From 4fcdcc9910c486880c7960025dcf04950562271e Mon Sep 17 00:00:00 2001
From: jgarcia <jgarcia>
Date: Wed, 26 Apr 2006 10:01:44 +0000
Subject: [PATCH] Ability to set buffering mode of streams

---
 msvc/ecl-threads.def  |   1 +
 msvc/ecl.def          |   1 +
 src/c/file.d          | 121 +++++++++++++++++++++++++-----------------
 src/c/symbols_list.h  |   4 ++
 src/c/symbols_list2.h |   4 ++
 src/c/unixsys.d       |   4 +-
 src/h/external.h      |   1 +
 src/h/object.h        |   2 -
 8 files changed, 85 insertions(+), 53 deletions(-)

diff --git a/msvc/ecl-threads.def b/msvc/ecl-threads.def
index 3bd8249b0..ae8f7c8ab 100755
--- a/msvc/ecl-threads.def
+++ b/msvc/ecl-threads.def
@@ -313,6 +313,7 @@ EXPORTS
 	si_do_read_sequence
 	si_file_column
 	cl_interactive_stream_p
+	si_set_buffering_mode
 
 	ecl_input_stream_p
 	ecl_output_stream_p
diff --git a/msvc/ecl.def b/msvc/ecl.def
index a263a5120..44502eeb8 100644
--- a/msvc/ecl.def
+++ b/msvc/ecl.def
@@ -314,6 +314,7 @@ EXPORTS
 	si_do_read_sequence
 	si_file_column
 	cl_interactive_stream_p
+	si_set_buffering_mode
 
 	ecl_input_stream_p
 	ecl_output_stream_p
diff --git a/src/c/file.d b/src/c/file.d
index 6ab1e11fa..c26b6bd11 100644
--- a/src/c/file.d
+++ b/src/c/file.d
@@ -457,9 +457,7 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists,
 	}
 	x->stream.object1 = fn;
 	x->stream.int0 = x->stream.int1 = 0;
-#if !defined(GBC_BOEHM)
-	setbuf(fp, x->stream.buffer = cl_alloc(BUFSIZ));
-#endif
+	si_set_buffering_mode(x, char_stream_p? @':line-buffered' : @':fully-buffered');
 
 	if (smm == smm_probe)
 		cl_close
@@ -788,6 +786,38 @@ ecl_read_byte8(cl_object strm)
 	return c;
 }
 
