X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fstream.lisp;h=4611a72215f3a37f6fe8cfe1c738716e6ca1596c;hb=69ef68ba7393e3492c1b4a756d1140f71c2922bc;hp=ed8769510dc14b54122121bcfb1c6ed036c0044b;hpb=6006a909156fce9f584a9ed04e21710ce3eefe19;p=sbcl.git diff --git a/src/code/stream.lisp b/src/code/stream.lisp index ed87695..4611a72 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -298,8 +298,11 @@ (defun ansi-stream-listen (stream) (or (/= (the fixnum (ansi-stream-in-index stream)) +ansi-stream-in-buffer-length+) - ;; Test for T explicitly since misc methods return :EOF sometimes. - (eq (funcall (ansi-stream-misc stream) stream :listen) t))) + ;; Handle :EOF return from misc methods specially + (let ((result (funcall (ansi-stream-misc stream) stream :listen))) + (if (eq result :eof) + nil + result)))) (defun listen (&optional (stream *standard-input*)) (let ((stream (in-synonym-of stream))) @@ -391,13 +394,23 @@ numbytes eof-error-p)) ((<= numbytes num-buffered) + #+nil + (let ((copy-function (typecase buffer + ((simple-array * (*)) #'ub8-bash-copy) + (system-area-pointer #'copy-ub8-to-system-area)))) + (funcall copy-function in-buffer index buffer start numbytes)) (%byte-blt in-buffer index buffer start (+ start numbytes)) (setf (ansi-stream-in-index stream) (+ index numbytes)) numbytes) (t (let ((end (+ start num-buffered))) - (%byte-blt in-buffer index buffer start end) + #+nil + (let ((copy-function (typecase buffer + ((simple-array * (*)) #'ub8-bash-copy) + (system-area-pointer #'copy-ub8-to-system-area)))) + (funcall copy-function in-buffer index buffer start num-buffered)) + (%byte-blt in-buffer index buffer start end) (setf (ansi-stream-in-index stream) +ansi-stream-in-buffer-length+) (+ (funcall (ansi-stream-n-bin stream) stream @@ -426,13 +439,7 @@ (- +ansi-stream-in-buffer-length+ +ansi-stream-in-buffer-extra+) nil)) - (start (- +ansi-stream-in-buffer-length+ count)) - (n-character-array-bytes - #.(/ (sb!vm:saetp-n-bits - (find 'character - sb!vm:*specialized-array-element-type-properties* - :key #'sb!vm:saetp-specifier)) - sb!vm:n-byte-bits))) + (start (- +ansi-stream-in-buffer-length+ count))) (declare (type index start count)) (cond ((zerop count) (setf (ansi-stream-in-index stream) @@ -440,19 +447,17 @@ (funcall (ansi-stream-in stream) stream eof-error-p eof-value)) (t (when (/= start +ansi-stream-in-buffer-extra+) - (bit-bash-copy ibuf (+ (* +ansi-stream-in-buffer-extra+ - sb!vm:n-byte-bits - n-character-array-bytes) - (* sb!vm:vector-data-offset - sb!vm:n-word-bits)) - ibuf (+ (the index (* start - sb!vm:n-byte-bits - n-character-array-bytes)) - (* sb!vm:vector-data-offset - sb!vm:n-word-bits)) - (* count - sb!vm:n-byte-bits - n-character-array-bytes))) + (#.(let* ((n-character-array-bits + (sb!vm:saetp-n-bits + (find 'character + sb!vm:*specialized-array-element-type-properties* + :key #'sb!vm:saetp-specifier))) + (bash-function (intern (format nil "UB~A-BASH-COPY" n-character-array-bits) + (find-package "SB!KERNEL")))) + bash-function) + ibuf +ansi-stream-in-buffer-extra+ + ibuf start + count)) (setf (ansi-stream-in-index stream) (1+ start)) (aref ibuf start))))) @@ -470,11 +475,9 @@ (funcall (ansi-stream-bin stream) stream eof-error-p eof-value)) (t (unless (zerop start) - (bit-bash-copy ibuf (* sb!vm:vector-data-offset sb!vm:n-word-bits) - ibuf (+ (the index (* start sb!vm:n-byte-bits)) - (* sb!vm:vector-data-offset - sb!vm:n-word-bits)) - (* count sb!vm:n-byte-bits))) + (ub8-bash-copy ibuf 0 + ibuf start + count)) (setf (ansi-stream-in-index stream) (1+ start)) (aref ibuf start))))) @@ -827,7 +830,7 @@ (or (/= (the fixnum (ansi-stream-in-index in)) +ansi-stream-in-buffer-length+) (funcall (ansi-stream-misc in) in :listen)) - (stream-listen in))) + (listen in))) ((:finish-output :force-output :clear-output) (if out-ansi-stream-p (funcall (ansi-stream-misc out) out operation arg1 arg2) @@ -1020,32 +1023,18 @@ (aver (= numbytes (+ new-start bytes-read))) numbytes))))) -;;;; base STRING-STREAM stuff - -(defstruct (string-stream - (:include ansi-stream) - (:constructor nil) - (:copier nil)) - ;; FIXME: This type declaration is true, and will probably continue - ;; to be true. However, note well the comments in DEFTRANSFORM - ;; REPLACE, implying that performance of REPLACE is somewhat - ;; critical to performance of string streams. If (VECTOR CHARACTER) - ;; ever becomes different from (VECTOR BASE-CHAR), the transform - ;; probably needs to be extended. - (string (missing-arg) :type (vector character))) - ;;;; STRING-INPUT-STREAM stuff (defstruct (string-input-stream - (:include string-stream + (:include ansi-stream (in #'string-inch) (bin #'ill-bin) (n-bin #'ill-bin) - (misc #'string-in-misc) - (string (missing-arg) :type simple-string)) + (misc #'string-in-misc)) (:constructor internal-make-string-input-stream (string current end)) (:copier nil)) + (string (missing-arg) :type simple-string) (current (missing-arg) :type index) (end (missing-arg) :type index)) @@ -1080,14 +1069,16 @@ (when (plusp copy) (setf (string-input-stream-current stream) (truly-the index (+ index copy))) + ;; FIXME: why are we VECTOR-SAP'ing things here? what's the point? + ;; and are there SB-UNICODE issues here as well? --njf, 2005-03-24 (sb!sys:without-gcing - (system-area-copy (vector-sap string) - (* index sb!vm:n-byte-bits) - (if (typep buffer 'system-area-pointer) - buffer - (vector-sap buffer)) - (* start sb!vm:n-byte-bits) - (* copy sb!vm:n-byte-bits)))) + (system-area-ub8-copy (vector-sap string) + index + (if (typep buffer 'system-area-pointer) + buffer + (vector-sap buffer)) + start + copy))) (if (and (> requested copy) eof-error-p) (error 'end-of-file :stream stream) copy))) @@ -1136,17 +1127,16 @@ ;;;; STRING-OUTPUT-STREAM stuff (defstruct (string-output-stream - (:include string-stream + (:include ansi-stream (out #'string-ouch) (sout #'string-sout) - (misc #'string-out-misc) - ;; The string we throw stuff in. - (string (missing-arg) - :type (simple-array character (*)))) + (misc #'string-out-misc)) (:constructor make-string-output-stream (&key (element-type 'character) &aux (string (make-string 40)))) (:copier nil)) + ;; The string we throw stuff in. + (string (missing-arg) :type (simple-array character (*))) ;; Index of the next location to use. (index 0 :type fixnum) ;; Index cache for string-output-stream-last-index @@ -1287,17 +1277,14 @@ (satisfies array-has-fill-pointer-p))) (defstruct (fill-pointer-output-stream - (:include string-stream + (:include ansi-stream (out #'fill-pointer-ouch) (sout #'fill-pointer-sout) - (misc #'fill-pointer-misc) - ;; a string with a fill pointer where we stuff - ;; the stuff we write - (string (missing-arg) - :type string-with-fill-pointer - :read-only t)) + (misc #'fill-pointer-misc)) (:constructor make-fill-pointer-output-stream (string)) - (:copier nil))) + (:copier nil)) + ;; a string with a fill pointer where we stuff the stuff we write + (string (missing-arg) :type string-with-fill-pointer :read-only t)) (defun fill-pointer-ouch (stream character) (let* ((buffer (fill-pointer-output-stream-string stream))