@file{eval.c}. (An ordinary function would have the same general
appearance.)
-@cindex garbage collection protection
@smallexample
@group
DEFUN ("or", For, Sor, 0, UNEVALLED, 0,
If all args return nil, return nil.
@end group
@group
-usage: (or CONDITIONS ...) */)
+usage: (or CONDITIONS...) */)
(Lisp_Object args)
@{
- register Lisp_Object val = Qnil;
- struct gcpro gcpro1;
-@end group
-
-@group
- GCPRO1 (args);
+ Lisp_Object val = Qnil;
@end group
@group
@end group
@group
- UNGCPRO;
return val;
@}
@end group
the type explicitly using a suitable predicate (@pxref{Type Predicates}).
@cindex type checking internals
-@cindex @code{GCPRO} and @code{UNGCPRO}
+@cindex garbage collection protection
@cindex protect C variables from garbage collection
- Within the function @code{For} itself, note the use of the macros
-@code{GCPRO1} and @code{UNGCPRO}. These macros are defined for the
-sake of the few platforms which do not use Emacs' default
-stack-marking garbage collector. The @code{GCPRO1} macro ``protects''
-a variable from garbage collection, explicitly informing the garbage
-collector that that variable and all its contents must be as
-accessible. GC protection is necessary in any function which can
-perform Lisp evaluation by calling @code{eval_sub} or @code{Feval} as
-a subroutine, either directly or indirectly.
-
- It suffices to ensure that at least one pointer to each object is
-GC-protected. Thus, a particular local variable can do without
-protection if it is certain that the object it points to will be
-preserved by some other pointer (such as another local variable that
-has a @code{GCPRO}). Otherwise, the local variable needs a
-@code{GCPRO}.
-
- The macro @code{GCPRO1} protects just one local variable. If you
-want to protect two variables, use @code{GCPRO2} instead; repeating
-@code{GCPRO1} will not work. Macros @code{GCPRO3}, @code{GCPRO4},
-@code{GCPRO5}, and @code{GCPRO6} also exist. All these macros
-implicitly use local variables such as @code{gcpro1}; you must declare
-these explicitly, with type @code{struct gcpro}. Thus, if you use
-@code{GCPRO2}, you must declare @code{gcpro1} and @code{gcpro2}.
-
- @code{UNGCPRO} cancels the protection of the variables that are
-protected in the current function. It is necessary to do this
-explicitly.
+ Within the function @code{For} itself, the local variable
+@code{args} refers to objects controlled by Emacs's stack-marking
+garbage collector. Although the garbage collector does not reclaim
+objects reachable from C @code{Lisp_Object} stack variables, it may
+move non-object components of an object, such as string contents; so
+functions that access non-object components must take care to refetch
+their addresses after performing Lisp evaluation. Lisp evaluation can
+occur via calls to @code{eval_sub} or @code{Feval}, either directly or
+indirectly.
You must not use C initializers for static or global variables unless
the variables are never written once Emacs is dumped. These variables
arguments, in C it takes two: the number of Lisp-level arguments, and a
one-dimensional array containing their values. The first Lisp-level
argument is the Lisp function to call, and the rest are the arguments to
-pass to it. Since @code{Ffuncall} can call the evaluator, you must
-protect pointers from garbage collection around the call to
-@code{Ffuncall}.
+pass to it.
The C functions @code{call0}, @code{call1}, @code{call2}, and so on,
provide handy ways to call a Lisp function conveniently with a fixed
undumping code to GCC under IRIX, or by configuring --with-wide-int,
or by sticking with Emacs 24.4.
+** The Emacs garbage collector assumes GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS.
+The GC_MAKE_GCPROS_NOOPS stack-marking variant has been the default
+since Emacs 24.4, and the other variants were undocumented and were
+obstacles to maintenance and development. GC_MARK_STACK and its
+related symbols have been removed from the C internals.
+
** 'configure' now prefers gnustep-config when configuring GNUstep.
If gnustep-config is not available, the old heuristics are used.
static bool valgrind_p;
#endif
-/* GC_CHECK_MARKED_OBJECTS means do sanity checks on allocated objects.
- Doable only if GC_MARK_STACK. */
-#if ! GC_MARK_STACK
-# undef GC_CHECK_MARKED_OBJECTS
-#endif
+/* GC_CHECK_MARKED_OBJECTS means do sanity checks on allocated objects. */
/* GC_MALLOC_CHECK defined means perform validity checks of malloc'd
memory. Can do this only if using gmalloc.c and if not checking
MEM_TYPE_SPARE
};
-#if GC_MARK_STACK || defined GC_MALLOC_CHECK
-
/* A unique object in pure space used to make some Lisp objects
on free lists recognizable in O(1). */
static void mem_delete_fixup (struct mem_node *);
static struct mem_node *mem_find (void *);
-#endif /* GC_MARK_STACK || GC_MALLOC_CHECK */
-
#ifndef DEADP
# define DEADP(x) 0
#endif
-/* Recording what needs to be marked for gc. */
-
-struct gcpro *gcprolist;
-
/* Addresses of staticpro'd variables. Initialize it to a nonzero
value; otherwise some compilers put it into BSS. */
}
#endif
-#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
+#ifndef GC_MALLOC_CHECK
if (val && type != MEM_TYPE_NON_LISP)
mem_insert (val, (char *) val + nbytes, type);
#endif
{
MALLOC_BLOCK_INPUT;
free (block);
-#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
+#ifndef GC_MALLOC_CHECK
mem_delete (mem_find (block));
#endif
MALLOC_UNBLOCK_INPUT;
val = free_ablock;
free_ablock = free_ablock->x.next_free;
-#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
+#ifndef GC_MALLOC_CHECK
if (type != MEM_TYPE_NON_LISP)
mem_insert (val, (char *) val + nbytes, type);
#endif
struct ablocks *abase = ABLOCK_ABASE (ablock);
MALLOC_BLOCK_INPUT;
-#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
+#ifndef GC_MALLOC_CHECK
mem_delete (mem_find (block));
#endif
/* Put on free list. */
free_cons (struct Lisp_Cons *ptr)
{
ptr->u.chain = cons_free_list;
-#if GC_MARK_STACK
ptr->car = Vdead;
-#endif
cons_free_list = ptr;
consing_since_gc -= sizeof *ptr;
total_free_conses++;
{
struct vector_block *block = xmalloc (sizeof *block);
-#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
+#ifndef GC_MALLOC_CHECK
mem_insert (block->data, block->data + VECTOR_BLOCK_BYTES,
MEM_TYPE_VECTOR_BLOCK);
#endif
if (free_this_block)
{
*bprev = block->next;
-#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
+#ifndef GC_MALLOC_CHECK
mem_delete (mem_find (block->data));
#endif
xfree (block);
static void
run_finalizer_function (Lisp_Object function)
{
- struct gcpro gcpro1;
ptrdiff_t count = SPECPDL_INDEX ();
- GCPRO1 (function);
specbind (Qinhibit_quit, Qt);
internal_condition_case_1 (call0, function, Qt, run_finalizer_handler);
unbind_to (count, Qnil);
- UNGCPRO;
}
static void
C Stack Marking
************************************************************************/
-#if GC_MARK_STACK || defined GC_MALLOC_CHECK
-
/* Conservative C stack marking requires a method to identify possibly
live Lisp objects given a pointer value. We do this by keeping
track of blocks of Lisp data that are allocated in a red-black tree
c = mem_root;
parent = NULL;
-#if GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS
-
- while (c != MEM_NIL)
- {
- if (start >= c->start && start < c->end)
- emacs_abort ();
- parent = c;
- c = start < c->start ? c->left : c->right;
- }
-
-#else /* GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS */
-
while (c != MEM_NIL)
{
parent = c;
c = start < c->start ? c->left : c->right;
}
-#endif /* GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS */
-
/* Create a new node. */
#ifdef GC_MALLOC_CHECK
x = malloc (sizeof *x);
&& !NILP (((struct buffer *) p)->name_));
}
-#endif /* GC_MARK_STACK || defined GC_MALLOC_CHECK */
-
-#if GC_MARK_STACK
-
-#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
-
-/* Currently not used, but may be called from gdb. */
-
-void dump_zombies (void) EXTERNALLY_VISIBLE;
-
-/* Array of objects that are kept alive because the C stack contains
- a pattern that looks like a reference to them. */
-
-#define MAX_ZOMBIES 10
-static Lisp_Object zombies[MAX_ZOMBIES];
-
-/* Number of zombie objects. */
-
-static EMACS_INT nzombies;
-
-/* Number of garbage collections. */
-
-static EMACS_INT ngcs;
-
-/* Average percentage of zombies per collection. */
-
-static double avg_zombies;
-
-/* Max. number of live and zombie objects. */
-
-static EMACS_INT max_live, max_zombies;
-
-/* Average number of live objects per GC. */
-
-static double avg_live;
-
-DEFUN ("gc-status", Fgc_status, Sgc_status, 0, 0, "",
- doc: /* Show information about live and zombie objects. */)
- (void)
-{
- Lisp_Object zombie_list = Qnil;
- for (int i = 0; i < min (MAX_ZOMBIES, nzombies); i++)
- zombie_list = Fcons (zombies[i], zombie_list);
- AUTO_STRING (format, ("%d GCs, avg live/zombies = %.2f/%.2f (%f%%),"
- " max %d/%d\nzombies: %S"));
- return CALLN (Fmessage, format,
- make_number (ngcs), make_float (avg_live),
- make_float (avg_zombies),
- make_float (avg_zombies / avg_live / 100),
- make_number (max_live), make_number (max_zombies),
- zombie_list);
-}
-
-#endif /* GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES */
-
-
/* Mark OBJ if we can prove it's a Lisp_Object. */
static void
}
if (mark_p)
- {
-#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
- if (nzombies < MAX_ZOMBIES)
- zombies[nzombies] = obj;
- ++nzombies;
-#endif
- mark_object (obj);
- }
+ mark_object (obj);
}
}
void **pp;
int i;
-#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
- nzombies = 0;
-#endif
-
/* Make START the pointer to the start of the memory region,
if it isn't already. */
if (end < start)
#endif /* not GC_SAVE_REGISTERS_ON_STACK && not GC_SETJMP_WORKS */
-#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
-
-/* Abort if anything GCPRO'd doesn't survive the GC. */
-
-static void
-check_gcpros (void)
-{
- struct gcpro *p;
- ptrdiff_t i;
-
- for (p = gcprolist; p; p = p->next)
- for (i = 0; i < p->nvars; ++i)
- if (!survives_gc_p (p->var[i]))
- /* FIXME: It's not necessarily a bug. It might just be that the
- GCPRO is unnecessary or should release the object sooner. */
- emacs_abort ();
-}
-
-#elif GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
-
-void
-dump_zombies (void)
-{
- int i;
-
- fprintf (stderr, "\nZombies kept alive = %"pI"d:\n", nzombies);
- for (i = 0; i < min (MAX_ZOMBIES, nzombies); ++i)
- {
- fprintf (stderr, " %d = ", i);
- debug_print (zombies[i]);
- }
-}
-
-#endif /* GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES */
-
-
/* Mark live Lisp objects on the C stack.
There are several system-dependent problems to consider when
#ifdef GC_MARK_SECONDARY_STACK
GC_MARK_SECONDARY_STACK ();
#endif
-
-#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
- check_gcpros ();
-#endif
}
-#else /* GC_MARK_STACK == 0 */
-
-#define mark_maybe_object(obj) emacs_abort ()
-
-#endif /* GC_MARK_STACK != 0 */
-
static bool
c_symbol_p (struct Lisp_Symbol *sym)
{
valid_lisp_object_p (Lisp_Object obj)
{
void *p;
-#if GC_MARK_STACK
struct mem_node *m;
-#endif
if (INTEGERP (obj))
return 1;
if (p == &buffer_defaults || p == &buffer_local_symbols)
return 2;
-#if !GC_MARK_STACK
- return valid_pointer_p (p);
-#else
-
m = mem_find (p);
if (m == MEM_NIL)
}
return 0;
-#endif
-}
-
-/* If GC_MARK_STACK, return 1 if STR is a relocatable data of Lisp_String
- (i.e. there is a non-pure Lisp_Object X so that SDATA (X) == STR) and 0
- if not. Otherwise we can't rely on valid_lisp_object_p and return -1.
- This function is slow and should be used for debugging purposes. */
-
-int
-relocatable_string_data_p (const char *str)
-{
- if (PURE_POINTER_P (str))
- return 0;
-#if GC_MARK_STACK
- if (str)
- {
- struct sdata *sdata
- = (struct sdata *) (str - offsetof (struct sdata, data));
-
- if (0 < valid_pointer_p (sdata)
- && 0 < valid_pointer_p (sdata->string)
- && maybe_lisp_pointer (sdata->string))
- return (valid_lisp_object_p
- (make_lisp_ptr (sdata->string, Lisp_String))
- && (const char *) sdata->string->data == str);
- }
- return 0;
-#endif /* GC_MARK_STACK */
- return -1;
}
/***********************************************************************
xg_mark_data ();
#endif
-#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
- || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS)
mark_stack (end);
-#else
- {
- register struct gcpro *tail;
- for (tail = gcprolist; tail; tail = tail->next)
- for (i = 0; i < tail->nvars; i++)
- mark_object (tail->var[i]);
- }
- mark_byte_stack ();
-#endif
+
{
struct handler *handler;
for (handler = handlerlist; handler; handler = handler->next)
mark_fringe_data ();
#endif
-#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
- mark_stack (end);
-#endif
-
/* Everything is now marked, except for the data in font caches,
undo lists, and finalizers. The first two are compacted by
removing an items which aren't reachable otherwise. */
gc_sweep ();
- /* Clear the mark bits that we set in certain root slots. */
+ relocate_byte_stack ();
- unmark_byte_stack ();
+ /* Clear the mark bits that we set in certain root slots. */
VECTOR_UNMARK (&buffer_defaults);
VECTOR_UNMARK (&buffer_local_symbols);
-#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES && 0
- dump_zombies ();
-#endif
-
check_cons_list ();
gc_in_progress = 0;
};
retval = CALLMANY (Flist, total);
-#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
- {
- /* Compute average percentage of zombies. */
- double nlive
- = (total_conses + total_symbols + total_markers + total_strings
- + total_vectors + total_floats + total_intervals + total_buffers);
-
- avg_live = (avg_live * ngcs + nlive) / (ngcs + 1);
- max_live = max (nlive, max_live);
- avg_zombies = (avg_zombies * ngcs + nzombies) / (ngcs + 1);
- max_zombies = max (nzombies, max_zombies);
- ++ngcs;
- }
-#endif
-
/* GC is complete: now we can run our finalizer callbacks. */
run_finalizers (&doomed_finalizers);
See Info node `(elisp)Garbage Collection'. */)
(void)
{
-#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
- || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS \
- || GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES)
void *end;
#ifdef HAVE___BUILTIN_UNWIND_INIT
#endif /* not GC_SAVE_REGISTERS_ON_STACK */
#endif /* not HAVE___BUILTIN_UNWIND_INIT */
return garbage_collect_1 (end);
-#elif (GC_MARK_STACK == GC_USE_GCPROS_AS_BEFORE)
- /* Old GCPROs-based method without stack marking. */
- return garbage_collect_1 (NULL);
-#else
- emacs_abort ();
-#endif /* GC_MARK_STACK */
}
/* Mark Lisp objects in glyph matrix MATRIX. Currently the
/* If `save_type' is zero, `data[0].pointer' is the address
of a memory area containing `data[1].integer' potential
Lisp_Objects. */
- if (GC_MARK_STACK && ptr->save_type == SAVE_TYPE_MEMORY)
+ if (ptr->save_type == SAVE_TYPE_MEMORY)
{
Lisp_Object *p = ptr->data[0].pointer;
ptrdiff_t nelt;
/* Perform some sanity checks on the objects marked here. Abort if
we encounter an object we know is bogus. This increases GC time
- by ~80%, and requires compilation with GC_MARK_STACK != 0. */
+ by ~80%. */
#ifdef GC_CHECK_MARKED_OBJECTS
/* Check that the object pointed to by PO is known to be a Lisp
this_free++;
cblk->conses[pos].u.chain = cons_free_list;
cons_free_list = &cblk->conses[pos];
-#if GC_MARK_STACK
cons_free_list->car = Vdead;
-#endif
}
else
{
xfree (SYMBOL_BLV (&sym->s));
sym->s.next = symbol_free_list;
symbol_free_list = &sym->s;
-#if GC_MARK_STACK
symbol_free_list->function = Vdead;
-#endif
++this_free;
}
else
{
/* Even though Qt's contents are not set up, its address is known. */
Vpurify_flag = Qt;
- gc_precise = (GC_MARK_STACK == GC_USE_GCPROS_AS_BEFORE);
purebeg = PUREBEG;
pure_size = PURESIZE;
init_finalizer_list (&finalizers);
init_finalizer_list (&doomed_finalizers);
-#if GC_MARK_STACK || defined GC_MALLOC_CHECK
mem_init ();
Vdead = make_pure_string ("DEAD", 4, 4, 0);
-#endif
#ifdef DOUG_LEA_MALLOC
mallopt (M_TRIM_THRESHOLD, 128 * 1024); /* Trim threshold. */
void
init_alloc (void)
{
-#if GC_MARK_STACK
#if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS
setjmp_tested_p = longjmps_done = 0;
-#endif
#endif
Vgc_elapsed = make_float (0.0);
gcs_done = 0;
DEFVAR_INT ("gcs-done", gcs_done,
doc: /* Accumulated number of garbage collections done. */);
- DEFVAR_BOOL ("gc-precise", gc_precise,
- doc: /* Non-nil means GC stack marking is precise.
-Useful mainly for automated GC tests. Build time constant.*/);
- XSYMBOL (intern_c_string ("gc-precise"))->constant = 1;
-
defsubr (&Scons);
defsubr (&Slist);
defsubr (&Svector);
defsubr (&Smemory_info);
defsubr (&Smemory_use_counts);
defsubr (&Ssuspicious_object);
-
-#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
- defsubr (&Sgc_status);
-#endif
}
/* When compiled with GCC, GDB might say "No enum type named
{
int old_level, new_level, next_level;
struct bidi_it sentinel;
- struct gcpro gcpro1;
if (bidi_it->charpos < 0 || bidi_it->bytepos < 0)
emacs_abort ();
bidi_it->scan_dir = 1; /* default to logical order */
}
- /* The code below can call eval, and thus cause GC. If we are
- iterating a Lisp string, make sure it won't be GCed. */
- if (STRINGP (bidi_it->string.lstring))
- GCPRO1 (bidi_it->string.lstring);
-
/* If we just passed a newline, initialize for the next line. */
if (!bidi_it->first_elt
&& (bidi_it->ch == '\n' || bidi_it->ch == BIDI_EOB))
eassert (bidi_it->resolved_level >= 0
&& bidi_it->resolved_level <= BIDI_MAXDEPTH + 2);
-
- if (STRINGP (bidi_it->string.lstring))
- UNGCPRO;
}
/* Utility function for looking for strong directional characters
(Lisp_Object buffer_or_name)
{
Lisp_Object buffer;
- register struct buffer *b;
- register Lisp_Object tem;
- register struct Lisp_Marker *m;
- struct gcpro gcpro1;
+ struct buffer *b;
+ Lisp_Object tem;
+ struct Lisp_Marker *m;
if (NILP (buffer_or_name))
buffer = Fcurrent_buffer ();
if (INTERACTIVE && !NILP (BVAR (b, filename))
&& BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
{
- GCPRO1 (buffer);
AUTO_STRING (format, "Buffer %s modified; kill anyway? ");
tem = do_yes_or_no_p (CALLN (Fformat, format, BVAR (b, name)));
- UNGCPRO;
if (NILP (tem))
return unbind_to (count, Qnil);
}
{
struct buffer *other;
- GCPRO1 (buffer);
-
FOR_EACH_BUFFER (other)
if (other->base_buffer == b)
{
Fkill_buffer (buf);
}
- UNGCPRO;
-
/* Exit if we now have killed the base buffer (Bug#11665). */
if (!BUFFER_LIVE_P (b))
return Qt;
/* Unlock this buffer's file, if it is locked. */
unlock_buffer (b);
- GCPRO1 (buffer);
kill_buffer_processes (buffer);
- UNGCPRO;
/* Killing buffer processes may run sentinels which may have killed
our buffer. */
bool narrowed = (BEG != BEGV || Z != ZV);
bool modified_p = !NILP (Fbuffer_modified_p (Qnil));
Lisp_Object old_undo = BVAR (current_buffer, undo_list);
- struct gcpro gcpro1;
if (current_buffer->base_buffer)
error ("Cannot do `set-buffer-multibyte' on an indirect buffer");
if (NILP (flag) == NILP (BVAR (current_buffer, enable_multibyte_characters)))
return flag;
- GCPRO1 (old_undo);
-
/* Don't record these buffer changes. We will put a special undo entry
instead. */
bset_undo_list (current_buffer, Qt);
old_undo));
}
- UNGCPRO;
-
current_buffer->prevent_redisplay_optimizations_p = 1;
/* If buffer is shown in a window, let redisplay consider other windows. */
struct Lisp_Overlay *tail;
/* True if this change is an insertion. */
bool insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
overlay = Qnil;
tail = NULL;
}
}
- GCPRO4 (overlay, arg1, arg2, arg3);
{
/* Call the functions recorded in last_overlay_modification_hooks.
First copy the vector contents, in case some of these hooks
SAFE_FREE ();
}
- UNGCPRO;
}
static void
call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay, bool after,
Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
{
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-
- GCPRO4 (list, arg1, arg2, arg3);
-
while (CONSP (list))
{
if (NILP (arg3))
call5 (XCAR (list), overlay, after ? Qt : Qnil, arg1, arg2, arg3);
list = XCDR (list);
}
- UNGCPRO;
}
/* Delete any zero-sized overlays at position POS, if the `evaporate'
};
/* Whether to maintain a `top' and `bottom' field in the stack frame. */
-#define BYTE_MAINTAIN_TOP (BYTE_CODE_SAFE || BYTE_MARK_STACK)
+#define BYTE_MAINTAIN_TOP BYTE_CODE_SAFE
\f
/* Structure describing a value stack used during byte-code execution
in Fbyte_code. */
Lisp_Object byte_string;
const unsigned char *byte_string_start;
-#if BYTE_MARK_STACK
- /* The vector of constants used during byte-code execution. Storing
- this here protects it from GC because mark_byte_stack marks it. */
- Lisp_Object constants;
-#endif
-
/* Next entry in byte_stack_list. */
struct byte_stack *next;
};
/* A list of currently active byte-code execution value stacks.
Fbyte_code adds an entry to the head of this list before it starts
processing byte-code, and it removes the entry again when it is
- done. Signaling an error truncates the list analogous to
- gcprolist. */
+ done. Signaling an error truncates the list. */
struct byte_stack *byte_stack_list;
\f
-/* Mark objects on byte_stack_list. Called during GC. */
-
-#if BYTE_MARK_STACK
-void
-mark_byte_stack (void)
-{
- struct byte_stack *stack;
- Lisp_Object *obj;
-
- for (stack = byte_stack_list; stack; stack = stack->next)
- {
- /* If STACK->top is null here, this means there's an opcode in
- Fbyte_code that wasn't expected to GC, but did. To find out
- which opcode this is, record the value of `stack', and walk
- up the stack in a debugger, stopping in frames of Fbyte_code.
- The culprit is found in the frame of Fbyte_code where the
- address of its local variable `stack' is equal to the
- recorded value of `stack' here. */
- eassert (stack->top);
-
- for (obj = stack->bottom; obj <= stack->top; ++obj)
- mark_object (*obj);
-
- mark_object (stack->byte_string);
- mark_object (stack->constants);
- }
-}
-#endif
-
-/* Unmark objects in the stacks on byte_stack_list. Relocate program
- counters. Called when GC has completed. */
+/* Relocate program counters in the stacks on byte_stack_list. Called
+ when GC has completed. */
void
-unmark_byte_stack (void)
+relocate_byte_stack (void)
{
struct byte_stack *stack;
stack.byte_string = bytestr;
stack.pc = stack.byte_string_start = SDATA (bytestr);
-#if BYTE_MARK_STACK
- stack.constants = vector;
-#endif
if (MAX_ALLOCA / word_size <= XFASTINT (maxdepth))
memory_full (SIZE_MAX);
top = alloca ((XFASTINT (maxdepth) + 1) * sizeof *top);
read_file_name (Lisp_Object default_filename, Lisp_Object mustmatch,
Lisp_Object initial, Lisp_Object predicate)
{
- struct gcpro gcpro1;
- GCPRO1 (default_filename);
- RETURN_UNGCPRO (CALLN (Ffuncall, intern ("read-file-name"),
- callint_message, Qnil, default_filename,
- mustmatch, initial, predicate));
+ return CALLN (Ffuncall, intern ("read-file-name"),
+ callint_message, Qnil, default_filename,
+ mustmatch, initial, predicate);
}
/* BEWARE: Calling this directly from C would defeat the purpose! */
ptrdiff_t i, nargs;
ptrdiff_t mark;
bool arg_from_tty = 0;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
ptrdiff_t key_count;
bool record_then_fail = 0;
/* Set SPECS to the interactive form, or barf if not interactive. */
{
Lisp_Object form;
- GCPRO2 (function, prefix_arg);
form = Finteractive_form (function);
- UNGCPRO;
if (CONSP (form))
specs = filter_specs = Fcar (XCDR (form));
else
uintmax_t events = num_input_events;
input = specs;
/* Compute the arg values using the user's expression. */
- GCPRO2 (input, filter_specs);
specs = Feval (specs,
CONSP (funval) && EQ (Qclosure, XCAR (funval))
? CAR_SAFE (XCDR (funval)) : Qnil);
- UNGCPRO;
if (events != num_input_events || !NILP (record_flag))
{
/* We should record this command on the command history. */
memclear (args, nargs * (2 * word_size + 1));
- GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
- gcpro3.nvars = nargs;
- gcpro4.nvars = nargs;
-
if (!NILP (enable))
specbind (Qenable_recursive_minibuffers, Qt);
{
Lisp_Object val = Ffuncall (nargs, args);
- UNGCPRO;
val = unbind_to (speccount, val);
SAFE_FREE ();
return val;
encode_current_directory (void)
{
Lisp_Object dir;
- struct gcpro gcpro1;
dir = BVAR (current_buffer, directory);
- GCPRO1 (dir);
dir = Funhandled_file_name_directory (dir);
report_file_error ("Setting current directory",
BVAR (current_buffer, directory));
- RETURN_UNGCPRO (dir);
+ return dir;
}
/* If P is reapable, record it as a deleted process and kill it.
{
Lisp_Object infile, encoded_infile;
int filefd;
- struct gcpro gcpro1;
ptrdiff_t count = SPECPDL_INDEX ();
if (nargs >= 2 && ! NILP (args[1]))
else
infile = build_string (NULL_DEVICE);
- GCPRO1 (infile);
encoded_infile = ENCODE_FILE (infile);
filefd = emacs_open (SSDATA (encoded_infile), O_RDONLY, 0);
if (filefd < 0)
report_file_error ("Opening process input file", infile);
record_unwind_protect_int (close_file_unwind, filefd);
- UNGCPRO;
return unbind_to (count, call_process (nargs, args, filefd, -1));
}
/* Make sure that the child will be able to chdir to the current
buffer's current directory, or its unhandled equivalent. We
can't just have the child check for an error when it does the
- chdir, since it's in a vfork.
+ chdir, since it's in a vfork. */
+ current_dir = encode_current_directory ();
- We have to GCPRO around this because Fexpand_file_name,
- Funhandled_file_name_directory, and Ffile_accessible_directory_p
- might call a file name handling function. The argument list is
- protected by the caller, so all we really have to worry about is
- buffer. */
- {
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-
- current_dir = encode_current_directory ();
-
- GCPRO4 (buffer, current_dir, error_file, output_file);
-
- if (STRINGP (error_file))
- error_file = ENCODE_FILE (error_file);
- if (STRINGP (output_file))
- output_file = ENCODE_FILE (output_file);
- UNGCPRO;
- }
+ if (STRINGP (error_file))
+ error_file = ENCODE_FILE (error_file);
+ if (STRINGP (output_file))
+ output_file = ENCODE_FILE (output_file);
display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
/* Search for program; barf if not found. */
{
- struct gcpro gcpro1, gcpro2, gcpro3;
int ok;
- GCPRO3 (buffer, current_dir, error_file);
ok = openp (Vexec_path, args[0], Vexec_suffixes, &path,
make_number (X_OK), false);
- UNGCPRO;
if (ok < 0)
report_file_error ("Searching for program", args[0]);
}
SAFE_NALLOCA (new_argv, 1, nargs < 4 ? 2 : nargs - 2);
- {
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-
- GCPRO4 (buffer, current_dir, path, error_file);
- if (nargs > 4)
- {
- ptrdiff_t i;
+ if (nargs > 4)
+ {
+ ptrdiff_t i;
- argument_coding.dst_multibyte = 0;
- for (i = 4; i < nargs; i++)
- {
- argument_coding.src_multibyte = STRING_MULTIBYTE (args[i]);
- if (CODING_REQUIRE_ENCODING (&argument_coding))
- /* We must encode this argument. */
- args[i] = encode_coding_string (&argument_coding, args[i], 1);
- }
- for (i = 4; i < nargs; i++)
- new_argv[i - 3] = SSDATA (args[i]);
- new_argv[i - 3] = 0;
- }
- else
- new_argv[1] = 0;
- path = ENCODE_FILE (path);
- new_argv[0] = SSDATA (path);
- UNGCPRO;
- }
+ argument_coding.dst_multibyte = 0;
+ for (i = 4; i < nargs; i++)
+ {
+ argument_coding.src_multibyte = STRING_MULTIBYTE (args[i]);
+ if (CODING_REQUIRE_ENCODING (&argument_coding))
+ /* We must encode this argument. */
+ args[i] = encode_coding_string (&argument_coding, args[i], 1);
+ }
+ for (i = 4; i < nargs; i++)
+ new_argv[i - 3] = SSDATA (args[i]);
+ new_argv[i - 3] = 0;
+ }
+ else
+ new_argv[1] = 0;
+ path = ENCODE_FILE (path);
+ new_argv[0] = SSDATA (path);
discard_output = INTEGERP (buffer) || (NILP (buffer) && NILP (output_file));
Lisp_Object *filename_string_ptr)
{
int fd;
- struct gcpro gcpro1;
Lisp_Object filename_string;
Lisp_Object val, start, end;
Lisp_Object tmpdir;
#endif
filename_string = Fcopy_sequence (ENCODE_FILE (pattern));
- GCPRO1 (filename_string);
tempfile = SSDATA (filename_string);
count = SPECPDL_INDEX ();
coding-system-for-read. */
*filename_string_ptr = filename_string;
- UNGCPRO;
return fd;
}
usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- struct gcpro gcpro1;
Lisp_Object infile, val;
ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object start = args[0];
record_unwind_protect_int (close_file_unwind, fd);
}
- GCPRO1 (infile);
-
if (nargs > 3 && !NILP (args[3]))
Fdelete_region (start, end);
args[1] = infile;
val = call_process (nargs, args, fd, empty_input ? -1 : count);
- RETURN_UNGCPRO (unbind_to (count, val));
+ return unbind_to (count, val);
}
\f
#ifndef WINDOWSNT
Lisp_Object function, Lisp_Object table, Lisp_Object arg)
{
Lisp_Object range, val, parent;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
uniprop_decoder_t decoder = UNIPROP_GET_DECODER (table);
range = Fcons (make_number (0), make_number (MAX_CHAR));
parent = XCHAR_TABLE (table)->parent;
- GCPRO4 (table, arg, range, parent);
val = XCHAR_TABLE (table)->ascii;
if (SUB_CHAR_TABLE_P (val))
val = XSUB_CHAR_TABLE (val)->contents[0];
}
}
}
-
- UNGCPRO;
}
DEFUN ("map-char-table", Fmap_char_table, Smap_char_table,
{
Lisp_Object range;
int c, i;
- struct gcpro gcpro1;
range = Fcons (Qnil, Qnil);
- GCPRO1 (range);
for (i = 0, c = 0; i < chartab_size[0]; i++, c += chartab_chars[0])
{
else
call2 (function, range, arg);
}
-
- UNGCPRO;
}
\f
table = XCDR (val);
if (STRINGP (table))
{
- struct gcpro gcpro1;
- GCPRO1 (val);
AUTO_STRING (intl, "international/");
result = Fload (concat2 (intl, table), Qt, Qt, Qt, Qt);
- UNGCPRO;
if (NILP (result))
return Qnil;
table = XCDR (val);
code_conversion_restore (Lisp_Object arg)
{
Lisp_Object current, workbuf;
- struct gcpro gcpro1;
- GCPRO1 (arg);
current = XCAR (arg);
workbuf = XCDR (arg);
if (! NILP (workbuf))
Fkill_buffer (workbuf);
}
set_buffer_internal (XBUFFER (current));
- UNGCPRO;
}
Lisp_Object
if (! NILP (CODING_ATTR_POST_READ (attrs)))
{
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
ptrdiff_t prev_Z = Z, prev_Z_BYTE = Z_BYTE;
Lisp_Object val;
TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte);
- GCPRO5 (coding->src_object, coding->dst_object, src_object, dst_object,
- old_deactivate_mark);
val = safe_call1 (CODING_ATTR_POST_READ (attrs),
make_number (coding->produced_char));
- UNGCPRO;
CHECK_NATNUM (val);
coding->produced_char += Z - prev_Z;
coding->produced += Z_BYTE - prev_Z_BYTE;
set_buffer_internal (XBUFFER (coding->src_object));
}
- {
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
-
- GCPRO5 (coding->src_object, coding->dst_object, src_object, dst_object,
- old_deactivate_mark);
- safe_call2 (CODING_ATTR_PRE_WRITE (attrs),
- make_number (BEG), make_number (Z));
- UNGCPRO;
- }
+ safe_call2 (CODING_ATTR_PRE_WRITE (attrs),
+ make_number (BEG), make_number (Z));
if (XBUFFER (coding->src_object) != current_buffer)
kill_src_buffer = 1;
coding->src_object = Fcurrent_buffer ();
(Lisp_Object args)
{
Lisp_Object args_left, symbol, val;
- struct gcpro gcpro1;
args_left = val = args;
- GCPRO1 (args);
while (CONSP (args_left))
{
args_left = Fcdr (XCDR (args_left));
}
- UNGCPRO;
return val;
}
\f
case DBUS_TYPE_DICT_ENTRY:
{
Lisp_Object result;
- struct gcpro gcpro1;
DBusMessageIter subiter;
int subtype;
result = Qnil;
- GCPRO1 (result);
dbus_message_iter_recurse (iter, &subiter);
while ((subtype = dbus_message_iter_get_arg_type (&subiter))
!= DBUS_TYPE_INVALID)
dbus_message_iter_next (&subiter);
}
XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (result));
- RETURN_UNGCPRO (Fnreverse (result));
+ return Fnreverse (result);
}
default:
Lisp_Object interface = Qnil;
Lisp_Object member = Qnil;
Lisp_Object result;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
DBusConnection *connection;
DBusMessage *dmessage;
DBusMessageIter iter;
wrong_type_argument (Qinvalid_function, handler);
}
- /* Protect Lisp variables. */
- GCPRO6 (bus, service, path, interface, member, handler);
-
/* Trace parameters. */
switch (mtype)
{
/* Create the D-Bus message. */
dmessage = dbus_message_new (mtype);
if (dmessage == NULL)
- {
- UNGCPRO;
- XD_SIGNAL1 (build_string ("Unable to create a new message"));
- }
+ XD_SIGNAL1 (build_string ("Unable to create a new message"));
if (STRINGP (service))
{
/* Set destination. */
{
if (!dbus_message_set_destination (dmessage, SSDATA (service)))
- {
- UNGCPRO;
- XD_SIGNAL2 (build_string ("Unable to set the destination"),
- service);
- }
+ XD_SIGNAL2 (build_string ("Unable to set the destination"),
+ service);
}
else
&& (strcmp (dbus_bus_get_unique_name (connection), SSDATA (uname))
!= 0)
&& (!dbus_message_set_destination (dmessage, SSDATA (service))))
- {
- UNGCPRO;
- XD_SIGNAL2 (build_string ("Unable to set signal destination"),
- service);
- }
+ XD_SIGNAL2 (build_string ("Unable to set signal destination"),
+ service);
}
}
if ((!dbus_message_set_path (dmessage, SSDATA (path)))
|| (!dbus_message_set_interface (dmessage, SSDATA (interface)))
|| (!dbus_message_set_member (dmessage, SSDATA (member))))
- {
- UNGCPRO;
- XD_SIGNAL1 (build_string ("Unable to set the message parameter"));
- }
+ XD_SIGNAL1 (build_string ("Unable to set the message parameter"));
}
else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
{
if (!dbus_message_set_reply_serial (dmessage, serial))
- {
- UNGCPRO;
- XD_SIGNAL1 (build_string ("Unable to create a return message"));
- }
+ XD_SIGNAL1 (build_string ("Unable to create a return message"));
if ((mtype == DBUS_MESSAGE_TYPE_ERROR)
&& (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED)))
- {
- UNGCPRO;
- XD_SIGNAL1 (build_string ("Unable to create a error message"));
- }
+ XD_SIGNAL1 (build_string ("Unable to create a error message"));
}
/* Check for timeout parameter. */
message queue. */
if (!dbus_connection_send_with_reply (connection, dmessage,
NULL, timeout))
- {
- UNGCPRO;
- XD_SIGNAL1 (build_string ("Cannot send message"));
- }
+ XD_SIGNAL1 (build_string ("Cannot send message"));
/* The result is the key in Vdbus_registered_objects_table. */
serial = dbus_message_get_serial (dmessage);
/* Send the message. The message is just added to the outgoing
message queue. */
if (!dbus_connection_send (connection, dmessage, NULL))
- {
- UNGCPRO;
- XD_SIGNAL1 (build_string ("Cannot send message"));
- }
+ XD_SIGNAL1 (build_string ("Cannot send message"));
result = Qnil;
}
dbus_message_unref (dmessage);
/* Return the result. */
- RETURN_UNGCPRO (result);
+ return result;
}
/* Read one queued incoming message of the D-Bus BUS.
xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
{
Lisp_Object args, key, value;
- struct gcpro gcpro1;
struct input_event event;
DBusMessage *dmessage;
DBusMessageIter iter;
/* Collect the parameters. */
args = Qnil;
- GCPRO1 (args);
/* Loop over the resulting parameters. Construct a list. */
if (dbus_message_iter_init (dmessage, &iter))
/* Cleanup. */
cleanup:
dbus_message_unref (dmessage);
-
- UNGCPRO;
}
/* Read queued incoming messages of the D-Bus BUS.
struct re_pattern_buffer *bufp = NULL;
bool needsep = 0;
ptrdiff_t count = SPECPDL_INDEX ();
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
#ifdef WINDOWSNT
Lisp_Object w32_save = Qnil;
#endif
/* Don't let the compiler optimize away all copies of DIRECTORY,
- which would break GC; see Bug#16986. Although this is required
- only in the common case where GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS,
- it shouldn't break anything in the other cases. */
+ which would break GC; see Bug#16986. */
Lisp_Object volatile directory_volatile = directory;
/* Because of file name handlers, these functions might call
Ffuncall, and cause a GC. */
list = encoded_directory = dirfilename = Qnil;
- GCPRO5 (match, directory, list, dirfilename, encoded_directory);
dirfilename = Fdirectory_file_name (directory);
if (!NILP (match))
ptrdiff_t len = dirent_namelen (dp);
Lisp_Object name = make_unibyte_string (dp->d_name, len);
Lisp_Object finalname = name;
- struct gcpro gcpro1, gcpro2;
- GCPRO2 (finalname, name);
/* Note: DECODE_FILE can GC; it should protect its argument,
though. */
else
list = Fcons (finalname, list);
}
-
- UNGCPRO;
}
block_input ();
attrs ? Qfile_attributes_lessp : Qstring_lessp);
(void) directory_volatile;
- RETURN_UNGCPRO (list);
+ return list;
}
anything. */
bool includeall = 1;
ptrdiff_t count = SPECPDL_INDEX ();
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
elt = Qnil;
bestmatch = Qnil;
encoded_file = encoded_dir = Qnil;
- GCPRO5 (file, dirname, bestmatch, encoded_file, encoded_dir);
specbind (Qdefault_directory, dirname);
/* Do completion on the encoded file name
name = Ffile_name_as_directory (name);
/* Test the predicate, if any. */
- if (!NILP (predicate))
- {
- Lisp_Object val;
- struct gcpro gcpro1;
-
- GCPRO1 (name);
- val = call1 (predicate, name);
- UNGCPRO;
-
- if (NILP (val))
- continue;
- }
+ if (!NILP (predicate) && NILP (call1 (predicate, name)))
+ continue;
/* Suitably record this match. */
}
}
- UNGCPRO;
/* This closes the directory. */
bestmatch = unbind_to (count, bestmatch);
if (NILP (tem) && try_reload)
{
/* The file is newer, we need to reset the pointers. */
- struct gcpro gcpro1, gcpro2;
- GCPRO2 (function, raw);
try_reload = reread_doc_file (Fcar_safe (doc));
- UNGCPRO;
if (try_reload)
{
try_reload = 0;
if (NILP (tem) && try_reload)
{
/* The file is newer, we need to reset the pointers. */
- struct gcpro gcpro1, gcpro2, gcpro3;
- GCPRO3 (symbol, prop, raw);
try_reload = reread_doc_file (Fcar_safe (doc));
- UNGCPRO;
if (try_reload)
{
try_reload = 0;
unsigned char const *start;
ptrdiff_t length, length_byte;
Lisp_Object name;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
bool multibyte;
ptrdiff_t nchars;
tem = Qnil;
keymap = Qnil;
name = Qnil;
- GCPRO4 (string, tem, keymap, name);
enum text_quoting_style quoting_style = text_quoting_style ();
else
tem = string;
xfree (buf);
- RETURN_UNGCPRO (tem);
+ return tem;
}
\f
void
save_excursion_restore (Lisp_Object info)
{
Lisp_Object tem, tem1;
- struct gcpro gcpro1;
tem = Fmarker_buffer (XSAVE_OBJECT (info, 0));
/* If we're unwinding to top level, saved buffer may be deleted. This
if (NILP (tem))
goto out;
- GCPRO1 (info);
-
Fset_buffer (tem);
/* Point marker. */
&& XBUFFER (tem1) == current_buffer)))
Fset_window_point (tem, make_number (PT));
- UNGCPRO;
-
out:
free_misc (info);
}
-/* Callers passing one argument to Finsert need not gcpro the
- argument "array", since the only element of the array will
- not be used after calling insert or insert_from_string, so
- we don't care if it gets trashed. */
-
DEFUN ("insert", Finsert, Sinsert, 0, MANY, 0,
doc: /* Insert the arguments, either strings or characters, at point.
Point and before-insertion markers move forward to end up
{
Lisp_Object tem, string;
- struct gcpro gcpro1;
-
tem = BVAR (current_buffer, undo_list);
- GCPRO1 (tem);
/* Make a multibyte string containing this single character. */
string = make_multibyte_string ((char *) tostr, 1, len);
if (! NILP (noundo))
bset_undo_list (current_buffer, tem);
-
- UNGCPRO;
}
else
{
{
Lisp_Object val = Fformat_message (nargs, args);
Lisp_Object pane, menu;
- struct gcpro gcpro1;
pane = list1 (Fcons (build_string ("OK"), Qt));
- GCPRO1 (pane);
menu = Fcons (val, pane);
Fx_popup_dialog (Qt, menu, Qt);
- UNGCPRO;
return val;
}
}
(ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object properties, string;
- struct gcpro gcpro1, gcpro2;
ptrdiff_t i;
/* Number of args must be odd. */
error ("Wrong number of arguments");
properties = string = Qnil;
- GCPRO2 (properties, string);
/* First argument must be a string. */
CHECK_STRING (args[0]);
Fadd_text_properties (make_number (0),
make_number (SCHARS (string)),
properties, string);
- RETURN_UNGCPRO (string);
+ return string;
}
DEFUN ("format", Fformat, Sformat, 1, MANY, 0,
bool_bf intervals : 1;
} *info = 0;
- /* It should not be necessary to GCPRO ARGS, because
- the caller in the interpreter should take care of that. */
-
CHECK_STRING (args[0]);
format_start = SSDATA (args[0]);
formatlen = SBYTES (args[0]);
if (string_intervals (args[0]) || arg_intervals)
{
Lisp_Object len, new_len, props;
- struct gcpro gcpro1;
/* Add text properties from the format string. */
len = make_number (SCHARS (args[0]));
props = text_property_list (args[0], make_number (0), len, Qnil);
- GCPRO1 (props);
if (CONSP (props))
{
add_text_properties_from_list (val, props,
make_number (info[n].start));
}
-
- UNGCPRO;
}
/* If we allocated BUF or INFO with malloc, free it too. */
int
main (int argc, char **argv)
{
-#if GC_MARK_STACK
Lisp_Object dummy;
-#endif
char stack_bottom_variable;
bool do_initial_setlocale;
bool dumping;
/* If we use --chdir, this records the original directory. */
char *original_pwd = 0;
-#if GC_MARK_STACK
stack_base = &dummy;
-#endif
#ifndef CANNOT_DUMP
might_dump = !initialized;
attributes: noreturn)
(Lisp_Object arg)
{
- struct gcpro gcpro1;
int exit_code;
- GCPRO1 (arg);
-
/* Fsignal calls emacs_abort () if it sees that waiting_for_input is
set. */
waiting_for_input = 0;
run_hook (Qkill_emacs_hook);
- UNGCPRO;
#ifdef HAVE_X_WINDOWS
/* Transfer any clipboards we own to the clipboard manager. */
struct handler *handlerlist;
-#ifdef DEBUG_GCPRO
-/* Count levels of GCPRO to detect failure to UNGCPRO. */
-int gcpro_level;
-#endif
-
/* Non-nil means record all fset's and provide's, to be undone
if the file being autoloaded is not fully loaded.
They are recorded by being consed onto the front of Vautoload_queue:
void
init_eval (void)
{
- gcprolist = 0;
byte_stack_list = 0;
specpdl_ptr = specpdl;
{ /* Put a dummy catcher at top-level so that handlerlist is never NULL.
Vquit_flag = Qnil;
debug_on_next_call = 0;
lisp_eval_depth = 0;
-#ifdef DEBUG_GCPRO
- gcpro_level = 0;
-#endif
/* This is less than the initial value of num_nonmacro_input_events. */
when_entered_debugger = -1;
}
usage: (or CONDITIONS...) */)
(Lisp_Object args)
{
- register Lisp_Object val = Qnil;
- struct gcpro gcpro1;
-
- GCPRO1 (args);
+ Lisp_Object val = Qnil;
while (CONSP (args))
{
args = XCDR (args);
}
- UNGCPRO;
return val;
}
usage: (and CONDITIONS...) */)
(Lisp_Object args)
{
- register Lisp_Object val = Qt;
- struct gcpro gcpro1;
-
- GCPRO1 (args);
+ Lisp_Object val = Qt;
while (CONSP (args))
{
args = XCDR (args);
}
- UNGCPRO;
return val;
}
(Lisp_Object args)
{
Lisp_Object cond;
- struct gcpro gcpro1;
- GCPRO1 (args);
cond = eval_sub (XCAR (args));
- UNGCPRO;
if (!NILP (cond))
return eval_sub (Fcar (XCDR (args)));
(Lisp_Object args)
{
Lisp_Object val = args;
- struct gcpro gcpro1;
- GCPRO1 (args);
while (CONSP (args))
{
Lisp_Object clause = XCAR (args);
}
args = XCDR (args);
}
- UNGCPRO;
return val;
}
(Lisp_Object body)
{
Lisp_Object val = Qnil;
- struct gcpro gcpro1;
-
- GCPRO1 (body);
while (CONSP (body))
{
body = XCDR (body);
}
- UNGCPRO;
return val;
}
{
Lisp_Object val;
Lisp_Object args_left;
- struct gcpro gcpro1, gcpro2;
args_left = args;
val = args;
- GCPRO2 (args, val);
val = eval_sub (XCAR (args_left));
while (CONSP (args_left = XCDR (args_left)))
eval_sub (XCAR (args_left));
- UNGCPRO;
return val;
}
usage: (prog2 FORM1 FORM2 BODY...) */)
(Lisp_Object args)
{
- struct gcpro gcpro1;
-
- GCPRO1 (args);
eval_sub (XCAR (args));
- UNGCPRO;
return Fprog1 (XCDR (args));
}
if (CONSP (args))
{
Lisp_Object args_left = args;
- struct gcpro gcpro1;
- GCPRO1 (args);
do
{
args_left = Fcdr (XCDR (args_left));
}
while (CONSP (args_left));
-
- UNGCPRO;
}
return val;
{
Lisp_Object varlist, var, val, elt, lexenv;
ptrdiff_t count = SPECPDL_INDEX ();
- struct gcpro gcpro1, gcpro2, gcpro3;
-
- GCPRO3 (args, elt, varlist);
lexenv = Vinternal_interpreter_environment;
varlist = XCDR (varlist);
}
- UNGCPRO;
+
val = Fprogn (XCDR (args));
return unbind_to (count, val);
}
(Lisp_Object args)
{
Lisp_Object *temps, tem, lexenv;
- register Lisp_Object elt, varlist;
+ Lisp_Object elt, varlist;
ptrdiff_t count = SPECPDL_INDEX ();
ptrdiff_t argnum;
- struct gcpro gcpro1, gcpro2;
USE_SAFE_ALLOCA;
varlist = XCAR (args);
/* Compute the values and store them in `temps'. */
- GCPRO2 (args, *temps);
- gcpro2.nvars = 0;
-
for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
{
QUIT;
signal_error ("`let' bindings can have only one value-form", elt);
else
temps [argnum++] = eval_sub (Fcar (Fcdr (elt)));
- gcpro2.nvars = argnum;
}
- UNGCPRO;
lexenv = Vinternal_interpreter_environment;
(Lisp_Object args)
{
Lisp_Object test, body;
- struct gcpro gcpro1, gcpro2;
-
- GCPRO2 (test, body);
test = XCAR (args);
body = XCDR (args);
Fprogn (body);
}
- UNGCPRO;
return Qnil;
}
{
/* SYM is not mentioned in ENVIRONMENT.
Look at its function definition. */
- struct gcpro gcpro1;
- GCPRO1 (form);
def = Fautoload_do_load (def, sym, Qmacro);
- UNGCPRO;
if (!CONSP (def))
/* Not defined or definition not suitable. */
break;
usage: (catch TAG BODY...) */)
(Lisp_Object args)
{
- register Lisp_Object tag;
- struct gcpro gcpro1;
-
- GCPRO1 (args);
- tag = eval_sub (XCAR (args));
- UNGCPRO;
+ Lisp_Object tag = eval_sub (XCAR (args));
return internal_catch (tag, Fprogn, XCDR (args));
}
eassert (handlerlist == catch);
byte_stack_list = catch->byte_stack;
- gcprolist = catch->gcpro;
-#ifdef DEBUG_GCPRO
- gcpro_level = gcprolist ? gcprolist->level + 1 : 0;
-#endif
lisp_eval_depth = catch->lisp_eval_depth;
sys_longjmp (catch->jmp, 1);
(Lisp_Object fundef, Lisp_Object funname, Lisp_Object macro_only)
{
ptrdiff_t count = SPECPDL_INDEX ();
- struct gcpro gcpro1, gcpro2, gcpro3;
if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef)))
return fundef;
SDATA (SYMBOL_NAME (funname)));
CHECK_SYMBOL (funname);
- GCPRO3 (funname, fundef, macro_only);
/* Preserve the match data. */
record_unwind_save_match_data ();
Vautoload_queue = Qt;
unbind_to (count, Qnil);
- UNGCPRO;
-
if (NILP (funname))
return Qnil;
else
{
Lisp_Object fun, val, original_fun, original_args;
Lisp_Object funcar;
- struct gcpro gcpro1, gcpro2, gcpro3;
ptrdiff_t count;
if (SYMBOLP (form))
QUIT;
- GCPRO1 (form);
maybe_gc ();
- UNGCPRO;
if (++lisp_eval_depth > max_lisp_eval_depth)
{
SAFE_ALLOCA_LISP (vals, XINT (numargs));
- GCPRO3 (args_left, fun, fun);
- gcpro3.var = vals;
- gcpro3.nvars = 0;
-
while (!NILP (args_left))
{
vals[argnum++] = eval_sub (Fcar (args_left));
args_left = Fcdr (args_left);
- gcpro3.nvars = argnum;
}
set_backtrace_args (specpdl + count, vals, XINT (numargs));
val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals);
- UNGCPRO;
SAFE_FREE ();
}
else
{
- GCPRO3 (args_left, fun, fun);
- gcpro3.var = argvals;
- gcpro3.nvars = 0;
-
maxargs = XSUBR (fun)->max_args;
- for (i = 0; i < maxargs; args_left = Fcdr (args_left))
+ for (i = 0; i < maxargs; i++)
{
argvals[i] = eval_sub (Fcar (args_left));
- gcpro3.nvars = ++i;
+ args_left = Fcdr (args_left);
}
- UNGCPRO;
-
set_backtrace_args (specpdl + count, argvals, XINT (numargs));
switch (i)
spread_arg = XCDR (spread_arg);
}
- /* Ffuncall gcpro's all of its args. */
retval = Ffuncall (funcall_nargs, funcall_args);
SAFE_FREE ();
/* ARGS[0] should be a hook symbol.
Call each of the functions in the hook value, passing each of them
as arguments all the rest of ARGS (all NARGS - 1 elements).
- FUNCALL specifies how to call each function on the hook.
- The caller (or its caller, etc) must gcpro all of ARGS,
- except that it isn't necessary to gcpro ARGS[0]. */
+ FUNCALL specifies how to call each function on the hook. */
Lisp_Object
run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args,
Lisp_Object (*funcall) (ptrdiff_t nargs, Lisp_Object *args))
{
Lisp_Object sym, val, ret = Qnil;
- struct gcpro gcpro1, gcpro2, gcpro3;
/* If we are dying or still initializing,
don't do anything--it would probably crash if we tried. */
else
{
Lisp_Object global_vals = Qnil;
- GCPRO3 (sym, val, global_vals);
for (;
CONSP (val) && NILP (ret);
}
}
- UNGCPRO;
return ret;
}
}
return CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7);
}
-/* The caller should GCPRO all the elements of ARGS. */
-
DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0,
doc: /* Non-nil if OBJECT is a function. */)
(Lisp_Object object)
error ("Lisp nesting exceeds `max-lisp-eval-depth'");
}
- /* This also GCPROs them. */
count = record_in_backtrace (args[0], &args[1], nargs - 1);
- /* Call GC after setting up the backtrace, so the latter GCPROs the args. */
maybe_gc ();
if (debug_on_next_call)
Lisp_Object args_left;
ptrdiff_t i;
EMACS_INT numargs;
- register Lisp_Object *arg_vector;
- struct gcpro gcpro1, gcpro2, gcpro3;
- register Lisp_Object tem;
+ Lisp_Object *arg_vector;
+ Lisp_Object tem;
USE_SAFE_ALLOCA;
numargs = XFASTINT (Flength (args));
SAFE_ALLOCA_LISP (arg_vector, numargs);
args_left = args;
- GCPRO3 (*arg_vector, args_left, fun);
- gcpro1.nvars = 0;
-
for (i = 0; i < numargs; )
{
tem = Fcar (args_left), args_left = Fcdr (args_left);
tem = eval_sub (tem);
arg_vector[i++] = tem;
- gcpro1.nvars = i;
}
- UNGCPRO;
-
set_backtrace_args (specpdl + count, arg_vector, i);
tem = funcall_lambda (fun, numargs, arg_vector);
unbind_to (ptrdiff_t count, Lisp_Object value)
{
Lisp_Object quitf = Vquit_flag;
- struct gcpro gcpro1, gcpro2;
- GCPRO2 (value, quitf);
Vquit_flag = Qnil;
while (specpdl_ptr != specpdl + count)
if (NILP (Vquit_flag) && !NILP (quitf))
Vquit_flag = quitf;
- UNGCPRO;
return value;
}
#endif /* not DOS_NT */
)
{
- struct gcpro gcpro1;
-
- GCPRO1 (name);
default_directory = Fexpand_file_name (default_directory, Qnil);
- UNGCPRO;
}
}
multibyte = STRING_MULTIBYTE (name);
{
Lisp_Object tem, encoded_filename;
struct stat statbuf;
- struct gcpro gcpro1;
encoded_filename = ENCODE_FILE (absname);
if (! interactive)
xsignal2 (Qfile_already_exists,
build_string ("File already exists"), absname);
- GCPRO1 (absname);
AUTO_STRING (format, "File %s already exists; %s anyway? ");
tem = CALLN (Fformat, format, absname, build_string (querystring));
if (quick)
tem = call1 (intern ("y-or-n-p"), tem);
else
tem = do_yes_or_no_p (tem);
- UNGCPRO;
if (NILP (tem))
xsignal2 (Qfile_already_exists,
build_string ("File already exists"), absname);
Lisp_Object preserve_permissions)
{
Lisp_Object handler;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object encoded_file, encoded_newname;
#if HAVE_LIBSELINUX
#endif
encoded_file = encoded_newname = Qnil;
- GCPRO4 (file, newname, encoded_file, encoded_newname);
CHECK_STRING (file);
CHECK_STRING (newname);
if (NILP (handler))
handler = Ffind_file_name_handler (newname, Qcopy_file);
if (!NILP (handler))
- RETURN_UNGCPRO (call7 (handler, Qcopy_file, file, newname,
- ok_if_already_exists, keep_time, preserve_uid_gid,
- preserve_permissions));
+ return call7 (handler, Qcopy_file, file, newname,
+ ok_if_already_exists, keep_time, preserve_uid_gid,
+ preserve_permissions);
encoded_file = ENCODE_FILE (file);
encoded_newname = ENCODE_FILE (newname);
/* Discard the unwind protects. */
specpdl_ptr = specpdl + count;
- UNGCPRO;
return Qnil;
}
\f
{
Lisp_Object handler;
Lisp_Object encoded_file;
- struct gcpro gcpro1;
- GCPRO1 (filename);
if (!NILP (Ffile_directory_p (filename))
&& NILP (Ffile_symlink_p (filename)))
xsignal2 (Qfile_error,
build_string ("Removing old name: is a directory"),
filename);
- UNGCPRO;
filename = Fexpand_file_name (filename, Qnil);
handler = Ffind_file_name_handler (filename, Qdelete_file);
(Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
{
Lisp_Object handler;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
Lisp_Object encoded_file, encoded_newname, symlink_target;
symlink_target = encoded_file = encoded_newname = Qnil;
- GCPRO5 (file, newname, encoded_file, encoded_newname, symlink_target);
CHECK_STRING (file);
CHECK_STRING (newname);
file = Fexpand_file_name (file, Qnil);
if (NILP (handler))
handler = Ffind_file_name_handler (newname, Qrename_file);
if (!NILP (handler))
- RETURN_UNGCPRO (call4 (handler, Qrename_file,
- file, newname, ok_if_already_exists));
+ return call4 (handler, Qrename_file,
+ file, newname, ok_if_already_exists);
encoded_file = ENCODE_FILE (file);
encoded_newname = ENCODE_FILE (newname);
else
report_file_errno ("Renaming", list2 (file, newname), rename_errno);
}
- UNGCPRO;
+
return Qnil;
}
{
Lisp_Object handler;
Lisp_Object encoded_file, encoded_newname;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- GCPRO4 (file, newname, encoded_file, encoded_newname);
encoded_file = encoded_newname = Qnil;
CHECK_STRING (file);
CHECK_STRING (newname);
call the corresponding file handler. */
handler = Ffind_file_name_handler (file, Qadd_name_to_file);
if (!NILP (handler))
- RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file,
- newname, ok_if_already_exists));
+ return call4 (handler, Qadd_name_to_file, file,
+ newname, ok_if_already_exists);
/* If the new name has special constructs in it,
call the corresponding file handler. */
handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
if (!NILP (handler))
- RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file,
- newname, ok_if_already_exists));
+ return call4 (handler, Qadd_name_to_file, file,
+ newname, ok_if_already_exists);
encoded_file = ENCODE_FILE (file);
encoded_newname = ENCODE_FILE (newname);
report_file_errno ("Adding new name", list2 (file, newname), link_errno);
}
- UNGCPRO;
return Qnil;
}
{
Lisp_Object handler;
Lisp_Object encoded_target, encoded_linkname;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- GCPRO4 (target, linkname, encoded_target, encoded_linkname);
encoded_target = encoded_linkname = Qnil;
CHECK_STRING (target);
CHECK_STRING (linkname);
call the corresponding file handler. */
handler = Ffind_file_name_handler (target, Qmake_symbolic_link);
if (!NILP (handler))
- RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, target,
- linkname, ok_if_already_exists));
+ return call4 (handler, Qmake_symbolic_link, target,
+ linkname, ok_if_already_exists);
/* If the new link name has special constructs in it,
call the corresponding file handler. */
handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
if (!NILP (handler))
- RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, target,
- linkname, ok_if_already_exists));
+ return call4 (handler, Qmake_symbolic_link, target,
+ linkname, ok_if_already_exists);
encoded_target = ENCODE_FILE (target);
encoded_linkname = ENCODE_FILE (linkname);
unlink (SSDATA (encoded_linkname));
if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname))
>= 0)
- {
- UNGCPRO;
- return Qnil;
- }
+ return Qnil;
}
if (errno == ENOSYS)
- {
- UNGCPRO;
- xsignal1 (Qfile_error,
- build_string ("Symbolic links are not supported"));
- }
+ xsignal1 (Qfile_error,
+ build_string ("Symbolic links are not supported"));
symlink_errno = errno;
report_file_errno ("Making symbolic link", list2 (target, linkname),
symlink_errno);
}
- UNGCPRO;
+
return Qnil;
}
Lisp_Object absname1, absname2;
struct stat st1, st2;
Lisp_Object handler;
- struct gcpro gcpro1, gcpro2;
CHECK_STRING (file1);
CHECK_STRING (file2);
absname1 = Qnil;
- GCPRO2 (absname1, file2);
absname1 = expand_and_dir_to_file (file1, BVAR (current_buffer, directory));
absname2 = expand_and_dir_to_file (file2, BVAR (current_buffer, directory));
- UNGCPRO;
/* If the file name has special constructs in it,
call the corresponding file handler. */
if (!NILP (handler))
return call3 (handler, Qfile_newer_than_file_p, absname1, absname2);
- GCPRO2 (absname1, absname2);
absname1 = ENCODE_FILE (absname1);
absname2 = ENCODE_FILE (absname2);
- UNGCPRO;
if (stat (SSDATA (absname1), &st1) < 0)
return Qnil;
off_t beg_offset, end_offset;
int unprocessed;
ptrdiff_t count = SPECPDL_INDEX ();
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
Lisp_Object handler, val, insval, orig_filename, old_undo;
Lisp_Object p;
ptrdiff_t total = 0;
orig_filename = Qnil;
old_undo = Qnil;
- GCPRO5 (filename, val, p, orig_filename, old_undo);
-
CHECK_STRING (filename);
filename = Fexpand_file_name (filename, Qnil);
bool multibyte
= ! NILP (BVAR (current_buffer, enable_multibyte_characters));
Lisp_Object conversion_buffer;
- struct gcpro gcpro1;
conversion_buffer = code_conversion_save (1, multibyte);
inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */
unprocessed = 0; /* Bytes not processed in previous loop. */
- GCPRO1 (conversion_buffer);
while (1)
{
/* Read at most READ_BUF_SIZE bytes at a time, to allow
if (coding.carryover_bytes > 0)
memcpy (read_buf, coding.carryover, unprocessed);
}
- UNGCPRO;
+
if (this < 0)
report_file_error ("Read error", orig_filename);
emacs_close (fd);
if (NILP (val))
val = list2 (orig_filename, make_number (inserted));
- RETURN_UNGCPRO (unbind_to (count, val));
+ return unbind_to (count, val);
}
\f
static Lisp_Object build_annotations (Lisp_Object, Lisp_Object);
bool visiting = (EQ (visit, Qt) || STRINGP (visit));
bool quietly = !NILP (visit);
bool file_locked = 0;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
struct buffer *given_buffer;
struct coding_system coding;
validate_region (&start, &end);
visit_file = Qnil;
- GCPRO5 (start, filename, visit, visit_file, lockname);
filename = Fexpand_file_name (filename, Qnil);
XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
bset_filename (current_buffer, visit_file);
}
- UNGCPRO;
+
return val;
}
XSETFASTINT (end, ZV);
}
- UNGCPRO;
-
- GCPRO5 (start, filename, annotations, visit_file, lockname);
-
/* Decide the coding-system to encode the data with.
We used to make this choice before calling build_annotations, but that
leads to problems when a write-annotate-function takes care of
int open_errno = errno;
if (file_locked)
unlock_file (lockname);
- UNGCPRO;
report_file_errno ("Opening output file", filename, open_errno);
}
int lseek_errno = errno;
if (file_locked)
unlock_file (lockname);
- UNGCPRO;
report_file_errno ("Lseek error", filename, lseek_errno);
}
}
- UNGCPRO;
-
immediate_quit = 1;
if (STRINGP (start))
{
Lisp_Object annotations;
Lisp_Object p, res;
- struct gcpro gcpro1, gcpro2;
Lisp_Object original_buffer;
int i;
bool used_global = false;
annotations = Qnil;
p = Vwrite_region_annotate_functions;
- GCPRO2 (annotations, p);
while (CONSP (p))
{
struct buffer *given_buffer = current_buffer;
annotations = merge (annotations, res, Qcar_less_than_car);
}
- UNGCPRO;
return annotations;
}
{
Lisp_Object msg;
int i;
- struct gcpro gcpro1;
auto_save_error_occurred = 1;
AUTO_STRING (format, "Auto-saving %s: %s");
msg = CALLN (Fformat, format, BVAR (current_buffer, name),
Ferror_message_string (error_val));
- GCPRO1 (msg);
for (i = 0; i < 3; ++i)
{
Fsleep_for (make_number (1), Qnil);
}
- UNGCPRO;
return Qnil;
}
bool orig_minibuffer_auto_raise = minibuffer_auto_raise;
bool old_message_p = 0;
struct auto_save_unwind auto_save_unwind;
- struct gcpro gcpro1, gcpro2;
if (max_specpdl_size < specpdl_size + 40)
max_specpdl_size = specpdl_size + 40;
oquit = Vquit_flag;
Vquit_flag = Qnil;
- /* No GCPRO needed, because (when it matters) all Lisp_Object variables
- point to non-strings reached from Vbuffer_alist. */
-
hook = intern ("auto-save-hook");
safe_run_hooks (hook);
if (!NILP (Vrun_hooks))
{
Lisp_Object dir;
- dir = Qnil;
- GCPRO2 (dir, listfile);
dir = Ffile_name_directory (listfile);
if (NILP (Ffile_directory_p (dir)))
internal_condition_case_1 (do_auto_save_make_dir,
dir, Qt,
do_auto_save_eh);
- UNGCPRO;
}
stream = emacs_fopen (SSDATA (listfile), "w");
Lisp_Object orig_fn, encoded_fn;
char *lfname;
lock_info_type lock_info;
- struct gcpro gcpro1;
USE_SAFE_ALLOCA;
/* Don't do locking while dumping Emacs.
return;
orig_fn = fn;
- GCPRO1 (fn);
fn = Fexpand_file_name (fn, Qnil);
#ifdef WINDOWSNT
/* Ensure we have only '/' separators, to avoid problems with
}
SAFE_FREE ();
}
-
- UNGCPRO;
}
void
sort_list (Lisp_Object list, Lisp_Object predicate)
{
Lisp_Object front, back;
- register Lisp_Object len, tem;
- struct gcpro gcpro1, gcpro2;
+ Lisp_Object len, tem;
EMACS_INT length;
front = list;
back = Fcdr (tem);
Fsetcdr (tem, Qnil);
- GCPRO2 (front, back);
front = Fsort (front, predicate);
back = Fsort (back, predicate);
- UNGCPRO;
return merge (front, back, predicate);
}
return;
ptrdiff_t halflen = len >> 1;
Lisp_Object *tmp;
- struct gcpro gcpro1, gcpro2;
- GCPRO2 (vector, predicate);
USE_SAFE_ALLOCA;
SAFE_ALLOCA_LISP (tmp, halflen);
for (ptrdiff_t i = 0; i < halflen; i++)
tmp[i] = make_number (0);
sort_vector_inplace (predicate, len, XVECTOR (vector)->contents, tmp);
SAFE_FREE ();
- UNGCPRO;
}
DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
Lisp_Object
merge (Lisp_Object org_l1, Lisp_Object org_l2, Lisp_Object pred)
{
- Lisp_Object value;
- register Lisp_Object tail;
- Lisp_Object tem;
- register Lisp_Object l1, l2;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-
- l1 = org_l1;
- l2 = org_l2;
- tail = Qnil;
- value = Qnil;
-
- /* It is sufficient to protect org_l1 and org_l2.
- When l1 and l2 are updated, we copy the new values
- back into the org_ vars. */
- GCPRO4 (org_l1, org_l2, pred, value);
+ Lisp_Object l1 = org_l1;
+ Lisp_Object l2 = org_l2;
+ Lisp_Object tail = Qnil;
+ Lisp_Object value = Qnil;
while (1)
{
if (NILP (l1))
{
- UNGCPRO;
if (NILP (tail))
return l2;
Fsetcdr (tail, l2);
}
if (NILP (l2))
{
- UNGCPRO;
if (NILP (tail))
return l1;
Fsetcdr (tail, l1);
return value;
}
+
+ Lisp_Object tem;
if (inorder (pred, Fcar (l1), Fcar (l2)))
{
tem = l1;
{
Lisp_Object tail, dummy;
EMACS_INT i;
- struct gcpro gcpro1, gcpro2, gcpro3;
-
- if (vals)
- {
- /* Don't let vals contain any garbage when GC happens. */
- memclear (vals, leni * word_size);
-
- GCPRO3 (dummy, fn, seq);
- gcpro1.var = vals;
- gcpro1.nvars = leni;
- }
- else
- GCPRO2 (fn, seq);
- /* We need not explicitly protect `tail' because it is used only on lists, and
- 1) lists are not relocated and 2) the list is marked via `seq' so will not
- be freed */
if (VECTORP (seq) || COMPILEDP (seq))
{
tail = XCDR (tail);
}
}
-
- UNGCPRO;
}
DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
(Lisp_Object function, Lisp_Object sequence, Lisp_Object separator)
{
Lisp_Object len;
- register EMACS_INT leni;
+ EMACS_INT leni;
EMACS_INT nargs;
ptrdiff_t i;
- register Lisp_Object *args;
- struct gcpro gcpro1;
+ Lisp_Object *args;
Lisp_Object ret;
USE_SAFE_ALLOCA;
SAFE_ALLOCA_LISP (args, nargs);
- GCPRO1 (separator);
mapcar1 (leni, args, function, sequence);
- UNGCPRO;
for (i = leni - 1; i > 0; i--)
args[i + i] = args[i];
}
\f
/* This is how C code calls `yes-or-no-p' and allows the user
- to redefined it.
-
- Anything that calls this function must protect from GC! */
+ to redefine it. */
Lisp_Object
do_yes_or_no_p (Lisp_Object prompt)
return call1 (intern ("yes-or-no-p"), prompt);
}
-/* Anything that calls this function must protect from GC! */
-
DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0,
doc: /* Ask user a yes-or-no question.
Return t if answer is yes, and nil if the answer is no.
(Lisp_Object prompt)
{
Lisp_Object ans;
- struct gcpro gcpro1;
CHECK_STRING (prompt);
redisplay_preserve_echo_area (4);
pane = list2 (Fcons (build_string ("Yes"), Qt),
Fcons (build_string ("No"), Qnil));
- GCPRO1 (pane);
menu = Fcons (prompt, pane);
obj = Fx_popup_dialog (Qt, menu, Qnil);
- UNGCPRO;
return obj;
}
AUTO_STRING (yes_or_no, "(yes or no) ");
prompt = CALLN (Fconcat, prompt, yes_or_no);
- GCPRO1 (prompt);
while (1)
{
Qyes_or_no_p_history, Qnil,
Qnil));
if (SCHARS (ans) == 3 && !strcmp (SSDATA (ans), "yes"))
- {
- UNGCPRO;
- return Qt;
- }
+ return Qt;
if (SCHARS (ans) == 2 && !strcmp (SSDATA (ans), "no"))
- {
- UNGCPRO;
- return Qnil;
- }
+ return Qnil;
Fding (Qnil);
Fdiscard_input ();
(Lisp_Object feature, Lisp_Object filename, Lisp_Object noerror)
{
Lisp_Object tem;
- struct gcpro gcpro1, gcpro2;
bool from_file = load_in_progress;
CHECK_SYMBOL (feature);
Vautoload_queue = Qt;
/* Load the file. */
- GCPRO2 (feature, filename);
tem = Fload (NILP (filename) ? Fsymbol_name (feature) : filename,
noerror, Qt, Qnil, (NILP (filename) ? Qt : Qnil));
- UNGCPRO;
/* If load failed entirely, return nil. */
if (NILP (tem))
usage: (widget-apply WIDGET PROPERTY &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- /* This function can GC. */
- struct gcpro gcpro1, gcpro2;
Lisp_Object widget = args[0];
Lisp_Object property = args[1];
Lisp_Object propval = Fwidget_get (widget, property);
Lisp_Object trailing_args = Flist (nargs - 2, args + 2);
- GCPRO2 (propval, trailing_args);
Lisp_Object result = CALLN (Fapply, propval, widget, trailing_args);
- UNGCPRO;
return result;
}
Lisp_Object v = Fmake_vector (make_number (7), Qnil);
const int days[7] = {DAY_1, DAY_2, DAY_3, DAY_4, DAY_5, DAY_6, DAY_7};
int i;
- struct gcpro gcpro1;
- GCPRO1 (v);
synchronize_system_time_locale ();
for (i = 0; i < 7; i++)
{
ASET (v, i, code_convert_string_norecord (val, Vlocale_coding_system,
0));
}
- UNGCPRO;
return v;
}
#endif /* DAY_1 */
const int months[12] = {MON_1, MON_2, MON_3, MON_4, MON_5, MON_6, MON_7,
MON_8, MON_9, MON_10, MON_11, MON_12};
int i;
- struct gcpro gcpro1;
- GCPRO1 (v);
synchronize_system_time_locale ();
for (i = 0; i < 12; i++)
{
ASET (v, i, code_convert_string_norecord (val, Vlocale_coding_system,
0));
}
- UNGCPRO;
return v;
}
#endif /* MON_1 */
start_of_bucket = hash_code % ASIZE (h->index);
idx = HASH_INDEX (h, start_of_bucket);
- /* We need not gcpro idx since it's either an integer or nil. */
while (!NILP (idx))
{
ptrdiff_t i = XFASTINT (idx);
idx = HASH_INDEX (h, start_of_bucket);
prev = Qnil;
- /* We need not gcpro idx, prev since they're either integers or nil. */
while (!NILP (idx))
{
ptrdiff_t i = XFASTINT (idx);
make_frame (bool mini_p)
{
Lisp_Object frame;
- register struct frame *f;
- register struct window *rw, *mw;
- register Lisp_Object root_window;
- register Lisp_Object mini_window;
+ struct frame *f;
+ struct window *rw, *mw IF_LINT (= NULL);
+ Lisp_Object root_window;
+ Lisp_Object mini_window;
f = allocate_frame ();
XSETFRAME (frame, f);
default (the global minibuffer). */
struct frame *
-make_frame_without_minibuffer (register Lisp_Object mini_window, KBOARD *kb, Lisp_Object display)
+make_frame_without_minibuffer (Lisp_Object mini_window, KBOARD *kb,
+ Lisp_Object display)
{
- register struct frame *f;
- struct gcpro gcpro1;
+ struct frame *f;
if (!NILP (mini_window))
CHECK_LIVE_WINDOW (mini_window);
Lisp_Object frame_dummy;
XSETFRAME (frame_dummy, f);
- GCPRO1 (frame_dummy);
/* If there's no minibuffer frame to use, create one. */
kset_default_minibuffer_frame
(kb, call1 (intern ("make-initial-minibuffer-frame"), display));
- UNGCPRO;
}
mini_window
struct frame *f;
Lisp_Object lispy_dummy;
Lisp_Object x, y, retval;
- struct gcpro gcpro1;
f = SELECTED_FRAME ();
x = y = Qnil;
}
XSETFRAME (lispy_dummy, f);
retval = Fcons (lispy_dummy, Fcons (x, y));
- GCPRO1 (retval);
if (!NILP (Vmouse_position_function))
retval = call1 (Vmouse_position_function, retval);
- RETURN_UNGCPRO (retval);
+ return retval;
}
DEFUN ("mouse-pixel-position", Fmouse_pixel_position,
struct frame *f;
Lisp_Object lispy_dummy;
Lisp_Object x, y, retval;
- struct gcpro gcpro1;
f = SELECTED_FRAME ();
x = y = Qnil;
XSETFRAME (lispy_dummy, f);
retval = Fcons (lispy_dummy, Fcons (x, y));
- GCPRO1 (retval);
if (!NILP (Vmouse_position_function))
retval = call1 (Vmouse_position_function, retval);
- RETURN_UNGCPRO (retval);
+ return retval;
}
#ifdef HAVE_WINDOW_SYSTEM
Lisp_Object alist;
struct frame *f = decode_any_frame (frame);
int height, width;
- struct gcpro gcpro1;
if (!FRAME_LIVE_P (f))
return Qnil;
alist = Fcopy_alist (f->param_alist);
- GCPRO1 (alist);
if (!FRAME_WINDOW_P (f))
{
store_in_alist (&alist, Qmenu_bar_lines, lines);
}
- UNGCPRO;
return alist;
}
/* TAIL and ALIST are not used again below here. */
alist = tail = Qnil;
- /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
- because their values appear in VALUES and strings are not valid. */
top = left = Qunbound;
icon_left = icon_top = Qunbound;
if (default_filename)
{
Lisp_Object file;
- struct gcpro gcpro1;
char *utf8_filename;
- GCPRO1 (file);
file = build_string (default_filename);
gtk_file_chooser_set_current_name (GTK_FILE_CHOOSER (filewin), cp);
}
}
-
- UNGCPRO;
}
*func = xg_get_file_name_from_chooser;
{
int i;
Lisp_Object file, rtl_name;
- struct gcpro gcpro1, gcpro2;
- GCPRO2 (file, rtl_name);
rtl_name = Ffile_name_nondirectory (rtl);
struct window *w;
Lisp_Object old_buffer;
EMACS_INT old_charpos IF_LINT (= 0), old_bytepos IF_LINT (= 0);
- struct gcpro gcpro1;
Lisp_Object lcols;
void *itdata = NULL;
w = decode_live_window (window);
old_buffer = Qnil;
- GCPRO1 (old_buffer);
if (XBUFFER (w->contents) != current_buffer)
{
/* Set the window's buffer temporarily to the current buffer. */
old_charpos, old_bytepos);
}
- RETURN_UNGCPRO (make_number (it.vpos));
+ return make_number (it.vpos);
}
ptrdiff_t nchars, ptrdiff_t nbytes,
bool inherit, bool before_markers)
{
- struct gcpro gcpro1;
ptrdiff_t outgoing_nbytes = nbytes;
INTERVAL intervals;
= count_size_as_multibyte (SDATA (string) + pos_byte,
nbytes);
- GCPRO1 (string);
/* Do this before moving and increasing the gap,
because the before-change hooks might move the gap
or make it smaller. */
move_gap_both (PT, PT_BYTE);
if (GAP_SIZE < outgoing_nbytes)
make_gap (outgoing_nbytes - GAP_SIZE);
- UNGCPRO;
/* Copy the string text into the buffer, perhaps converting
between single-byte and multibyte. */
ptrdiff_t insbytes = SBYTES (new);
ptrdiff_t from_byte, to_byte;
ptrdiff_t nbytes_del, nchars_del;
- struct gcpro gcpro1;
INTERVAL intervals;
ptrdiff_t outgoing_insbytes = insbytes;
Lisp_Object deletion;
check_markers ();
- GCPRO1 (new);
deletion = Qnil;
if (prepare)
to = from + range_length;
}
- UNGCPRO;
-
/* Make args be valid. */
if (from < BEGV)
from = BEGV;
outgoing_insbytes
= count_size_as_multibyte (SDATA (new), insbytes);
- GCPRO1 (new);
-
/* Make sure the gap is somewhere in or next to what we are deleting. */
if (from > GPT)
gap_right (from, from_byte);
MODIFF++;
CHARS_MODIFF = MODIFF;
- UNGCPRO;
signal_after_change (from, nchars_del, GPT - from);
update_compositions (from, GPT, CHECK_BORDER);
{
ptrdiff_t from_byte, to_byte;
Lisp_Object deletion;
- struct gcpro gcpro1;
/* Make args be valid */
if (from < BEGV)
to_byte = CHAR_TO_BYTE (to);
deletion = del_range_2 (from, from_byte, to, to_byte, ret_string);
- GCPRO1 (deletion);
signal_after_change (from, to - from, 0);
update_compositions (from, from, CHECK_HEAD);
- UNGCPRO;
return deletion;
}
if (preserve_ptr)
{
Lisp_Object preserve_marker;
- struct gcpro gcpro1;
preserve_marker = Fcopy_marker (make_number (*preserve_ptr), Qnil);
- GCPRO1 (preserve_marker);
verify_interval_modification (current_buffer, start, end);
*preserve_ptr = marker_position (preserve_marker);
unchain_marker (XMARKER (preserve_marker));
- UNGCPRO;
}
else
verify_interval_modification (current_buffer, start, end);
Lisp_Object start, end;
Lisp_Object start_marker, end_marker;
Lisp_Object preserve_marker;
- struct gcpro gcpro1, gcpro2, gcpro3;
ptrdiff_t count = SPECPDL_INDEX ();
struct rvoe_arg rvoe_arg;
preserve_marker = Qnil;
start_marker = Qnil;
end_marker = Qnil;
- GCPRO3 (preserve_marker, start_marker, end_marker);
specbind (Qinhibit_modification_hooks, Qt);
if (! NILP (end_marker))
free_marker (end_marker);
RESTORE_VALUE;
- UNGCPRO;
unbind_to (count, Qnil);
}
void
safe_run_hooks (Lisp_Object hook)
{
- struct gcpro gcpro1;
ptrdiff_t count = SPECPDL_INDEX ();
- GCPRO1 (hook);
specbind (Qinhibit_quit, Qt);
run_hook_with_args (2, ((Lisp_Object []) {hook, hook}), safe_run_hook_funcall);
unbind_to (count, Qnil);
- UNGCPRO;
}
\f
if (single_kboard)
goto start;
current_kboard = kb;
- /* This is going to exit from read_char
- so we had better get rid of this frame's stuff. */
return make_number (-2);
}
volatile Lisp_Object previous_echo_area_message;
volatile Lisp_Object also_record;
volatile bool reread, recorded;
- struct gcpro gcpro1, gcpro2;
bool volatile polling_stopped_here = false;
struct kboard *orig_kboard = current_kboard;
c = Qnil;
previous_echo_area_message = Qnil;
- GCPRO2 (c, previous_echo_area_message);
-
retry:
recorded = false;
XSETCDR (last, list1 (c));
kb->kbd_queue_has_data = true;
current_kboard = kb;
- /* This is going to exit from read_char
- so we had better get rid of this frame's stuff. */
- UNGCPRO;
return make_number (-2); /* wrong_kboard_jmpbuf */
}
}
interpret the next key sequence using the wrong translation
tables and function keymaps. */
if (NILP (c) && current_kboard != orig_kboard)
- {
- UNGCPRO;
- return make_number (-2); /* wrong_kboard_jmpbuf */
- }
+ return make_number (-2); /* wrong_kboard_jmpbuf */
/* If this has become non-nil here, it has been set by a timer
or sentinel or filter. */
if (kb->kbd_queue_has_data)
{
current_kboard = kb;
- /* This is going to exit from read_char
- so we had better get rid of this frame's stuff. */
- UNGCPRO;
return make_number (-2); /* wrong_kboard_jmpbuf */
}
}
}
if (EQ (c, make_number (-2)))
- {
- /* This is going to exit from read_char
- so we had better get rid of this frame's stuff. */
- UNGCPRO;
- return c;
- }
+ return c;
}
non_reread:
ptrdiff_t key_count;
bool key_count_reset;
ptrdiff_t command_key_start;
- struct gcpro gcpro1;
ptrdiff_t count = SPECPDL_INDEX ();
/* Save the echo status. */
keys = Fcopy_sequence (this_command_keys);
else
keys = Qnil;
- GCPRO1 (keys);
/* Clear out this_command_keys. */
this_command_key_count = 0;
if (saved_immediate_echo)
echo_now ();
- UNGCPRO;
-
/* The input method can return no events. */
if (! CONSP (tem))
{
exit:
RESUME_POLLING;
input_was_pending = input_pending;
- RETURN_UNGCPRO (c);
+ return c;
}
/* Record a key that came from a mouse menu.
struct timespec now;
struct timespec idleness_now;
Lisp_Object chosen_timer;
- struct gcpro gcpro1;
nexttime = invalid_timespec ();
chosen_timer = Qnil;
- GCPRO1 (chosen_timer);
/* First run the code that was delayed. */
while (CONSP (pending_funcalls))
/* When we encounter a timer that is still waiting,
return the amount of time to wait before it is ripe. */
{
- UNGCPRO;
return difference;
}
}
/* No timers are pending in the future. */
/* Return 0 if we generated an event, and -1 if not. */
- UNGCPRO;
return nexttime;
}
{
struct timespec nexttime;
Lisp_Object timers, idle_timers;
- struct gcpro gcpro1, gcpro2;
Lisp_Object tem = Vinhibit_quit;
Vinhibit_quit = Qt;
Vinhibit_quit = tem;
- GCPRO2 (timers, idle_timers);
-
do
{
nexttime = timer_check_2 (timers, idle_timers);
}
while (nexttime.tv_sec == 0 && nexttime.tv_nsec == 0);
- UNGCPRO;
return nexttime;
}
static void
menu_bar_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy1, void *dummy2)
{
- struct gcpro gcpro1;
int i;
bool parsed;
Lisp_Object tem;
/* We add to menu_bar_one_keymap_changed_items before doing the
parse_menu_item, so that if it turns out it wasn't a menu item,
it still correctly hides any further menu item. */
- GCPRO1 (key);
parsed = parse_menu_item (item, 1);
- UNGCPRO;
if (!parsed)
return;
process_tool_bar_item (Lisp_Object key, Lisp_Object def, Lisp_Object data, void *args)
{
int i;
- struct gcpro gcpro1, gcpro2;
-
- /* Protect KEY and DEF from GC because parse_tool_bar_item may call
- eval. */
- GCPRO2 (key, def);
if (EQ (def, Qundefined))
{
/* Append a new tool bar item to tool_bar_items_vector. Accept
more than one definition for the same key. */
append_tool_bar_item ();
-
- UNGCPRO;
}
/* Access slot with index IDX of vector tool_bar_item_properties. */
next = call1 (next, prompt);
/* If the function returned something invalid,
- barf--don't ignore it.
- (To ignore it safely, we would need to gcpro a bunch of
- other variables.) */
+ barf--don't ignore it. */
if (! (NILP (next) || VECTORP (next) || STRINGP (next)))
error ("Function %s returns invalid key sequence",
SSDATA (SYMBOL_NAME (tem)));
/* List of events for which a fake prefix key has been generated. */
Lisp_Object fake_prefixed_keys = Qnil;
- struct gcpro gcpro1;
-
- GCPRO1 (fake_prefixed_keys);
raw_keybuf_count = 0;
last_nonmenu_event = Qnil;
if (EQ (key, Qt))
{
unbind_to (count, Qnil);
- UNGCPRO;
return -1;
}
Scan from indec.end until we find a bound suffix. */
while (indec.end < t)
{
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
bool done;
int diff;
- GCPRO4 (indec.map, fkey.map, keytran.map, delayed_switch_frame);
done = keyremap_step (keybuf, bufsize, &indec, max (t, mock_input),
1, &diff, prompt);
- UNGCPRO;
if (done)
{
mock_input = diff + max (t, mock_input);
/* Continue scan from fkey.end until we find a bound suffix. */
while (fkey.end < indec.start)
{
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
bool done;
int diff;
- GCPRO4 (indec.map, fkey.map, keytran.map, delayed_switch_frame);
done = keyremap_step (keybuf, bufsize, &fkey,
max (t, mock_input),
/* If there's a binding (i.e.
fkey.end + 1 == t
&& (test_undefined (current_binding)),
&diff, prompt);
- UNGCPRO;
if (done)
{
mock_input = diff + max (t, mock_input);
Scan from keytran.end until we find a bound suffix. */
while (keytran.end < fkey.start)
{
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
bool done;
int diff;
- GCPRO4 (indec.map, fkey.map, keytran.map, delayed_switch_frame);
done = keyremap_step (keybuf, bufsize, &keytran, max (t, mock_input),
1, &diff, prompt);
- UNGCPRO;
if (done)
{
mock_input = diff + max (t, mock_input);
add_command_key (keybuf[t]);
}
- UNGCPRO;
return t;
}
Lisp_Object cmd_loop, bool allow_string)
{
Lisp_Object keybuf[30];
- register int i;
- struct gcpro gcpro1;
+ int i;
ptrdiff_t count = SPECPDL_INDEX ();
if (!NILP (prompt))
specbind (Qinput_method_use_echo_area,
(NILP (cmd_loop) ? Qt : Qnil));
- memset (keybuf, 0, sizeof keybuf);
- GCPRO1 (keybuf[0]);
- gcpro1.nvars = ARRAYELTS (keybuf);
-
if (NILP (continue_echo))
{
this_command_key_count = 0;
Vquit_flag = Qt;
QUIT;
}
- UNGCPRO;
+
return unbind_to (count,
((allow_string ? make_event_array : Fvector)
(i, keybuf)));
ptrdiff_t count = SPECPDL_INDEX ();
int old_height, old_width;
int width, height;
- struct gcpro gcpro1;
if (tty_list && tty_list->next)
error ("There are other tty frames open; close them before suspending Emacs");
run_hook (intern ("suspend-hook"));
- GCPRO1 (stuffstring);
get_tty_size (fileno (CURTTY ()->input), &old_width, &old_height);
reset_all_sys_modes ();
/* sys_suspend can get an error if it tries to fork a subshell
run_hook (intern ("suspend-resume-hook"));
- UNGCPRO;
return Qnil;
}
if (immediate_quit && NILP (Vinhibit_quit))
{
struct gl_state_s saved;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
immediate_quit = false;
pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
saved = gl_state;
- GCPRO4 (saved.object, saved.global_code,
- saved.current_syntax_table, saved.old_prop);
Fsignal (Qquit, Qnil);
gl_state = saved;
- UNGCPRO;
}
else
{ /* Else request quit when it's safe. */
{
if (autoload)
{
- struct gcpro gcpro1, gcpro2;
-
- GCPRO2 (tem, object);
Fautoload_do_load (tem, object, Qnil);
- UNGCPRO;
-
goto autoload_retry;
}
else
(Lisp_Object keymap, Lisp_Object parent)
{
Lisp_Object list, prev;
- struct gcpro gcpro1, gcpro2;
/* Flush any reverse-map cache. */
where_is_cache = Qnil; where_is_cache_keymaps = Qt;
- GCPRO2 (keymap, parent);
keymap = get_keymap (keymap, 1, 1);
if (!NILP (parent))
{
CHECK_IMPURE (prev);
XSETCDR (prev, parent);
- RETURN_UNGCPRO (parent);
+ return parent;
}
prev = list;
}
{
/* See if there is a meta-map. If there's none, there is
no binding for IDX, unless a default binding exists in MAP. */
- struct gcpro gcpro1;
Lisp_Object event_meta_binding, event_meta_map;
- GCPRO1 (map);
/* A strange value in which Meta is set would cause
infinite recursion. Protect against that. */
if (XINT (meta_prefix_char) & CHAR_META)
event_meta_binding = access_keymap_1 (map, meta_prefix_char, t_ok,
noinherit, autoload);
event_meta_map = get_keymap (event_meta_binding, 0, autoload);
- UNGCPRO;
if (CONSP (event_meta_map))
{
map = event_meta_map;
Lisp_Object t_binding = Qunbound;
Lisp_Object retval = Qunbound;
Lisp_Object retval_tail = Qnil;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-
- GCPRO4 (tail, idx, t_binding, retval);
for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
(CONSP (tail)
}
QUIT;
}
- UNGCPRO;
+
return EQ (Qunbound, retval) ? get_keyelt (t_binding, autoload) : retval;
}
}
Lisp_Object args,
void *data)
{
- struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object tail
= (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
- GCPRO3 (map, args, tail);
for (; CONSP (tail) && !EQ (Qkeymap, XCAR (tail)); tail = XCDR (tail))
{
Lisp_Object binding = XCAR (tail);
make_save_funcptr_ptr_obj ((voidfuncptr) fun, data,
args));
}
- UNGCPRO;
+
return tail;
}
map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args,
void *data, bool autoload)
{
- struct gcpro gcpro1;
- GCPRO1 (args);
map = get_keymap (map, 1, autoload);
while (CONSP (map))
{
if (!CONSP (map))
map = get_keymap (map, 0, autoload);
}
- UNGCPRO;
}
/* Same as map_keymap, but does it right, properly eliminating duplicate
void
map_keymap_canonical (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *data)
{
- struct gcpro gcpro1;
- GCPRO1 (args);
/* map_keymap_canonical may be used from redisplay (e.g. when building menus)
so be careful to ignore errors and to inhibit redisplay. */
map = safe_call1 (Qkeymap_canonicalize, map);
/* No need to use `map_keymap' here because canonical map has no parent. */
map_keymap_internal (map, fun, args, data);
- UNGCPRO;
}
DEFUN ("map-keymap-internal", Fmap_keymap_internal, Smap_keymap_internal, 2, 2, 0,
If KEYMAP has a parent, this function returns it without processing it. */)
(Lisp_Object function, Lisp_Object keymap)
{
- struct gcpro gcpro1;
- GCPRO1 (function);
keymap = get_keymap (keymap, 1, 1);
keymap = map_keymap_internal (keymap, map_keymap_call, function, NULL);
- UNGCPRO;
return keymap;
}
bool metized = 0;
int meta_bit;
ptrdiff_t length;
- struct gcpro gcpro1, gcpro2, gcpro3;
- GCPRO3 (keymap, key, def);
keymap = get_keymap (keymap, 1, 1);
length = CHECK_VECTOR_OR_STRING (key);
if (length == 0)
- RETURN_UNGCPRO (Qnil);
+ return Qnil;
if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
message_with_string ("Key sequence contains invalid event %s", c, 1);
if (idx == length)
- RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
+ return store_in_keymap (keymap, c, def);
cmd = access_keymap (keymap, c, 0, 1, 1);
Lisp_Object c;
ptrdiff_t length;
bool t_ok = !NILP (accept_default);
- struct gcpro gcpro1, gcpro2;
- GCPRO2 (keymap, key);
keymap = get_keymap (keymap, 1, 1);
length = CHECK_VECTOR_OR_STRING (key);
if (length == 0)
- RETURN_UNGCPRO (keymap);
+ return keymap;
idx = 0;
while (1)
cmd = access_keymap (keymap, c, t_ok, 0, 1);
if (idx == length)
- RETURN_UNGCPRO (cmd);
+ return cmd;
keymap = get_keymap (cmd, 0, 1);
if (!CONSP (keymap))
- RETURN_UNGCPRO (make_number (idx));
+ return make_number (idx);
QUIT;
}
int nmaps;
Lisp_Object binding;
int i, j;
- struct gcpro gcpro1, gcpro2;
nmaps = current_minor_maps (&modes, &maps);
- /* Note that all these maps are GCPRO'd
- in the places where we found them. */
binding = Qnil;
- GCPRO2 (key, binding);
for (i = j = 0; i < nmaps; i++)
if (!NILP (maps[i])
if (KEYMAPP (binding))
maps[j++] = Fcons (modes[i], binding);
else if (j == 0)
- RETURN_UNGCPRO (list1 (Fcons (modes[i], binding)));
+ return list1 (Fcons (modes[i], binding));
}
- UNGCPRO;
return Flist (j, maps);
}
Lisp_Object maps, tail;
EMACS_INT prefixlen = XFASTINT (Flength (prefix));
- /* no need for gcpro because we don't autoload any keymaps. */
-
if (!NILP (prefix))
{
/* If a prefix was specified, start with the keymap (if any) for
Lisp_Object found = Qnil;
/* 1 means ignore all menu bindings entirely. */
bool nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
/* List of sequences found via remapping. Keep them in a separate
variable, so as to push them later, since we prefer
non-remapped binding. */
else
keymaps = Fcurrent_active_maps (Qnil, Qnil);
- GCPRO6 (definition, keymaps, found, sequences, remapped_sequences, tem);
-
tem = Fcommand_remapping (definition, Qnil, keymaps);
/* If `definition' is remapped to tem', then OT1H no key will run
that command (since they will run `tem' instead), so we should
/* We have a list of advertised bindings. */
while (CONSP (tem))
if (EQ (shadow_lookup (keymaps, XCAR (tem), Qnil, 0), definition))
- RETURN_UNGCPRO (XCAR (tem));
+ return XCAR (tem);
else
tem = XCDR (tem);
if (EQ (shadow_lookup (keymaps, tem, Qnil, 0), definition))
- RETURN_UNGCPRO (tem);
+ return tem;
}
sequences = Freverse (where_is_internal (definition, keymaps,
nil, then we should return the first ascii-only binding
we find. */
if (EQ (firstonly, Qnon_ascii))
- RETURN_UNGCPRO (sequence);
+ return sequence;
else if (!NILP (firstonly)
&& 2 == preferred_sequence_p (sequence))
- RETURN_UNGCPRO (sequence);
+ return sequence;
}
- UNGCPRO;
-
found = Fnreverse (found);
/* firstonly may have been t, but we may have gone all the way through
Lisp_Object outbuf, shadow;
bool nomenu = NILP (menus);
Lisp_Object start1;
- struct gcpro gcpro1;
const char *alternate_heading
= "\
CHECK_BUFFER (buffer);
shadow = Qnil;
- GCPRO1 (shadow);
-
outbuf = Fcurrent_buffer ();
/* Report on alternates for keys. */
describe_map_tree (KVAR (current_kboard, Vinput_decode_map), 0, Qnil, prefix,
"\f\nInput decoding map translations", nomenu, 1, 0, 0);
- UNGCPRO;
return Qnil;
}
bool transl, bool always_title, bool mention_shadow)
{
Lisp_Object maps, orig_maps, seen, sub_shadows;
- struct gcpro gcpro1, gcpro2, gcpro3;
bool something = 0;
const char *key_heading
= "\
orig_maps = maps = Faccessible_keymaps (startmap, prefix);
seen = Qnil;
sub_shadows = Qnil;
- GCPRO3 (maps, seen, sub_shadows);
if (nomenu)
{
if (something)
insert_string ("\n");
-
- UNGCPRO;
}
static int previous_description_column;
Lisp_Object suppress;
Lisp_Object kludge;
bool first = 1;
- struct gcpro gcpro1, gcpro2, gcpro3;
/* These accumulate the values from sparse keymap bindings,
so we can sort them and handle them in order. */
kludge = Fmake_vector (make_number (1), Qnil);
definition = Qnil;
- GCPRO3 (prefix, definition, kludge);
-
map = call1 (Qkeymap_canonicalize, map);
for (tail = map; CONSP (tail); tail = XCDR (tail))
}
SAFE_FREE ();
- UNGCPRO;
}
static void
Lisp_Object suppress;
Lisp_Object kludge;
bool first = 1;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
/* Range of elements to be handled. */
int from, to, stop;
Lisp_Object character;
that is done once per vector element, we don't want to cons up a
fresh vector every time. */
kludge = Fmake_vector (make_number (1), Qnil);
- GCPRO4 (elt_prefix, prefix, definition, kludge);
if (partial)
suppress = intern ("suppress-keymap");
insert ("default", 7);
(*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
}
-
- UNGCPRO;
}
\f
/* Apropos - finding all symbols whose names match a regexp. */
/* Most global vars are reset to their value via the specpdl mechanism,
but a few others are handled by storing their value here. */
-#if true /* GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS, but defined later. */
- struct gcpro *gcpro;
-#endif
sys_jmp_buf jmp;
EMACS_INT lisp_eval_depth;
ptrdiff_t pdlcount;
(c)->pdlcount = SPECPDL_INDEX (); \
(c)->poll_suppress_count = poll_suppress_count; \
(c)->interrupt_input_blocked = interrupt_input_blocked;\
- (c)->gcpro = gcprolist; \
(c)->byte_stack = byte_stack_list; \
handlerlist = (c);
extern Lisp_Object Vascii_downcase_table;
extern Lisp_Object Vascii_canon_table;
\f
-/* Structure for recording stack slots that need marking. */
-
-/* This is a chain of structures, each of which points at a Lisp_Object
- variable whose value should be marked in garbage collection.
- Normally every link of the chain is an automatic variable of a function,
- and its `val' points to some argument or local variable of the function.
- On exit to the function, the chain is set back to the value it had on entry.
- This way, no link remains in the chain when the stack frame containing the
- link disappears.
-
- Every function that can call Feval must protect in this fashion all
- Lisp_Object variables whose contents will be used again. */
-
-extern struct gcpro *gcprolist;
-
-struct gcpro
-{
- struct gcpro *next;
-
- /* Address of first protected variable. */
- volatile Lisp_Object *var;
-
- /* Number of consecutive protected variables. */
- ptrdiff_t nvars;
-
-#ifdef DEBUG_GCPRO
- /* File name where this record is used. */
- const char *name;
-
- /* Line number in this file. */
- int lineno;
-
- /* Index in the local chain of records. */
- int idx;
-
- /* Nesting level. */
- int level;
-#endif
-};
-
-/* Values of GC_MARK_STACK during compilation:
-
- 0 Use GCPRO as before
- 1 Do the real thing, make GCPROs and UNGCPRO no-ops.
- 2 Mark the stack, and check that everything GCPRO'd is
- marked.
- 3 Mark using GCPRO's, mark stack last, and count how many
- dead objects are kept alive.
-
- Formerly, method 0 was used. Currently, method 1 is used unless
- otherwise specified by hand when building, e.g.,
- "make CPPFLAGS='-DGC_MARK_STACK=GC_USE_GCPROS_AS_BEFORE'".
- Methods 2 and 3 are present mainly to debug the transition from 0 to 1. */
-
-#define GC_USE_GCPROS_AS_BEFORE 0
-#define GC_MAKE_GCPROS_NOOPS 1
-#define GC_MARK_STACK_CHECK_GCPROS 2
-#define GC_USE_GCPROS_CHECK_ZOMBIES 3
-
-#ifndef GC_MARK_STACK
-#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS
-#endif
-
-/* Whether we do the stack marking manually. */
-#define BYTE_MARK_STACK !(GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
- || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS)
-
-
-#if GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS
-
-/* Do something silly with gcproN vars just so gcc shuts up. */
-/* You get warnings from MIPSPro... */
-
-#define GCPRO1(varname) ((void) gcpro1)
-#define GCPRO2(varname1, varname2) ((void) gcpro2, (void) gcpro1)
-#define GCPRO3(varname1, varname2, varname3) \
- ((void) gcpro3, (void) gcpro2, (void) gcpro1)
-#define GCPRO4(varname1, varname2, varname3, varname4) \
- ((void) gcpro4, (void) gcpro3, (void) gcpro2, (void) gcpro1)
-#define GCPRO5(varname1, varname2, varname3, varname4, varname5) \
- ((void) gcpro5, (void) gcpro4, (void) gcpro3, (void) gcpro2, (void) gcpro1)
-#define GCPRO6(varname1, varname2, varname3, varname4, varname5, varname6) \
- ((void) gcpro6, (void) gcpro5, (void) gcpro4, (void) gcpro3, (void) gcpro2, \
- (void) gcpro1)
-#define GCPRO7(a, b, c, d, e, f, g) (GCPRO6 (a, b, c, d, e, f), (void) gcpro7)
-#define UNGCPRO ((void) 0)
-
-#else /* GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS */
-
-#ifndef DEBUG_GCPRO
-
-#define GCPRO1(a) \
- { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
- gcprolist = &gcpro1; }
-
-#define GCPRO2(a, b) \
- { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
- gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
- gcprolist = &gcpro2; }
-
-#define GCPRO3(a, b, c) \
- { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
- gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
- gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
- gcprolist = &gcpro3; }
-
-#define GCPRO4(a, b, c, d) \
- { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
- gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
- gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
- gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \
- gcprolist = &gcpro4; }
-
-#define GCPRO5(a, b, c, d, e) \
- { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
- gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
- gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
- gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \
- gcpro5.next = &gcpro4; gcpro5.var = &(e); gcpro5.nvars = 1; \
- gcprolist = &gcpro5; }
-
-#define GCPRO6(a, b, c, d, e, f) \
- { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
- gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
- gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
- gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \
- gcpro5.next = &gcpro4; gcpro5.var = &(e); gcpro5.nvars = 1; \
- gcpro6.next = &gcpro5; gcpro6.var = &(f); gcpro6.nvars = 1; \
- gcprolist = &gcpro6; }
-
-#define GCPRO7(a, b, c, d, e, f, g) \
- { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
- gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
- gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
- gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \
- gcpro5.next = &gcpro4; gcpro5.var = &(e); gcpro5.nvars = 1; \
- gcpro6.next = &gcpro5; gcpro6.var = &(f); gcpro6.nvars = 1; \
- gcpro7.next = &gcpro6; gcpro7.var = &(g); gcpro7.nvars = 1; \
- gcprolist = &gcpro7; }
-
-#define UNGCPRO (gcprolist = gcpro1.next)
-
-#else /* !DEBUG_GCPRO */
-
-extern int gcpro_level;
-
-#define GCPRO1(a) \
- { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
- gcpro1.name = __FILE__; gcpro1.lineno = __LINE__; gcpro1.idx = 1; \
- gcpro1.level = gcpro_level++; \
- gcprolist = &gcpro1; }
-
-#define GCPRO2(a, b) \
- { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
- gcpro1.name = __FILE__; gcpro1.lineno = __LINE__; gcpro1.idx = 1; \
- gcpro1.level = gcpro_level; \
- gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
- gcpro2.name = __FILE__; gcpro2.lineno = __LINE__; gcpro2.idx = 2; \
- gcpro2.level = gcpro_level++; \
- gcprolist = &gcpro2; }
-
-#define GCPRO3(a, b, c) \
- { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
- gcpro1.name = __FILE__; gcpro1.lineno = __LINE__; gcpro1.idx = 1; \
- gcpro1.level = gcpro_level; \
- gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
- gcpro2.name = __FILE__; gcpro2.lineno = __LINE__; gcpro2.idx = 2; \
- gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
- gcpro3.name = __FILE__; gcpro3.lineno = __LINE__; gcpro3.idx = 3; \
- gcpro3.level = gcpro_level++; \
- gcprolist = &gcpro3; }
-
-#define GCPRO4(a, b, c, d) \
- { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
- gcpro1.name = __FILE__; gcpro1.lineno = __LINE__; gcpro1.idx = 1; \
- gcpro1.level = gcpro_level; \
- gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
- gcpro2.name = __FILE__; gcpro2.lineno = __LINE__; gcpro2.idx = 2; \
- gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
- gcpro3.name = __FILE__; gcpro3.lineno = __LINE__; gcpro3.idx = 3; \
- gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \
- gcpro4.name = __FILE__; gcpro4.lineno = __LINE__; gcpro4.idx = 4; \
- gcpro4.level = gcpro_level++; \
- gcprolist = &gcpro4; }
-
-#define GCPRO5(a, b, c, d, e) \
- { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
- gcpro1.name = __FILE__; gcpro1.lineno = __LINE__; gcpro1.idx = 1; \
- gcpro1.level = gcpro_level; \
- gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
- gcpro2.name = __FILE__; gcpro2.lineno = __LINE__; gcpro2.idx = 2; \
- gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
- gcpro3.name = __FILE__; gcpro3.lineno = __LINE__; gcpro3.idx = 3; \
- gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \
- gcpro4.name = __FILE__; gcpro4.lineno = __LINE__; gcpro4.idx = 4; \
- gcpro5.next = &gcpro4; gcpro5.var = &(e); gcpro5.nvars = 1; \
- gcpro5.name = __FILE__; gcpro5.lineno = __LINE__; gcpro5.idx = 5; \
- gcpro5.level = gcpro_level++; \
- gcprolist = &gcpro5; }
-
-#define GCPRO6(a, b, c, d, e, f) \
- { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
- gcpro1.name = __FILE__; gcpro1.lineno = __LINE__; gcpro1.idx = 1; \
- gcpro1.level = gcpro_level; \
- gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
- gcpro2.name = __FILE__; gcpro2.lineno = __LINE__; gcpro2.idx = 2; \
- gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
- gcpro3.name = __FILE__; gcpro3.lineno = __LINE__; gcpro3.idx = 3; \
- gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \
- gcpro4.name = __FILE__; gcpro4.lineno = __LINE__; gcpro4.idx = 4; \
- gcpro5.next = &gcpro4; gcpro5.var = &(e); gcpro5.nvars = 1; \
- gcpro5.name = __FILE__; gcpro5.lineno = __LINE__; gcpro5.idx = 5; \
- gcpro6.next = &gcpro5; gcpro6.var = &(f); gcpro6.nvars = 1; \
- gcpro6.name = __FILE__; gcpro6.lineno = __LINE__; gcpro6.idx = 6; \
- gcpro6.level = gcpro_level++; \
- gcprolist = &gcpro6; }
-
-#define GCPRO7(a, b, c, d, e, f, g) \
- { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
- gcpro1.name = __FILE__; gcpro1.lineno = __LINE__; gcpro1.idx = 1; \
- gcpro1.level = gcpro_level; \
- gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
- gcpro2.name = __FILE__; gcpro2.lineno = __LINE__; gcpro2.idx = 2; \
- gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
- gcpro3.name = __FILE__; gcpro3.lineno = __LINE__; gcpro3.idx = 3; \
- gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \
- gcpro4.name = __FILE__; gcpro4.lineno = __LINE__; gcpro4.idx = 4; \
- gcpro5.next = &gcpro4; gcpro5.var = &(e); gcpro5.nvars = 1; \
- gcpro5.name = __FILE__; gcpro5.lineno = __LINE__; gcpro5.idx = 5; \
- gcpro6.next = &gcpro5; gcpro6.var = &(f); gcpro6.nvars = 1; \
- gcpro6.name = __FILE__; gcpro6.lineno = __LINE__; gcpro6.idx = 6; \
- gcpro7.next = &gcpro6; gcpro7.var = &(g); gcpro7.nvars = 1; \
- gcpro7.name = __FILE__; gcpro7.lineno = __LINE__; gcpro7.idx = 7; \
- gcpro7.level = gcpro_level++; \
- gcprolist = &gcpro7; }
-
-#define UNGCPRO \
- (--gcpro_level != gcpro1.level \
- ? emacs_abort () \
- : (void) (gcprolist = gcpro1.next))
-
-#endif /* DEBUG_GCPRO */
-#endif /* GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS */
-
-
-/* Evaluate expr, UNGCPRO, and then return the value of expr. */
-#define RETURN_UNGCPRO(expr) \
- do \
- { \
- Lisp_Object ret_ungc_val; \
- ret_ungc_val = (expr); \
- UNGCPRO; \
- return ret_ungc_val; \
- } \
- while (false)
-
/* Call staticpro (&var) to protect static variable `var'. */
void staticpro (Lisp_Object *);
extern void syms_of_alloc (void);
extern struct buffer * allocate_buffer (void);
extern int valid_lisp_object_p (Lisp_Object);
-extern int relocatable_string_data_p (const char *);
#ifdef GC_CHECK_CONS_LIST
extern void check_cons_list (void);
#else
/* Defined in bytecode.c. */
extern void syms_of_bytecode (void);
extern struct byte_stack *byte_stack_list;
-#if BYTE_MARK_STACK
-extern void mark_byte_stack (void);
-#endif
-extern void unmark_byte_stack (void);
+extern void relocate_byte_stack (void);
extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, ptrdiff_t, Lisp_Object *);
# define USE_STACK_LISP_OBJECTS true
#endif
-/* USE_STACK_LISP_OBJECTS requires GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS. */
-
-#if GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS
-# undef USE_STACK_LISP_OBJECTS
-# define USE_STACK_LISP_OBJECTS false
-#endif
-
#ifdef GC_CHECK_STRING_BYTES
enum { defined_GC_CHECK_STRING_BYTES = true };
#else
int fd;
int fd_index;
ptrdiff_t count = SPECPDL_INDEX ();
- struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object found, efound, hist_file_name;
/* True means we printed the ".el is newer" message. */
bool newer = 0;
if (!NILP (handler))
return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
- /* Do this after the handler to avoid
- the need to gcpro noerror, nomessage and nosuffix.
- (Below here, we care only whether they are nil or not.)
- The presence of this call is the result of a historical accident:
+ /* The presence of this call is the result of a historical accident:
it used to be in every file-operation and when it got removed
everywhere, it accidentally stayed here. Since then, enough people
supposedly have things like (load "$PROJECT/foo.el") in their .emacs
{
Lisp_Object suffixes;
found = Qnil;
- GCPRO2 (file, found);
if (! NILP (must_suffix))
{
}
fd = openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer);
- UNGCPRO;
}
if (fd == -1)
struct stat s1, s2;
int result;
- GCPRO3 (file, found, hist_file_name);
-
if (version < 0
&& ! (version = safe_to_load_version (fd)))
{
}
}
} /* !load_prefer_newer */
- UNGCPRO;
}
}
else
}
}
- GCPRO3 (file, found, hist_file_name);
-
if (fd < 0)
{
/* We somehow got here with fd == -2, meaning the file is deemed
if (!NILP (Ffboundp (Qdo_after_load_evaluation)))
call1 (Qdo_after_load_evaluation, hist_file_name) ;
- UNGCPRO;
-
xfree (saved_doc_string);
saved_doc_string = 0;
saved_doc_string_size = 0;
bool absolute;
ptrdiff_t want_length;
Lisp_Object filename;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6, gcpro7;
Lisp_Object string, tail, encoded_fn, save_string;
ptrdiff_t max_suffix_len = 0;
int last_errno = ENOENT;
}
string = filename = encoded_fn = save_string = Qnil;
- GCPRO7 (str, string, save_string, filename, path, suffixes, encoded_fn);
if (storeptr)
*storeptr = Qnil;
if (storeptr)
*storeptr = string;
SAFE_FREE ();
- UNGCPRO;
return -2;
}
}
if (storeptr)
*storeptr = string;
SAFE_FREE ();
- UNGCPRO;
return fd;
}
}
if (storeptr)
*storeptr = save_string;
SAFE_FREE ();
- UNGCPRO;
return save_fd;
}
}
}
SAFE_FREE ();
- UNGCPRO;
errno = last_errno;
return -1;
}
val = call2 (macroexpand, val, Qnil);
if (EQ (CAR_SAFE (val), Qprogn))
{
- struct gcpro gcpro1;
Lisp_Object subforms = XCDR (val);
- GCPRO1 (subforms);
for (val = Qnil; CONSP (subforms); subforms = XCDR (subforms))
val = readevalloop_eager_expand_eval (XCAR (subforms),
macroexpand);
- UNGCPRO;
}
else
val = eval_sub (call2 (macroexpand, val, Qt));
Lisp_Object unibyte, Lisp_Object readfun,
Lisp_Object start, Lisp_Object end)
{
- register int c;
- register Lisp_Object val;
+ int c;
+ Lisp_Object val;
ptrdiff_t count = SPECPDL_INDEX ();
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
struct buffer *b = 0;
bool continue_reading_p;
Lisp_Object lex_bound;
if (! NILP (start) && !b)
emacs_abort ();
- specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */
+ specbind (Qstandard_input, readcharfun);
specbind (Qcurrent_load_list, Qnil);
record_unwind_protect_int (readevalloop_1, load_convert_to_unibyte);
load_convert_to_unibyte = !NILP (unibyte);
(NILP (lex_bound) || EQ (lex_bound, Qunbound)
? Qnil : list1 (Qt)));
- GCPRO4 (sourcename, readfun, start, end);
-
/* Try to ensure sourcename is a truename, except whilst preloading. */
if (NILP (Vpurify_flag)
&& !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename))
build_load_history (sourcename,
stream || whole_buffer);
- UNGCPRO;
-
unbind_to (count, Qnil);
}
if (c == '(')
{
Lisp_Object tmp;
- struct gcpro gcpro1;
int ch;
/* Read the string itself. */
tmp = read1 (readcharfun, &ch, 0);
if (ch != 0 || !STRINGP (tmp))
invalid_syntax ("#");
- GCPRO1 (tmp);
/* Read the intervals and their properties. */
while (1)
{
invalid_syntax ("Invalid string property list");
Fset_text_properties (beg, end, plist, tmp);
}
- UNGCPRO;
+
return tmp;
}
{
Lisp_Object val, tail;
Lisp_Object elt, tem;
- struct gcpro gcpro1, gcpro2;
/* 0 is the normal case.
1 means this list is a doc reference; replace it with the number 0.
2 means this list is a doc reference; replace it with the doc string. */
while (1)
{
int ch;
- GCPRO2 (val, tail);
elt = read1 (readcharfun, &ch, first_in_list);
- UNGCPRO;
first_in_list = 0;
return val;
if (ch == '.')
{
- GCPRO2 (val, tail);
if (!NILP (tail))
XSETCDR (tail, read0 (readcharfun));
else
val = read0 (readcharfun);
read1 (readcharfun, &ch, 0);
- UNGCPRO;
+
if (ch == ')')
{
if (doc_reference == 1)
Lisp_Object tem;
ptrdiff_t pdlcount = SPECPDL_INDEX ();
EMACS_INT repeat = 1;
- struct gcpro gcpro1, gcpro2;
EMACS_INT success_count = 0;
executing_kbd_macro_iterations = 0;
Vreal_this_command));
record_unwind_protect (pop_kbd_macro, tem);
- GCPRO2 (final, loopfunc);
do
{
Vexecuting_kbd_macro = final;
Vreal_this_command = Vexecuting_kbd_macro;
- UNGCPRO;
return unbind_to (pdlcount, Qnil);
}
\f
Lisp_Object prefix, int maxdepth)
{
struct skp skp;
- struct gcpro gcpro1;
skp.pending_maps = Qnil;
skp.maxdepth = maxdepth;
skp.notbuttons = menu_items_used;
}
- GCPRO1 (skp.pending_maps);
map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);
- UNGCPRO;
/* Process now any submenus which want to be panes at this level. */
while (CONSP (skp.pending_maps))
single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *skp_v)
{
Lisp_Object map, item_string, enabled;
- struct gcpro gcpro1, gcpro2;
bool res;
struct skp *skp = skp_v;
/* Parse the menu item and leave the result in item_properties. */
- GCPRO2 (key, item);
res = parse_menu_item (item, 0);
- UNGCPRO;
if (!res)
return; /* Not a menu item. */
Lisp_Object x, y, window;
int menuflags = 0;
ptrdiff_t specpdl_count = SPECPDL_INDEX ();
- struct gcpro gcpro1;
if (NILP (position))
/* This is an obsolete call, which wants us to precompute the
record_unwind_protect_void (unuse_menu_items);
title = Qnil;
- GCPRO1 (title);
/* Decode the menu items from what was specified. */
{
discard_menu_items ();
FRAME_DISPLAY_INFO (f)->grabbed = 0;
- UNGCPRO;
return Qnil;
}
#endif
FRAME_DISPLAY_INFO (f)->grabbed = 0;
#endif
- UNGCPRO;
-
if (error_name) error ("%s", error_name);
return selection;
}
static Lisp_Object
string_to_object (Lisp_Object val, Lisp_Object defalt)
{
- struct gcpro gcpro1, gcpro2;
Lisp_Object expr_and_pos;
ptrdiff_t pos;
- GCPRO2 (val, defalt);
-
if (STRINGP (val) && SCHARS (val) == 0)
{
if (STRINGP (defalt))
}
val = Fcar (expr_and_pos);
- RETURN_UNGCPRO (val);
+ return val;
}
Lisp_Object val;
ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object mini_frame, ambient_dir, minibuffer, input_method;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
Lisp_Object enable_multibyte;
EMACS_INT pos = 0;
/* String to add to the history. */
input_method = Qnil;
enable_multibyte = Qnil;
- /* Don't need to protect PROMPT, HISTVAR, and HISTPOS because we
- store them away before we can GC. Don't need to protect
- BACKUP_N because we use the value only if it is an integer. */
- GCPRO5 (map, initial, val, ambient_dir, input_method);
-
if (!STRINGP (prompt))
prompt = empty_unibyte_string;
make_number (pos),
expflag, histvar, histpos, defalt,
allow_props, inherit_input_method);
- UNGCPRO;
return unbind_to (count, val);
}
/* The appropriate frame will get selected
in set-window-configuration. */
- UNGCPRO;
return unbind_to (count, val);
}
(Lisp_Object prompt, Lisp_Object initial_contents, Lisp_Object keymap, Lisp_Object read, Lisp_Object hist, Lisp_Object default_value, Lisp_Object inherit_input_method)
{
Lisp_Object histvar, histpos, val;
- struct gcpro gcpro1;
CHECK_STRING (prompt);
if (NILP (keymap))
if (NILP (histpos))
XSETFASTINT (histpos, 0);
- GCPRO1 (default_value);
val = read_minibuf (keymap, initial_contents, prompt,
!NILP (read),
histvar, histpos, default_value,
minibuffer_allow_text_properties,
!NILP (inherit_input_method));
- UNGCPRO;
return val;
}
int matchcount = 0;
ptrdiff_t bindcount = -1;
Lisp_Object bucket, zero, end, tem;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
CHECK_STRING (string);
if (type == function_table)
unbind_to (bindcount, Qnil);
bindcount = -1;
}
- GCPRO4 (tail, string, eltstring, bestmatch);
tem = (type == hash_table
? call2 (predicate, elt,
HASH_VALUE (XHASH_TABLE (collection),
idx - 1))
: call1 (predicate, elt));
- UNGCPRO;
}
if (NILP (tem)) continue;
}
ptrdiff_t idx = 0, obsize = 0;
ptrdiff_t bindcount = -1;
Lisp_Object bucket, tem, zero;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
CHECK_STRING (string);
if (type == 0)
unbind_to (bindcount, Qnil);
bindcount = -1;
}
- GCPRO4 (tail, eltstring, allmatches, string);
tem = type == 3
? call2 (predicate, elt,
HASH_VALUE (XHASH_TABLE (collection), idx - 1))
: call1 (predicate, elt);
- UNGCPRO;
}
if (NILP (tem)) continue;
}
static void
ns_set_name_internal (struct frame *f, Lisp_Object name)
{
- struct gcpro gcpro1;
Lisp_Object encoded_name, encoded_icon_name;
NSString *str;
NSView *view = FRAME_NS_VIEW (f);
- GCPRO1 (name);
encoded_name = ENCODE_UTF_8 (name);
- UNGCPRO;
str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
Lisp_Object buf = XWINDOW (f->selected_window)->contents;
const char *title;
NSAutoreleasePool *pool;
- struct gcpro gcpro1;
Lisp_Object encoded_name, encoded_filename;
NSString *str;
NSTRACE (ns_set_name_as_filename);
name = build_string ([ns_app_name UTF8String]);
}
- GCPRO1 (name);
encoded_name = ENCODE_UTF_8 (name);
- UNGCPRO;
view = FRAME_NS_VIEW (f);
if (! NILP (filename))
{
- GCPRO1 (filename);
encoded_filename = ENCODE_UTF_8 (filename);
- UNGCPRO;
fstr = [NSString stringWithUTF8String: SSDATA (encoded_filename)];
if (fstr == nil) fstr = @"";
int minibuffer_only = 0;
long window_prompting = 0;
ptrdiff_t count = specpdl_ptr - specpdl;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object display;
struct ns_display_info *dpyinfo = NULL;
Lisp_Object parent;
/* No need to protect DISPLAY because that's not used after passing
it to make_frame_without_minibuffer. */
frame = Qnil;
- GCPRO4 (parms, parent, name, frame);
tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
RES_TYPE_SYMBOL);
if (EQ (tem, Qnone) || NILP (tem))
if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
- UNGCPRO;
-
if (window_prompting & USPosition)
x_set_offset (f, f->left_pos, f->top_pos, 1);
(Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
{
int root_x, root_y;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
ptrdiff_t count = SPECPDL_INDEX ();
struct frame *f;
char *str;
specbind (Qinhibit_redisplay, Qt);
- GCPRO4 (string, parms, frame, timeout);
-
CHECK_STRING (string);
str = SSDATA (string);
f = decode_window_system_frame (frame);
[ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)];
unblock_input ();
- UNGCPRO;
return unbind_to (count, Qnil);
}
ptrdiff_t i;
ptrdiff_t size = SCHARS (string);
ptrdiff_t size_byte = SBYTES (string);
- struct gcpro gcpro1;
- GCPRO1 (string);
if (size == size_byte)
for (i = 0; i < size; i++)
printchar (SREF (string, i), printcharfun);
printchar (ch, printcharfun);
i += len;
}
- UNGCPRO;
}
}
\f
is used instead. */)
(Lisp_Object object, Lisp_Object printcharfun)
{
- struct gcpro gcpro1;
-
if (NILP (printcharfun))
printcharfun = Vstandard_output;
- GCPRO1 (object);
PRINTPREPARE;
printchar ('\n', printcharfun);
print (object, printcharfun, 1);
printchar ('\n', printcharfun);
PRINTFINISH;
- UNGCPRO;
return object;
}
{
struct buffer *old = current_buffer;
Lisp_Object value;
- struct gcpro gcpro1;
/* If OBJ is (error STRING), just return STRING.
That is not only faster, it also avoids the need to allocate
set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
value = Fbuffer_string ();
- GCPRO1 (value);
Ferase_buffer ();
set_buffer_internal (old);
- UNGCPRO;
return value;
}
Lisp_Object caller)
{
Lisp_Object errname, errmsg, file_error, tail;
- struct gcpro gcpro1;
if (context != 0)
write_string_1 (context, stream);
/* Print an error message including the data items. */
tail = Fcdr_safe (data);
- GCPRO1 (tail);
/* For file-error, make error message by concatenating
all the data items. They are all strings. */
Fprin1 (obj, stream);
}
}
-
- UNGCPRO;
}
print_string (obj, printcharfun);
else
{
- register ptrdiff_t i, i_byte;
- struct gcpro gcpro1;
+ ptrdiff_t i, i_byte;
ptrdiff_t size_byte;
/* True means we must ensure that the next character we output
cannot be taken as part of a hex character escape. */
bool need_nonhex = false;
bool multibyte = STRING_MULTIBYTE (obj);
- GCPRO1 (obj);
-
if (! EQ (Vprint_charset_text_property, Qt))
obj = print_prune_string_charset (obj);
0, print_interval, printcharfun);
printchar (')', printcharfun);
}
-
- UNGCPRO;
}
break;
{
ptrdiff_t i;
unsigned char c;
- struct gcpro gcpro1;
EMACS_INT size = bool_vector_size (obj);
ptrdiff_t size_in_chars = bool_vector_bytes (size);
ptrdiff_t real_size_in_chars = size_in_chars;
- GCPRO1 (obj);
int len = sprintf (buf, "#&%"pI"d\"", size);
strout (buf, len, len, printcharfun);
if (size_in_chars < real_size_in_chars)
print_c_string (" ...", printcharfun);
printchar ('\"', printcharfun);
-
- UNGCPRO;
}
else if (SUBRP (obj))
{
{
ptrdiff_t amount = v->data[1].integer;
-#if GC_MARK_STACK
-
/* valid_lisp_object_p is reliable, so try to print up
to 8 saved objects. This code is rarely used, so
it's OK that valid_lisp_object_p is slow. */
}
if (i == limit && i < amount)
print_c_string (" ...", printcharfun);
-
-#else /* not GC_MARK_STACK */
-
- /* There is no reliable way to determine whether the objects
- are initialized, so do not try to print them. */
-
- i = sprintf (buf, "with %"pD"d objects", amount);
- strout (buf, i, i, printcharfun);
-
-#endif /* GC_MARK_STACK */
}
else
{
Lisp_Object buffer, name, command, program, proc, contact, current_dir, tem;
Lisp_Object xstderr, stderrproc;
ptrdiff_t count = SPECPDL_INDEX ();
- struct gcpro gcpro1;
USE_SAFE_ALLOCA;
if (nargs == 0)
/* Save arguments for process-contact and clone-process. */
contact = Flist (nargs, args);
- GCPRO1 (contact);
buffer = Fplist_get (contact, QCbuffer);
if (!NILP (buffer))
/* Make sure that the child will be able to chdir to the current
buffer's current directory, or its unhandled equivalent. We
can't just have the child check for an error when it does the
- chdir, since it's in a vfork.
-
- We have to GCPRO around this because Fexpand_file_name and
- Funhandled_file_name_directory might call a file name handling
- function. The argument list is protected by the caller, so all
- we really have to worry about is buffer. */
- {
- struct gcpro gcpro1;
- GCPRO1 (buffer);
- current_dir = encode_current_directory ();
- UNGCPRO;
- }
+ chdir, since it's in a vfork. */
+ current_dir = encode_current_directory ();
name = Fplist_get (contact, QCname);
CHECK_STRING (name);
}
else if (!NILP (xstderr))
{
- struct gcpro gcpro1, gcpro2;
CHECK_STRING (program);
- GCPRO2 (buffer, current_dir);
stderrproc = CALLN (Fmake_pipe_process,
QCname,
concat2 (name, build_string (" stderr")),
QCbuffer,
Fget_buffer_create (xstderr));
- UNGCPRO;
}
proc = make_process (name);
/* Qt denotes we have not yet called Ffind_operation_coding_system. */
Lisp_Object coding_systems = Qt;
Lisp_Object val, *args2;
- struct gcpro gcpro1, gcpro2;
tem = Fplist_get (contact, QCcoding);
if (!NILP (tem))
args2[i++] = buffer;
for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
args2[i++] = XCAR (tem2);
- GCPRO2 (proc, current_dir);
if (!NILP (program))
coding_systems = Ffind_operation_coding_system (nargs2, args2);
- UNGCPRO;
if (CONSP (coding_systems))
val = XCAR (coding_systems);
else if (CONSP (Vdefault_process_coding_system))
args2[i++] = buffer;
for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
args2[i++] = XCAR (tem2);
- GCPRO2 (proc, current_dir);
if (!NILP (program))
coding_systems = Ffind_operation_coding_system (nargs2, args2);
- UNGCPRO;
}
if (CONSP (coding_systems))
val = XCDR (coding_systems);
&& !(SCHARS (program) > 1
&& IS_DEVICE_SEP (SREF (program, 1))))
{
- struct gcpro gcpro1, gcpro2;
-
tem = Qnil;
- GCPRO2 (buffer, current_dir);
openp (Vexec_path, program, Vexec_suffixes, &tem,
make_number (X_OK), false);
- UNGCPRO;
if (NILP (tem))
report_file_error ("Searching for program", program);
tem = Fexpand_file_name (tem, Qnil);
tem = remove_slash_colon (tem);
Lisp_Object arg_encoding = Qnil;
- struct gcpro gcpro1;
- GCPRO1 (tem);
/* Encode the file name and put it in NEW_ARGV.
That's where the child will use it to execute the program. */
new_argc++;
}
- UNGCPRO;
-
/* Now that everything is encoded we can collect the strings into
NEW_ARGV. */
char **new_argv;
else
create_pty (proc);
- UNGCPRO;
SAFE_FREE ();
return unbind_to (count, proc);
}
{
Lisp_Object proc, contact;
struct Lisp_Process *p;
- struct gcpro gcpro1;
Lisp_Object name, buffer;
Lisp_Object tem;
ptrdiff_t specpdl_count;
return Qnil;
contact = Flist (nargs, args);
- GCPRO1 (contact);
name = Fplist_get (contact, QCname);
CHECK_STRING (name);
specpdl_ptr = specpdl + specpdl_count;
- UNGCPRO;
return proc;
}
struct Lisp_Process *p;
Lisp_Object contact = Qnil;
Lisp_Object proc = Qnil;
- struct gcpro gcpro1;
contact = Flist (nargs, args);
- GCPRO1 (contact);
proc = Fplist_get (contact, QCprocess);
if (NILP (proc))
error ("Not a serial process");
if (NILP (Fplist_get (p->childp, QCspeed)))
- {
- UNGCPRO;
- return Qnil;
- }
+ return Qnil;
serial_configure (p, contact);
-
- UNGCPRO;
return Qnil;
}
int fd = -1;
Lisp_Object proc, contact, port;
struct Lisp_Process *p;
- struct gcpro gcpro1;
Lisp_Object name, buffer;
Lisp_Object tem, val;
ptrdiff_t specpdl_count;
return Qnil;
contact = Flist (nargs, args);
- GCPRO1 (contact);
port = Fplist_get (contact, QCport);
if (NILP (port))
specpdl_ptr = specpdl + specpdl_count;
- UNGCPRO;
return proc;
}
int ret = 0;
int xerrno = 0;
int s = -1, outch, inch;
- struct gcpro gcpro1;
ptrdiff_t count = SPECPDL_INDEX ();
ptrdiff_t count1;
Lisp_Object colon_address; /* Either QClocal or QCremote. */
/* Save arguments for process-contact and clone-process. */
contact = Flist (nargs, args);
- GCPRO1 (contact);
#ifdef WINDOWSNT
/* Ensure socket support is loaded if available. */
{
/* Setup coding systems for communicating with the network stream. */
- struct gcpro gcpro1;
/* Qt denotes we have not yet called Ffind_operation_coding_system. */
Lisp_Object coding_systems = Qt;
Lisp_Object val;
if (NILP (host) || NILP (service))
coding_systems = Qnil;
else
- {
- GCPRO1 (proc);
- coding_systems = CALLN (Ffind_operation_coding_system,
- Qopen_network_stream, name, buffer,
- host, service);
- UNGCPRO;
- }
+ coding_systems = CALLN (Ffind_operation_coding_system,
+ Qopen_network_stream, name, buffer,
+ host, service);
if (CONSP (coding_systems))
val = XCAR (coding_systems);
else if (CONSP (Vdefault_process_coding_system))
if (NILP (host) || NILP (service))
coding_systems = Qnil;
else
- {
- GCPRO1 (proc);
- coding_systems = CALLN (Ffind_operation_coding_system,
- Qopen_network_stream, name, buffer,
- host, service);
- UNGCPRO;
- }
+ coding_systems = CALLN (Ffind_operation_coding_system,
+ Qopen_network_stream, name, buffer,
+ host, service);
}
if (CONSP (coding_systems))
val = XCDR (coding_systems);
p->inherit_coding_system_flag
= !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
- UNGCPRO;
return proc;
}
bool outer_running_asynch_code = running_asynch_code;
int waiting = waiting_for_user_input_p;
- /* No need to gcpro these, because all we do with them later
- is test them for EQness, and none of them should be a string. */
#if 0
Lisp_Object obuffer, okeymap;
XSETBUFFER (obuffer, current_buffer);
if (inhibit_sentinels)
return;
- /* No need to gcpro these, because all we do with them later
- is test them for EQness, and none of them should be a string. */
odeactivate = Vdeactivate_mark;
#if 0
Lisp_Object obuffer, okeymap;
{
Lisp_Object proc;
Lisp_Object tail, msg;
- struct gcpro gcpro1, gcpro2;
int got_some_output = -1;
tail = Qnil;
msg = Qnil;
- /* We need to gcpro tail; if read_process_output calls a filter
- which deletes a process and removes the cons to which tail points
- from Vprocess_alist, and then causes a GC, tail is an unprotected
- reference. */
- GCPRO2 (tail, msg);
/* Set this now, so that if new processes are created by sentinels
that we run, we get called again to handle their status changes. */
} /* end for */
update_mode_lines = 24; /* In case buffers use %s in mode-line-format. */
- UNGCPRO;
return got_some_output;
}
{
Lisp_Object attrs[SOUND_ATTR_SENTINEL];
ptrdiff_t count = SPECPDL_INDEX ();
- struct gcpro gcpro1, gcpro2;
#ifdef WINDOWSNT
unsigned long ui_volume_tmp = UINT_MAX;
error ("Invalid sound specification");
Lisp_Object file = Qnil;
- GCPRO2 (sound, file);
#ifndef WINDOWSNT
current_sound_device = xzalloc (sizeof *current_sound_device);
#endif /* WINDOWSNT */
- UNGCPRO;
return unbind_to (count, Qnil);
}
\f
list_system_processes (void)
{
Lisp_Object procdir, match, proclist, next;
- struct gcpro gcpro1, gcpro2;
- register Lisp_Object tail;
+ Lisp_Object tail;
- GCPRO2 (procdir, match);
/* For every process on the system, there's a directory in the
"/proc" pseudo-directory whose name is the numeric ID of that
process. */
next = XCDR (tail);
XSETCAR (tail, Fstring_to_number (XCAR (tail), Qnil));
}
- UNGCPRO;
/* directory_files_internal returns the files in reverse order; undo
that. */
struct kinfo_proc *procs;
size_t i;
- struct gcpro gcpro1;
Lisp_Object proclist = Qnil;
if (sysctl (mib, 3, NULL, &len, NULL, 0) != 0)
return proclist;
}
- GCPRO1 (proclist);
len /= sizeof (struct kinfo_proc);
for (i = 0; i < len; i++)
{
proclist = Fcons (make_fixnum_or_float (procs[i].ki_pid), proclist);
#endif
}
- UNGCPRO;
xfree (procs);
Lisp_Object attrs = Qnil;
Lisp_Object cmd_str, decoded_cmd;
ptrdiff_t count;
- struct gcpro gcpro1, gcpro2;
CHECK_NUMBER_OR_FLOAT (pid);
CONS_TO_INTEGER (pid, pid_t, proc_id);
if (stat (procfn, &st) < 0)
return attrs;
- GCPRO2 (attrs, decoded_cmd);
-
/* euid egid */
uid = st.st_uid;
attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid)), attrs);
attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs);
}
- UNGCPRO;
return attrs;
}
gid_t gid;
Lisp_Object attrs = Qnil;
Lisp_Object decoded_cmd;
- struct gcpro gcpro1, gcpro2;
ptrdiff_t count;
CHECK_NUMBER_OR_FLOAT (pid);
if (stat (procfn, &st) < 0)
return attrs;
- GCPRO2 (attrs, decoded_cmd);
-
/* euid egid */
uid = st.st_uid;
attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid)), attrs);
attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs);
}
unbind_to (count, Qnil);
- UNGCPRO;
return attrs;
}
struct kinfo_proc proc;
size_t proclen = sizeof proc;
- struct gcpro gcpro1, gcpro2;
Lisp_Object attrs = Qnil;
Lisp_Object decoded_comm;
if (sysctl (mib, 4, &proc, &proclen, NULL, 0) != 0)
return attrs;
- GCPRO2 (attrs, decoded_comm);
-
attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (proc.ki_uid)), attrs);
block_input ();
attrs = Fcons (Fcons (Qargs, decoded_comm), attrs);
}
- UNGCPRO;
return attrs;
}
extern void set_waiting_for_input (struct timespec *);
/* When lisp.h is not included Lisp_Object is not defined (this can
- happen when this files is used outside the src directory).
- Use GCPRO1 to determine if lisp.h was included. */
-#ifdef GCPRO1
+ happen when this files is used outside the src directory). */
+#ifdef EMACS_LISP_H
/* Emacs uses the integer list (HI LO US PS) to represent the time
(HI << LO_TIME_BITS) + LO + US / 1e6 + PS / 1e12. */
{
Lisp_Object tail1, tail2, sym1, val1;
bool changed = false;
- struct gcpro gcpro1, gcpro2, gcpro3;
tail1 = plist;
sym1 = Qnil;
val1 = Qnil;
- /* No need to protect OBJECT, because we can GC only in the case
- where it is a buffer, and live buffers are always protected.
- I and its plist are also protected, via OBJECT. */
- GCPRO3 (tail1, sym1, val1);
/* Go through each element of PLIST. */
for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
if (EQ (sym1, XCAR (tail2)))
{
- /* No need to gcpro, because tail2 protects this
- and it must be a cons cell (we get an error otherwise). */
- register Lisp_Object this_cdr;
+ Lisp_Object this_cdr;
this_cdr = XCDR (tail2);
/* Found the property. Now check its value. */
}
}
- UNGCPRO;
-
return changed;
}
INTERVAL i, unchanged;
ptrdiff_t s, len;
bool modified = false;
- struct gcpro gcpro1;
bool first_time = true;
properties = validate_plist (properties);
s = XINT (start);
len = XINT (end) - s;
- /* No need to protect OBJECT, because we GC only if it's a buffer,
- and live buffers are always protected. */
- GCPRO1 (properties);
-
/* If this interval already has the properties, we can skip it. */
if (interval_has_all_properties (properties, i))
{
do
{
if (got >= len)
- RETURN_UNGCPRO (Qnil);
+ return Qnil;
len -= got;
i = next_interval (i);
got = LENGTH (i);
if (LENGTH (i) >= len)
{
- /* We can UNGCPRO safely here, because there will be just
- one more chance to gc, in the next call to add_properties,
- and after that we will not need PROPERTIES or OBJECT again. */
- UNGCPRO;
-
if (interval_has_all_properties (properties, i))
{
if (BUFFERP (object))
Lisp_Object plist;
ptrdiff_t s, e, e2, p, len;
bool modified = false;
- struct gcpro gcpro1, gcpro2;
i = validate_interval_range (src, &start, &end, soft);
if (!i)
s = i->position;
}
- GCPRO2 (stuff, dest);
-
while (! NILP (stuff))
{
res = Fcar (stuff);
stuff = Fcdr (stuff);
}
- UNGCPRO;
-
return modified ? Qt : Qnil;
}
void
add_text_properties_from_list (Lisp_Object object, Lisp_Object list, Lisp_Object delta)
{
- struct gcpro gcpro1, gcpro2;
-
- GCPRO2 (list, object);
-
for (; CONSP (list); list = XCDR (list))
{
Lisp_Object item, start, end, plist;
Fadd_text_properties (start, end, plist, object);
}
-
- UNGCPRO;
}
static void
call_mod_hooks (Lisp_Object list, Lisp_Object start, Lisp_Object end)
{
- struct gcpro gcpro1;
- GCPRO1 (list);
while (!NILP (list))
{
call2 (Fcar (list), start, end);
list = Fcdr (list);
}
- UNGCPRO;
}
/* Check for read-only intervals between character positions START ... END,
Lisp_Object hooks;
Lisp_Object prev_mod_hooks;
Lisp_Object mod_hooks;
- struct gcpro gcpro1;
hooks = Qnil;
prev_mod_hooks = Qnil;
if (!inhibit_modification_hooks)
{
- GCPRO1 (hooks);
hooks = Fnreverse (hooks);
while (! EQ (hooks, Qnil))
{
make_number (end));
hooks = Fcdr (hooks);
}
- UNGCPRO;
}
}
}
Lisp_Object
list_system_processes (void)
{
- struct gcpro gcpro1;
Lisp_Object proclist = Qnil;
HANDLE h_snapshot;
DWORD proc_id;
BOOL res;
- GCPRO1 (proclist);
-
proc_entry.dwSize = sizeof (PROCESSENTRY32);
for (res = process32_first (h_snapshot, &proc_entry); res;
res = process32_next (h_snapshot, &proc_entry))
}
CloseHandle (h_snapshot);
- UNGCPRO;
proclist = Fnreverse (proclist);
}
Lisp_Object
system_process_attributes (Lisp_Object pid)
{
- struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object attrs = Qnil;
Lisp_Object cmd_str, decoded_cmd, tem;
HANDLE h_snapshot, h_proc;
h_snapshot = create_toolhelp32_snapshot (TH32CS_SNAPPROCESS, 0);
- GCPRO3 (attrs, decoded_cmd, tem);
-
if (h_snapshot != INVALID_HANDLE_VALUE)
{
PROCESSENTRY32 pe;
}
if (!found_proc)
- {
- UNGCPRO;
- return Qnil;
- }
+ return Qnil;
h_proc = OpenProcess (PROCESS_QUERY_INFORMATION | PROCESS_VM_READ,
FALSE, proc_id);
if (h_proc)
CloseHandle (h_proc);
- UNGCPRO;
return attrs;
}
bool minibuffer_only = false;
long window_prompting = 0;
ptrdiff_t count = SPECPDL_INDEX ();
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object display;
struct w32_display_info *dpyinfo = NULL;
Lisp_Object parent;
/* No need to protect DISPLAY because that's not used after passing
it to make_frame_without_minibuffer. */
frame = Qnil;
- GCPRO4 (parameters, parent, name, frame);
tem = x_get_arg (dpyinfo, parameters, Qminibuffer, "minibuffer", "Minibuffer",
RES_TYPE_SYMBOL);
if (EQ (tem, Qnone) || NILP (tem))
if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
- UNGCPRO;
-
/* Make sure windows on this frame appear in calls to next-window
and similar functions. */
Vwindow_list = Qnil;
Lisp_Object monitor_list = Qnil, monitor_frames, rest, frame;
int i, n_monitors;
HMONITOR *monitors;
- struct gcpro gcpro1, gcpro2, gcpro3;
if (!(enum_display_monitors_fn && get_monitor_info_fn
&& monitor_from_window_fn))
}
}
- GCPRO3 (attributes_list, primary_monitor_attributes, monitor_frames);
-
for (i = 0; i < n_monitors; i++)
{
Lisp_Object geometry, workarea, name, attributes = Qnil;
if (!NILP (primary_monitor_attributes))
attributes_list = Fcons (primary_monitor_attributes, attributes_list);
- UNGCPRO;
-
xfree (monitors);
return attributes_list;
HOME directory, then in Emacs etc dir for a file called rgb.txt. */
{
Lisp_Object color_file;
- struct gcpro gcpro1;
color_file = build_string ("~/rgb.txt");
- GCPRO1 (color_file);
-
if (NILP (Ffile_readable_p (color_file)))
color_file =
Fexpand_file_name (build_string ("rgb.txt"),
Fsymbol_value (intern ("data-directory")));
Vw32_color_map = Fx_load_color_file (color_file);
-
- UNGCPRO;
}
if (NILP (Vw32_color_map))
Vw32_color_map = w32_default_color_map ();
long window_prompting = 0;
int width, height;
ptrdiff_t count = SPECPDL_INDEX ();
- struct gcpro gcpro1, gcpro2, gcpro3;
struct kboard *kb;
bool face_change_before = face_change;
Lisp_Object buffer;
Vx_resource_name = name;
frame = Qnil;
- GCPRO3 (parms, name, frame);
/* Make a frame without minibuffer nor mode-line. */
f = make_frame (false);
f->wants_modeline = 0;
f->no_split = true;
- UNGCPRO;
-
/* Now that the frame is official, it counts as a reference to
its display. */
FRAME_DISPLAY_INFO (f)->reference_count++;
struct text_pos pos;
int i, width, height;
bool seen_reversed_p;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
int old_windows_or_buffers_changed = windows_or_buffers_changed;
ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_redisplay, Qt);
- GCPRO4 (string, parms, frame, timeout);
-
CHECK_STRING (string);
f = decode_window_system_frame (frame);
if (NILP (timeout))
tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
intern ("x-hide-tip"));
- UNGCPRO;
return unbind_to (count, Qnil);
}
{
ptrdiff_t count;
Lisp_Object deleted, frame, timer;
- struct gcpro gcpro1, gcpro2;
/* Return quickly if nothing to do. */
if (NILP (tip_timer) && NILP (tip_frame))
frame = tip_frame;
timer = tip_timer;
- GCPRO2 (frame, timer);
tip_frame = tip_timer = deleted = Qnil;
count = SPECPDL_INDEX ();
deleted = Qt;
}
- UNGCPRO;
return unbind_to (count, deleted);
}
\f
char fname_ret[MAX_UTF8_PATH];
#endif /* NTGUI_UNICODE */
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
- GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, filename);
-
{
- struct gcpro gcpro1, gcpro2;
- GCPRO2 (orig_dir, orig_prompt); /* There is no GCPRON, N>6. */
-
/* Note: under NTGUI_UNICODE, we do _NOT_ use ENCODE_FILE: the
system file encoding expected by the platform APIs (e.g. Cygwin's
POSIX implementation) may not be the same as the encoding expected
Qfile_name_history,
default_filename,
Qnil);
-
- UNGCPRO;
}
/* Make "Cancel" equivalent to C-g. */
if (NILP (filename))
Fsignal (Qquit, Qnil);
- RETURN_UNGCPRO (filename);
+ return filename;
}
\f
char *doc_a = NULL, *params_a = NULL, *ops_a = NULL;
Lisp_Object absdoc, handler;
BOOL success;
- struct gcpro gcpro1;
#endif
CHECK_STRING (document);
absolute. But DOCUMENT does not have to be a file, it can be a
URL, for example. So we make it absolute only if it is an
existing file; if it is a file that does not exist, tough. */
- GCPRO1 (absdoc);
absdoc = Fexpand_file_name (document, Qnil);
/* Don't call file handlers for file-exists-p, since they might
attempt to access the file, which could fail or produce undesired
}
else
document = ENCODE_FILE (document);
- UNGCPRO;
current_dir = ENCODE_FILE (current_dir);
/* Cannot use filename_to_utf16/ansi with DOCUMENT, since it could
int vk_code;
int lisp_modifiers;
int w32_modifiers;
- struct gcpro gcpro1;
CHECK_VECTOR (key);
if (ASIZE (key) != 1)
return Qnil;
- GCPRO1 (key);
-
c = AREF (key, 0);
if (CONSP (c) && lucid_event_type_list_p (c))
c = Fevent_convert_list (c);
- UNGCPRO;
-
if (! INTEGERP (c) && ! SYMBOLP (c))
error ("Key definition is invalid");
absolute. So we double-check this here, just in case. */
if (faccessat (AT_FDCWD, cmdname, X_OK, AT_EACCESS) != 0)
{
- struct gcpro gcpro1;
-
program = build_string (cmdname);
full = Qnil;
- GCPRO1 (program);
openp (Vexec_path, program, Vexec_suffixes, &full, make_number (X_OK), 0);
- UNGCPRO;
if (NILP (full))
{
errno = EINVAL;
HDC context;
HFONT check_font, old_font;
int i, retval = 0;
- struct gcpro gcpro1;
/* Check the spec is in the right format. */
if (!CONSP (otf_spec) || XINT (Flength (otf_spec)) < 3)
if (!NILP (lang))
lang_tag = OTF_TAG (SNAME (lang));
- /* Everything else is contained within otf_spec so should get
- marked along with it. */
- GCPRO1 (otf_spec);
-
/* Scan GSUB and GPOS tables. */
for (i = 0; i < 2; i++)
{
Lisp_Object window, windows, best_window, frame_arg;
bool frame_best_window_flag = false;
struct frame *f;
- struct gcpro gcpro1;
/* If we're only looping through windows on a particular frame,
frame points to that frame. If we're looping through windows
window = FRAME_SELECTED_WINDOW (SELECTED_FRAME ());
windows = window_list_1 (window, mini ? Qt : Qnil, frame_arg);
- GCPRO1 (windows);
best_window = Qnil;
for (; CONSP (windows); windows = XCDR (windows))
{
if (EQ (window, selected_window))
/* Preferably return the selected window. */
- RETURN_UNGCPRO (window);
+ return window;
else if (EQ (XWINDOW (window)->frame, selected_frame)
&& !frame_best_window_flag)
/* Prefer windows on the current frame (but don't
}
}
- UNGCPRO;
return best_window;
}
else
{
Lisp_Object fns, fn;
- struct gcpro gcpro1, gcpro2;
fns = Qnil;
- GCPRO2 (val, fns);
for (; CONSP (val); val = XCDR (val))
{
else
safe_call1 (fn, pos);
}
-
- UNGCPRO;
}
unbind_to (count, Qnil);
if (!NILP (form) && !EQ (form, Qt))
{
ptrdiff_t count = SPECPDL_INDEX ();
- struct gcpro gcpro1;
/* Bind `object' to the object having the `display' property, a
buffer or string. Bind `position' to the position in the
specbind (Qobject, object);
specbind (Qposition, make_number (CHARPOS (*position)));
specbind (Qbuffer_position, make_number (bufpos));
- GCPRO1 (form);
form = safe_eval (form);
- UNGCPRO;
unbind_to (count, Qnil);
}
for (ptrdiff_t i = 1; i <= nargs; i++)
args[i] = va_arg (ap, Lisp_Object);
Lisp_Object msg = Qnil;
- struct gcpro gcpro1, gcpro2;
- GCPRO2 (args[1], msg);
- gcpro1.nvars = form_nargs;
msg = Fformat_message (nargs, args);
ptrdiff_t len = SBYTES (msg) + 1;
message_dolog (buffer, len - 1, true, STRING_MULTIBYTE (msg));
SAFE_FREE ();
-
- UNGCPRO;
}
ptrdiff_t point_at_end = 0;
ptrdiff_t zv_at_end = 0;
Lisp_Object old_deactivate_mark;
- struct gcpro gcpro1;
old_deactivate_mark = Vdeactivate_mark;
oldbuf = current_buffer;
set_marker_restricted_both (oldbegv, Qnil, BEGV, BEGV_BYTE);
oldzv = message_dolog_marker3;
set_marker_restricted_both (oldzv, Qnil, ZV, ZV_BYTE);
- GCPRO1 (old_deactivate_mark);
if (PT == Z)
point_at_end = 1;
TEMP_SET_PT_BOTH (marker_position (oldpoint),
marker_byte_position (oldpoint));
- UNGCPRO;
unchain_marker (XMARKER (oldpoint));
unchain_marker (XMARKER (oldbegv));
unchain_marker (XMARKER (oldzv));
void
message3 (Lisp_Object m)
{
- struct gcpro gcpro1;
-
- GCPRO1 (m);
clear_message (true, true);
cancel_echoing ();
}
if (! inhibit_message)
message3_nolog (m);
- UNGCPRO;
}
/* Log the message M to stderr. Log an empty line if M is not a string. */
if (need_message)
{
AUTO_STRING (fmt, m);
- struct gcpro gcpro1;
- Lisp_Object msg = string;
- GCPRO1 (msg);
- msg = CALLN (Fformat_message, fmt, msg);
+ Lisp_Object msg = CALLN (Fformat_message, fmt, string);
if (noninteractive)
message_to_stderr (msg);
buffer next time. */
message_buf_print = false;
}
-
- UNGCPRO;
}
}
{
bool all_windows = windows_or_buffers_changed || update_mode_lines;
bool some_windows = REDISPLAY_SOME_P ();
- struct gcpro gcpro1, gcpro2;
Lisp_Object tooltip_frame;
#ifdef HAVE_WINDOW_SYSTEM
/* Clear flag first in case we get an error below. */
FRAME_WINDOW_SIZES_CHANGED (f) = false;
functions = Vwindow_size_change_functions;
- GCPRO2 (tail, functions);
while (CONSP (functions))
{
call1 (XCAR (functions), frame);
functions = XCDR (functions);
}
- UNGCPRO;
}
- GCPRO1 (tail);
menu_bar_hooks_run = update_menu_bar (f, false, menu_bar_hooks_run);
#ifdef HAVE_WINDOW_SYSTEM
update_tool_bar (f, false);
#endif
- UNGCPRO;
}
unbind_to (count, Qnil);
ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object frame, new_tool_bar;
int new_n_tool_bar;
- struct gcpro gcpro1;
/* Set current_buffer to the buffer of the selected
window of the frame, so that we get the right local
specbind (Qoverriding_local_map, Qnil);
}
- GCPRO1 (new_tool_bar);
-
/* We must temporarily set the selected frame to this frame
before calling tool_bar_items, because the calculation of
the tool-bar keymap uses the selected frame (see
unblock_input ();
}
- UNGCPRO;
-
unbind_to (count, Qnil);
set_buffer_internal_1 (prev);
}
build_desired_tool_bar_string (struct frame *f)
{
int i, size, size_needed;
- struct gcpro gcpro1, gcpro2;
Lisp_Object image, plist;
image = plist = Qnil;
- GCPRO2 (image, plist);
/* Prepare F->desired_tool_bar_string. If we can reuse it, do so.
Otherwise, make a new string. */
else
{
AUTO_LIST4 (props, Qdisplay, Qnil, Qmenu_item, Qnil);
- struct gcpro gcpro1;
- GCPRO1 (props);
Fremove_text_properties (make_number (0), make_number (size),
props, f->desired_tool_bar_string);
- UNGCPRO;
}
/* Put a `display' property on the string for the images to display,
image = Fcons (Qimage, plist);
AUTO_LIST4 (props, Qdisplay, image, Qmenu_item,
make_number (i * TOOL_BAR_ITEM_NSLOTS));
- struct gcpro gcpro1;
- GCPRO1 (props);
/* Let the last image hide all remaining spaces in the tool bar
string. The string can be longer than needed when we reuse a
end = i + 1;
Fadd_text_properties (make_number (i), make_number (end),
props, f->desired_tool_bar_string);
- UNGCPRO;
#undef PROP
}
-
- UNGCPRO;
}
face_name, NAMED_MERGE_POINT_NORMAL,
&named_merge_points))
{
- struct gcpro gcpro1;
Lisp_Object from[LFACE_VECTOR_SIZE];
bool ok = get_lface_attributes (f, face_name, from, false,
named_merge_points);
if (ok)
- {
- GCPRO1 (named_merge_point.face_name);
- merge_face_vectors (f, from, to, named_merge_points);
- UNGCPRO;
- }
+ merge_face_vectors (f, from, to, named_merge_points);
return ok;
}
/* Encode Lisp string STRING as a text in a format appropriate for
XICCC (X Inter Client Communication Conventions).
- This can call Lisp code, so callers must GCPRO.
-
If STRING contains only ASCII characters, do no conversion and
return the string data of STRING. Otherwise, encode the text by
CODING_SYSTEM, and return a newly allocated memory area which
Lisp_Object coding_system;
Lisp_Object encoded_name;
Lisp_Object encoded_icon_name;
- struct gcpro gcpro1;
/* As ENCODE_UTF_8 may cause GC and relocation of string data,
we use it before x_encode_text that may return string data. */
- GCPRO1 (name);
encoded_name = ENCODE_UTF_8 (name);
- UNGCPRO;
coding_system = Qcompound_text;
/* Note: Encoding strategy
bool minibuffer_only = false;
long window_prompting = 0;
ptrdiff_t count = SPECPDL_INDEX ();
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
Lisp_Object display;
struct x_display_info *dpyinfo = NULL;
Lisp_Object parent;
if (! NILP (parent))
CHECK_NUMBER (parent);
- /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
- /* No need to protect DISPLAY because that's not used after passing
- it to make_frame_without_minibuffer. */
frame = Qnil;
- GCPRO4 (parms, parent, name, frame);
tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
RES_TYPE_SYMBOL);
if (EQ (tem, Qnone) || NILP (tem))
to get the color reference counts right, so initialize them! */
{
Lisp_Object black;
- struct gcpro gcpro1;
/* Function x_decode_color can signal an error. Make
sure to initialize color slots so that we won't try
f->output_data.x->mouse_pixel = -1;
black = build_string ("black");
- GCPRO1 (black);
FRAME_FOREGROUND_PIXEL (f)
= x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
FRAME_BACKGROUND_PIXEL (f)
= x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
f->output_data.x->mouse_pixel
= x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
- UNGCPRO;
}
/* Specify the parent under which to make this X window. */
if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
fset_param_alist (f, Fcons (XCAR (tem), f->param_alist));
- UNGCPRO;
-
/* Make sure windows on this frame appear in calls to next-window
and similar functions. */
Vwindow_list = Qnil;
int actual_format;
unsigned long actual_size, bytes_remaining;
int rc;
- struct gcpro gcpro1;
-
- GCPRO1 (prop_value);
rc = XGetWindowProperty (FRAME_X_DISPLAY (f), target_window,
prop_atom, 0, 0, False, target_type,
if (tmp_data) XFree (tmp_data);
}
- UNGCPRO;
return prop_value;
}
Lisp_Object prop_value = Qnil;
Atom target_type = XA_STRING;
Window target_window = FRAME_X_WINDOW (f);
- struct gcpro gcpro1;
bool found;
- GCPRO1 (prop_value);
CHECK_STRING (prop);
if (! NILP (source))
unblock_input ();
- UNGCPRO;
return prop_value;
}
Lisp_Object name;
int width, height;
ptrdiff_t count = SPECPDL_INDEX ();
- struct gcpro gcpro1, gcpro2, gcpro3;
bool face_change_before = face_change;
Lisp_Object buffer;
struct buffer *old_buffer;
error ("Invalid frame name--not a string or nil");
frame = Qnil;
- GCPRO3 (parms, name, frame);
f = make_frame (true);
XSETFRAME (frame, f);
to get the color reference counts right, so initialize them! */
{
Lisp_Object black;
- struct gcpro gcpro1;
/* Function x_decode_color can signal an error. Make
sure to initialize color slots so that we won't try
f->output_data.x->mouse_pixel = -1;
black = build_string ("black");
- GCPRO1 (black);
FRAME_FOREGROUND_PIXEL (f)
= x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
FRAME_BACKGROUND_PIXEL (f)
= x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
f->output_data.x->mouse_pixel
= x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
- UNGCPRO;
}
/* Set the name; the functions to which we pass f expect the name to
f->no_split = true;
- UNGCPRO;
-
/* Now that the frame will be official, it counts as a reference to
its display and terminal. */
FRAME_DISPLAY_INFO (f)->reference_count++;
struct text_pos pos;
int i, width, height;
bool seen_reversed_p;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
int old_windows_or_buffers_changed = windows_or_buffers_changed;
ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_redisplay, Qt);
- GCPRO4 (string, parms, frame, timeout);
-
CHECK_STRING (string);
if (SCHARS (string) == 0)
string = make_unibyte_string (" ", 1);
tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
intern ("x-hide-tip"));
- UNGCPRO;
return unbind_to (count, Qnil);
}
{
ptrdiff_t count;
Lisp_Object deleted, frame, timer;
- struct gcpro gcpro1, gcpro2;
/* Return quickly if nothing to do. */
if (NILP (tip_timer) && NILP (tip_frame))
frame = tip_frame;
timer = tip_timer;
- GCPRO2 (frame, timer);
tip_frame = tip_timer = deleted = Qnil;
count = SPECPDL_INDEX ();
#endif /* USE_LUCID */
}
- UNGCPRO;
return unbind_to (count, deleted);
}
int ac = 0;
XmString dir_xmstring, pattern_xmstring;
ptrdiff_t count = SPECPDL_INDEX ();
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
check_window_system (f);
- GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
-
if (popup_activated ())
error ("Trying to use a menu from within a menu-entry");
file = Qnil;
unblock_input ();
- UNGCPRO;
/* Make "Cancel" equivalent to C-g. */
if (NILP (file))
Lisp_Object file = Qnil;
Lisp_Object decoded_file;
ptrdiff_t count = SPECPDL_INDEX ();
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
char *cdef_file;
check_window_system (f);
- GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
-
if (popup_activated ())
error ("Trying to use a menu from within a menu-entry");
}
unblock_input ();
- UNGCPRO;
/* Make "Cancel" equivalent to C-g. */
if (NILP (file))
Lisp_Object font;
Lisp_Object font_param;
char *default_name = NULL;
- struct gcpro gcpro1, gcpro2;
ptrdiff_t count = SPECPDL_INDEX ();
if (popup_activated ())
block_input ();
- GCPRO2 (font_param, font);
-
XSETFONT (font, FRAME_FONT (f));
font_param = Ffont_get (font, QCname);
if (STRINGP (font_param))
CHECK_SYMBOL (target_type);
handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
- /* gcpro is not needed here since nothing but HANDLER_FN
- is live, and that ought to be a symbol. */
if (!NILP (handler_fn))
value = call3 (handler_fn,
static void
x_handle_selection_request (struct selection_input_event *event)
{
- struct gcpro gcpro1, gcpro2;
Time local_selection_time;
struct x_display_info *dpyinfo = SELECTION_EVENT_DPYINFO (event);
Lisp_Object local_selection_data;
bool success = false;
ptrdiff_t count = SPECPDL_INDEX ();
- GCPRO2 (local_selection_data, target_symbol);
if (!dpyinfo) goto DONE;
selection_symbol, target_symbol, success ? Qt : Qnil);
unbind_to (count, Qnil);
- UNGCPRO;
}
/* Perform the requested selection conversion, and write the data to
Lisp_Object target_symbol, Atom property,
bool for_multiple, struct x_display_info *dpyinfo)
{
- struct gcpro gcpro1;
Lisp_Object lisp_selection;
struct selection_data *cs;
- GCPRO1 (lisp_selection);
lisp_selection
= x_get_local_selection (selection_symbol, target_symbol,
converted_selections = cs;
}
- UNGCPRO;
return false;
}
cs->next = converted_selections;
converted_selections = cs;
lisp_data_to_selection_data (dpyinfo, lisp_selection, cs);
- UNGCPRO;
return true;
}
\f
Lisp_Object time_stamp, Lisp_Object terminal)
{
Lisp_Object val = Qnil;
- struct gcpro gcpro1, gcpro2;
struct frame *f = frame_for_x_selection (terminal);
- GCPRO2 (target_type, val); /* we store newly consed data into these */
CHECK_SYMBOL (selection_symbol);
CHECK_SYMBOL (target_type);
{
Lisp_Object frame;
XSETFRAME (frame, f);
- RETURN_UNGCPRO (x_get_foreign_selection (selection_symbol, target_type,
- time_stamp, frame));
+ return x_get_foreign_selection (selection_symbol, target_type,
+ time_stamp, frame);
}
if (CONSP (val) && SYMBOLP (XCAR (val)))
if (CONSP (val) && NILP (XCDR (val)))
val = XCAR (val);
}
- RETURN_UNGCPRO (clean_local_selection_data (val));
+ return clean_local_selection_data (val);
}
DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
{
char *vendor = ServerVendor (dpy);
- /* Protect terminal from GC before removing it from the
- list of terminals. */
- struct gcpro gcpro1;
- Lisp_Object gcpro_term;
- XSETTERMINAL (gcpro_term, terminal);
- GCPRO1 (gcpro_term);
-
/* Temporarily hide the partially initialized terminal. */
terminal_list = terminal->next_terminal;
unblock_input ();
block_input ();
terminal->next_terminal = terminal_list;
terminal_list = terminal;
- UNGCPRO;
}
/* Don't let the initial kboard remain current longer than necessary.
(require 'ert)
(require 'cl-lib)
-(ert-deftest finalizer-basic ()
- "Test that finalizers run at all."
- (skip-unless gc-precise)
- (let* ((finalized nil)
- (finalizer (make-finalizer (lambda () (setf finalized t)))))
- (garbage-collect)
- (should (equal finalized nil))
- (setf finalizer nil)
- (garbage-collect)
- (should (equal finalized t))))
-
-(ert-deftest finalizer-circular-reference ()
- "Test references from a callback to a finalizer."
- (skip-unless gc-precise)
- (let ((finalized nil))
- (let* ((value nil)
- (finalizer (make-finalizer (lambda () (setf finalized value)))))
- (setf value finalizer)
- (setf finalizer nil))
- (garbage-collect)
- (should finalized)))
-
-(ert-deftest finalizer-cross-reference ()
- "Test that between-finalizer references do not prevent collection."
- (skip-unless gc-precise)
- (let ((d nil) (fc 0))
- (let* ((f1-data (cons nil nil))
- (f2-data (cons nil nil))
- (f1 (make-finalizer
- (lambda () (cl-incf fc) (setf d f1-data))))
- (f2 (make-finalizer
- (lambda () (cl-incf fc) (setf d f2-data)))))
- (setcar f1-data f2)
- (setcar f2-data f1))
- (garbage-collect)
- (should (equal fc 2))))
-
-(ert-deftest finalizer-error ()
- "Test that finalizer errors are suppressed"
- (skip-unless gc-precise)
- (make-finalizer (lambda () (error "ABCDEF")))
- (garbage-collect)
- (with-current-buffer "*Messages*"
- (save-excursion
- (goto-char (point-max))
- (forward-line -1)
- (should (equal
- (buffer-substring (point) (point-at-eol))
- "finalizer failed: (error \"ABCDEF\")")))))
-
(ert-deftest finalizer-object-type ()
(should (equal (type-of (make-finalizer nil)) 'finalizer)))
(iter-close iter)
(should (not cps-test-closed-flag)))))
-(ert-deftest cps-test-iter-close-finalizer ()
- (skip-unless gc-precise)
- (garbage-collect)
- (let ((cps-test-closed-flag nil))
- (let ((iter (funcall
- (iter-lambda ()
- (unwind-protect (iter-yield 1)
- (setf cps-test-closed-flag t))))))
- (should (equal (iter-next iter) 1))
- (should (not cps-test-closed-flag))
- (setf iter nil)
- (garbage-collect)
- (should cps-test-closed-flag))))
-
(ert-deftest cps-test-iter-cleanup-once-only ()
(let* ((nr-unwound 0)
(iter