X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d285b373956fbe32141a491729cd84f190413e17..ca70e62febbbb5315ba2908f5a1d189635039928:/src/alloc.c diff --git a/src/alloc.c b/src/alloc.c index 83007657e2..067dd7b753 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1,5 +1,5 @@ /* Storage allocation and gc for GNU Emacs Lisp interpreter. - Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000 + Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -26,12 +26,6 @@ Boston, MA 02111-1307, USA. */ #include -/* Define this temporarily to hunt a bug. If defined, the size of - strings is redundantly recorded in sdata structures so that it can - be compared to the sizes recorded in Lisp strings. */ - -#define GC_CHECK_STRING_BYTES 1 - /* GC_MALLOC_CHECK defined means perform validity checks of malloc'd memory. Can do this only if using gmalloc.c. */ @@ -45,6 +39,7 @@ Boston, MA 02111-1307, USA. */ #undef HIDE_LISP_IMPLEMENTATION #include "lisp.h" +#include "process.h" #include "intervals.h" #include "puresize.h" #include "buffer.h" @@ -85,9 +80,6 @@ extern __malloc_size_t __malloc_extra_blocks; #endif /* not DOUG_LEA_MALLOC */ -#define max(A,B) ((A) > (B) ? (A) : (B)) -#define min(A,B) ((A) < (B) ? (A) : (B)) - /* Macro to verify that storage intended for Lisp objects is not out of range to fit in the space for a pointer. ADDRESS is the start of the block, and SIZE @@ -130,18 +122,18 @@ int consing_since_gc; /* Count the amount of consing of various sorts of space. */ -int cons_cells_consed; -int floats_consed; -int vector_cells_consed; -int symbols_consed; -int string_chars_consed; -int misc_objects_consed; -int intervals_consed; -int strings_consed; +EMACS_INT cons_cells_consed; +EMACS_INT floats_consed; +EMACS_INT vector_cells_consed; +EMACS_INT symbols_consed; +EMACS_INT string_chars_consed; +EMACS_INT misc_objects_consed; +EMACS_INT intervals_consed; +EMACS_INT strings_consed; /* Number of bytes of consing since GC before another GC should be done. */ -int gc_cons_threshold; +EMACS_INT gc_cons_threshold; /* Nonzero during GC. */ @@ -163,8 +155,8 @@ int malloc_sbrk_unused; /* Two limits controlling how much undo information to keep. */ -int undo_limit; -int undo_strong_limit; +EMACS_INT undo_limit; +EMACS_INT undo_strong_limit; /* Number of live and free conses etc. */ @@ -196,33 +188,34 @@ Lisp_Object Vpurify_flag; EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {0,}; #define PUREBEG (char *) pure -#else /* not HAVE_SHM */ +#else /* HAVE_SHM */ #define pure PURE_SEG_BITS /* Use shared memory segment */ #define PUREBEG (char *)PURE_SEG_BITS -/* This variable is used only by the XPNTR macro when HAVE_SHM is - defined. If we used the PURESIZE macro directly there, that would - make most of Emacs dependent on puresize.h, which we don't want - - you should be able to change that without too much recompilation. - So map_in_data initializes pure_size, and the dependencies work - out. */ +#endif /* HAVE_SHM */ + +/* Pointer to the pure area, and its size. */ -EMACS_INT pure_size; +static char *purebeg; +static size_t pure_size; -#endif /* not HAVE_SHM */ +/* Number of bytes of pure storage used before pure storage overflowed. + If this is non-zero, this implies that an overflow occurred. */ + +static size_t pure_bytes_used_before_overflow; /* Value is non-zero if P points into pure space. */ #define PURE_POINTER_P(P) \ (((PNTR_COMPARISON_TYPE) (P) \ - < (PNTR_COMPARISON_TYPE) ((char *) pure + PURESIZE)) \ + < (PNTR_COMPARISON_TYPE) ((char *) purebeg + pure_size)) \ && ((PNTR_COMPARISON_TYPE) (P) \ - >= (PNTR_COMPARISON_TYPE) pure)) + >= (PNTR_COMPARISON_TYPE) purebeg)) /* Index in pure at which next pure object will be allocated.. */ -int pure_bytes_used; +EMACS_INT pure_bytes_used; /* If nonzero, this is a warning delivered by malloc and not yet displayed. */ @@ -251,6 +244,10 @@ int ignore_warnings; Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots; +/* Hook run after GC has finished. */ + +Lisp_Object Vpost_gc_hook, Qpost_gc_hook; + static void mark_buffer P_ ((Lisp_Object)); static void mark_kboards P_ ((void)); static void gc_sweep P_ ((void)); @@ -282,7 +279,14 @@ enum mem_type MEM_TYPE_MISC, MEM_TYPE_SYMBOL, MEM_TYPE_FLOAT, - MEM_TYPE_VECTOR + /* Keep the following vector-like types together, with + MEM_TYPE_WINDOW being the last, and MEM_TYPE_VECTOR the + first. Or change the code of live_vector_p, for instance. */ + MEM_TYPE_VECTOR, + MEM_TYPE_PROCESS, + MEM_TYPE_HASH_TABLE, + MEM_TYPE_FRAME, + MEM_TYPE_WINDOW }; #if GC_MARK_STACK || defined GC_MALLOC_CHECK @@ -349,15 +353,19 @@ Lisp_Object *stack_base; static struct mem_node *mem_root; +/* Lowest and highest known address in the heap. */ + +static void *min_heap_address, *max_heap_address; + /* Sentinel node of the tree. */ static struct mem_node mem_z; #define MEM_NIL &mem_z static POINTER_TYPE *lisp_malloc P_ ((size_t, enum mem_type)); +static struct Lisp_Vector *allocate_vectorlike P_ ((EMACS_INT, enum mem_type)); static void lisp_free P_ ((POINTER_TYPE *)); static void mark_stack P_ ((void)); -static void init_stack P_ ((Lisp_Object *)); static int live_vector_p P_ ((struct mem_node *, void *)); static int live_buffer_p P_ ((struct mem_node *, void *)); static int live_string_p P_ ((struct mem_node *, void *)); @@ -388,7 +396,7 @@ struct gcpro *gcprolist; /* Addresses of staticpro'd variables. */ -#define NSTATICS 1024 +#define NSTATICS 1280 Lisp_Object *staticvec[NSTATICS] = {0}; /* Index of next unused slot in staticvec. */ @@ -404,6 +412,7 @@ static POINTER_TYPE *pure_alloc P_ ((size_t, int)); #define ALIGN(SZ, ALIGNMENT) \ (((SZ) + (ALIGNMENT) - 1) & ~((ALIGNMENT) - 1)) + /************************************************************************ Malloc @@ -604,8 +613,11 @@ lisp_malloc (nbytes, type) struct buffer * allocate_buffer () { - return (struct buffer *) lisp_malloc (sizeof (struct buffer), - MEM_TYPE_BUFFER); + struct buffer *b + = (struct buffer *) lisp_malloc (sizeof (struct buffer), + MEM_TYPE_BUFFER); + VALIDATE_LISP_STORAGE (b, sizeof *b); + return b; } @@ -960,7 +972,7 @@ mark_interval_tree (tree) a cast. */ XMARK (tree->up.obj); - traverse_intervals (tree, 1, 0, mark_interval, Qnil); + traverse_intervals_noorder (tree, mark_interval, Qnil); } @@ -1008,7 +1020,7 @@ make_number (n) /* Lisp_Strings are allocated in string_block structures. When a new string_block is allocated, all the Lisp_Strings it contains are - added to a free-list stiing_free_list. When a new Lisp_String is + added to a free-list string_free_list. When a new Lisp_String is needed, it is taken from that list. During the sweep phase of GC, string_blocks that are entirely free are freed, except two which we keep. @@ -1201,50 +1213,84 @@ init_strings () #ifdef GC_CHECK_STRING_BYTES -/* Check validity of all live Lisp strings' string_bytes member. - Used for hunting a bug. */ - static int check_string_bytes_count; +void check_string_bytes P_ ((int)); +void check_sblock P_ ((struct sblock *)); + +#define CHECK_STRING_BYTES(S) STRING_BYTES (S) + + +/* Like GC_STRING_BYTES, but with debugging check. */ + +int +string_bytes (s) + struct Lisp_String *s; +{ + int nbytes = (s->size_byte < 0 ? s->size : s->size_byte) & ~MARKBIT; + if (!PURE_POINTER_P (s) + && s->data + && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s))) + abort (); + return nbytes; +} + +/* Check validity Lisp strings' string_bytes member in B. */ + void -check_string_bytes () +check_sblock (b) + struct sblock *b; { - struct sblock *b; - - for (b = large_sblocks; b; b = b->next) - { - struct Lisp_String *s = b->first_data.string; - if (s && GC_STRING_BYTES (s) != SDATA_NBYTES (SDATA_OF_STRING (s))) - abort (); - } + struct sdata *from, *end, *from_end; - for (b = oldest_sblock; b; b = b->next) + end = b->next_free; + + for (from = &b->first_data; from < end; from = from_end) { - struct sdata *from, *end, *from_end; + /* Compute the next FROM here because copying below may + overwrite data we need to compute it. */ + int nbytes; - end = b->next_free; + /* Check that the string size recorded in the string is the + same as the one recorded in the sdata structure. */ + if (from->string) + CHECK_STRING_BYTES (from->string); - for (from = &b->first_data; from < end; from = from_end) - { - /* Compute the next FROM here because copying below may - overwrite data we need to compute it. */ - int nbytes; + if (from->string) + nbytes = GC_STRING_BYTES (from->string); + else + nbytes = SDATA_NBYTES (from); + + nbytes = SDATA_SIZE (nbytes); + from_end = (struct sdata *) ((char *) from + nbytes); + } +} - /* Check that the string size recorded in the string is the - same as the one recorded in the sdata structure. */ - if (from->string - && GC_STRING_BYTES (from->string) != SDATA_NBYTES (from)) - abort (); - - if (from->string) - nbytes = GC_STRING_BYTES (from->string); - else - nbytes = SDATA_NBYTES (from); - - nbytes = SDATA_SIZE (nbytes); - from_end = (struct sdata *) ((char *) from + nbytes); + +/* Check validity of Lisp strings' string_bytes member. ALL_P + non-zero means check all strings, otherwise check only most + recently allocated strings. Used for hunting a bug. */ + +void +check_string_bytes (all_p) + int all_p; +{ + if (all_p) + { + struct sblock *b; + + for (b = large_sblocks; b; b = b->next) + { + struct Lisp_String *s = b->first_data.string; + if (s) + CHECK_STRING_BYTES (s); } + + for (b = oldest_sblock; b; b = b->next) + check_sblock (b); } + else + check_sblock (current_sblock); } #endif /* GC_CHECK_STRING_BYTES */ @@ -1294,12 +1340,21 @@ allocate_string () consing_since_gc += sizeof *s; #ifdef GC_CHECK_STRING_BYTES - if (!noninteractive && ++check_string_bytes_count == 50) + if (!noninteractive +#ifdef macintosh + && current_sblock +#endif + ) { - check_string_bytes_count = 0; - check_string_bytes (); + if (++check_string_bytes_count == 200) + { + check_string_bytes_count = 0; + check_string_bytes (1); + } + else + check_string_bytes (0); } -#endif +#endif /* GC_CHECK_STRING_BYTES */ return s; } @@ -1604,17 +1659,17 @@ compact_small_strings () DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0, - "Return a newly created string of length LENGTH, with each element being INIT.\n\ -Both LENGTH and INIT must be numbers.") - (length, init) + doc: /* Return a newly created string of length LENGTH, with each element being INIT. +Both LENGTH and INIT must be numbers. */) + (length, init) Lisp_Object length, init; { register Lisp_Object val; register unsigned char *p, *end; int c, nbytes; - CHECK_NATNUM (length, 0); - CHECK_NUMBER (init, 1); + CHECK_NATNUM (length); + CHECK_NUMBER (init); c = XINT (init); if (SINGLE_BYTE_CHAR_P (c)) @@ -1648,9 +1703,9 @@ Both LENGTH and INIT must be numbers.") DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0, - "Return a new bool-vector of length LENGTH, using INIT for as each element.\n\ -LENGTH must be a number. INIT matters only in whether it is t or nil.") - (length, init) + doc: /* Return a new bool-vector of length LENGTH, using INIT for as each element. +LENGTH must be a number. INIT matters only in whether it is t or nil. */) + (length, init) Lisp_Object length, init; { register Lisp_Object val; @@ -1658,7 +1713,7 @@ LENGTH must be a number. INIT matters only in whether it is t or nil.") int real_init, i; int length_in_chars, length_in_elts, bits_per_value; - CHECK_NATNUM (length, 0); + CHECK_NATNUM (length); bits_per_value = sizeof (EMACS_INT) * BITS_PER_CHAR; @@ -1863,7 +1918,7 @@ int n_float_blocks; struct Lisp_Float *float_free_list; -/* Initialze float allocation. */ +/* Initialize float allocation. */ void init_float () @@ -2002,8 +2057,8 @@ free_cons (ptr) DEFUN ("cons", Fcons, Scons, 2, 2, 0, - "Create a new cons, give it CAR and CDR as components, and return it.") - (car, cdr) + doc: /* Create a new cons, give it CAR and CDR as components, and return it. */) + (car, cdr) Lisp_Object car, cdr; { register Lisp_Object val; @@ -2031,8 +2086,8 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, XSETCONS (val, &cons_block->conses[cons_block_index++]); } - XCAR (val) = car; - XCDR (val) = cdr; + XSETCAR (val, car); + XSETCDR (val, cdr); consing_since_gc += sizeof (struct Lisp_Cons); cons_cells_consed++; return val; @@ -2075,9 +2130,10 @@ list5 (arg1, arg2, arg3, arg4, arg5) DEFUN ("list", Flist, Slist, 0, MANY, 0, - "Return a newly created list with specified arguments as elements.\n\ -Any number of arguments, even zero arguments, are allowed.") - (nargs, args) + doc: /* Return a newly created list with specified arguments as elements. +Any number of arguments, even zero arguments, are allowed. +usage: (list &rest OBJECTS) */) + (nargs, args) int nargs; register Lisp_Object *args; { @@ -2094,19 +2150,49 @@ Any number of arguments, even zero arguments, are allowed.") DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, - "Return a newly created list of length LENGTH, with each element being INIT.") - (length, init) + doc: /* Return a newly created list of length LENGTH, with each element being INIT. */) + (length, init) register Lisp_Object length, init; { register Lisp_Object val; register int size; - CHECK_NATNUM (length, 0); + CHECK_NATNUM (length); size = XFASTINT (length); val = Qnil; - while (size-- > 0) - val = Fcons (init, val); + while (size > 0) + { + val = Fcons (init, val); + --size; + + if (size > 0) + { + val = Fcons (init, val); + --size; + + if (size > 0) + { + val = Fcons (init, val); + --size; + + if (size > 0) + { + val = Fcons (init, val); + --size; + + if (size > 0) + { + val = Fcons (init, val); + --size; + } + } + } + } + + QUIT; + } + return val; } @@ -2128,9 +2214,10 @@ int n_vectors; /* Value is a pointer to a newly allocated Lisp_Vector structure with room for LEN Lisp_Objects. */ -struct Lisp_Vector * -allocate_vectorlike (len) +static struct Lisp_Vector * +allocate_vectorlike (len, type) EMACS_INT len; + enum mem_type type; { struct Lisp_Vector *p; size_t nbytes; @@ -2143,7 +2230,7 @@ allocate_vectorlike (len) #endif nbytes = sizeof *p + (len - 1) * sizeof p->contents[0]; - p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTOR); + p = (struct Lisp_Vector *) lisp_malloc (nbytes, type); #ifdef DOUG_LEA_MALLOC /* Back to a reasonable maximum of mmap'ed areas. */ @@ -2161,10 +2248,98 @@ allocate_vectorlike (len) } +/* Allocate a vector with NSLOTS slots. */ + +struct Lisp_Vector * +allocate_vector (nslots) + EMACS_INT nslots; +{ + struct Lisp_Vector *v = allocate_vectorlike (nslots, MEM_TYPE_VECTOR); + v->size = nslots; + return v; +} + + +/* Allocate other vector-like structures. */ + +struct Lisp_Hash_Table * +allocate_hash_table () +{ + EMACS_INT len = VECSIZE (struct Lisp_Hash_Table); + struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_HASH_TABLE); + EMACS_INT i; + + v->size = len; + for (i = 0; i < len; ++i) + v->contents[i] = Qnil; + + return (struct Lisp_Hash_Table *) v; +} + + +struct window * +allocate_window () +{ + EMACS_INT len = VECSIZE (struct window); + struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_WINDOW); + EMACS_INT i; + + for (i = 0; i < len; ++i) + v->contents[i] = Qnil; + v->size = len; + + return (struct window *) v; +} + + +struct frame * +allocate_frame () +{ + EMACS_INT len = VECSIZE (struct frame); + struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_FRAME); + EMACS_INT i; + + for (i = 0; i < len; ++i) + v->contents[i] = make_number (0); + v->size = len; + return (struct frame *) v; +} + + +struct Lisp_Process * +allocate_process () +{ + EMACS_INT len = VECSIZE (struct Lisp_Process); + struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_PROCESS); + EMACS_INT i; + + for (i = 0; i < len; ++i) + v->contents[i] = Qnil; + v->size = len; + + return (struct Lisp_Process *) v; +} + + +struct Lisp_Vector * +allocate_other_vector (len) + EMACS_INT len; +{ + struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_VECTOR); + EMACS_INT i; + + for (i = 0; i < len; ++i) + v->contents[i] = Qnil; + v->size = len; + + return v; +} + + DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0, - "Return a newly created vector of length LENGTH, with each element being INIT.\n\ -See also the function `vector'.") - (length, init) + doc: /* Return a newly created vector of length LENGTH, with each element being INIT. +See also the function `vector'. */) + (length, init) register Lisp_Object length, init; { Lisp_Object vector; @@ -2172,11 +2347,10 @@ See also the function `vector'.") register int index; register struct Lisp_Vector *p; - CHECK_NATNUM (length, 0); + CHECK_NATNUM (length); sizei = XFASTINT (length); - p = allocate_vectorlike (sizei); - p->size = sizei; + p = allocate_vector (sizei); for (index = 0; index < sizei; index++) p->contents[index] = init; @@ -2186,18 +2360,18 @@ See also the function `vector'.") DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0, - "Return a newly created char-table, with purpose PURPOSE.\n\ -Each element is initialized to INIT, which defaults to nil.\n\ -PURPOSE should be a symbol which has a `char-table-extra-slots' property.\n\ -The property's value should be an integer between 0 and 10.") - (purpose, init) + doc: /* Return a newly created char-table, with purpose PURPOSE. +Each element is initialized to INIT, which defaults to nil. +PURPOSE should be a symbol which has a `char-table-extra-slots' property. +The property's value should be an integer between 0 and 10. */) + (purpose, init) register Lisp_Object purpose, init; { Lisp_Object vector; Lisp_Object n; - CHECK_SYMBOL (purpose, 1); + CHECK_SYMBOL (purpose); n = Fget (purpose, Qchar_table_extra_slots); - CHECK_NUMBER (n, 0); + CHECK_NUMBER (n); if (XINT (n) < 0 || XINT (n) > 10) args_out_of_range (n, Qnil); /* Add 2 to the size for the defalt and parent slots. */ @@ -2229,9 +2403,10 @@ make_sub_char_table (defalt) DEFUN ("vector", Fvector, Svector, 0, MANY, 0, - "Return a newly created vector with specified arguments as elements.\n\ -Any number of arguments, even zero arguments, are allowed.") - (nargs, args) + doc: /* Return a newly created vector with specified arguments as elements. +Any number of arguments, even zero arguments, are allowed. +usage: (vector &rest OBJECTS) */) + (nargs, args) register int nargs; Lisp_Object *args; { @@ -2249,12 +2424,13 @@ Any number of arguments, even zero arguments, are allowed.") DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0, - "Create a byte-code object with specified arguments as elements.\n\ -The arguments should be the arglist, bytecode-string, constant vector,\n\ -stack size, (optional) doc string, and (optional) interactive spec.\n\ -The first four arguments are required; at most six have any\n\ -significance.") - (nargs, args) + doc: /* Create a byte-code object with specified arguments as elements. +The arguments should be the arglist, bytecode-string, constant vector, +stack size, (optional) doc string, and (optional) interactive spec. +The first four arguments are required; at most six have any +significance. +usage: (make-byte-code &rest ELEMENTS) */) + (nargs, args) register int nargs; Lisp_Object *args; { @@ -2337,15 +2513,15 @@ init_symbol () DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, - "Return a newly allocated uninterned symbol whose name is NAME.\n\ -Its value and function definition are void, and its property list is nil.") - (name) + doc: /* Return a newly allocated uninterned symbol whose name is NAME. +Its value and function definition are void, and its property list is nil. */) + (name) Lisp_Object name; { register Lisp_Object val; register struct Lisp_Symbol *p; - CHECK_STRING (name, 0); + CHECK_STRING (name); if (symbol_free_list) { @@ -2370,11 +2546,13 @@ Its value and function definition are void, and its property list is nil.") p = XSYMBOL (val); p->name = XSTRING (name); - p->obarray = Qnil; p->plist = Qnil; p->value = Qunbound; p->function = Qunbound; - p->next = 0; + p->next = NULL; + p->interned = SYMBOL_UNINTERNED; + p->constant = 0; + p->indirect_variable = 0; consing_since_gc += sizeof (struct Lisp_Symbol); symbols_consed++; return val; @@ -2453,8 +2631,8 @@ allocate_misc () } DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, - "Return a newly allocated marker which does not point at any place.") - () + doc: /* Return a newly allocated marker which does not point at any place. */) + () { register Lisp_Object val; register struct Lisp_Marker *p; @@ -2533,6 +2711,17 @@ make_event_array (nargs, args) #if GC_MARK_STACK || defined GC_MALLOC_CHECK +/* Conservative C stack marking requires a method to identify possibly + live Lisp objects given a pointer value. We do this by keeping + track of blocks of Lisp data that are allocated in a red-black tree + (see also the comment of mem_node which is the type of nodes in + that tree). Function lisp_malloc adds information for an allocated + block to the red-black tree with calls to mem_insert, and function + lisp_free removes it with mem_delete. Functions live_string_p etc + call mem_find to lookup information about a given pointer in the + tree, and use that to determine if the pointer points to a Lisp + object or not. */ + /* Initialize this part of alloc.c. */ static void @@ -2555,6 +2744,9 @@ mem_find (start) { struct mem_node *p; + if (start < min_heap_address || start > max_heap_address) + return MEM_NIL; + /* Make the search always successful to speed up the loop below. */ mem_z.start = start; mem_z.end = (char *) start + 1; @@ -2577,6 +2769,11 @@ mem_insert (start, end, type) { struct mem_node *c, *parent, *x; + if (start < min_heap_address) + min_heap_address = start; + if (end > max_heap_address) + max_heap_address = end; + /* See where in the tree a node for START belongs. In this particular application, it shouldn't happen that a node is already present. For debugging purposes, let's check that. */ @@ -2937,7 +3134,8 @@ live_string_p (m, p) /* P must point to the start of a Lisp_String structure, and it must not be on the free-list. */ - return (offset % sizeof b->strings[0] == 0 + return (offset >= 0 + && offset % sizeof b->strings[0] == 0 && ((struct Lisp_String *) p)->data != NULL); } else @@ -2961,7 +3159,8 @@ live_cons_p (m, p) /* P must point to the start of a Lisp_Cons, not be one of the unused cells in the current cons block, and not be on the free-list. */ - return (offset % sizeof b->conses[0] == 0 + return (offset >= 0 + && offset % sizeof b->conses[0] == 0 && (b != cons_block || offset / sizeof b->conses[0] < cons_block_index) && !EQ (((struct Lisp_Cons *) p)->car, Vdead)); @@ -2987,7 +3186,8 @@ live_symbol_p (m, p) /* P must point to the start of a Lisp_Symbol, not be one of the unused cells in the current symbol block, and not be on the free-list. */ - return (offset % sizeof b->symbols[0] == 0 + return (offset >= 0 + && offset % sizeof b->symbols[0] == 0 && (b != symbol_block || offset / sizeof b->symbols[0] < symbol_block_index) && !EQ (((struct Lisp_Symbol *) p)->function, Vdead)); @@ -3013,7 +3213,8 @@ live_float_p (m, p) /* P must point to the start of a Lisp_Float, not be one of the unused cells in the current float block, and not be on the free-list. */ - return (offset % sizeof b->floats[0] == 0 + return (offset >= 0 + && offset % sizeof b->floats[0] == 0 && (b != float_block || offset / sizeof b->floats[0] < float_block_index) && !EQ (((struct Lisp_Float *) p)->type, Vdead)); @@ -3039,7 +3240,8 @@ live_misc_p (m, p) /* P must point to the start of a Lisp_Misc, not be one of the unused cells in the current misc block, and not be on the free-list. */ - return (offset % sizeof b->markers[0] == 0 + return (offset >= 0 + && offset % sizeof b->markers[0] == 0 && (b != marker_block || offset / sizeof b->markers[0] < marker_block_index) && ((union Lisp_Misc *) p)->u_marker.type != Lisp_Misc_Free); @@ -3057,7 +3259,9 @@ live_vector_p (m, p) struct mem_node *m; void *p; { - return m->type == MEM_TYPE_VECTOR && p == m->start; + return (p == m->start + && m->type >= MEM_TYPE_VECTOR + && m->type <= MEM_TYPE_WINDOW); } @@ -3109,7 +3313,7 @@ static int max_live, max_zombies; static double avg_live; DEFUN ("gc-status", Fgc_status, Sgc_status, 0, 0, "", - "Show information about live and zombie objects.") + doc: /* Show information about live and zombie objects. */) () { Lisp_Object args[7]; @@ -3209,14 +3413,123 @@ mark_maybe_object (obj) } } } + + +/* If P points to Lisp data, mark that as live if it isn't already + marked. */ + +static INLINE void +mark_maybe_pointer (p) + void *p; +{ + struct mem_node *m; + + /* Quickly rule out some values which can't point to Lisp data. We + assume that Lisp data is aligned on even addresses. */ + if ((EMACS_INT) p & 1) + return; + + m = mem_find (p); + if (m != MEM_NIL) + { + Lisp_Object obj = Qnil; + + switch (m->type) + { + case MEM_TYPE_NON_LISP: + /* Nothing to do; not a pointer to Lisp memory. */ + break; -/* Mark Lisp objects in the address range START..END. */ + case MEM_TYPE_BUFFER: + if (live_buffer_p (m, p) + && !XMARKBIT (((struct buffer *) p)->name)) + XSETVECTOR (obj, p); + break; + + case MEM_TYPE_CONS: + if (live_cons_p (m, p) + && !XMARKBIT (((struct Lisp_Cons *) p)->car)) + XSETCONS (obj, p); + break; + + case MEM_TYPE_STRING: + if (live_string_p (m, p) + && !STRING_MARKED_P ((struct Lisp_String *) p)) + XSETSTRING (obj, p); + break; + + case MEM_TYPE_MISC: + if (live_misc_p (m, p)) + { + Lisp_Object tem; + XSETMISC (tem, p); + + switch (XMISCTYPE (tem)) + { + case Lisp_Misc_Marker: + if (!XMARKBIT (XMARKER (tem)->chain)) + obj = tem; + break; + + case Lisp_Misc_Buffer_Local_Value: + case Lisp_Misc_Some_Buffer_Local_Value: + if (!XMARKBIT (XBUFFER_LOCAL_VALUE (tem)->realvalue)) + obj = tem; + break; + + case Lisp_Misc_Overlay: + if (!XMARKBIT (XOVERLAY (tem)->plist)) + obj = tem; + break; + } + } + break; + + case MEM_TYPE_SYMBOL: + if (live_symbol_p (m, p) + && !XMARKBIT (((struct Lisp_Symbol *) p)->plist)) + XSETSYMBOL (obj, p); + break; + + case MEM_TYPE_FLOAT: + if (live_float_p (m, p) + && !XMARKBIT (((struct Lisp_Float *) p)->type)) + XSETFLOAT (obj, p); + break; + + case MEM_TYPE_VECTOR: + case MEM_TYPE_PROCESS: + case MEM_TYPE_HASH_TABLE: + case MEM_TYPE_FRAME: + case MEM_TYPE_WINDOW: + if (live_vector_p (m, p)) + { + Lisp_Object tem; + XSETVECTOR (tem, p); + if (!GC_SUBRP (tem) + && !(XVECTOR (tem)->size & ARRAY_MARK_FLAG)) + obj = tem; + } + break; + + default: + abort (); + } + + if (!GC_NILP (obj)) + mark_object (&obj); + } +} + + +/* Mark Lisp objects referenced from the address range START..END. */ static void mark_memory (start, end) void *start, *end; { Lisp_Object *p; + void **pp; #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES nzombies = 0; @@ -3230,9 +3543,31 @@ mark_memory (start, end) start = end; end = tem; } - + + /* Mark Lisp_Objects. */ for (p = (Lisp_Object *) start; (void *) p < end; ++p) mark_maybe_object (*p); + + /* Mark Lisp data pointed to. This is necessary because, in some + situations, the C compiler optimizes Lisp objects away, so that + only a pointer to them remains. Example: + + DEFUN ("testme", Ftestme, Stestme, 0, 0, 0, "") + () + { + Lisp_Object obj = build_string ("test"); + struct Lisp_String *s = XSTRING (obj); + Fgarbage_collect (); + fprintf (stderr, "test `%s'\n", s->data); + return Qnil; + } + + Here, `obj' isn't really used, and the compiler optimizes it + away. The only reference to the life string is through the + pointer `s'. */ + + for (pp = (void **) start; (void *) pp < end; ++pp) + mark_maybe_pointer (*pp); } @@ -3250,7 +3585,7 @@ If you are a system-programmer, or can get the help of a local wizard\n\ who is, please take a look at the function mark_stack in alloc.c, and\n\ verify that the methods used are appropriate for your system.\n\ \n\ -Please mail the result to .\n\ +Please mail the result to .\n\ " #define SETJMP_WILL_NOT_WORK "\ @@ -3262,7 +3597,7 @@ solution for your system.\n\ \n\ Please take a look at the function mark_stack in alloc.c, and\n\ try to find a way to make it work on your system.\n\ -Please mail the result to .\n\ +Please mail the result to .\n\ " @@ -3399,6 +3734,7 @@ dump_zombies () static void mark_stack () { + int i; jmp_buf j; volatile int stack_grows_down_p = (char *) &j > (char *) stack_base; void *end; @@ -3434,17 +3770,11 @@ mark_stack () /* This assumes that the stack is a contiguous region in memory. If that's not the case, something has to be done here to iterate over the stack segments. */ -#if GC_LISP_OBJECT_ALIGNMENT == 1 - mark_memory (stack_base, end); - mark_memory ((char *) stack_base + 1, end); - mark_memory ((char *) stack_base + 2, end); - mark_memory ((char *) stack_base + 3, end); -#elif GC_LISP_OBJECT_ALIGNMENT == 2 - mark_memory (stack_base, end); - mark_memory ((char *) stack_base + 2, end); -#else - mark_memory (stack_base, end); +#ifndef GC_LISP_OBJECT_ALIGNMENT +#define GC_LISP_OBJECT_ALIGNMENT sizeof (Lisp_Object) #endif + for (i = 0; i < sizeof (Lisp_Object); i += GC_LISP_OBJECT_ALIGNMENT) + mark_memory ((char *) stack_base + i, end); #if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS check_gcpros (); @@ -3474,7 +3804,7 @@ pure_alloc (size, type) { size_t nbytes; POINTER_TYPE *result; - char *beg = PUREBEG; + char *beg = purebeg; /* Give Lisp_Floats an extra alignment. */ if (type == Lisp_Float) @@ -3489,8 +3819,17 @@ pure_alloc (size, type) } nbytes = ALIGN (size, sizeof (EMACS_INT)); - if (pure_bytes_used + nbytes > PURESIZE) - error ("Pure Lisp storage exhausted"); + + if (pure_bytes_used + nbytes > pure_size) + { + /* Don't allocate a large amount here, + because it might get mmap'd and then its address + might not be usable. */ + beg = purebeg = (char *) xmalloc (10000); + pure_size = 10000; + pure_bytes_used_before_overflow += pure_bytes_used; + pure_bytes_used = 0; + } result = (POINTER_TYPE *) (beg + pure_bytes_used); pure_bytes_used += nbytes; @@ -3498,6 +3837,17 @@ pure_alloc (size, type) } +/* Print a warning if PURESIZE is too small. */ + +void +check_pure_size () +{ + if (pure_bytes_used_before_overflow) + message ("Pure Lisp storage overflow (approx. %d bytes needed)", + (int) (pure_bytes_used + pure_bytes_used_before_overflow)); +} + + /* 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. @@ -3539,8 +3889,8 @@ pure_cons (car, cdr) p = (struct Lisp_Cons *) pure_alloc (sizeof *p, Lisp_Cons); XSETCONS (new, p); - XCAR (new) = Fpurecopy (car); - XCDR (new) = Fpurecopy (cdr); + XSETCAR (new, Fpurecopy (car)); + XSETCDR (new, Fpurecopy (cdr)); return new; } @@ -3580,10 +3930,10 @@ make_pure_vector (len) DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, - "Make a copy of OBJECT in pure storage.\n\ -Recursively copies contents of vectors and cons cells.\n\ -Does not copy symbols. Copies strings without text properties.") - (obj) + doc: /* Make a copy of OBJECT in pure storage. +Recursively copies contents of vectors and cons cells. +Does not copy symbols. Copies strings without text properties. */) + (obj) register Lisp_Object obj; { if (NILP (Vpurify_flag)) @@ -3671,27 +4021,23 @@ int inhibit_garbage_collection () { int count = specpdl_ptr - specpdl; - Lisp_Object number; int nbits = min (VALBITS, BITS_PER_INT); - XSETINT (number, ((EMACS_INT) 1 << (nbits - 1)) - 1); - - specbind (Qgc_cons_threshold, number); - + specbind (Qgc_cons_threshold, make_number (((EMACS_INT) 1 << (nbits - 1)) - 1)); return count; } DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", - "Reclaim storage for Lisp objects no longer needed.\n\ -Returns info on amount of space in use:\n\ - ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)\n\ - (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS\n\ - (USED-FLOATS . FREE-FLOATS) (USED-INTERVALS . FREE-INTERVALS)\n\ - (USED-STRINGS . FREE-STRINGS))\n\ -Garbage collection happens automatically if you cons more than\n\ -`gc-cons-threshold' bytes of Lisp data since previous garbage collection.") - () + doc: /* Reclaim storage for Lisp objects no longer needed. +Returns info on amount of space in use: + ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS) + (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS + (USED-FLOATS . FREE-FLOATS) (USED-INTERVALS . FREE-INTERVALS) + (USED-STRINGS . FREE-STRINGS)) +Garbage collection happens automatically if you cons more than +`gc-cons-threshold' bytes of Lisp data since previous garbage collection. */) + () { register struct gcpro *tail; register struct specbinding *bind; @@ -3702,6 +4048,12 @@ Garbage collection happens automatically if you cons more than\n\ register int i; int message_p; Lisp_Object total[8]; + int count = BINDING_STACK_SIZE (); + + /* Can't GC if pure storage overflowed because we can't determine + if something is a pure object or not. */ + if (pure_bytes_used_before_overflow) + return Qnil; /* In case user calls debug_print during GC, don't let that cause a recursive GC. */ @@ -3709,6 +4061,7 @@ Garbage collection happens automatically if you cons more than\n\ /* Save what's currently displayed in the echo area. */ message_p = push_message (); + record_unwind_protect (push_message_unwind, Qnil); /* Save a copy of the contents of the stack, for debugging. */ #if MAX_SAVE_STACK > 0 @@ -3754,6 +4107,24 @@ Garbage collection happens automatically if you cons more than\n\ nextb->undo_list = truncate_undo_list (nextb->undo_list, undo_limit, undo_strong_limit); + + /* Shrink buffer gaps, but skip indirect and dead buffers. */ + if (nextb->base_buffer == 0 && !NILP (nextb->name)) + { + /* If a buffer's gap size is more than 10% of the buffer + size, or larger than 2000 bytes, then shrink it + accordingly. Keep a minimum size of 20 bytes. */ + int size = min (2000, max (20, (nextb->text->z_byte / 10))); + + if (nextb->text->gap_size > size) + { + struct buffer *save_current = current_buffer; + current_buffer = nextb; + make_gap (-(nextb->text->gap_size - size)); + current_buffer = save_current; + } + } + nextb = nextb->next; } } @@ -3849,7 +4220,10 @@ Garbage collection happens automatically if you cons more than\n\ if (NILP (prev)) nextb->undo_list = tail = XCDR (tail); else - tail = XCDR (prev) = XCDR (tail); + { + tail = XCDR (tail); + XSETCDR (prev, tail); + } } else { @@ -3913,7 +4287,7 @@ Garbage collection happens automatically if you cons more than\n\ message1_nolog ("Garbage collecting...done"); } - pop_message (); + unbind_to (count, Qnil); total[0] = Fcons (make_number (total_conses), make_number (total_free_conses)); @@ -3946,6 +4320,13 @@ Garbage collection happens automatically if you cons more than\n\ } #endif + if (!NILP (Vpost_gc_hook)) + { + int count = inhibit_garbage_collection (); + safe_run_hooks (Qpost_gc_hook); + unbind_to (count, Qnil); + } + return Flist (sizeof total / sizeof *total, total); } @@ -4109,13 +4490,9 @@ mark_object (argptr) MARK_INTERVAL_TREE (ptr->intervals); MARK_STRING (ptr); #ifdef GC_CHECK_STRING_BYTES - { - /* Check that the string size recorded in the string is the - same as the one recorded in the sdata structure. */ - struct sdata *p = SDATA_OF_STRING (ptr); - if (GC_STRING_BYTES (ptr) != SDATA_NBYTES (p)) - abort (); - } + /* Check that the string size recorded in the string is the + same as the one recorded in the sdata structure. */ + CHECK_STRING_BYTES (ptr); #endif /* GC_CHECK_STRING_BYTES */ } break; @@ -4262,6 +4639,10 @@ mark_object (argptr) h->size |= ARRAY_MARK_FLAG; /* Mark contents. */ + /* Do not mark next_free or next_weak. + Being in the next_weak chain + should not keep the hash table alive. + No need to mark `count' since it is an integer. */ mark_object (&h->test); mark_object (&h->weak); mark_object (&h->rehash_size); @@ -4457,8 +4838,8 @@ mark_buffer (buf) && ! XMARKBIT (XCAR (ptr->car)) && GC_MARKERP (XCAR (ptr->car))) { - XMARK (XCAR (ptr->car)); - mark_object (&XCDR (ptr->car)); + XMARK (XCAR_AS_LVALUE (ptr->car)); + mark_object (&XCDR_AS_LVALUE (ptr->car)); } else mark_object (&ptr->car); @@ -4469,7 +4850,7 @@ mark_buffer (buf) break; } - mark_object (&XCDR (tail)); + mark_object (&XCDR_AS_LVALUE (tail)); } else mark_object (&buffer->undo_list); @@ -4511,6 +4892,7 @@ mark_kboards () mark_object (&kb->Vsystem_key_alist); mark_object (&kb->system_key_syms); mark_object (&kb->Vdefault_minibuffer_frame); + mark_object (&kb->echo_string); } } @@ -4606,6 +4988,10 @@ gc_sweep () sweep_weak_hash_tables (); sweep_strings (); +#ifdef GC_CHECK_STRING_BYTES + if (!noninteractive) + check_string_bytes (1); +#endif /* Put all unmarked conses on free list */ { @@ -4774,6 +5160,9 @@ gc_sweep () for (; sym < end; ++sym) { + /* Check if the symbol was created during loadup. In such a case + it might be pointed to by pure bytecode which we don't trace, + so we conservatively assume that it is live. */ int pure_p = PURE_POINTER_P (sym->name); if (!XMARKBIT (sym->plist) && !pure_p) @@ -4955,6 +5344,11 @@ gc_sweep () prev = vector, vector = vector->next; } } + +#ifdef GC_CHECK_STRING_BYTES + if (!noninteractive) + check_string_bytes (1); +#endif } @@ -4963,10 +5357,10 @@ gc_sweep () /* Debugging aids. */ DEFUN ("memory-limit", Fmemory_limit, Smemory_limit, 0, 0, 0, - "Return the address of the last byte Emacs has allocated, divided by 1024.\n\ -This may be helpful in debugging Emacs's memory usage.\n\ -We divide the value by 1024 to make sure it fits in a Lisp integer.") - () + doc: /* Return the address of the last byte Emacs has allocated, divided by 1024. +This may be helpful in debugging Emacs's memory usage. +We divide the value by 1024 to make sure it fits in a Lisp integer. */) + () { Lisp_Object end; @@ -4976,38 +5370,30 @@ We divide the value by 1024 to make sure it fits in a Lisp integer.") } DEFUN ("memory-use-counts", Fmemory_use_counts, Smemory_use_counts, 0, 0, 0, - "Return a list of counters that measure how much consing there has been.\n\ -Each of these counters increments for a certain kind of object.\n\ -The counters wrap around from the largest positive integer to zero.\n\ -Garbage collection does not decrease them.\n\ -The elements of the value are as follows:\n\ - (CONSES FLOATS VECTOR-CELLS SYMBOLS STRING-CHARS MISCS INTERVALS STRINGS)\n\ -All are in units of 1 = one object consed\n\ -except for VECTOR-CELLS and STRING-CHARS, which count the total length of\n\ -objects consed.\n\ -MISCS include overlays, markers, and some internal types.\n\ -Frames, windows, buffers, and subprocesses count as vectors\n\ - (but the contents of a buffer's text do not count here).") - () + doc: /* Return a list of counters that measure how much consing there has been. +Each of these counters increments for a certain kind of object. +The counters wrap around from the largest positive integer to zero. +Garbage collection does not decrease them. +The elements of the value are as follows: + (CONSES FLOATS VECTOR-CELLS SYMBOLS STRING-CHARS MISCS INTERVALS STRINGS) +All are in units of 1 = one object consed +except for VECTOR-CELLS and STRING-CHARS, which count the total length of +objects consed. +MISCS include overlays, markers, and some internal types. +Frames, windows, buffers, and subprocesses count as vectors + (but the contents of a buffer's text do not count here). */) + () { Lisp_Object consed[8]; - XSETINT (consed[0], - cons_cells_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); - XSETINT (consed[1], - floats_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); - XSETINT (consed[2], - vector_cells_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); - XSETINT (consed[3], - symbols_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); - XSETINT (consed[4], - string_chars_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); - XSETINT (consed[5], - misc_objects_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); - XSETINT (consed[6], - intervals_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); - XSETINT (consed[7], - strings_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); + consed[0] = make_number (min (MOST_POSITIVE_FIXNUM, cons_cells_consed)); + consed[1] = make_number (min (MOST_POSITIVE_FIXNUM, floats_consed)); + consed[2] = make_number (min (MOST_POSITIVE_FIXNUM, vector_cells_consed)); + consed[3] = make_number (min (MOST_POSITIVE_FIXNUM, symbols_consed)); + consed[4] = make_number (min (MOST_POSITIVE_FIXNUM, string_chars_consed)); + consed[5] = make_number (min (MOST_POSITIVE_FIXNUM, misc_objects_consed)); + consed[6] = make_number (min (MOST_POSITIVE_FIXNUM, intervals_consed)); + consed[7] = make_number (min (MOST_POSITIVE_FIXNUM, strings_consed)); return Flist (8, consed); } @@ -5030,14 +5416,16 @@ void init_alloc_once () { /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */ + purebeg = PUREBEG; + pure_size = PURESIZE; pure_bytes_used = 0; + pure_bytes_used_before_overflow = 0; + #if GC_MARK_STACK || defined GC_MALLOC_CHECK mem_init (); Vdead = make_pure_string ("DEAD", 4, 4, 0); #endif -#ifdef HAVE_SHM - pure_size = PURESIZE; -#endif + all_vectors = 0; ignore_warnings = 1; #ifdef DOUG_LEA_MALLOC @@ -5088,63 +5476,71 @@ void syms_of_alloc () { DEFVAR_INT ("gc-cons-threshold", &gc_cons_threshold, - "*Number of bytes of consing between garbage collections.\n\ -Garbage collection can happen automatically once this many bytes have been\n\ -allocated since the last garbage collection. All data types count.\n\n\ -Garbage collection happens automatically only when `eval' is called.\n\n\ -By binding this temporarily to a large number, you can effectively\n\ -prevent garbage collection during a part of the program."); + doc: /* *Number of bytes of consing between garbage collections. +Garbage collection can happen automatically once this many bytes have been +allocated since the last garbage collection. All data types count. + +Garbage collection happens automatically only when `eval' is called. + +By binding this temporarily to a large number, you can effectively +prevent garbage collection during a part of the program. */); DEFVAR_INT ("pure-bytes-used", &pure_bytes_used, - "Number of bytes of sharable Lisp data allocated so far."); + doc: /* Number of bytes of sharable Lisp data allocated so far. */); DEFVAR_INT ("cons-cells-consed", &cons_cells_consed, - "Number of cons cells that have been consed so far."); + doc: /* Number of cons cells that have been consed so far. */); DEFVAR_INT ("floats-consed", &floats_consed, - "Number of floats that have been consed so far."); + doc: /* Number of floats that have been consed so far. */); DEFVAR_INT ("vector-cells-consed", &vector_cells_consed, - "Number of vector cells that have been consed so far."); + doc: /* Number of vector cells that have been consed so far. */); DEFVAR_INT ("symbols-consed", &symbols_consed, - "Number of symbols that have been consed so far."); + doc: /* Number of symbols that have been consed so far. */); DEFVAR_INT ("string-chars-consed", &string_chars_consed, - "Number of string characters that have been consed so far."); + doc: /* Number of string characters that have been consed so far. */); DEFVAR_INT ("misc-objects-consed", &misc_objects_consed, - "Number of miscellaneous objects that have been consed so far."); + doc: /* Number of miscellaneous objects that have been consed so far. */); DEFVAR_INT ("intervals-consed", &intervals_consed, - "Number of intervals that have been consed so far."); + doc: /* Number of intervals that have been consed so far. */); DEFVAR_INT ("strings-consed", &strings_consed, - "Number of strings that have been consed so far."); + doc: /* Number of strings that have been consed so far. */); DEFVAR_LISP ("purify-flag", &Vpurify_flag, - "Non-nil means loading Lisp code in order to dump an executable.\n\ -This means that certain objects should be allocated in shared (pure) space."); + doc: /* Non-nil means loading Lisp code in order to dump an executable. +This means that certain objects should be allocated in shared (pure) space. */); DEFVAR_INT ("undo-limit", &undo_limit, - "Keep no more undo information once it exceeds this size.\n\ -This limit is applied when garbage collection happens.\n\ -The size is counted as the number of bytes occupied,\n\ -which includes both saved text and other data."); + doc: /* Keep no more undo information once it exceeds this size. +This limit is applied when garbage collection happens. +The size is counted as the number of bytes occupied, +which includes both saved text and other data. */); undo_limit = 20000; DEFVAR_INT ("undo-strong-limit", &undo_strong_limit, - "Don't keep more than this much size of undo information.\n\ -A command which pushes past this size is itself forgotten.\n\ -This limit is applied when garbage collection happens.\n\ -The size is counted as the number of bytes occupied,\n\ -which includes both saved text and other data."); + doc: /* Don't keep more than this much size of undo information. +A command which pushes past this size is itself forgotten. +This limit is applied when garbage collection happens. +The size is counted as the number of bytes occupied, +which includes both saved text and other data. */); undo_strong_limit = 30000; DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages, - "Non-nil means display messages at start and end of garbage collection."); + doc: /* Non-nil means display messages at start and end of garbage collection. */); garbage_collection_messages = 0; + DEFVAR_LISP ("post-gc-hook", &Vpost_gc_hook, + doc: /* Hook run after garbage collection has finished. */); + Vpost_gc_hook = Qnil; + Qpost_gc_hook = intern ("post-gc-hook"); + staticpro (&Qpost_gc_hook); + /* We build this in advance because if we wait until we need it, we might not be able to allocate the memory to hold it. */ memory_signal_data