From: Taylor R. Campbell <net/mumble/campbell>
Date: Fri, 12 Sep 2008 10:26:18 +0000 (+0000)
Subject: In SIGNAL-IO-THREAD-EVENTS, we may not always find a dentry for all
X-Git-Tag: 20090517-FFI~156
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=eb54e1e6369db11aae215a3fdf7c4b9a9042d975;p=mit-scheme.git

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 6d2a26f3e..dc2de327a 100644
--- 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)))))))