#include <config.h>
-#define LISP_INLINE EXTERN_INLINE
-
#include <stdio.h>
#include <limits.h> /* For CHAR_BIT. */
#include <verify.h>
+#if (defined ENABLE_CHECKING \
+ && defined HAVE_VALGRIND_VALGRIND_H \
+ && !defined USE_VALGRIND)
+# define USE_VALGRIND 1
+#endif
+
+#if USE_VALGRIND
+#include <valgrind/valgrind.h>
+#include <valgrind/memcheck.h>
+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
static Lisp_Object Qpost_gc_hook;
-static void free_save_value (Lisp_Object);
static void mark_terminals (void);
static void gc_sweep (void);
static Lisp_Object make_pure_vector (ptrdiff_t);
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
-#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
-#include <stdio.h> /* For fprintf. */
-#endif
-
/* A unique object in pure space used to make some Lisp objects
on free lists recognizable in O(1). */
static struct mem_node mem_z;
#define MEM_NIL &mem_z
-#if GC_MARK_STACK || defined GC_MALLOC_CHECK
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 void mem_delete (struct mem_node *);
static void mem_delete_fixup (struct mem_node *);
static struct mem_node *mem_find (void *);
-#endif
#endif /* GC_MARK_STACK || GC_MALLOC_CHECK */
/* Addresses of staticpro'd variables. Initialize it to a nonzero
value; otherwise some compilers put it into BSS. */
-#define NSTATICS 0x800
+enum { NSTATICS = 2048 };
static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
/* Index of next unused slot in staticvec. */
((void *) (((uintptr_t) (ptr) + (ALIGNMENT) - 1) \
& ~ ((ALIGNMENT) - 1)))
+static void
+XFLOAT_INIT (Lisp_Object f, double n)
+{
+ XFLOAT (f)->u.data = n;
+}
\f
/************************************************************************
char *
xstrdup (const char *s)
{
- size_t len = strlen (s) + 1;
- char *p = xmalloc (len);
- memcpy (p, s, len);
- return p;
+ ptrdiff_t size;
+ eassert (s);
+ size = strlen (s) + 1;
+ return memcpy (xmalloc (size), s, size);
+}
+
+/* Like above, but duplicates Lisp string to C string. */
+
+char *
+xlispstrdup (Lisp_Object string)
+{
+ ptrdiff_t size = SBYTES (string) + 1;
+ return memcpy (xmalloc (size), SSDATA (string), size);
}
/* Like putenv, but (1) use the equivalent of xmalloc and (2) the
memory_full (0);
}
-/* Unwind for SAFE_ALLOCA */
-
-Lisp_Object
-safe_alloca_unwind (Lisp_Object arg)
-{
- free_save_value (arg);
- return Qnil;
-}
-
/* Return a newly allocated memory block of SIZE bytes, remembering
to free it when unwinding. */
void *
record_xmalloc (size_t size)
{
void *p = xmalloc (size);
- record_unwind_protect (safe_alloca_unwind, make_save_pointer (p));
+ record_unwind_protect_ptr (xfree, p);
return p;
}
#define ABLOCKS_BASE(abase) (abase)
#else
#define ABLOCKS_BASE(abase) \
- (1 & (intptr_t) ABLOCKS_BUSY (abase) ? abase : ((void**)abase)[-1])
+ (1 & (intptr_t) ABLOCKS_BUSY (abase) ? abase : ((void **)abase)[-1])
#endif
/* The list of free ablock. */
aligned = (base == abase);
if (!aligned)
- ((void**)abase)[-1] = base;
+ ((void **) abase)[-1] = base;
#ifdef DOUG_LEA_MALLOC
/* Back to a reasonable maximum of mmap'ed areas. */
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. */
(Lisp_Object length, Lisp_Object init)
{
register Lisp_Object val;
- register unsigned char *p, *end;
int c;
EMACS_INT nbytes;
{
nbytes = XINT (length);
val = make_uninit_string (nbytes);
- p = SDATA (val);
- end = p + SCHARS (val);
- while (p != end)
- *p++ = c;
+ memset (SDATA (val), c, nbytes);
+ SDATA (val)[nbytes] = 0;
}
else
{
unsigned char str[MAX_MULTIBYTE_LENGTH];
- int len = CHAR_STRING (c, str);
+ ptrdiff_t len = CHAR_STRING (c, str);
EMACS_INT string_len = XINT (length);
+ unsigned char *p, *beg, *end;
if (string_len > STRING_BYTES_MAX / len)
string_overflow ();
nbytes = len * string_len;
val = make_uninit_multibyte_string (string_len, nbytes);
- p = SDATA (val);
- end = p + nbytes;
- while (p != end)
+ for (beg = SDATA (val), p = beg, end = beg + nbytes; p < end; p += len)
{
- memcpy (p, str, len);
- p += len;
+ /* First time we just copy `str' to the data of `val'. */
+ if (p == beg)
+ memcpy (p, str, len);
+ else
+ {
+ /* Next time we copy largest possible chunk from
+ initialized to uninitialized part of `val'. */
+ len = min (p - beg, end - p);
+ memcpy (p, beg, len);
+ }
}
+ *p = 0;
}
- *p = 0;
return val;
}
+verify (sizeof (size_t) * CHAR_BIT == BITS_PER_SIZE_T);
+verify ((BITS_PER_SIZE_T & (BITS_PER_SIZE_T - 1)) == 0);
+
+static ptrdiff_t
+bool_vector_payload_bytes (ptrdiff_t nr_bits,
+ ptrdiff_t *exact_needed_bytes_out)
+{
+ ptrdiff_t exact_needed_bytes;
+ ptrdiff_t needed_bytes;
+
+ eassert (nr_bits >= 0);
+
+ exact_needed_bytes = ROUNDUP ((size_t) nr_bits, CHAR_BIT) / CHAR_BIT;
+ needed_bytes = ROUNDUP ((size_t) nr_bits, BITS_PER_SIZE_T) / CHAR_BIT;
+
+ if (needed_bytes == 0)
+ {
+ /* Always allocate at least one machine word of payload so that
+ bool-vector operations in data.c don't need a special case
+ for empty vectors. */
+ needed_bytes = sizeof (size_t);
+ }
+
+ if (exact_needed_bytes_out != NULL)
+ *exact_needed_bytes_out = exact_needed_bytes;
+
+ return needed_bytes;
+}
DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0,
doc: /* Return a new bool-vector of length LENGTH, using INIT for each element.
{
register Lisp_Object val;
struct Lisp_Bool_Vector *p;
- ptrdiff_t length_in_chars;
- EMACS_INT length_in_elts;
- int bits_per_value;
- int extra_bool_elts = ((bool_header_size - header_size + word_size - 1)
- / word_size);
+ ptrdiff_t exact_payload_bytes;
+ ptrdiff_t total_payload_bytes;
+ ptrdiff_t needed_elements;
CHECK_NATNUM (length);
+ if (PTRDIFF_MAX < XFASTINT (length))
+ memory_full (SIZE_MAX);
- bits_per_value = sizeof (EMACS_INT) * BOOL_VECTOR_BITS_PER_CHAR;
+ total_payload_bytes = bool_vector_payload_bytes
+ (XFASTINT (length), &exact_payload_bytes);
- length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value;
+ eassert (exact_payload_bytes <= total_payload_bytes);
+ eassert (0 <= exact_payload_bytes);
- val = Fmake_vector (make_number (length_in_elts + extra_bool_elts), Qnil);
+ needed_elements = ROUNDUP ((size_t) ((bool_header_size - header_size)
+ + total_payload_bytes),
+ word_size) / word_size;
- /* No Lisp_Object to trace in there. */
+ p = (struct Lisp_Bool_Vector *) allocate_vector (needed_elements);
+ XSETVECTOR (val, p);
XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0, 0);
- p = XBOOL_VECTOR (val);
p->size = XFASTINT (length);
-
- length_in_chars = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
- / BOOL_VECTOR_BITS_PER_CHAR);
- if (length_in_chars)
+ if (exact_payload_bytes)
{
- memset (p->data, ! NILP (init) ? -1 : 0, length_in_chars);
+ memset (p->data, ! NILP (init) ? -1 : 0, exact_payload_bytes);
/* Clear any extraneous bits in the last byte. */
- p->data[length_in_chars - 1]
+ p->data[exact_payload_bytes - 1]
&= (1 << ((XFASTINT (length) - 1) % BOOL_VECTOR_BITS_PER_CHAR + 1)) - 1;
}
+ /* Clear padding at the end. */
+ memset (p->data + exact_payload_bytes,
+ 0,
+ total_payload_bytes - exact_payload_bytes);
+
return val;
}
roundup_size = COMMON_MULTIPLE (word_size, USE_LSB_TAG ? GCALIGNMENT : 1)
};
-/* ROUNDUP_SIZE must be a power of 2. */
-verify ((roundup_size & (roundup_size - 1)) == 0);
-
/* Verify assumptions described above. */
verify ((VECTOR_BLOCK_SIZE % roundup_size) == 0);
verify (VECTOR_BLOCK_SIZE <= (1 << PSEUDOVECTOR_SIZE_BITS));
-/* Round up X to nearest mult-of-ROUNDUP_SIZE. */
-
-#define vroundup(x) (((x) + (roundup_size - 1)) & ~(roundup_size - 1))
+/* Round up X to nearest mult-of-ROUNDUP_SIZE --- use at compile time. */
+#define vroundup_ct(x) ROUNDUP ((size_t) (x), roundup_size)
+/* Round up X to nearest mult-of-ROUNDUP_SIZE --- use at runtime. */
+#define vroundup(x) (assume ((x) >= 0), vroundup_ct (x))
/* Rounding helps to maintain alignment constraints if USE_LSB_TAG. */
-#define VECTOR_BLOCK_BYTES (VECTOR_BLOCK_SIZE - vroundup (sizeof (void *)))
+#define VECTOR_BLOCK_BYTES (VECTOR_BLOCK_SIZE - vroundup_ct (sizeof (void *)))
/* Size of the minimal vector allocated from block. */
-#define VBLOCK_BYTES_MIN vroundup (sizeof (struct Lisp_Vector))
+#define VBLOCK_BYTES_MIN vroundup_ct (header_size + sizeof (Lisp_Object))
/* Size of the largest vector allocated from block. */
#define VINDEX(nbytes) (((nbytes) - VBLOCK_BYTES_MIN) / roundup_size)
-/* Get and set the next field in block-allocated vectorlike objects on
- the free list. Doing it this way respects C's aliasing rules.
- We could instead make 'contents' a union, but that would mean
- changes everywhere that the code uses 'contents'. */
-static struct Lisp_Vector *
-next_in_free_list (struct Lisp_Vector *v)
-{
- intptr_t i = XLI (v->contents[0]);
- return (struct Lisp_Vector *) i;
-}
-static void
-set_next_in_free_list (struct Lisp_Vector *v, struct Lisp_Vector *next)
-{
- v->contents[0] = XIL ((intptr_t) next);
-}
-
/* Common shortcut to setup vector on a free list. */
#define SETUP_ON_FREE_LIST(v, nbytes, tmp) \
eassert ((nbytes) % roundup_size == 0); \
(tmp) = VINDEX (nbytes); \
eassert ((tmp) < VECTOR_MAX_FREE_LIST_INDEX); \
- set_next_in_free_list (v, vector_free_lists[tmp]); \
+ v->u.next = vector_free_lists[tmp]; \
vector_free_lists[tmp] = (v); \
total_free_vector_slots += (nbytes) / word_size; \
} while (0)
struct large_vector *vector;
#if USE_LSB_TAG
/* We need to maintain ROUNDUP_SIZE alignment for the vector member. */
- unsigned char c[vroundup (sizeof (struct large_vector *))];
+ unsigned char c[vroundup_ct (sizeof (struct large_vector *))];
#endif
} next;
struct Lisp_Vector v;
if (vector_free_lists[index])
{
vector = vector_free_lists[index];
- vector_free_lists[index] = next_in_free_list (vector);
+ vector_free_lists[index] = vector->u.next;
total_free_vector_slots -= nbytes / word_size;
return vector;
}
{
/* This vector is larger than requested. */
vector = vector_free_lists[index];
- vector_free_lists[index] = next_in_free_list (vector);
+ vector_free_lists[index] = vector->u.next;
total_free_vector_slots -= nbytes / word_size;
/* Excess bytes are used for the smaller vector,
if (size & PSEUDOVECTOR_FLAG)
{
if (PSEUDOVECTOR_TYPEP (&v->header, PVEC_BOOL_VECTOR))
- size = (bool_header_size
- + (((struct Lisp_Bool_Vector *) v)->size
- + BOOL_VECTOR_BITS_PER_CHAR - 1)
- / BOOL_VECTOR_BITS_PER_CHAR);
+ {
+ struct Lisp_Bool_Vector *bv = (struct Lisp_Bool_Vector *) v;
+ ptrdiff_t payload_bytes =
+ bool_vector_payload_bytes (bv->size, NULL);
+
+ eassert (payload_bytes >= 0);
+ size = bool_header_size + ROUNDUP (payload_bytes, word_size);
+ }
else
size = (header_size
+ ((size & PSEUDOVECTOR_SIZE_MASK)
static void
sweep_vectors (void)
{
- struct vector_block *block = vector_blocks, **bprev = &vector_blocks;
+ struct vector_block *block, **bprev = &vector_blocks;
struct large_vector *lv, **lvprev = &large_vectors;
struct Lisp_Vector *vector, *next;
free_this_block = 1;
else
{
- int tmp;
+ size_t tmp;
SETUP_ON_FREE_LIST (vector, total_bytes, tmp);
}
}
total_vectors++;
if (vector->header.size & PSEUDOVECTOR_FLAG)
{
- struct Lisp_Bool_Vector *b = (struct Lisp_Bool_Vector *) vector;
-
/* All non-bool pseudovectors are small enough to be allocated
from vector blocks. This code should be redesigned if some
pseudovector type grows beyond VBLOCK_BYTES_MAX. */
eassert (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BOOL_VECTOR));
-
- total_vector_slots
- += (bool_header_size
- + ((b->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
- / BOOL_VECTOR_BITS_PER_CHAR)) / word_size;
+ total_vector_slots += vector_nbytes (vector) / word_size;
}
else
total_vector_slots
else
{
struct large_vector *lv
- = lisp_malloc (sizeof (*lv) + (len - 1) * word_size,
+ = lisp_malloc ((offsetof (struct large_vector, v.u.contents)
+ + len * word_size),
MEM_TYPE_VECTORLIKE);
lv->next.vector = large_vectors;
large_vectors = lv;
/* Only the first lisplen slots will be traced normally by the GC. */
for (i = 0; i < lisplen; ++i)
- v->contents[i] = Qnil;
+ v->u.contents[i] = Qnil;
XSETPVECTYPESIZE (v, tag, lisplen, memlen - lisplen);
return v;
p = allocate_vector (XFASTINT (length));
sizei = XFASTINT (length);
for (i = 0; i < sizei; i++)
- p->contents[i] = init;
+ p->u.contents[i] = init;
XSETVECTOR (vector, p);
return vector;
register struct Lisp_Vector *p = XVECTOR (val);
for (i = 0; i < nargs; i++)
- p->contents[i] = args[i];
+ p->u.contents[i] = args[i];
return val;
}
void
make_byte_code (struct Lisp_Vector *v)
{
- if (v->header.size > 1 && STRINGP (v->contents[1])
- && STRING_MULTIBYTE (v->contents[1]))
+ /* Don't allow the global zero_vector to become a byte code object. */
+ eassert(0 < v->header.size);
+ if (v->header.size > 1 && STRINGP (v->u.contents[1])
+ && STRING_MULTIBYTE (v->u.contents[1]))
/* BYTECODE-STRING must have been produced by Emacs 20.2 or the
earlier because they produced a raw 8-bit string for byte-code
and now such a byte-code string is loaded as multibyte while
raw 8-bit characters converted to multibyte form. Thus, now we
must convert them back to the original unibyte form. */
- v->contents[1] = Fstring_as_unibyte (v->contents[1]);
+ v->u.contents[1] = Fstring_as_unibyte (v->u.contents[1]);
XSETPVECTYPE (v, PVEC_COMPILED);
}
to be setcar'd). */
for (i = 0; i < nargs; i++)
- p->contents[i] = args[i];
+ p->u.contents[i] = args[i];
make_byte_code (p);
XSETCOMPILED (val, p);
return val;
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);
that are assumed here and elsewhere. */
verify (SAVE_UNUSED == 0);
-verify ((SAVE_INTEGER | SAVE_POINTER | SAVE_OBJECT) >> SAVE_SLOT_BITS == 0);
+verify (((SAVE_INTEGER | SAVE_POINTER | SAVE_FUNCPOINTER | SAVE_OBJECT)
+ >> SAVE_SLOT_BITS)
+ == 0);
-/* Return a Lisp_Save_Value object with the data saved according to
- DATA_TYPE. DATA_TYPE should be one of SAVE_TYPE_INT_INT, etc. */
+/* Return Lisp_Save_Value objects for the various combinations
+ that callers need. */
Lisp_Object
-make_save_value (enum Lisp_Save_Type save_type, ...)
+make_save_int_int_int (ptrdiff_t a, ptrdiff_t b, ptrdiff_t c)
{
- va_list ap;
- int i;
Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
struct Lisp_Save_Value *p = XSAVE_VALUE (val);
+ p->save_type = SAVE_TYPE_INT_INT_INT;
+ p->data[0].integer = a;
+ p->data[1].integer = b;
+ p->data[2].integer = c;
+ return val;
+}
- 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));
-
- 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;
+Lisp_Object
+make_save_obj_obj_obj_obj (Lisp_Object a, Lisp_Object b, Lisp_Object c,
+ Lisp_Object d)
+{
+ Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
+ struct Lisp_Save_Value *p = XSAVE_VALUE (val);
+ p->save_type = SAVE_TYPE_OBJ_OBJ_OBJ_OBJ;
+ p->data[0].object = a;
+ p->data[1].object = b;
+ p->data[2].object = c;
+ p->data[3].object = d;
+ return val;
+}
- case SAVE_INTEGER:
- p->data[i].integer = va_arg (ap, ptrdiff_t);
- break;
+#if defined HAVE_NS || defined HAVE_NTGUI
+Lisp_Object
+make_save_ptr (void *a)
+{
+ Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
+ struct Lisp_Save_Value *p = XSAVE_VALUE (val);
+ p->save_type = SAVE_POINTER;
+ p->data[0].pointer = a;
+ return val;
+}
+#endif
- case SAVE_OBJECT:
- p->data[i].object = va_arg (ap, Lisp_Object);
- break;
+Lisp_Object
+make_save_ptr_int (void *a, ptrdiff_t b)
+{
+ Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
+ struct Lisp_Save_Value *p = XSAVE_VALUE (val);
+ p->save_type = SAVE_TYPE_PTR_INT;
+ p->data[0].pointer = a;
+ p->data[1].integer = b;
+ return val;
+}
- default:
- emacs_abort ();
- }
+#if defined HAVE_MENUS && ! (defined USE_X_TOOLKIT || defined USE_GTK)
+Lisp_Object
+make_save_ptr_ptr (void *a, void *b)
+{
+ Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
+ struct Lisp_Save_Value *p = XSAVE_VALUE (val);
+ p->save_type = SAVE_TYPE_PTR_PTR;
+ p->data[0].pointer = a;
+ p->data[1].pointer = b;
+ return val;
+}
+#endif
- va_end (ap);
+Lisp_Object
+make_save_funcptr_ptr_obj (void (*a) (void), void *b, Lisp_Object c)
+{
+ Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
+ struct Lisp_Save_Value *p = XSAVE_VALUE (val);
+ p->save_type = SAVE_TYPE_FUNCPTR_PTR_OBJ;
+ p->data[0].funcpointer = a;
+ p->data[1].pointer = b;
+ p->data[2].object = c;
return val;
}
-/* The most common task it to save just one C pointer. */
+/* Return a Lisp_Save_Value object that represents an array A
+ of N Lisp objects. */
Lisp_Object
-make_save_pointer (void *pointer)
+make_save_memory (Lisp_Object *a, ptrdiff_t n)
{
Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
struct Lisp_Save_Value *p = XSAVE_VALUE (val);
- p->save_type = SAVE_POINTER;
- p->data[0].pointer = pointer;
+ p->save_type = SAVE_TYPE_MEMORY;
+ p->data[0].pointer = a;
+ p->data[1].integer = n;
return val;
}
/* Free a Lisp_Save_Value object. Do not use this function
if SAVE contains pointer other than returned by xmalloc. */
-static void
+void
free_save_value (Lisp_Object save)
{
xfree (XSAVE_POINTER (save, 0));
p->charpos = 0;
p->next = NULL;
p->insertion_type = 0;
+ p->need_adjustment = 0;
return val;
}
m->charpos = charpos;
m->bytepos = bytepos;
m->insertion_type = 0;
+ m->need_adjustment = 0;
m->next = BUF_MARKERS (buf);
BUF_MARKERS (buf) = m;
return obj;
Any number of arguments, even zero arguments, are allowed. */
Lisp_Object
-make_event_array (register int nargs, Lisp_Object *args)
+make_event_array (ptrdiff_t nargs, Lisp_Object *args)
{
- int i;
+ ptrdiff_t i;
for (i = 0; i < nargs; i++)
/* The things that fit in a string
{
if (m->type == MEM_TYPE_STRING)
{
- struct string_block *b = (struct string_block *) m->start;
+ struct string_block *b = m->start;
ptrdiff_t offset = (char *) p - (char *) &b->strings[0];
/* P must point to the start of a Lisp_String structure, and it
{
if (m->type == MEM_TYPE_CONS)
{
- struct cons_block *b = (struct cons_block *) m->start;
+ struct cons_block *b = m->start;
ptrdiff_t offset = (char *) p - (char *) &b->conses[0];
/* P must point to the start of a Lisp_Cons, not be
{
if (m->type == MEM_TYPE_SYMBOL)
{
- struct symbol_block *b = (struct symbol_block *) m->start;
+ struct symbol_block *b = m->start;
ptrdiff_t offset = (char *) p - (char *) &b->symbols[0];
/* P must point to the start of a Lisp_Symbol, not be
{
if (m->type == MEM_TYPE_FLOAT)
{
- struct float_block *b = (struct float_block *) m->start;
+ struct float_block *b = m->start;
ptrdiff_t offset = (char *) p - (char *) &b->floats[0];
/* P must point to the start of a Lisp_Float and not be
{
if (m->type == MEM_TYPE_MISC)
{
- struct marker_block *b = (struct marker_block *) m->start;
+ struct marker_block *b = m->start;
ptrdiff_t offset = (char *) p - (char *) &b->markers[0];
/* P must point to the start of a Lisp_Misc, not be
if (m->type == MEM_TYPE_VECTOR_BLOCK)
{
/* This memory node corresponds to a vector block. */
- struct vector_block *block = (struct vector_block *) m->start;
+ struct vector_block *block = m->start;
struct Lisp_Vector *vector = (struct Lisp_Vector *) block->data;
/* P is in the block's allocation range. Scan the block
#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 . */
void *po;
struct mem_node *m;
+#if USE_VALGRIND
+ if (valgrind_p)
+ VALGRIND_MAKE_MEM_DEFINED (&obj, sizeof (obj));
+#endif
+
if (INTEGERP (obj))
return;
{
struct mem_node *m;
+#if USE_VALGRIND
+ if (valgrind_p)
+ VALGRIND_MAKE_MEM_DEFINED (&p, sizeof (p));
+#endif
+
/* Quickly rule out some values which can't point to Lisp data.
USE_LSB_TAG needs Lisp data to be aligned on multiples of GCALIGNMENT.
Otherwise, assume that Lisp data is aligned on even addresses. */
#elif GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
-static void
+void
dump_zombies (void)
{
int i;
#endif
}
+#else /* GC_MARK_STACK == 0 */
+
+#define mark_maybe_object(obj) emacs_abort ()
+
#endif /* GC_MARK_STACK != 0 */
Unfortunately, we cannot use NULL_DEVICE here, as emacs_write may
not validate p in that case. */
- if (pipe (fd) == 0)
+ if (emacs_pipe (fd) == 0)
{
- bool valid = emacs_write (fd[1], (char *) p, 16) == 16;
+ bool valid = emacs_write (fd[1], p, 16) == 16;
emacs_close (fd[1]);
emacs_close (fd[0]);
return valid;
size &= PSEUDOVECTOR_SIZE_MASK;
vec = XVECTOR (make_pure_vector (size));
for (i = 0; i < size; i++)
- vec->contents[i] = Fpurecopy (AREF (obj, i));
+ vec->u.contents[i] = Fpurecopy (AREF (obj, i));
if (COMPILEDP (obj))
{
XSETPVECTYPE (vec, PVEC_COMPILED);
void
staticpro (Lisp_Object *varaddress)
{
- staticvec[staticidx++] = varaddress;
if (staticidx >= NSTATICS)
fatal ("NSTATICS too small; try increasing and recompiling Emacs.");
+ staticvec[staticidx++] = varaddress;
}
\f
See Info node `(elisp)Garbage Collection'. */)
(void)
{
- struct specbinding *bind;
struct buffer *nextb;
char stack_top_variable;
ptrdiff_t i;
bool message_p;
ptrdiff_t count = SPECPDL_INDEX ();
- EMACS_TIME start;
+ struct timespec 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 ();
if (profiler_memory_running)
tot_before = total_bytes_of_live_objects ();
- start = current_emacs_time ();
+ start = current_timespec ();
/* In case user calls debug_print during GC,
don't let that cause a recursive GC. */
/* Save what's currently displayed in the echo area. */
message_p = push_message ();
- record_unwind_protect (pop_message_unwind, Qnil);
+ record_unwind_protect_void (pop_message_unwind);
/* Save a copy of the contents of the stack, for debugging. */
#if MAX_SAVE_STACK > 0
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 (tail->var[i]);
}
mark_byte_stack ();
+#endif
{
- struct catchtag *catch;
struct handler *handler;
-
- for (catch = catchlist; catch; catch = catch->next)
- {
- mark_object (catch->tag);
- mark_object (catch->val);
- }
- for (handler = handlerlist; handler; handler = handler->next)
- {
- mark_object (handler->handler);
- mark_object (handler->var);
- }
+ for (handler = handlerlist; handler; handler = handler->next)
+ {
+ mark_object (handler->tag_or_ch);
+ mark_object (handler->val);
+ }
}
- mark_backtrace ();
-#endif
-
#ifdef HAVE_WINDOW_SYSTEM
mark_fringe_data ();
#endif
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),
/* Accumulate statistics. */
if (FLOATP (Vgc_elapsed))
{
- EMACS_TIME since_start = sub_emacs_time (current_emacs_time (), start);
+ struct timespec since_start = timespec_sub (current_timespec (), start);
Vgc_elapsed = make_float (XFLOAT_DATA (Vgc_elapsed)
- + EMACS_TIME_TO_DOUBLE (since_start));
+ + timespectod (since_start));
}
gcs_done++;
malloc_probe (swept);
}
- backtrace_list = backtrace.next;
return retval;
}
The distinction is used e.g. by Lisp_Process which places extra
non-Lisp_Object fields at the end of the structure... */
for (i = 0; i < size; i++) /* ...and then mark its elements. */
- mark_object (ptr->contents[i]);
+ mark_object (ptr->u.contents[i]);
}
/* Like mark_vectorlike but optimized for char-tables (and
VECTOR_MARK (ptr);
for (i = 0; i < size; i++)
{
- Lisp_Object val = ptr->contents[i];
+ Lisp_Object val = ptr->u.contents[i];
if (INTEGERP (val) || (SYMBOLP (val) && XSYMBOL (val)->gcmarkbit))
continue;
{
CONS_MARK (XCONS (tail));
mark_object (XCAR (tail));
- prev = &XCDR_AS_LVALUE (tail);
+ prev = xcdr_addr (tail);
}
}
mark_object (tail);
VECTOR_MARK (ptr);
for (i = 0; i < size; i++)
if (i != COMPILED_CONSTANTS)
- mark_object (ptr->contents[i]);
+ mark_object (ptr->u.contents[i]);
if (size > COMPILED_CONSTANTS)
{
- obj = ptr->contents[COMPILED_CONSTANTS];
+ obj = ptr->u.contents[COMPILED_CONSTANTS];
goto loop;
}
}
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);
}
#endif
Vgc_elapsed = make_float (0.0);
gcs_done = 0;
+
+#if USE_VALGRIND
+ valgrind_p = RUNNING_ON_VALGRIND != 0;
+#endif
}
void
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__ */