fix GENCGC DYNAMIC-USAGE on 64-bit platforms

[sbcl.git] / src / code / fd-stream.lisp

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index a2940e1..69505b8 100644 (file)
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -157,6 +157,8 @@
   (element-type 'base-char)
   ;; the Unix file descriptor
   (fd -1 :type fixnum)
+  ;; What do we know about the FD?
+  (fd-type :unknown :type keyword)
   ;; controls when the output buffer is flushed
   (buffering :full :type (member :full :line :none))
   ;; controls whether the input buffer must be cleared before output
@@ -289,9 +291,9 @@
                                (return (reset-buffer obuf)))
                               (count
                                ;; Partial write -- update buffer status and
-                               ;; queue or wait. Do not use INCF! Another
-                               ;; thread might have moved head...
-                               (setf (buffer-head obuf) (+ count head))
+                               ;; queue or wait.
+                               (incf head count)
+                               (setf (buffer-head obuf) head)
                                (queue-or-wait))
                               #!-win32
                               ((eql errno sb!unix:ewouldblock)
@@ -407,14 +409,10 @@
 ;;; this is not something we want to export. Nikodemus thinks the
 ;;; right thing is to support a low-level non-stream like IO layer,
 ;;; akin to java.nio.
-(defun output-raw-bytes (stream thing &optional start end)
+(declaim (inline output-raw-bytes))
+(define-deprecated-function :late "1.0.8.16" output-raw-bytes write-sequence
+    (stream thing &optional start end)
   (write-or-buffer-output stream thing (or start 0) (or end (length thing))))
-
-(define-compiler-macro output-raw-bytes (stream thing &optional start end)
-  (deprecation-warning 'output-raw-bytes)
-  (let ((x (gensym "THING")))
-    `(let ((,x ,thing))
-       (write-or-buffer-output ,stream ,x (or ,start 0) (or ,end (length ,x))))))
 \f
 ;;;; output routines and related noise
 
@@ -974,11 +972,9 @@
            (count 0))
     (tagbody
        ;; Check for blocking input before touching the stream if we are to
-       ;; serve events: if the FD is blocking, we don't want to hang on the
-       ;; write if we are to serve events or notice timeouts.
-       (if (and (or (fd-stream-serve-events stream)
-                    (fd-stream-timeout stream)
-                    *deadline*)
+       ;; serve events: if the FD is blocking, we don't want to try an uninterruptible
+       ;; read(). Regular files should never block, so we can elide the check.
+       (if (and (neq :regular (fd-stream-fd-type stream))
                 (sysread-may-block-p stream))
            (go :wait-for-input)
            (go :main))
@@ -2221,6 +2217,12 @@
         ((not (or input output))
          (error "File descriptor must be opened either for input or output.")))
   (let ((stream (%make-fd-stream :fd fd
+                                 :fd-type (progn
+                                            #!-win32 (sb!unix:fd-type fd)
+                                            ;; KLUDGE.
+                                            #!+win32 (if serve-events
+                                                         :unknown
+                                                         :regular))
                                  :name name
                                  :file file
                                  :original original
@@ -2422,6 +2424,10 @@
             (cond ((numberp fd)
                    (case direction
                      ((:input :output :io)
+                      ;; For O_APPEND opened files, lseek returns 0 until first write.
+                      ;; So we jump ahead here.
+                      (when (eq if-exists :append)
+                        (sb!unix:unix-lseek fd 0 sb!unix:l_xtnd))
                       (make-fd-stream fd
                                       :input input
                                       :output output