/* Storage allocation and gc for GNU Emacs Lisp interpreter.
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2012
- Free Software Foundation, Inc.
+Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2013 Free Software
+Foundation, Inc.
This file is part of GNU Emacs.
#include <limits.h> /* For CHAR_BIT. */
#ifdef ENABLE_CHECKING
-#include <signal.h> /* For SIGABRT. */
+#include <signal.h> /* For SIGABRT. */
#endif
#ifdef HAVE_PTHREAD
#endif
#include <unistd.h>
-#ifndef HAVE_UNISTD_H
-extern void *sbrk ();
-#endif
-
#include <fcntl.h>
#ifdef USE_GTK
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);
-static void mark_glyph_matrix (struct glyph_matrix *);
-static void mark_face_cache (struct face_cache *);
static void mark_buffer (struct buffer *);
#if !defined REL_ALLOC || defined SYSTEM_MALLOC
static void refill_memory_reserve (void);
#endif
-static struct Lisp_String *allocate_string (void);
static void compact_small_strings (void);
static void free_large_strings (void);
-static void sweep_strings (void);
-static void free_misc (Lisp_Object);
extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE;
-/* When scanning the C stack for live Lisp objects, Emacs keeps track
- of what memory allocated via lisp_malloc is intended for what
- purpose. This enumeration specifies the type of memory. */
+/* When scanning the C stack for live Lisp objects, Emacs keeps track of
+ what memory allocated via lisp_malloc and lisp_align_malloc is intended
+ for what purpose. This enumeration specifies the type of memory. */
enum mem_type
{
MEM_TYPE_MISC,
MEM_TYPE_SYMBOL,
MEM_TYPE_FLOAT,
- /* We used to keep separate mem_types for subtypes of vectors such as
- process, hash_table, frame, terminal, and window, but we never made
- use of the distinction, so it only caused source-code complexity
- and runtime slowdown. Minor but pointless. */
+ /* Since all non-bool pseudovectors are small enough to be
+ allocated from vector blocks, this memory type denotes
+ large regular vectors and large bool pseudovectors. */
MEM_TYPE_VECTORLIKE,
/* Special type to denote vector blocks. */
MEM_TYPE_VECTOR_BLOCK,
MEM_TYPE_SPARE
};
-static void *lisp_malloc (size_t, enum mem_type);
-
-
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
/* Addresses of staticpro'd variables. Initialize it to a nonzero
value; otherwise some compilers put it into BSS. */
-#define NSTATICS 0x660
+#define NSTATICS 0x800
static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
/* Index of next unused slot in staticvec. */
#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
infinity.
If PA is null, then allocate a new array instead of reallocating
- the old one. Thus, to grow an array A without saving its old
- contents, invoke xfree (A) immediately followed by xgrowalloc (0,
- &NITEMS, ...).
+ the old one.
Block interrupt input as needed. If memory exhaustion occurs, set
*NITEMS to zero if PA is null, and signal an error (i.e., do not
- return). */
+ return).
+
+ Thus, to grow an array A without saving its old contents, do
+ { xfree (A); A = NULL; A = xpalloc (NULL, &AITEMS, ...); }.
+ The A = NULL avoids a dangling pointer if xpalloc exhausts memory
+ and signals an error, and later this code is reexecuted and
+ attempts to free A. */
void *
xpalloc (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min,
return p;
}
+/* Like putenv, but (1) use the equivalent of xmalloc and (2) the
+ argument is a const pointer. */
+
+void
+xputenv (char const *string)
+{
+ if (putenv ((char *) string) != 0)
+ memory_full (0);
+}
/* Unwind for SAFE_ALLOCA */
Lisp_Object
safe_alloca_unwind (Lisp_Object arg)
{
- register struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
-
- p->dogc = 0;
- xfree (p->pointer);
- p->pointer = 0;
- free_misc (arg);
+ free_save_value (arg);
return Qnil;
}
record_xmalloc (size_t size)
{
void *p = xmalloc (size);
- record_unwind_protect (safe_alloca_unwind, make_save_value (p, 0));
+ record_unwind_protect (safe_alloca_unwind, make_save_pointer (p));
return p;
}
#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
b = lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP);
#ifdef DOUG_LEA_MALLOC
- /* Back to a reasonable maximum of mmap'ed areas. */
+ /* Back to a reasonable maximum of mmap'ed areas. */
mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
#endif
#ifdef GC_CHECK_STRING_BYTES
/* Check that the string size recorded in the string is the
- same as the one recorded in the sdata structure. */
+ same as the one recorded in the sdata structure. */
if (s && string_bytes (s) != SDATA_NBYTES (from))
emacs_abort ();
#endif /* GC_CHECK_STRING_BYTES */
val = Fmake_vector (make_number (length_in_elts + extra_bool_elts), Qnil);
/* No Lisp_Object to trace in there. */
- XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0);
+ XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0, 0);
p = XBOOL_VECTOR (val);
p->size = XFASTINT (length);
#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, index) \
- do { \
- XSETPVECTYPESIZE (v, PVEC_FREE, nbytes); \
- eassert ((nbytes) % roundup_size == 0); \
- (index) = VINDEX (nbytes); \
- eassert ((index) < VECTOR_MAX_FREE_LIST_INDEX); \
- (v)->header.next.vector = vector_free_lists[index]; \
- vector_free_lists[index] = (v); \
- total_free_vector_slots += (nbytes) / word_size; \
+#define SETUP_ON_FREE_LIST(v, nbytes, tmp) \
+ do { \
+ (tmp) = ((nbytes - header_size) / word_size); \
+ XSETPVECTYPESIZE (v, PVEC_FREE, 0, (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]); \
+ vector_free_lists[tmp] = (v); \
+ total_free_vector_slots += (nbytes) / word_size; \
} while (0)
+/* This internal type is used to maintain the list of large vectors
+ which are allocated at their own, e.g. outside of vector blocks. */
+
+struct large_vector
+{
+ union {
+ 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 *))];
+#endif
+ } next;
+ struct Lisp_Vector v;
+};
+
+/* This internal type is used to maintain an underlying storage
+ for small vectors. */
+
struct vector_block
{
char data[VECTOR_BLOCK_BYTES];
/* Singly-linked list of large vectors. */
-static struct Lisp_Vector *large_vectors;
+static struct large_vector *large_vectors;
/* The only vector with 0 slots, allocated from pure space. */
static struct Lisp_Vector *
allocate_vector_from_block (size_t nbytes)
{
- struct Lisp_Vector *vector, *rest;
+ struct Lisp_Vector *vector;
struct vector_block *block;
size_t index, restbytes;
if (vector_free_lists[index])
{
vector = vector_free_lists[index];
- vector_free_lists[index] = vector->header.next.vector;
- vector->header.next.nbytes = nbytes;
+ vector_free_lists[index] = next_in_free_list (vector);
total_free_vector_slots -= nbytes / word_size;
return vector;
}
{
/* This vector is larger than requested. */
vector = vector_free_lists[index];
- vector_free_lists[index] = vector->header.next.vector;
- vector->header.next.nbytes = nbytes;
+ vector_free_lists[index] = next_in_free_list (vector);
total_free_vector_slots -= nbytes / word_size;
/* Excess bytes are used for the smaller vector,
which should be set on an appropriate free list. */
restbytes = index * roundup_size + VBLOCK_BYTES_MIN - nbytes;
eassert (restbytes % roundup_size == 0);
- rest = ADVANCE (vector, nbytes);
- SETUP_ON_FREE_LIST (rest, restbytes, index);
+ SETUP_ON_FREE_LIST (ADVANCE (vector, nbytes), restbytes, index);
return vector;
}
/* New vector will be at the beginning of this block. */
vector = (struct Lisp_Vector *) block->data;
- vector->header.next.nbytes = nbytes;
/* If the rest of space from this block is large enough
for one-slot vector at least, set up it on a free list. */
if (restbytes >= VBLOCK_BYTES_MIN)
{
eassert (restbytes % roundup_size == 0);
- rest = ADVANCE (vector, nbytes);
- SETUP_ON_FREE_LIST (rest, restbytes, index);
+ SETUP_ON_FREE_LIST (ADVANCE (vector, nbytes), restbytes, index);
}
return vector;
- }
+}
/* Nonzero if VECTOR pointer is valid pointer inside BLOCK. */
((char *) (vector) <= (block)->data \
+ VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN)
-/* Number of bytes used by vector-block-allocated object. This is the only
- place where we actually use the `nbytes' field of the vector-header.
- I.e. we could get rid of the `nbytes' field by computing it based on the
- vector-type. */
+/* Return the memory footprint of V in bytes. */
+
+static ptrdiff_t
+vector_nbytes (struct Lisp_Vector *v)
+{
+ ptrdiff_t size = v->header.size & ~ARRAY_MARK_FLAG;
-#define PSEUDOVECTOR_NBYTES(vector) \
- (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) \
- ? vector->header.size & PSEUDOVECTOR_SIZE_MASK \
- : vector->header.next.nbytes)
+ 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);
+ else
+ size = (header_size
+ + ((size & PSEUDOVECTOR_SIZE_MASK)
+ + ((size & PSEUDOVECTOR_REST_MASK)
+ >> PSEUDOVECTOR_SIZE_BITS)) * word_size);
+ }
+ else
+ size = header_size + size * word_size;
+ return vroundup (size);
+}
/* Reclaim space used by unmarked vectors. */
sweep_vectors (void)
{
struct vector_block *block = vector_blocks, **bprev = &vector_blocks;
- struct Lisp_Vector *vector, *next, **vprev = &large_vectors;
+ struct large_vector *lv, **lvprev = &large_vectors;
+ struct Lisp_Vector *vector, *next;
total_vectors = total_vector_slots = total_free_vector_slots = 0;
memset (vector_free_lists, 0, sizeof (vector_free_lists));
for (block = vector_blocks; block; block = *bprev)
{
bool free_this_block = 0;
+ ptrdiff_t nbytes;
for (vector = (struct Lisp_Vector *) block->data;
VECTOR_IN_BLOCK (vector, block); vector = next)
{
VECTOR_UNMARK (vector);
total_vectors++;
- total_vector_slots += vector->header.next.nbytes / word_size;
- next = ADVANCE (vector, vector->header.next.nbytes);
+ nbytes = vector_nbytes (vector);
+ total_vector_slots += nbytes / word_size;
+ next = ADVANCE (vector, nbytes);
}
else
{
- ptrdiff_t nbytes = PSEUDOVECTOR_NBYTES (vector);
- ptrdiff_t total_bytes = nbytes;
+ ptrdiff_t total_bytes;
+ nbytes = vector_nbytes (vector);
+ total_bytes = nbytes;
next = ADVANCE (vector, nbytes);
/* While NEXT is not marked, try to coalesce with VECTOR,
{
if (VECTOR_MARKED_P (next))
break;
- nbytes = PSEUDOVECTOR_NBYTES (next);
+ nbytes = vector_nbytes (next);
total_bytes += nbytes;
next = ADVANCE (next, nbytes);
}
/* Sweep large vectors. */
- for (vector = large_vectors; vector; vector = *vprev)
+ for (lv = large_vectors; lv; lv = *lvprev)
{
+ vector = &lv->v;
if (VECTOR_MARKED_P (vector))
{
VECTOR_UNMARK (vector);
else
total_vector_slots
+= header_size / word_size + vector->header.size;
- vprev = &vector->header.next.vector;
+ lvprev = &lv->next.vector;
}
else
{
- *vprev = vector->header.next.vector;
- lisp_free (vector);
+ *lvprev = lv->next.vector;
+ lisp_free (lv);
}
}
}
p = allocate_vector_from_block (vroundup (nbytes));
else
{
- p = lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE);
- p->header.next.vector = large_vectors;
- large_vectors = p;
+ struct large_vector *lv
+ = lisp_malloc (sizeof (*lv) + (len - 1) * word_size,
+ MEM_TYPE_VECTORLIKE);
+ lv->next.vector = large_vectors;
+ large_vectors = lv;
+ p = &lv->v;
}
#ifdef DOUG_LEA_MALLOC
/* Allocate other vector-like structures. */
struct Lisp_Vector *
-allocate_pseudovector (int memlen, int lisplen, int tag)
+allocate_pseudovector (int memlen, int lisplen, enum pvec_type tag)
{
struct Lisp_Vector *v = allocate_vectorlike (memlen);
int i;
+ /* Catch bogus values. */
+ eassert (tag <= PVEC_FONT);
+ 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;
- XSETPVECTYPESIZE (v, tag, lisplen);
+ XSETPVECTYPESIZE (v, tag, lisplen, memlen - lisplen);
return v;
}
{
struct buffer *b = lisp_malloc (sizeof *b, MEM_TYPE_BUFFER);
- XSETPVECTYPESIZE (b, PVEC_BUFFER, (offsetof (struct buffer, own_text)
- - header_size) / word_size);
+ BUFFER_PVEC_INIT (b);
/* Put B on the chain of all buffers including killed ones. */
- b->header.next.buffer = all_buffers;
+ b->next = all_buffers;
all_buffers = b;
/* Note that the rest fields of B are not initialized. */
return b;
usage: (vector &rest OBJECTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- register Lisp_Object len, val;
ptrdiff_t i;
- register struct Lisp_Vector *p;
+ register Lisp_Object val = make_uninit_vector (nargs);
+ register struct Lisp_Vector *p = XVECTOR (val);
- XSETFASTINT (len, nargs);
- val = Fmake_vector (len, Qnil);
- p = XVECTOR (val);
for (i = 0; i < nargs; i++)
p->contents[i] = args[i];
return val;
usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- register Lisp_Object len, val;
ptrdiff_t i;
- register struct Lisp_Vector *p;
+ register Lisp_Object val = make_uninit_vector (nargs);
+ register struct Lisp_Vector *p = XVECTOR (val);
- /* We used to purecopy everything here, if purify-flga was set. This worked
+ /* We used to purecopy everything here, if purify-flag was set. This worked
OK for Emacs-23, but with Emacs-24's lexical binding code, it can be
dangerous, since make-byte-code is used during execution to build
closures, so any closure built during the preload phase would end up
just wasteful and other times plainly wrong (e.g. those free vars may want
to be setcar'd). */
- XSETFASTINT (len, nargs);
- val = Fmake_vector (len, Qnil);
-
- p = XVECTOR (val);
for (i = 0; i < nargs; i++)
p->contents[i] = args[i];
make_byte_code (p);
DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
doc: /* Return a newly allocated uninterned symbol whose name is NAME.
-Its value and function definition are void, and its property list is nil. */)
+Its value is void, and its function definition and property list are nil. */)
(Lisp_Object name)
{
register Lisp_Object val;
set_symbol_plist (val, Qnil);
p->redirect = SYMBOL_PLAINVAL;
SET_SYMBOL_VAL (p, Qunbound);
- set_symbol_function (val, Qunbound);
+ set_symbol_function (val, Qnil);
set_symbol_next (val, NULL);
p->gcmarkbit = 0;
p->interned = SYMBOL_UNINTERNED;
return val;
}
-/* Free a Lisp_Misc object */
+/* Free a Lisp_Misc object. */
-static void
+void
free_misc (Lisp_Object misc)
{
XMISCTYPE (misc) = Lisp_Misc_Free;
total_free_markers++;
}
-/* Return a Lisp_Misc_Save_Value object containing POINTER and
- INTEGER. This is used to package C values to call record_unwind_protect.
- The unwind function can get the C values back using XSAVE_VALUE. */
+/* 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. */
Lisp_Object
-make_save_value (void *pointer, ptrdiff_t integer)
+make_save_value (const char *fmt, ...)
{
- register Lisp_Object val;
- register struct Lisp_Save_Value *p;
+ va_list ap;
+ int len = strlen (fmt);
+ 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)
+
+ INITX (0);
+ INITX (1);
+ INITX (2);
+ INITX (3);
+
+#undef INITX
+
+ va_end (ap);
+ p->area = 0;
+ return val;
+}
+
+/* The most common task it to save just one C pointer. */
+
+Lisp_Object
+make_save_pointer (void *pointer)
+{
+ Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
+ struct Lisp_Save_Value *p = XSAVE_VALUE (val);
- val = allocate_misc (Lisp_Misc_Save_Value);
- p = XSAVE_VALUE (val);
- p->pointer = pointer;
- p->integer = integer;
- p->dogc = 0;
+ p->area = 0;
+ p->type0 = SAVE_POINTER;
+ p->data[0].pointer = pointer;
+ p->type1 = p->type2 = p->type3 = SAVE_UNUSED;
return val;
}
+/* Free a Lisp_Save_Value object. Do not use this function
+ if SAVE contains pointer other than returned by xmalloc. */
+
+static void
+free_save_value (Lisp_Object save)
+{
+ xfree (XSAVE_POINTER (save, 0));
+ free_misc (save);
+}
+
/* Return a Lisp_Misc_Overlay object with specified START, END and PLIST. */
Lisp_Object
while (VECTOR_IN_BLOCK (vector, block)
&& vector <= (struct Lisp_Vector *) p)
{
- if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE))
- vector = ADVANCE (vector, (vector->header.size
- & PSEUDOVECTOR_SIZE_MASK));
- else if (vector == p)
+ if (!PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) && vector == p)
return 1;
else
- vector = ADVANCE (vector, vector->header.next.nbytes);
+ vector = ADVANCE (vector, vector_nbytes (vector));
}
}
- else if (m->type == MEM_TYPE_VECTORLIKE && p == m->start)
+ else if (m->type == MEM_TYPE_VECTORLIKE
+ && (char *) p == ((char *) m->start
+ + offsetof (struct large_vector, v)))
/* This memory node corresponds to a large vector. */
return 1;
return 0;
}
}
-/* setjmp will work with GCC unless NON_SAVING_SETJMP is defined in
- the GCC system configuration. In gcc 3.2, the only systems for
- which this is so are i386-sco5 non-ELF, i386-sysv3 (maybe included
- by others?) and ns32k-pc532-min. */
-
#if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS
static bool setjmp_tested_p;
#endif
}
-/* Return 2 if OBJ is a killed or special buffer object.
- Return 1 if OBJ is a valid lisp object.
- Return 0 if OBJ is NOT a valid lisp object.
- Return -1 if we cannot validate OBJ.
- This function can be quite slow,
- so it should only be used in code for manual debugging. */
+/* Return 2 if OBJ is a killed or special buffer object, 1 if OBJ is a
+ valid lisp object, 0 if OBJ is NOT a valid lisp object, or -1 if we
+ cannot validate OBJ. This function can be quite slow, so its primary
+ use is the manual debugging. The only exception is print_object, where
+ we use it to check whether the memory referenced by the pointer of
+ Lisp_Save_Value object contains valid objects. */
int
valid_lisp_object_p (Lisp_Object obj)
{
staticvec[staticidx++] = varaddress;
if (staticidx >= NSTATICS)
- emacs_abort ();
+ fatal ("NSTATICS too small; try increasing and recompiling Emacs.");
}
\f
dump_zombies ();
#endif
- unblock_input ();
-
check_cons_list ();
gc_in_progress = 0;
+ unblock_input ();
+
consing_since_gc = 0;
if (gc_cons_threshold < GC_DEFAULT_THRESHOLD / 10)
gc_cons_threshold = GC_DEFAULT_THRESHOLD / 10;
if (ptr->header.size & PSEUDOVECTOR_FLAG)
pvectype = ((ptr->header.size & PVEC_TYPE_MASK)
- >> PSEUDOVECTOR_SIZE_BITS);
+ >> PSEUDOVECTOR_AREA_BITS);
else
pvectype = PVEC_NORMAL_VECTOR;
struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *) ptr;
mark_vectorlike (ptr);
+ mark_object (h->test.name);
+ mark_object (h->test.user_hash_function);
+ mark_object (h->test.user_cmp_function);
/* If hash table is not weak, mark all keys and values.
For weak tables, mark only the vector. */
if (NILP (h->weak))
case Lisp_Misc_Save_Value:
XMISCANY (obj)->gcmarkbit = 1;
-#if GC_MARK_STACK
{
register struct Lisp_Save_Value *ptr = XSAVE_VALUE (obj);
- /* If DOGC is set, POINTER is the address of a memory
- area containing INTEGER potential Lisp_Objects. */
- if (ptr->dogc)
+ /* If `area' is nonzero, `data[0].pointer' is the address
+ of a memory area containing `data[1].integer' potential
+ Lisp_Objects. */
+#if GC_MARK_STACK
+ if (ptr->area)
{
- Lisp_Object *p = (Lisp_Object *) ptr->pointer;
+ Lisp_Object *p = ptr->data[0].pointer;
ptrdiff_t nelt;
- for (nelt = ptr->integer; nelt > 0; nelt--, p++)
+ for (nelt = ptr->data[1].integer; nelt > 0; nelt--, p++)
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);
+ }
}
-#endif
break;
case Lisp_Misc_Overlay:
for (buffer = all_buffers; buffer; buffer = *bprev)
if (!VECTOR_MARKED_P (buffer))
{
- *bprev = buffer->header.next.buffer;
+ *bprev = buffer->next;
lisp_free (buffer);
}
else
/* Do not use buffer_(set|get)_intervals here. */
buffer->text->intervals = balance_intervals (buffer->text->intervals);
total_buffers++;
- bprev = &buffer->header.next.buffer;
+ bprev = &buffer->next;
}
}
}
#endif
\f
-/* Initialization */
+/* Initialization. */
void
init_alloc_once (void)
#endif
#ifdef DOUG_LEA_MALLOC
- mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */
- mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */
- mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); /* max. number of mmap'ed areas */
+ mallopt (M_TRIM_THRESHOLD, 128 * 1024); /* Trim threshold. */
+ mallopt (M_MMAP_THRESHOLD, 64 * 1024); /* Mmap threshold. */
+ mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); /* Max. number of mmap'ed areas. */
#endif
init_strings ();
init_vectors ();