From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Tue, 18 Aug 2015 07:11:23 +0000 (-0700)
Subject: Add SMP GC primitives and use them (with 1 processor).
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5947e1117b3037369aa40b7857d0e45487b6b174;p=mit-scheme.git

Add SMP GC primitives and use them (with 1 processor).

Add SMP-GC-LOCK, SMP-GC-UNLOCK and SMP-GC-WAIT.  Add a stub for the
remaining unimplemented SMP primitive: SMP-LOCK-OBARRAY.  Make
SMP-COUNT return 1 so that the runtime system sets enable-smp? and
calls the new primitives.

Drop the threads_mutex (but keep threads_processor set) in SMP-GC-LOCK
so that processors waiting to enter the thread system (in
SMP-LOCK-THREADS) will wake, enter the GC-WAIT state, then try again.
---

diff --git a/src/microcode/fasdump.c b/src/microcode/fasdump.c
index 655950913..ed17031ec 100644
--- a/src/microcode/fasdump.c
+++ b/src/microcode/fasdump.c
@@ -141,6 +141,9 @@ at by compiled code are ignored (and discarded).")
     error_bad_range_arg (2);
   transaction_record_action (tat_always, close_fasl_file, (&ff_info));
 
+#ifdef ENABLE_SMP
+  assert (gc_processor == self);
+#endif
   open_tospace (heap_start);
   /* This must be _before_ the call to initialize_fixups(): */
   transaction_record_action (tat_abort, abort_fasdump, 0);
diff --git a/src/microcode/intern.c b/src/microcode/intern.c
index 21d29f5f7..a4808a035 100644
--- a/src/microcode/intern.c
+++ b/src/microcode/intern.c
@@ -265,3 +265,12 @@ Equivalent to (MODULO (STRING-HASH STRING) DENOMINATOR).")
 			% (arg_ulong_integer (2))));
   }
 }
+
+DEFINE_PRIMITIVE ("SMP-LOCK-OBARRAY", Prim_smp_lock_obarray, 1, 1,
+		  "(SMP-LOCK-OBARRAY LOCK?)\n\
+When LOCK? is #F/non-#F, unlock/lock the pthread mutex serializing\n\
+access to the obarray.  Value is #T unless there was an error.")
+{
+  PRIMITIVE_HEADER (1);
+  PRIMITIVE_RETURN (SHARP_T);
+}
diff --git a/src/microcode/memmag.c b/src/microcode/memmag.c
index ae61b8c66..afd406599 100644
--- a/src/microcode/memmag.c
+++ b/src/microcode/memmag.c
@@ -270,6 +270,9 @@ the primitive GC daemons before returning.")
   if (GC_Debug == true) verify_heap ();
 #endif
 
+#ifdef ENABLE_SMP
+  assert (gc_processor == self);
+#endif
   open_tospace (heap_start);
   initialize_weak_chain ();
   ephemeron_count = 0;
diff --git a/src/microcode/ossmp.h b/src/microcode/ossmp.h
index 2c0cd8e65..899046e0e 100644
--- a/src/microcode/ossmp.h
+++ b/src/microcode/ossmp.h
@@ -31,19 +31,31 @@ USA.
 
 #include <pthread.h>
 
+typedef enum {
+  PROCESSOR_NEW,
+  PROCESSOR_RUNNING,
+  PROCESSOR_IDLE,
+  PROCESSOR_GC_WAIT,
+  PROCESSOR_DEAD
+} processor_state_t;
+
 typedef struct processor processor_t;
 
 struct processor {
   struct processor *next;
   char id;
+  processor_state_t state;
   pthread_t pthread;
 };
 
 extern processor_t *processors;
 extern __thread processor_t *self;
+extern processor_t *gc_processor;
 
 extern void setup_processors (int count);
 
+extern void smp_kill_gc (processor_t *);
+
 #ifdef ENABLE_DEBUGGING_TOOLS
 
 extern bool smp_trace_p;
diff --git a/src/microcode/prossmp.c b/src/microcode/prossmp.c
index c4dac3130..e5b7f8ef0 100644
--- a/src/microcode/prossmp.c
+++ b/src/microcode/prossmp.c
@@ -36,6 +36,19 @@ USA.
 /* The chain of processors, starting with processor0 -- main()'s thread: */
 processor_t *processors;
 
+/* The mutex that serializes processor state changes, including the
+   gc_processor variable. */
+pthread_mutex_t state_mutex = MUTEX_INITIALIZER;
+
+/* The processor running the garbage collector. */
+processor_t *gc_processor = NULL;
+
+/* The condition variable on which GC-WAIT processors wait. */
+static pthread_cond_t finished = PTHREAD_COND_INITIALIZER;
+
+/* The condition variable on which the gc_processor waits. */
+static pthread_cond_t ready = PTHREAD_COND_INITIALIZER;
+
 /* The mutex that serializes the thread system. */
 static pthread_mutex_t threads_mutex = MUTEX_INITIALIZER;
 
@@ -47,7 +60,7 @@ __thread processor_t *self;
 
 #ifdef ENABLE_DEBUGGING_TOOLS
 
