X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-simple-streams%2Finternal.lisp;h=e5e926e68791965c0cb8f6efe370c507980f69cd;hb=93b89755004549ed5f20d1938fd6e54ee20650b2;hp=da127f79386b58ba6e206172f44e51e7cac2bb35;hpb=cc9a73604f696b6e69842a95b1e11f40f8cdd7bf;p=sbcl.git diff --git a/contrib/sb-simple-streams/internal.lisp b/contrib/sb-simple-streams/internal.lisp index da127f7..e5e926e 100644 --- a/contrib/sb-simple-streams/internal.lisp +++ b/contrib/sb-simple-streams/internal.lisp @@ -13,7 +13,6 @@ ;;; ********************************************************************** ;;; ;;; Various functions needed by simple-streams - (declaim (inline buffer-sap bref (setf bref) buffer-copy allocate-buffer free-buffer)) @@ -28,13 +27,17 @@ (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) @@ -80,7 +83,13 @@ (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* @@ -303,6 +312,7 @@ (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)) @@ -463,6 +473,8 @@ (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 @@ -472,11 +484,11 @@ :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