X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fstream.lisp;h=4611a72215f3a37f6fe8cfe1c738716e6ca1596c;hb=fd00d78accb69be3a626a29120ba17a18569b98c;hp=b33dfb9b90a4796c5365012fe3c21b913f31f4d4;hpb=cb296ae5a022a5b0f1fd573584301b0d2a9493f9;p=sbcl.git diff --git a/src/code/stream.lisp b/src/code/stream.lisp index b33dfb9..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 @@ -419,30 +432,34 @@ ;;; and hence must be an N-BIN method. (defun fast-read-char-refill (stream eof-error-p eof-value) (let* ((ibuf (ansi-stream-cin-buffer stream)) - (count (funcall (ansi-stream-n-bin stream) - stream - ibuf - +ansi-stream-in-buffer-extra+ - (- +ansi-stream-in-buffer-length+ - +ansi-stream-in-buffer-extra+) - nil)) - (start (- +ansi-stream-in-buffer-length+ count))) + (count (funcall (ansi-stream-n-bin stream) + stream + ibuf + +ansi-stream-in-buffer-extra+ + (- +ansi-stream-in-buffer-length+ + +ansi-stream-in-buffer-extra+) + nil)) + (start (- +ansi-stream-in-buffer-length+ count))) (declare (type index start count)) (cond ((zerop count) - (setf (ansi-stream-in-index stream) +ansi-stream-in-buffer-length+) - (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) - (* 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))) - (setf (ansi-stream-in-index stream) (1+ start)) - (aref ibuf start))))) + (setf (ansi-stream-in-index stream) + +ansi-stream-in-buffer-length+) + (funcall (ansi-stream-in stream) stream eof-error-p eof-value)) + (t + (when (/= start +ansi-stream-in-buffer-extra+) + (#.(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))))) ;;; This is similar to FAST-READ-CHAR-REFILL, but we don't have to ;;; leave room for unreading. @@ -458,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))))) @@ -815,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) @@ -1008,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)) @@ -1068,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))) @@ -1124,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 @@ -1275,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)) @@ -1518,7 +1517,7 @@ (defun case-frob-upcase-out (stream char) (declare (type case-frob-stream stream) - (type base-char char)) + (type character char)) (let ((target (case-frob-stream-target stream)) (char (char-upcase char))) (if (ansi-stream-p target) @@ -1543,7 +1542,7 @@ (defun case-frob-downcase-out (stream char) (declare (type case-frob-stream stream) - (type base-char char)) + (type character char)) (let ((target (case-frob-stream-target stream)) (char (char-downcase char))) (if (ansi-stream-p target) @@ -1568,7 +1567,7 @@ (defun case-frob-capitalize-out (stream char) (declare (type case-frob-stream stream) - (type base-char char)) + (type character char)) (let ((target (case-frob-stream-target stream))) (cond ((alphanumericp char) (let ((char (char-upcase char))) @@ -1612,7 +1611,7 @@ (defun case-frob-capitalize-aux-out (stream char) (declare (type case-frob-stream stream) - (type base-char char)) + (type character char)) (let ((target (case-frob-stream-target stream))) (cond ((alphanumericp char) (let ((char (char-downcase char))) @@ -1657,7 +1656,7 @@ (defun case-frob-capitalize-first-out (stream char) (declare (type case-frob-stream stream) - (type base-char char)) + (type character char)) (let ((target (case-frob-stream-target stream))) (cond ((alphanumericp char) (let ((char (char-upcase char)))