[Emacs-diffs] emacs-24 r116924: * src/alloc.c: Keep track of symbols referenced from pure space (bug#17168).

[Stefan Monnier]

------------------------------------------------------------
revno: 116924
revision-id: address@hidden
parent: address@hidden
committer: Stefan Monnier <address@hidden>
branch nick: emacs-24
timestamp: Mon 2014-04-07 12:08:46 -0400
message:
  * 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'.
modified:
  src/ChangeLog                  changelog-20091113204419-o5vbwnq5f7feedwu-1438
  src/alloc.c                    alloc.c-20091113204419-o5vbwnq5f7feedwu-252
  src/lisp.h                     lisp.h-20091113204419-o5vbwnq5f7feedwu-253

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2014-04-05 18:33:55 +0000
+++ b/src/ChangeLog     2014-04-07 16:08:46 +0000
@@ -1,3 +1,18 @@
+2014-04-07  Stefan Monnier  <address@hidden>
+
+       * 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  <address@hidden>
 
        * keyboard.c (Fopen_dribble_file): Doc tweak.

=== modified file 'src/alloc.c'
--- a/src/alloc.c       2014-03-20 14:09:37 +0000
+++ b/src/alloc.c       2014-04-07 16:08:46 +0000
@@ -3316,6 +3316,13 @@
 
 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 @@
   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 @@
   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 @@
   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 @@
 {
   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 @@
        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 @@
       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 @@
   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 @@
   for (i = 0; i < staticidx; i++)
     mark_object (*staticvec[i]);
 
+  mark_pinned_symbols ();
   mark_specpdl ();
   mark_terminals ();
   mark_kboards ();
@@ -6536,12 +6587,7 @@
 
        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 @@
            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;
              }
          }

=== modified file 'src/lisp.h'
--- a/src/lisp.h        2014-03-25 02:47:39 +0000
+++ b/src/lisp.h        2014-04-07 16:08:46 +0000
@@ -1568,6 +1568,9 @@
      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;