;;; **********************************************************************
;;;
;;; Various functions needed by simple-streams
-
(declaim (inline buffer-sap bref (setf bref) buffer-copy
allocate-buffer free-buffer))
(defun bref (buffer index)
(declare (type simple-stream-buffer buffer)
(type (integer 0 #.most-positive-fixnum) index))
- (sb-sys:sap-ref-8 (buffer-sap buffer) index))
+ (if (vectorp buffer)
+ (sb-sys:sap-ref-8 (sb-sys:vector-sap buffer) index)
+ (sb-sys:sap-ref-8 buffer index)))
(defun (setf bref) (octet buffer index)
(declare (type (unsigned-byte 8) octet)
(type simple-stream-buffer buffer)
(type (integer 0 #.most-positive-fixnum) index))
- (setf (sb-sys:sap-ref-8 (buffer-sap buffer) index) octet))
+ (if (vectorp buffer)
+ (setf (sb-sys:sap-ref-8 (sb-sys:vector-sap buffer) index) octet)
+ (setf (sb-sys:sap-ref-8 buffer index) octet)))
(defun buffer-copy (src soff dst doff length)
(declare (type simple-stream-buffer src dst)
(defun std-dc-newline-in-handler (stream character)
(with-stream-class (dual-channel-simple-stream stream)
- (setf (sm charpos stream) -1) ;; set to 0 "if reading" ???
+ ;; FIXME: Currently, -1 is wrong, since callers of CHARPOS expect
+ ;; a result in (or null (and fixnum unsigned-byte)), so they must
+ ;; never see this temporary value. Note that in
+ ;; STD-NEWLINE-OUT-HANDLER it is correct to use -1, since CHARPOS
+ ;; is incremented to zero before WRITE-CHAR returns. Perhaps the
+ ;; same should happen for input?
+ (setf (sm charpos stream) 0) ; was -1
character))
(defvar *std-control-out-table*
(type (or null simple-stream-buffer) buffer)
(type fixnum start)
(type (or null fixnum) end)
+ (type blocking blocking)
(optimize (speed 3) (space 2) (safety 0) (debug 0)))
(with-stream-class (simple-stream stream)
(let ((fd (sm input-handle stream))
(declare (type sb-int:index mask))
(let ((name (cond ((sb-int:unix-namestring pathname input))
((and input (eq if-does-not-exist :create))
+ (sb-int:unix-namestring pathname nil))
+ ((and (eq direction :io) (not if-does-not-exist-given))
(sb-int:unix-namestring pathname nil)))))
;; Process if-exists argument if we are doing any output.
(cond (output
:new-version
:error)))
(case if-exists
- ((:error nil)
+ ((:error nil :new-version)
(setf mask (logior mask sb-unix:o_excl)))
((:rename :rename-and-delete)
(setf mask (logior mask sb-unix:o_creat)))
- ((:new-version :supersede)
+ ((:supersede)
(setf mask (logior mask sb-unix:o_trunc)))))
(t
(setf if-exists nil))) ; :ignore-this-arg