From: Taylor R. Campbell <net/mumble/campbell>
Date: Wed, 15 Apr 2009 19:30:53 +0000 (+0000)
Subject: New primitive NEW-MAKE-PIPE does what MAKE-PIPE does but stores its
X-Git-Tag: 20090517-FFI~35
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3c75e8cfb32014b87866d357875d8c749e4e03df;p=mit-scheme.git

New primitive NEW-MAKE-PIPE does what MAKE-PIPE does but stores its
results in weak pairs so that it can be used with GC finalizers.  Use
this in the runtime's MAKE-PIPE procedure so that interrupts need not
be disabled, and file descriptor exhaustion can trigger garbage
collection which can trigger GC daemons that close files.
---

diff --git a/v7/src/microcode/prosio.c b/v7/src/microcode/prosio.c
index 83f9ec3a4..42aafbe54 100644
--- a/v7/src/microcode/prosio.c
+++ b/v7/src/microcode/prosio.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: prosio.c,v 1.31 2009/03/21 07:09:09 riastradh Exp $
+$Id: prosio.c,v 1.32 2009/04/15 19:30:52 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -206,7 +206,7 @@ If it cannot, 0 is returned.")
        : (BOOLEAN_TO_OBJECT (result == 0)));
   }
 }
-
+
 DEFINE_PRIMITIVE ("CHANNEL-NONBLOCKING", Prim_channel_nonblocking, 1, 1,
   "Put CHANNEL in non-blocking mode.")
 {
@@ -237,6 +237,22 @@ DEFINE_PRIMITIVE ("MAKE-PIPE", Prim_make_pipe, 0, 0,
     PRIMITIVE_RETURN (result);
   }
 }
+
+DEFINE_PRIMITIVE ("NEW-MAKE-PIPE", Prim_new_make_pipe, 2, 2,
+  "Store the reader and writer of a new pipe in the cdrs of weak pairs.")
+{
+  PRIMITIVE_HEADER (2);
+  CHECK_ARG (1, WEAK_PAIR_P);
+  CHECK_ARG (2, WEAK_PAIR_P);
+  {
+    Tchannel reader;
+    Tchannel writer;
+    OS_make_pipe ((&reader), (&writer));
+    SET_PAIR_CDR ((ARG_REF (1)), (long_to_integer (reader)));
+    SET_PAIR_CDR ((ARG_REF (2)), (long_to_integer (writer)));
+    PRIMITIVE_RETURN (UNSPECIFIC);
+  }
+}
 
 /* Select registry */
 
diff --git a/v7/src/runtime/io.scm b/v7/src/runtime/io.scm
index c02e8b198..19d33ecb8 100644
--- a/v7/src/runtime/io.scm
+++ b/v7/src/runtime/io.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: io.scm,v 14.89 2009/03/21 07:09:09 riastradh Exp $
+$Id: io.scm,v 14.90 2009/04/15 19:30:53 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -343,11 +343,17 @@ USA.
   ((ucode-primitive file-truncate 2) (channel-descriptor channel) length))
 
 (define (make-pipe)
-  (without-interrupts
-   (lambda ()
-     (let ((pipe ((ucode-primitive make-pipe 0))))
-       (values (make-channel (car pipe))
-	       (make-channel (cdr pipe)))))))
+  (let* ((writer)
+	 (reader
+	  (open-channel
+	   (lambda (reader-pair)
+	     (set! writer
+		   (open-channel
+		    (lambda (writer-pair)
+		      ((ucode-primitive new-make-pipe 2)
+		       reader-pair
+		       writer-pair))))))))
+    (values reader writer)))
 
 ;;;; Terminal Primitives