#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. */
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. */
(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 (header_size + sizeof (Lisp_Object))
+#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 ((offsetof (struct large_vector, v.contents)
+ = lisp_malloc ((offsetof (struct large_vector, v.u.contents)
+ len * word_size),
MEM_TYPE_VECTORLIKE);
lv->next.vector = large_vectors;
/* 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;
>> 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;
-
- case SAVE_FUNCPOINTER:
- p->data[i].funcpointer = va_arg (ap, voidfuncptr);
- 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
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;
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
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);
+ }
}
-#endif
-
#ifdef HAVE_WINDOW_SYSTEM
mark_fringe_data ();
#endif
/* 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++;
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;
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;
}
}
#endif
Vgc_elapsed = make_float (0.0);
gcs_done = 0;
+
+#if USE_VALGRIND
+ valgrind_p = RUNNING_ON_VALGRIND != 0;
+#endif
}
void