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.

1 files changed, 354 insertions, 264 deletions

diff --git a/src/alloc.c b/src/alloc.c
index b06dd943ba5..71f2c199b22 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.  */