(external-format :default)
;; fixed width, or function to call with a character
(char-size 1 :type (or fixnum function))
- (output-bytes #'ill-out :type function))
+ (output-bytes #'ill-out :type function)
+ ;; a boolean indicating whether the stream is bivalent. For
+ ;; internal use only.
+ (bivalent-p nil :type boolean))
(def!method print-object ((fd-stream fd-stream) stream)
(declare (type stream stream))
(print-unreadable-object (fd-stream stream :type t :identity t)
(defun stream-decoding-error (stream octets)
(error 'stream-decoding-error
+ :external-format (stream-external-format stream)
:stream stream
;; FIXME: dunno how to get at OCTETS currently, or even if
;; that's the right thing to report.
:octets octets))
(defun stream-encoding-error (stream code)
(error 'stream-encoding-error
+ :external-format (stream-external-format stream)
:stream stream
:code code))
;;; correct on win32. However, none of the places that use it require
;;; further assurance than "may" versus "will definitely not".
(defun sysread-may-block-p (stream)
- #+win32
+ #!+win32
;; This answers T at EOF on win32, I think.
(not (sb!win32:fd-listen (fd-stream-fd stream)))
- #-win32
+ #!-win32
(sb!unix:with-restarted-syscall (count errno)
(sb!alien:with-alien ((read-fds (sb!alien:struct sb!unix:fd-set)))
(sb!unix:fd-zero read-fds)
(do-listen)))))))
(do-listen)))
(:unread
- (setf (fd-stream-unread fd-stream) arg1)
+ ;; If the stream is bivalent, the user might follow an
+ ;; unread-char with a read-byte. In this case, the bookkeeping
+ ;; is simpler if we adjust the buffer head by the number of code
+ ;; units in the character.
+ ;; FIXME: there has to be a proper way to check for bivalence,
+ ;; right?
+ (if (fd-stream-bivalent-p fd-stream)
+ (decf (buffer-head (fd-stream-ibuf fd-stream))
+ (fd-stream-character-size fd-stream arg1))
+ (setf (fd-stream-unread fd-stream) arg1))
(setf (fd-stream-listen fd-stream) t))
(:close
;; Drop input buffers
:buffering buffering
:dual-channel-p dual-channel-p
:external-format external-format
+ :bivalent-p (eq element-type :default)
:char-size (external-format-char-size external-format)
:timeout
(if timeout
(:io (values t t sb!unix:o_rdwr))
(:probe (values t nil sb!unix:o_rdonly)))
(declare (type index mask))
- (let* ((pathname (merge-pathnames filename))
- (namestring
- (cond ((unix-namestring pathname input))
- ((and input (eq if-does-not-exist :create))
- (unix-namestring pathname nil))
- ((and (eq direction :io) (not if-does-not-exist-given))
- (unix-namestring pathname nil)))))
+ (let* (;; PATHNAME is the pathname we associate with the stream.
+ (pathname (merge-pathnames filename))
+ (physical (physicalize-pathname pathname))
+ (truename (probe-file physical))
+ ;; NAMESTRING is the native namestring we open the file with.
+ (namestring (cond (truename
+ (native-namestring truename :as-file t))
+ ((or (not input)
+ (and input (eq if-does-not-exist :create))
+ (and (eq direction :io) (not if-does-not-exist-given)))
+ (native-namestring physical :as-file t)))))
;; Process if-exists argument if we are doing any output.
(cond (output
(unless if-exists-given
(when (and output (= (logand orig-mode #o170000)
#o40000))
(error 'simple-file-error
- :pathname namestring
+ :pathname pathname
:format-control
"can't open ~S for output: is a directory"
:format-arguments (list namestring)))
(cond (new-name
(setf (fd-stream-pathname stream) new-name)
(setf (fd-stream-file stream)
- (unix-namestring new-name nil))
+ (native-namestring (physicalize-pathname new-name)
+ :as-file t))
t)
(t
(fd-stream-pathname stream)))))