0.8.13.70: MORE DOCUMENTATION

[sbcl.git] / contrib / sb-simple-streams / internal.lisp

diff --git a/contrib/sb-simple-streams/internal.lisp b/contrib/sb-simple-streams/internal.lisp
index da127f7..e5e926e 100644 (file)
--- 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