procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Assume GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS

Browse source 
This removes the need for GCPRO1 etc.  Suggested by Stefan Monnier in:
http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00918.html
* doc/lispref/internals.texi (Writing Emacs Primitives):
* etc/NEWS:
Document the change.
* src/alloc.c (gcprolist, dump_zombies, MAX_ZOMBIES, zombies)
(nzombies, ngcs, avg_zombies, max_live, max_zombies, avg_live)
(Fgc_status, check_gcpros, relocatable_string_data_p, gc-precise):
* src/bytecode.c (mark_byte_stack) [BYTE_MARK_STACK]:
* src/eval.c (gcpro_level) [DEBUG_GCPRO]:
* src/lisp.h (struct handler.gcpro, struct gcpro, GC_MARK_STACK)
(GC_USE_GCPROS_AS_BEFORE, GC_MAKE_GCPROS_NOOPS)
(GC_MARK_STACK_CHECK_GCPROS, GC_USE_GCPROS_CHECK_ZOMBIES)
(BYTE_MARK_STACK, GCPRO1, GCPRO2, GCPRO3, GCPRO4, GCPRO5, GCPRO6)
(GCPRO7, UNGCPRO, RETURN_UNGCPRO):
Remove.  All uses removed.  The code now assumes
GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS.
* src/bytecode.c (relocate_byte_stack):
Rename from unmark_byte_stack, since it now only relocates.
All callers changed.
* src/frame.c (make_frame): Add an IF_LINT to pacify GCC 5.2
with GCPROs removed.
* src/systime.h: Use EMACS_LISP_H as the canary instead of GCPRO1.
* test/automated/finalizer-tests.el (finalizer-basic)
(finalizer-circular-reference, finalizer-cross-reference)
(finalizer-error):
* test/automated/generator-tests.el (cps-test-iter-close-finalizer):
Remove tests, as they depend on gc-precise.
This commit is contained in:
Paul Eggert 2015-08-26 19:24:28 -07:00
parent 259a643d7f
commit 60d1b18734
50 changed files with 193 additions and 1850 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

54
doc/lispref/internals.texi
View file

@ -638,7 +638,6 @@ to read the source, but we can explain some things here.
@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,
@ -648,15 +647,10 @@ The remaining args are not evalled at all.
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
@ -670,7 +664,6 @@ usage: (or CONDITIONS ...) */)
@end group
@group
UNGCPRO;
return val;
@}
@end group
@ -774,36 +767,17 @@ a primitive to accept only a certain type of argument, you must check
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
@ -932,9 +906,7 @@ the Lisp function @code{funcall} accepts an unlimited number of
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

6
etc/NEWS
View file

@ -39,6 +39,12 @@ should be able to work around the problem either by porting the Emacs
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.

267
src/alloc.c
View file

@ -69,11 +69,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
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
@ -298,8 +294,6 @@ enum mem_type
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). */
@ -380,16 +374,10 @@ static void mem_delete (struct mem_node *);
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. */
@ -965,7 +953,7 @@ lisp_malloc (size_t nbytes, enum mem_type type)
}
#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
@ -985,7 +973,7 @@ lisp_free (void *block)
{
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;
@ -1190,7 +1178,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type)
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
@ -1210,7 +1198,7 @@ lisp_align_free (void *block)
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. */
@ -2499,9 +2487,7 @@ void
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++;
@ -2849,7 +2835,7 @@ allocate_vector_block (void)
{
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
@ -3058,7 +3044,7 @@ sweep_vectors (void)
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);
@ -3772,14 +3758,11 @@ run_finalizer_handler (Lisp_Object args)
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
@ -3918,8 +3901,6 @@ refill_memory_reserve (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
@ -3986,26 +3967,12 @@ mem_insert (void *start, void *end, enum mem_type type)
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);
@ -4491,62 +4458,6 @@ live_buffer_p (struct mem_node *m, void *p)
&& !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
@ -4608,14 +4519,7 @@ mark_maybe_object (Lisp_Object obj)
}
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);
}
}
@ -4723,10 +4627,6 @@ mark_memory (void *start, void *end)
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)
@ -4847,42 +4747,6 @@ test_setjmp (void)
#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
@ -4945,18 +4809,8 @@ mark_stack (void *end)
#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)
{
@ -5007,9 +4861,7 @@ int
valid_lisp_object_p (Lisp_Object obj)
{
void *p;
#if GC_MARK_STACK
struct mem_node *m;
#endif
if (INTEGERP (obj))
return 1;
@ -5024,10 +4876,6 @@ valid_lisp_object_p (Lisp_Object obj)
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)
@ -5075,35 +4923,6 @@ valid_lisp_object_p (Lisp_Object obj)
}
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;
}
/***********************************************************************
@ -5675,18 +5494,8 @@ garbage_collect_1 (void *end)
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)
@ -5699,10 +5508,6 @@ garbage_collect_1 (void *end)
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. */
@ -5730,16 +5535,12 @@ garbage_collect_1 (void *end)
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;
@ -5813,21 +5614,6 @@ garbage_collect_1 (void *end)
};
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);
@ -5878,9 +5664,6 @@ returns nil, because real GC can't be done.
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
@ -5935,12 +5718,6 @@ See Info node `(elisp)Garbage Collection'. */)
#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
@ -6133,7 +5910,7 @@ mark_save_value (struct Lisp_Save_Value *ptr)
/* 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;
@ -6208,7 +5985,7 @@ mark_object (Lisp_Object arg)
/* 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
@ -6634,9 +6411,7 @@ sweep_conses (void)
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
{
@ -6795,9 +6570,7 @@ sweep_symbols (void)
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
@ -7226,7 +6999,6 @@ init_alloc_once (void)
{
/* 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;
@ -7235,10 +7007,8 @@ init_alloc_once (void)
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. */
@ -7255,10 +7025,8 @@ init_alloc_once (void)
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;
@ -7368,11 +7136,6 @@ The time is in seconds as a floating point value. */);
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);
@ -7391,10 +7154,6 @@ Useful mainly for automated GC tests. Build time constant.*/);
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

9
src/bidi.c
View file

@ -3348,7 +3348,6 @@ bidi_move_to_visually_next (struct bidi_it *bidi_it)
{
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 ();
@ -3358,11 +3357,6 @@ bidi_move_to_visually_next (struct bidi_it *bidi_it)
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))
@ -3508,9 +3502,6 @@ bidi_move_to_visually_next (struct bidi_it *bidi_it)
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

28
src/buffer.c
View file

@ -1629,10 +1629,9 @@ cleaning up all windows currently displaying the buffer to be killed. */)
(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 ();
@ -1665,10 +1664,8 @@ cleaning up all windows currently displaying the buffer to be killed. */)
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);
}
@ -1702,8 +1699,6 @@ cleaning up all windows currently displaying the buffer to be killed. */)
{
struct buffer *other;
GCPRO1 (buffer);
FOR_EACH_BUFFER (other)
if (other->base_buffer == b)
{
@ -1712,8 +1707,6 @@ cleaning up all windows currently displaying the buffer to be killed. */)
Fkill_buffer (buf);
}
UNGCPRO;
/* Exit if we now have killed the base buffer (Bug#11665). */
if (!BUFFER_LIVE_P (b))
return Qt;
@ -1751,9 +1744,7 @@ cleaning up all windows currently displaying the buffer to be killed. */)
/* 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. */
@ -2409,7 +2400,6 @@ current buffer is cleared. */)
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");
@ -2418,8 +2408,6 @@ current buffer is cleared. */)
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);
@ -2649,8 +2637,6 @@ current buffer is cleared. */)
old_undo));
}
UNGCPRO;
current_buffer->prevent_redisplay_optimizations_p = 1;
/* If buffer is shown in a window, let redisplay consider other windows. */
@ -4394,7 +4380,6 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after,
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;
@ -4487,7 +4472,6 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after,
}
}
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
@ -4511,17 +4495,12 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after,
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))
@ -4530,7 +4509,6 @@ call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay, bool after,
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'

49
src/bytecode.c
View file

@ -296,7 +296,7 @@ enum byte_code_op
};
/* 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
/* Structure describing a value stack used during byte-code execution
in Fbyte_code. */
@ -319,12 +319,6 @@ struct byte_stack
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;
};
@ -332,46 +326,16 @@ struct byte_stack
/* 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;
/* 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;
@ -554,9 +518,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
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);

18
src/callint.c
View file

@ -228,11 +228,9 @@ static Lisp_Object
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! */
@ -298,7 +296,6 @@ invoke it. If KEYS is omitted or nil, the return value of
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;
@ -340,9 +337,7 @@ invoke it. If KEYS is omitted or nil, the return value of
/* 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
@ -357,11 +352,9 @@ invoke it. If KEYS is omitted or nil, the return value of
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. */
@ -500,10 +493,6 @@ invoke it. If KEYS is omitted or nil, the return value of
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);
@ -847,7 +836,6 @@ invoke it. If KEYS is omitted or nil, the return value of
{
Lisp_Object val = Ffuncall (nargs, args);
UNGCPRO;
val = unbind_to (speccount, val);
SAFE_FREE ();
return val;

87
src/callproc.c
View file

@ -113,10 +113,8 @@ Lisp_Object
encode_current_directory (void)
{
Lisp_Object dir;
struct gcpro gcpro1;
dir = BVAR (current_buffer, directory);
GCPRO1 (dir);
dir = Funhandled_file_name_directory (dir);
@ -138,7 +136,7 @@ encode_current_directory (void)
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.
@ -252,7 +250,6 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
{
Lisp_Object infile, encoded_infile;
int filefd;
struct gcpro gcpro1;
ptrdiff_t count = SPECPDL_INDEX ();
if (nargs >= 2 && ! NILP (args[1]))
@ -263,14 +260,12 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
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));
}
@ -422,26 +417,13 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
/* 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]);
@ -454,13 +436,10 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
/* 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]);
}
@ -470,32 +449,26 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
SAFE_NALLOCA (new_argv, 1, nargs < 4 ? 2 : nargs - 2);
{
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
if (nargs > 4)
{
ptrdiff_t i;
GCPRO4 (buffer, current_dir, path, error_file);
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));
@ -936,7 +909,6 @@ create_temp_file (ptrdiff_t nargs, Lisp_Object *args,
Lisp_Object *filename_string_ptr)
{
int fd;
struct gcpro gcpro1;
Lisp_Object filename_string;
Lisp_Object val, start, end;
Lisp_Object tmpdir;
@ -980,7 +952,6 @@ create_temp_file (ptrdiff_t nargs, Lisp_Object *args,
#endif
filename_string = Fcopy_sequence (ENCODE_FILE (pattern));
GCPRO1 (filename_string);
tempfile = SSDATA (filename_string);
count = SPECPDL_INDEX ();
@ -1033,7 +1004,6 @@ create_temp_file (ptrdiff_t nargs, Lisp_Object *args,
coding-system-for-read. */
*filename_string_ptr = filename_string;
UNGCPRO;
return fd;
}
@ -1064,7 +1034,6 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
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];
@ -1095,8 +1064,6 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
record_unwind_protect_int (close_file_unwind, fd);
}
GCPRO1 (infile);
if (nargs > 3 && !NILP (args[3]))
Fdelete_region (start, end);
@ -1113,7 +1080,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
args[1] = infile;
val = call_process (nargs, args, fd, empty_input ? -1 : count);
RETURN_UNGCPRO (unbind_to (count, val));
return unbind_to (count, val);
}
#ifndef WINDOWSNT

11
src/chartab.c
View file

@ -863,13 +863,11 @@ map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
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];
@ -920,8 +918,6 @@ map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
}
}
}
UNGCPRO;
}
DEFUN ("map-char-table", Fmap_char_table, Smap_char_table,
@ -1031,10 +1027,8 @@ map_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object),
{
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])
{
@ -1065,8 +1059,6 @@ map_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object),
else
call2 (function, range, arg);
}
UNGCPRO;
}
@ -1299,11 +1291,8 @@ uniprop_table (Lisp_Object prop)
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);

18
src/coding.c
View file

@ -7833,9 +7833,7 @@ static void
code_conversion_restore (Lisp_Object arg)
{
Lisp_Object current, workbuf;
struct gcpro gcpro1;
GCPRO1 (arg);
current = XCAR (arg);
workbuf = XCDR (arg);
if (! NILP (workbuf))
@ -7846,7 +7844,6 @@ code_conversion_restore (Lisp_Object arg)
Fkill_buffer (workbuf);
}
set_buffer_internal (XBUFFER (current));
UNGCPRO;
}
Lisp_Object
@ -8118,16 +8115,12 @@ decode_coding_object (struct coding_system *coding,
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;
@ -8255,15 +8248,8 @@ encode_coding_object (struct coding_system *coding,
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 ();

3
src/data.c
View file

@ -1529,10 +1529,8 @@ usage: (setq-default [VAR VALUE]...) */)
(Lisp_Object args)
{
Lisp_Object args_left, symbol, val;
struct gcpro gcpro1;
args_left = val = args;
GCPRO1 (args);
while (CONSP (args_left))
{
@ -1542,7 +1540,6 @@ usage: (setq-default [VAR VALUE]...) */)
args_left = Fcdr (XCDR (args_left));
}
UNGCPRO;
return val;
}

58
src/dbusbind.c
View file

@ -906,11 +906,9 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
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)
@ -919,7 +917,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_next (&subiter);
}
XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (result));
RETURN_UNGCPRO (Fnreverse (result));
return Fnreverse (result);
}
default:
@ -1259,7 +1257,6 @@ usage: (dbus-message-internal &rest REST) */)
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;
@ -1317,9 +1314,6 @@ usage: (dbus-message-internal &rest REST) */)
wrong_type_argument (Qinvalid_function, handler);
}
/* Protect Lisp variables. */
GCPRO6 (bus, service, path, interface, member, handler);
/* Trace parameters. */
switch (mtype)
{
@ -1357,10 +1351,7 @@ usage: (dbus-message-internal &rest REST) */)
/* 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))
{
@ -1368,11 +1359,8 @@ usage: (dbus-message-internal &rest REST) */)
/* 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
@ -1392,11 +1380,8 @@ usage: (dbus-message-internal &rest REST) */)
&& (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);
}
}
@ -1407,26 +1392,17 @@ usage: (dbus-message-internal &rest REST) */)
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. */
@ -1473,10 +1449,7 @@ usage: (dbus-message-internal &rest REST) */)
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);
@ -1491,10 +1464,7 @@ usage: (dbus-message-internal &rest REST) */)
/* 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;
}
@ -1505,7 +1475,7 @@ usage: (dbus-message-internal &rest REST) */)
dbus_message_unref (dmessage);
/* Return the result. */
RETURN_UNGCPRO (result);
return result;
}
/* Read one queued incoming message of the D-Bus BUS.
@ -1515,7 +1485,6 @@ static void
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;
@ -1533,7 +1502,6 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
/* Collect the parameters. */
args = Qnil;
GCPRO1 (args);
/* Loop over the resulting parameters. Construct a list. */
if (dbus_message_iter_init (dmessage, &iter))
@ -1657,8 +1625,6 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
/* Cleanup. */
cleanup:
dbus_message_unref (dmessage);
UNGCPRO;
}
/* Read queued incoming messages of the D-Bus BUS.

29
src/dired.c
View file

@ -166,21 +166,17 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
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))
@ -254,8 +250,6 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
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. */
@ -314,8 +308,6 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
else
list = Fcons (finalname, list);
}
UNGCPRO;
}
block_input ();
@ -334,7 +326,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
attrs ? Qfile_attributes_lessp : Qstring_lessp);
(void) directory_volatile;
RETURN_UNGCPRO (list);
return list;
}
@ -472,7 +464,6 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
anything. */
bool includeall = 1;
ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
elt = Qnil;
@ -480,7 +471,6 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
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
@ -640,18 +630,8 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
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. */
@ -731,7 +711,6 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
}
}
UNGCPRO;
/* This closes the directory. */
bestmatch = unbind_to (count, bestmatch);

10
src/doc.c
View file

@ -407,10 +407,7 @@ string is passed through `substitute-command-keys'. */)
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;
@ -452,10 +449,7 @@ aren't strings. */)
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;
@ -751,7 +745,6 @@ Otherwise, return a new string. */)
unsigned char const *start;
ptrdiff_t length, length_byte;
Lisp_Object name;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
bool multibyte;
ptrdiff_t nchars;
@ -762,7 +755,6 @@ Otherwise, return a new string. */)
tem = Qnil;
keymap = Qnil;
name = Qnil;
GCPRO4 (string, tem, keymap, name);
enum text_quoting_style quoting_style = text_quoting_style ();
@ -1012,7 +1004,7 @@ Otherwise, return a new string. */)
else
tem = string;
xfree (buf);
RETURN_UNGCPRO (tem);
return tem;
}
void

