/* Storage allocation and gc for GNU Emacs Lisp interpreter.
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2014 Free Software
+Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2015 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
#endif /* MAX_SAVE_STACK > 0 */
-static Lisp_Object Qconses;
-static Lisp_Object Qsymbols;
-static Lisp_Object Qmiscs;
-static Lisp_Object Qstrings;
-static Lisp_Object Qvectors;
-static Lisp_Object Qfloats;
-static Lisp_Object Qintervals;
-static Lisp_Object Qbuffers;
-static Lisp_Object Qstring_bytes, Qvector_slots, Qheap;
-static Lisp_Object Qgc_cons_threshold;
-Lisp_Object Qautomatic_gc;
-Lisp_Object Qchar_table_extra_slots;
-
-/* Hook run after GC has finished. */
-
-static Lisp_Object Qpost_gc_hook;
-
static void mark_terminals (void);
static void gc_sweep (void);
static Lisp_Object make_pure_vector (ptrdiff_t);
return pointers_fit_in_lispobj_p () && !might_dump;
}
+/* Head of a circularly-linked list of extant finalizers. */
+static struct Lisp_Finalizer finalizers;
+
+/* Head of a circularly-linked list of finalizers that must be invoked
+ because we deemed them unreachable. This list must be global, and
+ not a local inside garbage_collect_1, in case we GC again while
+ running finalizers. */
+static struct Lisp_Finalizer doomed_finalizers;
+
\f
/************************************************************************
Malloc
/* Allocate other vector-like structures. */
struct Lisp_Vector *
-allocate_pseudovector (int memlen, int lisplen, enum pvec_type tag)
+allocate_pseudovector (int memlen, int lisplen,
+ int zerolen, enum pvec_type tag)
{
struct Lisp_Vector *v = allocate_vectorlike (memlen);
- int i;
/* Catch bogus values. */
- eassert (tag <= PVEC_FONT);
+ eassert (0 <= tag && tag <= PVEC_FONT);
+ eassert (0 <= lisplen && lisplen <= zerolen && zerolen <= memlen);
eassert (memlen - lisplen <= (1 << PSEUDOVECTOR_REST_BITS) - 1);
eassert (lisplen <= (1 << PSEUDOVECTOR_SIZE_BITS) - 1);
- /* Only the first lisplen slots will be traced normally by the GC. */
- for (i = 0; i < lisplen; ++i)
- v->contents[i] = Qnil;
-
+ /* Only the first LISPLEN slots will be traced normally by the GC. */
+ memclear (v->contents, zerolen * word_size);
XSETPVECTYPESIZE (v, tag, lisplen, memlen - lisplen);
return v;
}
return b;
}
-struct Lisp_Hash_Table *
-allocate_hash_table (void)
-{
- return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table, count, PVEC_HASH_TABLE);
-}
-
-struct window *
-allocate_window (void)
-{
- struct window *w;
-
- w = ALLOCATE_PSEUDOVECTOR (struct window, current_matrix, PVEC_WINDOW);
- /* Users assumes that non-Lisp data is zeroed. */
- memset (&w->current_matrix, 0,
- sizeof (*w) - offsetof (struct window, current_matrix));
- return w;
-}
-
-struct terminal *
-allocate_terminal (void)
-{
- struct terminal *t;
-
- t = ALLOCATE_PSEUDOVECTOR (struct terminal, next_terminal, PVEC_TERMINAL);
- /* Users assumes that non-Lisp data is zeroed. */
- memset (&t->next_terminal, 0,
- sizeof (*t) - offsetof (struct terminal, next_terminal));
- return t;
-}
-
-struct frame *
-allocate_frame (void)
-{
- struct frame *f;
-
- f = ALLOCATE_PSEUDOVECTOR (struct frame, face_cache, PVEC_FRAME);
- /* Users assumes that non-Lisp data is zeroed. */
- memset (&f->face_cache, 0,
- sizeof (*f) - offsetof (struct frame, face_cache));
- return f;
-}
-
-struct Lisp_Process *
-allocate_process (void)
-{
- struct Lisp_Process *p;
-
- p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS);
- /* Users assumes that non-Lisp data is zeroed. */
- memset (&p->pid, 0,
- sizeof (*p) - offsetof (struct Lisp_Process, pid));
- return p;
-}
-
DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0,
doc: /* Return a newly created vector of length LENGTH, with each element being INIT.
See also the function `vector'. */)
XSYMBOL (sym)->name = name;
}
+void
+init_symbol (Lisp_Object val, Lisp_Object name)
+{
+ struct Lisp_Symbol *p = XSYMBOL (val);
+ set_symbol_name (val, name);
+ set_symbol_plist (val, Qnil);
+ p->redirect = SYMBOL_PLAINVAL;
+ SET_SYMBOL_VAL (p, Qunbound);
+ set_symbol_function (val, Qnil);
+ set_symbol_next (val, NULL);
+ p->gcmarkbit = false;
+ p->interned = SYMBOL_UNINTERNED;
+ p->constant = 0;
+ p->declared_special = false;
+ p->pinned = false;
+}
+
DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
doc: /* Return a newly allocated uninterned symbol whose name is NAME.
Its value is void, and its function definition and property list are nil. */)
(Lisp_Object name)
{
- register Lisp_Object val;
- register struct Lisp_Symbol *p;
+ Lisp_Object val;
CHECK_STRING (name);
MALLOC_UNBLOCK_INPUT;
- p = XSYMBOL (val);
- set_symbol_name (val, name);
- set_symbol_plist (val, Qnil);
- p->redirect = SYMBOL_PLAINVAL;
- SET_SYMBOL_VAL (p, Qunbound);
- set_symbol_function (val, Qnil);
- set_symbol_next (val, NULL);
- p->gcmarkbit = false;
- p->interned = SYMBOL_UNINTERNED;
- p->constant = 0;
- p->declared_special = false;
- p->pinned = false;
+ init_symbol (val, name);
consing_since_gc += sizeof (struct Lisp_Symbol);
symbols_consed++;
total_free_symbols--;
};
/* Allocation of markers and other objects that share that structure.
- Works like allocation of conses. */
+ Works like allocation of conses. */
#define MARKER_BLOCK_SIZE \
((1020 - sizeof (struct marker_block *)) / sizeof (union aligned_Lisp_Misc))
}
}
+static void
+init_finalizer_list (struct Lisp_Finalizer *head)
+{
+ head->prev = head->next = head;
+}
+
+/* Insert FINALIZER before ELEMENT. */
+
+static void
+finalizer_insert (struct Lisp_Finalizer *element,
+ struct Lisp_Finalizer *finalizer)
+{
+ eassert (finalizer->prev == NULL);
+ eassert (finalizer->next == NULL);
+ finalizer->next = element;
+ finalizer->prev = element->prev;
+ finalizer->prev->next = finalizer;
+ element->prev = finalizer;
+}
+
+static void
+unchain_finalizer (struct Lisp_Finalizer *finalizer)
+{
+ if (finalizer->prev != NULL)
+ {
+ eassert (finalizer->next != NULL);
+ finalizer->prev->next = finalizer->next;
+ finalizer->next->prev = finalizer->prev;
+ finalizer->prev = finalizer->next = NULL;
+ }
+}
+
+static void
+mark_finalizer_list (struct Lisp_Finalizer *head)
+{
+ for (struct Lisp_Finalizer *finalizer = head->next;
+ finalizer != head;
+ finalizer = finalizer->next)
+ {
+ finalizer->base.gcmarkbit = true;
+ mark_object (finalizer->function);
+ }
+}
+
+/* Move doomed finalizers to list DEST from list SRC. A doomed
+ finalizer is one that is not GC-reachable and whose
+ finalizer->function is non-nil. */
+
+static void
+queue_doomed_finalizers (struct Lisp_Finalizer *dest,
+ struct Lisp_Finalizer *src)
+{
+ struct Lisp_Finalizer *finalizer = src->next;
+ while (finalizer != src)
+ {
+ struct Lisp_Finalizer *next = finalizer->next;
+ if (!finalizer->base.gcmarkbit && !NILP (finalizer->function))
+ {
+ unchain_finalizer (finalizer);
+ finalizer_insert (dest, finalizer);
+ }
+
+ finalizer = next;
+ }
+}
+
+static Lisp_Object
+run_finalizer_handler (Lisp_Object args)
+{
+ add_to_log ("finalizer failed: %S", args, Qnil);
+ return Qnil;
+}
+
+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
+run_finalizers (struct Lisp_Finalizer *finalizers)
+{
+ struct Lisp_Finalizer *finalizer;
+ Lisp_Object function;
+
+ while (finalizers->next != finalizers)
+ {
+ finalizer = finalizers->next;
+ eassert (finalizer->base.type == Lisp_Misc_Finalizer);
+ unchain_finalizer (finalizer);
+ function = finalizer->function;
+ if (!NILP (function))
+ {
+ finalizer->function = Qnil;
+ run_finalizer_function (function);
+ }
+ }
+}
+
+DEFUN ("make-finalizer", Fmake_finalizer, Smake_finalizer, 1, 1, 0,
+ doc: /* Make a finalizer that will run FUNCTION.
+FUNCTION will be called after garbage collection when the returned
+finalizer object becomes unreachable. If the finalizer object is
+reachable only through references from finalizer objects, it does not
+count as reachable for the purpose of deciding whether to run
+FUNCTION. FUNCTION will be run once per finalizer object. */)
+ (Lisp_Object function)
+{
+ Lisp_Object val = allocate_misc (Lisp_Misc_Finalizer);
+ struct Lisp_Finalizer *finalizer = XFINALIZER (val);
+ finalizer->function = function;
+ finalizer->prev = finalizer->next = NULL;
+ finalizer_insert (&finalizers, finalizer);
+ return val;
+}
\f
/************************************************************************
must not have been killed. */
return (m->type == MEM_TYPE_BUFFER
&& p == m->start
- && !NILP (((struct buffer *) p)->INTERNAL_FIELD (name)));
+ && !NILP (((struct buffer *) p)->name_));
}
#endif /* GC_MARK_STACK || defined GC_MALLOC_CHECK */
doc: /* Show information about live and zombie objects. */)
(void)
{
- Lisp_Object args[8], zombie_list = Qnil;
- EMACS_INT i;
- for (i = 0; i < min (MAX_ZOMBIES, nzombies); i++)
+ Lisp_Object zombie_list = Qnil;
+ for (int i = 0; i < min (MAX_ZOMBIES, nzombies); i++)
zombie_list = Fcons (zombies[i], zombie_list);
- args[0] = build_string ("%d GCs, avg live/zombies = %.2f/%.2f (%f%%), max %d/%d\nzombies: %S");
- args[1] = make_number (ngcs);
- args[2] = make_float (avg_live);
- args[3] = make_float (avg_zombies);
- args[4] = make_float (avg_zombies / avg_live / 100);
- args[5] = make_number (max_live);
- args[6] = make_number (max_zombies);
- args[7] = zombie_list;
- return Fmessage (8, args);
+ return CALLN (Fmessage,
+ build_string ("%d GCs, avg live/zombies = %.2f/%.2f"
+ " (%f%%), max %d/%d\nzombies: %S"),
+ 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 */
#endif
/* Mark Lisp objects referenced from the address range START+OFFSET..END
- or END+OFFSET..START. */
+ or END+OFFSET..START. */
static void ATTRIBUTE_NO_SANITIZE_ADDRESS
mark_memory (void *start, void *end)
#endif /* GC_MARK_STACK != 0 */
+static bool
+c_symbol_p (struct Lisp_Symbol *sym)
+{
+ char *lispsym_ptr = (char *) lispsym;
+ char *sym_ptr = (char *) sym;
+ ptrdiff_t lispsym_offset = sym_ptr - lispsym_ptr;
+ return 0 <= lispsym_offset && lispsym_offset < sizeof lispsym;
+}
/* Determine whether it is safe to access memory at address P. */
static int
if (PURE_POINTER_P (p))
return 1;
+ if (SYMBOLP (obj) && c_symbol_p (p))
+ return ((char *) p - (char *) lispsym) % sizeof lispsym[0] == 0;
+
if (p == &buffer_defaults || p == &buffer_local_symbols)
return 2;
return new;
}
-
DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
doc: /* Make a copy of object OBJ in pure storage.
Recursively copies contents of vectors and cons cells.
else if (FLOATP (obj))
obj = make_pure_float (XFLOAT_DATA (obj));
else if (STRINGP (obj))
- obj = make_pure_string (SSDATA (obj), SCHARS (obj),
- SBYTES (obj),
- STRING_MULTIBYTE (obj));
- else if (COMPILEDP (obj) || VECTORP (obj))
{
- register struct Lisp_Vector *vec;
+ if (XSTRING (obj)->intervals)
+ message ("Dropping text-properties when making string pure");
+ obj = make_pure_string (SSDATA (obj), SCHARS (obj),
+ SBYTES (obj),
+ STRING_MULTIBYTE (obj));
+ }
+ else if (COMPILEDP (obj) || VECTORP (obj) || HASH_TABLE_P (obj))
+ {
+ struct Lisp_Vector *objp = XVECTOR (obj);
+ ptrdiff_t nbytes = vector_nbytes (objp);
+ struct Lisp_Vector *vec = pure_alloc (nbytes, Lisp_Vectorlike);
register ptrdiff_t i;
- ptrdiff_t size;
-
- size = ASIZE (obj);
+ ptrdiff_t size = ASIZE (obj);
if (size & PSEUDOVECTOR_FLAG)
size &= PSEUDOVECTOR_SIZE_MASK;
- vec = XVECTOR (make_pure_vector (size));
+ memcpy (vec, objp, nbytes);
for (i = 0; i < size; i++)
- vec->contents[i] = purecopy (AREF (obj, i));
- if (COMPILEDP (obj))
- {
- XSETPVECTYPE (vec, PVEC_COMPILED);
- XSETCOMPILED (obj, vec);
- }
- else
- XSETVECTOR (obj, vec);
+ vec->contents[i] = purecopy (vec->contents[i]);
+ XSETVECTOR (obj, vec);
}
else if (SYMBOLP (obj))
{
- if (!XSYMBOL (obj)->pinned)
+ if (!XSYMBOL (obj)->pinned && !c_symbol_p (XSYMBOL (obj)))
{ /* We can't purify them, but they appear in many pure objects.
Mark them as `pinned' so we know to mark them at every GC cycle. */
XSYMBOL (obj)->pinned = true;
symbol_block_pinned = symbol_block;
}
+ /* Don't hash-cons it. */
return obj;
}
else
{
- Lisp_Object args[2];
- args[0] = build_pure_c_string ("Don't know how to purify: %S");
- args[1] = obj;
- Fsignal (Qerror, (Fcons (Fformat (2, args), Qnil)));
+ Lisp_Object fmt = build_pure_c_string ("Don't know how to purify: %S");
+ Fsignal (Qerror, list1 (CALLN (Fformat, fmt, obj)));
}
if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing. */
union aligned_Lisp_Symbol *sym = sblk->symbols, *end = sym + lim;
for (; sym < end; ++sym)
if (sym->s.pinned)
- mark_object (make_lisp_ptr (&sym->s, Lisp_Symbol));
+ mark_object (make_lisp_symbol (&sym->s));
lim = SYMBOL_BLOCK_SIZE;
}
return Qnil;
/* Record this function, so it appears on the profiler's backtraces. */
- record_in_backtrace (Qautomatic_gc, &Qnil, 0);
+ record_in_backtrace (Qautomatic_gc, 0, 0);
check_cons_list ();
mark_buffer (&buffer_defaults);
mark_buffer (&buffer_local_symbols);
+ for (i = 0; i < ARRAYELTS (lispsym); i++)
+ mark_object (builtin_lisp_symbol (i));
+
for (i = 0; i < staticidx; i++)
mark_object (*staticvec[i]);
mark_stack (end);
#endif
- /* Everything is now marked, except for the data in font caches
- and undo lists. They're compacted by removing an items which
- aren't reachable otherwise. */
+ /* 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. */
compact_font_caches ();
mark_object (BVAR (nextb, undo_list));
}
+ /* Now pre-sweep finalizers. Here, we add any unmarked finalizers
+ to doomed_finalizers so we can run their associated functions
+ after GC. It's important to scan finalizers at this stage so
+ that we can be sure that unmarked finalizers are really
+ unreachable except for references from their associated functions
+ and from other finalizers. */
+
+ queue_doomed_finalizers (&doomed_finalizers, &finalizers);
+ mark_finalizer_list (&doomed_finalizers);
+
gc_sweep ();
/* Clear the mark bits that we set in certain root slots. */
}
unbind_to (count, Qnil);
- {
- Lisp_Object total[11];
- int total_size = 10;
-
- total[0] = list4 (Qconses, make_number (sizeof (struct Lisp_Cons)),
- bounded_number (total_conses),
- bounded_number (total_free_conses));
-
- total[1] = list4 (Qsymbols, make_number (sizeof (struct Lisp_Symbol)),
- bounded_number (total_symbols),
- bounded_number (total_free_symbols));
-
- total[2] = list4 (Qmiscs, make_number (sizeof (union Lisp_Misc)),
- bounded_number (total_markers),
- bounded_number (total_free_markers));
-
- total[3] = list4 (Qstrings, make_number (sizeof (struct Lisp_String)),
- bounded_number (total_strings),
- bounded_number (total_free_strings));
- total[4] = list3 (Qstring_bytes, make_number (1),
- bounded_number (total_string_bytes));
-
- total[5] = list3 (Qvectors,
- make_number (header_size + sizeof (Lisp_Object)),
- bounded_number (total_vectors));
-
- total[6] = list4 (Qvector_slots, make_number (word_size),
- bounded_number (total_vector_slots),
- bounded_number (total_free_vector_slots));
-
- total[7] = list4 (Qfloats, make_number (sizeof (struct Lisp_Float)),
- bounded_number (total_floats),
- bounded_number (total_free_floats));
-
- total[8] = list4 (Qintervals, make_number (sizeof (struct interval)),
- bounded_number (total_intervals),
- bounded_number (total_free_intervals));
-
- total[9] = list3 (Qbuffers, make_number (sizeof (struct buffer)),
- bounded_number (total_buffers));
+ Lisp_Object total[] = {
+ list4 (Qconses, make_number (sizeof (struct Lisp_Cons)),
+ bounded_number (total_conses),
+ bounded_number (total_free_conses)),
+ list4 (Qsymbols, make_number (sizeof (struct Lisp_Symbol)),
+ bounded_number (total_symbols),
+ bounded_number (total_free_symbols)),
+ list4 (Qmiscs, make_number (sizeof (union Lisp_Misc)),
+ bounded_number (total_markers),
+ bounded_number (total_free_markers)),
+ list4 (Qstrings, make_number (sizeof (struct Lisp_String)),
+ bounded_number (total_strings),
+ bounded_number (total_free_strings)),
+ list3 (Qstring_bytes, make_number (1),
+ bounded_number (total_string_bytes)),
+ list3 (Qvectors,
+ make_number (header_size + sizeof (Lisp_Object)),
+ bounded_number (total_vectors)),
+ list4 (Qvector_slots, make_number (word_size),
+ bounded_number (total_vector_slots),
+ bounded_number (total_free_vector_slots)),
+ list4 (Qfloats, make_number (sizeof (struct Lisp_Float)),
+ bounded_number (total_floats),
+ bounded_number (total_free_floats)),
+ list4 (Qintervals, make_number (sizeof (struct interval)),
+ bounded_number (total_intervals),
+ bounded_number (total_free_intervals)),
+ list3 (Qbuffers, make_number (sizeof (struct buffer)),
+ bounded_number (total_buffers)),
#ifdef DOUG_LEA_MALLOC
- total_size++;
- total[10] = list4 (Qheap, make_number (1024),
- bounded_number ((mallinfo ().uordblks + 1023) >> 10),
- bounded_number ((mallinfo ().fordblks + 1023) >> 10));
+ list4 (Qheap, make_number (1024),
+ bounded_number ((mallinfo ().uordblks + 1023) >> 10),
+ bounded_number ((mallinfo ().fordblks + 1023) >> 10)),
#endif
- retval = Flist (total_size, total);
- }
+ };
+ retval = CALLMANY (Flist, total);
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
{
}
#endif
+ /* GC is complete: now we can run our finalizer callbacks. */
+ run_finalizers (&doomed_finalizers);
+
if (!NILP (Vpost_gc_hook))
{
ptrdiff_t gc_count = inhibit_garbage_collection ();
void
mark_object (Lisp_Object arg)
{
- register Lisp_Object obj = arg;
+ register Lisp_Object obj;
void *po;
#ifdef GC_CHECK_MARKED_OBJECTS
struct mem_node *m;
#endif
ptrdiff_t cdr_count = 0;
+ obj = arg;
loop:
po = XPNTR (obj);
emacs_abort (); \
} while (0)
- /* Check both of the above conditions. */
+ /* Check both of the above conditions, for non-symbols. */
#define CHECK_ALLOCATED_AND_LIVE(LIVEP) \
do { \
CHECK_ALLOCATED (); \
CHECK_LIVE (LIVEP); \
} while (0) \
+ /* Check both of the above conditions, for symbols. */
+#define CHECK_ALLOCATED_AND_LIVE_SYMBOL() \
+ do { \
+ if (!c_symbol_p (ptr)) \
+ { \
+ CHECK_ALLOCATED (); \
+ CHECK_LIVE (live_symbol_p); \
+ } \
+ } while (0) \
+
#else /* not GC_CHECK_MARKED_OBJECTS */
-#define CHECK_LIVE(LIVEP) ((void) 0)
-#define CHECK_ALLOCATED_AND_LIVE(LIVEP) ((void) 0)
+#define CHECK_LIVE(LIVEP) ((void) 0)
+#define CHECK_ALLOCATED_AND_LIVE(LIVEP) ((void) 0)
+#define CHECK_ALLOCATED_AND_LIVE_SYMBOL() ((void) 0)
#endif /* not GC_CHECK_MARKED_OBJECTS */
nextsym:
if (ptr->gcmarkbit)
break;
- CHECK_ALLOCATED_AND_LIVE (live_symbol_p);
+ CHECK_ALLOCATED_AND_LIVE_SYMBOL ();
ptr->gcmarkbit = 1;
/* Attempt to catch bogus objects. */
eassert (valid_lisp_object_p (ptr->function));
case Lisp_Misc_Overlay:
mark_overlay (XOVERLAY (obj));
- break;
+ break;
+
+ case Lisp_Misc_Finalizer:
+ XMISCANY (obj)->gcmarkbit = true;
+ mark_object (XFINALIZER (obj)->function);
+ break;
default:
emacs_abort ();
static void
sweep_symbols (void)
{
- register struct symbol_block *sblk;
+ struct symbol_block *sblk;
struct symbol_block **sprev = &symbol_block;
- register int lim = symbol_block_index;
- EMACS_INT num_free = 0, num_used = 0;
+ int lim = symbol_block_index;
+ EMACS_INT num_free = 0, num_used = ARRAYELTS (lispsym);
symbol_free_list = NULL;
+ for (int i = 0; i < ARRAYELTS (lispsym); i++)
+ lispsym[i].gcmarkbit = 0;
+
for (sblk = symbol_block; sblk; sblk = *sprev)
{
int this_free = 0;
total_free_symbols = num_free;
}
-NO_INLINE /* For better stack traces */
+NO_INLINE /* For better stack traces. */
static void
sweep_misc (void)
{
{
if (mblk->markers[i].m.u_any.type == Lisp_Misc_Marker)
unchain_marker (&mblk->markers[i].m.u_marker);
+ if (mblk->markers[i].m.u_any.type == Lisp_Misc_Finalizer)
+ unchain_finalizer (&mblk->markers[i].m.u_finalizer);
/* Set the type of the freed object to Lisp_Misc_Free.
We could leave the type alone, since nobody checks it,
but this might catch bugs faster. */
bounded_number (strings_consed));
}
+static bool
+symbol_uses_obj (Lisp_Object symbol, Lisp_Object obj)
+{
+ struct Lisp_Symbol *sym = XSYMBOL (symbol);
+ Lisp_Object val = find_symbol_value (symbol);
+ return (EQ (val, obj)
+ || EQ (sym->function, obj)
+ || (!NILP (sym->function)
+ && COMPILEDP (sym->function)
+ && EQ (AREF (sym->function, COMPILED_BYTECODE), obj))
+ || (!NILP (val)
+ && COMPILEDP (val)
+ && EQ (AREF (val, COMPILED_BYTECODE), obj)));
+}
+
/* Find at most FIND_MAX symbols which have OBJ as their value or
function. This is used in gdbinit's `xwhichsymbols' command. */
if (! DEADP (obj))
{
+ for (int i = 0; i < ARRAYELTS (lispsym); i++)
+ {
+ Lisp_Object sym = builtin_lisp_symbol (i);
+ if (symbol_uses_obj (sym, obj))
+ {
+ found = Fcons (sym, found);
+ if (--find_max == 0)
+ goto out;
+ }
+ }
+
for (sblk = symbol_block; sblk; sblk = sblk->next)
{
union aligned_Lisp_Symbol *aligned_sym = sblk->symbols;
for (bn = 0; bn < SYMBOL_BLOCK_SIZE; bn++, aligned_sym++)
{
- struct Lisp_Symbol *sym = &aligned_sym->s;
- Lisp_Object val;
- Lisp_Object tem;
-
if (sblk == symbol_block && bn >= symbol_block_index)
break;
- XSETSYMBOL (tem, sym);
- val = find_symbol_value (tem);
- if (EQ (val, obj)
- || EQ (sym->function, obj)
- || (!NILP (sym->function)
- && COMPILEDP (sym->function)
- && EQ (AREF (sym->function, COMPILED_BYTECODE), obj))
- || (!NILP (val)
- && COMPILEDP (val)
- && EQ (AREF (val, COMPILED_BYTECODE), obj)))
+ Lisp_Object sym = make_lisp_symbol (&aligned_sym->s);
+ if (symbol_uses_obj (sym, obj))
{
- found = Fcons (tem, found);
+ found = Fcons (sym, found);
if (--find_max == 0)
goto out;
}
void
init_alloc_once (void)
{
- /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */
+ /* 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;
verify_alloca ();
+ init_finalizer_list (&finalizers);
+ init_finalizer_list (&doomed_finalizers);
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
mem_init ();
DEFVAR_INT ("symbols-consed", symbols_consed,
doc: /* Number of symbols that have been consed so far. */);
+ symbols_consed += ARRAYELTS (lispsym);
DEFVAR_INT ("string-chars-consed", string_chars_consed,
doc: /* Number of string characters that have been consed so far. */);
doc: /* Accumulated time elapsed in garbage collections.
The time is in seconds as a floating point value. */);
DEFVAR_INT ("gcs-done", gcs_done,
- doc: /* Accumulated number of garbage collections 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 (&Smake_bool_vector);
defsubr (&Smake_symbol);
defsubr (&Smake_marker);
+ defsubr (&Smake_finalizer);
defsubr (&Spurecopy);
defsubr (&Sgarbage_collect);
defsubr (&Smemory_limit);