From 3c75e8cfb32014b87866d357875d8c749e4e03df Mon Sep 17 00:00:00 2001
From: "Taylor R. Campbell" <net/mumble/campbell>
Date: Wed, 15 Apr 2009 19:30:53 +0000
Subject: [PATCH] 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.

---
 v7/src/microcode/prosio.c | 20 ++++++++++++++++++--
 v7/src/runtime/io.scm     | 18 ++++++++++++------
 2 files changed, 30 insertions(+), 8 deletions(-)

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
 
-- 
2.25.1