29
src/editfns.c
View file

@ -958,7 +958,6 @@ 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
@ -966,8 +965,6 @@ save_excursion_restore (Lisp_Object info)
if (NILP (tem))
goto out;
GCPRO1 (info);
Fset_buffer (tem);
/* Point marker. */
@ -988,8 +985,6 @@ save_excursion_restore (Lisp_Object info)
&& XBUFFER (tem1) == current_buffer)))
Fset_window_point (tem, make_number (PT));
UNGCPRO;
out:
free_misc (info);
@ -2482,11 +2477,6 @@ insert1 (Lisp_Object arg)
}
/* 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
@ -3191,10 +3181,7 @@ Both characters must have the same length of multi-byte form. */)
{
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);
@ -3213,8 +3200,6 @@ Both characters must have the same length of multi-byte form. */)
if (! NILP (noundo))
bset_undo_list (current_buffer, tem);
UNGCPRO;
}
else
{
@ -3724,13 +3709,10 @@ usage: (message-box FORMAT-STRING &rest ARGS) */)
{
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;
}
}
@ -3772,7 +3754,6 @@ usage: (propertize STRING &rest PROPERTIES) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object properties, string;
struct gcpro gcpro1, gcpro2;
ptrdiff_t i;
/* Number of args must be odd. */
@ -3780,7 +3761,6 @@ usage: (propertize STRING &rest PROPERTIES) */)
error ("Wrong number of arguments");
properties = string = Qnil;
GCPRO2 (properties, string);
/* First argument must be a string. */
CHECK_STRING (args[0]);
@ -3792,7 +3772,7 @@ usage: (propertize STRING &rest PROPERTIES) */)
Fadd_text_properties (make_number (0),
make_number (SCHARS (string)),
properties, string);
RETURN_UNGCPRO (string);
return string;
}
DEFUN ("format", Fformat, Sformat, 1, MANY, 0,
@ -3914,9 +3894,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
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]);
@ -4552,12 +4529,10 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
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))
{
@ -4646,8 +4621,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
add_text_properties_from_list (val, props,
make_number (info[n].start));
}
UNGCPRO;
}
/* If we allocated BUF or INFO with malloc, free it too. */

8
src/emacs.c
View file

