smp: Add io-waiter and arrange for ONE processor to io-wait.

Also, clean up the stack in SMP-IDLE.  And do NOT tail into a runnable
thread in signal-thread-event -- always return.

diff --git a/src/microcode/prossmp.c b/src/microcode/prossmp.c
index eab9c4797550abc1154198b76cfc62e36750d7a1..707229d465ec58a630ff55d3e5aaefeba1b16aaa 100644 (file)
--- a/src/microcode/prossmp.c
+++ b/src/microcode/prossmp.c
@@ -508,7 +508,15 @@ Wait for interrupts.")
   trace (";%d SMP-Idle.", self->id);
   self->state = PROCESSOR_IDLE;
 
-  assert (GET_INT_MASK == INT_Mask);
+  /* Abandon continuation. */
+  stack_pointer = STACK_BOTTOM;
+ Will_Push (CONTINUATION_SIZE);
+  SET_RC (RC_END_OF_COMPUTATION);
+  SET_EXP (SHARP_F);
+  SAVE_CONT ();
+ Pushed ();
+
+  SET_INTERRUPT_MASK (INT_Mask);
   while (! ((PENDING_INTERRUPTS_P)
            || OS_process_any_status_change ()))
     {

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index cdc984b1cc0bba63d61c269f3fee35f4ec3c4a6e..3195a8abcb1a8114a9aa8e4eac336296d202a76b 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -285,6 +285,7 @@ USA.
   (set! last-runnable-thread thread)
   (complain-if (not (eq? #f (thread/next thread)))
               "%thread-running: last-runnable-thread has a next")
+  (%maybe-wake-idle-processor id)
   unspecific)
 
 (define (thread-not-running id thread state)
@@ -614,7 +615,25 @@ USA.
 (define (reset-threads-high!)
   (set! io-registry (and ((ucode-primitive have-select? 0))
                         (make-select-registry)))
-  (set! io-registrations #f))
+  (set! io-registrations #f)
+  (set! io-waiter #f))
+
+(define io-waiter)
+
+(define (%maybe-wake-idle-processor id)
+  (%%trace ";"id" %maybe-wake-idle-processor\n")
+  (assert-locked '%maybe-wake-idle-processor)
+  (complain-if (not (only-gc-ok?))
+              "%maybe-wake-idle-processor: with interrupts")
+  (let ((len (vector-length current-threads)))
+    (let loop ((id* 0))
+      (if (fix:< id* len)
+         (if (and (not (%current-thread id*))
+                  (not (fix:= id* id)))
+             (begin
+               (%%trace ";"id" waking "id*"\n")
+               ((ucode-primitive smp-wake 1) id*))
+             (loop (fix:1+ id*)))))))
 
 (define (wait-for-io id)
   ;; This procedure never returns.
@@ -624,11 +643,26 @@ USA.
               "wait-for-io: with interrupts")
   (complain-if (%current-thread id)
               "wait-for-io: not idle")
+  (if io-waiter
+      (begin
+       (%%trace ";"id" wait-for-io: idling\n")
+       (%unlock)
+       ;; This primitive never returns, but it unmasks all interrupts.
+       ((ucode-primitive smp-idle 0)))
+      (begin
+       (%%trace ";"id" wait-for-io: waiting\n")
+       (set! io-waiter id)
+       (io-waiter-wait id))))
+
+(define (io-waiter-wait id)
+  ;; This procedure never returns.
+  (%%trace ";"id" io-waiter-wait\n")
+  (assert-locked 'io-waiter-wait)
   (%maybe-toggle-thread-timer #f)
-  (%%trace ";"id" wait-for-io: next timeout = "next-scheduled-timeout"\n")
+  (%%trace ";"id" io-waiter-wait: next timeout = "next-scheduled-timeout"\n")
   (let ((result
         (begin
-          (%%trace ";"id" wait-for-io: blocking for i/o\n")
+          (%%trace ";"id" io-waiter-wait: blocking for i/o\n")
           (%unlock)
           (set-interrupt-enables! interrupt-mask/all)
           (test-select-registry io-registry #t))))
@@ -636,15 +670,16 @@ USA.
     (%lock)
     (signal-select-result result)
     (complain-if (%current-thread id)
-                "wait-for-io: ALREADY running a thread")
+                "io-waiter-wait: ALREADY running a thread")
     (if first-runnable-thread
        (begin
          (complain-if (not (thread/continuation first-runnable-thread))
-                      "wait-for-io: BOGUS runnable")
-         (%%trace ";"id" wait-for-io:"
+                      "io-waiter-wait: BOGUS runnable")
+         (%%trace ";"id" io-waiter-wait:"
                   " run-first-thread "first-runnable-thread"\n")
+         (set! io-waiter #f)
          (run-first-thread id))
-       (wait-for-io id))))
+       (io-waiter-wait id))))
 \f
 (define (signal-select-result result)
   (%%trace ";"(%%id)" signal-select-result"
@@ -1020,15 +1055,9 @@ USA.
             (%lock)
             (%trace ";"id" signal-thread-event: %signal\n")
             (%signal-thread-event thread event)
-            (if (and (not self) first-runnable-thread)
-                (begin
-                  (%trace ";"id" signal-thread-event"
-                          " running "first-runnable-thread"\n")
-                  (run-first-thread id))
-                (begin
-                  (%maybe-toggle-thread-timer)
-                  (%trace ";"id" signal-thread-event: done\n")
-                  (%unlock)))))))))
+            (%maybe-toggle-thread-timer)
+            (%trace ";"id" signal-thread-event: done\n")
+            (%unlock)))))))
 
 (define (%signal-thread-event thread event)
   (assert-locked '%signal-thread-event)