/* Storage allocation and gc for GNU Emacs Lisp interpreter.
Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999,
- 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+ 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
This file is part of GNU Emacs.
You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
#include <config.h>
#include <stdio.h>
#include <limits.h> /* For CHAR_BIT. */
+#ifdef STDC_HEADERS
+#include <stddef.h> /* For offsetof, used by PSEUDOVECSIZE. */
+#endif
+
#ifdef ALLOC_DEBUG
#undef INLINE
#endif
extern POINTER_TYPE *sbrk ();
#endif
+#ifdef HAVE_FCNTL_H
+#define INCLUDED_FCNTL
+#include <fcntl.h>
+#endif
+#ifndef O_WRONLY
+#define O_WRONLY 1
+#endif
+
#ifdef DOUG_LEA_MALLOC
#include <malloc.h>
static __malloc_size_t bytes_used_when_full;
+static __malloc_size_t bytes_used_when_reconsidered;
+
/* Mark, unmark, query mark bit of a Lisp string. S must be a pointer
to a struct Lisp_String. */
EMACS_INT intervals_consed;
EMACS_INT strings_consed;
-/* Number of bytes of consing since GC before another GC should be done. */
+/* Minimum number of bytes of consing since GC before next GC. */
EMACS_INT gc_cons_threshold;
+/* Similar minimum, computed from Vgc_cons_percentage. */
+
+EMACS_INT gc_relative_threshold;
+
+static Lisp_Object Vgc_cons_percentage;
+
+/* Minimum number of bytes of consing since GC before next GC,
+ when memory is full. */
+
+EMACS_INT memory_full_cons_threshold;
+
/* Nonzero during GC. */
int gc_in_progress;
static int total_free_floats, total_floats;
/* Points to memory space allocated as "spare", to be freed if we run
- out of memory. */
+ out of memory. We keep one large block, four cons-blocks, and
+ two string blocks. */
-static char *spare_memory;
+char *spare_memory[7];
-/* Amount of spare memory to keep in reserve. */
+/* Amount of spare memory to keep in large reserve block. */
#define SPARE_MEMORY (1 << 14)
MEM_TYPE_WINDOW
};
+static POINTER_TYPE *lisp_align_malloc P_ ((size_t, enum mem_type));
+static POINTER_TYPE *lisp_malloc P_ ((size_t, enum mem_type));
+void refill_memory_reserve ();
+
+
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
static void mem_delete_fixup P_ ((struct mem_node *));
static INLINE struct mem_node *mem_find P_ ((void *));
+
#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
static void check_gcpros P_ ((void));
#endif
#ifdef DOUG_LEA_MALLOC
-# define BYTES_USED (mallinfo ().arena)
+# define BYTES_USED (mallinfo ().uordblks)
#else
# define BYTES_USED _bytes_used
#endif
-
-
-/* Called if malloc returns zero. */
-
-void
-memory_full ()
-{
- Vmemory_full = Qt;
-
-#ifndef SYSTEM_MALLOC
- bytes_used_when_full = BYTES_USED;
-#endif
-
- /* The first time we get here, free the spare memory. */
- if (spare_memory)
- {
- free (spare_memory);
- spare_memory = 0;
- }
-
- /* This used to call error, but if we've run out of memory, we could
- get infinite recursion trying to build the string. */
- while (1)
- Fsignal (Qnil, Vmemory_signal_data);
-}
-
-
+\f
/* Called if we can't allocate relocatable space for a buffer. */
void
memory_full ();
#endif
- Vmemory_full = Qt;
-
/* This used to call error, but if we've run out of memory, we could
get infinite recursion trying to build the string. */
while (1)
BLOCK_INPUT;
free (block);
UNBLOCK_INPUT;
+ /* We don't call refill_memory_reserve here
+ because that duplicates doing so in emacs_blocked_free
+ and the criterion should go there. */
}
/* The entry point is lisp_align_malloc which returns blocks of at most */
/* BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary. */
+/* Use posix_memalloc if the system has it and we're using the system's
+ malloc (because our gmalloc.c routines don't have posix_memalign although
+ its memalloc could be used). */
+#if defined (HAVE_POSIX_MEMALIGN) && defined (SYSTEM_MALLOC)
+#define USE_POSIX_MEMALIGN 1
+#endif
/* BLOCK_ALIGN has to be a power of 2. */
#define BLOCK_ALIGN (1 << 10)
#define ABLOCKS_BUSY(abase) ((abase)->blocks[0].abase)
/* Pointer to the (not necessarily aligned) malloc block. */
-#ifdef HAVE_POSIX_MEMALIGN
+#ifdef USE_POSIX_MEMALIGN
#define ABLOCKS_BASE(abase) (abase)
#else
#define ABLOCKS_BASE(abase) \
mallopt (M_MMAP_MAX, 0);
#endif
-#ifdef HAVE_POSIX_MEMALIGN
+#ifdef USE_POSIX_MEMALIGN
{
int err = posix_memalign (&base, BLOCK_ALIGN, ABLOCKS_BYTES);
if (err)
}
eassert ((aligned & 1) == aligned);
eassert (i == (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1));
+#ifdef USE_POSIX_MEMALIGN
+ eassert ((unsigned long)ABLOCKS_BASE (abase) % BLOCK_ALIGN == 0);
+#endif
free (ABLOCKS_BASE (abase));
}
UNBLOCK_INPUT;
\f
#ifndef SYSTEM_MALLOC
-/* If we released our reserve (due to running out of memory),
- and we have a fair amount free once again,
- try to set aside another reserve in case we run out once more.
-
- This is called when a relocatable block is freed in ralloc.c. */
-
-void
-refill_memory_reserve ()
-{
- if (spare_memory == 0)
- spare_memory = (char *) malloc ((size_t) SPARE_MEMORY);
-}
-
-\f
/* Arranging to disable input signals while we're in malloc.
This only works with GNU malloc. To help out systems which can't
#ifndef SYNC_INPUT
#ifndef DOUG_LEA_MALLOC
-extern void * (*__malloc_hook) P_ ((size_t));
-extern void * (*__realloc_hook) P_ ((void *, size_t));
-extern void (*__free_hook) P_ ((void *));
+extern void * (*__malloc_hook) P_ ((size_t, const void *));
+extern void * (*__realloc_hook) P_ ((void *, size_t, const void *));
+extern void (*__free_hook) P_ ((void *, const void *));
/* Else declared in malloc.h, perhaps with an extra arg. */
#endif /* DOUG_LEA_MALLOC */
-static void * (*old_malloc_hook) ();
-static void * (*old_realloc_hook) ();
-static void (*old_free_hook) ();
+static void * (*old_malloc_hook) P_ ((size_t, const void *));
+static void * (*old_realloc_hook) P_ ((void *, size_t, const void*));
+static void (*old_free_hook) P_ ((void*, const void*));
/* This function is used as the hook for free to call. */
static void
-emacs_blocked_free (ptr)
+emacs_blocked_free (ptr, ptr2)
void *ptr;
+ const void *ptr2;
{
+ EMACS_INT bytes_used_now;
+
BLOCK_INPUT_ALLOC;
#ifdef GC_MALLOC_CHECK
/* If we released our reserve (due to running out of memory),
and we have a fair amount free once again,
try to set aside another reserve in case we run out once more. */
- if (spare_memory == 0
+ if (! NILP (Vmemory_full)
/* Verify there is enough space that even with the malloc
hysteresis this call won't run out again.
The code here is correct as long as SPARE_MEMORY
is substantially larger than the block size malloc uses. */
&& (bytes_used_when_full
- > BYTES_USED + max (malloc_hysteresis, 4) * SPARE_MEMORY))
- spare_memory = (char *) malloc ((size_t) SPARE_MEMORY);
+ > ((bytes_used_when_reconsidered = BYTES_USED)
+ + max (malloc_hysteresis, 4) * SPARE_MEMORY)))
+ refill_memory_reserve ();
__free_hook = emacs_blocked_free;
UNBLOCK_INPUT_ALLOC;
/* This function is the malloc hook that Emacs uses. */
static void *
-emacs_blocked_malloc (size)
+emacs_blocked_malloc (size, ptr)
size_t size;
+ const void *ptr;
{
void *value;
/* This function is the realloc hook that Emacs uses. */
static void *
-emacs_blocked_realloc (ptr, size)
+emacs_blocked_realloc (ptr, size, ptr2)
void *ptr;
size_t size;
+ const void *ptr2;
{
void *value;
{
INTERVAL val;
+ /* eassert (!handling_signal); */
+
+#ifndef SYNC_INPUT
+ BLOCK_INPUT;
+#endif
+
if (interval_free_list)
{
val = interval_free_list;
}
val = &interval_block->intervals[interval_block_index++];
}
+
+#ifndef SYNC_INPUT
+ UNBLOCK_INPUT;
+#endif
+
consing_since_gc += sizeof (struct interval);
intervals_consed++;
RESET_INTERVAL (val);
/* We check for overrun in string data blocks by appending a small
"cookie" after each allocated string data block, and check for the
- presense of this cookie during GC. */
+ presence of this cookie during GC. */
#define GC_STRING_OVERRUN_COOKIE_SIZE 4
static char string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] =
{
struct Lisp_String *s;
+ /* eassert (!handling_signal); */
+
+#ifndef SYNC_INPUT
+ BLOCK_INPUT;
+#endif
+
/* If the free-list is empty, allocate a new string_block, and
add all the Lisp_Strings in it to the free-list. */
if (string_free_list == NULL)
s = string_free_list;
string_free_list = NEXT_FREE_LISP_STRING (s);
+#ifndef SYNC_INPUT
+ UNBLOCK_INPUT;
+#endif
+
/* Probably not strictly necessary, but play it safe. */
bzero (s, sizeof *s);
/* Determine the number of bytes needed to store NBYTES bytes
of string data. */
needed = SDATA_SIZE (nbytes);
+ old_data = s->data ? SDATA_OF_STRING (s) : NULL;
+ old_nbytes = GC_STRING_BYTES (s);
+
+#ifndef SYNC_INPUT
+ BLOCK_INPUT;
+#endif
if (nbytes > LARGE_STRING_BYTES)
{
else
b = current_sblock;
- old_data = s->data ? SDATA_OF_STRING (s) : NULL;
- old_nbytes = GC_STRING_BYTES (s);
-
data = b->next_free;
+ b->next_free = (struct sdata *) ((char *) data + needed + GC_STRING_EXTRA);
+
+#ifndef SYNC_INPUT
+ UNBLOCK_INPUT;
+#endif
+
data->string = s;
s->data = SDATA_DATA (data);
#ifdef GC_CHECK_STRING_BYTES
bcopy (string_overrun_cookie, (char *) data + needed,
GC_STRING_OVERRUN_COOKIE_SIZE);
#endif
- b->next_free = (struct sdata *) ((char *) data + needed + GC_STRING_EXTRA);
/* If S had already data assigned, mark that as free by setting its
string back-pointer to null, and recording the size of the data
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 as each element.
+ doc: /* Return a new bool-vector of length LENGTH, using INIT for each element.
LENGTH must be a number. INIT matters only in whether it is t or nil. */)
(length, init)
Lisp_Object length, init;
free_float (ptr)
struct Lisp_Float *ptr;
{
- *(struct Lisp_Float **)&ptr->data = float_free_list;
+ ptr->u.chain = float_free_list;
float_free_list = ptr;
}
{
register Lisp_Object val;
+ /* eassert (!handling_signal); */
+
+#ifndef SYNC_INPUT
+ BLOCK_INPUT;
+#endif
+
if (float_free_list)
{
/* We use the data field for chaining the free list
so that we won't use the same field that has the mark bit. */
XSETFLOAT (val, float_free_list);
- float_free_list = *(struct Lisp_Float **)&float_free_list->data;
+ float_free_list = float_free_list->u.chain;
}
else
{
float_block_index++;
}
+#ifndef SYNC_INPUT
+ UNBLOCK_INPUT;
+#endif
+
XFLOAT_DATA (val) = float_value;
eassert (!FLOAT_MARKED_P (XFLOAT (val)));
consing_since_gc += sizeof (struct Lisp_Float);
free_cons (ptr)
struct Lisp_Cons *ptr;
{
- *(struct Lisp_Cons **)&ptr->cdr = cons_free_list;
+ ptr->u.chain = cons_free_list;
#if GC_MARK_STACK
ptr->car = Vdead;
#endif
{
register Lisp_Object val;
+ /* eassert (!handling_signal); */
+
+#ifndef SYNC_INPUT
+ BLOCK_INPUT;
+#endif
+
if (cons_free_list)
{
/* We use the cdr for chaining the free list
so that we won't use the same field that has the mark bit. */
XSETCONS (val, cons_free_list);
- cons_free_list = *(struct Lisp_Cons **)&cons_free_list->cdr;
+ cons_free_list = cons_free_list->u.chain;
}
else
{
cons_block_index++;
}
+#ifndef SYNC_INPUT
+ UNBLOCK_INPUT;
+#endif
+
XSETCAR (val, car);
XSETCDR (val, cdr);
eassert (!CONS_MARKED_P (XCONS (val)));
struct Lisp_Cons *tail = cons_free_list;
while (tail)
- tail = *(struct Lisp_Cons **)&tail->cdr;
+ tail = tail->u.chain;
#endif
}
UNBLOCK_INPUT;
#endif
+ /* 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];
p = (struct Lisp_Vector *) lisp_malloc (nbytes, type);
consing_since_gc += nbytes;
vector_cells_consed += len;
+#ifndef SYNC_INPUT
+ BLOCK_INPUT;
+#endif
+
p->next = all_vectors;
all_vectors = p;
+
+#ifndef SYNC_INPUT
+ UNBLOCK_INPUT;
+#endif
+
++n_vectors;
return p;
}
struct Lisp_Process *
allocate_process ()
{
- EMACS_INT len = VECSIZE (struct Lisp_Process);
- struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_PROCESS);
+ /* Memory-footprint of the object in nb of Lisp_Object fields. */
+ EMACS_INT memlen = VECSIZE (struct Lisp_Process);
+ /* Size if we only count the actual Lisp_Object fields (which need to be
+ traced by the GC). */
+ EMACS_INT lisplen = PSEUDOVECSIZE (struct Lisp_Process, pid);
+ struct Lisp_Vector *v = allocate_vectorlike (memlen, MEM_TYPE_PROCESS);
EMACS_INT i;
- for (i = 0; i < len; ++i)
+ for (i = 0; i < lisplen; ++i)
v->contents[i] = Qnil;
- v->size = len;
+ v->size = lisplen;
return (struct Lisp_Process *) v;
}
CHECK_STRING (name);
+ /* eassert (!handling_signal); */
+
+#ifndef SYNC_INPUT
+ BLOCK_INPUT;
+#endif
+
if (symbol_free_list)
{
XSETSYMBOL (val, symbol_free_list);
- symbol_free_list = *(struct Lisp_Symbol **)&symbol_free_list->value;
+ symbol_free_list = symbol_free_list->next;
}
else
{
symbol_block_index++;
}
+#ifndef SYNC_INPUT
+ UNBLOCK_INPUT;
+#endif
+
p = XSYMBOL (val);
p->xname = name;
p->plist = Qnil;
{
Lisp_Object val;
+ /* eassert (!handling_signal); */
+
+#ifndef SYNC_INPUT
+ BLOCK_INPUT;
+#endif
+
if (marker_free_list)
{
XSETMISC (val, marker_free_list);
marker_block_index++;
}
+#ifndef SYNC_INPUT
+ UNBLOCK_INPUT;
+#endif
+
--total_free_markers;
consing_since_gc += sizeof (union Lisp_Misc);
misc_objects_consed++;
}
+\f
+/************************************************************************
+ Memory Full Handling
+ ************************************************************************/
+
+
+/* Called if malloc returns zero. */
+
+void
+memory_full ()
+{
+ int i;
+
+ Vmemory_full = Qt;
+
+ memory_full_cons_threshold = sizeof (struct cons_block);
+
+ /* The first time we get here, free the spare memory. */
+ for (i = 0; i < sizeof (spare_memory) / sizeof (char *); i++)
+ if (spare_memory[i])
+ {
+ if (i == 0)
+ free (spare_memory[i]);
+ else if (i >= 1 && i <= 4)
+ lisp_align_free (spare_memory[i]);
+ else
+ lisp_free (spare_memory[i]);
+ spare_memory[i] = 0;
+ }
+
+ /* Record the space now used. When it decreases substantially,
+ we can refill the memory reserve. */
+#ifndef SYSTEM_MALLOC
+ bytes_used_when_full = BYTES_USED;
+#endif
+
+ /* This used to call error, but if we've run out of memory, we could
+ get infinite recursion trying to build the string. */
+ while (1)
+ Fsignal (Qnil, Vmemory_signal_data);
+}
+
+/* If we released our reserve (due to running out of memory),
+ and we have a fair amount free once again,
+ try to set aside another reserve in case we run out once more.
+
+ This is called when a relocatable block is freed in ralloc.c,
+ and also directly from this file, in case we're not using ralloc.c. */
+
+void
+refill_memory_reserve ()
+{
+#ifndef SYSTEM_MALLOC
+ if (spare_memory[0] == 0)
+ spare_memory[0] = (char *) malloc ((size_t) SPARE_MEMORY);
+ if (spare_memory[1] == 0)
+ spare_memory[1] = (char *) lisp_align_malloc (sizeof (struct cons_block),
+ MEM_TYPE_CONS);
+ if (spare_memory[2] == 0)
+ spare_memory[2] = (char *) lisp_align_malloc (sizeof (struct cons_block),
+ MEM_TYPE_CONS);
+ if (spare_memory[3] == 0)
+ spare_memory[3] = (char *) lisp_align_malloc (sizeof (struct cons_block),
+ MEM_TYPE_CONS);
+ if (spare_memory[4] == 0)
+ spare_memory[4] = (char *) lisp_align_malloc (sizeof (struct cons_block),
+ MEM_TYPE_CONS);
+ if (spare_memory[5] == 0)
+ spare_memory[5] = (char *) lisp_malloc (sizeof (struct string_block),
+ MEM_TYPE_STRING);
+ if (spare_memory[6] == 0)
+ spare_memory[6] = (char *) lisp_malloc (sizeof (struct string_block),
+ MEM_TYPE_STRING);
+ if (spare_memory[0] && spare_memory[1] && spare_memory[5])
+ Vmemory_full = Qnil;
+#endif
+}
\f
/************************************************************************
C Stack Marking
#endif
}
-
#endif /* GC_MARK_STACK != 0 */
+
+/* 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. */
+
+int
+valid_lisp_object_p (obj)
+ Lisp_Object obj;
+{
+ void *p;
+#if !GC_MARK_STACK
+ int fd;
+#else
+ struct mem_node *m;
+#endif
+
+ if (INTEGERP (obj))
+ return 1;
+
+ p = (void *) XPNTR (obj);
+ if (PURE_POINTER_P (p))
+ return 1;
+
+#if !GC_MARK_STACK
+ /* We need to determine whether it is safe to access memory at
+ address P. Obviously, we cannot just access it (we would SEGV
+ trying), so we trick the o/s to tell us whether p is a valid
+ pointer. Unfortunately, we cannot use NULL_DEVICE here, as
+ emacs_write may not validate p in that case. */
+ if ((fd = emacs_open ("__Valid__Lisp__Object__", O_CREAT | O_WRONLY | O_TRUNC, 0666)) >= 0)
+ {
+ int valid = (emacs_write (fd, (char *)p, 16) == 16);
+ emacs_close (fd);
+ unlink ("__Valid__Lisp__Object__");
+ return valid;
+ }
+
+ return -1;
+#else
+
+ m = mem_find (p);
+
+ if (m == MEM_NIL)
+ return 0;
+
+ switch (m->type)
+ {
+ case MEM_TYPE_NON_LISP:
+ return 0;
+
+ case MEM_TYPE_BUFFER:
+ return live_buffer_p (m, p);
+
+ case MEM_TYPE_CONS:
+ return live_cons_p (m, p);
+
+ case MEM_TYPE_STRING:
+ return live_string_p (m, p);
+
+ case MEM_TYPE_MISC:
+ return live_misc_p (m, p);
+
+ case MEM_TYPE_SYMBOL:
+ return live_symbol_p (m, p);
+
+ case MEM_TYPE_FLOAT:
+ return live_float_p (m, p);
+
+ case MEM_TYPE_VECTOR:
+ case MEM_TYPE_PROCESS:
+ case MEM_TYPE_HASH_TABLE:
+ case MEM_TYPE_FRAME:
+ case MEM_TYPE_WINDOW:
+ return live_vector_p (m, p);
+
+ default:
+ break;
+ }
+
+ return 0;
+#endif
+}
+
+
+
\f
/***********************************************************************
Pure Storage Management
check_pure_size ()
{
if (pure_bytes_used_before_overflow)
- message ("Pure Lisp storage overflow (approx. %d bytes needed)",
+ message ("emacs:0:Pure Lisp storage overflow (approx. %d bytes needed)",
(int) (pure_bytes_used + pure_bytes_used_before_overflow));
}
DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
- doc: /* Make a copy of OBJECT in pure storage.
+ doc: /* Make a copy of object OBJ in pure storage.
Recursively copies contents of vectors and cons cells.
Does not copy symbols. Copies strings without text properties. */)
(obj)
if (gc_cons_threshold < 10000)
gc_cons_threshold = 10000;
+ 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);
+ }
+ else
+ gc_relative_threshold = 0;
+
if (garbage_collection_messages)
{
if (message_p || minibuf_level > 0)
if (size & PSEUDOVECTOR_FLAG)
size &= PSEUDOVECTOR_SIZE_MASK;
+ /* Note that this size is not the memory-footprint size, but only
+ the number of Lisp_Object fields that we should trace.
+ 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]);
}
CHECK_ALLOCATED_AND_LIVE (live_cons_p);
CONS_MARK (ptr);
/* If the cdr is nil, avoid recursion for the car. */
- if (EQ (ptr->cdr, Qnil))
+ if (EQ (ptr->u.cdr, Qnil))
{
obj = ptr->car;
cdr_count = 0;
goto loop;
}
mark_object (ptr->car);
- obj = ptr->cdr;
+ obj = ptr->u.cdr;
cdr_count++;
if (cdr_count == mark_object_loop_halt)
abort ();
if (!CONS_MARKED_P (&cblk->conses[i]))
{
this_free++;
- *(struct Lisp_Cons **)&cblk->conses[i].cdr = cons_free_list;
+ cblk->conses[i].u.chain = cons_free_list;
cons_free_list = &cblk->conses[i];
#if GC_MARK_STACK
cons_free_list->car = Vdead;
{
*cprev = cblk->next;
/* Unhook from the free list. */
- cons_free_list = *(struct Lisp_Cons **) &cblk->conses[0].cdr;
+ cons_free_list = cblk->conses[0].u.chain;
lisp_align_free (cblk);
n_cons_blocks--;
}
if (!FLOAT_MARKED_P (&fblk->floats[i]))
{
this_free++;
- *(struct Lisp_Float **)&fblk->floats[i].data = float_free_list;
+ fblk->floats[i].u.chain = float_free_list;
float_free_list = &fblk->floats[i];
}
else
{
*fprev = fblk->next;
/* Unhook from the free list. */
- float_free_list = *(struct Lisp_Float **) &fblk->floats[0].data;
+ float_free_list = fblk->floats[0].u.chain;
lisp_align_free (fblk);
n_float_blocks--;
}
if (!sym->gcmarkbit && !pure_p)
{
- *(struct Lisp_Symbol **) &sym->value = symbol_free_list;
+ sym->next = symbol_free_list;
symbol_free_list = sym;
#if GC_MARK_STACK
symbol_free_list->function = Vdead;
{
*sprev = sblk->next;
/* Unhook from the free list. */
- symbol_free_list = *(struct Lisp_Symbol **)&sblk->symbols[0].value;
+ symbol_free_list = sblk->symbols[0].next;
lisp_free (sblk);
n_symbol_blocks--;
}
malloc_hysteresis = 0;
#endif
- spare_memory = (char *) malloc (SPARE_MEMORY);
+ refill_memory_reserve ();
ignore_warnings = 0;
gcprolist = 0;
staticidx = 0;
consing_since_gc = 0;
gc_cons_threshold = 100000 * sizeof (Lisp_Object);
+ gc_relative_threshold = 0;
+
#ifdef VIRT_ADDR_VARIES
malloc_sbrk_unused = 1<<22; /* A large number */
malloc_sbrk_used = 100000; /* as reasonable as any number */
Garbage collection happens automatically only when `eval' is called.
By binding this temporarily to a large number, you can effectively
-prevent garbage collection during a part of the program. */);
+prevent garbage collection during a part of the program.
+See also `gc-cons-percentage'. */);
+
+ DEFVAR_LISP ("gc-cons-percentage", &Vgc_cons_percentage,
+ doc: /* *Portion of the heap used for allocation.
+Garbage collection can happen automatically once this portion of the heap
+has been allocated since the last garbage collection.
+If this portion is smaller than `gc-cons-threshold', this is ignored. */);
+ Vgc_cons_percentage = make_float (0.1);
DEFVAR_INT ("pure-bytes-used", &pure_bytes_used,
doc: /* Number of bytes of sharable Lisp data allocated so far. */);
build_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"));
DEFVAR_LISP ("memory-full", &Vmemory_full,
- doc: /* Non-nil means we are handling a memory-full error. */);
+ doc: /* Non-nil means Emacs cannot get much more Lisp memory. */);
Vmemory_full = Qnil;
staticpro (&Qgc_cons_threshold);