0.pre7.75:
[sbcl.git] / src / code / fd-stream.lisp
index 583345f..06c75b4 100644 (file)
@@ -43,7 +43,7 @@
 
 (defstruct (fd-stream
            (:constructor %make-fd-stream)
-           (:include lisp-stream
+           (:include ansi-stream
                      (misc #'fd-stream-misc-routine))
            (:copier nil))
 
         :format-control "~@<~?: ~2I~_~A~:>"
         :format-arguments (list note-format (list stream) (strerror errno))))
 (defun simple-file-perror (note-format pathname errno)
-  (error 'simple-stream-error
+  (error 'simple-file-error
         :pathname pathname
         :format-control "~@<~?: ~2I~_~A~:>"
         :format-arguments
            ((<= bytes space)
             (if (system-area-pointer-p thing)
                 (system-area-copy thing
-                                  (* start sb!vm:byte-bits)
+                                  (* start sb!vm:n-byte-bits)
                                   (fd-stream-obuf-sap fd-stream)
-                                  (* tail sb!vm:byte-bits)
-                                  (* bytes sb!vm:byte-bits))
+                                  (* tail sb!vm:n-byte-bits)
+                                  (* bytes sb!vm:n-byte-bits))
                 ;; FIXME: There should be some type checking somewhere to
                 ;; verify that THING here is a vector, not just <not a SAP>.
                 (copy-to-system-area thing
-                                     (+ (* start sb!vm:byte-bits)
+                                     (+ (* start sb!vm:n-byte-bits)
                                         (* sb!vm:vector-data-offset
-                                           sb!vm:word-bits))
+                                           sb!vm:n-word-bits))
                                      (fd-stream-obuf-sap fd-stream)
-                                     (* tail sb!vm:byte-bits)
-                                     (* bytes sb!vm:byte-bits)))
+                                     (* tail sb!vm:n-byte-bits)
+                                     (* bytes sb!vm:n-byte-bits)))
             (setf (fd-stream-obuf-tail fd-stream) newtail))
            ((<= bytes len)
             (flush-output-buffer fd-stream)
             (if (system-area-pointer-p thing)
                 (system-area-copy thing
-                                  (* start sb!vm:byte-bits)
+                                  (* start sb!vm:n-byte-bits)
                                   (fd-stream-obuf-sap fd-stream)
                                   0
-                                  (* bytes sb!vm:byte-bits))
+                                  (* bytes sb!vm:n-byte-bits))
                 ;; FIXME: There should be some type checking somewhere to
                 ;; verify that THING here is a vector, not just <not a SAP>.
                 (copy-to-system-area thing
-                                     (+ (* start sb!vm:byte-bits)
+                                     (+ (* start sb!vm:n-byte-bits)
                                         (* sb!vm:vector-data-offset
-                                           sb!vm:word-bits))
+                                           sb!vm:n-word-bits))
                                      (fd-stream-obuf-sap fd-stream)
                                      0
-                                     (* bytes sb!vm:byte-bits)))
+                                     (* bytes sb!vm:n-byte-bits)))
             (setf (fd-stream-obuf-tail fd-stream) bytes))
            (t
             (flush-output-buffer fd-stream)
             (setf (fd-stream-ibuf-tail stream) 0))
            (t
             (decf tail head)
-            (system-area-copy ibuf-sap (* head sb!vm:byte-bits)
-                              ibuf-sap 0 (* tail sb!vm:byte-bits))
+            (system-area-copy ibuf-sap (* head sb!vm:n-byte-bits)
+                              ibuf-sap 0 (* tail sb!vm:n-byte-bits))
             (setf head 0)
             (setf (fd-stream-ibuf-head stream) 0)
             (setf (fd-stream-ibuf-tail stream) tail))))
                      (car entry)
                      (caddr entry))))))
 
