X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fstream.lisp;h=e3dbd91b327f1d8471cb837cfe4bd804e34a3818;hb=1b650be8b800cf96e2c268ae317fb26d0bf36827;hp=edfc4ed112ffceb8e074175efdfaba6b674c781f;hpb=6a8fb906ba96395f2a60f821b2ec7649a2a3ae46;p=sbcl.git diff --git a/src/code/stream.lisp b/src/code/stream.lisp index edfc4ed..e3dbd91 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -145,7 +145,7 @@ ;;; Call the MISC method with the :FILE-POSITION operation. (defun file-position (stream &optional position) (declare (type stream stream)) - (declare (type (or index (member nil :start :end)) position)) + (declare (type (or index (alien sb!unix:off-t) (member nil :start :end)) position)) (cond (position (setf (ansi-stream-in-index stream) +ansi-stream-in-buffer-length+) @@ -1147,7 +1147,11 @@ (case operation (:file-position (if arg1 - (setf (string-input-stream-current stream) arg1) + (setf (string-input-stream-current stream) + (case arg1 + (:start 0) + (:end (string-input-stream-end stream)) + (t arg1))) (string-input-stream-current stream))) (:file-length (length (string-input-stream-string stream))) (:unread (decf (string-input-stream-current stream))) @@ -1178,12 +1182,16 @@ (sout #'string-sout) (misc #'string-out-misc) ;; The string we throw stuff in. - (string (make-string 40) + (string (missing-arg) :type (simple-array character (*)))) - (:constructor make-string-output-stream ()) + (:constructor make-string-output-stream + (&key (element-type 'character) + &aux (string (make-string 40)))) (:copier nil)) ;; Index of the next location to use. - (index 0 :type fixnum)) + (index 0 :type fixnum) + ;; Requested element type + (element-type 'character)) #!+sb-doc (setf (fdocumentation 'make-string-output-stream 'function) @@ -1250,8 +1258,19 @@ (defun get-output-stream-string (stream) (declare (type string-output-stream stream)) (let* ((length (string-output-stream-index stream)) - (result (make-string length))) - (replace result (string-output-stream-string stream)) + (element-type (string-output-stream-element-type stream)) + (result + (case element-type + ;; Overwhelmingly common case; can be inlined. + ((character) (make-string length)) + (t (make-string length :element-type element-type))))) + ;; For the benefit of the REPLACE transform, let's do this, so + ;; that the common case isn't ludicrously expensive. + (etypecase result + ((simple-array character (*)) + (replace result (string-output-stream-string stream))) + ((simple-array nil (*)) + (replace result (string-output-stream-string stream)))) (setf (string-output-stream-index stream) 0) result))