#include <limits.h> /* For CHAR_BIT. */
#include <setjmp.h>
-#ifdef ALLOC_DEBUG
-#undef INLINE
-#endif
-
#include <signal.h>
#ifdef HAVE_GTK_AND_PTHREAD
#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 of S, a pointer to a struct Lisp_String.
Be careful during GC, because S->size contains the mark bit for
/* Number of bytes of consing done since the last gc. */
-int consing_since_gc;
+EMACS_INT consing_since_gc;
/* Similar minimum, computed from Vgc_cons_percentage. */
/* Number of live and free conses etc. */
-static int total_conses, total_markers, total_symbols, total_vector_size;
-static int total_free_conses, total_free_markers, total_free_symbols;
-static int total_free_floats, total_floats;
+static EMACS_INT total_conses, total_markers, total_symbols, total_vector_size;
+static EMACS_INT total_free_conses, total_free_markers, total_free_symbols;
+static EMACS_INT total_free_floats, total_floats;
/* Points to memory space allocated as "spare", to be freed if we run
out of memory. We keep one large block, four cons-blocks, and
static char *spare_memory[7];
-#ifndef SYSTEM_MALLOC
-/* Amount of spare memory to keep in large reserve block. */
+/* Amount of spare memory to keep in large reserve block, or to see
+ whether this much is available when malloc fails on a larger request. */
#define SPARE_MEMORY (1 << 14)
-#endif
/* Number of extra blocks malloc should get when it needs more core. */
static void mem_rotate_right (struct mem_node *);
static void mem_delete (struct mem_node *);
static void mem_delete_fixup (struct mem_node *);
-static INLINE struct mem_node *mem_find (void *);
+static inline struct mem_node *mem_find (void *);
#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
ALIGNMENT must be a power of 2. */
#define ALIGN(ptr, ALIGNMENT) \
- ((POINTER_TYPE *) ((((EMACS_UINT)(ptr)) + (ALIGNMENT) - 1) \
+ ((POINTER_TYPE *) ((((uintptr_t) (ptr)) + (ALIGNMENT) - 1) \
& ~((ALIGNMENT) - 1)))
/* Called if we can't allocate relocatable space for a buffer. */
void
-buffer_memory_full (void)
+buffer_memory_full (EMACS_INT nbytes)
{
/* If buffers use the relocating allocator, no need to free
spare_memory, because we may have plenty of malloc space left
malloc. */
#ifndef REL_ALLOC
- memory_full ();
+ memory_full (nbytes);
#endif
/* This used to call error, but if we've run out of memory, we could
}
-#ifdef XMALLOC_OVERRUN_CHECK
+#ifndef XMALLOC_OVERRUN_CHECK
+#define XMALLOC_OVERRUN_CHECK_SIZE 0
+#else
/* Check for overrun in malloc'ed buffers by wrapping a 16 byte header
and a 16 byte trailer around each block.
/* Like malloc, but wraps allocated block with header and trailer. */
-POINTER_TYPE *
+static POINTER_TYPE *
overrun_check_malloc (size_t size)
{
register unsigned char *val;
/* Like realloc, but checks old block for overrun, and wraps new block
with header and trailer. */
-POINTER_TYPE *
+static POINTER_TYPE *
overrun_check_realloc (POINTER_TYPE *block, size_t size)
{
register unsigned char *val = (unsigned char *) block;
/* Like free, but checks block for overrun. */
-void
+static void
overrun_check_free (POINTER_TYPE *block)
{
unsigned char *val = (unsigned char *) block;
MALLOC_UNBLOCK_INPUT;
if (!val && size)
- memory_full ();
+ memory_full (size);
return val;
}
val = (POINTER_TYPE *) realloc (block, size);
MALLOC_UNBLOCK_INPUT;
- if (!val && size) memory_full ();
+ if (!val && size)
+ memory_full (size);
return val;
}
MALLOC_UNBLOCK_INPUT;
if (!val && nbytes)
- memory_full ();
+ memory_full (nbytes);
return val;
}
#define ABLOCKS_BYTES (sizeof (struct ablocks) - BLOCK_PADDING)
#define ABLOCK_ABASE(block) \
- (((unsigned long) (block)->abase) <= (1 + 2 * ABLOCKS_SIZE) \
+ (((uintptr_t) (block)->abase) <= (1 + 2 * ABLOCKS_SIZE) \
? (struct ablocks *)(block) \
: (block)->abase)
#define ABLOCKS_BASE(abase) (abase)
#else
#define ABLOCKS_BASE(abase) \
- (1 & (long) ABLOCKS_BUSY (abase) ? abase : ((void**)abase)[-1])
+ (1 & (intptr_t) ABLOCKS_BUSY (abase) ? abase : ((void**)abase)[-1])
#endif
/* The list of free ablock. */
if (!free_ablock)
{
int i;
- EMACS_INT aligned; /* int gets warning casting to 64-bit pointer. */
+ intptr_t aligned; /* int gets warning casting to 64-bit pointer. */
#ifdef DOUG_LEA_MALLOC
/* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed
if (base == 0)
{
MALLOC_UNBLOCK_INPUT;
- memory_full ();
+ memory_full (ABLOCKS_BYTES);
}
aligned = (base == abase);
lisp_malloc_loser = base;
free (base);
MALLOC_UNBLOCK_INPUT;
- memory_full ();
+ memory_full (SIZE_MAX);
}
}
#endif
abase->blocks[i].x.next_free = free_ablock;
free_ablock = &abase->blocks[i];
}
- ABLOCKS_BUSY (abase) = (struct ablocks *) (long) aligned;
+ ABLOCKS_BUSY (abase) = (struct ablocks *) aligned;
- eassert (0 == ((EMACS_UINT)abase) % BLOCK_ALIGN);
+ eassert (0 == ((uintptr_t) abase) % BLOCK_ALIGN);
eassert (ABLOCK_ABASE (&abase->blocks[3]) == abase); /* 3 is arbitrary */
eassert (ABLOCK_ABASE (&abase->blocks[0]) == abase);
eassert (ABLOCKS_BASE (abase) == base);
- eassert (aligned == (long) ABLOCKS_BUSY (abase));
+ eassert (aligned == (intptr_t) ABLOCKS_BUSY (abase));
}
abase = ABLOCK_ABASE (free_ablock);
- ABLOCKS_BUSY (abase) = (struct ablocks *) (2 + (long) ABLOCKS_BUSY (abase));
+ ABLOCKS_BUSY (abase) =
+ (struct ablocks *) (2 + (intptr_t) ABLOCKS_BUSY (abase));
val = free_ablock;
free_ablock = free_ablock->x.next_free;
#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
- if (val && type != MEM_TYPE_NON_LISP)
+ if (type != MEM_TYPE_NON_LISP)
mem_insert (val, (char *) val + nbytes, type);
#endif
MALLOC_UNBLOCK_INPUT;
- if (!val && nbytes)
- memory_full ();
- eassert (0 == ((EMACS_UINT)val) % BLOCK_ALIGN);
+ eassert (0 == ((uintptr_t) val) % BLOCK_ALIGN);
return val;
}
ablock->x.next_free = free_ablock;
free_ablock = ablock;
/* Update busy count. */
- ABLOCKS_BUSY (abase) = (struct ablocks *) (-2 + (long) ABLOCKS_BUSY (abase));
+ ABLOCKS_BUSY (abase) =
+ (struct ablocks *) (-2 + (intptr_t) ABLOCKS_BUSY (abase));
- if (2 > (long) ABLOCKS_BUSY (abase))
+ if (2 > (intptr_t) ABLOCKS_BUSY (abase))
{ /* All the blocks are free. */
- int i = 0, aligned = (long) ABLOCKS_BUSY (abase);
+ int i = 0, aligned = (intptr_t) ABLOCKS_BUSY (abase);
struct ablock **tem = &free_ablock;
struct ablock *atop = &abase->blocks[aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1];
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);
+ eassert ((uintptr_t) ABLOCKS_BASE (abase) % BLOCK_ALIGN == 0);
#endif
free (ABLOCKS_BASE (abase));
}
struct buffer *b
= (struct buffer *) lisp_malloc (sizeof (struct buffer),
MEM_TYPE_BUFFER);
- b->size = ((sizeof (struct buffer) + sizeof (EMACS_INT) - 1)
- / sizeof (EMACS_INT));
- XSETPVECTYPE (b, PVEC_BUFFER);
+ XSETPVECTYPESIZE (b, PVEC_BUFFER,
+ ((sizeof (struct buffer) + sizeof (EMACS_INT) - 1)
+ / sizeof (EMACS_INT)));
return b;
}
/* Number of free and live intervals. */
-static int total_free_intervals, total_intervals;
+static EMACS_INT total_free_intervals, total_intervals;
/* List of free intervals. */
static INTERVAL interval_free_list;
-/* Total number of interval blocks now in use. */
-
-static int n_interval_blocks;
-
/* Initialize interval allocation. */
interval_block = NULL;
interval_block_index = INTERVAL_BLOCK_SIZE;
interval_free_list = 0;
- n_interval_blocks = 0;
}
newi->next = interval_block;
interval_block = newi;
interval_block_index = 0;
- n_interval_blocks++;
}
val = &interval_block->intervals[interval_block_index++];
}
static struct sblock *large_sblocks;
-/* List of string_block structures, and how many there are. */
+/* List of string_block structures. */
static struct string_block *string_blocks;
-static int n_string_blocks;
/* Free-list of Lisp_Strings. */
/* Number of live and free Lisp_Strings. */
-static int total_strings, total_free_strings;
+static EMACS_INT total_strings, total_free_strings;
/* Number of bytes used by live strings. */
#define GC_STRING_EXTRA (GC_STRING_OVERRUN_COOKIE_SIZE)
+/* Exact bound on the number of bytes in a string, not counting the
+ terminating null. A string cannot contain more bytes than
+ STRING_BYTES_BOUND, nor can it be so long that the size_t
+ arithmetic in allocate_string_data would overflow while it is
+ calculating a value to be passed to malloc. */
+#define STRING_BYTES_MAX \
+ min (STRING_BYTES_BOUND, \
+ ((SIZE_MAX - XMALLOC_OVERRUN_CHECK_SIZE - GC_STRING_EXTRA \
+ - offsetof (struct sblock, first_data) \
+ - SDATA_DATA_OFFSET) \
+ & ~(sizeof (EMACS_INT) - 1)))
+
/* Initialize string allocation. Called from init_alloc_once. */
static void
total_strings = total_free_strings = total_string_size = 0;
oldest_sblock = current_sblock = large_sblocks = NULL;
string_blocks = NULL;
- n_string_blocks = 0;
string_free_list = NULL;
empty_unibyte_string = make_pure_string ("", 0, 0, 0);
empty_multibyte_string = make_pure_string ("", 0, 0, 1);
s = string_free_list;
while (s != NULL)
{
- if ((unsigned long)s < 1024)
+ if ((uintptr_t) s < 1024)
abort();
s = NEXT_FREE_LISP_STRING (s);
}
memset (b, 0, sizeof *b);
b->next = string_blocks;
string_blocks = b;
- ++n_string_blocks;
for (i = STRING_BLOCK_SIZE - 1; i >= 0; --i)
{
struct sblock *b;
EMACS_INT needed, old_nbytes;
+ if (STRING_BYTES_MAX < nbytes)
+ string_overflow ();
+
/* Determine the number of bytes needed to store NBYTES bytes
of string data. */
needed = SDATA_SIZE (nbytes);
&& total_free_strings > STRING_BLOCK_SIZE)
{
lisp_free (b);
- --n_string_blocks;
string_free_list = free_list_before;
}
else
current_sblock = tb;
}
+void
+string_overflow (void)
+{
+ error ("Maximum string size exceeded");
+}
DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0,
doc: /* Return a newly created string of length LENGTH, with INIT in each element.
EMACS_INT nbytes;
CHECK_NATNUM (length);
- CHECK_NUMBER (init);
+ CHECK_CHARACTER (init);
- c = XINT (init);
+ c = XFASTINT (init);
if (ASCII_CHAR_P (c))
{
nbytes = XINT (length);
int len = CHAR_STRING (c, str);
EMACS_INT string_len = XINT (length);
- if (string_len > MOST_POSITIVE_FIXNUM / len)
- error ("Maximum string size exceeded");
+ if (string_len > STRING_BYTES_MAX / len)
+ string_overflow ();
nbytes = len * string_len;
val = make_uninit_multibyte_string (string_len, nbytes);
p = SDATA (val);
{
register Lisp_Object val;
struct Lisp_Bool_Vector *p;
- int real_init, i;
EMACS_INT length_in_chars, length_in_elts;
int bits_per_value;
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);
- real_init = (NILP (init) ? 0 : -1);
- for (i = 0; i < length_in_chars ; i++)
- p->data[i] = real_init;
+ if (length_in_chars)
+ {
+ memset (p->data, ! NILP (init) ? -1 : 0, length_in_chars);
- /* Clear the extraneous bits in the last byte. */
- if (XINT (length) != length_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
- p->data[length_in_chars - 1]
- &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
+ /* Clear any extraneous bits in the last byte. */
+ p->data[length_in_chars - 1]
+ &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
+ }
return val;
}
&= ~(1 << ((n) % (sizeof(int) * CHAR_BIT)))
#define FLOAT_BLOCK(fptr) \
- ((struct float_block *)(((EMACS_UINT)(fptr)) & ~(BLOCK_ALIGN - 1)))
+ ((struct float_block *) (((uintptr_t) (fptr)) & ~(BLOCK_ALIGN - 1)))
#define FLOAT_INDEX(fptr) \
- ((((EMACS_UINT)(fptr)) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Float))
+ ((((uintptr_t) (fptr)) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Float))
struct float_block
{
static int float_block_index;
-/* Total number of float blocks now in use. */
-
-static int n_float_blocks;
-
/* Free-list of Lisp_Floats. */
static struct Lisp_Float *float_free_list;
float_block = NULL;
float_block_index = FLOAT_BLOCK_SIZE; /* Force alloc of new float_block. */
float_free_list = 0;
- n_float_blocks = 0;
}
memset (new->gcmarkbits, 0, sizeof new->gcmarkbits);
float_block = new;
float_block_index = 0;
- n_float_blocks++;
}
XSETFLOAT (val, &float_block->floats[float_block_index]);
float_block_index++;
/ (sizeof (struct Lisp_Cons) * CHAR_BIT + 1))
#define CONS_BLOCK(fptr) \
- ((struct cons_block *)(((EMACS_UINT)(fptr)) & ~(BLOCK_ALIGN - 1)))
+ ((struct cons_block *) ((uintptr_t) (fptr) & ~(BLOCK_ALIGN - 1)))
#define CONS_INDEX(fptr) \
- ((((EMACS_UINT)(fptr)) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Cons))
+ (((uintptr_t) (fptr) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Cons))
struct cons_block
{
static struct Lisp_Cons *cons_free_list;
-/* Total number of cons blocks now in use. */
-
-static int n_cons_blocks;
-
/* Initialize cons allocation. */
cons_block = NULL;
cons_block_index = CONS_BLOCK_SIZE; /* Force alloc of new cons_block. */
cons_free_list = 0;
- n_cons_blocks = 0;
}
new->next = cons_block;
cons_block = new;
cons_block_index = 0;
- n_cons_blocks++;
}
XSETCONS (val, &cons_block->conses[cons_block_index]);
cons_block_index++;
doc: /* Return a newly created list with specified arguments as elements.
Any number of arguments, even zero arguments, are allowed.
usage: (list &rest OBJECTS) */)
- (size_t nargs, register Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
register Lisp_Object val;
val = Qnil;
static struct Lisp_Vector *all_vectors;
-/* Total number of vector-like objects now in use. */
-
-static int n_vectors;
-
+/* Handy constants for vectorlike objects. */
+enum
+ {
+ header_size = offsetof (struct Lisp_Vector, contents),
+ word_size = sizeof (Lisp_Object)
+ };
/* Value is a pointer to a newly allocated Lisp_Vector structure
with room for LEN Lisp_Objects. */
/* This gets triggered by code which I haven't bothered to fix. --Stef */
/* eassert (!handling_signal); */
- nbytes = (offsetof (struct Lisp_Vector, contents)
- + len * sizeof p->contents[0]);
+ nbytes = header_size + len * word_size;
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;
- ++n_vectors;
return p;
}
-/* Allocate a vector with NSLOTS slots. */
+/* Allocate a vector with LEN slots. */
struct Lisp_Vector *
-allocate_vector (EMACS_INT nslots)
+allocate_vector (EMACS_INT len)
{
- struct Lisp_Vector *v = allocate_vectorlike (nslots);
- v->size = nslots;
+ struct Lisp_Vector *v;
+ ptrdiff_t nbytes_max = min (PTRDIFF_MAX, SIZE_MAX);
+
+ if (min ((nbytes_max - header_size) / word_size, MOST_POSITIVE_FIXNUM) < len)
+ memory_full (SIZE_MAX);
+ v = allocate_vectorlike (len);
+ v->header.size = len;
return v;
}
allocate_pseudovector (int memlen, int lisplen, EMACS_INT tag)
{
struct Lisp_Vector *v = allocate_vectorlike (memlen);
- EMACS_INT i;
+ 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;
}
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 size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
register Lisp_Object len, val;
- register size_t i;
+ ptrdiff_t i;
register struct Lisp_Vector *p;
XSETFASTINT (len, nargs);
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 size_t nargs, Lisp_Object *args)
+ (ptrdiff_t nargs, Lisp_Object *args)
{
register Lisp_Object len, val;
- register size_t i;
+ ptrdiff_t i;
register struct Lisp_Vector *p;
XSETFASTINT (len, nargs);
if (!NILP (Vpurify_flag))
- val = make_pure_vector ((EMACS_INT) nargs);
+ val = make_pure_vector (nargs);
else
val = Fmake_vector (len, Qnil);
static struct Lisp_Symbol *symbol_free_list;
-/* Total number of symbol blocks now in use. */
-
-static int n_symbol_blocks;
-
/* Initialize symbol allocation. */
symbol_block = NULL;
symbol_block_index = SYMBOL_BLOCK_SIZE;
symbol_free_list = 0;
- n_symbol_blocks = 0;
}
new->next = symbol_block;
symbol_block = new;
symbol_block_index = 0;
- n_symbol_blocks++;
}
XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]);
symbol_block_index++;
static union Lisp_Misc *marker_free_list;
-/* Total number of marker blocks now in use. */
-
-static int n_marker_blocks;
-
static void
init_marker (void)
{
marker_block = NULL;
marker_block_index = MARKER_BLOCK_SIZE;
marker_free_list = 0;
- n_marker_blocks = 0;
}
/* Return a newly allocated Lisp_Misc object, with no substructure. */
new->next = marker_block;
marker_block = new;
marker_block_index = 0;
- n_marker_blocks++;
total_free_markers += MARKER_BLOCK_SIZE;
}
XSETMISC (val, &marker_block->markers[marker_block_index]);
The unwind function can get the C values back using XSAVE_VALUE. */
Lisp_Object
-make_save_value (void *pointer, int integer)
+make_save_value (void *pointer, ptrdiff_t integer)
{
register Lisp_Object val;
register struct Lisp_Save_Value *p;
are characters that are in 0...127,
after discarding the meta bit and all the bits above it. */
if (!INTEGERP (args[i])
- || (XUINT (args[i]) & ~(-CHAR_META)) >= 0200)
+ || (XINT (args[i]) & ~(-CHAR_META)) >= 0200)
return Fvector (nargs, args);
/* Since the loop exited, we know that all the things in it are
************************************************************************/
-/* Called if malloc returns zero. */
+/* Called if malloc (NBYTES) returns zero. If NBYTES == SIZE_MAX,
+ there may have been size_t overflow so that malloc was never
+ called, or perhaps malloc was invoked successfully but the
+ resulting pointer had problems fitting into a tagged EMACS_INT. In
+ either case this counts as memory being full even though malloc did
+ not fail. */
void
-memory_full (void)
+memory_full (size_t nbytes)
{
- int i;
+ /* Do not go into hysterics merely because a large request failed. */
+ int enough_free_memory = 0;
+ if (SPARE_MEMORY < nbytes)
+ {
+ void *p = malloc (SPARE_MEMORY);
+ if (p)
+ {
+ free (p);
+ enough_free_memory = 1;
+ }
+ }
- Vmemory_full = Qt;
+ if (! enough_free_memory)
+ {
+ int i;
- memory_full_cons_threshold = sizeof (struct cons_block);
+ Vmemory_full = Qt;
- /* 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;
- }
+ 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. */
+ /* Record the space now used. When it decreases substantially,
+ we can refill the memory reserve. */
#if !defined SYSTEM_MALLOC && !defined SYNC_INPUT
- bytes_used_when_full = BYTES_USED;
+ 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. */
/* Value is a pointer to the mem_node containing START. Value is
MEM_NIL if there is no node in the tree containing START. */
-static INLINE struct mem_node *
+static inline struct mem_node *
mem_find (void *start)
{
struct mem_node *p;
/* Value is non-zero if P is a pointer to a live Lisp string on
the heap. M is a pointer to the mem_block for P. */
-static INLINE int
+static inline int
live_string_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_STRING)
/* Value is non-zero if P is a pointer to a live Lisp cons on
the heap. M is a pointer to the mem_block for P. */
-static INLINE int
+static inline int
live_cons_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_CONS)
/* Value is non-zero if P is a pointer to a live Lisp symbol on
the heap. M is a pointer to the mem_block for P. */
-static INLINE int
+static inline int
live_symbol_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_SYMBOL)
/* Value is non-zero if P is a pointer to a live Lisp float on
the heap. M is a pointer to the mem_block for P. */
-static INLINE int
+static inline int
live_float_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_FLOAT)
/* Value is non-zero if P is a pointer to a live Lisp Misc on
the heap. M is a pointer to the mem_block for P. */
-static INLINE int
+static inline int
live_misc_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_MISC)
/* Value is non-zero if P is a pointer to a live vector-like object.
M is a pointer to the mem_block for P. */
-static INLINE int
+static inline int
live_vector_p (struct mem_node *m, void *p)
{
return (p == m->start && m->type == MEM_TYPE_VECTORLIKE);
/* Value is non-zero if P is a pointer to a live buffer. M is a
pointer to the mem_block for P. */
-static INLINE int
+static inline int
live_buffer_p (struct mem_node *m, void *p)
{
/* P must point to the start of the block, and the buffer
/* Number of zombie objects. */
-static int nzombies;
+static EMACS_INT nzombies;
/* Number of garbage collections. */
-static int ngcs;
+static EMACS_INT ngcs;
/* Average percentage of zombies per collection. */
/* Max. number of live and zombie objects. */
-static int max_live, max_zombies;
+static EMACS_INT max_live, max_zombies;
/* Average number of live objects per GC. */
(void)
{
Lisp_Object args[8], zombie_list = Qnil;
- int i;
+ EMACS_INT i;
for (i = 0; i < nzombies; i++)
zombie_list = Fcons (zombies[i], zombie_list);
args[0] = build_string ("%d GCs, avg live/zombies = %.2f/%.2f (%f%%), max %d/%d\nzombies: %S");
/* Mark OBJ if we can prove it's a Lisp_Object. */
-static INLINE void
+static inline void
mark_maybe_object (Lisp_Object obj)
{
void *po;
/* If P points to Lisp data, mark that as live if it isn't already
marked. */
-static INLINE void
+static inline void
mark_maybe_pointer (void *p)
{
struct mem_node *m;
/* Quickly rule out some values which can't point to Lisp data. */
- if ((EMACS_INT) p %
+ if ((intptr_t) p %
#ifdef USE_LSB_TAG
8 /* USE_LSB_TAG needs Lisp data to be aligned on multiples of 8. */
#else
check_gcpros (void)
{
struct gcpro *p;
- size_t i;
+ ptrdiff_t i;
for (p = gcprolist; p; p = p->next)
for (i = 0; i < p->nvars; ++i)
{
int i;
- fprintf (stderr, "\nZombies kept alive = %d:\n", nzombies);
+ fprintf (stderr, "\nZombies kept alive = %"pI":\n", nzombies);
for (i = 0; i < min (MAX_ZOMBIES, nzombies); ++i)
{
fprintf (stderr, " %d = ", i);
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));
inhibit_garbage_collection (void)
{
int count = SPECPDL_INDEX ();
- int nbits = min (VALBITS, BITS_PER_INT);
- specbind (Qgc_cons_threshold, make_number (((EMACS_INT) 1 << (nbits - 1)) - 1));
+ specbind (Qgc_cons_threshold, make_number (MOST_POSITIVE_FIXNUM));
return count;
}
{
register struct specbinding *bind;
char stack_top_variable;
- register size_t i;
+ ptrdiff_t i;
int message_p;
Lisp_Object total[8];
int count = SPECPDL_INDEX ();
}
}
- nextb = nextb->next;
+ nextb = nextb->header.next.buffer;
}
}
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 (gc_cons_threshold < 10000)
gc_cons_threshold = 10000;
+ gc_relative_threshold = 0;
if (FLOATP (Vgc_cons_percentage))
{ /* Set gc_cons_combined_threshold. */
- EMACS_INT tot = 0;
+ double tot = 0;
tot += total_conses * sizeof (struct Lisp_Cons);
tot += total_symbols * sizeof (struct Lisp_Symbol);
tot += total_intervals * sizeof (struct interval);
tot += total_strings * sizeof (struct Lisp_String);
- gc_relative_threshold = tot * XFLOAT_DATA (Vgc_cons_percentage);
+ tot *= XFLOAT_DATA (Vgc_cons_percentage);
+ if (0 < tot)
+ {
+ if (tot < TYPE_MAXIMUM (EMACS_INT))
+ gc_relative_threshold = tot;
+ else
+ gc_relative_threshold = TYPE_MAXIMUM (EMACS_INT);
+ }
}
- else
- gc_relative_threshold = 0;
if (garbage_collection_messages)
{
static void
mark_vectorlike (struct Lisp_Vector *ptr)
{
- register EMACS_UINT size = ptr->size;
- register EMACS_UINT i;
+ EMACS_INT size = ptr->header.size;
+ EMACS_INT i;
eassert (!VECTOR_MARKED_P (ptr));
VECTOR_MARK (ptr); /* Else mark it */
static void
mark_char_table (struct Lisp_Vector *ptr)
{
- register EMACS_UINT size = ptr->size & PSEUDOVECTOR_SIZE_MASK;
- register EMACS_UINT i;
+ int size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
+ int i;
eassert (!VECTOR_MARKED_P (ptr));
VECTOR_MARK (ptr);
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 i;
+ int size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
+ int i;
CHECK_LIVE (live_vector_p);
VECTOR_MARK (ptr); /* Else mark it */
- size &= PSEUDOVECTOR_SIZE_MASK;
for (i = 0; i < size; i++) /* and then mark its elements */
{
if (i != COMPILED_CONSTANTS)
if (ptr->dogc)
{
Lisp_Object *p = (Lisp_Object *) ptr->pointer;
- int nelt;
+ ptrdiff_t nelt;
for (nelt = ptr->integer; nelt > 0; nelt--, p++)
mark_maybe_object (*p);
}
register struct cons_block *cblk;
struct cons_block **cprev = &cons_block;
register int lim = cons_block_index;
- register int num_free = 0, num_used = 0;
+ EMACS_INT num_free = 0, num_used = 0;
cons_free_list = 0;
/* Unhook from the free list. */
cons_free_list = cblk->conses[0].u.chain;
lisp_align_free (cblk);
- n_cons_blocks--;
}
else
{
register struct float_block *fblk;
struct float_block **fprev = &float_block;
register int lim = float_block_index;
- register int num_free = 0, num_used = 0;
+ EMACS_INT num_free = 0, num_used = 0;
float_free_list = 0;
/* Unhook from the free list. */
float_free_list = fblk->floats[0].u.chain;
lisp_align_free (fblk);
- n_float_blocks--;
}
else
{
register struct interval_block *iblk;
struct interval_block **iprev = &interval_block;
register int lim = interval_block_index;
- register int num_free = 0, num_used = 0;
+ EMACS_INT num_free = 0, num_used = 0;
interval_free_list = 0;
/* Unhook from the free list. */
interval_free_list = INTERVAL_PARENT (&iblk->intervals[0]);
lisp_free (iblk);
- n_interval_blocks--;
}
else
{
register struct symbol_block *sblk;
struct symbol_block **sprev = &symbol_block;
register int lim = symbol_block_index;
- register int num_free = 0, num_used = 0;
+ EMACS_INT num_free = 0, num_used = 0;
symbol_free_list = NULL;
/* Unhook from the free list. */
symbol_free_list = sblk->symbols[0].next;
lisp_free (sblk);
- n_symbol_blocks--;
}
else
{
register struct marker_block *mblk;
struct marker_block **mprev = &marker_block;
register int lim = marker_block_index;
- register int num_free = 0, num_used = 0;
+ EMACS_INT num_free = 0, num_used = 0;
marker_free_list = 0;
/* Unhook from the free list. */
marker_free_list = mblk->markers[0].u_free.chain;
lisp_free (mblk);
- n_marker_blocks--;
}
else
{
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) (char *) sbrk (0) / 1024);
+ XSETINT (end, (intptr_t) (char *) sbrk (0) / 1024);
return end;
}
HCoop / bpt / emacs.git / blobdiff