/* 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.
marked objects. */
#if (defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC \
- || defined GC_CHECK_MARKED_OBJECTS)
+ || defined HYBRID_MALLOC || defined GC_CHECK_MARKED_OBJECTS)
#undef GC_MALLOC_CHECK
#endif
#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);
static void mark_buffer (struct buffer *);
-#if !defined REL_ALLOC || defined SYSTEM_MALLOC
+#if !defined REL_ALLOC || defined SYSTEM_MALLOC || defined HYBRID_MALLOC
static void refill_memory_reserve (void);
#endif
static void compact_small_strings (void);
/* If we can't store all memory addresses in our lisp objects, it's
risky to let the heap use mmap and give us addresses from all
over our address space. We also can't use mmap for lisp objects
- if we might dump: unexec doesn't preserve the contents of mmaped
+ if we might dump: unexec doesn't preserve the contents of mmapped
regions. */
return pointers_fit_in_lispobj_p () && !might_dump;
}
/* Define XMALLOC_OVERRUN_SIZE_SIZE so that (1) it's large enough to
hold a size_t value and (2) the header size is a multiple of the
alignment that Emacs needs for C types and for USE_LSB_TAG. */
-#define XMALLOC_BASE_ALIGNMENT \
- alignof (union { long double d; intmax_t i; void *p; })
+#define XMALLOC_BASE_ALIGNMENT alignof (max_align_t)
#if USE_LSB_TAG
# define XMALLOC_HEADER_ALIGNMENT \
clang 3.3 anyway. */
#if ! ADDRESS_SANITIZER
-# if !defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC
+# if !defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC && !defined HYBRID_MALLOC
# define USE_ALIGNED_ALLOC 1
/* Defined in gmalloc.c. */
void *aligned_alloc (size_t, size_t);
+# elif defined HYBRID_MALLOC
+# if defined ALIGNED_ALLOC || defined HAVE_POSIX_MEMALIGN
+# define USE_ALIGNED_ALLOC 1
+# define aligned_alloc hybrid_aligned_alloc
+/* Defined in gmalloc.c. */
+void *aligned_alloc (size_t, size_t);
+# endif
# elif defined HAVE_ALIGNED_ALLOC
# define USE_ALIGNED_ALLOC 1
# elif defined HAVE_POSIX_MEMALIGN
return val;
}
-
-/* Make an unibyte string from LENGTH bytes at CONTENTS. */
+/* Make a unibyte string from LENGTH bytes at CONTENTS. */
Lisp_Object
make_unibyte_string (const char *contents, ptrdiff_t length)
}
-/* Return an unibyte Lisp_String set up to hold LENGTH characters
+/* Return a unibyte Lisp_String set up to hold LENGTH characters
occupying LENGTH bytes. */
Lisp_Object
Lisp_Object
listn (enum constype type, ptrdiff_t count, Lisp_Object arg, ...)
{
- va_list ap;
- ptrdiff_t i;
- Lisp_Object val, *objp;
+ Lisp_Object (*cons) (Lisp_Object, Lisp_Object);
+ switch (type)
+ {
+ case CONSTYPE_PURE: cons = pure_cons; break;
+ case CONSTYPE_HEAP: cons = Fcons; break;
+ default: emacs_abort ();
+ }
- /* Change to SAFE_ALLOCA if you hit this eassert. */
- eassert (count <= MAX_ALLOCA / word_size);
+ eassume (0 < count);
+ Lisp_Object val = cons (arg, Qnil);
+ Lisp_Object tail = val;
- objp = alloca (count * word_size);
- objp[0] = arg;
+ va_list ap;
va_start (ap, arg);
- for (i = 1; i < count; i++)
- objp[i] = va_arg (ap, Lisp_Object);
- va_end (ap);
-
- for (val = Qnil, i = count - 1; i >= 0; i--)
+ for (ptrdiff_t i = 1; i < count; i++)
{
- if (type == CONSTYPE_PURE)
- val = pure_cons (objp[i], val);
- else if (type == CONSTYPE_HEAP)
- val = Fcons (objp[i], val);
- else
- emacs_abort ();
+ Lisp_Object elem = cons (va_arg (ap, Lisp_Object), Qnil);
+ XSETCDR (tail, elem);
+ tail = elem;
}
+ va_end (ap);
+
return val;
}
static struct Lisp_Vector *
next_vector (struct Lisp_Vector *v)
{
- return XUNTAG (v->contents[0], 0);
+ return XUNTAG (v->contents[0], Lisp_Int0);
}
static void
set_next_vector (struct Lisp_Vector *v, struct Lisp_Vector *p)
{
- v->contents[0] = make_lisp_ptr (p, 0);
+ v->contents[0] = make_lisp_ptr (p, Lisp_Int0);
}
/* This value is balanced well enough to avoid too much internal overhead
/* 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'. */)
return vector;
}
-
DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
doc: /* Return a newly created vector with specified arguments as elements.
Any number of arguments, even zero arguments, are allowed.
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--;
void
refill_memory_reserve (void)
{
-#ifndef SYSTEM_MALLOC
+#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC
if (spare_memory[0] == 0)
spare_memory[0] = malloc (SPARE_MEMORY);
if (spare_memory[1] == 0)
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 /* 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
#ifdef WINDOWSNT
return w32_valid_pointer_p (p, 16);
#else
+
+ if (ADDRESS_SANITIZER)
+ return p ? -1 : 0;
+
int fd[2];
/* Obviously, we cannot just access it (we would SEGV trying), so we
return valid;
}
- return -1;
+ return -1;
#endif
}
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;
struct sdata *sdata
= (struct sdata *) (str - offsetof (struct sdata, data));
- if (valid_pointer_p (sdata)
- && valid_pointer_p (sdata->string)
+ 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))
}
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;
}
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]);
}
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
{
for (; ptr && !ptr->gcmarkbit; ptr = ptr->next)
{
ptr->gcmarkbit = 1;
- mark_object (ptr->start);
- mark_object (ptr->end);
+ /* These two are always markers and can be marked fast. */
+ XMARKER (ptr->start)->gcmarkbit = 1;
+ XMARKER (ptr->end)->gcmarkbit = 1;
mark_object (ptr->plist);
}
}
mark_object (Lisp_Object arg)
{
register Lisp_Object obj = arg;
-#ifdef GC_CHECK_MARKED_OBJECTS
void *po;
+#ifdef GC_CHECK_MARKED_OBJECTS
struct mem_node *m;
#endif
ptrdiff_t cdr_count = 0;
loop:
- if (PURE_POINTER_P (XPNTR (obj)))
+ po = XPNTR (obj);
+ if (PURE_POINTER_P (po))
return;
last_marked[last_marked_index++] = obj;
by ~80%, and requires compilation with GC_MARK_STACK != 0. */
#ifdef GC_CHECK_MARKED_OBJECTS
- po = (void *) XPNTR (obj);
-
/* Check that the object pointed to by PO is known to be a Lisp
structure allocated from the heap. */
#define CHECK_ALLOCATED() \
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) >= 1);
+ eassert (valid_lisp_object_p (ptr->function));
mark_object (ptr->function);
mark_object (ptr->plist);
switch (ptr->redirect)
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;
++num_used;
sym->s.gcmarkbit = 0;
/* Attempt to catch bogus objects. */
- eassert (valid_lisp_object_p (sym->s.function) >= 1);
+ eassert (valid_lisp_object_p (sym->s.function));
}
}
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;
}
DEFUN ("suspicious-object", Fsuspicious_object, Ssuspicious_object, 1, 1, 0,
doc: /* Return OBJ, maybe marking it for extra scrutiny.
-If Emacs is compiled with suspicous object checking, capture
+If Emacs is compiled with suspicious object checking, capture
a stack trace when OBJ is freed in order to help track down
garbage collection bugs. Otherwise, do nothing and return OBJ. */)
(Lisp_Object obj)
file, line, msg);
terminate_due_to_signal (SIGABRT, INT_MAX);
}
-#endif
-\f
+
+#endif /* ENABLE_CHECKING */
+
+#if defined (ENABLE_CHECKING) && USE_STACK_LISP_OBJECTS
+
+/* Debugging check whether STR is ASCII-only. */
+
+const char *
+verify_ascii (const char *str)
+{
+ const unsigned char *ptr = (unsigned char *) str, *end = ptr + strlen (str);
+ while (ptr < end)
+ {
+ int c = STRING_CHAR_ADVANCE (ptr);
+ if (!ASCII_CHAR_P (c))
+ emacs_abort ();
+ }
+ return str;
+}
+
+/* Stress alloca with inconveniently sized requests and check
+ whether all allocated areas may be used for Lisp_Object. */
+
+NO_INLINE static void
+verify_alloca (void)
+{
+ int i;
+ enum { ALLOCA_CHECK_MAX = 256 };
+ /* Start from size of the smallest Lisp object. */
+ for (i = sizeof (struct Lisp_Cons); i <= ALLOCA_CHECK_MAX; i++)
+ {
+ void *ptr = alloca (i);
+ make_lisp_ptr (ptr, Lisp_Cons);
+ }
+}
+
+#else /* not ENABLE_CHECKING && USE_STACK_LISP_OBJECTS */
+
+#define verify_alloca() ((void) 0)
+
+#endif /* ENABLE_CHECKING && USE_STACK_LISP_OBJECTS */
+
/* Initialization. */
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;
+
purebeg = PUREBEG;
pure_size = PURESIZE;
+ verify_alloca ();
+
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
mem_init ();
Vdead = make_pure_string ("DEAD", 4, 4, 0);
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. */);