X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffd-stream.lisp;h=b403ffad183e2124e9eea0e7f9e42b89ea37d153;hb=4ed3f0d08c3a57a6762018d9622f253ab9d0f2b6;hp=309febd904cdb4e9dd99d7d933c3b1d86b26663c;hpb=da2e2f4be772532cacd9188d206d4eb82dc9f6ef;p=sbcl.git

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 309febd..b403ffa 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -591,12 +591,28 @@
 ;;; 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)
+(defun fd-stream-read-n-bytes (stream buffer start requested eof-error-p
+			       &aux (total-copied 0))
   (declare (type file-stream stream))
-  (declare (type index start requested))
-  (do ((total-copied 0))
+  (declare (type index start requested total-copied))
+  (let ((unread (fd-stream-unread stream)))
+    (when unread
+      ;; AVERs designed to fail when we have more complicated
+      ;; character representations.
+      (aver (typep unread 'base-char))
+      (aver (= (fd-stream-element-size stream) 1))
+      ;; KLUDGE: this is a slightly-unrolled-and-inlined version of
+      ;; %BYTE-BLT
+      (etypecase buffer
+	(system-area-pointer
+	 (setf (sap-ref-8 buffer start) (char-code unread)))
+	((simple-unboxed-array (*))
+	 (setf (aref buffer start) unread)))
+      (setf (fd-stream-unread stream) nil)
+      (setf (fd-stream-listen stream) nil)
+      (incf total-copied)))
+  (do ()
       (nil)
-    (declare (type index total-copied))
     (let* ((remaining-request (- requested total-copied))
 	   (head (fd-stream-ibuf-head stream))
 	   (tail (fd-stream-ibuf-tail stream))
@@ -687,6 +703,8 @@
 		     ;; (unsigned-byte 8).  Because there's no buffer, the
 		     ;; other element-types will dispatch to the appropriate
 		     ;; input (output) routine in fast-read-byte.
+		     (equal target-type '(unsigned-byte 8))
+		     #+nil
 		     (or (eq type 'unsigned-byte)
 			 (eq type :default)))
 	    (setf (ansi-stream-in-buffer fd-stream)
@@ -853,7 +871,6 @@
     (:element-type
      (fd-stream-element-type fd-stream))
     (:interactive-p
-      ;; FIXME: sb!unix:unix-isatty is undefined.
      (= 1 (the (member 0 1)
             (sb!unix:unix-isatty (fd-stream-fd fd-stream)))))
     (:line-length
@@ -886,22 +903,22 @@
 
 (defun fd-stream-file-position (stream &optional newpos)
   (declare (type file-stream stream)
-	   (type (or index (member nil :start :end)) newpos))
+	   (type (or (alien sb!unix:off-t) (member nil :start :end)) newpos))
   (if (null newpos)
       (sb!sys:without-interrupts
 	;; 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))
-	  (cond ((fixnump posn)
+	  (declare (type (or (alien sb!unix:off-t) null) posn))
+	  (cond ((integerp posn)
 		 ;; Adjust for buffered output: If there is any output
 		 ;; buffered, the *real* file position will be larger
 		 ;; than reported by lseek() because lseek() obviously
 		 ;; cannot take into account output we have not sent
 		 ;; yet.
 		 (dolist (later (fd-stream-output-later stream))
-		   (incf posn (- (the index (caddr later))
-				 (the index (cadr later)))))
+		   (incf posn (- (caddr later)
+				 (cadr later))))
 		 (incf posn (fd-stream-obuf-tail stream))
 		 ;; Adjust for unread input: If there is any input
 		 ;; read from UNIX but not supplied to the user of the
@@ -922,7 +939,7 @@
 					 stream
 					 errno))))))
       (let ((offset 0) origin)
-	(declare (type index offset))
+	(declare (type (alien sb!unix:off-t) offset))
 	;; Make sure we don't have any output pending, because if we
 	;; move the file pointer before writing this stuff, it will be
 	;; written in the wrong location.
@@ -942,14 +959,14 @@
 	       (setf offset 0 origin sb!unix:l_set))
 	      ((eq newpos :end)
 	       (setf offset 0 origin sb!unix:l_xtnd))
-	      ((typep newpos 'index)
+	      ((typep newpos '(alien sb!unix:off-t))
 	       (setf offset (* newpos (fd-stream-element-size stream))
 		     origin sb!unix:l_set))
 	      (t
 	       (error "invalid position given to FILE-POSITION: ~S" newpos)))
 	(multiple-value-bind (posn errno)
 	    (sb!unix:unix-lseek (fd-stream-fd stream) offset origin)
-	  (cond ((typep posn 'fixnum)
+	  (cond ((typep posn '(alien sb!unix:off-t))
 		 t)
 		((eq errno sb!unix:espipe)
 		 nil)
@@ -1208,7 +1225,7 @@
 		      (open-error "~@<The path ~2I~_~S ~I~_does not exist.~:>"
 				  pathname))
 		     (t nil)))
-		  ((and (eql errno sb!unix:eexist) if-exists)
+		  ((and (eql errno sb!unix:eexist) (null if-exists))
 		   nil)
 		  (t
 		   (vanilla-open-error)))))))))