From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Sat, 11 Jul 2015 20:24:03 +0000 (-0700)
Subject: Call %deregister-gc-event.  Punt registered-subprocesses-running?.
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=33054eebb94f2702330de87f7a8376f5d1fe7c7e;p=mit-scheme.git

Call %deregister-gc-event.  Punt registered-subprocesses-running?.
---

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 3204e3841..3d987d7a8 100644
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -565,6 +565,7 @@ USA.
     (ring/discard-all (thread/pending-events thread))
     (%deregister-io-thread-events thread)
     (%discard-thread-timer-records thread)
+    (%deregister-gc-event thread)
     (%deregister-subprocess-events thread)
     (%disassociate-joined-threads thread)
     (%disassociate-thread-mutexes thread)
@@ -686,16 +687,9 @@ USA.
 (define (maybe-signal-io-thread-events)
   (%assert-locked 'maybe-signal-io-thread-events)
   (if (or io-registrations
-	  (registered-subprocesses-running?))
+	  subprocess-registrations)
       (signal-select-result (test-select-registry io-registry #f))))
 
-(define-integrable (registered-subprocesses-running?)
-  (find (lambda (registration)
-	  (eq? 'RUNNING (subprocess-status
-			 (subprocess-registration/subprocess
-			  registration))))
-	subprocess-registrations))
-
 (define (block-on-io-descriptor descriptor mode)
   (let ((result 'INTERRUPT)
 	(registration #f))
@@ -1077,9 +1071,13 @@ USA.
 (define (deregister-gc-event)
   (with-thread-lock
    (lambda ()
-     (let ((entry (weak-assq (%thread (%id)) gc-events)))
-       (if entry
-	   (set! gc-events (delq! entry gc-events)))))))
+     (%deregister-gc-event (%thread (%id))))))
+
+(define (%deregister-gc-event thread)
+  (%assert-locked '%deregister-gc-event)
+  (let ((entry (weak-assq thread gc-events)))
+    (if entry
+	(set! gc-events (delq! entry gc-events)))))
 
 (define (registered-gc-event)
   (with-thread-lock
@@ -1276,6 +1274,7 @@ USA.
        (ring/discard-all (thread/pending-events thread))
        (%deregister-io-thread-events thread)
        (%discard-thread-timer-records thread)
+       (%deregister-gc-event thread)
        (%deregister-subprocess-events thread)
        (set-thread/block-events?! thread block-events?))
      (%maybe-toggle-thread-timer))))
@@ -1336,7 +1335,7 @@ USA.
 	    ((and consider-non-timers?
 		  timer-interval
 		  (or io-registrations
-		      (registered-subprocesses-running?)
+		      subprocess-registrations
 		      first-runnable-thread))
 	     (start (+ now timer-interval)))
 	    (else