From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 11 Nov 2003 01:53:38 +0000 (+0000)
Subject: Allow a channel to be closed more than once.  This is the previous
X-Git-Tag: 20090517-FFI~1754
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e6a97ef214f4a777a8f3fba45ec9c20426026cab;p=mit-scheme.git

Allow a channel to be closed more than once.  This is the previous
behavior, and some callers expect to be able to do this.
---

diff --git a/v7/src/runtime/io.scm b/v7/src/runtime/io.scm
index baf95c5df..b5ea8fe0f 100644
--- a/v7/src/runtime/io.scm
+++ b/v7/src/runtime/io.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: io.scm,v 14.75 2003/11/10 21:46:07 cph Exp $
+$Id: io.scm,v 14.76 2003/11/11 01:53:38 cph Exp $
 
 Copyright 1986,1987,1988,1990,1991,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1998,1999,2000,2001 Massachusetts Institute of Technology
@@ -72,7 +72,7 @@ USA.
   (let ((name ((ucode-primitive channel-type-name 1) descriptor)))
     (and name
 	 (intern name))))
-
+
 (define-integrable (channel-type=unknown? channel)
   (false? (channel-type channel)))
 
@@ -89,7 +89,10 @@ USA.
 	(eq? 'OS/2-CONSOLE type))))
 
 (define (channel-close channel)
-  (remove-from-gc-finalizer! open-channels channel))
+  (without-interrupts
+   (lambda ()
+     (if (channel-open? channel)
+	 (remove-from-gc-finalizer! open-channels channel)))))
 
 (define-integrable (channel-open? channel)
   (channel-descriptor channel))