#endif /* not DOUG_LEA_MALLOC */
-#if ! defined (SYSTEM_MALLOC) && defined (HAVE_GTK_AND_PTHREAD)
+#if ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT
+#ifdef HAVE_GTK_AND_PTHREAD
/* When GTK uses the file chooser dialog, different backends can be loaded
dynamically. One such a backend is the Gnome VFS backend that gets loaded
} \
while (0)
-#else /* SYSTEM_MALLOC || not HAVE_GTK_AND_PTHREAD */
+#else /* ! defined HAVE_GTK_AND_PTHREAD */
#define BLOCK_INPUT_ALLOC BLOCK_INPUT
#define UNBLOCK_INPUT_ALLOC UNBLOCK_INPUT
-#endif /* SYSTEM_MALLOC || not HAVE_GTK_AND_PTHREAD */
-
-/* Value of _bytes_used, when spare_memory was freed. */
-
-static __malloc_size_t bytes_used_when_full;
+#endif /* ! defined HAVE_GTK_AND_PTHREAD */
+#endif /* ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT */
/* Mark, unmark, query mark bit of a Lisp string. S must be a pointer
to a struct Lisp_String. */
#define UNMARK_STRING(S) ((S)->size &= ~ARRAY_MARK_FLAG)
#define STRING_MARKED_P(S) (((S)->size & ARRAY_MARK_FLAG) != 0)
-#define VECTOR_MARK(V) ((V)->size |= ARRAY_MARK_FLAG)
-#define VECTOR_UNMARK(V) ((V)->size &= ~ARRAY_MARK_FLAG)
-#define VECTOR_MARKED_P(V) (((V)->size & ARRAY_MARK_FLAG) != 0)
+#define VECTOR_MARK(V) ((V)->header.size |= ARRAY_MARK_FLAG)
+#define VECTOR_UNMARK(V) ((V)->header.size &= ~ARRAY_MARK_FLAG)
+#define VECTOR_MARKED_P(V) (((V)->header.size & ARRAY_MARK_FLAG) != 0)
-/* Value is the number of bytes/chars of S, a pointer to a struct
- Lisp_String. This must be used instead of STRING_BYTES (S) or
- S->size during GC, because S->size contains the mark bit for
+/* Value is the number of bytes of S, a pointer to a struct Lisp_String.
+ Be careful during GC, because S->size contains the mark bit for
strings. */
#define GC_STRING_BYTES(S) (STRING_BYTES (S))
-#define GC_STRING_CHARS(S) ((S)->size & ~ARRAY_MARK_FLAG)
/* Global variables. */
struct emacs_globals globals;
static char *spare_memory[7];
+#ifndef SYSTEM_MALLOC
/* Amount of spare memory to keep in large reserve block. */
#define SPARE_MEMORY (1 << 14)
+#endif
/* Number of extra blocks malloc should get when it needs more core. */
remapping on more recent systems because this is less important
nowadays than in the days of small memories and timesharing. */
+#ifndef VIRT_ADDR_VARIES
+static
+#endif
EMACS_INT pure[(PURESIZE + sizeof (EMACS_INT) - 1) / sizeof (EMACS_INT)] = {1,};
#define PUREBEG (char *) pure
/* Buffer in which we save a copy of the C stack at each GC. */
+#if MAX_SAVE_STACK > 0
static char *stack_copy;
-static int stack_copy_size;
+static size_t stack_copy_size;
+#endif
/* Non-zero means ignore malloc warnings. Set during initialization.
Currently not used. */
static int ignore_warnings;
-Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots;
+static Lisp_Object Qgc_cons_threshold;
+Lisp_Object Qchar_table_extra_slots;
/* Hook run after GC has finished. */
-Lisp_Object Qpost_gc_hook;
+static Lisp_Object Qpost_gc_hook;
static void mark_buffer (Lisp_Object);
static void mark_terminals (void);
-extern void mark_kboards (void);
-extern void mark_ttys (void);
-extern void mark_backtrace (void);
static void gc_sweep (void);
static void mark_glyph_matrix (struct glyph_matrix *);
static void mark_face_cache (struct face_cache *);
-#ifdef HAVE_WINDOW_SYSTEM
-extern void mark_fringe_data (void);
-#endif /* HAVE_WINDOW_SYSTEM */
-
+#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);
-
-extern int message_enable_multibyte;
+static void free_misc (Lisp_Object);
/* When scanning the C stack for live Lisp objects, Emacs keeps track
of what memory allocated via lisp_malloc is intended for what
intern ("emergency"));
pending_malloc_warning = 0;
}
-
-
-#ifdef DOUG_LEA_MALLOC
-# define BYTES_USED (mallinfo ().uordblks)
-#else
-# define BYTES_USED _bytes_used
-#endif
\f
/* Called if we can't allocate relocatable space for a buffer. */
/* Like malloc, but wraps allocated block with header and trailer. */
-POINTER_TYPE *
-overrun_check_malloc (size)
- size_t size;
+static POINTER_TYPE *
+overrun_check_malloc (size_t size)
{
register unsigned char *val;
size_t overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_SIZE*2 : 0;
/* Like realloc, but checks old block for overrun, and wraps new block
with header and trailer. */
-POINTER_TYPE *
-overrun_check_realloc (block, size)
- POINTER_TYPE *block;
- size_t size;
+static POINTER_TYPE *
+overrun_check_realloc (POINTER_TYPE *block, size_t size)
{
- register unsigned char *val = (unsigned char *)block;
+ register unsigned char *val = (unsigned char *) block;
size_t overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_SIZE*2 : 0;
if (val
/* Like free, but checks block for overrun. */
-void
-overrun_check_free (block)
- POINTER_TYPE *block;
+static void
+overrun_check_free (POINTER_TYPE *block)
{
- unsigned char *val = (unsigned char *)block;
+ unsigned char *val = (unsigned char *) block;
++check_depth;
if (val
nothing else. */
#define BLOCK_PADDING 0
#define BLOCK_BYTES \
- (BLOCK_ALIGN - sizeof (struct ablock *) - BLOCK_PADDING)
+ (BLOCK_ALIGN - sizeof (struct ablocks *) - BLOCK_PADDING)
/* Internal data structures and constants. */
struct buffer *b
= (struct buffer *) lisp_malloc (sizeof (struct buffer),
MEM_TYPE_BUFFER);
- b->size = sizeof (struct buffer) / sizeof (EMACS_INT);
- XSETPVECTYPE (b, PVEC_BUFFER);
+ XSETPVECTYPESIZE (b, PVEC_BUFFER,
+ ((sizeof (struct buffer) + sizeof (EMACS_INT) - 1)
+ / sizeof (EMACS_INT)));
return b;
}
static void * (*old_realloc_hook) (void *, size_t, const void*);
static void (*old_free_hook) (void*, const void*);
+#ifdef DOUG_LEA_MALLOC
+# define BYTES_USED (mallinfo ().uordblks)
+#else
+# define BYTES_USED _bytes_used
+#endif
+
static __malloc_size_t bytes_used_when_reconsidered;
+/* Value of _bytes_used, when spare_memory was freed. */
+
+static __malloc_size_t bytes_used_when_full;
+
/* This function is used as the hook for free to call. */
static void
/* List of free intervals. */
-INTERVAL interval_free_list;
+static INTERVAL interval_free_list;
/* Total number of interval blocks now in use. */
#define SDATA_NBYTES(S) (S)->nbytes
#define SDATA_DATA(S) (S)->data
+#define SDATA_SELECTOR(member) member
#else /* not GC_CHECK_STRING_BYTES */
union
{
- /* When STRING in non-null. */
+ /* When STRING is non-null. */
unsigned char data[1];
/* When STRING is null. */
EMACS_INT nbytes;
} u;
-
#define SDATA_NBYTES(S) (S)->u.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))
};
a pointer to the `u.data' member of its sdata structure; the
structure starts at a constant offset in front of that. */
-#ifdef GC_CHECK_STRING_BYTES
-
-#define SDATA_OF_STRING(S) \
- ((struct sdata *) ((S)->data - sizeof (struct Lisp_String *) \
- - sizeof (EMACS_INT)))
-
-#else /* not GC_CHECK_STRING_BYTES */
-
-#define SDATA_OF_STRING(S) \
- ((struct sdata *) ((S)->data - sizeof (struct Lisp_String *)))
-
-#endif /* not GC_CHECK_STRING_BYTES */
+#define SDATA_OF_STRING(S) ((struct sdata *) ((S)->data - SDATA_DATA_OFFSET))
#ifdef GC_CHECK_STRING_OVERRUN
presence of this cookie during GC. */
#define GC_STRING_OVERRUN_COOKIE_SIZE 4
-static char string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] =
- { 0xde, 0xad, 0xbe, 0xef };
+static char const string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] =
+ { '\xde', '\xad', '\xbe', '\xef' };
#else
#define GC_STRING_OVERRUN_COOKIE_SIZE 0
#ifdef GC_CHECK_STRING_BYTES
#define SDATA_SIZE(NBYTES) \
- ((sizeof (struct Lisp_String *) \
+ ((SDATA_DATA_OFFSET \
+ (NBYTES) + 1 \
- + sizeof (EMACS_INT) \
+ sizeof (EMACS_INT) - 1) \
& ~(sizeof (EMACS_INT) - 1))
#else /* not GC_CHECK_STRING_BYTES */
-#define SDATA_SIZE(NBYTES) \
- ((sizeof (struct Lisp_String *) \
- + (NBYTES) + 1 \
- + sizeof (EMACS_INT) - 1) \
+/* The 'max' reserves space for the nbytes union member even when NBYTES + 1 is
+ less than the size of that member. The 'max' is not needed when
+ SDATA_DATA_OFFSET is a multiple of sizeof (EMACS_INT), because then the
+ alignment code reserves enough space. */
+
+#define SDATA_SIZE(NBYTES) \
+ ((SDATA_DATA_OFFSET \
+ + (SDATA_DATA_OFFSET % sizeof (EMACS_INT) == 0 \
+ ? NBYTES \
+ : max (NBYTES, sizeof (EMACS_INT) - 1)) \
+ + 1 \
+ + sizeof (EMACS_INT) - 1) \
& ~(sizeof (EMACS_INT) - 1))
#endif /* not GC_CHECK_STRING_BYTES */
static int check_string_bytes_count;
-static void check_string_bytes (int);
-static void check_sblock (struct sblock *);
-
#define CHECK_STRING_BYTES(S) STRING_BYTES (S)
/* Check validity of Lisp strings' string_bytes member in B. */
static void
-check_sblock (b)
- struct sblock *b;
+check_sblock (struct sblock *b)
{
struct sdata *from, *end, *from_end;
recently allocated strings. Used for hunting a bug. */
static void
-check_string_bytes (all_p)
- int all_p;
+check_string_bytes (int all_p)
{
if (all_p)
{
This may catch buffer overrun from a previous string. */
static void
-check_string_free_list ()
+check_string_free_list (void)
{
struct Lisp_String *s;
if (nbytes > LARGE_STRING_BYTES)
{
- size_t size = sizeof *b - sizeof (struct sdata) + needed;
+ size_t size = offsetof (struct sblock, first_data) + needed;
#ifdef DOUG_LEA_MALLOC
/* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed
s->size_byte = nbytes;
s->data[nbytes] = '\0';
#ifdef GC_CHECK_STRING_OVERRUN
- memcpy (data + needed, string_overrun_cookie, GC_STRING_OVERRUN_COOKIE_SIZE);
+ memcpy ((char *) data + needed, string_overrun_cookie,
+ GC_STRING_OVERRUN_COOKIE_SIZE);
#endif
/* If S had already data assigned, mark that as free by setting its
/* Copy, and update the string's `data' pointer. */
if (from != to)
{
- xassert (tb != b || to <= from);
+ xassert (tb != b || to < from);
memmove (to, from, nbytes + GC_STRING_EXTRA);
to->string->data = SDATA_DATA (to);
}
slot `size' of the struct Lisp_Bool_Vector. */
val = Fmake_vector (make_number (length_in_elts + 1), Qnil);
- /* Get rid of any bits that would cause confusion. */
- XVECTOR (val)->size = 0; /* No Lisp_Object to trace in there. */
- /* Use XVECTOR (val) rather than `p' because p->size is not TRT. */
- XSETPVECTYPE (XVECTOR (val), PVEC_BOOL_VECTOR);
+ /* No Lisp_Object to trace in there. */
+ XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0);
p = XBOOL_VECTOR (val);
p->size = XFASTINT (length);
/* Current float_block. */
-struct float_block *float_block;
+static struct float_block *float_block;
/* Index of first unused Lisp_Float in the current float_block. */
-int float_block_index;
+static int float_block_index;
/* Total number of float blocks now in use. */
-int n_float_blocks;
+static int n_float_blocks;
/* Free-list of Lisp_Floats. */
-struct Lisp_Float *float_free_list;
+static struct Lisp_Float *float_free_list;
/* Initialize float allocation. */
/* Current cons_block. */
-struct cons_block *cons_block;
+static struct cons_block *cons_block;
/* Index of first unused Lisp_Cons in the current block. */
-int cons_block_index;
+static int cons_block_index;
/* Free-list of Lisp_Cons structures. */
-struct Lisp_Cons *cons_free_list;
+static struct Lisp_Cons *cons_free_list;
/* Total number of cons blocks now in use. */
return val;
}
+#ifdef GC_CHECK_CONS_LIST
/* Get an error now if there's any junk in the cons free list. */
void
check_cons_list (void)
{
-#ifdef GC_CHECK_CONS_LIST
struct Lisp_Cons *tail = cons_free_list;
while (tail)
tail = tail->u.chain;
-#endif
}
+#endif
/* Make a list of 1, 2, 3, 4 or 5 specified objects. */
doc: /* Return a newly created list with specified arguments as elements.
Any number of arguments, even zero arguments, are allowed.
usage: (list &rest OBJECTS) */)
- (int nargs, register Lisp_Object *args)
+ (size_t nargs, register Lisp_Object *args)
{
register Lisp_Object val;
val = Qnil;
/* This gets triggered by code which I haven't bothered to fix. --Stef */
/* eassert (!handling_signal); */
- nbytes = sizeof *p + (len - 1) * sizeof p->contents[0];
+ nbytes = (offsetof (struct Lisp_Vector, contents)
+ + len * sizeof p->contents[0]);
p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE);
#ifdef DOUG_LEA_MALLOC
consing_since_gc += nbytes;
vector_cells_consed += len;
- p->next = all_vectors;
+ p->header.next.vector = all_vectors;
all_vectors = p;
MALLOC_UNBLOCK_INPUT;
allocate_vector (EMACS_INT nslots)
{
struct Lisp_Vector *v = allocate_vectorlike (nslots);
- v->size = nslots;
+ v->header.size = nslots;
return v;
}
EMACS_INT i;
/* Only the first lisplen slots will be traced normally by the GC. */
- v->size = lisplen;
for (i = 0; i < lisplen; ++i)
v->contents[i] = Qnil;
- XSETPVECTYPE (v, tag); /* Add the appropriate tag. */
+ XSETPVECTYPESIZE (v, tag, lisplen);
return v;
}
{
Lisp_Object vector;
register EMACS_INT sizei;
- register EMACS_INT index;
+ register EMACS_INT i;
register struct Lisp_Vector *p;
CHECK_NATNUM (length);
sizei = XFASTINT (length);
p = allocate_vector (sizei);
- for (index = 0; index < sizei; index++)
- p->contents[index] = init;
+ for (i = 0; i < sizei; i++)
+ p->contents[i] = init;
XSETVECTOR (vector, p);
return vector;
doc: /* Return a newly created vector with specified arguments as elements.
Any number of arguments, even zero arguments, are allowed.
usage: (vector &rest OBJECTS) */)
- (register int nargs, Lisp_Object *args)
+ (register size_t nargs, Lisp_Object *args)
{
register Lisp_Object len, val;
- register int index;
+ register size_t i;
register struct Lisp_Vector *p;
XSETFASTINT (len, nargs);
val = Fmake_vector (len, Qnil);
p = XVECTOR (val);
- for (index = 0; index < nargs; index++)
- p->contents[index] = args[index];
+ for (i = 0; i < nargs; i++)
+ p->contents[i] = args[i];
return val;
}
DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
doc: /* Create a byte-code object with specified arguments as elements.
-The arguments should be the arglist, bytecode-string, constant vector,
-stack size, (optional) doc string, and (optional) interactive spec.
+The arguments should be the ARGLIST, bytecode-string BYTE-CODE, constant
+vector CONSTANTS, maximum stack size DEPTH, (optional) DOCSTRING,
+and (optional) INTERACTIVE-SPEC.
The first four arguments are required; at most six have any
significance.
+The ARGLIST can be either like the one of `lambda', in which case the arguments
+will be dynamically bound before executing the byte code, or it can be an
+integer of the form NNNNNNNRMMMMMMM where the 7bit MMMMMMM specifies the
+minimum number of arguments, the 7-bit NNNNNNN specifies the maximum number
+of arguments (ignoring &rest) and the R bit specifies whether there is a &rest
+argument to catch the left-over arguments. If such an integer is used, the
+arguments will not be dynamically bound but will be instead pushed on the
+stack before executing the byte-code.
usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */)
- (register int nargs, Lisp_Object *args)
+ (register size_t nargs, Lisp_Object *args)
{
register Lisp_Object len, val;
- register int index;
+ register size_t i;
register struct Lisp_Vector *p;
XSETFASTINT (len, nargs);
args[1] = Fstring_as_unibyte (args[1]);
p = XVECTOR (val);
- for (index = 0; index < nargs; index++)
+ for (i = 0; i < nargs; i++)
{
if (!NILP (Vpurify_flag))
- args[index] = Fpurecopy (args[index]);
- p->contents[index] = args[index];
+ args[i] = Fpurecopy (args[i]);
+ p->contents[i] = args[i];
}
XSETPVECTYPE (p, PVEC_COMPILED);
XSETCOMPILED (val, p);
p->gcmarkbit = 0;
p->interned = SYMBOL_UNINTERNED;
p->constant = 0;
+ p->declared_special = 0;
consing_since_gc += sizeof (struct Lisp_Symbol);
symbols_consed++;
return val;
/* Free a Lisp_Misc object */
-void
+static void
free_misc (Lisp_Object misc)
{
XMISCTYPE (misc) = Lisp_Misc_Free;
/* Record the space now used. When it decreases substantially,
we can refill the memory reserve. */
-#ifndef SYSTEM_MALLOC
+#if !defined SYSTEM_MALLOC && !defined SYNC_INPUT
bytes_used_when_full = BYTES_USED;
#endif
check_gcpros (void)
{
struct gcpro *p;
- int i;
+ size_t i;
for (p = gcprolist; p; p = p->next)
for (i = 0; i < p->nvars; ++i)
mark_stack (void)
{
int i;
- /* jmp_buf may not be aligned enough on darwin-ppc64 */
- union aligned_jmpbuf {
- Lisp_Object o;
- jmp_buf j;
- } j;
- volatile int stack_grows_down_p = (char *) &j > (char *) stack_base;
void *end;
#ifdef HAVE___BUILTIN_UNWIND_INIT
__builtin_unwind_init ();
end = &end;
#else /* not HAVE___BUILTIN_UNWIND_INIT */
+#ifndef GC_SAVE_REGISTERS_ON_STACK
+ /* jmp_buf may not be aligned enough on darwin-ppc64 */
+ union aligned_jmpbuf {
+ Lisp_Object o;
+ jmp_buf j;
+ } j;
+ volatile int stack_grows_down_p = (char *) &j > (char *) stack_base;
+#endif
/* This trick flushes the register windows so that all the state of
the process is contained in the stack. */
/* Fixme: Code in the Boehm GC suggests flushing (with `flushrs') is
check_pure_size (void)
{
if (pure_bytes_used_before_overflow)
- message ("emacs:0:Pure Lisp storage overflow (approx. %d bytes needed)",
- (int) (pure_bytes_used + pure_bytes_used_before_overflow));
+ message (("emacs:0:Pure Lisp storage overflow (approx. %"pI"d"
+ " bytes needed)"),
+ pure_bytes_used + pure_bytes_used_before_overflow);
}
{
Lisp_Object new;
struct Lisp_Vector *p;
- size_t size = sizeof *p + (len - 1) * sizeof (Lisp_Object);
+ size_t size = (offsetof (struct Lisp_Vector, contents)
+ + len * sizeof (Lisp_Object));
p = (struct Lisp_Vector *) pure_alloc (size, Lisp_Vectorlike);
XSETVECTOR (new, p);
- XVECTOR (new)->size = len;
+ XVECTOR (new)->header.size = len;
return new;
}
register EMACS_INT i;
EMACS_INT size;
- size = XVECTOR (obj)->size;
+ size = ASIZE (obj);
if (size & PSEUDOVECTOR_FLAG)
size &= PSEUDOVECTOR_SIZE_MASK;
vec = XVECTOR (make_pure_vector (size));
{
register struct specbinding *bind;
char stack_top_variable;
- register int i;
+ register size_t i;
int message_p;
Lisp_Object total[8];
int count = SPECPDL_INDEX ();
}
}
- nextb = nextb->next;
+ nextb = nextb->header.next.buffer;
}
}
#if MAX_SAVE_STACK > 0
if (NILP (Vpurify_flag))
{
- i = &stack_top_variable - stack_bottom;
- if (i < 0) i = -i;
- if (i < MAX_SAVE_STACK)
+ char *stack;
+ size_t stack_size;
+ if (&stack_top_variable < stack_bottom)
+ {
+ stack = &stack_top_variable;
+ stack_size = stack_bottom - &stack_top_variable;
+ }
+ else
+ {
+ stack = stack_bottom;
+ stack_size = &stack_top_variable - stack_bottom;
+ }
+ if (stack_size <= MAX_SAVE_STACK)
{
- if (stack_copy == 0)
- stack_copy = (char *) xmalloc (stack_copy_size = i);
- else if (stack_copy_size < i)
- stack_copy = (char *) xrealloc (stack_copy, (stack_copy_size = i));
- if (stack_copy)
+ if (stack_copy_size < stack_size)
{
- if ((EMACS_INT) (&stack_top_variable - stack_bottom) > 0)
- memcpy (stack_copy, stack_bottom, i);
- else
- memcpy (stack_copy, &stack_top_variable, i);
+ stack_copy = (char *) xrealloc (stack_copy, stack_size);
+ stack_copy_size = stack_size;
}
+ memcpy (stack_copy, stack, stack_size);
}
}
#endif /* MAX_SAVE_STACK > 0 */
undo_list any more, we can finally mark the list. */
mark_object (nextb->BUFFER_INTERNAL_FIELD (undo_list));
- nextb = nextb->next;
+ nextb = nextb->header.next.buffer;
}
}
if (FLOATP (Vgc_cons_percentage))
{ /* Set gc_cons_combined_threshold. */
- EMACS_INT total = 0;
-
- total += total_conses * sizeof (struct Lisp_Cons);
- total += total_symbols * sizeof (struct Lisp_Symbol);
- total += total_markers * sizeof (union Lisp_Misc);
- total += total_string_size;
- total += total_vector_size * sizeof (Lisp_Object);
- total += total_floats * sizeof (struct Lisp_Float);
- total += total_intervals * sizeof (struct interval);
- total += total_strings * sizeof (struct Lisp_String);
-
- gc_relative_threshold = total * XFLOAT_DATA (Vgc_cons_percentage);
+ EMACS_INT tot = 0;
+
+ tot += total_conses * sizeof (struct Lisp_Cons);
+ tot += total_symbols * sizeof (struct Lisp_Symbol);
+ tot += total_markers * sizeof (union Lisp_Misc);
+ tot += total_string_size;
+ tot += total_vector_size * sizeof (Lisp_Object);
+ tot += total_floats * sizeof (struct Lisp_Float);
+ tot += total_intervals * sizeof (struct interval);
+ tot += total_strings * sizeof (struct Lisp_String);
+
+ gc_relative_threshold = tot * XFLOAT_DATA (Vgc_cons_percentage);
}
else
gc_relative_threshold = 0;
if (!NILP (Vpost_gc_hook))
{
- int count = inhibit_garbage_collection ();
+ int gc_count = inhibit_garbage_collection ();
safe_run_hooks (Qpost_gc_hook);
- unbind_to (count, Qnil);
+ unbind_to (gc_count, Qnil);
}
/* Accumulate statistics. */
#define LAST_MARKED_SIZE 500
static Lisp_Object last_marked[LAST_MARKED_SIZE];
-int last_marked_index;
+static int last_marked_index;
/* For debugging--call abort when we cdr down this many
links of a list, in mark_object. In debugging,
the call to abort will hit a breakpoint.
Normally this is zero and the check never goes off. */
-static int mark_object_loop_halt;
+static size_t mark_object_loop_halt;
static void
mark_vectorlike (struct Lisp_Vector *ptr)
{
- register EMACS_UINT size = ptr->size;
+ register EMACS_UINT size = ptr->header.size;
register EMACS_UINT i;
eassert (!VECTOR_MARKED_P (ptr));
static void
mark_char_table (struct Lisp_Vector *ptr)
{
- register EMACS_UINT size = ptr->size & PSEUDOVECTOR_SIZE_MASK;
+ register EMACS_UINT size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
register EMACS_UINT i;
eassert (!VECTOR_MARKED_P (ptr));
void *po;
struct mem_node *m;
#endif
- int cdr_count = 0;
+ size_t cdr_count = 0;
loop:
#else /* not GC_CHECK_MARKED_OBJECTS */
-#define CHECK_ALLOCATED() (void) 0
#define CHECK_LIVE(LIVEP) (void) 0
#define CHECK_ALLOCATED_AND_LIVE(LIVEP) (void) 0
if (po != &buffer_defaults && po != &buffer_local_symbols)
{
struct buffer *b;
- for (b = all_buffers; b && b != po; b = b->next)
+ for (b = all_buffers; b && b != po; b = b->header.next.buffer)
;
if (b == NULL)
abort ();
recursion there. */
{
register struct Lisp_Vector *ptr = XVECTOR (obj);
- register EMACS_UINT size = ptr->size;
+ register EMACS_UINT size = ptr->header.size;
register EMACS_UINT i;
CHECK_LIVE (live_vector_p);
if (!VECTOR_MARKED_P (buffer))
{
if (prev)
- prev->next = buffer->next;
+ prev->header.next = buffer->header.next;
else
- all_buffers = buffer->next;
- next = buffer->next;
+ all_buffers = buffer->header.next.buffer;
+ next = buffer->header.next.buffer;
lisp_free (buffer);
buffer = next;
}
{
VECTOR_UNMARK (buffer);
UNMARK_BALANCE_INTERVALS (BUF_INTERVALS (buffer));
- prev = buffer, buffer = buffer->next;
+ prev = buffer, buffer = buffer->header.next.buffer;
}
}
if (!VECTOR_MARKED_P (vector))
{
if (prev)
- prev->next = vector->next;
+ prev->header.next = vector->header.next;
else
- all_vectors = vector->next;
- next = vector->next;
+ all_vectors = vector->header.next.vector;
+ next = vector->header.next.vector;
lisp_free (vector);
n_vectors--;
vector = next;
else
{
VECTOR_UNMARK (vector);
- if (vector->size & PSEUDOVECTOR_FLAG)
- total_vector_size += (PSEUDOVECTOR_SIZE_MASK & vector->size);
+ if (vector->header.size & PSEUDOVECTOR_FLAG)
+ total_vector_size += PSEUDOVECTOR_SIZE_MASK & vector->header.size;
else
- total_vector_size += vector->size;
- prev = vector, vector = vector->next;
+ total_vector_size += vector->header.size;
+ prev = vector, vector = vector->header.next.vector;
}
}
{
Lisp_Object end;
- XSETINT (end, (EMACS_INT) sbrk (0) / 1024);
+ XSETINT (end, (EMACS_INT) (char *) sbrk (0) / 1024);
return end;
}
return Flist (8, consed);
}
+#ifdef ENABLE_CHECKING
int suppress_checking;
void
file, line, msg);
abort ();
}
+#endif
\f
/* Initialization */