-bool smp_trace_p = true;
+bool smp_trace_p = false;
 
 static void
 trace (const char * format, ...)
@@ -65,6 +78,65 @@ trace (const char * format, ...)
 
 #endif
 
+static void
+fatal (const char * format, ...)
+{
+  va_list args;
+  va_start (args, format);
+  voutf_fatal (format, args);
+  va_end (args);
+  outf_flush_fatal ();
+  self->state = PROCESSOR_DEAD;
+  pthread_exit ((void*)self);
+  /* NOTREACHED */
+}
+
+static void pthread_error (int code);
+
+static void
+mutex_lock (pthread_mutex_t *mutex)
+{
+  int err = pthread_mutex_lock (mutex);
+  if (err != 0)
+    {
+      pthread_error (err);
+      fatal ("\n;%d pthread_mutex_lock failed: %d", self->id, err);
+    }
+}
+
+static void
+mutex_unlock (pthread_mutex_t *mutex)
+{
+  int err = pthread_mutex_unlock (mutex);
+  if (err != 0)
+    {
+      pthread_error (err);
+      fatal ("\n;%d pthread_mutex_unlock failed: %d", self->id, err);
+    }
+}
+
+static void
+cond_wait (pthread_cond_t *cond, pthread_mutex_t *mutex)
+{
+  int err = pthread_cond_wait (cond, mutex);
+  if (err != 0)
+    {
+      pthread_error (err);
+      fatal ("\n;%d pthread_cond_wait failed: %d", self->id, err);
+    }
+}
+
+static void
+cond_broadcast (pthread_cond_t *cond)
+{
+  int err = pthread_cond_broadcast (cond);
+  if (err != 0)
+    {
+      pthread_error (err);
+      fatal ("\n;%d pthread_cond_broadcast failed: %d", self->id, err);
+    }
+}
+
 static void
 pthread_error (int code)
 {
@@ -118,19 +190,71 @@ make_processors (int id)
     }
   new->next = processors;
   new->id = id;
+  new->state = PROCESSOR_NEW;
   processors = new;
 
   if (id > 0)
     make_processors (id - 1);
 }
 
-#endif /* ENABLE_SMP */
+static bool
+all_in (processor_state_t s)
+{
+  bool all = true;
+  for (processor_t *p = processors; p != NULL; p = p->next)
+    if (p->state != s)
+      {
+	all = false;
+	break;
+      }
+  return (all);
+}
+
+static void
+gc_wait (void)
+{
+  self->state = PROCESSOR_GC_WAIT;
+  if (all_in (PROCESSOR_GC_WAIT))
+    {
+      trace (";%d GC wait ready.", self->id);
+      cond_broadcast (&ready);
+    }
+  cond_wait (&finished, &state_mutex);
+  trace (";%d GC wait finished.", self->id);
 
+  assert (self->state == PROCESSOR_RUNNING);
+}
+
+static void
+interrupt_others (void)
+{
+  for (processor_t *p = processors; p != NULL; p = p->next)
+    if (p != self && p->state != PROCESSOR_GC_WAIT)
+      {
+	trace (";%d sending SIGUSR2 to %d", self->id, p->id);
+	smp_kill_gc (p);
+      }
+}
+
+static void
+smp_gc_wait (void)
+{
+  mutex_lock (&state_mutex);
+  CLEAR_INTERRUPT (INT_Global_GC);
+  gc_wait ();
+  mutex_unlock (&state_mutex);
+}
+#endif /* ENABLE_SMP */
+
 DEFINE_PRIMITIVE ("SMP-COUNT", Prim_smp_count, 0, 0, "(SMP-COUNT)\n\
 The number of concurrently running Symmetric Multi-Processors.")
 {
   PRIMITIVE_HEADER (0);
+#ifdef ENABLE_SMP
+  PRIMITIVE_RETURN (LONG_TO_FIXNUM (1));
+#else
   PRIMITIVE_RETURN (SHARP_F);
+#endif
 }
 
 DEFINE_PRIMITIVE ("SMP-ID", Prim_smp_id, 0, 0, "(SMP-ID)\n\
@@ -159,12 +283,94 @@ access to the thread system.")
       PRIMITIVE_RETURN (UNSPECIFIC);
     }
   else
-    {
-      mutex_lock (&threads_mutex);
-      threads_processor = self;
-      PRIMITIVE_RETURN (UNSPECIFIC);
-    }
+    while (true)
+      {
+	mutex_lock (&threads_mutex);
+	if (threads_processor == NULL)
+	  {
+	    threads_processor = self;
+	    PRIMITIVE_RETURN (UNSPECIFIC);
+	  }
+	else
+	  {
+	    assert (threads_processor != self);
+	    trace (";%d SMP-Lock-Threads: direct to GC-Wait.", self->id);
+	    mutex_unlock (&threads_mutex);
+	    smp_gc_wait ();
+	  }
+      }
 #else /* not ENABLE_SMP */
   PRIMITIVE_RETURN (UNSPECIFIC);
 #endif
 }
