#include <limits.h> /* For CHAR_BIT. */
#include <setjmp.h>
-#ifdef ALLOC_DEBUG
-#undef INLINE
-#endif
-
#include <signal.h>
#ifdef HAVE_GTK_AND_PTHREAD
/* 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
}
-#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.
/* 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);
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
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)
+ if (string_len > STRING_BYTES_MAX / len)
string_overflow ();
nbytes = len * string_len;
val = make_uninit_multibyte_string (string_len, nbytes);
{
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;
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;
}
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++;
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
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->header.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. */
for (i = 0; i < lisplen; ++i)
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;
void *p = malloc (SPARE_MEMORY);
if (p)
{
- if (spare_memory[0])
- free (p);
- else
- spare_memory[0] = p;
+ free (p);
enough_free_memory = 1;
}
}
/* 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;
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);
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 ();
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->header.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->header.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);
recursion there. */
{
register struct Lisp_Vector *ptr = XVECTOR (obj);
- register EMACS_UINT size = ptr->header.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
{
all_vectors = vector->header.next.vector;
next = vector->header.next.vector;
lisp_free (vector);
- n_vectors--;
vector = next;
}
HCoop / bpt / emacs.git / blobdiff