/* 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, 2006, 2007, 2008, 2009, 2010
+ Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2011
Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <limits.h> /* For CHAR_BIT. */
#include <setjmp.h>
-#ifdef STDC_HEADERS
-#include <stddef.h> /* For offsetof, used by PSEUDOVECSIZE. */
-#endif
-
#ifdef ALLOC_DEBUG
#undef INLINE
#endif
#undef GC_MALLOC_CHECK
#endif
-#ifdef HAVE_UNISTD_H
#include <unistd.h>
-#else
+#ifndef HAVE_UNISTD_H
extern POINTER_TYPE *sbrk ();
#endif
-#ifdef HAVE_FCNTL_H
#include <fcntl.h>
-#endif
-#ifndef O_WRONLY
-#define O_WRONLY 1
-#endif
#ifdef WINDOWSNT
-#include <fcntl.h>
#include "w32.h"
#endif
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. */
#define GC_STRING_BYTES(S) (STRING_BYTES (S))
#define GC_STRING_CHARS(S) ((S)->size & ~ARRAY_MARK_FLAG)
+/* Global variables. */
+struct emacs_globals globals;
+
/* Number of bytes of consing done since the last gc. */
int consing_since_gc;
-/* Count the amount of consing of various sorts of space. */
-
-EMACS_INT cons_cells_consed;
-EMACS_INT floats_consed;
-EMACS_INT vector_cells_consed;
-EMACS_INT symbols_consed;
-EMACS_INT string_chars_consed;
-EMACS_INT misc_objects_consed;
-EMACS_INT intervals_consed;
-EMACS_INT strings_consed;
-
-/* 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. */
int abort_on_gc;
-/* Nonzero means display messages at beginning and end of GC. */
-
-int garbage_collection_messages;
-
-#ifndef VIRT_ADDR_VARIES
-extern
-#endif /* VIRT_ADDR_VARIES */
-int malloc_sbrk_used;
-
-#ifndef VIRT_ADDR_VARIES
-extern
-#endif /* VIRT_ADDR_VARIES */
-int malloc_sbrk_unused;
-
/* Number of live and free conses etc. */
static int total_conses, total_markers, total_symbols, total_vector_size;
static int malloc_hysteresis;
-/* Non-nil means defun should do purecopy on the function definition. */
-
-Lisp_Object Vpurify_flag;
-
-/* Non-nil means we are handling a memory-full error. */
-
-Lisp_Object Vmemory_full;
-
/* Initialize it to a nonzero value to force it into data space
(rather than bss space). That way unexec will remap it into text
space (pure), on some systems. We have not implemented the
&& ((PNTR_COMPARISON_TYPE) (P) \
>= (PNTR_COMPARISON_TYPE) purebeg))
-/* Total number of bytes allocated in pure storage. */
-
-EMACS_INT pure_bytes_used;
-
/* Index in pure at which next pure Lisp object will be allocated.. */
static EMACS_INT pure_bytes_used_lisp;
const char *pending_malloc_warning;
-/* Pre-computed signal argument for use when memory is exhausted. */
-
-Lisp_Object Vmemory_signal_data;
-
/* Maximum amount of C stack to save when a GC happens. */
#ifndef MAX_SAVE_STACK
/* Hook run after GC has finished. */
-Lisp_Object Vpost_gc_hook, Qpost_gc_hook;
-
-Lisp_Object Vgc_elapsed; /* accumulated elapsed time in GC */
-EMACS_INT gcs_done; /* accumulated GCs */
+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 */
-
static struct Lisp_String *allocate_string (void);
static void compact_small_strings (void);
static void free_large_strings (void);
static POINTER_TYPE *lisp_align_malloc (size_t, enum mem_type);
static POINTER_TYPE *lisp_malloc (size_t, enum mem_type);
-void refill_memory_reserve (void);
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
static struct mem_node mem_z;
#define MEM_NIL &mem_z
-static POINTER_TYPE *lisp_malloc (size_t, enum mem_type);
static struct Lisp_Vector *allocate_vectorlike (EMACS_INT);
static void lisp_free (POINTER_TYPE *);
static void mark_stack (void);
static void * (*old_realloc_hook) (void *, size_t, const void*);
static void (*old_free_hook) (void*, const void*);
+static __malloc_size_t bytes_used_when_reconsidered;
+
/* This function is used as the hook for free to call. */
static void
-emacs_blocked_free (ptr, ptr2)
- void *ptr;
- const void *ptr2;
+emacs_blocked_free (void *ptr, const void *ptr2)
{
BLOCK_INPUT_ALLOC;
/* This function is the malloc hook that Emacs uses. */
static void *
-emacs_blocked_malloc (size, ptr)
- size_t size;
- const void *ptr;
+emacs_blocked_malloc (size_t size, const void *ptr)
{
void *value;
/* This function is the realloc hook that Emacs uses. */
static void *
-emacs_blocked_realloc (ptr, size, ptr2)
- void *ptr;
- size_t size;
- const void *ptr2;
+emacs_blocked_realloc (void *ptr, size_t size, const void *ptr2)
{
void *value;
/* Called from main to set up malloc to use our hooks. */
void
-uninterrupt_malloc ()
+uninterrupt_malloc (void)
{
#ifdef HAVE_GTK_AND_PTHREAD
#ifdef DOUG_LEA_MALLOC
can't create number objects in macros. */
#ifndef make_number
Lisp_Object
-make_number (n)
- EMACS_INT n;
+make_number (EMACS_INT n)
{
Lisp_Object obj;
obj.s.val = n;
/* Number of bytes used by live strings. */
-static int total_string_size;
+static EMACS_INT total_string_size;
/* Given a pointer to a Lisp_String S which is on the free-list
string_free_list, return a pointer to its successor in the
/* Like GC_STRING_BYTES, but with debugging check. */
-int
-string_bytes (s)
- struct Lisp_String *s;
+EMACS_INT
+string_bytes (struct Lisp_String *s)
{
- int nbytes = (s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte);
+ EMACS_INT nbytes =
+ (s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte);
+
if (!PURE_POINTER_P (s)
&& s->data
&& nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
{
/* Compute the next FROM here because copying below may
overwrite data we need to compute it. */
- int nbytes;
+ EMACS_INT nbytes;
/* Check that the string size recorded in the string is the
same as the one recorded in the sdata structure. */
s = string_free_list;
while (s != NULL)
{
- if ((unsigned)s < 1024)
+ if ((unsigned long)s < 1024)
abort();
s = NEXT_FREE_LISP_STRING (s);
}
S->data if it was initially non-null. */
void
-allocate_string_data (struct Lisp_String *s, int nchars, int nbytes)
+allocate_string_data (struct Lisp_String *s,
+ EMACS_INT nchars, EMACS_INT nbytes)
{
struct sdata *data, *old_data;
struct sblock *b;
- int needed, old_nbytes;
+ EMACS_INT needed, old_nbytes;
/* Determine the number of bytes needed to store NBYTES bytes
of string data. */
{
/* Compute the next FROM here because copying below may
overwrite data we need to compute it. */
- int nbytes;
+ EMACS_INT nbytes;
#ifdef GC_CHECK_STRING_BYTES
/* Check that the string size recorded in the string is the
{
register Lisp_Object val;
register unsigned char *p, *end;
- int c, nbytes;
+ int c;
+ EMACS_INT nbytes;
CHECK_NATNUM (length);
CHECK_NUMBER (init);
{
unsigned char str[MAX_MULTIBYTE_LENGTH];
int len = CHAR_STRING (c, str);
+ EMACS_INT string_len = XINT (length);
- nbytes = len * XINT (length);
- val = make_uninit_multibyte_string (XINT (length), nbytes);
+ if (string_len > MOST_POSITIVE_FIXNUM / len)
+ error ("Maximum string size exceeded");
+ nbytes = len * string_len;
+ val = make_uninit_multibyte_string (string_len, nbytes);
p = SDATA (val);
end = p + nbytes;
while (p != end)
register Lisp_Object val;
struct Lisp_Bool_Vector *p;
int real_init, i;
- int length_in_chars, length_in_elts, bits_per_value;
+ EMACS_INT length_in_chars, length_in_elts;
+ int bits_per_value;
CHECK_NATNUM (length);
multibyte, depending on the contents. */
Lisp_Object
-make_string (const char *contents, int nbytes)
+make_string (const char *contents, EMACS_INT nbytes)
{
register Lisp_Object val;
- int nchars, multibyte_nbytes;
+ EMACS_INT nchars, multibyte_nbytes;
- parse_str_as_multibyte (contents, nbytes, &nchars, &multibyte_nbytes);
+ parse_str_as_multibyte ((const unsigned char *) contents, nbytes,
+ &nchars, &multibyte_nbytes);
if (nbytes == nchars || nbytes != multibyte_nbytes)
/* CONTENTS contains no multibyte sequences or contains an invalid
multibyte sequence. We must make unibyte string. */
/* Make an unibyte string from LENGTH bytes at CONTENTS. */
Lisp_Object
-make_unibyte_string (const char *contents, int length)
+make_unibyte_string (const char *contents, EMACS_INT length)
{
register Lisp_Object val;
val = make_uninit_string (length);
memcpy (SDATA (val), contents, length);
- STRING_SET_UNIBYTE (val);
return val;
}
bytes at CONTENTS. */
Lisp_Object
-make_multibyte_string (const char *contents, int nchars, int nbytes)
+make_multibyte_string (const char *contents,
+ EMACS_INT nchars, EMACS_INT nbytes)
{
register Lisp_Object val;
val = make_uninit_multibyte_string (nchars, nbytes);
CONTENTS. It is a multibyte string if NBYTES != NCHARS. */
Lisp_Object
-make_string_from_bytes (const char *contents, int nchars, int nbytes)
+make_string_from_bytes (const char *contents,
+ EMACS_INT nchars, EMACS_INT nbytes)
{
register Lisp_Object val;
val = make_uninit_multibyte_string (nchars, nbytes);
characters by itself. */
Lisp_Object
-make_specified_string (const char *contents, int nchars, int nbytes, int multibyte)
+make_specified_string (const char *contents,
+ EMACS_INT nchars, EMACS_INT nbytes, int multibyte)
{
register Lisp_Object val;
if (nchars < 0)
{
if (multibyte)
- nchars = multibyte_chars_in_text (contents, nbytes);
+ nchars = multibyte_chars_in_text ((const unsigned char *) contents,
+ nbytes);
else
nchars = nbytes;
}
occupying LENGTH bytes. */
Lisp_Object
-make_uninit_string (int length)
+make_uninit_string (EMACS_INT length)
{
Lisp_Object val;
which occupy NBYTES bytes. */
Lisp_Object
-make_uninit_multibyte_string (int nchars, int nbytes)
+make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes)
{
Lisp_Object string;
struct Lisp_String *s;
}
-/* Explicitly free a float cell by putting it on the free-list. */
-
-static void
-free_float (struct Lisp_Float *ptr)
-{
- ptr->u.chain = float_free_list;
- float_free_list = ptr;
-}
-
-
/* Return a new float object with value FLOAT_VALUE. */
Lisp_Object
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. */
(register Lisp_Object length, Lisp_Object init)
{
register Lisp_Object val;
- register int size;
+ register EMACS_INT size;
CHECK_NATNUM (length);
size = XFASTINT (length);
{
Lisp_Object vector;
register EMACS_INT sizei;
- register 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;
(register int nargs, Lisp_Object *args)
{
register Lisp_Object len, val;
- register int index;
+ register int 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;
}
(register int nargs, Lisp_Object *args)
{
register Lisp_Object len, val;
- register int index;
+ register int 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);
if (m->type == MEM_TYPE_STRING)
{
struct string_block *b = (struct string_block *) m->start;
- int offset = (char *) p - (char *) &b->strings[0];
+ ptrdiff_t offset = (char *) p - (char *) &b->strings[0];
/* P must point to the start of a Lisp_String structure, and it
must not be on the free-list. */
if (m->type == MEM_TYPE_CONS)
{
struct cons_block *b = (struct cons_block *) m->start;
- int offset = (char *) p - (char *) &b->conses[0];
+ ptrdiff_t offset = (char *) p - (char *) &b->conses[0];
/* P must point to the start of a Lisp_Cons, not be
one of the unused cells in the current cons block,
if (m->type == MEM_TYPE_SYMBOL)
{
struct symbol_block *b = (struct symbol_block *) m->start;
- int offset = (char *) p - (char *) &b->symbols[0];
+ ptrdiff_t offset = (char *) p - (char *) &b->symbols[0];
/* P must point to the start of a Lisp_Symbol, not be
one of the unused cells in the current symbol block,
if (m->type == MEM_TYPE_FLOAT)
{
struct float_block *b = (struct float_block *) m->start;
- int offset = (char *) p - (char *) &b->floats[0];
+ ptrdiff_t offset = (char *) p - (char *) &b->floats[0];
/* P must point to the start of a Lisp_Float and not be
one of the unused cells in the current float block. */
if (m->type == MEM_TYPE_MISC)
{
struct marker_block *b = (struct marker_block *) m->start;
- int offset = (char *) p - (char *) &b->markers[0];
+ ptrdiff_t offset = (char *) p - (char *) &b->markers[0];
/* P must point to the start of a Lisp_Misc, not be
one of the unused cells in the current misc block,
must not have been killed. */
return (m->type == MEM_TYPE_BUFFER
&& p == m->start
- && !NILP (((struct buffer *) p)->name));
+ && !NILP (((struct buffer *) p)->BUFFER_INTERNAL_FIELD (name)));
}
#endif /* GC_MARK_STACK || defined GC_MALLOC_CHECK */
static INLINE void
mark_maybe_object (Lisp_Object obj)
{
- void *po = (void *) XPNTR (obj);
- struct mem_node *m = mem_find (po);
+ void *po;
+ struct mem_node *m;
+
+ if (INTEGERP (obj))
+ return;
+
+ po = (void *) XPNTR (obj);
+ m = mem_find (po);
if (m != MEM_NIL)
{
can prove that. */
static void
-test_setjmp ()
+test_setjmp (void)
{
char buf[10];
register int x;
/* Abort if anything GCPRO'd doesn't survive the GC. */
static void
-check_gcpros ()
+check_gcpros (void)
{
struct gcpro *p;
int i;
#elif GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
static void
-dump_zombies ()
+dump_zombies (void)
{
int i;
have to be true! It must be verified for each system, possibly
by taking a look at the source code of setjmp.
+ If __builtin_unwind_init is available (defined by GCC >= 2.8) we
+ can use it as a machine independent method to store all registers
+ to the stack. In this case the macros described in the previous
+ two paragraphs are not used.
+
Stack Layout
Architectures differ in the way their processor stack is organized.
mark_stack (void)
{
int i;
+ void *end;
+
+#ifdef HAVE___BUILTIN_UNWIND_INIT
+ /* Force callee-saved registers and register windows onto the stack.
+ This is the preferred method if available, obviating the need for
+ machine dependent methods. */
+ __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;
- void *end;
-
+#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
setjmp (j.j);
end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j;
#endif /* not GC_SAVE_REGISTERS_ON_STACK */
+#endif /* not HAVE___BUILTIN_UNWIND_INIT */
/* This assumes that the stack is a contiguous region in memory. If
that's not the case, something has to be done here to iterate
address. Return NULL if not found. */
static char *
-find_string_data_in_pure (const char *data, int nbytes)
+find_string_data_in_pure (const char *data, EMACS_INT nbytes)
{
- int i, skip, bm_skip[256], last_char_skip, infinity, start, start_max;
+ int i;
+ EMACS_INT skip, bm_skip[256], last_char_skip, infinity, start, start_max;
const unsigned char *p;
char *non_lisp_beg;
string; then the string is not protected from gc. */
Lisp_Object
-make_pure_string (const char *data, int nchars, int nbytes, int multibyte)
+make_pure_string (const char *data,
+ EMACS_INT nchars, EMACS_INT nbytes, int multibyte)
{
Lisp_Object string;
struct Lisp_String *s;
s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
- s->data = find_string_data_in_pure (data, nbytes);
+ s->data = (unsigned char *) find_string_data_in_pure (data, nbytes);
if (s->data == NULL)
{
s->data = (unsigned char *) pure_alloc (nbytes + 1, -1);
{
Lisp_Object string;
struct Lisp_String *s;
- int nchars = strlen (data);
+ EMACS_INT nchars = strlen (data);
s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
s->size = nchars;
else if (FLOATP (obj))
obj = make_pure_float (XFLOAT_DATA (obj));
else if (STRINGP (obj))
- obj = make_pure_string (SDATA (obj), SCHARS (obj),
+ obj = make_pure_string (SSDATA (obj), SCHARS (obj),
SBYTES (obj),
STRING_MULTIBYTE (obj));
else if (COMPILEDP (obj) || VECTORP (obj))
{
register struct Lisp_Vector *vec;
- register int i;
+ register EMACS_INT i;
EMACS_INT size;
size = XVECTOR (obj)->size;
(void)
{
register struct specbinding *bind;
- struct catchtag *catch;
- struct handler *handler;
char stack_top_variable;
register int i;
int message_p;
turned off in that buffer. Calling truncate_undo_list on
Qt tends to return NULL, which effectively turns undo back on.
So don't call truncate_undo_list if undo_list is Qt. */
- if (! NILP (nextb->name) && ! EQ (nextb->undo_list, Qt))
+ if (! NILP (nextb->BUFFER_INTERNAL_FIELD (name)) && ! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt))
truncate_undo_list (nextb);
/* Shrink buffer gaps, but skip indirect and dead buffers. */
- if (nextb->base_buffer == 0 && !NILP (nextb->name)
+ if (nextb->base_buffer == 0 && !NILP (nextb->BUFFER_INTERNAL_FIELD (name))
&& ! nextb->text->inhibit_shrinking)
{
/* If a buffer's gap size is more than 10% of the buffer
for (i = 0; i < tail->nvars; i++)
mark_object (tail->var[i]);
}
-#endif
-
mark_byte_stack ();
+ {
+ struct catchtag *catch;
+ struct handler *handler;
+
for (catch = catchlist; catch; catch = catch->next)
{
mark_object (catch->tag);
mark_object (handler->handler);
mark_object (handler->var);
}
+ }
mark_backtrace ();
+#endif
#ifdef HAVE_WINDOW_SYSTEM
mark_fringe_data ();
turned off in that buffer. Calling truncate_undo_list on
Qt tends to return NULL, which effectively turns undo back on.
So don't call truncate_undo_list if undo_list is Qt. */
- if (! EQ (nextb->undo_list, Qt))
+ if (! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt))
{
Lisp_Object tail, prev;
- tail = nextb->undo_list;
+ tail = nextb->BUFFER_INTERNAL_FIELD (undo_list);
prev = Qnil;
while (CONSP (tail))
{
&& !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
{
if (NILP (prev))
- nextb->undo_list = tail = XCDR (tail);
+ nextb->BUFFER_INTERNAL_FIELD (undo_list) = tail = XCDR (tail);
else
{
tail = XCDR (tail);
}
/* Now that we have stripped the elements that need not be in the
undo_list any more, we can finally mark the list. */
- mark_object (nextb->undo_list);
+ mark_object (nextb->BUFFER_INTERNAL_FIELD (undo_list));
nextb = nextb->next;
}
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. */
static void
mark_vectorlike (struct Lisp_Vector *ptr)
{
- register EMACS_INT size = ptr->size;
- register int i;
+ register EMACS_UINT size = ptr->size;
+ register EMACS_UINT i;
eassert (!VECTOR_MARKED_P (ptr));
VECTOR_MARK (ptr); /* Else mark it */
static void
mark_char_table (struct Lisp_Vector *ptr)
{
- register EMACS_INT size = ptr->size & PSEUDOVECTOR_SIZE_MASK;
- register int i;
+ register EMACS_UINT size = ptr->size & PSEUDOVECTOR_SIZE_MASK;
+ register EMACS_UINT i;
eassert (!VECTOR_MARKED_P (ptr));
VECTOR_MARK (ptr);
{
Lisp_Object val = ptr->contents[i];
- if (INTEGERP (val) || SYMBOLP (val) && XSYMBOL (val)->gcmarkbit)
+ if (INTEGERP (val) || (SYMBOLP (val) && XSYMBOL (val)->gcmarkbit))
continue;
if (SUB_CHAR_TABLE_P (val))
{
recursion there. */
{
register struct Lisp_Vector *ptr = XVECTOR (obj);
- register EMACS_INT size = ptr->size;
- register int i;
+ register EMACS_UINT size = ptr->size;
+ register EMACS_UINT i;
CHECK_LIVE (live_vector_p);
VECTOR_MARK (ptr); /* Else mark it */
/* buffer-local Lisp variables start at `undo_list',
tho only the ones from `name' on are GC'd normally. */
- for (ptr = &buffer->name;
+ for (ptr = &buffer->BUFFER_INTERNAL_FIELD (name);
(char *)ptr < (char *)buffer + sizeof (struct buffer);
ptr++)
mark_object (*ptr);
for (t = terminal_list; t; t = t->next_terminal)
{
eassert (t->name != NULL);
- if (!VECTOR_MARKED_P (t))
- {
#ifdef HAVE_WINDOW_SYSTEM
- mark_image_cache (t->image_cache);
+ /* If a terminal object is reachable from a stacpro'ed object,
+ it might have been marked already. Make sure the image cache
+ gets marked. */
+ mark_image_cache (t->image_cache);
#endif /* HAVE_WINDOW_SYSTEM */
- mark_vectorlike ((struct Lisp_Vector *)t);
- }
+ if (!VECTOR_MARKED_P (t))
+ mark_vectorlike ((struct Lisp_Vector *)t);
}
}
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 */
-#endif /* VIRT_ADDR_VARIES */
}
void
void
syms_of_alloc (void)
{
- DEFVAR_INT ("gc-cons-threshold", &gc_cons_threshold,
+ DEFVAR_INT ("gc-cons-threshold", gc_cons_threshold,
doc: /* *Number of bytes of consing between garbage collections.
Garbage collection can happen automatically once this many bytes have been
allocated since the last garbage collection. All data types count.
prevent garbage collection during a part of the program.
See also `gc-cons-percentage'. */);
- DEFVAR_LISP ("gc-cons-percentage", &Vgc_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,
+ DEFVAR_INT ("pure-bytes-used", pure_bytes_used,
doc: /* Number of bytes of sharable Lisp data allocated so far. */);
- DEFVAR_INT ("cons-cells-consed", &cons_cells_consed,
+ DEFVAR_INT ("cons-cells-consed", cons_cells_consed,
doc: /* Number of cons cells that have been consed so far. */);
- DEFVAR_INT ("floats-consed", &floats_consed,
+ DEFVAR_INT ("floats-consed", floats_consed,
doc: /* Number of floats that have been consed so far. */);
- DEFVAR_INT ("vector-cells-consed", &vector_cells_consed,
+ DEFVAR_INT ("vector-cells-consed", vector_cells_consed,
doc: /* Number of vector cells that have been consed so far. */);
- DEFVAR_INT ("symbols-consed", &symbols_consed,
+ DEFVAR_INT ("symbols-consed", symbols_consed,
doc: /* Number of symbols that have been consed so far. */);
- DEFVAR_INT ("string-chars-consed", &string_chars_consed,
+ DEFVAR_INT ("string-chars-consed", string_chars_consed,
doc: /* Number of string characters that have been consed so far. */);
- DEFVAR_INT ("misc-objects-consed", &misc_objects_consed,
+ DEFVAR_INT ("misc-objects-consed", misc_objects_consed,
doc: /* Number of miscellaneous objects that have been consed so far. */);
- DEFVAR_INT ("intervals-consed", &intervals_consed,
+ DEFVAR_INT ("intervals-consed", intervals_consed,
doc: /* Number of intervals that have been consed so far. */);
- DEFVAR_INT ("strings-consed", &strings_consed,
+ DEFVAR_INT ("strings-consed", strings_consed,
doc: /* Number of strings that have been consed so far. */);
- DEFVAR_LISP ("purify-flag", &Vpurify_flag,
+ DEFVAR_LISP ("purify-flag", Vpurify_flag,
doc: /* Non-nil means loading Lisp code in order to dump an executable.
This means that certain objects should be allocated in shared (pure) space.
It can also be set to a hash-table, in which case this table is used to
do hash-consing of the objects allocated to pure space. */);
- DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages,
+ DEFVAR_BOOL ("garbage-collection-messages", garbage_collection_messages,
doc: /* Non-nil means display messages at start and end of garbage collection. */);
garbage_collection_messages = 0;
- DEFVAR_LISP ("post-gc-hook", &Vpost_gc_hook,
+ DEFVAR_LISP ("post-gc-hook", Vpost_gc_hook,
doc: /* Hook run after garbage collection has finished. */);
Vpost_gc_hook = Qnil;
Qpost_gc_hook = intern_c_string ("post-gc-hook");
staticpro (&Qpost_gc_hook);
- DEFVAR_LISP ("memory-signal-data", &Vmemory_signal_data,
+ DEFVAR_LISP ("memory-signal-data", Vmemory_signal_data,
doc: /* Precomputed `signal' argument for memory-full error. */);
/* We build this in advance because if we wait until we need it, we might
not be able to allocate the memory to hold it. */
= pure_cons (Qerror,
pure_cons (make_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"), Qnil));
- DEFVAR_LISP ("memory-full", &Vmemory_full,
+ DEFVAR_LISP ("memory-full", Vmemory_full,
doc: /* Non-nil means Emacs cannot get much more Lisp memory. */);
Vmemory_full = Qnil;
staticpro (&Qchar_table_extra_slots);
Qchar_table_extra_slots = intern_c_string ("char-table-extra-slots");
- DEFVAR_LISP ("gc-elapsed", &Vgc_elapsed,
+ DEFVAR_LISP ("gc-elapsed", Vgc_elapsed,
doc: /* Accumulated time elapsed in garbage collections.
The time is in seconds as a floating point value. */);
- DEFVAR_INT ("gcs-done", &gcs_done,
+ DEFVAR_INT ("gcs-done", gcs_done,
doc: /* Accumulated number of garbage collections done. */);
defsubr (&Scons);
defsubr (&Sgc_status);
#endif
}
-
-/* arch-tag: 6695ca10-e3c5-4c2c-8bc3-ed26a7dda857
- (do not change this comment) */
HCoop / bpt / emacs.git / blobdiff