static struct mem_node mem_z;
#define MEM_NIL &mem_z
-static struct Lisp_Vector *allocate_vectorlike (ptrdiff_t);
-static void lisp_free (void *);
-static void mark_stack (void);
-static bool live_vector_p (struct mem_node *, void *);
-static bool live_buffer_p (struct mem_node *, void *);
-static bool live_string_p (struct mem_node *, void *);
-static bool live_cons_p (struct mem_node *, void *);
-static bool live_symbol_p (struct mem_node *, void *);
-static bool live_float_p (struct mem_node *, void *);
-static bool live_misc_p (struct mem_node *, void *);
-static void mark_maybe_object (Lisp_Object);
-static void mark_memory (void *, void *);
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
-static void mem_init (void);
static struct mem_node *mem_insert (void *, void *, enum mem_type);
static void mem_insert_fixup (struct mem_node *);
static void mem_rotate_left (struct mem_node *);
static struct mem_node *mem_find (void *);
#endif
-
-#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
-static void check_gcpros (void);
-#endif
-
#endif /* GC_MARK_STACK || GC_MALLOC_CHECK */
#ifndef DEADP
((void *) (((uintptr_t) (ptr) + (ALIGNMENT) - 1) \
& ~ ((ALIGNMENT) - 1)))
+static void
+XFLOAT_INIT (Lisp_Object f, double n)
+{
+ XFLOAT (f)->u.data = n;
+}
\f
/************************************************************************
#ifndef REL_ALLOC
memory_full (nbytes);
-#endif
-
+#else
/* This used to call error, but if we've run out of memory, we could
get infinite recursion trying to build the string. */
xsignal (Qnil, Vmemory_signal_data);
+#endif
}
/* A common multiple of the positive integers A and B. Ideally this
#define INTERVAL_BLOCK_SIZE \
((1020 - sizeof (struct interval_block *)) / sizeof (struct interval))
-/* Intervals are allocated in chunks in form of an interval_block
+/* Intervals are allocated in chunks in the form of an interval_block
structure. */
struct interval_block
When a Lisp_String is freed during GC, it is put back on
string_free_list, and its `data' member and its sdata's `string'
pointer is set to null. The size of the string is recorded in the
- `u.nbytes' member of the sdata. So, sdata structures that are no
+ `n.nbytes' member of the sdata. So, sdata structures that are no
longer used, can be easily recognized, and it's easy to compact the
sblocks of small strings which we do in compact_small_strings. */
#define LARGE_STRING_BYTES 1024
-/* Structure describing string memory sub-allocated from an sblock.
+/* Struct or union describing string memory sub-allocated from an sblock.
This is where the contents of Lisp strings are stored. */
-struct sdata
+#ifdef GC_CHECK_STRING_BYTES
+
+typedef struct
{
/* Back-pointer to the string this sdata belongs to. If null, this
structure is free, and the NBYTES member of the union below
contents. */
struct Lisp_String *string;
-#ifdef GC_CHECK_STRING_BYTES
-
ptrdiff_t nbytes;
- unsigned char data[1];
+ unsigned char data[FLEXIBLE_ARRAY_MEMBER];
+} sdata;
#define SDATA_NBYTES(S) (S)->nbytes
#define SDATA_DATA(S) (S)->data
#define SDATA_SELECTOR(member) member
-#else /* not GC_CHECK_STRING_BYTES */
+#else
- union
+typedef union
+{
+ struct Lisp_String *string;
+
+ /* When STRING is non-null. */
+ struct
{
- /* When STRING is non-null. */
- unsigned char data[1];
+ struct Lisp_String *string;
+ unsigned char data[FLEXIBLE_ARRAY_MEMBER];
+ } u;
- /* When STRING is null. */
+ /* When STRING is null. */
+ struct
+ {
+ struct Lisp_String *string;
ptrdiff_t nbytes;
- } u;
+ } n;
+} sdata;
-#define SDATA_NBYTES(S) (S)->u.nbytes
+#define SDATA_NBYTES(S) (S)->n.nbytes
#define SDATA_DATA(S) (S)->u.data
#define SDATA_SELECTOR(member) u.member
#endif /* not GC_CHECK_STRING_BYTES */
-#define SDATA_DATA_OFFSET offsetof (struct sdata, SDATA_SELECTOR (data))
-};
+#define SDATA_DATA_OFFSET offsetof (sdata, SDATA_SELECTOR (data))
/* Structure describing a block of memory which is sub-allocated to
/* Pointer to the next free sdata block. This points past the end
of the sblock if there isn't any space left in this block. */
- struct sdata *next_free;
+ sdata *next_free;
/* Start of data. */
- struct sdata first_data;
+ sdata first_data;
};
/* Number of Lisp strings in a string_block structure. The 1020 is
a pointer to the `u.data' member of its sdata structure; the
structure starts at a constant offset in front of that. */
-#define SDATA_OF_STRING(S) ((struct sdata *) ((S)->data - SDATA_DATA_OFFSET))
+#define SDATA_OF_STRING(S) ((sdata *) ((S)->data - SDATA_DATA_OFFSET))
#ifdef GC_CHECK_STRING_OVERRUN
static void
check_sblock (struct sblock *b)
{
- struct sdata *from, *end, *from_end;
+ sdata *from, *end, *from_end;
end = b->next_free;
same as the one recorded in the sdata structure. */
nbytes = SDATA_SIZE (from->string ? string_bytes (from->string)
: SDATA_NBYTES (from));
- from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA);
+ from_end = (sdata *) ((char *) from + nbytes + GC_STRING_EXTRA);
}
}
allocate_string_data (struct Lisp_String *s,
EMACS_INT nchars, EMACS_INT nbytes)
{
- struct sdata *data, *old_data;
+ sdata *data, *old_data;
struct sblock *b;
ptrdiff_t needed, old_nbytes;
b = current_sblock;
data = b->next_free;
- b->next_free = (struct sdata *) ((char *) data + needed + GC_STRING_EXTRA);
+ b->next_free = (sdata *) ((char *) data + needed + GC_STRING_EXTRA);
MALLOC_UNBLOCK_INPUT;
else
{
/* String is dead. Put it on the free-list. */
- struct sdata *data = SDATA_OF_STRING (s);
+ sdata *data = SDATA_OF_STRING (s);
/* Save the size of S in its sdata so that we know
how large that is. Reset the sdata's string
if (string_bytes (s) != SDATA_NBYTES (data))
emacs_abort ();
#else
- data->u.nbytes = STRING_BYTES (s);
+ data->n.nbytes = STRING_BYTES (s);
#endif
data->string = NULL;
compact_small_strings (void)
{
struct sblock *b, *tb, *next;
- struct sdata *from, *to, *end, *tb_end;
- struct sdata *to_end, *from_end;
+ sdata *from, *to, *end, *tb_end;
+ sdata *to_end, *from_end;
/* TB is the sblock we copy to, TO is the sdata within TB we copy
to, and TB_END is the end of TB. */
tb = oldest_sblock;
- tb_end = (struct sdata *) ((char *) tb + SBLOCK_SIZE);
+ tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE);
to = &tb->first_data;
/* Step through the blocks from the oldest to the youngest. We
eassert (nbytes <= LARGE_STRING_BYTES);
nbytes = SDATA_SIZE (nbytes);
- from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA);
+ from_end = (sdata *) ((char *) from + nbytes + GC_STRING_EXTRA);
#ifdef GC_CHECK_STRING_OVERRUN
if (memcmp (string_overrun_cookie,
if (s)
{
/* If TB is full, proceed with the next sblock. */
- to_end = (struct sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
+ to_end = (sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
if (to_end > tb_end)
{
tb->next_free = to;
tb = tb->next;
- tb_end = (struct sdata *) ((char *) tb + SBLOCK_SIZE);
+ tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE);
to = &tb->first_data;
- to_end = (struct sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
+ to_end = (sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
}
/* Copy, and update the string's `data' pointer. */
/* Size of the minimal vector allocated from block. */
-#define VBLOCK_BYTES_MIN vroundup (sizeof (struct Lisp_Vector))
+#define VBLOCK_BYTES_MIN vroundup (header_size + sizeof (Lisp_Object))
/* Size of the largest vector allocated from block. */
else
{
struct large_vector *lv
- = lisp_malloc (sizeof (*lv) + (len - 1) * word_size,
+ = lisp_malloc ((offsetof (struct large_vector, v.contents)
+ + len * word_size),
MEM_TYPE_VECTORLIKE);
lv->next.vector = large_vectors;
large_vectors = lv;
static struct Lisp_Symbol *symbol_free_list;
+static void
+set_symbol_name (Lisp_Object sym, Lisp_Object name)
+{
+ XSYMBOL (sym)->name = name;
+}
+
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. */)
--total_free_markers;
consing_since_gc += sizeof (union Lisp_Misc);
misc_objects_consed++;
- XMISCTYPE (val) = type;
+ XMISCANY (val)->type = type;
XMISCANY (val)->gcmarkbit = 0;
return val;
}
void
free_misc (Lisp_Object misc)
{
- XMISCTYPE (misc) = Lisp_Misc_Free;
+ XMISCANY (misc)->type = Lisp_Misc_Free;
XMISC (misc)->u_free.chain = marker_free_list;
marker_free_list = XMISC (misc);
consing_since_gc -= sizeof (union Lisp_Misc);
total_free_markers++;
}
+/* Verify properties of Lisp_Save_Value's representation
+ that are assumed here and elsewhere. */
+
+verify (SAVE_UNUSED == 0);
+verify ((SAVE_INTEGER | SAVE_POINTER | SAVE_OBJECT) >> SAVE_SLOT_BITS == 0);
+
/* Return a Lisp_Save_Value object with the data saved according to
- FMT. Format specifiers are `i' for an integer, `p' for a pointer
- and `o' for Lisp_Object. Up to 4 objects can be specified. */
+ DATA_TYPE. DATA_TYPE should be one of SAVE_TYPE_INT_INT, etc. */
Lisp_Object
-make_save_value (const char *fmt, ...)
+make_save_value (enum Lisp_Save_Type save_type, ...)
{
va_list ap;
- int len = strlen (fmt);
+ int i;
Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
struct Lisp_Save_Value *p = XSAVE_VALUE (val);
- eassert (0 < len && len < 5);
- va_start (ap, fmt);
-
-#define INITX(index) \
- do { \
- if (len <= index) \
- p->type ## index = SAVE_UNUSED; \
- else \
- { \
- if (fmt[index] == 'i') \
- { \
- p->type ## index = SAVE_INTEGER; \
- p->data[index].integer = va_arg (ap, ptrdiff_t); \
- } \
- else if (fmt[index] == 'p') \
- { \
- p->type ## index = SAVE_POINTER; \
- p->data[index].pointer = va_arg (ap, void *); \
- } \
- else if (fmt[index] == 'o') \
- { \
- p->type ## index = SAVE_OBJECT; \
- p->data[index].object = va_arg (ap, Lisp_Object); \
- } \
- else \
- emacs_abort (); \
- } \
- } while (0)
+ eassert (0 < save_type
+ && (save_type < 1 << (SAVE_TYPE_BITS - 1)
+ || save_type == SAVE_TYPE_MEMORY));
+ p->save_type = save_type;
+ va_start (ap, save_type);
+ save_type &= ~ (1 << (SAVE_TYPE_BITS - 1));
- INITX (0);
- INITX (1);
- INITX (2);
- INITX (3);
+ for (i = 0; save_type; i++, save_type >>= SAVE_SLOT_BITS)
+ switch (save_type & ((1 << SAVE_SLOT_BITS) - 1))
+ {
+ case SAVE_POINTER:
+ p->data[i].pointer = va_arg (ap, void *);
+ break;
-#undef INITX
+ case SAVE_INTEGER:
+ p->data[i].integer = va_arg (ap, ptrdiff_t);
+ break;
+
+ case SAVE_OBJECT:
+ p->data[i].object = va_arg (ap, Lisp_Object);
+ break;
+
+ default:
+ emacs_abort ();
+ }
va_end (ap);
- p->area = 0;
return val;
}
{
Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
struct Lisp_Save_Value *p = XSAVE_VALUE (val);
-
- p->area = 0;
- p->type0 = SAVE_POINTER;
+ p->save_type = SAVE_POINTER;
p->data[0].pointer = pointer;
- p->type1 = p->type2 = p->type3 = SAVE_UNUSED;
return val;
}
See Info node `(elisp)Garbage Collection'. */)
(void)
{
- struct specbinding *bind;
struct buffer *nextb;
char stack_top_variable;
ptrdiff_t i;
EMACS_TIME start;
Lisp_Object retval = Qnil;
size_t tot_before = 0;
- struct backtrace backtrace;
if (abort_on_gc)
emacs_abort ();
return Qnil;
/* Record this function, so it appears on the profiler's backtraces. */
- backtrace.next = backtrace_list;
- backtrace.function = Qautomatic_gc;
- backtrace.args = &Qnil;
- backtrace.nargs = 0;
- backtrace.debug_on_exit = 0;
- backtrace_list = &backtrace;
+ record_in_backtrace (Qautomatic_gc, &Qnil, 0);
check_cons_list ();
for (i = 0; i < staticidx; i++)
mark_object (*staticvec[i]);
- for (bind = specpdl; bind != specpdl_ptr; bind++)
- {
- mark_object (bind->symbol);
- mark_object (bind->old_value);
- }
+ mark_specpdl ();
mark_terminals ();
mark_kboards ();
mark_object (handler->var);
}
}
- mark_backtrace ();
#endif
#ifdef HAVE_WINDOW_SYSTEM
total[4] = list3 (Qstring_bytes, make_number (1),
bounded_number (total_string_bytes));
- total[5] = list3 (Qvectors, make_number (sizeof (struct Lisp_Vector)),
+ total[5] = list3 (Qvectors,
+ make_number (header_size + sizeof (Lisp_Object)),
bounded_number (total_vectors));
total[6] = list4 (Qvector_slots, make_number (word_size),
malloc_probe (swept);
}
- backtrace_list = backtrace.next;
return retval;
}
{
CONS_MARK (XCONS (tail));
mark_object (XCAR (tail));
- prev = &XCDR_AS_LVALUE (tail);
+ prev = xcdr_addr (tail);
}
}
mark_object (tail);
case PVEC_WINDOW:
{
struct window *w = (struct window *) ptr;
- bool leaf = NILP (w->hchild) && NILP (w->vchild);
mark_vectorlike (ptr);
- /* Mark glyphs for leaf windows. Marking window
+ /* Mark glyph matrices, if any. Marking window
matrices is sufficient because frame matrices
use the same glyph memory. */
- if (leaf && w->current_matrix)
+ if (w->current_matrix)
{
mark_glyph_matrix (w->current_matrix);
mark_glyph_matrix (w->desired_matrix);
case Lisp_Misc_Save_Value:
XMISCANY (obj)->gcmarkbit = 1;
{
- register struct Lisp_Save_Value *ptr = XSAVE_VALUE (obj);
- /* If `area' is nonzero, `data[0].pointer' is the address
+ struct Lisp_Save_Value *ptr = XSAVE_VALUE (obj);
+ /* 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
- if (ptr->area)
+ if (GC_MARK_STACK && ptr->save_type == SAVE_TYPE_MEMORY)
{
Lisp_Object *p = ptr->data[0].pointer;
ptrdiff_t nelt;
mark_maybe_object (*p);
}
else
-#endif /* GC_MARK_STACK */
{
/* Find Lisp_Objects in `data[N]' slots and mark them. */
- if (ptr->type0 == SAVE_OBJECT)
- mark_object (ptr->data[0].object);
- if (ptr->type1 == SAVE_OBJECT)
- mark_object (ptr->data[1].object);
- if (ptr->type2 == SAVE_OBJECT)
- mark_object (ptr->data[2].object);
- if (ptr->type3 == SAVE_OBJECT)
- mark_object (ptr->data[3].object);
+ int i;
+ for (i = 0; i < SAVE_VALUE_SLOTS; i++)
+ if (save_type (ptr, i) == SAVE_OBJECT)
+ mark_object (ptr->data[i].object);
}
}
break;
void
die (const char *msg, const char *file, int line)
{
- fprintf (stderr, "\r\n%s:%d: Emacs fatal error: %s\r\n",
+ fprintf (stderr, "\r\n%s:%d: Emacs fatal error: assertion failed: %s\r\n",
file, line, msg);
terminate_due_to_signal (SIGABRT, INT_MAX);
}
enum MAX_ALLOCA MAX_ALLOCA;
enum More_Lisp_Bits More_Lisp_Bits;
enum pvec_type pvec_type;
-#if USE_LSB_TAG
- enum lsb_bits lsb_bits;
-#endif
} const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0};
#endif /* __GNUC__ */