This parameterizes the GC a bit to make it thread-ready.

The basic idea is that whenever a thread "exits lisp" -- that is,
releases the global lock in favor of another thread -- it must save
its stack boundaries in the thread object.  This way the boundaries
are always available for marking.  This is the purpose of
flush_stack_call_func.

I haven't tested this under all the possible GC configurations.
There is a new FIXME in a spot that i didn't convert.

Arguably all_threads should go in the previous patch.

6 files changed, 140 insertions, 64 deletions

diff --git a/src/alloc.c b/src/alloc.c
index bdf7b24af04..dfae2d1ef67 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -387,7 +387,6 @@ static struct mem_node mem_z;
 
 static struct Lisp_Vector *allocate_vectorlike (ptrdiff_t);
 static void lisp_free (void *);
-static void mark_stack (void);
 static int live_vector_p (struct mem_node *, void *);
 static int live_buffer_p (struct mem_node *, void *);
 static int live_string_p (struct mem_node *, void *);
@@ -4865,8 +4864,27 @@ dump_zombies (void)
    would be necessary, each one starting with one byte more offset
    from the stack start.  */
 
-static void
-mark_stack (void)
+void
+mark_stack (char *bottom, char *end)
+{
+  /* This assumes that the stack is a contiguous region in memory.  If
+     that's not the case, something has to be done here to iterate
+     over the stack segments.  */
+  mark_memory (bottom, end);
+
+  /* Allow for marking a secondary stack, like the register stack on the
+     ia64.  */
+#ifdef GC_MARK_SECONDARY_STACK
+  GC_MARK_SECONDARY_STACK ();
+#endif
+
+#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
+  check_gcpros ();
+#endif
+}
+
+void
+flush_stack_call_func (void (*func) (void *arg), void *arg)
 {
   void *end;
 
@@ -4922,20 +4940,8 @@ mark_stack (void)
 #endif /* not GC_SAVE_REGISTERS_ON_STACK */
 #endif /* not HAVE___BUILTIN_UNWIND_INIT */
 
-  /* This assumes that the stack is a contiguous region in memory.  If
-     that's not the case, something has to be done here to iterate
-     over the stack segments.  */
-  mark_memory (stack_bottom, end);
-
-  /* Allow for marking a secondary stack, like the register stack on the
-     ia64.  */
-#ifdef GC_MARK_SECONDARY_STACK
-  GC_MARK_SECONDARY_STACK ();
-#endif
-
-#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
-  check_gcpros ();
-#endif
+  current_thread->stack_top = end;
+  (*func) (arg);
 }
 
 #endif /* GC_MARK_STACK != 0 */
@@ -5457,11 +5463,7 @@ See Info node `(elisp)Garbage Collection'.  */)
   for (i = 0; i < staticidx; i++)
     mark_object (*staticvec[i]);
 
-  for (bind = specpdl; bind != specpdl_ptr; bind++)
-    {
-      mark_object (bind->symbol);
-      mark_object (bind->old_value);
-    }
+  mark_threads ();
   mark_terminals ();
   mark_kboards ();
   mark_ttys ();
@@ -5473,40 +5475,12 @@ See Info node `(elisp)Garbage Collection'.  */)
   }
 #endif
 
-#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
-     || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS)
-  mark_stack ();
-#else
-  {
-    register struct gcpro *tail;
-    for (tail = gcprolist; tail; tail = tail->next)
-      for (i = 0; i < tail->nvars; i++)
-        mark_object (tail->var[i]);
-  }
-  mark_byte_stack ();
-  {
-    struct catchtag *catch;
-    struct handler *handler;
-
-  for (catch = catchlist; catch; catch = catch->next)
-    {
-      mark_object (catch->tag);
-      mark_object (catch->val);
-    }
-  for (handler = handlerlist; handler; handler = handler->next)
-    {
-      mark_object (handler->handler);
-      mark_object (handler->var);
-    }
-  }
-  mark_backtrace ();
-#endif
-
 #ifdef HAVE_WINDOW_SYSTEM
   mark_fringe_data ();
 #endif
 
 #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
+  FIXME;
   mark_stack ();
 #endif
 
