diff options
Diffstat (limited to 'src/alloc.c')
| -rw-r--r-- | src/alloc.c | 815 |
1 files changed, 577 insertions, 238 deletions
diff --git a/src/alloc.c b/src/alloc.c index 31e8da70161..8054aa5ae59 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -44,6 +44,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "keyboard.h" #include "frame.h" #include "blockinput.h" +#include "pdumper.h" #include "termhooks.h" /* For struct terminal. */ #ifdef HAVE_WINDOW_SYSTEM #include TERM_HEADER @@ -65,16 +66,13 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ # include <malloc.h> #endif -#if (defined ENABLE_CHECKING \ - && defined HAVE_VALGRIND_VALGRIND_H \ - && !defined USE_VALGRIND) +#if defined HAVE_VALGRIND_VALGRIND_H && !defined USE_VALGRIND # define USE_VALGRIND 1 #endif #if USE_VALGRIND #include <valgrind/valgrind.h> #include <valgrind/memcheck.h> -static bool valgrind_p; #endif /* GC_CHECK_MARKED_OBJECTS means do sanity checks on allocated objects. @@ -194,9 +192,6 @@ alloc_unexec_pre (void) if (!malloc_state_ptr) fatal ("malloc_get_state: %s", strerror (errno)); # endif -# ifdef HYBRID_MALLOC - bss_sbrk_did_unexec = true; -# endif } void @@ -205,22 +200,19 @@ alloc_unexec_post (void) # ifdef DOUG_LEA_MALLOC free (malloc_state_ptr); # endif -# ifdef HYBRID_MALLOC - bss_sbrk_did_unexec = false; -# endif } #endif /* Mark, unmark, query mark bit of a Lisp string. S must be a pointer to a struct Lisp_String. */ -#define MARK_STRING(S) ((S)->u.s.size |= ARRAY_MARK_FLAG) -#define UNMARK_STRING(S) ((S)->u.s.size &= ~ARRAY_MARK_FLAG) -#define STRING_MARKED_P(S) (((S)->u.s.size & ARRAY_MARK_FLAG) != 0) +#define XMARK_STRING(S) ((S)->u.s.size |= ARRAY_MARK_FLAG) +#define XUNMARK_STRING(S) ((S)->u.s.size &= ~ARRAY_MARK_FLAG) +#define XSTRING_MARKED_P(S) (((S)->u.s.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) +#define XMARK_VECTOR(V) ((V)->header.size |= ARRAY_MARK_FLAG) +#define XUNMARK_VECTOR(V) ((V)->header.size &= ~ARRAY_MARK_FLAG) +#define XVECTOR_MARKED_P(V) (((V)->header.size & ARRAY_MARK_FLAG) != 0) /* Default value of gc_cons_threshold (see below). */ @@ -242,6 +234,12 @@ byte_ct gc_relative_threshold; byte_ct memory_full_cons_threshold; +#ifdef HAVE_PDUMPER +/* Number of finalizers run: used to loop over GC until we stop + generating garbage. */ +int number_finalizers_run; +#endif + /* True during GC. */ bool gc_in_progress; @@ -375,6 +373,27 @@ static void compact_small_strings (void); static void free_large_strings (void); extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE; +/* Forward declare mark accessor functions: they're used all over the + place. */ + +inline static bool vector_marked_p (const struct Lisp_Vector *v); +inline static void set_vector_marked (struct Lisp_Vector *v); + +inline static bool vectorlike_marked_p (const union vectorlike_header *v); +inline static void set_vectorlike_marked (union vectorlike_header *v); + +inline static bool cons_marked_p (const struct Lisp_Cons *c); +inline static void set_cons_marked (struct Lisp_Cons *c); + +inline static bool string_marked_p (const struct Lisp_String *s); +inline static void set_string_marked (struct Lisp_String *s); + +inline static bool symbol_marked_p (const struct Lisp_Symbol *s); +inline static void set_symbol_marked (struct Lisp_Symbol *s); + +inline static bool interval_marked_p (INTERVAL i); +inline static void set_interval_marked (INTERVAL i); + /* When scanning the C stack for live Lisp objects, Emacs keeps track of what memory allocated via lisp_malloc and lisp_align_malloc is intended for what purpose. This enumeration specifies the type of memory. */ @@ -400,7 +419,10 @@ enum mem_type /* A unique object in pure space used to make some Lisp objects on free lists recognizable in O(1). */ -static Lisp_Object Vdead; +#ifndef ENABLE_CHECKING +static +#endif +Lisp_Object Vdead; #define DEADP(x) EQ (x, Vdead) #ifdef GC_MALLOC_CHECK @@ -478,30 +500,21 @@ static struct mem_node *mem_find (void *); #endif /* Addresses of staticpro'd variables. Initialize it to a nonzero - value; otherwise some compilers put it into BSS. */ + value if we might dump; otherwise some compilers put it into + BSS. */ -enum { NSTATICS = 2048 }; -static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag}; +Lisp_Object *staticvec[NSTATICS] +#ifndef CANNOT_DUMP += {&Vpurify_flag} +#endif + ; /* Index of next unused slot in staticvec. */ -static int staticidx; +int staticidx; static void *pure_alloc (size_t, int); -/* True if N is a power of 2. N should be positive. */ - -#define POWER_OF_2(n) (((n) & ((n) - 1)) == 0) - -/* Return X rounded to the next multiple of Y. Y should be positive, - and Y - 1 + X should not overflow. Arguments should not have side - effects, as they are evaluated more than once. Tune for Y being a - power of 2. */ - -#define ROUNDUP(x, y) (POWER_OF_2 (y) \ - ? ((y) - 1 + (x)) & ~ ((y) - 1) \ - : ((y) - 1 + (x)) - ((y) - 1 + (x)) % (y)) - /* Return PTR rounded up to the next multiple of ALIGNMENT. */ static void * @@ -571,18 +584,18 @@ mmap_lisp_allowed_p (void) over our address space. We also can't use mmap for lisp objects if we might dump: unexec doesn't preserve the contents of mmapped regions. */ - return pointers_fit_in_lispobj_p () && !might_dump; + return pointers_fit_in_lispobj_p () && !will_dump_with_unexec_p (); } #endif /* Head of a circularly-linked list of extant finalizers. */ -static struct Lisp_Finalizer finalizers; +struct Lisp_Finalizer finalizers; /* Head of a circularly-linked list of finalizers that must be invoked because we deemed them unreachable. This list must be global, and not a local inside garbage_collect_1, in case we GC again while running finalizers. */ -static struct Lisp_Finalizer doomed_finalizers; +struct Lisp_Finalizer doomed_finalizers; /************************************************************************ @@ -931,6 +944,8 @@ xfree (void *block) { if (!block) return; + if (pdumper_object_p (block)) + return; MALLOC_BLOCK_INPUT; free (block); MALLOC_UNBLOCK_INPUT; @@ -1153,6 +1168,9 @@ lisp_malloc (size_t nbytes, enum mem_type type) static void lisp_free (void *block) { + if (pdumper_object_p (block)) + return; + MALLOC_BLOCK_INPUT; free (block); #ifndef GC_MALLOC_CHECK @@ -1569,22 +1587,23 @@ make_interval (void) /* Mark Lisp objects in interval I. */ static void -mark_interval (INTERVAL i, void *dummy) +mark_interval_tree_1 (INTERVAL i, void *dummy) { /* Intervals should never be shared. So, if extra internal checking is enabled, GC aborts if it seems to have visited an interval twice. */ - eassert (!i->gcmarkbit); - i->gcmarkbit = 1; + eassert (!interval_marked_p (i)); + set_interval_marked (i); mark_object (i->plist); } /* Mark the interval tree rooted in I. */ -#define MARK_INTERVAL_TREE(i) \ - do { \ - if (i && !i->gcmarkbit) \ - traverse_intervals_noorder (i, mark_interval, NULL); \ - } while (0) +static void +mark_interval_tree (INTERVAL i) +{ + if (i && !interval_marked_p (i)) + traverse_intervals_noorder (i, mark_interval_tree_1, NULL); +} /*********************************************************************** String Allocation @@ -1820,7 +1839,9 @@ static void init_strings (void) { empty_unibyte_string = make_pure_string ("", 0, 0, 0); + staticpro (&empty_unibyte_string); empty_multibyte_string = make_pure_string ("", 0, 0, 1); + staticpro (&empty_multibyte_string); } @@ -2114,10 +2135,10 @@ sweep_strings (void) if (s->u.s.data) { /* String was not on free-list before. */ - if (STRING_MARKED_P (s)) + if (XSTRING_MARKED_P (s)) { /* String is live; unmark it and its intervals. */ - UNMARK_STRING (s); + XUNMARK_STRING (s); /* Do not use string_(set|get)_intervals here. */ s->u.s.intervals = balance_intervals (s->u.s.intervals); @@ -2619,7 +2640,8 @@ make_formatted_string (char *buf, const char *format, ...) &= ~((bits_word) 1 << ((n) % BITS_PER_BITS_WORD))) #define FLOAT_BLOCK(fptr) \ - ((struct float_block *) (((uintptr_t) (fptr)) & ~(BLOCK_ALIGN - 1))) + (eassert (!pdumper_object_p (fptr)), \ + ((struct float_block *) (((uintptr_t) (fptr)) & ~(BLOCK_ALIGN - 1)))) #define FLOAT_INDEX(fptr) \ ((((uintptr_t) (fptr)) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Float)) @@ -2632,13 +2654,13 @@ struct float_block struct float_block *next; }; -#define FLOAT_MARKED_P(fptr) \ +#define XFLOAT_MARKED_P(fptr) \ GETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX ((fptr))) -#define FLOAT_MARK(fptr) \ +#define XFLOAT_MARK(fptr) \ SETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX ((fptr))) -#define FLOAT_UNMARK(fptr) \ +#define XFLOAT_UNMARK(fptr) \ UNSETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX ((fptr))) /* Current float_block. */ @@ -2686,7 +2708,7 @@ make_float (double float_value) MALLOC_UNBLOCK_INPUT; XFLOAT_INIT (val, float_value); - eassert (!FLOAT_MARKED_P (XFLOAT (val))); + eassert (!XFLOAT_MARKED_P (XFLOAT (val))); consing_since_gc += sizeof (struct Lisp_Float); floats_consed++; total_free_floats--; @@ -2711,7 +2733,8 @@ make_float (double float_value) / (sizeof (struct Lisp_Cons) * CHAR_BIT + 1)) #define CONS_BLOCK(fptr) \ - ((struct cons_block *) ((uintptr_t) (fptr) & ~(BLOCK_ALIGN - 1))) + (eassert (!pdumper_object_p (fptr)), \ + ((struct cons_block *) ((uintptr_t) (fptr) & ~(BLOCK_ALIGN - 1)))) #define CONS_INDEX(fptr) \ (((uintptr_t) (fptr) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Cons)) @@ -2724,13 +2747,13 @@ struct cons_block struct cons_block *next; }; -#define CONS_MARKED_P(fptr) \ +#define XCONS_MARKED_P(fptr) \ GETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr))) -#define CONS_MARK(fptr) \ +#define XMARK_CONS(fptr) \ SETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr))) -#define CONS_UNMARK(fptr) \ +#define XUNMARK_CONS(fptr) \ UNSETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr))) /* Current cons_block. */ @@ -2803,7 +2826,7 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, XSETCAR (val, car); XSETCDR (val, cdr); - eassert (!CONS_MARKED_P (XCONS (val))); + eassert (!XCONS_MARKED_P (XCONS (val))); consing_since_gc += sizeof (struct Lisp_Cons); total_free_conses--; cons_cells_consed++; @@ -3103,6 +3126,7 @@ static void init_vectors (void) { zero_vector = make_pure_vector (0); + staticpro (&zero_vector); } /* Allocate vector from a vector block. */ @@ -3173,17 +3197,17 @@ allocate_vector_from_block (ptrdiff_t nbytes) /* Return the memory footprint of V in bytes. */ -static ptrdiff_t -vector_nbytes (struct Lisp_Vector *v) +ptrdiff_t +vectorlike_nbytes (const union vectorlike_header *hdr) { - ptrdiff_t size = v->header.size & ~ARRAY_MARK_FLAG; + ptrdiff_t size = hdr->size & ~ARRAY_MARK_FLAG; ptrdiff_t nwords; if (size & PSEUDOVECTOR_FLAG) { - if (PSEUDOVECTOR_TYPEP (&v->header, PVEC_BOOL_VECTOR)) + if (PSEUDOVECTOR_TYPEP (hdr, PVEC_BOOL_VECTOR)) { - struct Lisp_Bool_Vector *bv = (struct Lisp_Bool_Vector *) v; + struct Lisp_Bool_Vector *bv = (struct Lisp_Bool_Vector *) hdr; ptrdiff_t word_bytes = (bool_vector_words (bv->size) * sizeof (bits_word)); ptrdiff_t boolvec_bytes = bool_header_size + word_bytes; @@ -3281,9 +3305,9 @@ sweep_vectors (void) for (vector = (struct Lisp_Vector *) block->data; VECTOR_IN_BLOCK (vector, block); vector = next) { - if (VECTOR_MARKED_P (vector)) + if (XVECTOR_MARKED_P (vector)) { - VECTOR_UNMARK (vector); + XUNMARK_VECTOR (vector); total_vectors++; ptrdiff_t nbytes = vector_nbytes (vector); total_vector_slots += nbytes / word_size; @@ -3304,7 +3328,7 @@ sweep_vectors (void) total_bytes += nbytes; next = ADVANCE (next, nbytes); } - while (VECTOR_IN_BLOCK (next, block) && !VECTOR_MARKED_P (next)); + while (VECTOR_IN_BLOCK (next, block) && !vector_marked_p (next)); eassert (total_bytes % roundup_size == 0); @@ -3335,9 +3359,9 @@ sweep_vectors (void) for (lv = large_vectors; lv; lv = *lvprev) { vector = large_vector_vec (lv); - if (VECTOR_MARKED_P (vector)) + if (XVECTOR_MARKED_P (vector)) { - VECTOR_UNMARK (vector); + XUNMARK_VECTOR (vector); total_vectors++; if (vector->header.size & PSEUDOVECTOR_FLAG) total_vector_slots += vector_nbytes (vector) / word_size; @@ -3847,7 +3871,7 @@ mark_finalizer_list (struct Lisp_Finalizer *head) finalizer != head; finalizer = finalizer->next) { - VECTOR_MARK (finalizer); + set_vectorlike_marked (&finalizer->header); mark_object (finalizer->function); } } @@ -3864,7 +3888,8 @@ queue_doomed_finalizers (struct Lisp_Finalizer *dest, while (finalizer != src) { struct Lisp_Finalizer *next = finalizer->next; - if (!VECTOR_MARKED_P (finalizer) && !NILP (finalizer->function)) + if (!vectorlike_marked_p (&finalizer->header) + && !NILP (finalizer->function)) { unchain_finalizer (finalizer); finalizer_insert (dest, finalizer); @@ -3885,6 +3910,9 @@ static void run_finalizer_function (Lisp_Object function) { ptrdiff_t count = SPECPDL_INDEX (); +#ifdef HAVE_PDUMPER + ++number_finalizers_run; +#endif specbind (Qinhibit_quit, Qt); internal_condition_case_1 (call0, function, Qt, run_finalizer_handler); @@ -3929,6 +3957,126 @@ FUNCTION. FUNCTION will be run once per finalizer object. */) /************************************************************************ + Mark bit access functions + ************************************************************************/ + +/* With the rare exception of functions implementing block-based + allocation of various types, you should not directly test or set GC + mark bits on objects. Some objects might live in special memory + regions (e.g., a dump image) and might store their mark bits + elsewhere. */ + +static bool +vector_marked_p (const struct Lisp_Vector *v) +{ + if (pdumper_object_p (v)) + { + /* Look at cold_start first so that we don't have to fault in + the vector header just to tell that it's a bool vector. */ + if (pdumper_cold_object_p (v)) + { + eassert (PSEUDOVECTOR_TYPE (v) == PVEC_BOOL_VECTOR); + return true; + } + return pdumper_marked_p (v); + } + return XVECTOR_MARKED_P (v); +} + +static void +set_vector_marked (struct Lisp_Vector *v) +{ + if (pdumper_object_p (v)) + { + eassert (PSEUDOVECTOR_TYPE (v) != PVEC_BOOL_VECTOR); + pdumper_set_marked (v); + } + else + XMARK_VECTOR (v); +} + +static bool +vectorlike_marked_p (const union vectorlike_header *header) +{ + return vector_marked_p ((const struct Lisp_Vector *) header); +} + +static void +set_vectorlike_marked (union vectorlike_header *header) +{ + set_vector_marked ((struct Lisp_Vector *) header); +} + +static bool +cons_marked_p (const struct Lisp_Cons *c) +{ + return pdumper_object_p (c) + ? pdumper_marked_p (c) + : XCONS_MARKED_P (c); +} + +static void +set_cons_marked (struct Lisp_Cons *c) +{ + if (pdumper_object_p (c)) + pdumper_set_marked (c); + else + XMARK_CONS (c); +} + +static bool +string_marked_p (const struct Lisp_String *s) +{ + return pdumper_object_p (s) + ? pdumper_marked_p (s) + : XSTRING_MARKED_P (s); +} + +static void +set_string_marked (struct Lisp_String *s) +{ + if (pdumper_object_p (s)) + pdumper_set_marked (s); + else + XMARK_STRING (s); +} + +static bool +symbol_marked_p (const struct Lisp_Symbol *s) +{ + return pdumper_object_p (s) + ? pdumper_marked_p (s) + : s->u.s.gcmarkbit; +} + +static void +set_symbol_marked (struct Lisp_Symbol *s) +{ + if (pdumper_object_p (s)) + pdumper_set_marked (s); + else + s->u.s.gcmarkbit = true; +} + +static bool +interval_marked_p (INTERVAL i) +{ + return pdumper_object_p (i) + ? pdumper_marked_p (i) + : i->gcmarkbit; +} + +static void +set_interval_marked (INTERVAL i) +{ + if (pdumper_object_p (i)) + pdumper_set_marked (i); + else + i->gcmarkbit = true; +} + + +/************************************************************************ Memory Full Handling ************************************************************************/ @@ -4626,14 +4774,29 @@ static void mark_maybe_object (Lisp_Object obj) { #if USE_VALGRIND - if (valgrind_p) - VALGRIND_MAKE_MEM_DEFINED (&obj, sizeof (obj)); + VALGRIND_MAKE_MEM_DEFINED (&obj, sizeof (obj)); #endif if (FIXNUMP (obj)) return; void *po = XPNTR (obj); + + /* If the pointer is in the dumped image and the dump has a record + of the object starting at the place where the pointer points, we + definitely have an object. If the pointer is in the dumped image + and the dump has no idea what the pointer is pointing at, we + definitely _don't_ have an object. */ + if (pdumper_object_p (po)) + { + /* Don't use pdumper_object_p_precise here! It doesn't check the + tag bits. OBJ here might be complete garbage, so we need to + verify both the pointer and the tag. */ + if (XTYPE (obj) == pdumper_find_object_type (po)) + mark_object (obj); + return; + } + struct mem_node *m = mem_find (po); if (m != MEM_NIL) @@ -4703,9 +4866,8 @@ mark_maybe_pointer (void *p) { struct mem_node *m; -#if USE_VALGRIND - if (valgrind_p) - VALGRIND_MAKE_MEM_DEFINED (&p, sizeof (p)); +#ifdef USE_VALGRIND + VALGRIND_MAKE_MEM_DEFINED (&p, sizeof (p)); #endif if (sizeof (Lisp_Object) == sizeof (void *) || !HAVE_MODULES) @@ -4720,6 +4882,17 @@ mark_maybe_pointer (void *p) p = (void *) ((uintptr_t) p & ~((1 << GCTYPEBITS) - 1)); } + if (pdumper_object_p (p)) + { + enum Lisp_Type type = pdumper_find_object_type (p); + if (type != PDUMPER_NO_OBJECT) + mark_object ((type == Lisp_Symbol) + ? make_lisp_symbol(p) + : make_lisp_ptr(p, type)); + /* See mark_maybe_object for why we can confidently return. */ + return; + } + m = mem_find (p); if (m != MEM_NIL) { @@ -5076,6 +5249,12 @@ valid_pointer_p (void *p) return p ? -1 : 0; int fd[2]; + static int under_rr_state; + + if (!under_rr_state) + under_rr_state = getenv ("RUNNING_UNDER_RR") ? -1 : 1; + if (under_rr_state < 0) + return under_rr_state; /* 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. @@ -5115,6 +5294,9 @@ valid_lisp_object_p (Lisp_Object obj) if (p == &buffer_defaults || p == &buffer_local_symbols) return 2; + if (pdumper_object_p (p)) + return pdumper_object_p_precise (p) ? 1 : 0; + struct mem_node *m = mem_find (p); if (m == MEM_NIL) @@ -5324,7 +5506,7 @@ make_pure_c_string (const char *data, ptrdiff_t nchars) Lisp_Object string; struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String); s->u.s.size = nchars; - s->u.s.size_byte = -1; + s->u.s.size_byte = -2; s->u.s.data = (unsigned char *) data; s->u.s.intervals = NULL; XSETSTRING (string, s); @@ -5617,7 +5799,7 @@ compact_font_cache_entry (Lisp_Object entry) /* Consider OBJ if it is (font-spec . [font-entity font-entity ...]). */ if (CONSP (obj) && GC_FONT_SPEC_P (XCAR (obj)) - && !VECTOR_MARKED_P (GC_XFONT_SPEC (XCAR (obj))) + && !vectorlike_marked_p (&GC_XFONT_SPEC (XCAR (obj))->header) /* Don't use VECTORP here, as that calls ASIZE, which could hit assertion violation during GC. */ && (VECTORLIKEP (XCDR (obj)) @@ -5633,7 +5815,8 @@ compact_font_cache_entry (Lisp_Object entry) { Lisp_Object objlist; - if (VECTOR_MARKED_P (GC_XFONT_ENTITY (AREF (obj_cdr, i)))) + if (vectorlike_marked_p ( + &GC_XFONT_ENTITY (AREF (obj_cdr, i))->header)) break; objlist = AREF (AREF (obj_cdr, i), FONT_OBJLIST_INDEX); @@ -5643,7 +5826,7 @@ compact_font_cache_entry (Lisp_Object entry) struct font *font = GC_XFONT_OBJECT (val); if (!NILP (AREF (val, FONT_TYPE_INDEX)) - && VECTOR_MARKED_P(font)) + && vectorlike_marked_p(&font->header)) break; } if (CONSP (objlist)) @@ -5712,7 +5895,7 @@ compact_undo_list (Lisp_Object list) { if (CONSP (XCAR (tail)) && MARKERP (XCAR (XCAR (tail))) - && !VECTOR_MARKED_P (XMARKER (XCAR (XCAR (tail))))) + && !vectorlike_marked_p (&XMARKER (XCAR (XCAR (tail)))->header)) *prev = XCDR (tail); else prev = xcdr_addr (tail); @@ -5745,6 +5928,105 @@ mark_pinned_symbols (void) } } +static void +visit_vectorlike_root (struct gc_root_visitor visitor, + struct Lisp_Vector *ptr, + enum gc_root_type type) +{ + ptrdiff_t size = ptr->header.size; + ptrdiff_t i; + + if (size & PSEUDOVECTOR_FLAG) + size &= PSEUDOVECTOR_SIZE_MASK; + for (i = 0; i < size; i++) + visitor.visit (&ptr->contents[i], type, visitor.data); +} + +static void +visit_buffer_root (struct gc_root_visitor visitor, + struct buffer *buffer, + enum gc_root_type type) +{ + /* Buffers that are roots don't have intervals, an undo list, or + other constructs that real buffers have. */ + eassert (buffer->base_buffer == NULL); + eassert (buffer->overlays_before == NULL); + eassert (buffer->overlays_after == NULL); + + /* Visit the buffer-locals. */ + visit_vectorlike_root (visitor, (struct Lisp_Vector *) buffer, type); +} + +/* Visit GC roots stored in the Emacs data section. Used by both core + GC and by the portable dumping code. + + There are other GC roots of course, but these roots are dynamic + runtime data structures that pdump doesn't care about and so we can + continue to mark those directly in garbage_collect_1. */ +void +visit_static_gc_roots (struct gc_root_visitor visitor) +{ + visit_buffer_root (visitor, + &buffer_defaults, + GC_ROOT_BUFFER_LOCAL_DEFAULT); + visit_buffer_root (visitor, + &buffer_local_symbols, + GC_ROOT_BUFFER_LOCAL_NAME); + + for (int i = 0; i < ARRAYELTS (lispsym); i++) + { + Lisp_Object sptr = builtin_lisp_symbol (i); + visitor.visit (&sptr, GC_ROOT_C_SYMBOL, visitor.data); + } + + for (int i = 0; i < staticidx; i++) + visitor.visit (staticvec[i], GC_ROOT_STATICPRO, visitor.data); +} + +static void +mark_object_root_visitor (Lisp_Object *root_ptr, + enum gc_root_type type, + void *data) +{ + mark_object (*root_ptr); +} + +/* List of weak hash tables we found during marking the Lisp heap. + Will be NULL on entry to garbage_collect_1 and after it + returns. */ +static struct Lisp_Hash_Table *weak_hash_tables; + +NO_INLINE /* For better stack traces */ +static void +mark_and_sweep_weak_table_contents (void) +{ + struct Lisp_Hash_Table *h; + bool marked; + + /* Mark all keys and values that are in use. Keep on marking until + there is no more change. This is necessary for cases like + value-weak table A containing an entry X -> Y, where Y is used in a + key-weak table B, Z -> Y. If B comes after A in the list of weak + tables, X -> Y might be removed from A, although when looking at B + one finds that it shouldn't. */ + do + { + marked = false; + for (h = weak_hash_tables; h; h = h->next_weak) + marked |= sweep_weak_table (h, false); + } + while (marked); + + /* Remove hash table entries that aren't used. */ + while (weak_hash_tables) + { + h = weak_hash_tables; + weak_hash_tables = h->next_weak; + h->next_weak = NULL; + sweep_weak_table (h, true); + } +} + /* Subroutine of Fgarbage_collect that does most of the work. It is a separate function so that we could limit mark_stack in searching the stack frames below this function, thus avoiding the rare cases @@ -5757,13 +6039,14 @@ garbage_collect_1 (void *end) { struct buffer *nextb; char stack_top_variable; - ptrdiff_t i; bool message_p; ptrdiff_t count = SPECPDL_INDEX (); struct timespec start; Lisp_Object retval = Qnil; byte_ct tot_before = 0; + eassert (weak_hash_tables == NULL); + /* 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) @@ -5839,14 +6122,10 @@ garbage_collect_1 (void *end) /* Mark all the special slots that serve as the roots of accessibility. */ - mark_buffer (&buffer_defaults); - mark_buffer (&buffer_local_symbols); - - for (i = 0; i < ARRAYELTS (lispsym); i++) - mark_object (builtin_lisp_symbol (i)); - - for (i = 0; i < staticidx; i++) - mark_object (*staticvec[i]); + struct gc_root_visitor visitor; + memset (&visitor, 0, sizeof (visitor)); + visitor.visit = mark_object_root_visitor; + visit_static_gc_roots (visitor); mark_pinned_objects (); mark_pinned_symbols (); @@ -5891,11 +6170,11 @@ garbage_collect_1 (void *end) queue_doomed_finalizers (&doomed_finalizers, &finalizers); mark_finalizer_list (&doomed_finalizers); - gc_sweep (); + /* Must happen after all other marking and before gc_sweep. */ + mark_and_sweep_weak_table_contents (); + eassert (weak_hash_tables == NULL); - /* Clear the mark bits that we set in certain root slots. */ - VECTOR_UNMARK (&buffer_defaults); - VECTOR_UNMARK (&buffer_local_symbols); + gc_sweep (); unmark_main_thread (); @@ -6043,7 +6322,7 @@ mark_glyph_matrix (struct glyph_matrix *matrix) for (; glyph < end_glyph; ++glyph) if (STRINGP (glyph->object) - && !STRING_MARKED_P (XSTRING (glyph->object))) + && !string_marked_p (XSTRING (glyph->object))) mark_object (glyph->object); } } @@ -6060,13 +6339,18 @@ static int last_marked_index; ptrdiff_t mark_object_loop_halt EXTERNALLY_VISIBLE; static void -mark_vectorlike (struct Lisp_Vector *ptr) +mark_vectorlike (union vectorlike_header *header) { + struct Lisp_Vector *ptr = (struct Lisp_Vector *) header; ptrdiff_t size = ptr->header.size; ptrdiff_t i; - eassert (!VECTOR_MARKED_P (ptr)); - VECTOR_MARK (ptr); /* Else mark it. */ + eassert (!vector_marked_p (ptr)); + + /* Bool vectors have a different case in mark_object. */ + eassert (PSEUDOVECTOR_TYPE (ptr) != PVEC_BOOL_VECTOR); + + set_vector_marked (ptr); /* Else mark it. */ if (size & PSEUDOVECTOR_FLAG) size &= PSEUDOVECTOR_SIZE_MASK; @@ -6089,17 +6373,18 @@ mark_char_table (struct Lisp_Vector *ptr, enum pvec_type pvectype) /* Consult the Lisp_Sub_Char_Table layout before changing this. */ int i, idx = (pvectype == PVEC_SUB_CHAR_TABLE ? SUB_CHAR_TABLE_OFFSET : 0); - eassert (!VECTOR_MARKED_P (ptr)); - VECTOR_MARK (ptr); + eassert (!vector_marked_p (ptr)); + set_vector_marked (ptr); for (i = idx; i < size; i++) { Lisp_Object val = ptr->contents[i]; - if (FIXNUMP (val) || (SYMBOLP (val) && XSYMBOL (val)->u.s.gcmarkbit)) + if (FIXNUMP (val) || + (SYMBOLP (val) && symbol_marked_p (XSYMBOL (val)))) continue; if (SUB_CHAR_TABLE_P (val)) { - if (! VECTOR_MARKED_P (XVECTOR (val))) + if (! vector_marked_p (XVECTOR (val))) mark_char_table (XVECTOR (val), PVEC_SUB_CHAR_TABLE); } else @@ -6113,7 +6398,7 @@ mark_compiled (struct Lisp_Vector *ptr) { int i, size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK; - VECTOR_MARK (ptr); + set_vector_marked (ptr); for (i = 0; i < size; i++) if (i != COMPILED_CONSTANTS) mark_object (ptr->contents[i]); @@ -6125,12 +6410,12 @@ mark_compiled (struct Lisp_Vector *ptr) static void mark_overlay (struct Lisp_Overlay *ptr) { - for (; ptr && !VECTOR_MARKED_P (ptr); ptr = ptr->next) + for (; ptr && !vectorlike_marked_p (&ptr->header); ptr = ptr->next) { - VECTOR_MARK (ptr); + set_vectorlike_marked (&ptr->header); /* These two are always markers and can be marked fast. */ - VECTOR_MARK (XMARKER (ptr->start)); - VECTOR_MARK (XMARKER (ptr->end)); + set_vectorlike_marked (&XMARKER (ptr->start)->header); + set_vectorlike_marked (&XMARKER (ptr->end)->header); mark_object (ptr->plist); } } @@ -6141,11 +6426,11 @@ static void mark_buffer (struct buffer *buffer) { /* This is handled much like other pseudovectors... */ - mark_vectorlike ((struct Lisp_Vector *) buffer); + mark_vectorlike (&buffer->header); /* ...but there are some buffer-specific things. */ - MARK_INTERVAL_TREE (buffer_intervals (buffer)); + mark_interval_tree (buffer_intervals (buffer)); /* For now, we just don't mark the undo_list. It's done later in a special way just before the sweep phase, and after stripping @@ -6155,7 +6440,8 @@ mark_buffer (struct buffer *buffer) mark_overlay (buffer->overlays_after); /* If this is an indirect buffer, mark its base buffer. */ - if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer)) + if (buffer->base_buffer && + !vectorlike_marked_p (&buffer->base_buffer->header)) mark_buffer (buffer->base_buffer); } @@ -6174,8 +6460,8 @@ mark_face_cache (struct face_cache *c) if (face) { - if (face->font && !VECTOR_MARKED_P (face->font)) - mark_vectorlike ((struct Lisp_Vector *) face->font); + if (face->font && !vectorlike_marked_p (&face->font->header)) + mark_vectorlike (&face->font->header); for (j = 0; j < LFACE_VECTOR_SIZE; ++j) mark_object (face->lface[j]); @@ -6206,7 +6492,7 @@ mark_discard_killed_buffers (Lisp_Object list) { Lisp_Object tail, *prev = &list; - for (tail = list; CONSP (tail) && !CONS_MARKED_P (XCONS (tail)); + for (tail = list; CONSP (tail) && !cons_marked_p (XCONS (tail)); tail = XCDR (tail)) { Lisp_Object tem = XCAR (tail); @@ -6216,7 +6502,7 @@ mark_discard_killed_buffers (Lisp_Object list) *prev = XCDR (tail); else { - CONS_MARK (XCONS (tail)); + set_cons_marked (XCONS (tail)); mark_object (XCAR (tail)); prev = xcdr_addr (tail); } @@ -6225,6 +6511,72 @@ mark_discard_killed_buffers (Lisp_Object list) return list; } +static void +mark_frame (struct Lisp_Vector *ptr) +{ + struct frame *f = (struct frame *) ptr; + mark_vectorlike (&ptr->header); + mark_face_cache (f->face_cache); +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (f) && FRAME_X_OUTPUT (f)) + { + struct font *font = FRAME_FONT (f); + + if (font && !vectorlike_marked_p (&font->header)) + mark_vectorlike (&font->header); + } +#endif +} + +static void +mark_window (struct Lisp_Vector *ptr) +{ + struct window *w = (struct window *) ptr; + + mark_vectorlike (&ptr->header); + + /* Mark glyph matrices, if any. Marking window + matrices is sufficient because frame matrices + use the same glyph memory. */ + if (w->current_matrix) + { + mark_glyph_matrix (w->current_matrix); + mark_glyph_matrix (w->desired_matrix); + } + + /* Filter out killed buffers from both buffer lists + in attempt to help GC to reclaim killed buffers faster. + We can do it elsewhere for live windows, but this is the + best place to do it for dead windows. */ + wset_prev_buffers + (w, mark_discard_killed_buffers (w->prev_buffers)); + wset_next_buffers + (w, mark_discard_killed_buffers (w->next_buffers)); +} + +static void +mark_hash_table (struct Lisp_Vector *ptr) +{ + struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *) ptr; + + mark_vectorlike (&h->header); + mark_object (h->test.name); + mark_object (h->test.user_hash_function); + mark_object (h->test.user_cmp_function); + /* If hash table is not weak, mark all keys and values. For weak + tables, mark only the vector and not its contents --- that's what + makes it weak. */ + if (NILP (h->weak)) + mark_object (h->key_and_value); + else + { + eassert (h->next_weak == NULL); + h->next_weak = weak_hash_tables; + weak_hash_tables = h; + set_vector_marked (XVECTOR (h->key_and_value)); + } +} + /* Determine type of generic Lisp_Object and mark it accordingly. This function implements a straightforward depth-first marking @@ -6239,7 +6591,7 @@ mark_object (Lisp_Object arg) register Lisp_Object obj; void *po; #if GC_CHECK_MARKED_OBJECTS - struct mem_node *m; + struct mem_node *m = NULL; #endif ptrdiff_t cdr_count = 0; @@ -6262,6 +6614,12 @@ mark_object (Lisp_Object arg) structure allocated from the heap. */ #define CHECK_ALLOCATED() \ do { \ + if (pdumper_object_p(po)) \ + { \ + if (!pdumper_object_p_precise (po)) \ + emacs_abort (); \ + break; \ + } \ m = mem_find (po); \ if (m == MEM_NIL) \ emacs_abort (); \ @@ -6271,6 +6629,8 @@ mark_object (Lisp_Object arg) function LIVEP. */ #define CHECK_LIVE(LIVEP) \ do { \ + if (pdumper_object_p(po)) \ + break; \ if (!LIVEP (m, po)) \ emacs_abort (); \ } while (0) @@ -6305,11 +6665,11 @@ mark_object (Lisp_Object arg) case Lisp_String: { register struct Lisp_String *ptr = XSTRING (obj); - if (STRING_MARKED_P (ptr)) - break; + if (string_marked_p (ptr)) + break; CHECK_ALLOCATED_AND_LIVE (live_string_p); - MARK_STRING (ptr); - MARK_INTERVAL_TREE (ptr->u.s.intervals); + set_string_marked (ptr); + mark_interval_tree (ptr->u.s.intervals); #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. */ @@ -6322,22 +6682,25 @@ mark_object (Lisp_Object arg) { register struct Lisp_Vector *ptr = XVECTOR (obj); - if (VECTOR_MARKED_P (ptr)) + if (vector_marked_p (ptr)) break; -#if GC_CHECK_MARKED_OBJECTS - m = mem_find (po); - if (m == MEM_NIL && !SUBRP (obj) && !main_thread_p (po)) - emacs_abort (); +#ifdef GC_CHECK_MARKED_OBJECTS + if (!pdumper_object_p(po)) + { + m = mem_find (po); + if (m == MEM_NIL && !SUBRP (obj) && !main_thread_p (po)) + emacs_abort (); + } #endif /* GC_CHECK_MARKED_OBJECTS */ enum pvec_type pvectype = PSEUDOVECTOR_TYPE (ptr); - if (pvectype != PVEC_SUBR - && pvectype != PVEC_BUFFER - && !main_thread_p (po)) - CHECK_LIVE (live_vector_p); + if (pvectype != PVEC_SUBR && + pvectype != PVEC_BUFFER && + !main_thread_p (po)) + CHECK_LIVE (live_vector_p); switch (pvectype) { @@ -6353,77 +6716,28 @@ mark_object (Lisp_Object arg) } #endif /* GC_CHECK_MARKED_OBJECTS */ mark_buffer ((struct buffer *) ptr); - break; - - case PVEC_COMPILED: - /* Although we could treat this just like a vector, mark_compiled - returns the COMPILED_CONSTANTS element, which is marked at the - next iteration of goto-loop here. This is done to avoid a few - recursive calls to mark_object. */ - obj = mark_compiled (ptr); - if (!NILP (obj)) - goto loop; - break; - - case PVEC_FRAME: - { - struct frame *f = (struct frame *) ptr; - - mark_vectorlike (ptr); - mark_face_cache (f->face_cache); -#ifdef HAVE_WINDOW_SYSTEM - if (FRAME_WINDOW_P (f) && FRAME_X_OUTPUT (f)) - { - struct font *font = FRAME_FONT (f); - - if (font && !VECTOR_MARKED_P (font)) - mark_vectorlike ((struct Lisp_Vector *) font); - } -#endif - } - break; - - case PVEC_WINDOW: - { - struct window *w = (struct window *) ptr; - - mark_vectorlike (ptr); - - /* Mark glyph matrices, if any. Marking window - matrices is sufficient because frame matrices - use the same glyph memory. */ - if (w->current_matrix) - { - mark_glyph_matrix (w->current_matrix); - mark_glyph_matrix (w->desired_matrix); - } - - /* Filter out killed buffers from both buffer lists - in attempt to help GC to reclaim killed buffers faster. - We can do it elsewhere for live windows, but this is the - best place to do it for dead windows. */ - wset_prev_buffers - (w, mark_discard_killed_buffers (w->prev_buffers)); - wset_next_buffers - (w, mark_discard_killed_buffers (w->next_buffers)); - } - break; + break; + + case PVEC_COMPILED: + /* Although we could treat this just like a vector, mark_compiled + returns the COMPILED_CONSTANTS element, which is marked at the + next iteration of goto-loop here. This is done to avoid a few + recursive calls to mark_object. */ + obj = mark_compiled (ptr); + if (!NILP (obj)) + goto loop; + break; + + case PVEC_FRAME: + mark_frame (ptr); + break; + + case PVEC_WINDOW: + mark_window (ptr); + break; case PVEC_HASH_TABLE: - { - struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *) ptr; - - mark_vectorlike (ptr); - mark_object (h->test.name); - mark_object (h->test.user_hash_function); - mark_object (h->test.user_cmp_function); - /* If hash table is not weak, mark all keys and values. - For weak tables, mark only the vector. */ - if (NILP (h->weak)) - mark_object (h->key_and_value); - else - VECTOR_MARK (XVECTOR (h->key_and_value)); - } + mark_hash_table (ptr); break; case PVEC_CHAR_TABLE: @@ -6431,7 +6745,17 @@ mark_object (Lisp_Object arg) mark_char_table (ptr, (enum pvec_type) pvectype); break; - case PVEC_OVERLAY: + case PVEC_BOOL_VECTOR: + /* bool vectors in a dump are permanently "marked", since + they're in the old section and don't have mark bits. + If we're looking at a dumped bool vector, we should + have aborted above when we called vector_marked_p(), so + we should never get here. */ + eassert (!pdumper_object_p (ptr)); + set_vector_marked (ptr); + break; + + case PVEC_OVERLAY: mark_overlay (XOVERLAY (obj)); break; @@ -6444,7 +6768,7 @@ mark_object (Lisp_Object arg) default: /* A regular vector, or a pseudovector needing no special treatment. */ - mark_vectorlike (ptr); + mark_vectorlike (&ptr->header); } } break; @@ -6453,10 +6777,10 @@ mark_object (Lisp_Object arg) { struct Lisp_Symbol *ptr = XSYMBOL (obj); nextsym: - if (ptr->u.s.gcmarkbit) - break; - CHECK_ALLOCATED_AND_LIVE_SYMBOL (); - ptr->u.s.gcmarkbit = 1; + if (symbol_marked_p (ptr)) + break; + CHECK_ALLOCATED_AND_LIVE_SYMBOL (); + set_symbol_marked(ptr); /* Attempt to catch bogus objects. */ eassert (valid_lisp_object_p (ptr->u.s.function)); mark_object (ptr->u.s.function); @@ -6483,8 +6807,8 @@ mark_object (Lisp_Object arg) default: emacs_abort (); } if (!PURE_P (XSTRING (ptr->u.s.name))) - MARK_STRING (XSTRING (ptr->u.s.name)); - MARK_INTERVAL_TREE (string_intervals (ptr->u.s.name)); + set_string_marked (XSTRING (ptr->u.s.name)); + mark_interval_tree (string_intervals (ptr->u.s.name)); /* Inner loop to mark next symbol in this bucket, if any. */ po = ptr = ptr->u.s.next; if (ptr) @@ -6495,10 +6819,10 @@ mark_object (Lisp_Object arg) case Lisp_Cons: { struct Lisp_Cons *ptr = XCONS (obj); - if (CONS_MARKED_P (ptr)) + if (cons_marked_p (ptr)) break; CHECK_ALLOCATED_AND_LIVE (live_cons_p); - CONS_MARK (ptr); + set_cons_marked (ptr); /* If the cdr is nil, avoid recursion for the car. */ if (NILP (ptr->u.s.u.cdr)) { @@ -6516,7 +6840,12 @@ mark_object (Lisp_Object arg) case Lisp_Float: CHECK_ALLOCATED_AND_LIVE (live_float_p); - FLOAT_MARK (XFLOAT (obj)); + /* Do not mark floats stored in a dump image: these floats are + "cold" and do not have mark bits. */ + if (pdumper_object_p (XFLOAT (obj))) + eassert (pdumper_cold_object_p (XFLOAT (obj))); + else if (!XFLOAT_MARKED_P (XFLOAT (obj))) + XFLOAT_MARK (XFLOAT (obj)); break; case_Lisp_Int: @@ -6530,6 +6859,7 @@ mark_object (Lisp_Object arg) #undef CHECK_ALLOCATED #undef CHECK_ALLOCATED_AND_LIVE } + /* Mark the Lisp pointers in the terminal objects. Called by Fgarbage_collect. */ @@ -6546,13 +6876,11 @@ mark_terminals (void) gets marked. */ mark_image_cache (t->image_cache); #endif /* HAVE_WINDOW_SYSTEM */ - if (!VECTOR_MARKED_P (t)) - mark_vectorlike ((struct Lisp_Vector *)t); + if (!vectorlike_marked_p (&t->header)) + mark_vectorlike (&t->header); } } - - /* Value is non-zero if OBJ will survive the current GC because it's either marked or does not need to be marked to survive. */ @@ -6564,27 +6892,29 @@ survives_gc_p (Lisp_Object obj) switch (XTYPE (obj)) { case_Lisp_Int: - survives_p = 1; + survives_p = true; break; case Lisp_Symbol: - survives_p = XSYMBOL (obj)->u.s.gcmarkbit; + survives_p = symbol_marked_p (XSYMBOL (obj)); break; case Lisp_String: - survives_p = STRING_MARKED_P (XSTRING (obj)); + survives_p = string_marked_p (XSTRING (obj)); break; case Lisp_Vectorlike: - survives_p = SUBRP (obj) || VECTOR_MARKED_P (XVECTOR (obj)); + survives_p = SUBRP (obj) || vector_marked_p (XVECTOR (obj)); break; case Lisp_Cons: - survives_p = CONS_MARKED_P (XCONS (obj)); + survives_p = cons_marked_p (XCONS (obj)); break; case Lisp_Float: - survives_p = FLOAT_MARKED_P (XFLOAT (obj)); + survives_p = + XFLOAT_MARKED_P (XFLOAT (obj)) || + pdumper_object_p (XFLOAT (obj)); break; default: @@ -6638,7 +6968,7 @@ sweep_conses (void) { struct Lisp_Cons *acons = ptr_bounds_copy (&cblk->conses[pos], cblk); - if (!CONS_MARKED_P (acons)) + if (!XCONS_MARKED_P (acons)) { this_free++; cblk->conses[pos].u.s.u.chain = cons_free_list; @@ -6648,7 +6978,7 @@ sweep_conses (void) else { num_used++; - CONS_UNMARK (acons); + XUNMARK_CONS (acons); } } } @@ -6691,7 +7021,7 @@ sweep_floats (void) for (int i = 0; i < lim; i++) { struct Lisp_Float *afloat = ptr_bounds_copy (&fblk->floats[i], fblk); - if (!FLOAT_MARKED_P (afloat)) + if (!XFLOAT_MARKED_P (afloat)) { this_free++; fblk->floats[i].u.chain = float_free_list; @@ -6700,7 +7030,7 @@ sweep_floats (void) else { num_used++; - FLOAT_UNMARK (afloat); + XFLOAT_UNMARK (afloat); } } lim = FLOAT_BLOCK_SIZE; @@ -6850,7 +7180,7 @@ unchain_dead_markers (struct buffer *buffer) struct Lisp_Marker *this, **prev = &BUF_MARKERS (buffer); while ((this = *prev)) - if (VECTOR_MARKED_P (this)) + if (vectorlike_marked_p (&this->header)) prev = &this->next; else { @@ -6867,14 +7197,15 @@ sweep_buffers (void) total_buffers = 0; for (buffer = all_buffers; buffer; buffer = *bprev) - if (!VECTOR_MARKED_P (buffer)) + if (!vectorlike_marked_p (&buffer->header)) { *bprev = buffer->next; lisp_free (buffer); } else { - VECTOR_UNMARK (buffer); + if (!pdumper_object_p (buffer)) + XUNMARK_VECTOR (buffer); /* Do not use buffer_(set|get)_intervals here. */ buffer->text->intervals = balance_intervals (buffer->text->intervals); unchain_dead_markers (buffer); @@ -6887,10 +7218,6 @@ sweep_buffers (void) static void gc_sweep (void) { - /* Remove or mark entries in weak hash tables. - This must be done before any object is unmarked. */ - sweep_weak_hash_tables (); - sweep_strings (); check_string_bytes (!noninteractive); sweep_conses (); @@ -6899,6 +7226,7 @@ gc_sweep (void) sweep_symbols (); sweep_buffers (); sweep_vectors (); + pdumper_clear_marks (); check_string_bytes (!noninteractive); } @@ -7151,19 +7479,34 @@ verify_alloca (void) /* Initialization. */ +static void init_alloc_once_for_pdumper (void); + void init_alloc_once (void) { + gc_cons_threshold = GC_DEFAULT_THRESHOLD; /* Even though Qt's contents are not set up, its address is known. */ Vpurify_flag = Qt; - purebeg = PUREBEG; - pure_size = PURESIZE; + PDUMPER_REMEMBER_SCALAR (buffer_defaults.header); + PDUMPER_REMEMBER_SCALAR (buffer_local_symbols.header); + + /* Call init_alloc_once_for_pdumper now so we run mem_init early. + Keep in mind that when we reload from a dump, we'll run _only_ + init_alloc_once_for_pdumper and not init_alloc_once at all. */ + pdumper_do_now_and_after_load (init_alloc_once_for_pdumper); verify_alloca (); - init_finalizer_list (&finalizers); - init_finalizer_list (&doomed_finalizers); + init_strings (); + init_vectors (); +} + +static void +init_alloc_once_for_pdumper (void) +{ + purebeg = PUREBEG; + pure_size = PURESIZE; mem_init (); Vdead = make_pure_string ("DEAD", 4, 4, 0); @@ -7172,11 +7515,11 @@ init_alloc_once (void) mallopt (M_MMAP_THRESHOLD, 64 * 1024); /* Mmap threshold. */ mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); /* Max. number of mmap'ed areas. */ #endif - init_strings (); - init_vectors (); + + init_finalizer_list (&finalizers); + init_finalizer_list (&doomed_finalizers); refill_memory_reserve (); - gc_cons_threshold = GC_DEFAULT_THRESHOLD; } void @@ -7184,10 +7527,6 @@ init_alloc (void) { Vgc_elapsed = make_float (0.0); gcs_done = 0; - -#if USE_VALGRIND - valgrind_p = RUNNING_ON_VALGRIND != 0; -#endif } void |