diff --git a/src/c/file.d b/src/c/file.d index 915f0a95d..7fb0d1dc5 100755 --- a/src/c/file.d +++ b/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, diff --git a/src/c/print.d b/src/c/print.d index 2f774d453..db60fed08 100644 --- a/src/c/print.d +++ b/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, diff --git a/src/clos/streams.lsp b/src/clos/streams.lsp index f723589d5..acf6f6f06 100644 --- a/src/clos/streams.lsp +++ b/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) diff --git a/src/h/object.h b/src/h/object.h index 73e576b1a..c0f5124de 100644 --- a/src/h/object.h +++ b/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);