+cl_object
+si_set_buffering_mode(cl_object stream, cl_object buffer_mode_symbol)
+{
+	enum ecl_smmode mode = stream->stream.mode;
+	int buffer_mode;
+
+	if (type_of(stream) != t_stream) {
+		FEerror("Cannot set buffer of ~A", 1, stream);
+	}
+	if (buffer_mode_symbol == Cnil) {
+		buffer_mode = _IONBF;
+	} else if (buffer_mode_symbol == Ct || buffer_mode_symbol == @':fully-buffered') {
+		buffer_mode = _IOFBF;
+	} else if (buffer_mode_symbol == @':line-buffered') {
+		buffer_mode = _IOLBF;
+	} else {
+		FEerror("Not a valid buffering mode: ~A", 1, buffer_mode_symbol);
+	}
+	if (mode == smm_output || mode == smm_io || mode == smm_input) {
+		FILE *fp = stream->stream.file;
+		char *new_buffer = 0;
+		setvbuf(fp, 0, _IONBF, 0);
+		if (buffer_mode != _IONBF) {
+			char *new_buffer;
+			cl_index buffer_size = BUFSIZ;
+			new_buffer = stream->stream.buffer = cl_alloc_atomic(buffer_size);
+			setvbuf(fp, new_buffer, buffer_mode, buffer_size);
+		}
+	}
+	@(return stream)
+}
+
 static void
 flush_output_stream_binary(cl_object strm)
 {
@@ -2720,61 +2750,56 @@ cl_interactive_stream_p(cl_object strm)
 cl_object
 ecl_make_stream_from_fd(cl_object fname, int fd, enum ecl_smmode smm)
 {
-   cl_object stream;
-   char *mode;			/* file open mode */
-   FILE *fp;			/* file pointer */
+	cl_object stream;
+	char *mode;			/* file open mode */
+	FILE *fp;			/* file pointer */
 
-   switch(smm) {
-    case smm_input:
-      mode = "r";
-      break;
-    case smm_output:
-      mode = "w";
-      break;
-    case smm_io:
-      mode = "w+";
-      break;
+	switch(smm) {
+	case smm_input:
+		mode = "r";
+		break;
+	case smm_output:
+		mode = "w";
+		break;
+	case smm_io:
+		mode = "w+";
+		break;
 #if defined(ECL_WSOCK)
-    case smm_input_wsock:
-    case smm_output_wsock:
-    case smm_io_wsock:
-      break;
+	case smm_input_wsock:
+	case smm_output_wsock:
+	case smm_io_wsock:
+		break;
 #endif
-    default:
-      FEerror("make_stream: wrong mode", 0);
-   }
+	default:
+		FEerror("make_stream: wrong mode", 0);
+	}
 #if defined(ECL_WSOCK)
-   if ( smm == smm_input_wsock || smm == smm_output_wsock || smm == smm_io_wsock )
-     fp = ( FILE* )fd;
-   else
-     fp = fdopen( fd, mode );
+	if ( smm == smm_input_wsock || smm == smm_output_wsock || smm == smm_io_wsock )
+		fp = ( FILE* )fd;
+	else
+		fp = fdopen( fd, mode );
 #else
-   fp = fdopen(fd, mode);
+	fp = fdopen(fd, mode);
 #endif
 
-   stream = cl_alloc_object(t_stream);
-   stream->stream.mode = (short)smm;
-   stream->stream.closed = 0;
-   stream->stream.file = fp;
+	stream = cl_alloc_object(t_stream);
+	stream->stream.mode = (short)smm;
+	stream->stream.closed = 0;
+	stream->stream.file = fp;
 #if defined (ECL_WSOCK)
-   if ( smm == smm_input_wsock || smm == smm_io_wsock )
-     stream->stream.object0 = Cnil;
-   else
-     stream->stream.object0 = @'base-char';
+	if ( smm == smm_input_wsock || smm == smm_io_wsock )
+		stream->stream.object0 = Cnil;
+	else
+		stream->stream.object0 = @'base-char';
 #else
-   stream->stream.object0 = @'base-char';
+	stream->stream.object0 = @'base-char';
 #endif
-   stream->stream.object1 = fname; /* not really used */
-   stream->stream.int0 = stream->stream.int1 = 0;
-   setbuf(fp, NULL);
-#if !defined(GBC_BOEHM)
-   setbuf(fp, NULL);
-   setbuf(fp, stream->stream.buffer = cl_alloc_atomic(BUFSIZ)); 
-#endif
-   stream->stream.char_stream_p = 1;
-   stream->stream.byte_size = 8;
-   stream->stream.signed_bytes = 0;
-   return(stream);
+	stream->stream.object1 = fname; /* not really used */
+	stream->stream.int0 = stream->stream.int1 = 0;
+	stream->stream.char_stream_p = 1;
+	stream->stream.byte_size = 8;
+	stream->stream.signed_bytes = 0;
+	return(stream);
 }
 
 
diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index d1e7aa371..a0caf1f83 100644
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -1636,6 +1636,10 @@ cl_symbols[] = {
 
 {SYS_ "*ACTION-ON-UNDEFINED-VARIABLE*", SI_SPECIAL, NULL, -1, Cnil},
 
+{SYS_ "SET-BUFFERING-MODE", SI_ORDINARY, si_set_buffering_mode, 2, OBJNULL},
+{KEY_ "LINE-BUFFERED", KEYWORD, NULL, -1, OBJNULL},
+{KEY_ "FULLY-BUFFERED", KEYWORD, NULL, -1, OBJNULL},
+
 /* Tag for end of list */
 {NULL, CL_ORDINARY, NULL, -1, OBJNULL}};
 
diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h
index c714b9a53..a2af4b6df 100644
--- a/src/c/symbols_list2.h
+++ b/src/c/symbols_list2.h
@@ -1636,6 +1636,10 @@ cl_symbols[] = {
 
 {SYS_ "*ACTION-ON-UNDEFINED-VARIABLE*",NULL},
 
+{SYS_ "SET-BUFFERING-MODE","si_set_buffering_mode"},
+{KEY_ "LINE-BUFFERED",NULL},
+{KEY_ "FULLY-BUFFERED",NULL},
+
 /* Tag for end of list */
 {NULL,NULL}};
 
diff --git a/src/c/unixsys.d b/src/c/unixsys.d
index 5a7f272e4..de3e95713 100644
--- a/src/c/unixsys.d
+++ b/src/c/unixsys.d
@@ -69,9 +69,7 @@ si_open_pipe(cl_object cmd)
 	stream->stream.char_stream_p = 1;
 	stream->stream.object1 = @'si::open-pipe';
 	stream->stream.int0 = stream->stream.int1 = 0;
-#if !defined(GBC_BOEHM)
-	setbuf(ptr, stream->stream.buffer = cl_alloc_atomic(BUFSIZ));
-#endif
+	si_set_buffering_mode(stream, @':line-buffered');
 	@(return stream)
 #endif
 }
diff --git a/src/h/external.h b/src/h/external.h
index 9dc1b38e4..d8b9a7abb 100644
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -550,6 +550,7 @@ extern cl_object si_do_write_sequence(cl_object string, cl_object stream, cl_obj
 extern cl_object si_do_read_sequence(cl_object string, cl_object stream, cl_object start, cl_object end);
 extern cl_object si_file_column(cl_object strm);
 extern cl_object cl_interactive_stream_p(cl_object strm);
+extern cl_object si_set_buffering_mode(cl_object strm, cl_object mode);
 
 extern bool ecl_input_stream_p(cl_object strm);
 extern bool ecl_output_stream_p(cl_object strm);
diff --git a/src/h/object.h b/src/h/object.h
index f0160cc9d..54b9eaffc 100644
--- a/src/h/object.h
+++ b/src/h/object.h
@@ -336,9 +336,7 @@ struct ecl_stream {
 	cl_object object1;	/*  some object */
 	cl_fixnum int0;		/*  some int  */
 	cl_fixnum int1;		/*  some int  */
-#if !defined(GBC_BOEHM)
 	char	*buffer;	/*  file buffer  */
-#endif
 	cl_index byte_size;	/*  size of byte in binary streams  */
 	unsigned char bit_buffer;
 	uint8_t bits_left;