In SIGNAL-IO-THREAD-EVENTS, we may not always find a dentry for all

the descriptors and modes listed.  Don't assume that we shall.

This case arises particularly when there is no thread blocked in
BLOCK-ON-IO-DESCRIPTOR and someone invokes the PROCESS-WAIT primitive.
This should fix the random (%RECORD-REF #F 3) error that I have seen
when gunzipping MIT Scheme's Info reference manual and it isn't in the
operating system's disk buffer cache, which led to a losing race.

diff --git a/v7/src/runtime/thread.scm b/v7/src/runtime/thread.scm
index 6d2a26f3e4313cb98c8c608b7bd983f927b647d7..dc2de327a24f6d855579cc3b969cad47b562ab55 100644 (file)
--- a/v7/src/runtime/thread.scm
+++ b/v7/src/runtime/thread.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: thread.scm,v 1.49 2008/02/15 04:19:00 riastradh Exp $
+$Id: thread.scm,v 1.50 2008/09/12 10:26:18 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -643,17 +643,19 @@ USA.
                      ((READ/WRITE) (lambda (mode) mode))
                      ((ERROR HANGUP) (lambda (mode) mode #t))
                      (else (error "Illegal mode:" mode))))))
-             (let ((tentry (dentry/first-tentry dentry)))
-               (let ((events
-                      (cons (cons (tentry/thread tentry)
-                                  (let ((e (tentry/event tentry)))
-                                    (and e
-                                         (lambda () (e mode)))))
-                            events)))
-                 (if (tentry/permanent? tentry)
-                     (move-tentry-to-back! tentry)
-                     (delete-tentry! tentry))
-                 (loop (fix:+ i 1) events)))))
+             (if (not dentry)
+                 (loop (fix:+ i 1) events)
+                 (let ((tentry (dentry/first-tentry dentry)))
+                   (let ((events
+                          (cons (cons (tentry/thread tentry)
+                                      (let ((e (tentry/event tentry)))
+                                        (and e
+                                             (lambda () (e mode)))))
+                                events)))
+                     (if (tentry/permanent? tentry)
+                         (move-tentry-to-back! tentry)
+                         (delete-tentry! tentry))
+                     (loop (fix:+ i 1) events))))))
          (do ((events events (cdr events)))
              ((not (pair? events)))
            (%signal-thread-event (caar events) (cdar events)))))))