@ -714,9 +714,7 @@ close_output_streams (void)
int
main (int argc, char **argv)
{
#if GC_MARK_STACK
Lisp_Object dummy;
#endif
char stack_bottom_variable;
bool do_initial_setlocale;
bool dumping;
@ -735,9 +733,7 @@ main (int argc, char **argv)
/* 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;
@ -1932,16 +1928,12 @@ all of which are called before Emacs is actually killed. */
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. */

122
src/eval.c
View file

@ -33,11 +33,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
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:
@ -226,7 +221,6 @@ static struct handler handlerlist_sentinel;
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.
@ -242,9 +236,6 @@ init_eval (void)
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;
}
@ -344,10 +335,7 @@ If all args return nil, return nil.
usage: (or CONDITIONS...) */)
(Lisp_Object args)
{
register Lisp_Object val = Qnil;
struct gcpro gcpro1;
GCPRO1 (args);
Lisp_Object val = Qnil;
while (CONSP (args))
{
@ -357,7 +345,6 @@ usage: (or CONDITIONS...) */)
args = XCDR (args);
}
UNGCPRO;
return val;
}
@ -368,10 +355,7 @@ If no arg yields nil, return the last arg's value.
usage: (and CONDITIONS...) */)
(Lisp_Object args)
{
register Lisp_Object val = Qt;
struct gcpro gcpro1;
GCPRO1 (args);
Lisp_Object val = Qt;
while (CONSP (args))
{
@ -381,7 +365,6 @@ usage: (and CONDITIONS...) */)
args = XCDR (args);
}
UNGCPRO;
return val;
}
@ -394,11 +377,8 @@ usage: (if COND THEN ELSE...) */)
(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)));
@ -418,9 +398,7 @@ usage: (cond CLAUSES...) */)
(Lisp_Object args)
{
Lisp_Object val = args;
struct gcpro gcpro1;
GCPRO1 (args);
while (CONSP (args))
{
Lisp_Object clause = XCAR (args);
@ -433,7 +411,6 @@ usage: (cond CLAUSES...) */)
}
args = XCDR (args);
}
UNGCPRO;
return val;
}
@ -444,9 +421,6 @@ usage: (progn BODY...) */)
(Lisp_Object body)
{
Lisp_Object val = Qnil;
struct gcpro gcpro1;
GCPRO1 (body);
while (CONSP (body))
{
@ -454,7 +428,6 @@ usage: (progn BODY...) */)
body = XCDR (body);
}
UNGCPRO;
return val;
}
@ -476,17 +449,14 @@ usage: (prog1 FIRST BODY...) */)
{
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;
}
@ -497,11 +467,7 @@ remaining args, whose values are discarded.
usage: (prog2 FORM1 FORM2 BODY...) */)
(Lisp_Object args)
{
struct gcpro gcpro1;
GCPRO1 (args);
eval_sub (XCAR (args));
UNGCPRO;
return Fprog1 (XCDR (args));
}
@ -522,8 +488,6 @@ usage: (setq [SYM VAL]...) */)
if (CONSP (args))
{
Lisp_Object args_left = args;
struct gcpro gcpro1;
GCPRO1 (args);
do
{
@ -543,8 +507,6 @@ usage: (setq [SYM VAL]...) */)
args_left = Fcdr (XCDR (args_left));
}
while (CONSP (args_left));
UNGCPRO;
}
return val;
@ -854,9 +816,6 @@ usage: (let* VARLIST BODY...) */)
{
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;
@ -900,7 +859,7 @@ usage: (let* VARLIST BODY...) */)
varlist = XCDR (varlist);
}
UNGCPRO;
val = Fprogn (XCDR (args));
return unbind_to (count, val);
}
@ -915,10 +874,9 @@ usage: (let VARLIST BODY...) */)
(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);
@ -929,9 +887,6 @@ usage: (let VARLIST BODY...) */)
/* Compute the values and store them in `temps'. */
GCPRO2 (args, *temps);
gcpro2.nvars = 0;
for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
{
QUIT;
@ -942,9 +897,7 @@ usage: (let VARLIST BODY...) */)
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;
@ -984,9 +937,6 @@ usage: (while TEST BODY...) */)
(Lisp_Object args)
{
Lisp_Object test, body;
struct gcpro gcpro1, gcpro2;
GCPRO2 (test, body);
test = XCAR (args);
body = XCDR (args);
@ -996,7 +946,6 @@ usage: (while TEST BODY...) */)
Fprogn (body);
}
UNGCPRO;
return Qnil;
}
@ -1043,10 +992,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */)
{
/* 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;
@ -1082,12 +1028,7 @@ If a throw happens, it specifies the value to return from `catch'.
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));
}
@ -1172,10 +1113,6 @@ unwind_to_catch (struct handler *catch, Lisp_Object value)
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);
@ -1932,7 +1869,6 @@ it defines a macro. */)
(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;
@ -1951,7 +1887,6 @@ it defines a macro. */)
SDATA (SYMBOL_NAME (funname)));
CHECK_SYMBOL (funname);
GCPRO3 (funname, fundef, macro_only);
/* Preserve the match data. */
record_unwind_save_match_data ();
@ -1974,8 +1909,6 @@ it defines a macro. */)
Vautoload_queue = Qt;
unbind_to (count, Qnil);
UNGCPRO;
if (NILP (funname))
return Qnil;
else
@ -2063,7 +1996,6 @@ eval_sub (Lisp_Object form)
{
Lisp_Object fun, val, original_fun, original_args;
Lisp_Object funcar;
struct gcpro gcpro1, gcpro2, gcpro3;
ptrdiff_t count;
if (SYMBOLP (form))
@ -2086,9 +2018,7 @@ eval_sub (Lisp_Object form)
QUIT;
GCPRO1 (form);
maybe_gc ();
UNGCPRO;
if (++lisp_eval_depth > max_lisp_eval_depth)
{
@ -2146,38 +2076,26 @@ eval_sub (Lisp_Object form)
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)
@ -2341,7 +2259,6 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
spread_arg = XCDR (spread_arg);
}
/* Ffuncall gcpro's all of its args. */
retval = Ffuncall (funcall_nargs, funcall_args);
SAFE_FREE ();
@ -2470,16 +2387,13 @@ usage: (run-hook-wrapped HOOK WRAP-FUNCTION &rest ARGS) */)
/* 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. */
@ -2499,7 +2413,6 @@ run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args,
else
{
Lisp_Object global_vals = Qnil;
GCPRO3 (sym, val, global_vals);
for (;
CONSP (val) && NILP (ret);
@ -2538,7 +2451,6 @@ run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args,
}
}
UNGCPRO;
return ret;
}
}
@ -2633,8 +2545,6 @@ call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
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)
@ -2669,10 +2579,8 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
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)
@ -2808,28 +2716,21 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count)
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);
@ -3196,9 +3097,7 @@ Lisp_Object
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)
@ -3265,7 +3164,6 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
if (NILP (Vquit_flag) && !NILP (quitf))
Vquit_flag = quitf;
UNGCPRO;
return value;
}

101
src/fileio.c
View file

@ -867,11 +867,7 @@ filesystem tree, not (expand-file-name ".." dirname). */)
#endif /* not DOS_NT */
)
{
struct gcpro gcpro1;
GCPRO1 (name);
default_directory = Fexpand_file_name (default_directory, Qnil);
UNGCPRO;
}
}
multibyte = STRING_MULTIBYTE (name);
@ -1793,7 +1789,6 @@ barf_or_query_if_file_exists (Lisp_Object absname, bool known_to_exist,
{
Lisp_Object tem, encoded_filename;
struct stat statbuf;
struct gcpro gcpro1;
encoded_filename = ENCODE_FILE (absname);
@ -1810,14 +1805,12 @@ barf_or_query_if_file_exists (Lisp_Object absname, bool known_to_exist,
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);
@ -1858,7 +1851,6 @@ permissions. */)
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
@ -1875,7 +1867,6 @@ permissions. */)
#endif
encoded_file = encoded_newname = Qnil;
GCPRO4 (file, newname, encoded_file, encoded_newname);
CHECK_STRING (file);
CHECK_STRING (newname);
@ -1893,9 +1884,9 @@ permissions. */)
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);
@ -2095,7 +2086,6 @@ permissions. */)
/* Discard the unwind protects. */
specpdl_ptr = specpdl + count;
UNGCPRO;
return Qnil;
}
@ -2165,15 +2155,12 @@ With a prefix argument, TRASH is nil. */)
{
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);
@ -2220,11 +2207,9 @@ This is what happens in interactive use with M-x. */)
(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);
@ -2250,8 +2235,8 @@ This is what happens in interactive use with M-x. */)
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);
@ -2297,7 +2282,7 @@ This is what happens in interactive use with M-x. */)
else
report_file_errno ("Renaming", list2 (file, newname), rename_errno);
}
UNGCPRO;
return Qnil;
}
@ -2312,9 +2297,7 @@ This is what happens in interactive use with M-x. */)
{
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);
@ -2329,15 +2312,15 @@ This is what happens in interactive use with M-x. */)
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);
@ -2354,7 +2337,6 @@ This is what happens in interactive use with M-x. */)
report_file_errno ("Adding new name", list2 (file, newname), link_errno);
}
UNGCPRO;
return Qnil;
}
@ -2370,9 +2352,7 @@ This happens for interactive use with M-x. */)
{
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);
@ -2391,15 +2371,15 @@ This happens for interactive use with M-x. */)
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);
@ -2417,23 +2397,17 @@ This happens for interactive use with M-x. */)
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;
}
@ -3185,16 +3159,13 @@ otherwise, if FILE2 does not exist, the answer is t. */)
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. */
@ -3204,10 +3175,8 @@ otherwise, if FILE2 does not exist, the answer is t. */)
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;
@ -3410,7 +3379,6 @@ by calling `format-decode', which see. */)
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;
@ -3450,8 +3418,6 @@ by calling `format-decode', which see. */)
orig_filename = Qnil;
old_undo = Qnil;
GCPRO5 (filename, val, p, orig_filename, old_undo);
CHECK_STRING (filename);
filename = Fexpand_file_name (filename, Qnil);
@ -3902,7 +3868,6 @@ by calling `format-decode', which see. */)
bool multibyte
= ! NILP (BVAR (current_buffer, enable_multibyte_characters));
Lisp_Object conversion_buffer;
struct gcpro gcpro1;
conversion_buffer = code_conversion_save (1, multibyte);
@ -3915,7 +3880,6 @@ by calling `format-decode', which see. */)
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
@ -3939,7 +3903,7 @@ by calling `format-decode', which see. */)
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);
@ -4511,7 +4475,7 @@ by calling `format-decode', which see. */)
if (NILP (val))
val = list2 (orig_filename, make_number (inserted));
RETURN_UNGCPRO (unbind_to (count, val));
return unbind_to (count, val);
}
static Lisp_Object build_annotations (Lisp_Object, Lisp_Object);
@ -4698,7 +4662,6 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
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;
@ -4709,7 +4672,6 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
validate_region (&start, &end);
visit_file = Qnil;
GCPRO5 (start, filename, visit, visit_file, lockname);
filename = Fexpand_file_name (filename, Qnil);
@ -4745,7 +4707,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
bset_filename (current_buffer, visit_file);
}
UNGCPRO;
return val;
}
@ -4785,10 +4747,6 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
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
@ -4825,7 +4783,6 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
int open_errno = errno;
if (file_locked)
unlock_file (lockname);
UNGCPRO;
report_file_errno ("Opening output file", filename, open_errno);
}
@ -4841,13 +4798,10 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
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))
@ -5046,7 +5000,6 @@ build_annotations (Lisp_Object start, Lisp_Object end)
{
Lisp_Object annotations;
Lisp_Object p, res;
struct gcpro gcpro1, gcpro2;
Lisp_Object original_buffer;
int i;
bool used_global = false;
@ -5055,7 +5008,6 @@ build_annotations (Lisp_Object start, Lisp_Object end)
annotations = Qnil;
p = Vwrite_region_annotate_functions;
GCPRO2 (annotations, p);
while (CONSP (p))
{
struct buffer *given_buffer = current_buffer;
@ -5115,7 +5067,6 @@ build_annotations (Lisp_Object start, Lisp_Object end)
annotations = merge (annotations, res, Qcar_less_than_car);
}
UNGCPRO;
return annotations;
}
@ -5386,7 +5337,6 @@ auto_save_error (Lisp_Object error_val)
{
Lisp_Object msg;
int i;
struct gcpro gcpro1;
auto_save_error_occurred = 1;
@ -5395,7 +5345,6 @@ auto_save_error (Lisp_Object error_val)
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)
{
@ -5406,7 +5355,6 @@ auto_save_error (Lisp_Object error_val)
Fsleep_for (make_number (1), Qnil);
}
UNGCPRO;
return Qnil;
}
@ -5498,7 +5446,6 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
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;
@ -5517,9 +5464,6 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
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);
@ -5535,14 +5479,11 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
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");

4
src/filelock.c
View file

