From e3b838807bf9fbbbec9826de6c1e4efdf72acb78 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 7 Apr 2014 12:08:46 -0400 Subject: [PATCH] * src/alloc.c: Keep track of symbols referenced from pure space (bug#17168). (symbol_block_pinned): New var. (Fmake_symbol): Initialize `pinned'. (purecopy): New function, extracted from Fpurecopy. Mark symbols as pinned and signal an error for un-purifiable objects. (pure_cons): Use it. (Fpurecopy): Use it, except for objects that can't be purified. (mark_pinned_symbols): New function. (Fgarbage_collect): Use it. (gc_sweep): Remove hack made unnecessary. * src/lisp.h (struct Lisp_Symbol): New bitfield `pinned'. --- src/ChangeLog | 15 ++++++++++ src/alloc.c | 83 +++++++++++++++++++++++++++++++++++++++------------ src/lisp.h | 3 ++ 3 files changed, 82 insertions(+), 19 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 9b084701933..7618fb202e0 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,18 @@ +2014-04-07 Stefan Monnier + + * lisp.h (struct Lisp_Symbol): New bitfield `pinned'. + + * alloc.c: Keep track of symbols referenced from pure space (bug#17168). + (symbol_block_pinned): New var. + (Fmake_symbol): Initialize `pinned'. + (purecopy): New function, extracted from Fpurecopy. Mark symbols as + pinned and signal an error for un-purifiable objects. + (pure_cons): Use it. + (Fpurecopy): Use it, except for objects that can't be purified. + (mark_pinned_symbols): New function. + (Fgarbage_collect): Use it. + (gc_sweep): Remove hack made unnecessary. + 2014-04-05 Glenn Morris * keyboard.c (Fopen_dribble_file): Doc tweak. diff --git a/src/alloc.c b/src/alloc.c index 62c3beec1d2..d4e24b6244b 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3316,6 +3316,13 @@ struct symbol_block static struct symbol_block *symbol_block; static int symbol_block_index = SYMBOL_BLOCK_SIZE; +/* Pointer to the first symbol_block that contains pinned symbols. + Tests for 24.4 showed that at dump-time, Emacs contains about 15K symbols, + 10K of which are pinned (and all but 250 of them are interned in obarray), + whereas a "typical session" has in the order of 30K symbols. + `symbol_block_pinned' lets mark_pinned_symbols scan only 15K symbols rather + than 30K to find the 10K symbols we need to mark. */ +static struct symbol_block *symbol_block_pinned; /* List of free symbols. */ @@ -3368,10 +3375,11 @@ Its value is void, and its function definition and property list are nil. */) SET_SYMBOL_VAL (p, Qunbound); set_symbol_function (val, Qnil); set_symbol_next (val, NULL); - p->gcmarkbit = 0; + p->gcmarkbit = false; p->interned = SYMBOL_UNINTERNED; p->constant = 0; - p->declared_special = 0; + p->declared_special = false; + p->pinned = false; consing_since_gc += sizeof (struct Lisp_Symbol); symbols_consed++; total_free_symbols--; @@ -5173,6 +5181,8 @@ make_pure_c_string (const char *data, ptrdiff_t nchars) return string; } +static Lisp_Object purecopy (Lisp_Object obj); + /* Return a cons allocated from pure space. Give it pure copies of CAR as car and CDR as cdr. */ @@ -5182,8 +5192,8 @@ pure_cons (Lisp_Object car, Lisp_Object cdr) Lisp_Object new; struct Lisp_Cons *p = pure_alloc (sizeof *p, Lisp_Cons); XSETCONS (new, p); - XSETCAR (new, Fpurecopy (car)); - XSETCDR (new, Fpurecopy (cdr)); + XSETCAR (new, purecopy (car)); + XSETCDR (new, purecopy (cdr)); return new; } @@ -5224,9 +5234,19 @@ Does not copy symbols. Copies strings without text properties. */) { if (NILP (Vpurify_flag)) return obj; - - if (PURE_POINTER_P (XPNTR (obj))) + else if (MARKERP (obj) || OVERLAYP (obj) + || HASH_TABLE_P (obj) || SYMBOLP (obj)) + /* Can't purify those. */ return obj; + else + return purecopy (obj); +} + +static Lisp_Object +purecopy (Lisp_Object obj) +{ + if (PURE_POINTER_P (XPNTR (obj)) || INTEGERP (obj) || SUBRP (obj)) + return obj; /* Already pure. */ if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing. */ { @@ -5254,7 +5274,7 @@ Does not copy symbols. Copies strings without text properties. */) size &= PSEUDOVECTOR_SIZE_MASK; vec = XVECTOR (make_pure_vector (size)); for (i = 0; i < size; i++) - vec->contents[i] = Fpurecopy (AREF (obj, i)); + vec->contents[i] = purecopy (AREF (obj, i)); if (COMPILEDP (obj)) { XSETPVECTYPE (vec, PVEC_COMPILED); @@ -5263,11 +5283,23 @@ Does not copy symbols. Copies strings without text properties. */) else XSETVECTOR (obj, vec); } - else if (MARKERP (obj)) - error ("Attempt to copy a marker to pure storage"); + else if (SYMBOLP (obj)) + { + if (!XSYMBOL (obj)->pinned) + { /* We can't purify them, but they appear in many pure objects. + Mark them as `pinned' so we know to mark them at every GC cycle. */ + XSYMBOL (obj)->pinned = true; + symbol_block_pinned = symbol_block; + } + return obj; + } else - /* Not purified, don't hash-cons. */ - return obj; + { + Lisp_Object args[2]; + args[0] = build_pure_c_string ("Don't know how to purify: %S"); + args[1] = obj; + Fsignal (Qerror, (Fcons (Fformat (2, args), Qnil))); + } if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing. */ Fputhash (obj, obj, Vpurify_flag); @@ -5430,6 +5462,24 @@ compact_undo_list (Lisp_Object list) return list; } +static void +mark_pinned_symbols (void) +{ + struct symbol_block *sblk; + int lim = (symbol_block_pinned == symbol_block + ? symbol_block_index : SYMBOL_BLOCK_SIZE); + + for (sblk = symbol_block_pinned; sblk; sblk = sblk->next) + { + union aligned_Lisp_Symbol *sym = sblk->symbols, *end = sym + lim; + for (; sym < end; ++sym) + if (sym->s.pinned) + mark_object (make_lisp_ptr (&sym->s, Lisp_Symbol)); + + lim = SYMBOL_BLOCK_SIZE; + } +} + DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", doc: /* Reclaim storage for Lisp objects no longer needed. Garbage collection happens automatically if you cons more than @@ -5532,6 +5582,7 @@ See Info node `(elisp)Garbage Collection'. */) for (i = 0; i < staticidx; i++) mark_object (*staticvec[i]); + mark_pinned_symbols (); mark_specpdl (); mark_terminals (); mark_kboards (); @@ -6536,12 +6587,7 @@ gc_sweep (void) 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. */ - bool pure_p = PURE_POINTER_P (XSTRING (sym->s.name)); - - if (!sym->s.gcmarkbit && !pure_p) + if (!sym->s.gcmarkbit) { if (sym->s.redirect == SYMBOL_LOCALIZED) xfree (SYMBOL_BLV (&sym->s)); @@ -6555,8 +6601,7 @@ gc_sweep (void) else { ++num_used; - if (!pure_p) - eassert (!STRING_MARKED_P (XSTRING (sym->s.name))); + eassert (!STRING_MARKED_P (XSTRING (sym->s.name))); sym->s.gcmarkbit = 0; } } diff --git a/src/lisp.h b/src/lisp.h index 30f52b9070c..ea294f8d1da 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1568,6 +1568,9 @@ struct Lisp_Symbol special (with `defvar' etc), and shouldn't be lexically bound. */ bool_bf declared_special : 1; + /* True if pointed to from purespace and hence can't be GC'd. */ + bool_bf pinned : 1; + /* The symbol's name, as a Lisp string. */ Lisp_Object name; -- 2.39.2