X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffd-stream.lisp;h=c6a105275a82ee01262f02e5f8b0c2dca6c386f3;hb=031ae238d37250e935dabaf2a3efb6e0305dd3e7;hp=a2e45dd92b585a5324b497e9249c207bfddbcd03;hpb=72408d179d7396904e25e9a3dc423d2634e65072;p=sbcl.git

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index a2e45dd..c6a1052 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -107,7 +107,7 @@
 	 :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
@@ -575,7 +575,7 @@
 		      (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))
@@ -585,9 +585,11 @@
 			   (* length sb!vm: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))
@@ -598,23 +600,16 @@
 	   (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)
@@ -858,6 +853,16 @@
     (: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))
@@ -876,8 +881,7 @@
 	   (type (or index (member nil :start :end)) newpos))
   (if (null newpos)
       (sb!sys:without-interrupts
-	;; First, find the position of the UNIX file descriptor in the
-	;; file.
+	;; First, find the position of the UNIX file descriptor in the file.
 	(multiple-value-bind (posn errno)
 	    (sb!unix:unix-lseek (fd-stream-fd stream) 0 sb!unix:l_incr)
 	  (declare (type (or index null) posn))
@@ -1124,8 +1128,8 @@
 	    (delete-original (eq if-exists :rename-and-delete))
 	    (mode #o666))
 	(when original
-	  ;; We are doing a :RENAME or :RENAME-AND-DELETE.
-	  ;; Determine whether the file already exists, make sure the original
+	  ;; We are doing a :RENAME or :RENAME-AND-DELETE. Determine
+	  ;; whether the file already exists, make sure the original
 	  ;; file is not a directory, and keep the mode.
 	  (let ((exists
 		 (and namestring
@@ -1154,10 +1158,10 @@
 			 (do-old-rename namestring original))
 	      (setf original nil)
 	      (setf delete-original nil)
-	      ;; In order to use :SUPERSEDE instead, we have to make sure
-	      ;; SB!UNIX:O_CREAT corresponds to IF-DOES-NOT-EXIST.
-	      ;; SB!UNIX:O_CREAT was set before because of IF-EXISTS being
-	      ;; :RENAME.
+	      ;; In order to use :SUPERSEDE instead, we have to make
+	      ;; sure SB!UNIX:O_CREAT corresponds to
+	      ;; IF-DOES-NOT-EXIST. SB!UNIX:O_CREAT was set before
+	      ;; because of IF-EXISTS being :RENAME.
 	      (unless (eq if-does-not-exist :create)
 		(setf mask
 		      (logior (logandc2 mask sb!unix:o_creat)
@@ -1273,6 +1277,8 @@
 
 ;;; 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