@ -666,7 +666,6 @@ lock_file (Lisp_Object fn)
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.
@ -676,7 +675,6 @@ lock_file (Lisp_Object fn)
return;
orig_fn = fn;
GCPRO1 (fn);
fn = Fexpand_file_name (fn, Qnil);
#ifdef WINDOWSNT
/* Ensure we have only '/' separators, to avoid problems with
@ -727,8 +725,6 @@ lock_file (Lisp_Object fn)
}
SAFE_FREE ();
}
UNGCPRO;
}
void

91
src/fns.c
View file

@ -1863,8 +1863,7 @@ static Lisp_Object
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;
@ -1878,10 +1877,8 @@ sort_list (Lisp_Object list, Lisp_Object predicate)
back = Fcdr (tem);
Fsetcdr (tem, Qnil);
GCPRO2 (front, back);
front = Fsort (front, predicate);
back = Fsort (back, predicate);
UNGCPRO;
return merge (front, back, predicate);
}
@ -1977,15 +1974,12 @@ sort_vector (Lisp_Object vector, Lisp_Object 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,
@ -2008,27 +2002,15 @@ the second. */)
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);
@ -2036,12 +2018,13 @@ merge (Lisp_Object org_l1, Lisp_Object org_l2, Lisp_Object pred)
}
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;
@ -2504,22 +2487,6 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
{
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))
{
@ -2566,8 +2533,6 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
tail = XCDR (tail);
}
}
UNGCPRO;
}
DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
@ -2578,11 +2543,10 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
(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;
@ -2595,9 +2559,7 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
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];
@ -2655,9 +2617,7 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
}
/* 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)
@ -2665,8 +2625,6 @@ 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.
@ -2681,7 +2639,6 @@ if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */)
(Lisp_Object prompt)
{
Lisp_Object ans;
struct gcpro gcpro1;
CHECK_STRING (prompt);
@ -2692,16 +2649,13 @@ if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */)
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)
{
@ -2709,15 +2663,9 @@ if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */)
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 ();
@ -2834,7 +2782,6 @@ The normal messages at start and end of loading FILENAME are suppressed. */)
(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);
@ -2890,10 +2837,8 @@ The normal messages at start and end of loading FILENAME are suppressed. */)
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))
@ -2979,15 +2924,11 @@ ARGS are passed as extra arguments to the function.
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;
}
@ -3030,8 +2971,6 @@ The data read from the system are decoded using `locale-coding-system'. */)
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++)
{
@ -3042,7 +2981,6 @@ The data read from the system are decoded using `locale-coding-system'. */)
ASET (v, i, code_convert_string_norecord (val, Vlocale_coding_system,
0));
}
UNGCPRO;
return v;
}
#endif /* DAY_1 */
@ -3053,8 +2991,6 @@ The data read from the system are decoded using `locale-coding-system'. */)
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++)
{
@ -3063,7 +2999,6 @@ The data read from the system are decoded using `locale-coding-system'. */)
ASET (v, i, code_convert_string_norecord (val, Vlocale_coding_system,
0));
}
UNGCPRO;
return v;
}
#endif /* MON_1 */
@ -4015,7 +3950,6 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, EMACS_UINT *hash)
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);
@ -4079,7 +4013,6 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
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);

29
src/frame.c
View file

@ -611,10 +611,10 @@ struct frame *
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);
@ -735,10 +735,10 @@ make_frame (bool mini_p)
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);
@ -759,11 +759,9 @@ make_frame_without_minibuffer (register Lisp_Object mini_window, KBOARD *kb, Lis
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
@ -1855,7 +1853,6 @@ and returns whatever that function returns. */)
struct frame *f;
Lisp_Object lispy_dummy;
Lisp_Object x, y, retval;
struct gcpro gcpro1;
f = SELECTED_FRAME ();
x = y = Qnil;
@ -1881,10 +1878,9 @@ and returns whatever that function returns. */)
}
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,
@ -1901,7 +1897,6 @@ and nil for X and Y. */)
struct frame *f;
Lisp_Object lispy_dummy;
Lisp_Object x, y, retval;
struct gcpro gcpro1;
f = SELECTED_FRAME ();
x = y = Qnil;
@ -1919,10 +1914,9 @@ and nil for X and Y. */)
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
@ -2510,13 +2504,11 @@ If FRAME is omitted or nil, return information on the currently selected frame.
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))
{
@ -2586,7 +2578,6 @@ If FRAME is omitted or nil, return information on the currently selected frame.
store_in_alist (&alist, Qmenu_bar_lines, lines);
}
UNGCPRO;
return alist;
}
@ -3135,8 +3126,6 @@ x_set_frame_parameters (struct frame *f, Lisp_Object 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;

6
src/gtkutil.c
View file

@ -1928,9 +1928,7 @@ xg_get_file_with_chooser (struct frame *f,
if (default_filename)
{
Lisp_Object file;
struct gcpro gcpro1;
char *utf8_filename;
GCPRO1 (file);
file = build_string (default_filename);
@ -1955,8 +1953,6 @@ xg_get_file_with_chooser (struct frame *f,
gtk_file_chooser_set_current_name (GTK_FILE_CHOOSER (filewin), cp);
}
}
UNGCPRO;
}
*func = xg_get_file_name_from_chooser;
@ -4459,8 +4455,6 @@ find_rtl_image (struct frame *f, Lisp_Object image, Lisp_Object rtl)
{
int i;
Lisp_Object file, rtl_name;
struct gcpro gcpro1, gcpro2;
GCPRO2 (file, rtl_name);
rtl_name = Ffile_name_nondirectory (rtl);

4
src/indent.c
View file

@ -1984,7 +1984,6 @@ whether or not it is currently displayed in some window. */)
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;
@ -2000,7 +1999,6 @@ whether or not it is currently displayed in some window. */)
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. */
@ -2210,7 +2208,7 @@ whether or not it is currently displayed in some window. */)
old_charpos, old_bytepos);
}
RETURN_UNGCPRO (make_number (it.vpos));
return make_number (it.vpos);
}

19
src/insdel.c
View file

@ -892,7 +892,6 @@ insert_from_string_1 (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
ptrdiff_t nchars, ptrdiff_t nbytes,
bool inherit, bool before_markers)
{
struct gcpro gcpro1;
ptrdiff_t outgoing_nbytes = nbytes;
INTERVAL intervals;
@ -906,7 +905,6 @@ insert_from_string_1 (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
= 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. */
@ -916,7 +914,6 @@ insert_from_string_1 (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
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. */
@ -1278,14 +1275,12 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new,
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)
@ -1295,8 +1290,6 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new,
to = from + range_length;
}
UNGCPRO;
/* Make args be valid. */
if (from < BEGV)
from = BEGV;
@ -1321,8 +1314,6 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new,
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);
@ -1424,7 +1415,6 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new,
MODIFF++;
CHARS_MODIFF = MODIFF;
UNGCPRO;
signal_after_change (from, nchars_del, GPT - from);
update_compositions (from, GPT, CHECK_BORDER);
@ -1561,7 +1551,6 @@ del_range_1 (ptrdiff_t from, ptrdiff_t to, bool prepare, bool ret_string)
{
ptrdiff_t from_byte, to_byte;
Lisp_Object deletion;
struct gcpro gcpro1;
/* Make args be valid */
if (from < BEGV)
@ -1583,10 +1572,8 @@ del_range_1 (ptrdiff_t from, ptrdiff_t to, bool prepare, bool ret_string)
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;
}
@ -1806,13 +1793,10 @@ prepare_to_modify_buffer_1 (ptrdiff_t start, ptrdiff_t end,
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);
@ -1970,7 +1954,6 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int,
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;
@ -1979,7 +1962,6 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int,
preserve_marker = Qnil;
start_marker = Qnil;
end_marker = Qnil;
GCPRO3 (preserve_marker, start_marker, end_marker);
specbind (Qinhibit_modification_hooks, Qt);
@ -2025,7 +2007,6 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int,
if (! NILP (end_marker))
free_marker (end_marker);
RESTORE_VALUE;
UNGCPRO;
unbind_to (count, Qnil);
}

84
src/keyboard.c
View file

@ -1896,14 +1896,11 @@ safe_run_hook_funcall (ptrdiff_t nargs, Lisp_Object *args)
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;
}
@ -2219,8 +2216,6 @@ read_event_from_main_queue (struct timespec *end_time,
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);
}
@ -2389,7 +2384,6 @@ read_char (int commandflag, Lisp_Object map,
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;
@ -2402,8 +2396,6 @@ read_char (int commandflag, Lisp_Object map,
c = Qnil;
previous_echo_area_message = Qnil;
GCPRO2 (c, previous_echo_area_message);
retry:
recorded = false;
@ -2663,9 +2655,6 @@ read_char (int commandflag, Lisp_Object map,
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 */
}
}
@ -2807,10 +2796,7 @@ read_char (int commandflag, Lisp_Object map,
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. */
@ -2861,9 +2847,6 @@ read_char (int commandflag, Lisp_Object map,
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 */
}
}
@ -2883,12 +2866,7 @@ read_char (int commandflag, Lisp_Object map,
}
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:
@ -3042,7 +3020,6 @@ read_char (int commandflag, Lisp_Object map,
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. */
@ -3071,7 +3048,6 @@ read_char (int commandflag, Lisp_Object map,
keys = Fcopy_sequence (this_command_keys);
else
keys = Qnil;
GCPRO1 (keys);
/* Clear out this_command_keys. */
this_command_key_count = 0;
@ -3118,8 +3094,6 @@ read_char (int commandflag, Lisp_Object map,
if (saved_immediate_echo)
echo_now ();
UNGCPRO;
/* The input method can return no events. */
if (! CONSP (tem))
{
@ -3230,7 +3204,7 @@ read_char (int commandflag, Lisp_Object map,
exit:
RESUME_POLLING;
input_was_pending = input_pending;
RETURN_UNGCPRO (c);
return c;
}
/* Record a key that came from a mouse menu.
@ -4431,12 +4405,10 @@ timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers)
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))
@ -4561,14 +4533,12 @@ timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers)
/* 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;
}
@ -4587,7 +4557,6 @@ timer_check (void)
{
struct timespec nexttime;
Lisp_Object timers, idle_timers;
struct gcpro gcpro1, gcpro2;
Lisp_Object tem = Vinhibit_quit;
Vinhibit_quit = Qt;
@ -4606,15 +4575,12 @@ timer_check (void)
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;
}
@ -7596,7 +7562,6 @@ Lisp_Object item_properties;
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;
@ -7629,9 +7594,7 @@ menu_bar_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy1, void *dumm
/* 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;
@ -8108,11 +8071,6 @@ static void
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))
{
@ -8137,8 +8095,6 @@ process_tool_bar_item (Lisp_Object key, Lisp_Object def, Lisp_Object data, void
/* 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. */
@ -8818,9 +8774,7 @@ access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt,
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)));
@ -9016,9 +8970,6 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
/* 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;
@ -9250,7 +9201,6 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
if (EQ (key, Qt))
{
unbind_to (count, Qnil);
UNGCPRO;
return -1;
}
@ -9641,14 +9591,11 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
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);
@ -9675,11 +9622,9 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
/* 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.
@ -9688,7 +9633,6 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
fkey.end + 1 == t
&& (test_undefined (current_binding)),
&diff, prompt);
UNGCPRO;
if (done)
{
mock_input = diff + max (t, mock_input);
@ -9704,14 +9648,11 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
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);
@ -9853,7 +9794,6 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
add_command_key (keybuf[t]);
}
UNGCPRO;
return t;
}
@ -9864,8 +9804,7 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo,
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))
@ -9877,10 +9816,6 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo,
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;
@ -9911,7 +9846,7 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo,
Vquit_flag = Qt;
QUIT;
}
UNGCPRO;
return unbind_to (count,
((allow_string ? make_event_array : Fvector)
(i, keybuf)));
@ -10275,7 +10210,6 @@ On such systems, Emacs starts a subshell instead of suspending. */)
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");
@ -10285,7 +10219,6 @@ On such systems, Emacs starts a subshell instead of suspending. */)
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
@ -10309,7 +10242,6 @@ On such systems, Emacs starts a subshell instead of suspending. */)
run_hook (intern ("suspend-resume-hook"));
UNGCPRO;
return Qnil;
}
@ -10531,16 +10463,12 @@ handle_interrupt (bool in_signal_handler)
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. */

