emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master 7a8798de95: Reduce GC mark-phase recursion by using explicit stac


From: Mattias Engdegård
Subject: master 7a8798de95: Reduce GC mark-phase recursion by using explicit stack (bug#54698)
Date: Mon, 4 Apr 2022 13:18:05 -0400 (EDT)

branch: master
commit 7a8798de95a57c8ff85f070075e0a0176b458578
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    Reduce GC mark-phase recursion by using explicit stack (bug#54698)
    
    An explict stack of objects to be traversed for marking replaces
    recursion for most common object types: conses, vectors, records, hash
    tables, symbols, functions etc.  Recursion is still used for other
    types but those are less common and thus not as likely to cause a
    problem.
    
    The stack grows dynamically as required which eliminates almost all C
    stack overflow crashes in the GC.  There is also a nontrivial GC
    performance improvement.
    
    * src/alloc.c (GC_REMEMBER_LAST_MARKED, GC_CDR_COUNT): New.
    (mark_char_table, struct mark_entry):
    Remove (subsumed into process_mark_stack).
    (struct mark_entry, struct mark_stack, mark_stk)
    (mark_stack_empty_p, mark_stack_pop, grow_mark_stack)
    (mark_stack_push_value, mark_stack_push_values)
    (process_mark_stack): New.
    (mark_object, mark_objects):
    Just push the object(s) and let process_mark_stack do the work.
---
 src/alloc.c | 618 ++++++++++++++++++++++++++++++++++--------------------------
 1 file changed, 354 insertions(+), 264 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index b06dd943ba..71f2c199b2 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -6085,6 +6085,8 @@ maybe_garbage_collect (void)
     garbage_collect ();
 }
 
+static inline bool mark_stack_empty_p (void);
+
 /* Subroutine of Fgarbage_collect that does most of the work.  */
 void
 garbage_collect (void)
@@ -6100,6 +6102,8 @@ garbage_collect (void)
   if (garbage_collection_inhibited)
     return;
 
+  eassert(mark_stack_empty_p ());
+
   /* Record this function, so it appears on the profiler's backtraces.  */
   record_in_backtrace (QAutomatic_GC, 0, 0);
 
@@ -6222,6 +6226,8 @@ garbage_collect (void)
   mark_and_sweep_weak_table_contents ();
   eassert (weak_hash_tables == NULL);
 
+  eassert (mark_stack_empty_p ());
+
   gc_sweep ();
 
   unmark_main_thread ();
@@ -6395,15 +6401,25 @@ mark_glyph_matrix (struct glyph_matrix *matrix)
       }
 }
 
+/* Whether to remember a few of the last marked values for debugging.  */
+#define GC_REMEMBER_LAST_MARKED 0
+
+#if GC_REMEMBER_LAST_MARKED
 enum { LAST_MARKED_SIZE = 1 << 9 }; /* Must be a power of 2.  */
 Lisp_Object last_marked[LAST_MARKED_SIZE] EXTERNALLY_VISIBLE;
 static int last_marked_index;
+#endif
 
+/* Whether to enable the mark_object_loop_halt debugging feature.  */
+#define GC_CDR_COUNT 0
+
+#if GC_CDR_COUNT
 /* For debugging--call abort when we cdr down this many
    links of a list, in mark_object.  In debugging,
    the call to abort will hit a breakpoint.
    Normally this is zero and the check never goes off.  */
 ptrdiff_t mark_object_loop_halt EXTERNALLY_VISIBLE;
+#endif
 
 static void
 mark_vectorlike (union vectorlike_header *header)
@@ -6457,19 +6473,6 @@ mark_char_table (struct Lisp_Vector *ptr, enum pvec_type 
pvectype)
     }
 }
 
-NO_INLINE /* To reduce stack depth in mark_object.  */
-static Lisp_Object
-mark_compiled (struct Lisp_Vector *ptr)
-{
-  int i, size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
-
-  set_vector_marked (ptr);
-  for (i = 0; i < size; i++)
-    if (i != COMPILED_CONSTANTS)
-      mark_object (ptr->contents[i]);
-  return size > COMPILED_CONSTANTS ? ptr->contents[COMPILED_CONSTANTS] : Qnil;
-}
-
 /* Mark the chain of overlays starting at PTR.  */
 
 static void
