(fd -1 :type fixnum)
;; controls when the output buffer is flushed
(buffering :full :type (member :full :line :none))
+ ;; controls whether the input buffer must be cleared before output
+ ;; (must be done for files, not for sockets, pipes and other data
+ ;; sources where input and output aren't related). non-NIL means
+ ;; don't clear input buffer.
+ (dual-channel-p nil)
;; character position (if known)
(char-pos nil :type (or index null))
;; T if input is waiting on FD. :EOF if we hit EOF.
size))
(flush-output-buffer ,stream-var)))
,(unless (eq (car buffering) :none)
- `(when (> (fd-stream-ibuf-tail ,stream-var)
- (fd-stream-ibuf-head ,stream-var))
+ `(when (and (not (fd-stream-dual-channel-p ,stream-var))
+ (> (fd-stream-ibuf-tail ,stream-var)
+ (fd-stream-ibuf-head ,stream-var)))
(file-position ,stream-var (file-position ,stream-var))))
,(if restart
`(catch 'output-nothing
,size))
(flush-output-buffer ,stream-var)))
,(unless (eq (car buffering) :none)
- `(when (> (fd-stream-ibuf-tail ,stream-var)
- (fd-stream-ibuf-head ,stream-var))
+ `(when (and (not (fd-stream-dual-channel-p ,stream-var))
+ (> (fd-stream-ibuf-tail ,stream-var)
+ (fd-stream-ibuf-head ,stream-var)))
(file-position ,stream-var (file-position ,stream-var))))
,(if restart
`(catch 'output-nothing
(let ((start (or start 0))
(end (or end (length (the (simple-array * (*)) thing)))))
(declare (type index start end))
- (when (> (fd-stream-ibuf-tail fd-stream)
- (fd-stream-ibuf-head fd-stream))
+ (when (and (not (fd-stream-dual-channel-p fd-stream))
+ (> (fd-stream-ibuf-tail fd-stream)
+ (fd-stream-ibuf-head fd-stream)))
(file-position fd-stream (file-position fd-stream)))
(let* ((len (fd-stream-obuf-length fd-stream))
(tail (fd-stream-obuf-tail fd-stream))
(let ((start (or start 0))
(end (or end (length string))))
(declare (type index start end))
- (when (> (fd-stream-ibuf-tail stream)
- (fd-stream-ibuf-head stream))
+ (when (and (not (fd-stream-dual-channel-p stream))
+ (> (fd-stream-ibuf-tail stream)
+ (fd-stream-ibuf-head stream)))
(file-position stream (file-position stream)))
(when (< end start)
(error ":END before :START!"))
(let ((start (or start 0))
(end (or end (length string))))
(declare (type index start end))
- (when (> (fd-stream-ibuf-tail fd-stream)
- (fd-stream-ibuf-head fd-stream))
+ (when (and (not (fd-stream-dual-channel-p fd-stream))
+ (> (fd-stream-ibuf-tail fd-stream)
+ (fd-stream-ibuf-head fd-stream)))
(file-position fd-stream (file-position fd-stream)))
(when (< end start)
(error ":END before :START!"))
(output-size nil)
(character-stream-p (subtypep type 'character)))
- (when (fd-stream-obuf-sap fd-stream)
+ ;; drop buffers when direction changes
+ (when (and (fd-stream-obuf-sap fd-stream) (not output-p))
(push (fd-stream-obuf-sap fd-stream) *available-buffers*)
(setf (fd-stream-obuf-sap fd-stream) nil))
- (when (fd-stream-ibuf-sap fd-stream)
+ (when (and (fd-stream-ibuf-sap fd-stream) (not input-p))
(push (fd-stream-ibuf-sap fd-stream) *available-buffers*)
(setf (fd-stream-ibuf-sap fd-stream) nil))
normalized-external-format))
(unless routine
(error "could not find any input routine for ~S" target-type))
- (setf (fd-stream-ibuf-sap fd-stream) (next-available-buffer))
- (setf (fd-stream-ibuf-length fd-stream) bytes-per-buffer)
- (setf (fd-stream-ibuf-tail fd-stream) 0)
(if character-stream-p
(setf (fd-stream-in fd-stream) routine
(fd-stream-bin fd-stream) #'ill-bin)
(error "could not find any output routine for ~S buffered ~S"
(fd-stream-buffering fd-stream)
target-type))
- (setf (fd-stream-obuf-sap fd-stream) (next-available-buffer))
- (setf (fd-stream-obuf-length fd-stream) bytes-per-buffer)
- (setf (fd-stream-obuf-tail fd-stream) 0)
(when character-stream-p
(setf (fd-stream-output-bytes fd-stream) output-bytes))
(if character-stream-p
(fd-stream-bout fd-stream) routine))
(setf (fd-stream-sout fd-stream)
(if (eql size 1) #'fd-sout #'ill-out))
- (setf (fd-stream-char-pos fd-stream) 0)
(setf output-size size)
(setf output-type type)))
(sb!sys:serve-all-events)))
(:element-type
(fd-stream-element-type fd-stream))
+ (:external-format
+ (fd-stream-external-format fd-stream))
(:interactive-p
(= 1 (the (member 0 1)
(sb!unix:unix-isatty (fd-stream-fd fd-stream)))))
(if (zerop mode)
nil
(truncate size (fd-stream-element-size fd-stream)))))
+ ;; FIXME: I doubt this is correct in the presence of Unicode,
+ ;; since fd-stream FILE-POSITION is measured in bytes.
+ (:file-string-length
+ (etypecase arg1
+ (character 1)
+ (string (length arg1))))
(:file-position
(fd-stream-file-position fd-stream arg1))))
delete-original
pathname
input-buffer-p
+ dual-channel-p
(name (if file
(format nil "file ~S" file)
(format nil "descriptor ~W" fd)))
:delete-original delete-original
:pathname pathname
:buffering buffering
+ :dual-channel-p dual-channel-p
:external-format external-format
:timeout timeout)))
+ (when input
+ (setf (fd-stream-ibuf-sap stream) (next-available-buffer))
+ (setf (fd-stream-ibuf-length stream) bytes-per-buffer)
+ (setf (fd-stream-ibuf-tail stream) 0))
+ (when output
+ (setf (fd-stream-obuf-sap stream) (next-available-buffer))
+ (setf (fd-stream-obuf-length stream) bytes-per-buffer)
+ (setf (fd-stream-obuf-tail stream) 0)
+ (setf (fd-stream-char-pos stream) 0))
(set-fd-stream-routines stream element-type input output input-buffer-p)
(when (and auto-close (fboundp 'finalize))
(finalize stream
:original original
:delete-original delete-original
:pathname pathname
+ :dual-channel-p nil
:input-buffer-p t
:auto-close t))
(:probe
t)
(t
(fd-stream-pathname stream)))))
-\f
-;;;; international character support (which is trivial for our simple
-;;;; character sets)
-
-;;;; (Those who do Lisp only in English might not remember that ANSI
-;;;; requires these functions to be exported from package
-;;;; COMMON-LISP.)
-
-(defun file-string-length (stream object)
- (declare (type (or string character) object) (type fd-stream stream))
- #!+sb-doc
- "Return the delta in STREAM's FILE-POSITION that would be caused by writing
- OBJECT to STREAM. Non-trivial only in implementations that support
- international character sets."
- (declare (ignore stream))
- (etypecase object
- (character 1)
- (string (length object))))
-
-(defun stream-external-format (stream)
- (declare (type fd-stream stream))
- #!+sb-doc
- "Return the actual external format for fd-streams, otherwise :DEFAULT."
- (if (typep stream 'fd-stream)
- (fd-stream-external-format stream)
- :default))
projects / sbcl.git / blobdiff