82
src/keymap.c
View file

@ -254,12 +254,7 @@ get_keymap (Lisp_Object object, bool error_if_not_keymap, bool autoload)
{
if (autoload)
{
struct gcpro gcpro1, gcpro2;
GCPRO2 (tem, object);
Fautoload_do_load (tem, object, Qnil);
UNGCPRO;
goto autoload_retry;
}
else
@ -322,12 +317,10 @@ Return PARENT. PARENT should be nil or another keymap. */)
(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))
@ -350,7 +343,7 @@ Return PARENT. PARENT should be nil or another keymap. */)
{
CHECK_IMPURE (prev);
XSETCDR (prev, parent);
RETURN_UNGCPRO (parent);
return parent;
}
prev = list;
}
@ -397,9 +390,7 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx,
{
/* 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)
@ -407,7 +398,6 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx,
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;
@ -429,9 +419,6 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx,
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)
@ -539,7 +526,7 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx,
}
QUIT;
}
UNGCPRO;
return EQ (Qunbound, retval) ? get_keyelt (t_binding, autoload) : retval;
}
}
@ -584,11 +571,9 @@ map_keymap_internal (Lisp_Object map,
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);
@ -614,7 +599,7 @@ map_keymap_internal (Lisp_Object map,
make_save_funcptr_ptr_obj ((voidfuncptr) fun, data,
args));
}
UNGCPRO;
return tail;
}
@ -630,8 +615,6 @@ void
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))
{
@ -645,7 +628,6 @@ map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args,
if (!CONSP (map))
map = get_keymap (map, 0, autoload);
}
UNGCPRO;
}
/* Same as map_keymap, but does it right, properly eliminating duplicate
@ -653,14 +635,11 @@ map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args,
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,
@ -670,11 +649,8 @@ the definition it is bound to. The event may be a character range.
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;
}
@ -1079,14 +1055,12 @@ binding KEY to DEF is added at the front of 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);
@ -1149,7 +1123,7 @@ binding KEY to DEF is added at the front of KEYMAP. */)
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);
@ -1233,14 +1207,12 @@ recognize the default bindings, just as `read-key-sequence' does. */)
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)
@ -1261,11 +1233,11 @@ recognize the default bindings, just as `read-key-sequence' does. */)
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;
}
@ -1744,14 +1716,10 @@ bindings; see the description of `lookup-key' for more details about this. */)
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])
@ -1761,10 +1729,9 @@ bindings; see the description of `lookup-key' for more details about this. */)
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);
}
@ -1922,8 +1889,6 @@ then the value includes only maps for prefixes that start with PREFIX. */)
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
@ -2553,7 +2518,6 @@ The optional 5th arg NO-REMAP alters how command remapping is handled:
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. */
@ -2576,8 +2540,6 @@ The optional 5th arg NO-REMAP alters how command remapping is handled:
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
@ -2603,11 +2565,11 @@ The optional 5th arg NO-REMAP alters how command remapping is handled:
/* 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,
@ -2676,14 +2638,12 @@ The optional 5th arg NO-REMAP alters how command remapping is handled:
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
@ -2769,7 +2729,6 @@ The optional argument MENUS, if non-nil, says to mention menu bindings.
Lisp_Object outbuf, shadow;
bool nomenu = NILP (menus);
Lisp_Object start1;
struct gcpro gcpro1;
const char *alternate_heading
= "\
@ -2780,8 +2739,6 @@ You type Translation\n\
CHECK_BUFFER (buffer);
shadow = Qnil;
GCPRO1 (shadow);
outbuf = Fcurrent_buffer ();
/* Report on alternates for keys. */
@ -2927,7 +2884,6 @@ You type Translation\n\
describe_map_tree (KVAR (current_kboard, Vinput_decode_map), 0, Qnil, prefix,
"\f\nInput decoding map translations", nomenu, 1, 0, 0);
UNGCPRO;
return Qnil;
}
@ -2959,7 +2915,6 @@ describe_map_tree (Lisp_Object startmap, bool partial, Lisp_Object shadow,
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
= "\
@ -2969,7 +2924,6 @@ key binding\n\
orig_maps = maps = Faccessible_keymaps (startmap, prefix);
seen = Qnil;
sub_shadows = Qnil;
GCPRO3 (maps, seen, sub_shadows);
if (nomenu)
{
@ -3065,8 +3019,6 @@ key binding\n\
if (something)
insert_string ("\n");
UNGCPRO;
}
static int previous_description_column;
@ -3178,7 +3130,6 @@ describe_map (Lisp_Object map, Lisp_Object prefix,
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. */
@ -3198,8 +3149,6 @@ describe_map (Lisp_Object map, Lisp_Object prefix,
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))
@ -3350,7 +3299,6 @@ describe_map (Lisp_Object map, Lisp_Object prefix,
}
SAFE_FREE ();
UNGCPRO;
}
static void
@ -3423,7 +3371,6 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
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;
@ -3449,7 +3396,6 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
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");
@ -3599,8 +3545,6 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
insert ("default", 7);
(*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
}
UNGCPRO;
}
/* Apropos - finding all symbols whose names match a regexp. */

273
src/lisp.h
View file

@ -3031,9 +3031,6 @@ struct handler
/* 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;
@ -3060,7 +3057,6 @@ struct handler
(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);
@ -3107,262 +3103,6 @@ extern void process_quit_flag (void);
extern Lisp_Object Vascii_downcase_table;
extern Lisp_Object Vascii_canon_table;
/* 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 *);
@ -3877,7 +3617,6 @@ extern void init_alloc (void);
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
@ -4320,10 +4059,7 @@ extern int read_bytecode_char (bool);
/* 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 *);
@ -4658,13 +4394,6 @@ lisp_word_count (ptrdiff_t nbytes)
# 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

45
src/lread.c
View file

@ -1025,7 +1025,6 @@ Return t if the file exists and loads successfully. */)
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;
@ -1044,10 +1043,7 @@ Return t if the file exists and loads successfully. */)
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
@ -1073,7 +1069,6 @@ Return t if the file exists and loads successfully. */)
{
Lisp_Object suffixes;
found = Qnil;
GCPRO2 (file, found);
if (! NILP (must_suffix))
{
@ -1101,7 +1096,6 @@ Return t if the file exists and loads successfully. */)
}
fd = openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer);
UNGCPRO;
}
if (fd == -1)
@ -1204,8 +1198,6 @@ Return t if the file exists and loads successfully. */)
struct stat s1, s2;
int result;
GCPRO3 (file, found, hist_file_name);
if (version < 0
&& ! (version = safe_to_load_version (fd)))
{
@ -1250,7 +1242,6 @@ Return t if the file exists and loads successfully. */)
}
}
} /* !load_prefer_newer */
UNGCPRO;
}
}
else
@ -1272,8 +1263,6 @@ Return t if the file exists and loads successfully. */)
}
}
GCPRO3 (file, found, hist_file_name);
if (fd < 0)
{
/* We somehow got here with fd == -2, meaning the file is deemed
@ -1339,8 +1328,6 @@ Return t if the file exists and loads successfully. */)
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;
@ -1430,7 +1417,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
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;
@ -1451,7 +1437,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
}
string = filename = encoded_fn = save_string = Qnil;
GCPRO7 (str, string, save_string, filename, path, suffixes, encoded_fn);
if (storeptr)
*storeptr = Qnil;
@ -1547,7 +1532,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
if (storeptr)
*storeptr = string;
SAFE_FREE ();
UNGCPRO;
return -2;
}
}
@ -1621,7 +1605,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
if (storeptr)
*storeptr = string;
SAFE_FREE ();
UNGCPRO;
return fd;
}
}
@ -1632,7 +1615,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
if (storeptr)
*storeptr = save_string;
SAFE_FREE ();
UNGCPRO;
return save_fd;
}
}
@ -1642,7 +1624,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
}
SAFE_FREE ();
UNGCPRO;
errno = last_errno;
return -1;
}
@ -1746,14 +1727,11 @@ readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand)
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));
@ -1775,10 +1753,9 @@ readevalloop (Lisp_Object readcharfun,
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;
@ -1813,7 +1790,7 @@ readevalloop (Lisp_Object readcharfun,
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);
@ -1826,8 +1803,6 @@ readevalloop (Lisp_Object readcharfun,
(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))
@ -1946,8 +1921,6 @@ readevalloop (Lisp_Object readcharfun,
build_load_history (sourcename,
stream || whole_buffer);
UNGCPRO;
unbind_to (count, Qnil);
}
@ -2664,14 +2637,12 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
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)
{
@ -2689,7 +2660,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
invalid_syntax ("Invalid string property list");
Fset_text_properties (beg, end, plist, tmp);
}
UNGCPRO;
return tmp;
}
@ -3571,7 +3542,6 @@ read_list (bool flag, Lisp_Object readcharfun)
{
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. */
@ -3586,9 +3556,7 @@ read_list (bool flag, Lisp_Object readcharfun)
while (1)
{
int ch;
GCPRO2 (val, tail);
elt = read1 (readcharfun, &ch, first_in_list);
UNGCPRO;
first_in_list = 0;
@ -3631,13 +3599,12 @@ read_list (bool flag, Lisp_Object readcharfun)
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)

3
src/macros.c
View file

@ -294,7 +294,6 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */)
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;
@ -314,7 +313,6 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */)
Vreal_this_command));
record_unwind_protect (pop_kbd_macro, tem);
GCPRO2 (final, loopfunc);
do
{
Vexecuting_kbd_macro = final;
@ -344,7 +342,6 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */)
Vreal_this_command = Vexecuting_kbd_macro;
UNGCPRO;
return unbind_to (pdlcount, Qnil);
}

