From aa099a332a4e00660628bf30030c5a9fca856b03 Mon Sep 17 00:00:00 2001
From: jjgarcia <jjgarcia>
Date: Fri, 27 Jun 2008 20:18:12 +0000
Subject: [PATCH] Implement SI:MAKE-PIPE (By S. Gromoff). Eliminate OPEN-PIPE /
 CLOSE-PIPE.

---
 src/CHANGELOG         |  6 ++++++
 src/c/symbols_list.h  |  3 +--
 src/c/symbols_list2.h |  3 +--
 src/c/unixsys.d       | 48 ++++++++++++++-----------------------------
 src/h/external.h      |  3 +--
 5 files changed, 24 insertions(+), 39 deletions(-)

diff --git a/src/CHANGELOG b/src/CHANGELOG
index 7ba19d149..a947dc279 100644
--- a/src/CHANGELOG
+++ b/src/CHANGELOG
@@ -136,6 +136,12 @@ ECL 0.9k:
 
  - Accessors for low-level socket timeout attributes (by G. Carncross).
 
+ - The function EXT:OPEN-PIPE disappears, together with EXT:CLOSE-PIPE. Use
+   EXT:RUN-PROCESS instead.
+
+ - New function EXT:MAKE-PIPE implements the equivalent of POSIX pipe() but
+   producing a two-way stream.
+
 * CLOS:
 
  - When caching generic function calls, ECL now uses a thread-local hash table
diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index 44ce2d16b..72f6d9dea 100644
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -1079,7 +1079,6 @@ cl_symbols[] = {
 {SYS_ "CHAR-SET", SI_ORDINARY, si_char_set, 3, OBJNULL},
 {SYS_ "CHDIR", SI_ORDINARY, si_chdir, -1, OBJNULL},
 {SYS_ "CLEAR-COMPILER-PROPERTIES", SI_ORDINARY, cl_identity, 1, OBJNULL},
-{SYS_ "CLOSE-PIPE", SI_ORDINARY, si_close_pipe, 1, OBJNULL},
 {SYS_ "COERCE-TO-BASE-STRING", SI_ORDINARY, si_coerce_to_base_string, 1, OBJNULL},
 {SYS_ "COERCE-TO-EXTENDED-STRING", SI_ORDINARY, si_coerce_to_extended_string, 1, OBJNULL},
 {SYS_ "COERCE-TO-FILENAME", SI_ORDINARY, si_coerce_to_filename, 1, OBJNULL},
@@ -1141,7 +1140,7 @@ cl_symbols[] = {
 {SYS_ "MKDIR", SI_ORDINARY, si_mkdir, 2, OBJNULL},
 {SYS_ "MKSTEMP", SI_ORDINARY, si_mkstemp, 1, OBJNULL},
 {SYS_ "RMDIR", SI_ORDINARY, si_rmdir, 1, OBJNULL},
-{SYS_ "OPEN-PIPE", SI_ORDINARY, si_open_pipe, 1, OBJNULL},
+{SYS_ "MAKE-PIPE", SI_ORDINARY, si_make_pipe, 0, OBJNULL},
 {SYS_ "PACKAGE-LOCK", SI_ORDINARY, si_package_lock, 2, OBJNULL},
 {SYS_ "PACKAGE-HASH-TABLES", SI_ORDINARY, si_package_hash_tables, 1, OBJNULL},
 {SYS_ "PATHNAME-TRANSLATIONS", SI_ORDINARY, si_pathname_translations, -1, OBJNULL},
diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h
index 704b96f57..6bf64b152 100644
--- a/src/c/symbols_list2.h
+++ b/src/c/symbols_list2.h
@@ -1079,7 +1079,6 @@ cl_symbols[] = {
 {SYS_ "CHAR-SET","si_char_set"},
 {SYS_ "CHDIR","si_chdir"},
 {SYS_ "CLEAR-COMPILER-PROPERTIES","cl_identity"},
-{SYS_ "CLOSE-PIPE","si_close_pipe"},
 {SYS_ "COERCE-TO-BASE-STRING","si_coerce_to_base_string"},
 {SYS_ "COERCE-TO-EXTENDED-STRING","si_coerce_to_extended_string"},
 {SYS_ "COERCE-TO-FILENAME","si_coerce_to_filename"},
@@ -1141,7 +1140,7 @@ cl_symbols[] = {
 {SYS_ "MKDIR","si_mkdir"},
 {SYS_ "MKSTEMP","si_mkstemp"},
 {SYS_ "RMDIR","si_rmdir"},
-{SYS_ "OPEN-PIPE","si_open_pipe"},
+{SYS_ "MAKE-PIPE","si_make_pipe"},
 {SYS_ "PACKAGE-LOCK","si_package_lock"},
 {SYS_ "PACKAGE-HASH-TABLES","si_package_hash_tables"},
 {SYS_ "PATHNAME-TRANSLATIONS","si_pathname_translations"},
diff --git a/src/c/unixsys.d b/src/c/unixsys.d
index 213a66e33..338253063 100644
--- a/src/c/unixsys.d
+++ b/src/c/unixsys.d
@@ -49,44 +49,26 @@ si_getpid(void)
 }
 
 cl_object
-si_open_pipe(cl_object cmd_string)
+si_make_pipe()
 {
+	cl_object output;
+	int fds[2], ret;
 #ifdef _MSC_VER
-	FEerror("Pipes are not supported under Win32/MSVC", 0);
+	ret = _pipe(fds, 4096, _O_BINARY);
 #else
-	FILE *ptr;
-	cl_object stream;
-	cl_object cmd = si_copy_to_simple_base_string(cmd);
-	ptr = popen(cmd->base_string.self, "r");
-	if (ptr == NULL)
-		@(return Cnil);
-	stream = cl_alloc_object(t_stream);
-	stream->stream.mode = smm_input;
-	stream->stream.file = ptr;
-	stream->stream.object0 = @'base-char';
-	stream->stream.char_stream_p = 1;
-	stream->stream.object1 = @'si::open-pipe';
-	stream->stream.int0 = stream->stream.int1 = 0;
-	si_set_buffering_mode(stream, @':line-buffered');
-	@(return stream)
+	ret = pipe(fds);
 #endif
-}
-
-cl_object
-si_close_pipe(cl_object stream)
-{
-#ifdef _MSC_VER
-	FEerror("Pipes are not supported under Win32/MSVC", 0);
-#else
-	if (type_of(stream) == t_stream &&
-	    stream->stream.object1 == @'si::open-pipe') {
-		stream->stream.closed = 1;
-		pclose(stream->stream.file);
-		stream->stream.file = NULL;
-		stream->stream.object0 = OBJNULL;
+	if (ret < 0) {
+		FElibc_error("Unable to create pipe", 0);
+		output = Cnil;
+	} else {
+		cl_object fake_in_name = make_simple_base_string("PIPE-READ-ENDPOINT");
+		cl_object in = ecl_make_stream_from_fd(fake_in_name, fds[0], smm_input);
+		cl_object fake_out_name = make_simple_base_string("PIPE-WRITE-ENDPOINT");
+		cl_object out = ecl_make_stream_from_fd(fake_out_name, fds[1], smm_output);
+		output = cl_make_two_way_stream(in, out);
 	}
-	@(return)
-#endif
+	@(return output)
 }
 
 @(defun ext::run-program (command argv &key (input @':stream') (output @':stream')
diff --git a/src/h/external.h b/src/h/external.h
index c372053f3..4f0c8a535 100644
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -1530,8 +1530,7 @@ extern ECL_API cl_object si_trap_fpe(cl_object condition, cl_object flag);
 /* unixsys.c */
 
 extern ECL_API cl_object si_system(cl_object cmd);
-extern ECL_API cl_object si_open_pipe(cl_object cmd);
-extern ECL_API cl_object si_close_pipe(cl_object stream);
+extern ECL_API cl_object si_make_pipe();
 extern ECL_API cl_object si_run_program _ARGS((cl_narg narg, cl_object command, cl_object args, ...));