/* 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;
#ifdef ENABLE_DEBUGGING_TOOLS
-bool smp_trace_p = true;
+bool smp_trace_p = false;
static void
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)
{
}
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 */
+\f
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\
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);
+}