11
src/menu.c
View file

@ -276,7 +276,6 @@ single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
Lisp_Object prefix, int maxdepth)
{
struct skp skp;
struct gcpro gcpro1;
skp.pending_maps = Qnil;
skp.maxdepth = maxdepth;
@ -296,9 +295,7 @@ single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
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))
@ -325,14 +322,11 @@ static void
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. */
@ -1177,7 +1171,6 @@ no quit occurs and `x-popup-menu' returns nil. */)
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
@ -1329,7 +1322,6 @@ no quit occurs and `x-popup-menu' returns nil. */)
record_unwind_protect_void (unuse_menu_items);
title = Qnil;
GCPRO1 (title);
/* Decode the menu items from what was specified. */
@ -1422,7 +1414,6 @@ no quit occurs and `x-popup-menu' returns nil. */)
{
discard_menu_items ();
FRAME_DISPLAY_INFO (f)->grabbed = 0;
UNGCPRO;
return Qnil;
}
#endif
@ -1449,8 +1440,6 @@ no quit occurs and `x-popup-menu' returns nil. */)
FRAME_DISPLAY_INFO (f)->grabbed = 0;
#endif
UNGCPRO;
if (error_name) error ("%s", error_name);
return selection;
}

22
src/minibuf.c
View file

@ -150,12 +150,9 @@ static void run_exit_minibuf_hook (void);
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))
@ -181,7 +178,7 @@ string_to_object (Lisp_Object val, Lisp_Object defalt)
}
val = Fcar (expr_and_pos);
RETURN_UNGCPRO (val);
return val;
}
@ -384,7 +381,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
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. */
@ -437,11 +433,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
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;
@ -466,7 +457,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
make_number (pos),
expflag, histvar, histpos, defalt,
allow_props, inherit_input_method);
UNGCPRO;
return unbind_to (count, val);
}
@ -758,7 +748,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
/* The appropriate frame will get selected
in set-window-configuration. */
UNGCPRO;
return unbind_to (count, val);
}
@ -936,7 +925,6 @@ and some related functions, which use zero-indexing for POSITION. */)
(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))
@ -959,13 +947,11 @@ and some related functions, which use zero-indexing for POSITION. */)
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;
}
@ -1212,7 +1198,6 @@ is used to further constrain the set of candidates. */)
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)
@ -1325,13 +1310,11 @@ is used to further constrain the set of candidates. */)
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;
}
@ -1469,7 +1452,6 @@ with a space are ignored unless STRING itself starts with a space. */)
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)
@ -1587,12 +1569,10 @@ with a space are ignored unless STRING itself starts with a space. */)
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;
}

16
src/nsfns.m
View file