+
+DEFINE_PRIMITIVE ("SMP-GC-WAIT", Prim_smp_gc_wait, 0, 0, "(SMP-GC-WAIT)\n\
+Put the current processor in the GC-WAIT state.\n\
+Called by the global-gc interrupt handler.")
+{
+  PRIMITIVE_HEADER (0);
+#ifdef ENABLE_SMP
+  trace (";%d SMP-GC-Wait.", self->id);
+  smp_gc_wait ();
+  trace (";%d SMP-GC-Wait done.", self->id);
+#else
+  signal_error_from_primitive (ERR_UNIMPLEMENTED_PRIMITIVE);
+#endif
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
+
+DEFINE_PRIMITIVE ("SMP-GC-LOCK", Prim_smp_gc_lock, 0, 0,
+		  "(SMP-GC-LOCK)\n\
+Lock the heap; call all other processors to the GC-WAIT state.  Value is #T\n\
+when successful and #F if some other processor has locked the heap.")
+{
+  PRIMITIVE_HEADER (0);
+#ifdef ENABLE_SMP
+  trace (";%d SMP-GC-Lock.", self->id);
+  mutex_lock (&state_mutex);
+  if (gc_processor != NULL)
+    {
+      trace (";%d SMP-GC-Lock lost to %d.", self->id, gc_processor->id);
+      mutex_unlock (&state_mutex);
+      PRIMITIVE_RETURN (SHARP_F);
+    }
+  gc_processor = self;
+  self->state = PROCESSOR_GC_WAIT;
+  if (self == threads_processor)
+    mutex_unlock (&threads_mutex);
+  interrupt_others ();
+  if (! all_in (PROCESSOR_GC_WAIT))
+    {
+      trace (";%d SMP-GC-Lock waiting.", self->id);
+      cond_wait (&ready, &state_mutex);
+    }
+  trace (";%d SMP-GC-Lock ready.", self->id);
+  mutex_unlock (&state_mutex);
+#else
+  signal_error_from_primitive (ERR_UNIMPLEMENTED_PRIMITIVE);
+#endif
+  PRIMITIVE_RETURN (SHARP_T);
+}
+
+DEFINE_PRIMITIVE ("SMP-GC-UNLOCK", Prim_smp_gc_unlock, 0, 0,
+		  "(SMP-GC-UNLOCK)\n\
+Release other processors from the GC-WAIT state.")
+{
+  PRIMITIVE_HEADER (0);
+#ifdef ENABLE_SMP
+  trace (";%d SMP-GC-Unlock.", self->id);
+  mutex_lock (&state_mutex);
+  assert (gc_processor == self);
+  assert (all_in (PROCESSOR_GC_WAIT));
+  gc_processor = NULL;
+  for (processor_t *p = processors; p != NULL; p = p->next)
+    p->state = PROCESSOR_RUNNING;
+  if (self == threads_processor)
+    mutex_lock (&threads_mutex);
+  mutex_unlock (&state_mutex);
+  cond_broadcast (&finished);
+#else
+  signal_error_from_primitive (ERR_UNIMPLEMENTED_PRIMITIVE);
+#endif
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
diff --git a/src/microcode/purify.c b/src/microcode/purify.c
index fc25c42a9..03a66cb66 100644
--- a/src/microcode/purify.c
+++ b/src/microcode/purify.c
@@ -56,6 +56,9 @@ PURE? is ignored.")
   POP_PRIMITIVE_FRAME (3);
 
   ENTER_CRITICAL_SECTION ("purify");
+#ifdef ENABLE_SMP
+  assert (gc_processor == self);
+#endif
   heap_reserved = safety_margin;
   purify (object);
 
diff --git a/src/microcode/uxsig.c b/src/microcode/uxsig.c
index 952ddcaea..2f675f4c5 100644
--- a/src/microcode/uxsig.c
+++ b/src/microcode/uxsig.c
@@ -505,6 +505,21 @@ DEFUN_STD_HANDLER (sighnd_console_resize,
   request_console_resize_interrupt ();
 })
 
+#ifdef ENABLE_SMP
+
+static
+DEFUN_STD_HANDLER (sighnd_global_gc,
+{
+  REQUEST_INTERRUPT (INT_Global_GC);
+})
+
+void
+smp_kill_gc (processor_t *p)
+{
+  pthread_kill (p->pthread, SIGUSR2);
+}
+
+#endif /* ENABLE_SMP */
 
 /* The following conditionalization would more naturally be expressed
    by conditionalizing the code inside the handler, but the Sun
@@ -671,8 +686,12 @@ UX_initialize_signals (void)
   bind_handler (SIGALRM,	sighnd_timer);
   bind_handler (SIGVTALRM,	sighnd_timer);
   bind_handler (SIGUSR1,	sighnd_save_then_terminate);
+#ifndef ENABLE_SMP
 #ifdef HAVE_NICE
   bind_handler (SIGUSR2,	sighnd_renice);
+#endif
+#else
+  bind_handler (SIGUSR2,	sighnd_global_gc);
 #endif
   bind_handler (SIGCHLD,	sighnd_dead_subprocess);
   /* If this signal is ignored, then the system call that would have