From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Tue, 18 Aug 2015 06:04:28 +0000 (-0700)
Subject: Add new primitives SMP-COUNT, SMP-ID and SMP-LOCK-THREADS.
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=02e1ef7ffcafc588bd1ef301fda7d637947057ff;p=mit-scheme.git

Add new primitives SMP-COUNT, SMP-ID and SMP-LOCK-THREADS.

Add new thread local variable "self", a pointer to a processor_t
describing the current processor.  Include the processor ID in
Do_Micro_Error messages.
---

diff --git a/src/microcode/ossmp.h b/src/microcode/ossmp.h
index 133409535..2c0cd8e65 100644
--- a/src/microcode/ossmp.h
+++ b/src/microcode/ossmp.h
@@ -31,10 +31,29 @@ USA.
 
 #include <pthread.h>
 
+typedef struct processor processor_t;
+
+struct processor {
+  struct processor *next;
+  char id;
+  pthread_t pthread;
+};
+
+extern processor_t *processors;
+extern __thread processor_t *self;
+
 extern void setup_processors (int count);
 
 #ifdef ENABLE_DEBUGGING_TOOLS
+
 extern bool smp_trace_p;
+
+#define MUTEX_INITIALIZER PTHREAD_ERRORCHECK_MUTEX_INITIALIZER_NP
+
+#else
+
+#define MUTEX_INITIALIZER PTHREAD_MUTEX_INITIALIZER
+
 #endif
 
 #endif /* ENABLE_SMP */
diff --git a/src/microcode/prossmp.c b/src/microcode/prossmp.c
index c3293e0bd..c4dac3130 100644
--- a/src/microcode/prossmp.c
+++ b/src/microcode/prossmp.c
@@ -31,6 +31,19 @@ USA.
 #ifdef ENABLE_SMP
 
 #include "option.h"
+#include <errno.h>
+
+/* The chain of processors, starting with processor0 -- main()'s thread: */
+processor_t *processors;
+
+/* The mutex that serializes the thread system. */
+static pthread_mutex_t threads_mutex = MUTEX_INITIALIZER;
+
+/* The processor that owns the threads_mutex. */
+static processor_t *threads_processor = NULL;
+
+/* The current pthread's processor. */
+__thread processor_t *self;
 
 #ifdef ENABLE_DEBUGGING_TOOLS
 
@@ -52,12 +65,106 @@ trace (const char * format, ...)
 
 #endif
 
+static void
+pthread_error (int code)
+{
+  switch (code)
+    {
+    case EINVAL:
+      outf_error_line (";%d pthread error: invalid", self->id);
+      break;
+    case EDEADLK:
+      outf_error_line (";%d pthread error: deadlock", self->id);
+      break;
+    case EBUSY:
+      outf_error_line (";%d pthread error: busy", self->id);
+      break;
+    case EPERM:
+      outf_error_line (";%d pthread error: permission", self->id);
+      break;
+    default:
+      outf_error_line (";%d pthread error: unknown %d", self->id, code);
+    }
+}
+
+static void make_processors (int);
+
 void
 setup_processors (int count)
 {
   trace ("; processor count: %d", option_processor_count);
   trace ("; local heap size: %d", option_processor_heap_size);
   trace (";      stack size: %d", option_stack_size);
+
+  make_processors (0);
+
+  self = processors;
+  assert (self->id == 0);
+  self->pthread = pthread_self ();
+}
+
+static void
+make_processors (int id)
+{
+  processor_t *new;
+
+  trace (";%d Setup.", id);
+  new = malloc (sizeof (processor_t));
+  if (new == NULL)
+    {
+      outf_fatal ("\n;%d could not malloc processor_t", id);
+      outf_flush_fatal ();
+      Microcode_Termination (TERM_NO_SPACE);
+    }
+  new->next = processors;
+  new->id = id;
+  processors = new;
+
+  if (id > 0)
+    make_processors (id - 1);
 }
 
 #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);
+  PRIMITIVE_RETURN (SHARP_F);
+}
+
+DEFINE_PRIMITIVE ("SMP-ID", Prim_smp_id, 0, 0, "(SMP-ID)\n\
+A fixnum identifying the current processor.")
+{
+  PRIMITIVE_HEADER (0);
+#ifdef ENABLE_SMP
+  PRIMITIVE_RETURN (LONG_TO_FIXNUM (self->id));
+#else
+  PRIMITIVE_RETURN (FIXNUM_ZERO);
+#endif
+}
+
+DEFINE_PRIMITIVE ("SMP-LOCK-THREADS", Prim_smp_lock_threads, 1, 1,
+		  "(SMP-LOCK-THREADS LOCK?)\n\
+When LOCK? is #F/non-#F, unlock/lock the pthread mutex serializing\n\
+access to the thread system.")
+{
+  PRIMITIVE_HEADER (1);
+#ifdef ENABLE_SMP
+  if ((ARG_REF (1)) == SHARP_F)
+    {
+      assert (self == threads_processor);
+      threads_processor = NULL;
+      mutex_unlock (&threads_mutex);
+      PRIMITIVE_RETURN (UNSPECIFIC);
+    }
+  else
+    {
+      mutex_lock (&threads_mutex);
+      threads_processor = self;
+      PRIMITIVE_RETURN (UNSPECIFIC);
+    }
+#else /* not ENABLE_SMP */
+  PRIMITIVE_RETURN (UNSPECIFIC);
+#endif
+}
diff --git a/src/microcode/utils.c b/src/microcode/utils.c
index ac1472927..5099ffb1b 100644
--- a/src/microcode/utils.c
+++ b/src/microcode/utils.c
@@ -177,6 +177,9 @@ err_print (long error_code, outf_channel where)
     outf (where, "Unknown error code %#lx.\n", error_code);
   else
     outf (where, "Error code %#lx (%s).\n", error_code, message);
+#ifdef ENABLE_SMP
+  outf (where, "Processor #%d.\n", self->id);
+#endif
 }
 
 long death_blow;