printer/reader: call user defined write/read-sequence methods for CLOS streams

Before this change, we called user defined write-string methods
    directly in write-string/write-line but all other operations were
    done inefficiently through generic_write/read_vector.

src/c/file.d

@@ -524,7 +524,7 @@ generic_read_vector(cl_object strm, cl_object data, cl_index start, cl_index end
   expected_type = ecl_stream_element_type(strm);
   ops = stream_dispatch_table(strm);
   if (expected_type == @'base-char' || expected_type == @'character') {
-    ecl_character (*read_char)(cl_object) = ops->read_char;                 
+    ecl_character (*read_char)(cl_object) = ops->read_char;
     for (; start < end; start++) {
       cl_fixnum c = read_char(strm);
       if (c == EOF) break;
@@ -1215,6 +1215,21 @@ clos_stream_peek_char(cl_object strm)
   return ecl_char_code(out);
 }
 
+static cl_index
+clos_stream_read_vector(cl_object strm, cl_object data, cl_index start, cl_index end)
+{
+  return fixnnint(_ecl_funcall5(@'gray::stream-read-sequence', strm, data, ecl_make_fixnum(start), ecl_make_fixnum(end)));
+}
+
+static cl_index
+clos_stream_write_vector(cl_object strm, cl_object data, cl_index start, cl_index end)
+{
+  _ecl_funcall5(@'gray::stream-write-sequence', strm, data, ecl_make_fixnum(start), ecl_make_fixnum(end));
+  if (start >= end)
+    return start;
+  return end;
+}
+
 static int
 clos_stream_listen(cl_object strm)
 {
@@ -1313,8 +1328,8 @@ const struct ecl_file_ops clos_stream_ops = {
   clos_stream_unread_char,
   clos_stream_peek_char,
 
-  generic_read_vector,
-  generic_write_vector,
+  clos_stream_read_vector,
+  clos_stream_write_vector,
 
   clos_stream_listen,
   clos_stream_clear_input,

src/c/print.d

@@ -222,6 +222,7 @@ ecl_print_circle(void)
   unlikely_if (!ECL_STRINGP(strng))
     FEwrong_type_nth_arg(@[write-string], 1, strng, @[string]);
   strm = _ecl_stream_or_default_output(strm);
+  /* Optimization: directly call stream-write-string for CLOS streams */
 #ifdef ECL_CLOS_STREAMS
   if (!ECL_ANSI_STREAM_P(strm))
     _ecl_funcall5(@'gray::stream-write-string', strm, strng, start, end);
@@ -236,6 +237,7 @@ ecl_print_circle(void)
   unlikely_if (!ECL_STRINGP(strng))
     FEwrong_type_nth_arg(@[write-line], 1, strng, @[string]);
   strm = _ecl_stream_or_default_output(strm);
+  /* Optimization: directly call stream-write-string for CLOS streams */
 #ifdef ECL_CLOS_STREAMS
   if (!ECL_ANSI_STREAM_P(strm))
     _ecl_funcall5(@'gray::stream-write-string', strm, strng,

src/clos/streams.lsp

@@ -537,13 +537,38 @@
 
 ;; READ-SEQUENCE
 
+;; Simple default stream-write-sequence method for CLOS streams. Note
+;; that we cannot use si:do-read-sequence for this purpose, since it
+;; will call stream-read-sequence again.
+(defun clos-default-read-sequence (stream sequence start end)
+  (declare (type t stream) ; check for c::stream-designator ignored
+           (type sequence sequence)
+           (fixnum start)
+           (ext:check-arguments-type))
+  (let ((end (or end (length sequence)))
+        (elttype (stream-element-type stream)))
+    (declare (fixnum end))
+    (if (or (eql elttype 'character) (eql elttype 'base-char))
+        (loop for pos from start below end
+           do (let ((c (stream-read-char stream)))
+                (if (eql c :eof)
+                    (return pos)
+                    (setf (elt sequence pos) c)))
+           finally (return pos))
+        (loop for pos from start below end
+           do (let ((b (stream-read-byte stream)))
+                (if (eql b :eof)
+                    (return pos)
+                    (setf (elt sequence pos) b)))
+           finally (return pos)))))
+
 (defmethod stream-read-sequence ((stream fundamental-character-input-stream)
                                  sequence &optional (start 0) (end nil))
-  (si::do-read-sequence sequence stream start end))
+  (clos-default-read-sequence stream sequence start end))
 
 (defmethod stream-read-sequence ((stream fundamental-binary-input-stream)
                                  sequence &optional (start 0) (end nil))
-  (si::do-read-sequence sequence stream start end))
+  (clos-default-read-sequence stream sequence start end))
 
 (defmethod stream-read-sequence ((stream ansi-stream) sequence
                                  &optional (start 0) (end nil))
@@ -601,13 +626,33 @@
 
 ;; WRITE-SEQUENCE
 
+;; Simple default stream-write-sequence method for CLOS streams. Note
+;; that we cannot use si:do-write-sequence for this purpose, since it
+;; will call stream-write-sequence again.
+(defun clos-default-write-sequence (stream sequence start end)
+  (declare (type t stream) ; check for c::stream-designator ignored
+           (type sequence sequence)
+           (fixnum start)
+           (ext:check-arguments-type))
+  (let ((end (or end (length sequence)))
+        (elttype (stream-element-type stream)))
+    (declare (fixnum end))
+    (if (or (eql elttype 'character) (eql elttype 'base-char))
+        (loop for pos from start below end
+           do (stream-write-char stream (elt sequence pos)))
+        (loop for pos from start below end
+           do (stream-write-byte stream (elt sequence pos)))))
+  sequence)
+
 (defmethod stream-write-sequence ((stream fundamental-character-output-stream) sequence
                                   &optional (start 0) end)
-  (si::do-write-sequence sequence stream start end))
+  (if (stringp sequence)
+      (stream-write-string stream sequence start end)
+      (clos-default-write-sequence stream sequence start end)))
 
 (defmethod stream-write-sequence ((stream fundamental-binary-output-stream) sequence
                                   &optional (start 0) end)
-  (si::do-write-sequence sequence stream start end))
+  (clos-default-write-sequence stream sequence start end))
 
 (defmethod stream-write-sequence ((stream ansi-stream) sequence
                                   &optional (start 0) end)

src/h/object.h

@@ -597,7 +597,7 @@ enum {
         ECL_STREAM_CLOSE_COMPONENTS = 1024
 };
 
-typedef int (*cl_eformat_decoder)(cl_object stream);
+typedef ecl_character (*cl_eformat_decoder)(cl_object stream);
 typedef int (*cl_eformat_encoder)(cl_object stream, unsigned char *buffer, int c);
 typedef cl_index (*cl_eformat_read_byte8)(cl_object object, unsigned char *buffer, cl_index n);