@@ -6622,110 +6625,161 @@ mark_window (struct Lisp_Vector *ptr)
     (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
+/* Entry of the mark stack.  */
+struct mark_entry
+{
+  ptrdiff_t n;                 /* number of values, or 0 if a single value */
+  union {
+    Lisp_Object value;         /* when n = 0 */
+    Lisp_Object *values;       /* when n > 0 */
+  } u;
+};
+
+/* This stack is used during marking for traversing data structures without
+   using C recursion.  */
+struct mark_stack
+{
+  struct mark_entry *stack;    /* base of stack */
+  ptrdiff_t size;              /* allocated size in entries */
+  ptrdiff_t sp;                        /* current number of entries */
+};
+
+static struct mark_stack mark_stk = {NULL, 0, 0};
+
+static inline bool
+mark_stack_empty_p (void)
+{
+  return mark_stk.sp <= 0;
+}
+
+/* Pop and return a value from the mark stack (which must be nonempty).  */
+static inline Lisp_Object
+mark_stack_pop (void)
+{
+  eassume (!mark_stack_empty_p ());
+  struct mark_entry *e = &mark_stk.stack[mark_stk.sp - 1];
+  if (e->n == 0)               /* single value */
     {
-      eassert (h->next_weak == NULL);
-      h->next_weak = weak_hash_tables;
-      weak_hash_tables = h;
-      set_vector_marked (XVECTOR (h->key_and_value));
+      --mark_stk.sp;
+      return e->u.value;
     }
+  /* Array of values: pop them left to right, which seems to be slightly
+     faster than right to left.  */
+  e->n--;
+  if (e->n == 0)
+    --mark_stk.sp;             /* last value consumed */
+  return (++e->u.values)[-1];
 }
 
-void
-mark_objects (Lisp_Object *obj, ptrdiff_t n)
+NO_INLINE static void
+grow_mark_stack (void)
 {
-  for (ptrdiff_t i = 0; i < n; i++)
-    mark_object (obj[i]);
+  struct mark_stack *ms = &mark_stk;
+  eassert (ms->sp == ms->size);
+  ptrdiff_t min_incr = ms->sp == 0 ? 8192 : 1;
+  ptrdiff_t oldsize = ms->size;
+  ms->stack = xpalloc (ms->stack, &ms->size, min_incr, -1, sizeof *ms->stack);
+  eassert (ms->sp < ms->size);
 }
 
-/* Determine type of generic Lisp_Object and mark it accordingly.
+/* Push VALUE onto the mark stack.  */
+static inline void
+mark_stack_push_value (Lisp_Object value)
+{
+  if (mark_stk.sp >= mark_stk.size)
+    grow_mark_stack ();
+  mark_stk.stack[mark_stk.sp++] = (struct mark_entry){.n = 0, .u.value = 
value};
+}
 
-   This function implements a straightforward depth-first marking
-   algorithm and so the recursion depth may be very high (a few
-   tens of thousands is not uncommon).  To minimize stack usage,
-   a few cold paths are moved out to NO_INLINE functions above.
-   In general, inlining them doesn't help you to gain more speed.  */
+/* Push the N values at VALUES onto the mark stack.  */
+static inline void
+mark_stack_push_values (Lisp_Object *values, ptrdiff_t n)
+{
+  eassume (n >= 0);
+  if (n == 0)
+    return;
+  if (mark_stk.sp >= mark_stk.size)
+    grow_mark_stack ();
+  mark_stk.stack[mark_stk.sp++] = (struct mark_entry){.n = n,
+                                                     .u.values = values};
+}
 
-void
-mark_object (Lisp_Object arg)
+/* Traverse and mark objects on the mark stack above BASE_SP.
+
+   Traversal is depth-first using the mark stack for most common
+   object types.  Recursion is used for other types, in the hope that
+   they are rare enough that C stack usage is kept low.  */
+static void
+process_mark_stack (ptrdiff_t base_sp)
 {
-  register Lisp_Object obj;
-  void *po;
 #if GC_CHECK_MARKED_OBJECTS
   struct mem_node *m = NULL;
 #endif
+#if GC_CDR_COUNT
   ptrdiff_t cdr_count = 0;
+#endif
 
-  obj = arg;
- loop:
+  eassume (mark_stk.sp >= base_sp && base_sp >= 0);
 
-  po = XPNTR (obj);
-  if (PURE_P (po))
-    return;
+  while (mark_stk.sp > base_sp)
+    {
+      Lisp_Object obj = mark_stack_pop ();
+    mark_obj: ;
+      void *po = XPNTR (obj);
+      if (PURE_P (po))
+       continue;
 
-  last_marked[last_marked_index++] = obj;
-  last_marked_index &= LAST_MARKED_SIZE - 1;
+#if GC_REMEMBER_LAST_MARKED
+      last_marked[last_marked_index++] = obj;
+      last_marked_index &= LAST_MARKED_SIZE - 1;
+#endif
 
-  /* Perform some sanity checks on the objects marked here.  Abort if
-     we encounter an object we know is bogus.  This increases GC time
-     by ~80%.  */
+      /* Perform some sanity checks on the objects marked here.  Abort if
+        we encounter an object we know is bogus.  This increases GC time
+        by ~80%.  */
 #if GC_CHECK_MARKED_OBJECTS
 
-  /* Check that the object pointed to by PO is known to be a Lisp
-     structure allocated from the heap.  */
+      /* Check that the object pointed to by PO is known to be a Lisp
+        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 ();                          \
-  } while (0)
-
-  /* Check that the object pointed to by PO is live, using predicate
-     function LIVEP.  */
-#define CHECK_LIVE(LIVEP, MEM_TYPE)            \
-  do {                                         \
-    if (pdumper_object_p (po))                 \
-      break;                                    \
-    if (! (m->type == MEM_TYPE && LIVEP (m, po))) \
-      emacs_abort ();                          \
-  } while (0)
-
-  /* Check both of the above conditions, for non-symbols.  */
-#define CHECK_ALLOCATED_AND_LIVE(LIVEP, MEM_TYPE) \
-  do {                                         \
-    CHECK_ALLOCATED ();                                \
-    CHECK_LIVE (LIVEP, MEM_TYPE);              \
-  } while (false)
-
-  /* Check both of the above conditions, for symbols.  */
-#define CHECK_ALLOCATED_AND_LIVE_SYMBOL()      \
-  do {                                         \
-    if (!c_symbol_p (ptr))                     \
-      {                                                \
-       CHECK_ALLOCATED ();                     \
-       CHECK_LIVE (live_symbol_p, MEM_TYPE_SYMBOL); \
-      }                                                \
-  } while (false)
+      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 ();                       \
+      } while (0)
+
+      /* Check that the object pointed to by PO is live, using predicate
+        function LIVEP.  */
+#define CHECK_LIVE(LIVEP, MEM_TYPE)                    \
+      do {                                             \
+       if (pdumper_object_p (po))                      \
+         break;                                        \
+       if (! (m->type == MEM_TYPE && LIVEP (m, po)))   \
+         emacs_abort ();                               \
+      } while (0)
+
+      /* Check both of the above conditions, for non-symbols.  */
+#define CHECK_ALLOCATED_AND_LIVE(LIVEP, MEM_TYPE)      \
+      do {                                             \
+       CHECK_ALLOCATED ();                             \
+       CHECK_LIVE (LIVEP, MEM_TYPE);                   \
+      } while (false)
+
+      /* Check both of the above conditions, for symbols.  */
+#define CHECK_ALLOCATED_AND_LIVE_SYMBOL()                      \
+      do {                                                     \
+       if (!c_symbol_p (ptr))                                  \
+         {                                                     \
+           CHECK_ALLOCATED ();                                 \
+           CHECK_LIVE (live_symbol_p, MEM_TYPE_SYMBOL);        \
+         }                                                     \
+      } while (false)
 
 #else /* not GC_CHECK_MARKED_OBJECTS */
 
@@ -6734,200 +6788,220 @@ mark_object (Lisp_Object arg)
 
 #endif /* not GC_CHECK_MARKED_OBJECTS */
 
-  switch (XTYPE (obj))
-    {
-    case Lisp_String:
-      {
-       register struct Lisp_String *ptr = XSTRING (obj);
-        if (string_marked_p (ptr))
-          break;
-       CHECK_ALLOCATED_AND_LIVE (live_string_p, MEM_TYPE_STRING);
-        set_string_marked (ptr);
-        mark_interval_tree (ptr->u.s.intervals);
+      switch (XTYPE (obj))
+       {
+       case Lisp_String:
+         {
+           register struct Lisp_String *ptr = XSTRING (obj);
+           if (string_marked_p (ptr))
+             break;
+           CHECK_ALLOCATED_AND_LIVE (live_string_p, MEM_TYPE_STRING);
+           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.  */
-       string_bytes (ptr);
+           /* Check that the string size recorded in the string is the
+              same as the one recorded in the sdata structure.  */
+           string_bytes (ptr);
 #endif /* GC_CHECK_STRING_BYTES */
-      }
-      break;
+         }
+         break;
 
-    case Lisp_Vectorlike:
-      {
-       register struct Lisp_Vector *ptr = XVECTOR (obj);
+       case Lisp_Vectorlike:
+         {
+           register struct Lisp_Vector *ptr = XVECTOR (obj);
 
-       if (vector_marked_p (ptr))
-         break;
+           if (vector_marked_p (ptr))
+             break;
 
-        enum pvec_type pvectype
-          = PSEUDOVECTOR_TYPE (ptr);
+           enum pvec_type pvectype
+             = PSEUDOVECTOR_TYPE (ptr);
 
 #ifdef GC_CHECK_MARKED_OBJECTS
-        if (!pdumper_object_p (po) && !SUBRP (obj) && !main_thread_p (po))
-          {
-           m = mem_find (po);
-           if (m == MEM_NIL)
-             emacs_abort ();
-           if (m->type == MEM_TYPE_VECTORLIKE)
-             CHECK_LIVE (live_large_vector_p, MEM_TYPE_VECTORLIKE);
-           else
-             CHECK_LIVE (live_small_vector_p, MEM_TYPE_VECTOR_BLOCK);
-          }
+           if (!pdumper_object_p (po) && !SUBRP (obj) && !main_thread_p (po))
+             {
+               m = mem_find (po);
+               if (m == MEM_NIL)
+                 emacs_abort ();
+               if (m->type == MEM_TYPE_VECTORLIKE)
+                 CHECK_LIVE (live_large_vector_p, MEM_TYPE_VECTORLIKE);
+               else
+                 CHECK_LIVE (live_small_vector_p, MEM_TYPE_VECTOR_BLOCK);
+             }
 #endif
 
-       switch (pvectype)
-         {
-         case PVEC_BUFFER:
-           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:
-            mark_frame (ptr);
-            break;
-
-          case PVEC_WINDOW:
-            mark_window (ptr);
-            break;
-
-         case PVEC_HASH_TABLE:
-            mark_hash_table (ptr);
-           break;
-
-         case PVEC_CHAR_TABLE:
-         case PVEC_SUB_CHAR_TABLE:
-           mark_char_table (ptr, (enum pvec_type) pvectype);
-           break;
-
-          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;
-
-         case PVEC_SUBR:
-#ifdef HAVE_NATIVE_COMP
-           if (SUBR_NATIVE_COMPILEDP (obj))
+           switch (pvectype)
              {
+             case PVEC_BUFFER:
+               mark_buffer ((struct buffer *) ptr);
+               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;
+                 ptrdiff_t size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
+                 set_vector_marked (ptr);
+                 mark_stack_push_values (ptr->contents, size);
+                 mark_stack_push_value (h->test.name);
+                 mark_stack_push_value (h->test.user_hash_function);
+                 mark_stack_push_value (h->test.user_cmp_function);
+                 if (NILP (h->weak))
+                   mark_stack_push_value (h->key_and_value);
+                 else
+                   {
+                     /* For weak tables, mark only the vector and not its
+                        contents --- that's what makes it weak.  */
+                     eassert (h->next_weak == NULL);
+                     h->next_weak = weak_hash_tables;
+                     weak_hash_tables = h;
+                     set_vector_marked (XVECTOR (h->key_and_value));
+                   }
+                 break;
+               }
+
+             case PVEC_CHAR_TABLE:
+             case PVEC_SUB_CHAR_TABLE:
+               mark_char_table (ptr, (enum pvec_type) pvectype);
+               break;
+
+             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);
-               struct Lisp_Subr *subr = XSUBR (obj);
-               mark_object (subr->native_intspec);
-               mark_object (subr->command_modes);
-               mark_object (subr->native_comp_u);
-               mark_object (subr->lambda_list);
-               mark_object (subr->type);
-             }
+               break;
+
+             case PVEC_OVERLAY:
+               mark_overlay (XOVERLAY (obj));
+               break;
+
+             case PVEC_SUBR:
+#ifdef HAVE_NATIVE_COMP
+               if (SUBR_NATIVE_COMPILEDP (obj))
+                 {
+                   set_vector_marked (ptr);
+                   struct Lisp_Subr *subr = XSUBR (obj);
+                   mark_stack_push_value (subr->native_intspec);
+                   mark_stack_push_value (subr->command_modes);
+                   mark_stack_push_value (subr->native_comp_u);
+                   mark_stack_push_value (subr->lambda_list);
+                   mark_stack_push_value (subr->type);
+                 }
 #endif
-           break;
+               break;
 
-         case PVEC_FREE:
-           emacs_abort ();
+             case PVEC_FREE:
+               emacs_abort ();
 
-         default:
-           /* A regular vector, or a pseudovector needing no special
-              treatment.  */
-           mark_vectorlike (&ptr->header);
+             default:
+               {
+                 /* A regular vector or pseudovector needing no special
+                    treatment.  */
+                 ptrdiff_t size = ptr->header.size;
+                 if (size & PSEUDOVECTOR_FLAG)
+                   size &= PSEUDOVECTOR_SIZE_MASK;
+                 set_vector_marked (ptr);
+                 mark_stack_push_values (ptr->contents, size);
+               }
+               break;
+             }
          }
-      }
-      break;
+         break;
 
-    case Lisp_Symbol:
-      {
-       struct Lisp_Symbol *ptr = XBARE_SYMBOL (obj);
-      nextsym:
-        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);
-       mark_object (ptr->u.s.plist);
-       switch (ptr->u.s.redirect)
+       case Lisp_Symbol:
          {
-         case SYMBOL_PLAINVAL: mark_object (SYMBOL_VAL (ptr)); break;
-         case SYMBOL_VARALIAS:
-           {
-             Lisp_Object tem;
-             XSETSYMBOL (tem, SYMBOL_ALIAS (ptr));
-             mark_object (tem);
+           struct Lisp_Symbol *ptr = XBARE_SYMBOL (obj);
+         nextsym:
+           if (symbol_marked_p (ptr))
              break;
-           }
-         case SYMBOL_LOCALIZED:
-           mark_localized_symbol (ptr);
-           break;
-         case SYMBOL_FORWARDED:
-           /* If the value is forwarded to a buffer or keyboard field,
-              these are marked when we see the corresponding object.
-              And if it's forwarded to a C variable, either it's not
-              a Lisp_Object var, or it's staticpro'd already.  */
-           break;
-         default: emacs_abort ();
+           CHECK_ALLOCATED_AND_LIVE_SYMBOL ();
+           set_symbol_marked (ptr);
+           /* Attempt to catch bogus objects.  */
+           eassert (valid_lisp_object_p (ptr->u.s.function));
+           mark_stack_push_value (ptr->u.s.function);
+           mark_stack_push_value (ptr->u.s.plist);
+           switch (ptr->u.s.redirect)
+             {
+             case SYMBOL_PLAINVAL:
+               mark_stack_push_value (SYMBOL_VAL (ptr));
+               break;
+             case SYMBOL_VARALIAS:
+               {
+                 Lisp_Object tem;
+                 XSETSYMBOL (tem, SYMBOL_ALIAS (ptr));
+                 mark_stack_push_value (tem);
+                 break;
+               }
+             case SYMBOL_LOCALIZED:
+               mark_localized_symbol (ptr);
+               break;
+             case SYMBOL_FORWARDED:
+               /* If the value is forwarded to a buffer or keyboard field,
+                  these are marked when we see the corresponding object.
+                  And if it's forwarded to a C variable, either it's not
+                  a Lisp_Object var, or it's staticpro'd already.  */
+               break;
+             default: emacs_abort ();
+             }
+           if (!PURE_P (XSTRING (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)
+             goto nextsym;
          }
-       if (!PURE_P (XSTRING (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)
-         goto nextsym;
-      }
-      break;
-
-    case Lisp_Cons:
-      {
-       struct Lisp_Cons *ptr = XCONS (obj);
-       if (cons_marked_p (ptr))
          break;
-       CHECK_ALLOCATED_AND_LIVE (live_cons_p, MEM_TYPE_CONS);
-        set_cons_marked (ptr);
-       /* If the cdr is nil, avoid recursion for the car.  */
-       if (NILP (ptr->u.s.u.cdr))
+
+       case Lisp_Cons:
          {
+           struct Lisp_Cons *ptr = XCONS (obj);
+           if (cons_marked_p (ptr))
+             break;
+           CHECK_ALLOCATED_AND_LIVE (live_cons_p, MEM_TYPE_CONS);
+           set_cons_marked (ptr);
+           /* Avoid growing the stack if the cdr is nil.
+              In any case, make sure the car is expanded first.  */
+           if (!NILP (ptr->u.s.u.cdr))
+             {
+               mark_stack_push_value (ptr->u.s.u.cdr);
+#if GC_CDR_COUNT
+               cdr_count++;
+               if (cdr_count == mark_object_loop_halt)
+                 emacs_abort ();
+#endif
+             }
+           /* Speedup hack for the common case (successive list elements).  */
            obj = ptr->u.s.car;
-           cdr_count = 0;
-           goto loop;
+           goto mark_obj;
          }
-       mark_object (ptr->u.s.car);
-       obj = ptr->u.s.u.cdr;
-       cdr_count++;
-       if (cdr_count == mark_object_loop_halt)
-         emacs_abort ();
-       goto loop;
-      }
 
-    case Lisp_Float:
-      CHECK_ALLOCATED_AND_LIVE (live_float_p, MEM_TYPE_FLOAT);
-      /* 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_Float:
+         CHECK_ALLOCATED_AND_LIVE (live_float_p, MEM_TYPE_FLOAT);
+         /* 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:
-      break;
+       case_Lisp_Int:
+         break;
 
-    default:
-      emacs_abort ();
+       default:
+         emacs_abort ();
+       }
     }
 
 #undef CHECK_LIVE
@@ -6935,6 +7009,22 @@ mark_object (Lisp_Object arg)
 #undef CHECK_ALLOCATED_AND_LIVE
 }
 
+void
+mark_object (Lisp_Object obj)
+{
+  ptrdiff_t sp = mark_stk.sp;
+  mark_stack_push_value (obj);
+  process_mark_stack (sp);
+}
+
+void
+mark_objects (Lisp_Object *objs, ptrdiff_t n)
+{
+  ptrdiff_t sp = mark_stk.sp;
+  mark_stack_push_values (objs, n);
+  process_mark_stack (sp);
+}
+
 /* Mark the Lisp pointers in the terminal objects.
    Called by Fgarbage_collect.  */
 



reply via email to

[Prev in Thread] Current Thread [Next in Thread]