\f
;;;; file position and file length
-;;; Call the misc method with the :file-position operation.
+;;; 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))
(when res
(- res (- +in-buffer-length+ (lisp-stream-in-index stream))))))))
-;;; declaration test functions
-
-#!+high-security
-(defun stream-associated-with-file (stream)
- #!+sb-doc
- "Tests if the stream is associated with a file"
- (or (typep stream 'file-stream)
- (and (synonym-stream-p stream)
- (typep (symbol-value (synonym-stream-symbol stream))
- 'file-stream))))
-
-;;; Like File-Position, only use :file-length.
+;;; This is a literal translation of the ANSI glossary entry "stream
+;;; associated with a file".
+;;;
+;;; KLUDGE: Note that since Unix famously thinks "everything is a
+;;; file", and in particular stdin, stdout, and stderr are files, we
+;;; end up with this test being satisfied for weird things like
+;;; *STANDARD-OUTPUT* (to a tty). That seems unlikely to be what the
+;;; ANSI spec really had in mind, especially since this is used as a
+;;; qualification for operations like FILE-LENGTH (so that ANSI was
+;;; probably thinking of something like what Unix calls block devices)
+;;; but I can't see any better way to do it. -- WHN 2001-04-14
+(defun stream-associated-with-file-p (x)
+ "Test for the ANSI concept \"stream associated with a file\"."
+ (or (typep x 'file-stream)
+ (and (synonym-stream-p x)
+ (stream-associated-with-file-p (symbol-value
+ (synonym-stream-symbol x))))))
+
+(defun stream-must-be-associated-with-file (stream)
+ (declare (type stream stream))
+ (unless (stream-associated-with-file-p stream)
+ (error 'simple-type-error
+ ;; KLUDGE: The ANSI spec for FILE-LENGTH specifically says
+ ;; this should be TYPE-ERROR. But what then can we use for
+ ;; EXPECTED-TYPE? This SATISFIES type (with a nonstandard
+ ;; private predicate function..) is ugly and confusing, but
+ ;; I can't see any other way. -- WHN 2001-04-14
+ :expected-type '(satisfies stream-associated-with-file-p)
+ :format-string
+ "~@<The stream ~2I~_~S ~I~_isn't associated with a file.~:>"
+ :format-arguments (list stream))))
+
+;;; like FILE-POSITION, only using :FILE-LENGTH
(defun file-length (stream)
(declare (type (or file-stream synonym-stream) stream))
-
- #!+high-security
- (check-type-var stream '(satisfies stream-associated-with-file)
- "a stream associated with a file")
-
+ (stream-must-be-associated-with-file stream)
(funcall (lisp-stream-misc stream) stream :file-length))
\f
;;;; input functions
(stream *standard-input*)
(eof-error-p t)
eof-value recursive-p)
-
+ (declare (ignore recursive-p))
(let ((stream (in-synonym-of stream)))
(if (lisp-stream-p stream)
(let ((char (read-char stream eof-error-p eof-value)))
(if (lisp-stream-p stream)
(or (/= (the fixnum (lisp-stream-in-index stream)) +in-buffer-length+)
;; Test for T explicitly since misc methods return :EOF sometimes.
- (eq (funcall (lisp-stream-misc stream) stream :listen) at))
+ (eq (funcall (lisp-stream-misc stream) stream :listen) t))
;; Fall through to Gray streams FUNDAMENTAL-STREAM case.
(stream-listen stream))))
;;; Read NUMBYTES bytes into BUFFER beginning at START, and return the
;;; number of bytes read.
;;;
-;;; Note: CMU CL's version of this had a special interpretation of EOF-ERROR-P
-;;; which SBCL does not have. (In the EOF-ERROR-P=NIL case, CMU CL's version
-;;; would return as soon as any data became available.) This could be useful
-;;; behavior for things like pipes in some cases, but it wasn't being used in
-;;; SBCL, so it was dropped. If we ever need it, it could be added later as a
-;;; new variant N-BIN method (perhaps N-BIN-ASAP?) or something.
+;;; Note: CMU CL's version of this had a special interpretation of
+;;; EOF-ERROR-P which SBCL does not have. (In the EOF-ERROR-P=NIL
+;;; case, CMU CL's version would return as soon as any data became
+;;; available.) This could be useful behavior for things like pipes in
+;;; some cases, but it wasn't being used in SBCL, so it was dropped.
+;;; If we ever need it, it could be added later as a new variant N-BIN
+;;; method (perhaps N-BIN-ASAP?) or something.
(defun read-n-bytes (stream buffer start numbytes &optional (eof-error-p t))
(declare (type lisp-stream stream)
(type index numbytes start)
;; spec, and extrapolating from the behavior of other operations
;; when their operands are the wrong type, it seems that it would be
;; more correct to essentially
- ;; (ASSERT (<= 0 START END (LENGTH STRING)))
+ ;; (AVER (<= 0 START END (LENGTH STRING)))
;; instead of modifying the incorrect values.
#!+high-security
(setf end (min end (length (the vector string))))
(:copier nil))
(input-stream (required-argument) :type stream :read-only t)
(output-stream (required-argument) :type stream :read-only t))
-(def!method print-object ((x two-way-stream) stream)
- (print-unreadable-object (x stream :type t :identity t)
- (format stream
- ":INPUT-STREAM ~S :OUTPUT-STREAM ~S"
- (two-way-stream-input-stream x)
- (two-way-stream-output-stream x))))
+(defprinter (two-way-stream) input-stream output-stream)
#!-high-security-support
(setf (fdocumentation 'make-two-way-stream 'function)
- "Returns a bidirectional stream which gets its input from Input-Stream and
+ "Return a bidirectional stream which gets its input from Input-Stream and
sends its output to Output-Stream.")
#!+high-security-support
(defun make-two-way-stream (input-stream output-stream)
#!+sb-doc
- "Returns a bidirectional stream which gets its input from Input-Stream and
+ "Return a bidirectional stream which gets its input from Input-Stream and
sends its output to Output-Stream."
;; FIXME: This idiom of the-real-stream-of-a-possibly-synonym-stream
;; should be encapsulated in a function, and used here and most of
(:include lisp-stream
(in #'concatenated-in)
(bin #'concatenated-bin)
+ (n-bin #'concatenated-n-bin)
(misc #'concatenated-misc))
(:constructor
#!-high-security-support make-concatenated-stream
#!+high-security-support %make-concatenated-stream
(&rest streams &aux (current streams)))
(:copier nil))
- ;; The car of this is the stream we are reading from now.
+ ;; The car of this is the substream we are reading from now.
current
- ;; This is a list of all the streams. We need to remember them so that
- ;; we can close them.
+ ;; This is a list of all the substreams there ever were. We need to
+ ;; remember them so that we can close them.
;;
;; FIXME: ANSI says this is supposed to be the list of streams that
;; we still have to read from. So either this needs to become a
(macrolet ((in-fun (name fun)
`(defun ,name (stream eof-error-p eof-value)
- (do ((current (concatenated-stream-current stream) (cdr current)))
+ (do ((current (concatenated-stream-current stream)
+ (cdr current)))
((null current)
(eof-or-lose stream eof-error-p eof-value))
(let* ((stream (car current))
(in-fun concatenated-in read-char)
(in-fun concatenated-bin read-byte))
+(defun concatenated-n-bin (stream buffer start numbytes eof-errorp)
+ (do ((current (concatenated-stream-current stream) (cdr current))
+ (current-start start)
+ (remaining-bytes numbytes))
+ ((null current)
+ (if eof-errorp
+ (error 'end-of-file :stream stream)
+ (- numbytes remaining-bytes)))
+ (let* ((stream (car current))
+ (bytes-read (read-n-bytes stream buffer current-start
+ remaining-bytes nil)))
+ (incf current-start bytes-read)
+ (decf remaining-bytes bytes-read)
+ (when (zerop remaining-bytes) (return numbytes)))
+ (setf (concatenated-stream-current stream) (cdr current))))
+
(defun concatenated-misc (stream operation &optional arg1 arg2)
(let ((left (concatenated-stream-current stream)))
(when left
projects / sbcl.git / blobdiff