/* 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
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
/* 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,
ptrdiff_t nitems_incr_max = n_max - n;
ptrdiff_t incr = max (nitems_incr_min, min (incr_estimate, nitems_incr_max));
- eassert (0 < item_size && 0 < nitems_incr_min && 0 <= n && -1 <= nitems_max);
+ eassert (item_size > 0 && nitems_incr_min > 0 && n >= 0 && nitems_max >= -1);
if (! pa)
*nitems = 0;
if (nitems_incr_max < incr)
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. */
-#define PSEUDOVECTOR_NBYTES(vector) \
- (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) \
- ? vector->header.size & PSEUDOVECTOR_SIZE_MASK \
- : vector->header.next.nbytes)
+static ptrdiff_t
+vector_nbytes (struct Lisp_Vector *v)
+{
+ ptrdiff_t size = v->header.size & ~ARRAY_MARK_FLAG;
+
+ 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-flag was set. This worked
OK for Emacs-23, but with Emacs-24's lexical binding code, it can be
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. */
+/* 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
+ DATA_TYPE. DATA_TYPE should be one of SAVE_TYPE_INT_INT, etc. */
Lisp_Object
-make_save_value (void *pointer, ptrdiff_t integer)
+make_save_value (enum Lisp_Save_Type save_type, ...)
{
- register Lisp_Object val;
- register struct Lisp_Save_Value *p;
+ va_list ap;
+ int i;
+ Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
+ struct Lisp_Save_Value *p = XSAVE_VALUE (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_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);
+ return val;
+}
- val = allocate_misc (Lisp_Misc_Save_Value);
- p = XSAVE_VALUE (val);
- p->pointer = pointer;
- p->integer = integer;
- p->dogc = 0;
+/* 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);
+ p->save_type = SAVE_POINTER;
+ p->data[0].pointer = pointer;
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;
double tot = total_bytes_of_live_objects ();
tot *= XFLOAT_DATA (Vgc_cons_percentage);
- if (0 < tot)
+ if (tot > 0)
{
if (tot < TYPE_MAXIMUM (EMACS_INT))
gc_relative_threshold = tot;
if (ptr->header.size & PSEUDOVECTOR_FLAG)
pvectype = ((ptr->header.size & PVEC_TYPE_MASK)
- >> PSEUDOVECTOR_SIZE_BITS);
+ >> PSEUDOVECTOR_AREA_BITS);
else
pvectype = PVEC_NORMAL_VECTOR;
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);
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)
+ 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 && ptr->save_type == SAVE_TYPE_MEMORY)
{
- 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
+ {
+ /* Find Lisp_Objects in `data[N]' slots and mark them. */
+ int i;
+ for (i = 0; i < SAVE_VALUE_SLOTS; i++)
+ if (save_type (ptr, i) == SAVE_OBJECT)
+ mark_object (ptr->data[i].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 ();
HCoop / bpt / emacs.git / blobdiff