(mapcar
(lambda (buffering)
(let ((function
- (intern (let ((*print-case* :upcase))
- (format nil name-fmt (car buffering))))))
+ (intern (format nil name-fmt (string (car buffering))))))
`(progn
(defun ,function (stream byte)
(output-wrapper/variable-width (stream ,size ,buffering ,restart)
(mapcar
(lambda (buffering)
(let ((function
- (intern (let ((*print-case* :upcase))
- (format nil name-fmt (car buffering))))))
+ (intern (format nil name-fmt (string (car buffering))))))
`(progn
(defun ,function (stream byte)
(output-wrapper (stream ,size ,buffering ,restart)
:end end))))
(if (and (typep thing 'base-string)
(eq (fd-stream-external-format stream) :latin-1))
- (ecase (fd-stream-buffering stream)
- (:full
- (output-raw-bytes stream thing start end))
- (:line
- (output-raw-bytes stream thing start end)
- (when last-newline
- (flush-output-buffer stream)))
- (:none
- (frob-output stream thing start end nil)))
+ (ecase (fd-stream-buffering stream)
+ (:full
+ (output-raw-bytes stream thing start end))
+ (:line
+ (output-raw-bytes stream thing start end)
+ (when last-newline
+ (flush-output-buffer stream)))
+ (:none
+ (frob-output stream thing start end nil)))
(ecase (fd-stream-buffering stream)
(:full (funcall (fd-stream-output-bytes stream)
stream thing nil start end))
;;; per element.
(defvar *input-routines* ())
-;;; Fill the input buffer, and return the first character. Throw to
-;;; EOF-INPUT-CATCHER if the eof was reached. Drop into SYSTEM:SERVER
-;;; if necessary.
-(defun frob-input (stream)
+;;; Fill the input buffer, and return the number of bytes read. Throw
+;;; to EOF-INPUT-CATCHER if the eof was reached. Drop into
+;;; SYSTEM:SERVER if necessary.
+(defun refill-buffer/fd (stream)
(let ((fd (fd-stream-fd stream))
(ibuf-sap (fd-stream-ibuf-sap stream))
(buflen (fd-stream-ibuf-length stream))
(unless (sb!sys:wait-until-fd-usable
fd :input (fd-stream-timeout stream))
(error 'io-timeout :stream stream :direction :read))
- (frob-input stream))
+ (refill-buffer/fd stream))
(simple-stream-perror "couldn't read from ~S" stream errno)))
((zerop count)
(setf (fd-stream-listen stream) :eof)
(/show0 "THROWing EOF-INPUT-CATCHER")
(throw 'eof-input-catcher nil))
(t
- (incf (fd-stream-ibuf-tail stream) count))))))
+ (incf (fd-stream-ibuf-tail stream) count)
+ count)))))
;;; Make sure there are at least BYTES number of bytes in the input
-;;; buffer. Keep calling FROB-INPUT until that condition is met.
+;;; buffer. Keep calling REFILL-BUFFER/FD until that condition is met.
(defmacro input-at-least (stream bytes)
(let ((stream-var (gensym))
(bytes-var (gensym)))
(fd-stream-ibuf-head ,stream-var))
,bytes-var)
(return))
- (frob-input ,stream-var)))))
+ (refill-buffer/fd ,stream-var)))))
(defmacro input-wrapper/variable-width ((stream bytes eof-error eof-value)
&body read-forms)
(= total-copied requested)
(return total-copied))
(;; If EOF, we're done in another way.
- (zerop (refill-fd-stream-buffer stream))
+ (null (catch 'eof-input-catcher (refill-buffer/fd stream)))
(if eof-error-p
(error 'end-of-file :stream stream)
(return total-copied)))
;; through into another pass of the loop.
))))
-;;; Try to refill the stream buffer. Return the number of bytes read.
-;;; (For EOF, the return value will be zero, otherwise positive.)
-(defun refill-fd-stream-buffer (stream)
- ;; We don't have any logic to preserve leftover bytes in the buffer,
- ;; so we should only be called when the buffer is empty.
- ;; FIXME: can have three bytes in buffer because of UTF-8
- (let ((new-head 0)
- (sap (fd-stream-ibuf-sap stream)))
- (do ((head (fd-stream-ibuf-head stream) (1+ head))
- (tail (fd-stream-ibuf-tail stream)))
- ((= head tail))
- (setf (sap-ref-8 sap new-head) (sap-ref-8 sap head))
- (incf new-head))
- (multiple-value-bind (count err)
- (sb!unix:unix-read (fd-stream-fd stream)
- (sap+ sap new-head)
- (- (fd-stream-ibuf-length stream) new-head))
- (declare (type (or index null) count))
- (when (null count)
- (simple-stream-perror "couldn't read from ~S" stream err))
- (setf (fd-stream-listen stream) nil
- (fd-stream-ibuf-head stream) 0
- (fd-stream-ibuf-tail stream) (+ count new-head))
- count)))
-
(defun fd-stream-resync (stream)
(dolist (entry *external-formats*)
(when (member (fd-stream-external-format stream) (first entry))
(defmacro define-external-format (external-format size output-restart
out-expr in-expr)
(let* ((name (first external-format))
- (out-function (intern (let ((*print-case* :upcase))
- (format nil "OUTPUT-BYTES/~A" name))))
- (format (format nil "OUTPUT-CHAR-~A-~~A-BUFFERED" name))
- (in-function (intern (let ((*print-case* :upcase))
- (format nil "FD-STREAM-READ-N-CHARACTERS/~A"
- name))))
- (in-char-function (intern (let ((*print-case* :upcase))
- (format nil "INPUT-CHAR/~A" name)))))
+ (out-function (symbolicate "OUTPUT-BYTES/" name))
+ (format (format nil "OUTPUT-CHAR-~A-~~A-BUFFERED" (string name)))
+ (in-function (symbolicate "FD-STREAM-READ-N-CHARACTERS/" name))
+ (in-char-function (symbolicate "INPUT-CHAR/" name)))
`(progn
(defun ,out-function (stream string flush-p start end)
(let ((start (or start 0))
(= total-copied requested)
(return total-copied))
( ;; If EOF, we're done in another way.
- (zerop (refill-fd-stream-buffer stream))
+ (null (catch 'eof-input-catcher (refill-buffer/fd stream)))
(if eof-error-p
(error 'end-of-file :stream stream)
(return total-copied)))
(setf *external-formats*
(cons '(,external-format ,in-function ,in-char-function ,out-function
,@(mapcar #'(lambda (buffering)
- (intern (let ((*print-case* :upcase))
- (format nil format buffering))))
+ (intern (format nil format (string buffering))))
'(:none :line :full)))
*external-formats*)))))
(external-format output-restart out-size-expr
out-expr in-size-expr in-expr)
(let* ((name (first external-format))
- (out-function (intern (let ((*print-case* :upcase))
- (format nil "OUTPUT-BYTES/~A" name))))
- (format (format nil "OUTPUT-CHAR-~A-~~A-BUFFERED" name))
- (in-function (intern (let ((*print-case* :upcase))
- (format nil "FD-STREAM-READ-N-CHARACTERS/~A"
- name))))
- (in-char-function (intern (let ((*print-case* :upcase))
- (format nil "INPUT-CHAR/~A" name))))
- (resync-function (intern (let ((*print-case* :upcase))
- (format nil "RESYNC/~A" name)))))
+ (out-function (symbolicate "OUTPUT-BYTES/" name))
+ (format (format nil "OUTPUT-CHAR-~A-~~A-BUFFERED" (string name)))
+ (in-function (symbolicate "FD-STREAM-READ-N-CHARACTERS/" name))
+ (in-char-function (symbolicate "INPUT-CHAR/" name))
+ (resync-function (symbolicate "RESYNC/" name)))
`(progn
(defun ,out-function (fd-stream string flush-p start end)
(let ((start (or start 0))
(return total-copied))
( ;; If EOF, we're done in another way.
(or (eq decode-break-reason 'eof)
- (zerop (refill-fd-stream-buffer stream)))
+ (null (catch 'eof-input-catcher
+ (refill-buffer/fd stream))))
(if eof-error-p
(error 'end-of-file :stream stream)
(return total-copied)))
(setf *external-formats*
(cons '(,external-format ,in-function ,in-char-function ,out-function
,@(mapcar #'(lambda (buffering)
- (intern (let ((*print-case* :upcase))
- (format nil format buffering))))
+ (intern (format nil format (string buffering))))
'(:none :line :full))
,resync-function)
*external-formats*)))))
(function c-string int))
sb!unix:codeset)
"LATIN-1")
- "KEYWORD")))
- (dolist (entry *external-formats*
- (setf (fd-stream-external-format fd-stream) :latin-1))
- (when (member (fd-stream-external-format fd-stream) (first entry))
- (return)))
+ "KEYWORD"))
+ (dolist (entry *external-formats*
+ (restart-case
+ (error "Invalid external-format ~A"
+ (fd-stream-external-format fd-stream))
+ (use-default ()
+ :report "Set external format to LATIN-1"
+ (setf (fd-stream-external-format fd-stream) :latin-1))))
+ (when (member (fd-stream-external-format fd-stream) (first entry))
+ (return))))
(when input-p
(multiple-value-bind (routine type size read-n-characters
0
0))))
(cond ((eql count 1)
- (frob-input fd-stream)
+ (refill-buffer/fd fd-stream)
(setf (fd-stream-ibuf-head fd-stream) 0)
(setf (fd-stream-ibuf-tail fd-stream) 0))
(t
(let ((original (case if-exists
((:rename :rename-and-delete)
(pick-backup-name namestring))
- ((:append)
+ ((:append :overwrite)
;; KLUDGE: Provent CLOSE from deleting
;; appending streams when called with :ABORT T
namestring)))