X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/24d8a105d8ee6a59fe5535d5d6117d0c1002aa71..9416ae448e61ef1478a7e7e07bdfa25273095811:/src/alloc.c diff --git a/src/alloc.c b/src/alloc.c index b18e313fc8..2fd5000964 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1,6 +1,6 @@ /* Storage allocation and gc for GNU Emacs Lisp interpreter. Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999, - 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. + 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -23,6 +23,10 @@ Boston, MA 02110-1301, USA. */ #include #include /* For CHAR_BIT. */ +#ifdef STDC_HEADERS +#include /* For offsetof, used by PSEUDOVECSIZE. */ +#endif + #ifdef ALLOC_DEBUG #undef INLINE #endif @@ -66,6 +70,19 @@ Boston, MA 02110-1301, USA. */ extern POINTER_TYPE *sbrk (); #endif +#ifdef HAVE_FCNTL_H +#define INCLUDED_FCNTL +#include +#endif +#ifndef O_WRONLY +#define O_WRONLY 1 +#endif + +#ifdef WINDOWSNT +#include +#include "w32.h" +#endif + #ifdef DOUG_LEA_MALLOC #include @@ -113,17 +130,17 @@ static pthread_mutex_t alloc_mutex; #define BLOCK_INPUT_ALLOC \ do \ { \ - pthread_mutex_lock (&alloc_mutex); \ - if (pthread_self () == main_thread) \ - BLOCK_INPUT; \ + if (pthread_self () == main_thread) \ + BLOCK_INPUT; \ + pthread_mutex_lock (&alloc_mutex); \ } \ while (0) #define UNBLOCK_INPUT_ALLOC \ do \ { \ - if (pthread_self () == main_thread) \ - UNBLOCK_INPUT; \ - pthread_mutex_unlock (&alloc_mutex); \ + pthread_mutex_unlock (&alloc_mutex); \ + if (pthread_self () == main_thread) \ + UNBLOCK_INPUT; \ } \ while (0) @@ -138,6 +155,8 @@ static pthread_mutex_t alloc_mutex; 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. */ @@ -275,10 +294,18 @@ static size_t pure_bytes_used_before_overflow; && ((PNTR_COMPARISON_TYPE) (P) \ >= (PNTR_COMPARISON_TYPE) purebeg)) -/* Index in pure at which next pure object will be allocated.. */ +/* 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; + +/* Number of bytes allocated for non-Lisp objects in pure storage. */ + +static EMACS_INT pure_bytes_used_non_lisp; + /* If nonzero, this is a warning delivered by malloc and not yet displayed. */ @@ -358,6 +385,8 @@ enum mem_type static POINTER_TYPE *lisp_align_malloc P_ ((size_t, enum mem_type)); static POINTER_TYPE *lisp_malloc P_ ((size_t, enum mem_type)); +void refill_memory_reserve (); + #if GC_MARK_STACK || defined GC_MALLOC_CHECK @@ -458,7 +487,6 @@ static void mem_rotate_right P_ ((struct mem_node *)); static void mem_delete P_ ((struct mem_node *)); static void mem_delete_fixup P_ ((struct mem_node *)); static INLINE struct mem_node *mem_find P_ ((void *)); -void refill_memory_reserve (); #if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS @@ -521,7 +549,7 @@ display_malloc_warning () #ifdef DOUG_LEA_MALLOC -# define BYTES_USED (mallinfo ().arena) +# define BYTES_USED (mallinfo ().uordblks) #else # define BYTES_USED _bytes_used #endif @@ -544,8 +572,7 @@ buffer_memory_full () /* This used to call error, but if we've run out of memory, we could get infinite recursion trying to build the string. */ - while (1) - Fsignal (Qnil, Vmemory_signal_data); + xsignal (Qnil, Vmemory_signal_data); } @@ -872,6 +899,12 @@ lisp_free (block) /* The entry point is lisp_align_malloc which returns blocks of at most */ /* BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary. */ +/* Use posix_memalloc if the system has it and we're using the system's + malloc (because our gmalloc.c routines don't have posix_memalign although + its memalloc could be used). */ +#if defined (HAVE_POSIX_MEMALIGN) && defined (SYSTEM_MALLOC) +#define USE_POSIX_MEMALIGN 1 +#endif /* BLOCK_ALIGN has to be a power of 2. */ #define BLOCK_ALIGN (1 << 10) @@ -937,7 +970,7 @@ struct ablocks #define ABLOCKS_BUSY(abase) ((abase)->blocks[0].abase) /* Pointer to the (not necessarily aligned) malloc block. */ -#ifdef HAVE_POSIX_MEMALIGN +#ifdef USE_POSIX_MEMALIGN #define ABLOCKS_BASE(abase) (abase) #else #define ABLOCKS_BASE(abase) \ @@ -978,7 +1011,7 @@ lisp_align_malloc (nbytes, type) mallopt (M_MMAP_MAX, 0); #endif -#ifdef HAVE_POSIX_MEMALIGN +#ifdef USE_POSIX_MEMALIGN { int err = posix_memalign (&base, BLOCK_ALIGN, ABLOCKS_BYTES); if (err) @@ -1094,6 +1127,9 @@ lisp_align_free (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); +#endif free (ABLOCKS_BASE (abase)); } UNBLOCK_INPUT; @@ -1179,8 +1215,8 @@ emacs_blocked_free (ptr, ptr2) The code here is correct as long as SPARE_MEMORY is substantially larger than the block size malloc uses. */ && (bytes_used_when_full - > ((bytes_used_now = BYTES_USED) - + max (malloc_hysteresis, 4) * SPARE_MEMORY)) + > ((bytes_used_when_reconsidered = BYTES_USED) + + max (malloc_hysteresis, 4) * SPARE_MEMORY))) refill_memory_reserve (); __free_hook = emacs_blocked_free; @@ -1408,6 +1444,12 @@ make_interval () { INTERVAL val; + /* eassert (!handling_signal); */ + +#ifndef SYNC_INPUT + BLOCK_INPUT; +#endif + if (interval_free_list) { val = interval_free_list; @@ -1429,6 +1471,11 @@ make_interval () } val = &interval_block->intervals[interval_block_index++]; } + +#ifndef SYNC_INPUT + UNBLOCK_INPUT; +#endif + consing_since_gc += sizeof (struct interval); intervals_consed++; RESET_INTERVAL (val); @@ -1826,6 +1873,12 @@ allocate_string () { struct Lisp_String *s; + /* eassert (!handling_signal); */ + +#ifndef SYNC_INPUT + BLOCK_INPUT; +#endif + /* If the free-list is empty, allocate a new string_block, and add all the Lisp_Strings in it to the free-list. */ if (string_free_list == NULL) @@ -1855,6 +1908,10 @@ allocate_string () s = string_free_list; string_free_list = NEXT_FREE_LISP_STRING (s); +#ifndef SYNC_INPUT + UNBLOCK_INPUT; +#endif + /* Probably not strictly necessary, but play it safe. */ bzero (s, sizeof *s); @@ -1902,6 +1959,12 @@ allocate_string_data (s, nchars, nbytes) /* Determine the number of bytes needed to store NBYTES bytes of string data. */ needed = SDATA_SIZE (nbytes); + old_data = s->data ? SDATA_OF_STRING (s) : NULL; + old_nbytes = GC_STRING_BYTES (s); + +#ifndef SYNC_INPUT + BLOCK_INPUT; +#endif if (nbytes > LARGE_STRING_BYTES) { @@ -1956,10 +2019,13 @@ allocate_string_data (s, nchars, nbytes) else b = current_sblock; - old_data = s->data ? SDATA_OF_STRING (s) : NULL; - old_nbytes = GC_STRING_BYTES (s); - data = b->next_free; + b->next_free = (struct sdata *) ((char *) data + needed + GC_STRING_EXTRA); + +#ifndef SYNC_INPUT + UNBLOCK_INPUT; +#endif + data->string = s; s->data = SDATA_DATA (data); #ifdef GC_CHECK_STRING_BYTES @@ -1972,7 +2038,6 @@ allocate_string_data (s, nchars, nbytes) bcopy (string_overrun_cookie, (char *) data + needed, GC_STRING_OVERRUN_COOKIE_SIZE); #endif - b->next_free = (struct sdata *) ((char *) data + needed + GC_STRING_EXTRA); /* If S had already data assigned, mark that as free by setting its string back-pointer to null, and recording the size of the data @@ -2256,7 +2321,7 @@ INIT must be an integer that represents a character. */) DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0, - doc: /* Return a new bool-vector of length LENGTH, using INIT for as each element. + doc: /* Return a new bool-vector of length LENGTH, using INIT for each element. LENGTH must be a number. INIT matters only in whether it is t or nil. */) (length, init) Lisp_Object length, init; @@ -2528,7 +2593,7 @@ void free_float (ptr) struct Lisp_Float *ptr; { - *(struct Lisp_Float **)&ptr->data = float_free_list; + ptr->u.chain = float_free_list; float_free_list = ptr; } @@ -2541,12 +2606,18 @@ make_float (float_value) { register Lisp_Object val; + /* eassert (!handling_signal); */ + +#ifndef SYNC_INPUT + BLOCK_INPUT; +#endif + if (float_free_list) { /* We use the data field for chaining the free list so that we won't use the same field that has the mark bit. */ XSETFLOAT (val, float_free_list); - float_free_list = *(struct Lisp_Float **)&float_free_list->data; + float_free_list = float_free_list->u.chain; } else { @@ -2566,6 +2637,10 @@ make_float (float_value) float_block_index++; } +#ifndef SYNC_INPUT + UNBLOCK_INPUT; +#endif + XFLOAT_DATA (val) = float_value; eassert (!FLOAT_MARKED_P (XFLOAT (val))); consing_since_gc += sizeof (struct Lisp_Float); @@ -2646,7 +2721,7 @@ void free_cons (ptr) struct Lisp_Cons *ptr; { - *(struct Lisp_Cons **)&ptr->cdr = cons_free_list; + ptr->u.chain = cons_free_list; #if GC_MARK_STACK ptr->car = Vdead; #endif @@ -2660,12 +2735,18 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, { register Lisp_Object val; + /* eassert (!handling_signal); */ + +#ifndef SYNC_INPUT + BLOCK_INPUT; +#endif + if (cons_free_list) { /* We use the cdr for chaining the free list so that we won't use the same field that has the mark bit. */ XSETCONS (val, cons_free_list); - cons_free_list = *(struct Lisp_Cons **)&cons_free_list->cdr; + cons_free_list = cons_free_list->u.chain; } else { @@ -2684,6 +2765,10 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, cons_block_index++; } +#ifndef SYNC_INPUT + UNBLOCK_INPUT; +#endif + XSETCAR (val, car); XSETCDR (val, cdr); eassert (!CONS_MARKED_P (XCONS (val))); @@ -2700,11 +2785,18 @@ check_cons_list () struct Lisp_Cons *tail = cons_free_list; while (tail) - tail = *(struct Lisp_Cons **)&tail->cdr; + tail = tail->u.chain; #endif } -/* Make a list of 2, 3, 4 or 5 specified objects. */ +/* Make a list of 1, 2, 3, 4 or 5 specified objects. */ + +Lisp_Object +list1 (arg1) + Lisp_Object arg1; +{ + return Fcons (arg1, Qnil); +} Lisp_Object list2 (arg1, arg2) @@ -2841,6 +2933,9 @@ allocate_vectorlike (len, type) UNBLOCK_INPUT; #endif + /* This gets triggered by code which I haven't bothered to fix. --Stef */ + /* eassert (!handling_signal); */ + nbytes = sizeof *p + (len - 1) * sizeof p->contents[0]; p = (struct Lisp_Vector *) lisp_malloc (nbytes, type); @@ -2854,8 +2949,17 @@ allocate_vectorlike (len, type) consing_since_gc += nbytes; vector_cells_consed += len; +#ifndef SYNC_INPUT + BLOCK_INPUT; +#endif + p->next = all_vectors; all_vectors = p; + +#ifndef SYNC_INPUT + UNBLOCK_INPUT; +#endif + ++n_vectors; return p; } @@ -2922,13 +3026,17 @@ allocate_frame () struct Lisp_Process * allocate_process () { - EMACS_INT len = VECSIZE (struct Lisp_Process); - struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_PROCESS); + /* Memory-footprint of the object in nb of Lisp_Object fields. */ + EMACS_INT memlen = VECSIZE (struct Lisp_Process); + /* Size if we only count the actual Lisp_Object fields (which need to be + traced by the GC). */ + EMACS_INT lisplen = PSEUDOVECSIZE (struct Lisp_Process, pid); + struct Lisp_Vector *v = allocate_vectorlike (memlen, MEM_TYPE_PROCESS); EMACS_INT i; - for (i = 0; i < len; ++i) + for (i = 0; i < lisplen; ++i) v->contents[i] = Qnil; - v->size = len; + v->size = lisplen; return (struct Lisp_Process *) v; } @@ -3134,10 +3242,16 @@ Its value and function definition are void, and its property list is nil. */) CHECK_STRING (name); + /* eassert (!handling_signal); */ + +#ifndef SYNC_INPUT + BLOCK_INPUT; +#endif + if (symbol_free_list) { XSETSYMBOL (val, symbol_free_list); - symbol_free_list = *(struct Lisp_Symbol **)&symbol_free_list->value; + symbol_free_list = symbol_free_list->next; } else { @@ -3155,6 +3269,10 @@ Its value and function definition are void, and its property list is nil. */) symbol_block_index++; } +#ifndef SYNC_INPUT + UNBLOCK_INPUT; +#endif + p = XSYMBOL (val); p->xname = name; p->plist = Qnil; @@ -3214,6 +3332,12 @@ allocate_misc () { Lisp_Object val; + /* eassert (!handling_signal); */ + +#ifndef SYNC_INPUT + BLOCK_INPUT; +#endif + if (marker_free_list) { XSETMISC (val, marker_free_list); @@ -3236,6 +3360,10 @@ allocate_misc () marker_block_index++; } +#ifndef SYNC_INPUT + UNBLOCK_INPUT; +#endif + --total_free_markers; consing_since_gc += sizeof (union Lisp_Misc); misc_objects_consed++; @@ -3384,8 +3512,7 @@ memory_full () /* This used to call error, but if we've run out of memory, we could get infinite recursion trying to build the string. */ - while (1) - Fsignal (Qnil, Vmemory_signal_data); + xsignal (Qnil, Vmemory_signal_data); } /* If we released our reserve (due to running out of memory), @@ -4481,10 +4608,116 @@ mark_stack () #endif } - #endif /* GC_MARK_STACK != 0 */ +/* Determine whether it is safe to access memory at address P. */ +int +valid_pointer_p (p) + void *p; +{ +#ifdef WINDOWSNT + return w32_valid_pointer_p (p, 16); +#else + int fd; + + /* Obviously, we cannot just access it (we would SEGV trying), so we + trick the o/s to tell us whether p is a valid pointer. + Unfortunately, we cannot use NULL_DEVICE here, as emacs_write may + not validate p in that case. */ + + if ((fd = emacs_open ("__Valid__Lisp__Object__", O_CREAT | O_WRONLY | O_TRUNC, 0666)) >= 0) + { + int valid = (emacs_write (fd, (char *)p, 16) == 16); + emacs_close (fd); + unlink ("__Valid__Lisp__Object__"); + return valid; + } + + return -1; +#endif +} + +/* Return 1 if OBJ is a valid lisp object. + Return 0 if OBJ is NOT a valid lisp object. + Return -1 if we cannot validate OBJ. + This function can be quite slow, + so it should only be used in code for manual debugging. */ + +int +valid_lisp_object_p (obj) + Lisp_Object obj; +{ + void *p; +#if GC_MARK_STACK + struct mem_node *m; +#endif + + if (INTEGERP (obj)) + return 1; + + p = (void *) XPNTR (obj); + if (PURE_POINTER_P (p)) + return 1; + +#if !GC_MARK_STACK + return valid_pointer_p (p); +#else + + m = mem_find (p); + + if (m == MEM_NIL) + { + int valid = valid_pointer_p (p); + if (valid <= 0) + return valid; + + if (SUBRP (obj)) + return 1; + + return 0; + } + + switch (m->type) + { + case MEM_TYPE_NON_LISP: + return 0; + + case MEM_TYPE_BUFFER: + return live_buffer_p (m, p); + + case MEM_TYPE_CONS: + return live_cons_p (m, p); + + case MEM_TYPE_STRING: + return live_string_p (m, p); + + case MEM_TYPE_MISC: + return live_misc_p (m, p); + + case MEM_TYPE_SYMBOL: + return live_symbol_p (m, p); + + case MEM_TYPE_FLOAT: + return live_float_p (m, p); + + case MEM_TYPE_VECTOR: + case MEM_TYPE_PROCESS: + case MEM_TYPE_HASH_TABLE: + case MEM_TYPE_FRAME: + case MEM_TYPE_WINDOW: + return live_vector_p (m, p); + + default: + break; + } + + return 0; +#endif +} + + + /*********************************************************************** Pure Storage Management @@ -4492,10 +4725,7 @@ mark_stack () /* Allocate room for SIZE bytes from pure Lisp storage and return a pointer to it. TYPE is the Lisp type for which the memory is - allocated. TYPE < 0 means it's not used for a Lisp object. - - If store_pure_type_info is set and TYPE is >= 0, the type of - the allocated object is recorded in pure_types. */ + allocated. TYPE < 0 means it's not used for a Lisp object. */ static POINTER_TYPE * pure_alloc (size, type) @@ -4520,8 +4750,21 @@ pure_alloc (size, type) #endif again: - result = ALIGN (purebeg + pure_bytes_used, alignment); - pure_bytes_used = ((char *)result - (char *)purebeg) + size; + if (type >= 0) + { + /* Allocate space for a Lisp object from the beginning of the free + space with taking account of alignment. */ + result = ALIGN (purebeg + pure_bytes_used_lisp, alignment); + pure_bytes_used_lisp = ((char *)result - (char *)purebeg) + size; + } + else + { + /* Allocate space for a non-Lisp object from the end of the free + space. */ + pure_bytes_used_non_lisp += size; + result = purebeg + pure_size - pure_bytes_used_non_lisp; + } + pure_bytes_used = pure_bytes_used_lisp + pure_bytes_used_non_lisp; if (pure_bytes_used <= pure_size) return result; @@ -4533,6 +4776,7 @@ pure_alloc (size, type) pure_size = 10000; pure_bytes_used_before_overflow += pure_bytes_used - size; pure_bytes_used = 0; + pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0; goto again; } @@ -4543,11 +4787,78 @@ void check_pure_size () { if (pure_bytes_used_before_overflow) - message ("Pure Lisp storage overflow (approx. %d bytes needed)", + message ("emacs:0:Pure Lisp storage overflow (approx. %d bytes needed)", (int) (pure_bytes_used + pure_bytes_used_before_overflow)); } +/* Find the byte sequence {DATA[0], ..., DATA[NBYTES-1], '\0'} from + the non-Lisp data pool of the pure storage, and return its start + address. Return NULL if not found. */ + +static char * +find_string_data_in_pure (data, nbytes) + char *data; + int nbytes; +{ + int i, skip, bm_skip[256], last_char_skip, infinity, start, start_max; + unsigned char *p; + char *non_lisp_beg; + + if (pure_bytes_used_non_lisp < nbytes + 1) + return NULL; + + /* Set up the Boyer-Moore table. */ + skip = nbytes + 1; + for (i = 0; i < 256; i++) + bm_skip[i] = skip; + + p = (unsigned char *) data; + while (--skip > 0) + bm_skip[*p++] = skip; + + last_char_skip = bm_skip['\0']; + + non_lisp_beg = purebeg + pure_size - pure_bytes_used_non_lisp; + start_max = pure_bytes_used_non_lisp - (nbytes + 1); + + /* See the comments in the function `boyer_moore' (search.c) for the + use of `infinity'. */ + infinity = pure_bytes_used_non_lisp + 1; + bm_skip['\0'] = infinity; + + p = (unsigned char *) non_lisp_beg + nbytes; + start = 0; + do + { + /* Check the last character (== '\0'). */ + do + { + start += bm_skip[*(p + start)]; + } + while (start <= start_max); + + if (start < infinity) + /* Couldn't find the last character. */ + return NULL; + + /* No less than `infinity' means we could find the last + character at `p[start - infinity]'. */ + start -= infinity; + + /* Check the remaining characters. */ + if (memcmp (data, non_lisp_beg + start, nbytes) == 0) + /* Found. */ + return non_lisp_beg + start; + + start += last_char_skip; + } + while (start <= start_max); + + return NULL; +} + + /* Return a string allocated in pure space. DATA is a buffer holding NCHARS characters, and NBYTES bytes of string data. MULTIBYTE non-zero means make the result string multibyte. @@ -4566,11 +4877,15 @@ make_pure_string (data, nchars, nbytes, multibyte) struct Lisp_String *s; s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String); - s->data = (unsigned char *) pure_alloc (nbytes + 1, -1); + s->data = find_string_data_in_pure (data, nbytes); + if (s->data == NULL) + { + s->data = (unsigned char *) pure_alloc (nbytes + 1, -1); + bcopy (data, s->data, nbytes); + s->data[nbytes] = '\0'; + } s->size = nchars; s->size_byte = multibyte ? nbytes : -1; - bcopy (data, s->data, nbytes); - s->data[nbytes] = '\0'; s->intervals = NULL_INTERVAL; XSETSTRING (string, s); return string; @@ -4630,7 +4945,7 @@ make_pure_vector (len) DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, - doc: /* Make a copy of OBJECT in pure storage. + doc: /* Make a copy of object OBJ in pure storage. Recursively copies contents of vectors and cons cells. Does not copy symbols. Copies strings without text properties. */) (obj) @@ -4964,7 +5279,7 @@ returns nil, because real GC can't be done. */) total += total_floats * sizeof (struct Lisp_Float); total += total_intervals * sizeof (struct interval); total += total_strings * sizeof (struct Lisp_String); - + gc_relative_threshold = total * XFLOAT_DATA (Vgc_cons_percentage); } else @@ -5371,6 +5686,10 @@ mark_object (arg) if (size & PSEUDOVECTOR_FLAG) size &= PSEUDOVECTOR_SIZE_MASK; + /* Note that this size is not the memory-footprint size, but only + the number of Lisp_Object fields that we should trace. + The distinction is used e.g. by Lisp_Process which places extra + non-Lisp_Object fields at the end of the structure. */ for (i = 0; i < size; i++) /* and then mark its elements */ mark_object (ptr->contents[i]); } @@ -5491,14 +5810,14 @@ mark_object (arg) CHECK_ALLOCATED_AND_LIVE (live_cons_p); CONS_MARK (ptr); /* If the cdr is nil, avoid recursion for the car. */ - if (EQ (ptr->cdr, Qnil)) + if (EQ (ptr->u.cdr, Qnil)) { obj = ptr->car; cdr_count = 0; goto loop; } mark_object (ptr->car); - obj = ptr->cdr; + obj = ptr->u.cdr; cdr_count++; if (cdr_count == mark_object_loop_halt) abort (); @@ -5645,7 +5964,7 @@ gc_sweep () if (!CONS_MARKED_P (&cblk->conses[i])) { this_free++; - *(struct Lisp_Cons **)&cblk->conses[i].cdr = cons_free_list; + cblk->conses[i].u.chain = cons_free_list; cons_free_list = &cblk->conses[i]; #if GC_MARK_STACK cons_free_list->car = Vdead; @@ -5664,7 +5983,7 @@ gc_sweep () { *cprev = cblk->next; /* Unhook from the free list. */ - cons_free_list = *(struct Lisp_Cons **) &cblk->conses[0].cdr; + cons_free_list = cblk->conses[0].u.chain; lisp_align_free (cblk); n_cons_blocks--; } @@ -5695,7 +6014,7 @@ gc_sweep () if (!FLOAT_MARKED_P (&fblk->floats[i])) { this_free++; - *(struct Lisp_Float **)&fblk->floats[i].data = float_free_list; + fblk->floats[i].u.chain = float_free_list; float_free_list = &fblk->floats[i]; } else @@ -5711,7 +6030,7 @@ gc_sweep () { *fprev = fblk->next; /* Unhook from the free list. */ - float_free_list = *(struct Lisp_Float **) &fblk->floats[0].data; + float_free_list = fblk->floats[0].u.chain; lisp_align_free (fblk); n_float_blocks--; } @@ -5799,7 +6118,7 @@ gc_sweep () if (!sym->gcmarkbit && !pure_p) { - *(struct Lisp_Symbol **) &sym->value = symbol_free_list; + sym->next = symbol_free_list; symbol_free_list = sym; #if GC_MARK_STACK symbol_free_list->function = Vdead; @@ -5823,7 +6142,7 @@ gc_sweep () { *sprev = sblk->next; /* Unhook from the free list. */ - symbol_free_list = *(struct Lisp_Symbol **)&sblk->symbols[0].value; + symbol_free_list = sblk->symbols[0].next; lisp_free (sblk); n_symbol_blocks--; } @@ -6021,6 +6340,7 @@ init_alloc_once () purebeg = PUREBEG; pure_size = PURESIZE; pure_bytes_used = 0; + pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0; pure_bytes_used_before_overflow = 0; /* Initialize the list of free aligned blocks. */