(setf (ansi-stream-sout stream) #'closed-flame)
(setf (ansi-stream-misc stream) #'closed-flame))
\f
-;;;; file position and file length
+;;;; for file position and file length
(defun external-format-char-size (external-format)
- (let ((ef-entry (find-external-format external-format)))
- (if (variable-width-external-format-p ef-entry)
- (bytes-for-char-fun ef-entry)
- (funcall (bytes-for-char-fun ef-entry) #\x))))
+ (ef-char-size (get-external-format external-format)))
;;; Call the MISC method with the :FILE-POSITION operation.
#!-sb-fluid (declaim (inline ansi-stream-file-position))
(declare (type stream stream))
(declare (type (or index (alien sb!unix:off-t) (member nil :start :end))
position))
- ;; FIXME: It woud be good to comment on the stuff that is done here...
+ ;; FIXME: It would be good to comment on the stuff that is done here...
;; FIXME: This doesn't look interrupt safe.
(cond
(position
;; a-s-read-sequence and needs a lambda list that's congruent with
;; that of a-s-read-char
(declare (ignore recursive-p))
- (prepare-for-fast-read-byte stream
- (prog1
- (fast-read-byte eof-error-p eof-value t)
- (done-with-fast-read-byte))))
+ (with-fast-read-byte (t stream eof-error-p eof-value)
+ (fast-read-byte)))
(defun read-byte (stream &optional (eof-error-p t) eof-value)
(if (ansi-stream-p stream)
;; An empty count does not necessarily mean that we reached
;; the EOF, it's also possible that it's e.g. due to a
;; invalid octet sequence in a multibyte stream. To handle
- ;; the resyncing case correctly we need to call the
- ;; single-character reading function and check whether an
- ;; EOF was really reached. If not, we can just fill the
- ;; buffer by one character, and hope that the next refill
- ;; will not need to resync.
- (let* ((value (funcall (ansi-stream-in stream) stream nil :eof))
- (index (1- +ansi-stream-in-buffer-length+)))
- (case value
- ((:eof)
- ;; Mark buffer as empty.
+ ;; the resyncing case correctly we need to call the reading
+ ;; function and check whether an EOF was really reached. If
+ ;; not, we can just fill the buffer by one character, and
+ ;; hope that the next refill will not need to resync.
+ ;;
+ ;; KLUDGE: we can't use FD-STREAM functions (which are the
+ ;; only ones which will give us decoding errors) here,
+ ;; because this code is generic. We can't call the N-BIN
+ ;; function, because near the end of a real file that can
+ ;; legitimately bounce us to the IN function. So we have
+ ;; to call ANSI-STREAM-IN.
+ (let* ((index (1- +ansi-stream-in-buffer-length+))
+ (value (funcall (ansi-stream-in stream) stream nil :eof)))
+ (cond
+ ((eql value :eof)
+ ;; definitely EOF now
(setf (ansi-stream-in-index stream)
+ansi-stream-in-buffer-length+)
- ;; EOF. Redo the read, this time with the real eof parameters.
- (values t (funcall (ansi-stream-in stream)
- stream eof-error-p eof-value)))
- (otherwise
+ (values t (eof-or-lose stream eof-error-p eof-value)))
+ ;; we resynced or were given something instead
+ (t
(setf (aref ibuf index) value)
(values nil (setf (ansi-stream-in-index stream) index))))))
(t
(defun clear-output (&optional (stream *standard-output*))
(with-out-stream stream (ansi-stream-misc :clear-output)
- (stream-force-output))
+ (stream-clear-output))
nil)
(defun write-byte (integer stream)
;; not work either.
(when (echo-stream-unread-stuff stream)
(let* ((char (read-char stream))
- (octets (octets-to-string
+ (octets (string-to-octets
(string char)
:external-format
(stream-external-format
;; end of the stream.
(index-cache 0 :type index)
;; Requested element type
- (element-type 'character))
+ (element-type 'character :type type-specifier))
#!+sb-doc
(setf (fdocumentation 'make-string-output-stream 'function)
(defun string-out-misc (stream operation &optional arg1 arg2)
(declare (ignore arg2))
+ (declare (optimize speed))
(case operation
(:charpos
;; Keeping this first is a silly micro-optimization: FRESH-LINE
(buffer (string-output-stream-buffer stream))
(prev (string-output-stream-prev stream))
(base 0))
+ (declare (type (or null (simple-array character (*))) buffer))
:next
- (let ((pos (position #\newline buffer :from-end t :end pointer)))
+ (let ((pos (when buffer
+ (position #\newline buffer :from-end t :end pointer))))
(when (or pos (not buffer))
;; If newline is at index I, and pointer at index I+N, charpos
;; is N-1. If there is no newline, and pointer is at index N,
;;; FIXME: need to support (VECTOR NIL), ideally without destroying all hope
;;; of efficiency.
+(declaim (inline vector-with-fill-pointer))
+(defun vector-with-fill-pointer-p (x)
+ (and (vectorp x)
+ (array-has-fill-pointer-p x)))
+
(deftype string-with-fill-pointer ()
- '(and (or (vector character) (vector base-char))
- (satisfies array-has-fill-pointer-p)))
+ `(and (or (vector character) (vector base-char))
+ (satisfies vector-with-fill-pointer-p)))
(defstruct (fill-pointer-output-stream
(:include ansi-stream
(setf workspace new-workspace
offset-current current)
(set-array-header buffer workspace new-length
- current+1 0 new-length nil))
+ current+1 0 new-length nil nil))
(setf (fill-pointer buffer) current+1))
(setf (char workspace offset-current) character))))
current+1))
offset-current current
offset-dst-end dst-end)
(set-array-header buffer workspace new-length
- dst-end 0 new-length nil))
+ dst-end 0 new-length nil nil))
(setf (fill-pointer buffer) dst-end))
(replace workspace string
:start1 offset-current :start2 start :end2 end)))
projects / sbcl.git / blobdiff