From d14e638e10ff8a80eea77de07526563491b0b40f Mon Sep 17 00:00:00 2001
From: sperber <sperber>
Date: Thu, 19 Sep 2002 07:07:40 +0000
Subject: [PATCH] Replace hacked-up VM-CHANNEL-ABORT by a version that's
 simpler and closer to the original.

---
 scheme/vm/vmio.scm | 71 +++++++++++++++++++++-------------------------
 1 file changed, 32 insertions(+), 39 deletions(-)

diff --git a/scheme/vm/vmio.scm b/scheme/vm/vmio.scm
index 46bda39..6cc4c6e 100644
--- a/scheme/vm/vmio.scm
+++ b/scheme/vm/vmio.scm
@@ -288,46 +288,39 @@
 ; if it has.  If not, call the OS and have it abort the channel's current
 ; operation.
 
+
 (define (vm-channel-abort channel)
-  (cond ((and (false? *pending-input-channels-head*)
-	      (false? *pending-output-channels-head*))
-	 (set-channel-os-status! channel false) ; no longer pending
-	 (enter-fixnum (channel-abort
-			(extract-fixnum (channel-os-index channel)))))
-	((vm-eq? channel *pending-input-channels-head*)
-	 (dequeue-input-channel!)
-	 (channel-os-status channel))
-	((vm-eq? channel *pending-output-channels-head*)
-	 (dequeue-output-channel!)
-	 (channel-os-status channel))
-	(else
-	 (let loop ((ch (channel-next *pending-input-channels-head*))
-		    (prev *pending-input-channels-head*))
-	   (cond ((false? ch)
-		  (let loop ((ch (channel-next *pending-output-channels-head*))
-			     (prev *pending-output-channels-head*))
-		    (cond ((false? ch)
-			   (set-channel-os-status! channel false) ; no longer pending
-			   (enter-fixnum (channel-abort
-					  (extract-fixnum (channel-os-index channel)))))
-			  ((vm-eq? ch channel)
-			   (if (vm-eq? ch *pending-output-channels-tail*)
-			       (set! *pending-output-channels-tail* prev))
-			   (set-channel-next! prev (channel-next ch))
-			   (set-channel-next! ch false)
-			   (channel-os-status ch))
-			  (else
-			   (loop (channel-next ch) ch)))))
-
-		 ((vm-eq? ch channel)
-		  (if (vm-eq? ch *pending-input-channels-tail*)
-		      (set! *pending-input-channels-tail* prev))
-		  (set-channel-next! prev (channel-next ch))
-		  (set-channel-next! ch false)
-		  (channel-os-status ch))
-
-		 (else
-		  (loop (channel-next ch) ch)))))))
+  (let* ((input? (or (= input-status (channel-status channel))
+		     (= special-input-status (channel-status channel))))
+	 (head (if input?
+		   *pending-input-channels-head*
+		   *pending-output-channels-head*)))
+    (cond ((false? head)
+	   (set-channel-os-status! channel false) ; no longer pending
+	   (enter-fixnum (channel-abort
+			  (extract-fixnum (channel-os-index channel)))))
+	  ((vm-eq? channel head)
+	   (if input?
+	       (dequeue-input-channel!)
+	       (dequeue-output-channel!))
+	   (channel-os-status channel))
+	  (else
+	   (let loop ((ch (channel-next head)) (prev head))
+	     (cond ((false? ch)
+		    (set-channel-os-status! channel false) ; no longer pending
+		    (enter-fixnum (channel-abort
+				   (extract-fixnum (channel-os-index channel)))))
+		   ((vm-eq? ch channel)
+		    (if input?
+			(if (vm-eq? ch *pending-input-channels-tail*)
+			    (set! *pending-input-channels-tail* prev))
+			(if (vm-eq? ch *pending-output-channels-tail*)
+			    (set! *pending-output-channels-tail* prev)))
+		    (set-channel-next! prev (channel-next ch))
+		    (set-channel-next! ch false)
+		    (channel-os-status ch))
+		   (else
+		    (loop (channel-next ch) ch))))))))
 
 (define (trace-io trace-value)
   (set! *pending-input-channels-head*