-;;; Returns a string constructed from the sap, start, and end.
+;;; Return a string constructed from SAP, START, and END.
 (defun string-from-sap (sap start end)
   (declare (type index start end))
   (let* ((length (- end start))
         (string (make-string length)))
-    (copy-from-system-area sap (* start sb!vm:byte-bits)
-                          string (* sb!vm:vector-data-offset sb!vm:word-bits)
-                          (* length sb!vm:byte-bits))
+    (copy-from-system-area sap (* start sb!vm:n-byte-bits)
+                          string (* sb!vm:vector-data-offset
+                                    sb!vm:n-word-bits)
+                          (* length sb!vm:n-byte-bits))
     string))
 
-;;; the N-BIN method for FD-STREAMs. This blocks in UNIX-READ. It is
-;;; generally used where there is a definite amount of reading to be
-;;; done, so blocking isn't too problematical.
+;;; the N-BIN method for FD-STREAMs
+;;;
+;;; Note that this blocks in UNIX-READ. It is generally used where
+;;; there is a definite amount of reading to be done, so blocking
+;;; isn't too problematical.
 (defun fd-stream-read-n-bytes (stream buffer start requested eof-error-p)
   (declare (type fd-stream stream))
   (declare (type index start requested))
           (head (fd-stream-ibuf-head stream))
           (tail (fd-stream-ibuf-tail stream))
           (available (- tail head))
-          (this-copy (min remaining-request available))
+          (n-this-copy (min remaining-request available))
           (this-start (+ start total-copied))
+          (this-end (+ this-start n-this-copy))
           (sap (fd-stream-ibuf-sap stream)))
       (declare (type index remaining-request head tail available))
-      (declare (type index this-copy))
+      (declare (type index n-this-copy))
       ;; Copy data from stream buffer into user's buffer. 
-      (if (typep buffer 'system-area-pointer)
-         (system-area-copy sap (* head sb!vm:byte-bits)
-                           buffer (* this-start sb!vm:byte-bits)
-                           (* this-copy sb!vm:byte-bits))
-         (copy-from-system-area sap (* head sb!vm:byte-bits)
-                                buffer (+ (* this-start sb!vm:byte-bits)
-                                          (* sb!vm:vector-data-offset
-                                             sb!vm:word-bits))
-                                (* this-copy sb!vm:byte-bits)))
-      (incf (fd-stream-ibuf-head stream) this-copy)
-      (incf total-copied this-copy)
+      (%byte-blt sap head buffer this-start this-end)
+      (incf (fd-stream-ibuf-head stream) n-this-copy)
+      (incf total-copied n-this-copy)
       ;; Maybe we need to refill the stream buffer.
       (cond (;; If there were enough data in the stream buffer, we're done.
             (= total-copied requested)
        (when (eql size 1)
          (setf (fd-stream-n-bin fd-stream) #'fd-stream-read-n-bytes)
          (when buffer-p
-           (setf (lisp-stream-in-buffer fd-stream)
-                 (make-array +in-buffer-length+
+           (setf (ansi-stream-in-buffer fd-stream)
+                 (make-array +ansi-stream-in-buffer-length+
                              :element-type '(unsigned-byte 8)))))
        (setf input-size size)
        (setf input-type type)))
     (:charpos
      (fd-stream-char-pos fd-stream))
     (:file-length
+     (unless (fd-stream-file fd-stream)
+       ;; This is a TYPE-ERROR because ANSI's species FILE-LENGTH
+       ;; "should signal an error of type TYPE-ERROR if stream is not
+       ;; a stream associated with a file". Too bad there's no very
+       ;; appropriate value for the EXPECTED-TYPE slot..
+       (error 'simple-type-error
+              :datum fd-stream
+              :expected-type 'file-stream
+              :format-control "~S is not a stream associated with a file."
+              :format-arguments (list fd-stream)))
      (multiple-value-bind (okay dev ino mode nlink uid gid rdev size
                           atime mtime ctime blksize blocks)
         (sb!unix:unix-fstat (fd-stream-fd fd-stream))
 
 ;;; This is kind of like FILE-POSITION, but is an internal hack used
 ;;; by the filesys stuff to get and set the file name.
+;;;
+;;; FIXME: misleading name, screwy interface
 (defun file-name (stream &optional new-name)
   (when (typep stream 'fd-stream)
       (cond (new-name