@ -408,14 +408,11 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
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)];
@ -534,7 +531,6 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
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);
@ -555,9 +551,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
name = build_string ([ns_app_name UTF8String]);
}
GCPRO1 (name);
encoded_name = ENCODE_UTF_8 (name);
UNGCPRO;
view = FRAME_NS_VIEW (f);
@ -582,9 +576,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
if (! NILP (filename))
{
GCPRO1 (filename);
encoded_filename = ENCODE_UTF_8 (filename);
UNGCPRO;
fstr = [NSString stringWithUTF8String: SSDATA (encoded_filename)];
if (fstr == nil) fstr = @"";
@ -1085,7 +1077,6 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
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;
@ -1127,7 +1118,6 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
/* 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))
@ -1368,8 +1358,6 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
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);
@ -2775,7 +2763,6 @@ with offset DY added (default is -10).
(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;
@ -2783,8 +2770,6 @@ with offset DY added (default is -10).
specbind (Qinhibit_redisplay, Qt);
GCPRO4 (string, parms, frame, timeout);
CHECK_STRING (string);
str = SSDATA (string);
f = decode_window_system_frame (frame);
@ -2820,7 +2805,6 @@ with offset DY added (default is -10).
[ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)];
unblock_input ();
UNGCPRO;
return unbind_to (count, Qnil);
}

37
src/print.c
View file

@ -465,8 +465,6 @@ print_string (Lisp_Object string, Lisp_Object printcharfun)
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);
@ -480,7 +478,6 @@ print_string (Lisp_Object string, Lisp_Object printcharfun)
printchar (ch, printcharfun);
i += len;
}
UNGCPRO;
}
}
@ -739,17 +736,13 @@ If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
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;
}
@ -854,7 +847,6 @@ error message is constructed. */)
{
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
@ -870,10 +862,8 @@ error message is constructed. */)
set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
value = Fbuffer_string ();
GCPRO1 (value);
Ferase_buffer ();
set_buffer_internal (old);
UNGCPRO;
return value;
}
@ -888,7 +878,6 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
Lisp_Object caller)
{
Lisp_Object errname, errmsg, file_error, tail;
struct gcpro gcpro1;
if (context != 0)
write_string_1 (context, stream);
@ -927,7 +916,6 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
/* 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. */
@ -958,8 +946,6 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
Fprin1 (obj, stream);
}
}
UNGCPRO;
}
@ -1428,16 +1414,13 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
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);
@ -1507,8 +1490,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
0, print_interval, printcharfun);
printchar (')', printcharfun);
}
UNGCPRO;
}
break;
@ -1702,11 +1683,9 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
{
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);
@ -1743,8 +1722,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
if (size_in_chars < real_size_in_chars)
print_c_string (" ...", printcharfun);
printchar ('\"', printcharfun);
UNGCPRO;
}
else if (SUBRP (obj))
{
@ -2041,8 +2018,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
{
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. */
@ -2067,16 +2042,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
}
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
{

83
src/process.c
View file

@ -1402,7 +1402,6 @@ usage: (make-process &rest ARGS) */)
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)
@ -1410,7 +1409,6 @@ usage: (make-process &rest ARGS) */)
/* Save arguments for process-contact and clone-process. */
contact = Flist (nargs, args);
GCPRO1 (contact);
buffer = Fplist_get (contact, QCbuffer);
if (!NILP (buffer))
@ -1419,18 +1417,8 @@ usage: (make-process &rest ARGS) */)
/* 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);
@ -1454,15 +1442,12 @@ usage: (make-process &rest ARGS) */)
}
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);
@ -1526,7 +1511,6 @@ usage: (make-process &rest ARGS) */)
/* 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))
@ -1548,10 +1532,8 @@ usage: (make-process &rest ARGS) */)
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))
@ -1580,10 +1562,8 @@ usage: (make-process &rest ARGS) */)
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);
@ -1616,13 +1596,9 @@ usage: (make-process &rest ARGS) */)
&& !(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);
@ -1638,8 +1614,6 @@ usage: (make-process &rest ARGS) */)
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. */
@ -1666,8 +1640,6 @@ usage: (make-process &rest ARGS) */)
new_argc++;
}
UNGCPRO;
/* Now that everything is encoded we can collect the strings into
NEW_ARGV. */
char **new_argv;
@ -1685,7 +1657,6 @@ usage: (make-process &rest ARGS) */)
else
create_pty (proc);
UNGCPRO;
SAFE_FREE ();
return unbind_to (count, proc);
}
@ -2110,7 +2081,6 @@ usage: (make-pipe-process &rest ARGS) */)
{
Lisp_Object proc, contact;
struct Lisp_Process *p;
struct gcpro gcpro1;
Lisp_Object name, buffer;
Lisp_Object tem;
ptrdiff_t specpdl_count;
@ -2120,7 +2090,6 @@ usage: (make-pipe-process &rest ARGS) */)
return Qnil;
contact = Flist (nargs, args);
GCPRO1 (contact);
name = Fplist_get (contact, QCname);
CHECK_STRING (name);
@ -2244,7 +2213,6 @@ usage: (make-pipe-process &rest ARGS) */)
specpdl_ptr = specpdl + specpdl_count;
UNGCPRO;
return proc;
}
@ -2727,10 +2695,8 @@ usage: (serial-process-configure &rest ARGS) */)
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))
@ -2745,14 +2711,9 @@ usage: (serial-process-configure &rest ARGS) */)
error ("Not a serial process");
if (NILP (Fplist_get (p->childp, QCspeed)))
{
UNGCPRO;
return Qnil;
}
return Qnil;
serial_configure (p, contact);
UNGCPRO;
return Qnil;
}
@ -2834,7 +2795,6 @@ usage: (make-serial-process &rest ARGS) */)
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;
@ -2843,7 +2803,6 @@ usage: (make-serial-process &rest ARGS) */)
return Qnil;
contact = Flist (nargs, args);
GCPRO1 (contact);
port = Fplist_get (contact, QCport);
if (NILP (port))
@ -2946,7 +2905,6 @@ usage: (make-serial-process &rest ARGS) */)
specpdl_ptr = specpdl + specpdl_count;
UNGCPRO;
return proc;
}
@ -3137,7 +3095,6 @@ usage: (make-network-process &rest ARGS) */)
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. */
@ -3155,7 +3112,6 @@ usage: (make-network-process &rest ARGS) */)
/* Save arguments for process-contact and clone-process. */
contact = Flist (nargs, args);
GCPRO1 (contact);
#ifdef WINDOWSNT
/* Ensure socket support is loaded if available. */
@ -3722,7 +3678,6 @@ usage: (make-network-process &rest ARGS) */)
{
/* 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;
@ -3747,13 +3702,9 @@ usage: (make-network-process &rest ARGS) */)
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))
@ -3780,13 +3731,9 @@ usage: (make-network-process &rest ARGS) */)
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);
@ -3806,7 +3753,6 @@ usage: (make-network-process &rest ARGS) */)
p->inherit_coding_system_flag
= !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
UNGCPRO;
return proc;
}
@ -5422,8 +5368,6 @@ read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
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);
@ -6605,8 +6549,6 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason)
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;
@ -6684,16 +6626,10 @@ status_notify (struct Lisp_Process *deleting_process,
{
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. */
@ -6754,7 +6690,6 @@ status_notify (struct Lisp_Process *deleting_process,
} /* end for */
update_mode_lines = 24; /* In case buffers use %s in mode-line-format. */
UNGCPRO;
return got_some_output;
}

3
src/sound.c
View file

@ -1351,7 +1351,6 @@ Internal use only, use `play-sound' instead. */)
{
Lisp_Object attrs[SOUND_ATTR_SENTINEL];
ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2;
#ifdef WINDOWSNT
unsigned long ui_volume_tmp = UINT_MAX;
@ -1363,7 +1362,6 @@ Internal use only, use `play-sound' instead. */)
error ("Invalid sound specification");
Lisp_Object file = Qnil;
GCPRO2 (sound, file);
#ifndef WINDOWSNT
current_sound_device = xzalloc (sizeof *current_sound_device);
@ -1452,7 +1450,6 @@ Internal use only, use `play-sound' instead. */)
#endif /* WINDOWSNT */
UNGCPRO;
return unbind_to (count, Qnil);
}

20
src/sysdep.c
View file

@ -2719,10 +2719,8 @@ Lisp_Object
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. */
@ -2737,7 +2735,6 @@ list_system_processes (void)
next = XCDR (tail);
XSETCAR (tail, Fstring_to_number (XCAR (tail), Qnil));
}
UNGCPRO;
/* directory_files_internal returns the files in reverse order; undo
that. */
@ -2759,7 +2756,6 @@ list_system_processes (void)
struct kinfo_proc *procs;
size_t i;
struct gcpro gcpro1;
Lisp_Object proclist = Qnil;
if (sysctl (mib, 3, NULL, &len, NULL, 0) != 0)
@ -2772,7 +2768,6 @@ list_system_processes (void)
return proclist;
}
GCPRO1 (proclist);
len /= sizeof (struct kinfo_proc);
for (i = 0; i < len; i++)
{
@ -2782,7 +2777,6 @@ list_system_processes (void)
proclist = Fcons (make_fixnum_or_float (procs[i].ki_pid), proclist);
#endif
}
UNGCPRO;
xfree (procs);
@ -2993,7 +2987,6 @@ system_process_attributes (Lisp_Object pid)
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);
@ -3001,8 +2994,6 @@ system_process_attributes (Lisp_Object 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);
@ -3191,7 +3182,6 @@ system_process_attributes (Lisp_Object pid)
attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs);
}
UNGCPRO;
return attrs;
}
@ -3230,7 +3220,6 @@ system_process_attributes (Lisp_Object pid)
gid_t gid;
Lisp_Object attrs = Qnil;
Lisp_Object decoded_cmd;
struct gcpro gcpro1, gcpro2;
ptrdiff_t count;
CHECK_NUMBER_OR_FLOAT (pid);
@ -3239,8 +3228,6 @@ system_process_attributes (Lisp_Object 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);
@ -3333,7 +3320,6 @@ system_process_attributes (Lisp_Object pid)
attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs);
}
unbind_to (count, Qnil);
UNGCPRO;
return attrs;
}
@ -3369,7 +3355,6 @@ system_process_attributes (Lisp_Object pid)
struct kinfo_proc proc;
size_t proclen = sizeof proc;
struct gcpro gcpro1, gcpro2;
Lisp_Object attrs = Qnil;
Lisp_Object decoded_comm;
@ -3380,8 +3365,6 @@ system_process_attributes (Lisp_Object pid)
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 ();
@ -3519,7 +3502,6 @@ system_process_attributes (Lisp_Object pid)
attrs = Fcons (Fcons (Qargs, decoded_comm), attrs);
}
UNGCPRO;
return attrs;
}

5
src/systime.h
View file

@ -83,9 +83,8 @@ extern struct timeval make_timeval (struct timespec) ATTRIBUTE_CONST;
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. */

40
src/textprop.c
View file

@ -375,15 +375,10 @@ add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object,
{
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)))
@ -396,9 +391,7 @@ add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object,
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. */
@ -456,8 +449,6 @@ add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object,
}
}
UNGCPRO;
return changed;
}
@ -1160,7 +1151,6 @@ add_text_properties_1 (Lisp_Object start, Lisp_Object end,
INTERVAL i, unchanged;
ptrdiff_t s, len;
bool modified = false;
struct gcpro gcpro1;
bool first_time = true;
properties = validate_plist (properties);
@ -1178,10 +1168,6 @@ add_text_properties_1 (Lisp_Object start, Lisp_Object end,
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))
{
@ -1190,7 +1176,7 @@ add_text_properties_1 (Lisp_Object start, Lisp_Object end,
do
{
if (got >= len)
RETURN_UNGCPRO (Qnil);
return Qnil;
len -= got;
i = next_interval (i);
got = LENGTH (i);
@ -1233,11 +1219,6 @@ add_text_properties_1 (Lisp_Object start, Lisp_Object end,
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))
@ -1906,7 +1887,6 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src,
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)
@ -1964,8 +1944,6 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src,
s = i->position;
}
GCPRO2 (stuff, dest);
while (! NILP (stuff))
{
res = Fcar (stuff);
@ -1976,8 +1954,6 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src,
stuff = Fcdr (stuff);
}
UNGCPRO;
return modified ? Qt : Qnil;
}
@ -2047,10 +2023,6 @@ text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp
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;
@ -2062,8 +2034,6 @@ add_text_properties_from_list (Lisp_Object object, Lisp_Object list, Lisp_Object
Fadd_text_properties (start, end, plist, object);
}
UNGCPRO;
}
@ -2111,14 +2081,11 @@ extend_property_ranges (Lisp_Object list, Lisp_Object new_end)
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,
@ -2138,7 +2105,6 @@ verify_interval_modification (struct buffer *buf,
Lisp_Object hooks;
Lisp_Object prev_mod_hooks;
Lisp_Object mod_hooks;
struct gcpro gcpro1;
hooks = Qnil;
prev_mod_hooks = Qnil;
@ -2295,7 +2261,6 @@ verify_interval_modification (struct buffer *buf,
if (!inhibit_modification_hooks)
{
GCPRO1 (hooks);
hooks = Fnreverse (hooks);
while (! EQ (hooks, Qnil))
{
@ -2303,7 +2268,6 @@ verify_interval_modification (struct buffer *buf,
make_number (end));
hooks = Fcdr (hooks);
}
UNGCPRO;
}
}
}

13
src/w32.c
View file

@ -6544,7 +6544,6 @@ global_memory_status_ex (MEMORY_STATUS_EX *buf)
Lisp_Object
list_system_processes (void)
{
struct gcpro gcpro1;
Lisp_Object proclist = Qnil;
HANDLE h_snapshot;
@ -6556,8 +6555,6 @@ list_system_processes (void)
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))
@ -6567,7 +6564,6 @@ list_system_processes (void)
}
CloseHandle (h_snapshot);
UNGCPRO;
proclist = Fnreverse (proclist);
}
@ -6696,7 +6692,6 @@ process_times (HANDLE h_proc, Lisp_Object *ctime, Lisp_Object *etime,
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;
@ -6728,8 +6723,6 @@ system_process_attributes (Lisp_Object pid)
h_snapshot = create_toolhelp32_snapshot (TH32CS_SNAPPROCESS, 0);
GCPRO3 (attrs, decoded_cmd, tem);
if (h_snapshot != INVALID_HANDLE_VALUE)
{
PROCESSENTRY32 pe;
@ -6771,10 +6764,7 @@ system_process_attributes (Lisp_Object pid)
}
if (!found_proc)
{
UNGCPRO;
return Qnil;
}
return Qnil;
h_proc = OpenProcess (PROCESS_QUERY_INFORMATION | PROCESS_VM_READ,
FALSE, proc_id);
@ -6991,7 +6981,6 @@ system_process_attributes (Lisp_Object pid)
if (h_proc)
CloseHandle (h_proc);
UNGCPRO;
return attrs;
}

43
src/w32fns.c
View file

@ -4974,7 +4974,6 @@ This function is an internal primitive--use `make-frame' instead. */)
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;
@ -5023,7 +5022,6 @@ This function is an internal primitive--use `make-frame' instead. */)
/* 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))
@ -5285,8 +5283,6 @@ This function is an internal primitive--use `make-frame' instead. */)
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;
@ -5610,7 +5606,6 @@ w32_display_monitor_attributes_list (void)
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))
@ -5652,8 +5647,6 @@ w32_display_monitor_attributes_list (void)
}
}
GCPRO3 (attributes_list, primary_monitor_attributes, monitor_frames);
for (i = 0; i < n_monitors; i++)
{
Lisp_Object geometry, workarea, name, attributes = Qnil;
@ -5701,8 +5694,6 @@ w32_display_monitor_attributes_list (void)
if (!NILP (primary_monitor_attributes))
attributes_list = Fcons (primary_monitor_attributes, attributes_list);
UNGCPRO;
xfree (monitors);
return attributes_list;
@ -5889,20 +5880,15 @@ terminate Emacs if we can't open the connection.
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 ();
@ -6190,7 +6176,6 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
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;
@ -6215,7 +6200,6 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
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;
@ -6391,8 +6375,6 @@ x_create_tip_frame (struct w32_display_info *dpyinfo,
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++;
@ -6551,14 +6533,11 @@ Text larger than the specified size is clipped. */)
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))
@ -6840,7 +6819,6 @@ Text larger than the specified size is clipped. */)
tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
intern ("x-hide-tip"));
UNGCPRO;
return unbind_to (count, Qnil);
}
@ -6852,7 +6830,6 @@ Value is t if tooltip was open, nil otherwise. */)
{
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))
@ -6860,7 +6837,6 @@ Value is t if tooltip was open, nil otherwise. */)
frame = tip_frame;
timer = tip_timer;
GCPRO2 (frame, timer);
tip_frame = tip_timer = deleted = Qnil;
count = SPECPDL_INDEX ();
@ -6876,7 +6852,6 @@ Value is t if tooltip was open, nil otherwise. */)
deleted = Qt;
}
UNGCPRO;
return unbind_to (count, deleted);
}
@ -7049,13 +7024,7 @@ value of DIR as in previous invocations; this is standard Windows behavior. */)
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
@ -7284,15 +7253,13 @@ value of DIR as in previous invocations; this is standard Windows behavior. */)
Qfile_name_history,
default_filename,
Qnil);
UNGCPRO;
}
/* Make "Cancel" equivalent to C-g. */
if (NILP (filename))
Fsignal (Qquit, Qnil);
RETURN_UNGCPRO (filename);
return filename;
}
@ -7498,7 +7465,6 @@ a ShowWindow flag:
char *doc_a = NULL, *params_a = NULL, *ops_a = NULL;
Lisp_Object absdoc, handler;
BOOL success;
struct gcpro gcpro1;
#endif
CHECK_STRING (document);
@ -7598,7 +7564,6 @@ a ShowWindow flag:
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
@ -7622,7 +7587,6 @@ a ShowWindow flag:
}
else
document = ENCODE_FILE (document);
UNGCPRO;
current_dir = ENCODE_FILE (current_dir);
/* Cannot use filename_to_utf16/ansi with DOCUMENT, since it could
@ -7768,22 +7732,17 @@ w32_parse_hot_key (Lisp_Object key)
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");

4
src/w32proc.c
View file

@ -1748,13 +1748,9 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp)
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;

5
src/w32uniscribe.c
View file

@ -875,7 +875,6 @@ uniscribe_check_otf (LOGFONT *font, Lisp_Object otf_spec)
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)
@ -918,10 +917,6 @@ uniscribe_check_otf (LOGFONT *font, Lisp_Object otf_spec)
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++)
{

5
src/window.c
View file

@ -2633,7 +2633,6 @@ window_loop (enum window_loop type, Lisp_Object obj, bool mini,
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
@ -2667,7 +2666,6 @@ window_loop (enum window_loop type, Lisp_Object obj, bool mini,
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))
@ -2695,7 +2693,7 @@ window_loop (enum window_loop type, Lisp_Object obj, bool mini,
{
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
@ -2761,7 +2759,6 @@ window_loop (enum window_loop type, Lisp_Object obj, bool mini,
}
}
UNGCPRO;
return best_window;
}

46
src/xdisp.c
View file

@ -3720,10 +3720,8 @@ handle_fontified_prop (struct it *it)
else
{
Lisp_Object fns, fn;
struct gcpro gcpro1, gcpro2;
fns = Qnil;
GCPRO2 (val, fns);
for (; CONSP (val); val = XCDR (val))
{
@ -3748,8 +3746,6 @@ handle_fontified_prop (struct it *it)
else
safe_call1 (fn, pos);
}
UNGCPRO;
}
unbind_to (count, Qnil);
@ -4745,7 +4741,6 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
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
@ -4757,9 +4752,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
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);
}
@ -9835,9 +9828,6 @@ vadd_to_log (char const *format, va_list ap)
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;
@ -9847,8 +9837,6 @@ vadd_to_log (char const *format, va_list ap)
message_dolog (buffer, len - 1, true, STRING_MULTIBYTE (msg));
SAFE_FREE ();
UNGCPRO;
}
@ -9887,7 +9875,6 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool nlflag, bool multibyte)
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;
@ -9909,7 +9896,6 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool nlflag, bool multibyte)
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;
@ -10033,7 +10019,6 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool nlflag, bool multibyte)
TEMP_SET_PT_BOTH (marker_position (oldpoint),
marker_byte_position (oldpoint));
UNGCPRO;
unchain_marker (XMARKER (oldpoint));
unchain_marker (XMARKER (oldbegv));
unchain_marker (XMARKER (oldzv));
@ -10101,9 +10086,6 @@ message_log_check_duplicate (ptrdiff_t prev_bol_byte, ptrdiff_t this_bol_byte)
void
message3 (Lisp_Object m)
{
struct gcpro gcpro1;
GCPRO1 (m);
clear_message (true, true);
cancel_echoing ();
@ -10121,7 +10103,6 @@ message3 (Lisp_Object m)
}
if (! inhibit_message)
message3_nolog (m);
UNGCPRO;
}
/* Log the message M to stderr. Log an empty line if M is not a string. */
@ -10249,10 +10230,7 @@ message_with_string (const char *m, Lisp_Object string, bool log)
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);
@ -10267,8 +10245,6 @@ message_with_string (const char *m, Lisp_Object string, bool log)
buffer next time. */
message_buf_print = false;
}
UNGCPRO;
}
}
@ -11556,7 +11532,6 @@ prepare_menu_bars (void)
{
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
@ -11659,7 +11634,6 @@ prepare_menu_bars (void)
/* 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))
{
@ -11667,15 +11641,12 @@ prepare_menu_bars (void)
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);
@ -11861,7 +11832,6 @@ update_tool_bar (struct frame *f, bool save_match_data)
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
@ -11879,8 +11849,6 @@ update_tool_bar (struct frame *f, bool save_match_data)
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
@ -11912,8 +11880,6 @@ update_tool_bar (struct frame *f, bool save_match_data)
unblock_input ();
}
UNGCPRO;
unbind_to (count, Qnil);
set_buffer_internal_1 (prev);
}
@ -11930,11 +11896,9 @@ static void
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. */
@ -11954,11 +11918,8 @@ build_desired_tool_bar_string (struct frame *f)
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,
@ -12071,8 +12032,6 @@ build_desired_tool_bar_string (struct frame *f)
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
@ -12083,11 +12042,8 @@ build_desired_tool_bar_string (struct frame *f)
end = i + 1;
Fadd_text_properties (make_number (i), make_number (end),
props, f->desired_tool_bar_string);
UNGCPRO;
#undef PROP
}
UNGCPRO;
}