@@ -5556,7 +5530,7 @@ See Info node `(elisp)Garbage Collection'.  */)
 
   /* Clear the mark bits that we set in certain root slots.  */
 
-  unmark_byte_stack ();
+  unmark_threads ();
   VECTOR_UNMARK (&buffer_defaults);
   VECTOR_UNMARK (&buffer_local_symbols);
 
diff --git a/src/bytecode.c b/src/bytecode.c
index 019459491e9..d61e37d7886 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -335,12 +335,11 @@ struct byte_stack
 
 #if BYTE_MARK_STACK
 void
-mark_byte_stack (void)
+mark_byte_stack (struct byte_stack *stack)
 {
-  struct byte_stack *stack;
   Lisp_Object *obj;
 
-  for (stack = byte_stack_list; stack; stack = stack->next)
+  for (; stack; stack = stack->next)
     {
       /* If STACK->top is null here, this means there's an opcode in
          Fbyte_code that wasn't expected to GC, but did.  To find out
@@ -364,11 +363,9 @@ mark_byte_stack (void)
    counters.  Called when GC has completed.  */
 
 void
-unmark_byte_stack (void)
+unmark_byte_stack (struct byte_stack *stack)
 {
-  struct byte_stack *stack;
-
-  for (stack = byte_stack_list; stack; stack = stack->next)
+  for (; stack; stack = stack->next)
     {
       if (stack->byte_string_start != SDATA (stack->byte_string))
         {
diff --git a/src/eval.c b/src/eval.c
index 768cdc1a8f8..49ead499044 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -165,6 +165,19 @@ init_eval (void)
   when_entered_debugger = -1;
 }
 
+#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
+     || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS)
+void
+mark_catchlist (struct catchtag *catch)
+{
+  for (; catch; catch = catch->next)
+    {
+      mark_object (catch->tag);
+      mark_object (catch->val);
+    }
+}
+#endif
+
 /* Unwind-protect function used by call_debugger.  */
 
 static Lisp_Object
diff --git a/src/lisp.h b/src/lisp.h
index 0367d9938b7..a6665320da6 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2715,6 +2715,10 @@ extern void mark_object (Lisp_Object);
 #if defined REL_ALLOC && !defined SYSTEM_MALLOC
 extern void refill_memory_reserve (void);
 #endif
+#if GC_MARK_STACK
+extern void mark_stack (char *, char *);
+#endif
+extern void flush_stack_call_func (void (*func) (void *arg), void *arg);
 extern const char *pending_malloc_warning;
 extern Lisp_Object zero_vector;
 extern EMACS_INT consing_since_gc;
@@ -2902,6 +2906,10 @@ extern Lisp_Object Vautoload_queue;
 extern Lisp_Object Vsignaling_function;
 extern Lisp_Object inhibit_lisp_code;
 extern int handling_signal;
+#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
+     || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS)
+extern void mark_catchlist (struct catchtag *);
+#endif
 /* To run a normal hook, use the appropriate function from the list below.
    The calling convention:
 
@@ -2951,11 +2959,11 @@ extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...);
 extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
 extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object);
 extern void init_eval (void);
-#if BYTE_MARK_STACK
-extern void mark_backtrace (void);
-#endif
 extern void syms_of_eval (void);
 
+/* Defined in thread.c.  */
+extern void mark_threads (void);
+
 /* Defined in editfns.c.  */
 extern Lisp_Object Qfield;
 extern void insert1 (Lisp_Object);
@@ -3211,9 +3219,9 @@ extern int read_bytecode_char (int);
 extern Lisp_Object Qbytecode;
 extern void syms_of_bytecode (void);
 #if BYTE_MARK_STACK
-extern void mark_byte_stack (void);
+extern void mark_byte_stack (struct byte_stack *);
 #endif
-extern void unmark_byte_stack (void);
+extern void unmark_byte_stack (struct byte_stack *);
 extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object,
                                    Lisp_Object, ptrdiff_t, Lisp_Object *);
 
diff --git a/src/thread.c b/src/thread.c
index 0bd97b4fd8e..ba2d66320fa 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -24,3 +24,82 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 struct thread_state the_only_thread;
 
 struct thread_state *current_thread = &the_only_thread;
+
+struct thread_state *all_threads = &the_only_thread;
+
+static void
+mark_one_thread (struct thread_state *thread)
+{
+  register struct specbinding *bind;
+  struct handler *handler;
+  Lisp_Object tem;
+
+  for (bind = thread->m_specpdl; bind != thread->m_specpdl_ptr; bind++)
+    {
+      mark_object (bind->symbol);
+      mark_object (bind->old_value);
+    }
+
+#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
+     || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS)
+  mark_stack (thread->m_stack_bottom, thread->stack_top);
+#else
+  {
+    register struct gcpro *tail;
+    for (tail = thread->m_gcprolist; tail; tail = tail->next)
+      for (i = 0; i < tail->nvars; i++)
+        mark_object (tail->var[i]);
+  }
+
+#if BYTE_MARK_STACK
+  if (thread->m_byte_stack_list)
+    mark_byte_stack (thread->m_byte_stack_list);
+#endif
+
+  mark_catchlist (thread->m_catchlist);
+
+  for (handler = thread->m_handlerlist; handler; handler = handler->next)
+    {
+      mark_object (handler->handler);
+      mark_object (handler->var);
+    }
+
+  mark_backtrace (thread->m_backtrace_list);
+#endif
+
+  if (thread->m_current_buffer)
+    {
+      XSETBUFFER (tem, thread->m_current_buffer);
+      mark_object (tem);
+    }
+
+  mark_object (thread->m_last_thing_searched);
+
+  if (thread->m_saved_last_thing_searched)
+    mark_object (thread->m_saved_last_thing_searched);
+}
+
+static void
+mark_threads_callback (void *ignore)
+{
+  struct thread_state *iter;
+
+  for (iter = all_threads; iter; iter = iter->next_thread)
+    mark_one_thread (iter);
+}
+
+void
+mark_threads (void)
+{
+  flush_stack_call_func (mark_threads_callback, NULL);
+}
+
+void
+unmark_threads (void)
+{
+  struct thread_state *iter;
+
+  for (iter = all_threads; iter; iter = iter->next_thread)
+    if (iter->m_byte_stack_list)
+      unmark_byte_stack (iter->m_byte_stack_list);
+}
diff --git a/src/thread.h b/src/thread.h
index b2eb04d42e8..6d61d0e5fcf 100644
--- a/src/thread.h
+++ b/src/thread.h
@@ -133,8 +133,13 @@ struct thread_state
   /* Regexp to use to replace spaces, or NULL meaning don't.  */
   /*re_char*/ unsigned char *m_whitespace_regexp;
 #define whitespace_regexp (current_thread->m_whitespace_regexp)
+
+  /* Threads are kept on a linked list.  */
+  struct thread_state *next_thread;
 };
 
 extern struct thread_state *current_thread;
 
+extern void unmark_threads (void);
+
 #endif /* THREAD_H */