X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/8bd7b8304a41da5dc0c8a11967c1a6005e9465d0..c9d624c605059127505b6d4baec8f07d6ff731d9:/src/alloc.c diff --git a/src/alloc.c b/src/alloc.c index 16cd183aaa..fa4f1d3813 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -22,10 +22,6 @@ along with GNU Emacs. If not, see . */ #include /* For CHAR_BIT. */ #include -#ifdef ALLOC_DEBUG -#undef INLINE -#endif - #include #ifdef HAVE_GTK_AND_PTHREAD @@ -139,10 +135,6 @@ static pthread_mutex_t alloc_mutex; #endif /* ! defined HAVE_GTK_AND_PTHREAD */ #endif /* ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT */ -/* Value of _bytes_used, when spare_memory was freed. */ - -static __malloc_size_t bytes_used_when_full; - /* Mark, unmark, query mark bit of a Lisp string. S must be a pointer to a struct Lisp_String. */ @@ -150,9 +142,9 @@ static __malloc_size_t bytes_used_when_full; #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 @@ -165,7 +157,7 @@ struct emacs_globals globals; /* 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. */ @@ -198,7 +190,8 @@ static int total_free_floats, total_floats; static char *spare_memory[7]; -/* 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) @@ -410,7 +403,7 @@ static void mem_rotate_left (struct mem_node *); 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 @@ -440,7 +433,7 @@ static POINTER_TYPE *pure_alloc (size_t, int); 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))) @@ -469,18 +462,11 @@ display_malloc_warning (void) intern ("emergency")); pending_malloc_warning = 0; } - - -#ifdef DOUG_LEA_MALLOC -# define BYTES_USED (mallinfo ().uordblks) -#else -# define BYTES_USED _bytes_used -#endif /* 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 @@ -490,7 +476,7 @@ buffer_memory_full (void) 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 @@ -499,7 +485,9 @@ buffer_memory_full (void) } -#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. @@ -564,7 +552,7 @@ static int check_depth; /* 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; @@ -588,7 +576,7 @@ overrun_check_malloc (size_t size) /* 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; @@ -626,7 +614,7 @@ overrun_check_realloc (POINTER_TYPE *block, size_t size) /* Like free, but checks block for overrun. */ -void +static void overrun_check_free (POINTER_TYPE *block) { unsigned char *val = (unsigned char *) block; @@ -686,7 +674,7 @@ xmalloc (size_t size) MALLOC_UNBLOCK_INPUT; if (!val && size) - memory_full (); + memory_full (size); return val; } @@ -707,7 +695,8 @@ xrealloc (POINTER_TYPE *block, size_t size) val = (POINTER_TYPE *) realloc (block, size); MALLOC_UNBLOCK_INPUT; - if (!val && size) memory_full (); + if (!val && size) + memory_full (size); return val; } @@ -800,7 +789,7 @@ lisp_malloc (size_t nbytes, enum mem_type type) MALLOC_UNBLOCK_INPUT; if (!val && nbytes) - memory_full (); + memory_full (nbytes); return val; } @@ -844,7 +833,7 @@ lisp_free (POINTER_TYPE *block) nothing else. */ #define BLOCK_PADDING 0 #define BLOCK_BYTES \ - (BLOCK_ALIGN - sizeof (struct ablock *) - BLOCK_PADDING) + (BLOCK_ALIGN - sizeof (struct ablocks *) - BLOCK_PADDING) /* Internal data structures and constants. */ @@ -885,7 +874,7 @@ struct ablocks #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) @@ -897,7 +886,7 @@ struct ablocks #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. */ @@ -923,7 +912,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) 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 @@ -947,7 +936,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) if (base == 0) { MALLOC_UNBLOCK_INPUT; - memory_full (); + memory_full (ABLOCKS_BYTES); } aligned = (base == abase); @@ -973,7 +962,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) lisp_malloc_loser = base; free (base); MALLOC_UNBLOCK_INPUT; - memory_full (); + memory_full (SIZE_MAX); } } #endif @@ -986,30 +975,29 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) 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; } @@ -1027,11 +1015,12 @@ lisp_align_free (POINTER_TYPE *block) 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]; @@ -1048,7 +1037,7 @@ lisp_align_free (POINTER_TYPE *block) 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)); } @@ -1064,8 +1053,9 @@ allocate_buffer (void) struct buffer *b = (struct buffer *) lisp_malloc (sizeof (struct buffer), MEM_TYPE_BUFFER); - b->size = sizeof (struct buffer) / sizeof (EMACS_INT); - XSETPVECTYPE (b, PVEC_BUFFER); + XSETPVECTYPESIZE (b, PVEC_BUFFER, + ((sizeof (struct buffer) + sizeof (EMACS_INT) - 1) + / sizeof (EMACS_INT))); return b; } @@ -1096,8 +1086,18 @@ static void * (*old_malloc_hook) (size_t, const void *); static void * (*old_realloc_hook) (void *, size_t, const void*); static void (*old_free_hook) (void*, const void*); +#ifdef DOUG_LEA_MALLOC +# define BYTES_USED (mallinfo ().uordblks) +#else +# define BYTES_USED _bytes_used +#endif + static __malloc_size_t bytes_used_when_reconsidered; +/* Value of _bytes_used, when spare_memory was freed. */ + +static __malloc_size_t bytes_used_when_full; + /* This function is used as the hook for free to call. */ static void @@ -1515,23 +1515,26 @@ struct sdata #define SDATA_NBYTES(S) (S)->nbytes #define SDATA_DATA(S) (S)->data +#define SDATA_SELECTOR(member) member #else /* not GC_CHECK_STRING_BYTES */ union { - /* When STRING in non-null. */ + /* When STRING is non-null. */ unsigned char data[1]; /* When STRING is null. */ EMACS_INT nbytes; } u; - #define SDATA_NBYTES(S) (S)->u.nbytes #define SDATA_DATA(S) (S)->u.data +#define SDATA_SELECTOR(member) u.member #endif /* not GC_CHECK_STRING_BYTES */ + +#define SDATA_DATA_OFFSET offsetof (struct sdata, SDATA_SELECTOR (data)) }; @@ -1607,18 +1610,7 @@ static EMACS_INT total_string_size; a pointer to the `u.data' member of its sdata structure; the structure starts at a constant offset in front of that. */ -#ifdef GC_CHECK_STRING_BYTES - -#define SDATA_OF_STRING(S) \ - ((struct sdata *) ((S)->data - sizeof (struct Lisp_String *) \ - - sizeof (EMACS_INT))) - -#else /* not GC_CHECK_STRING_BYTES */ - -#define SDATA_OF_STRING(S) \ - ((struct sdata *) ((S)->data - sizeof (struct Lisp_String *))) - -#endif /* not GC_CHECK_STRING_BYTES */ +#define SDATA_OF_STRING(S) ((struct sdata *) ((S)->data - SDATA_DATA_OFFSET)) #ifdef GC_CHECK_STRING_OVERRUN @@ -1628,8 +1620,8 @@ static EMACS_INT total_string_size; presence of this cookie during GC. */ #define GC_STRING_OVERRUN_COOKIE_SIZE 4 -static char string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] = - { 0xde, 0xad, 0xbe, 0xef }; +static char const string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] = + { '\xde', '\xad', '\xbe', '\xef' }; #else #define GC_STRING_OVERRUN_COOKIE_SIZE 0 @@ -1642,18 +1634,25 @@ static char string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] = #ifdef GC_CHECK_STRING_BYTES #define SDATA_SIZE(NBYTES) \ - ((sizeof (struct Lisp_String *) \ + ((SDATA_DATA_OFFSET \ + (NBYTES) + 1 \ - + sizeof (EMACS_INT) \ + sizeof (EMACS_INT) - 1) \ & ~(sizeof (EMACS_INT) - 1)) #else /* not GC_CHECK_STRING_BYTES */ -#define SDATA_SIZE(NBYTES) \ - ((sizeof (struct Lisp_String *) \ - + (NBYTES) + 1 \ - + sizeof (EMACS_INT) - 1) \ +/* The 'max' reserves space for the nbytes union member even when NBYTES + 1 is + less than the size of that member. The 'max' is not needed when + SDATA_DATA_OFFSET is a multiple of sizeof (EMACS_INT), because then the + alignment code reserves enough space. */ + +#define SDATA_SIZE(NBYTES) \ + ((SDATA_DATA_OFFSET \ + + (SDATA_DATA_OFFSET % sizeof (EMACS_INT) == 0 \ + ? NBYTES \ + : max (NBYTES, sizeof (EMACS_INT) - 1)) \ + + 1 \ + + sizeof (EMACS_INT) - 1) \ & ~(sizeof (EMACS_INT) - 1)) #endif /* not GC_CHECK_STRING_BYTES */ @@ -1662,6 +1661,18 @@ static char string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] = #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 @@ -1681,9 +1692,6 @@ init_strings (void) static int check_string_bytes_count; -static void check_string_bytes (int); -static void check_sblock (struct sblock *); - #define CHECK_STRING_BYTES(S) STRING_BYTES (S) @@ -1705,8 +1713,7 @@ string_bytes (struct Lisp_String *s) /* Check validity of Lisp strings' string_bytes member in B. */ static void -check_sblock (b) - struct sblock *b; +check_sblock (struct sblock *b) { struct sdata *from, *end, *from_end; @@ -1739,8 +1746,7 @@ check_sblock (b) recently allocated strings. Used for hunting a bug. */ static void -check_string_bytes (all_p) - int all_p; +check_string_bytes (int all_p) { if (all_p) { @@ -1768,7 +1774,7 @@ check_string_bytes (all_p) This may catch buffer overrun from a previous string. */ static void -check_string_free_list () +check_string_free_list (void) { struct Lisp_String *s; @@ -1776,7 +1782,7 @@ check_string_free_list () s = string_free_list; while (s != NULL) { - if ((unsigned long)s < 1024) + if ((uintptr_t) s < 1024) abort(); s = NEXT_FREE_LISP_STRING (s); } @@ -1866,6 +1872,9 @@ allocate_string_data (struct Lisp_String *s, 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); @@ -1876,7 +1885,7 @@ allocate_string_data (struct Lisp_String *s, if (nbytes > LARGE_STRING_BYTES) { - size_t size = sizeof *b - sizeof (struct sdata) + needed; + size_t size = offsetof (struct sblock, first_data) + needed; #ifdef DOUG_LEA_MALLOC /* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed @@ -1937,7 +1946,8 @@ allocate_string_data (struct Lisp_String *s, s->size_byte = nbytes; s->data[nbytes] = '\0'; #ifdef GC_CHECK_STRING_OVERRUN - memcpy (data + needed, string_overrun_cookie, GC_STRING_OVERRUN_COOKIE_SIZE); + memcpy ((char *) data + needed, string_overrun_cookie, + GC_STRING_OVERRUN_COOKIE_SIZE); #endif /* If S had already data assigned, mark that as free by setting its @@ -2151,7 +2161,7 @@ compact_small_strings (void) /* Copy, and update the string's `data' pointer. */ if (from != to) { - xassert (tb != b || to <= from); + xassert (tb != b || to < from); memmove (to, from, nbytes + GC_STRING_EXTRA); to->string->data = SDATA_DATA (to); } @@ -2175,6 +2185,11 @@ compact_small_strings (void) 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. @@ -2188,9 +2203,9 @@ INIT must be an integer that represents a character. */) 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); @@ -2206,8 +2221,8 @@ INIT must be an integer that represents a character. */) 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); @@ -2247,10 +2262,8 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */) 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); @@ -2437,10 +2450,10 @@ make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes) &= ~(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 { @@ -2549,10 +2562,10 @@ make_float (double float_value) / (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 { @@ -2792,6 +2805,11 @@ allocate_vectorlike (EMACS_INT len) { struct Lisp_Vector *p; size_t nbytes; + int header_size = offsetof (struct Lisp_Vector, contents); + int word_size = sizeof p->contents[0]; + + if ((SIZE_MAX - header_size) / word_size < len) + memory_full (SIZE_MAX); MALLOC_BLOCK_INPUT; @@ -2805,7 +2823,7 @@ allocate_vectorlike (EMACS_INT len) /* This gets triggered by code which I haven't bothered to fix. --Stef */ /* eassert (!handling_signal); */ - nbytes = sizeof *p + (len - 1) * sizeof p->contents[0]; + nbytes = header_size + len * word_size; p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE); #ifdef DOUG_LEA_MALLOC @@ -2816,7 +2834,7 @@ allocate_vectorlike (EMACS_INT len) consing_since_gc += nbytes; vector_cells_consed += len; - p->next = all_vectors; + p->header.next.vector = all_vectors; all_vectors = p; MALLOC_UNBLOCK_INPUT; @@ -2832,7 +2850,7 @@ struct Lisp_Vector * allocate_vector (EMACS_INT nslots) { struct Lisp_Vector *v = allocate_vectorlike (nslots); - v->size = nslots; + v->header.size = nslots; return v; } @@ -2846,11 +2864,10 @@ allocate_pseudovector (int memlen, int lisplen, EMACS_INT tag) EMACS_INT i; /* Only the first lisplen slots will be traced normally by the GC. */ - v->size = lisplen; for (i = 0; i < lisplen; ++i) v->contents[i] = Qnil; - XSETPVECTYPE (v, tag); /* Add the appropriate tag. */ + XSETPVECTYPESIZE (v, tag, lisplen); return v; } @@ -3242,7 +3259,7 @@ make_event_array (register int nargs, Lisp_Object *args) 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 @@ -3270,35 +3287,55 @@ make_event_array (register int nargs, Lisp_Object *args) ************************************************************************/ -/* 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); - /* Record the space now used. When it decreases substantially, - we can refill the memory reserve. */ -#ifndef SYSTEM_MALLOC - bytes_used_when_full = BYTES_USED; + /* 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. */ +#if !defined SYSTEM_MALLOC && !defined SYNC_INPUT + 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. */ @@ -3374,7 +3411,7 @@ mem_init (void) /* 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; @@ -3750,7 +3787,7 @@ mem_delete_fixup (struct mem_node *x) /* 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) @@ -3773,7 +3810,7 @@ live_string_p (struct mem_node *m, void *p) /* 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) @@ -3799,7 +3836,7 @@ live_cons_p (struct mem_node *m, void *p) /* 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) @@ -3825,7 +3862,7 @@ live_symbol_p (struct mem_node *m, void *p) /* 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) @@ -3849,7 +3886,7 @@ live_float_p (struct mem_node *m, void *p) /* 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) @@ -3875,7 +3912,7 @@ live_misc_p (struct mem_node *m, void *p) /* 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); @@ -3885,7 +3922,7 @@ live_vector_p (struct mem_node *m, void *p) /* 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 @@ -3951,7 +3988,7 @@ DEFUN ("gc-status", Fgc_status, Sgc_status, 0, 0, "", /* 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; @@ -4020,13 +4057,13 @@ mark_maybe_object (Lisp_Object obj) /* 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 @@ -4573,8 +4610,9 @@ void check_pure_size (void) { if (pure_bytes_used_before_overflow) - message ("emacs:0:Pure Lisp storage overflow (approx. %d bytes needed)", - (int) (pure_bytes_used + pure_bytes_used_before_overflow)); + message (("emacs:0:Pure Lisp storage overflow (approx. %"pI"d" + " bytes needed)"), + pure_bytes_used + pure_bytes_used_before_overflow); } @@ -4733,11 +4771,12 @@ make_pure_vector (EMACS_INT len) { Lisp_Object new; struct Lisp_Vector *p; - size_t size = sizeof *p + (len - 1) * sizeof (Lisp_Object); + size_t size = (offsetof (struct Lisp_Vector, contents) + + len * sizeof (Lisp_Object)); p = (struct Lisp_Vector *) pure_alloc (size, Lisp_Vectorlike); XSETVECTOR (new, p); - XVECTOR (new)->size = len; + XVECTOR (new)->header.size = len; return new; } @@ -4775,7 +4814,7 @@ Does not copy symbols. Copies strings without text properties. */) 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)); @@ -4899,7 +4938,7 @@ returns nil, because real GC can't be done. */) } } - nextb = nextb->next; + nextb = nextb->header.next.buffer; } } @@ -5054,7 +5093,7 @@ returns nil, because real GC can't be done. */) 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; } } @@ -5228,7 +5267,7 @@ static size_t mark_object_loop_halt; static void mark_vectorlike (struct Lisp_Vector *ptr) { - register EMACS_UINT size = ptr->size; + register EMACS_UINT size = ptr->header.size; register EMACS_UINT i; eassert (!VECTOR_MARKED_P (ptr)); @@ -5251,7 +5290,7 @@ mark_vectorlike (struct Lisp_Vector *ptr) static void mark_char_table (struct Lisp_Vector *ptr) { - register EMACS_UINT size = ptr->size & PSEUDOVECTOR_SIZE_MASK; + register EMACS_UINT size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK; register EMACS_UINT i; eassert (!VECTOR_MARKED_P (ptr)); @@ -5364,7 +5403,7 @@ mark_object (Lisp_Object arg) 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 (); @@ -5380,7 +5419,7 @@ mark_object (Lisp_Object arg) recursion there. */ { register struct Lisp_Vector *ptr = XVECTOR (obj); - register EMACS_UINT size = ptr->size; + register EMACS_UINT size = ptr->header.size; register EMACS_UINT i; CHECK_LIVE (live_vector_p); @@ -6012,10 +6051,10 @@ gc_sweep (void) 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; } @@ -6023,7 +6062,7 @@ gc_sweep (void) { VECTOR_UNMARK (buffer); UNMARK_BALANCE_INTERVALS (BUF_INTERVALS (buffer)); - prev = buffer, buffer = buffer->next; + prev = buffer, buffer = buffer->header.next.buffer; } } @@ -6036,10 +6075,10 @@ gc_sweep (void) 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; @@ -6048,11 +6087,11 @@ gc_sweep (void) 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; } } @@ -6075,7 +6114,7 @@ We divide the value by 1024 to make sure it fits in a Lisp integer. */) { Lisp_Object end; - XSETINT (end, (EMACS_INT) (char *) sbrk (0) / 1024); + XSETINT (end, (intptr_t) (char *) sbrk (0) / 1024); return end; }