7
src/xfaces.c
View file

@ -2177,17 +2177,12 @@ merge_named_face (struct frame *f, Lisp_Object face_name, Lisp_Object *to,
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;
}

47
src/xfns.c
View file

@ -1323,8 +1323,6 @@ x_set_scroll_bar_background (struct frame *f, Lisp_Object value, Lisp_Object old
/* 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
@ -1386,13 +1384,10 @@ x_set_name_internal (struct frame *f, Lisp_Object name)
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
@ -2979,7 +2974,6 @@ This function is an internal primitive--use `make-frame' instead. */)
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;
@ -3018,11 +3012,7 @@ This function is an internal primitive--use `make-frame' instead. */)
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))
@ -3069,7 +3059,6 @@ This function is an internal primitive--use `make-frame' instead. */)
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
@ -3082,7 +3071,6 @@ This function is an internal primitive--use `make-frame' instead. */)
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)
@ -3095,7 +3083,6 @@ This function is an internal primitive--use `make-frame' instead. */)
= 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. */
@ -3397,8 +3384,6 @@ This function is an internal primitive--use `make-frame' instead. */)
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;
@ -4959,9 +4944,6 @@ x_window_property_intern (struct frame *f,
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,
@ -5020,7 +5002,6 @@ x_window_property_intern (struct frame *f,
if (tmp_data) XFree (tmp_data);
}
UNGCPRO;
return prop_value;
}
@ -5049,10 +5030,8 @@ no value of TYPE (always string in the MS Windows case). */)
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))
@ -5095,7 +5074,6 @@ no value of TYPE (always string in the MS Windows case). */)
unblock_input ();
UNGCPRO;
return prop_value;
}
@ -5157,7 +5135,6 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
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;
@ -5175,7 +5152,6 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
error ("Invalid frame name--not a string or nil");
frame = Qnil;
GCPRO3 (parms, name, frame);
f = make_frame (true);
XSETFRAME (frame, f);
@ -5223,7 +5199,6 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
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
@ -5236,7 +5211,6 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
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)
@ -5249,7 +5223,6 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
= 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
@ -5445,8 +5418,6 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
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++;
@ -5576,14 +5547,11 @@ Text larger than the specified size is clipped. */)
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);
@ -5839,7 +5807,6 @@ Text larger than the specified size is clipped. */)
tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
intern ("x-hide-tip"));
UNGCPRO;
return unbind_to (count, Qnil);
}
@ -5851,7 +5818,6 @@ Value is t if tooltip was open, nil otherwise. */)
{
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))
@ -5859,7 +5825,6 @@ Value is t if tooltip was open, nil otherwise. */)
frame = tip_frame;
timer = tip_timer;
GCPRO2 (frame, timer);
tip_frame = tip_timer = deleted = Qnil;
count = SPECPDL_INDEX ();
@ -5904,7 +5869,6 @@ Value is t if tooltip was open, nil otherwise. */)
#endif /* USE_LUCID */
}
UNGCPRO;
return unbind_to (count, deleted);
}
@ -5994,12 +5958,9 @@ value of DIR as in previous invocations; this is standard Windows behavior. */)
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");
@ -6124,7 +6085,6 @@ value of DIR as in previous invocations; this is standard Windows behavior. */)
file = Qnil;
unblock_input ();
UNGCPRO;
/* Make "Cancel" equivalent to C-g. */
if (NILP (file))
@ -6165,13 +6125,10 @@ value of DIR as in previous invocations; this is standard Windows behavior. */)
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");
@ -6200,7 +6157,6 @@ value of DIR as in previous invocations; this is standard Windows behavior. */)
}
unblock_input ();
UNGCPRO;
/* Make "Cancel" equivalent to C-g. */
if (NILP (file))
@ -6227,7 +6183,6 @@ nil, it defaults to the selected frame. */)
Lisp_Object font;
Lisp_Object font_param;
char *default_name = NULL;
struct gcpro gcpro1, gcpro2;
ptrdiff_t count = SPECPDL_INDEX ();
if (popup_activated ())
@ -6239,8 +6194,6 @@ nil, it defaults to the selected frame. */)
block_input ();
GCPRO2 (font_param, font);
XSETFONT (font, FRAME_FONT (f));
font_param = Ffont_get (font, QCname);
if (STRINGP (font_param))

17
src/xselect.c
View file

@ -384,8 +384,6 @@ x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
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,
@ -753,7 +751,6 @@ x_reply_selection_request (struct selection_input_event *event,
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);
@ -765,7 +762,6 @@ x_handle_selection_request (struct selection_input_event *event)
Lisp_Object local_selection_data;
bool success = false;
ptrdiff_t count = SPECPDL_INDEX ();
GCPRO2 (local_selection_data, target_symbol);
if (!dpyinfo) goto DONE;
@ -849,7 +845,6 @@ x_handle_selection_request (struct selection_input_event *event)
selection_symbol, target_symbol, success ? Qt : Qnil);
unbind_to (count, Qnil);
UNGCPRO;
}
/* Perform the requested selection conversion, and write the data to
@ -864,10 +859,8 @@ x_convert_selection (Lisp_Object selection_symbol,
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,
@ -891,7 +884,6 @@ x_convert_selection (Lisp_Object selection_symbol,
converted_selections = cs;
}
UNGCPRO;
return false;
}
@ -904,7 +896,6 @@ x_convert_selection (Lisp_Object selection_symbol,
cs->next = converted_selections;
converted_selections = cs;
lisp_data_to_selection_data (dpyinfo, lisp_selection, cs);
UNGCPRO;
return true;
}
@ -1968,9 +1959,7 @@ On Nextstep, TIME-STAMP and TERMINAL are unused. */)
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);
@ -1986,8 +1975,8 @@ On Nextstep, TIME-STAMP and TERMINAL are unused. */)
{
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)))
@ -1996,7 +1985,7 @@ On Nextstep, TIME-STAMP and TERMINAL are unused. */)
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,

8
src/xterm.c
View file

@ -11759,13 +11759,6 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
{
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 ();
@ -11776,7 +11769,6 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
block_input ();
terminal->next_terminal = terminal_list;
terminal_list = terminal;
UNGCPRO;
}
/* Don't let the initial kboard remain current longer than necessary.

50
test/automated/finalizer-tests.el
View file

@ -29,55 +29,5 @@
(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)))

14
test/automated/generator-tests.el
View file

@ -260,20 +260,6 @@ identical output.
(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