* improvement: on x86/x86-64 Lisp call frames now have the same layout as C
frames, allowing for instance more reliable backtraces.
* optimization: faster local calls on x86/x86-64
+ * minor incompatible changes: echo-streams now propagate unread-char to the
+ underlying input stream, and no longer permit unreading more than one
+ character.
changes in sbcl-1.0.27 relative to 1.0.26:
* new port: support added for x86-64 OpenBSD. (thanks to Josh Elsasser)
(n-bin #'echo-n-bin))
(:constructor %make-echo-stream (input-stream output-stream))
(:copier nil))
- unread-stuff)
+ (unread-stuff nil :type boolean))
(def!method print-object ((x echo-stream) stream)
(print-unreadable-object (x stream :type t :identity t)
(format stream
(macrolet ((in-fun (name in-fun out-fun &rest args)
`(defun ,name (stream ,@args)
- (or (pop (echo-stream-unread-stuff stream))
- (let* ((in (echo-stream-input-stream stream))
- (out (echo-stream-output-stream stream))
- (result (if eof-error-p
- (,in-fun in ,@args)
- (,in-fun in nil in))))
- (cond
- ((eql result in) eof-value)
- (t (,out-fun result out) result)))))))
+ (let* ((unread-stuff-p (echo-stream-unread-stuff stream))
+ (in (echo-stream-input-stream stream))
+ (out (echo-stream-output-stream stream))
+ (result (if eof-error-p
+ (,in-fun in ,@args)
+ (,in-fun in nil in))))
+ (setf (echo-stream-unread-stuff stream) nil)
+ (cond
+ ((eql result in) eof-value)
+ ;; If unread-stuff was true, the character read
+ ;; from the input stream was previously echoed.
+ (t (unless unread-stuff-p (,out-fun result out)) result))))))
(in-fun echo-in read-char write-char eof-error-p eof-value)
(in-fun echo-bin read-byte write-byte eof-error-p eof-value))
(defun echo-n-bin (stream buffer start numbytes eof-error-p)
- (let ((new-start start)
- (read 0))
- (loop
- (let ((thing (pop (echo-stream-unread-stuff stream))))
- (cond
- (thing
- (setf (aref buffer new-start) thing)
- (incf new-start)
- (incf read)
- (when (= read numbytes)
- (return-from echo-n-bin numbytes)))
- (t (return nil)))))
- (let ((bytes-read (read-n-bytes (echo-stream-input-stream stream) buffer
- new-start (- numbytes read) nil)))
- (cond
- ((not eof-error-p)
- (write-sequence buffer (echo-stream-output-stream stream)
- :start new-start :end (+ new-start bytes-read))
- (+ bytes-read read))
- ((> numbytes (+ read bytes-read))
- (write-sequence buffer (echo-stream-output-stream stream)
- :start new-start :end (+ new-start bytes-read))
- (error 'end-of-file :stream stream))
- (t
- (write-sequence buffer (echo-stream-output-stream stream)
- :start new-start :end (+ new-start bytes-read))
- (aver (= numbytes (+ new-start bytes-read)))
- numbytes)))))
+ (let ((bytes-read 0))
+ ;; Note: before ca 1.0.27.18, the logic for handling unread
+ ;; characters never could have worked, so probably nobody has ever
+ ;; tried doing bivalent block I/O through an echo stream; this may
+ ;; not work either.
+ (when (echo-stream-unread-stuff stream)
+ (let* ((char (read-char stream))
+ (octets (octets-to-string
+ (string char)
+ :external-format
+ (stream-external-format
+ (echo-stream-input-stream stream))))
+ (octet-count (length octets))
+ (blt-count (min octet-count numbytes)))
+ (replace buffer octets :start1 start :end1 (+ start blt-count))
+ (incf start blt-count)
+ (decf numbytes blt-count)))
+ (incf bytes-read (read-n-bytes (echo-stream-input-stream stream) buffer
+ start numbytes nil))
+ (cond
+ ((not eof-error-p)
+ (write-sequence buffer (echo-stream-output-stream stream)
+ :start start :end (+ start bytes-read))
+ bytes-read)
+ ((> numbytes bytes-read)
+ (write-sequence buffer (echo-stream-output-stream stream)
+ :start start :end (+ start bytes-read))
+ (error 'end-of-file :stream stream))
+ (t
+ (write-sequence buffer (echo-stream-output-stream stream)
+ :start start :end (+ start bytes-read))
+ (aver (= numbytes (+ start bytes-read)))
+ numbytes))))
\f
;;;; STRING-INPUT-STREAM stuff
(out (two-way-stream-output-stream stream)))
(case operation
(:listen
- (or (not (null (echo-stream-unread-stuff stream)))
- (if (ansi-stream-p in)
- (or (/= (the fixnum (ansi-stream-in-index in))
- +ansi-stream-in-buffer-length+)
- (funcall (ansi-stream-misc in) in :listen))
- (stream-misc-dispatch in :listen))))
- (:unread (push arg1 (echo-stream-unread-stuff stream)))
+ (if (ansi-stream-p in)
+ (or (/= (the fixnum (ansi-stream-in-index in))
+ +ansi-stream-in-buffer-length+)
+ (funcall (ansi-stream-misc in) in :listen))
+ (stream-misc-dispatch in :listen)))
+ (:unread (setf (echo-stream-unread-stuff stream) t)
+ (unread-char arg1 in))
(:element-type
(let ((in-type (stream-element-type in))
(out-type (stream-element-type out)))
;; echo-stream specific, or PEEK-CHAR because it is peeking code.
;; -- mrd 2002-11-18
;;
- ;; UNREAD-CHAR-P indicates whether the current character was one
- ;; that was previously unread. In that case, we need to ensure that
- ;; the semantics for UNREAD-CHAR are held; the character should
- ;; not be echoed again.
- (let ((unread-char-p nil))
+ ;; UNREAD-P indicates whether the next character on IN was one
+ ;; that was previously unread. In that case, we need to ensure
+ ;; that the semantics for UNREAD-CHAR are held; the character
+ ;; should not be echoed again.
+ (let ((unread-p nil)
+ ;; The first peek shouldn't touch the unread-stuff slot.
+ (initial-peek-p t))
(flet ((outfn (c)
- (unless unread-char-p
+ (unless unread-p
(if (ansi-stream-p out)
(funcall (ansi-stream-out out) out c)
;; gray-stream
(stream-write-char out c))))
(infn ()
- ;; Obtain input from unread buffer or input stream,
- ;; and set the flag appropriately.
- (cond ((not (null (echo-stream-unread-stuff stream)))
- (setf unread-char-p t)
- (pop (echo-stream-unread-stuff stream)))
- (t
- (setf unread-char-p nil)
- (read-char in (first arg2) :eof)))))
+ (if initial-peek-p
+ (setf unread-p (echo-stream-unread-stuff stream))
+ (setf (echo-stream-unread-stuff stream) nil))
+ (setf initial-peek-p nil)
+ (read-char in (first arg2) :eof)))
(generalized-peeking-mechanism
arg1 (second arg2) char
(infn)
(get-output-stream-string out-stream))
;; (Before the fix, the LET* expression just signalled an error.)
"a"))
+;;; ... and yet, a little over 6 years on, echo-streams were still
+;;; broken when a read-char followed the unread/peek sequence. Do
+;;; people not actually use echo-streams? RMK, 2009-04-02.
+(assert (string=
+ (let* ((in-stream (make-string-input-stream "abc"))
+ (out-stream (make-string-output-stream))
+ (echo-stream (make-echo-stream in-stream out-stream)))
+ (unread-char (read-char echo-stream) echo-stream)
+ (peek-char nil echo-stream)
+ (read-char echo-stream)
+ (get-output-stream-string out-stream))
+ ;; before ca. 1.0.27.18, the LET* returned "aa"
+ "a"))
;;; Reported by Fredrik Sandstrom to sbcl-devel 2005-05-17 ("Bug in
;;; peek-char"):
(let ((v (make-array 5 :fill-pointer 0 :element-type 'standard-char)))
(format v "foo")
(assert (equal (coerce "foo" 'base-string) v))))
+
+;;; Circa 1.0.27.18, echo-streams were changed somewhat, so that
+;;; unread-char on an echo-stream propagated the character down to the
+;;; echo-stream's input stream. (All other implementations but CMUCL
+;;; seemed to do this). The most useful argument for this behavior
+;;; involves cases where an input operation on an echo-stream finishes
+;;; up by unreading a delimiter, and the user wants to proceed to use the
+;;; underlying stream, e.g.,
+(assert (equal
+ (with-input-from-string (in "foo\"bar\"")
+ (with-open-stream (out (make-broadcast-stream))
+ (with-open-stream (echo (make-echo-stream in out))
+ (read echo)))
+ (read in))
+ ;; Before ca 1.0.27.18, the implicit UNREAD-CHAR at the end of
+ ;; the first READ wouldn't get back to IN, so the second READ
+ ;; returned BAR, not "BAR" (and then subsequent reads would
+ ;; lose).
+ "bar"))
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.27.17"
+"1.0.27.18"
projects / sbcl.git / commitdiff