From f4b6d8f4d2db76a1d6dc7b0eb556cebcff19d00d Mon Sep 17 00:00:00 2001
From: dtc <dtc>
Date: Mon, 19 Jun 2000 16:08:38 +0000
Subject: [PATCH] Rework the code to allow file offsets greater than the most
 positive fixnum which was only around 500Meg, as noted by Martin Cracauer.

---
 code/fd-stream.lisp | 38 ++++++++++++++++++++------------------
 1 file changed, 20 insertions(+), 18 deletions(-)

diff --git a/code/fd-stream.lisp b/code/fd-stream.lisp
index 82061bb96..3568fa72d 100644
--- a/code/fd-stream.lisp
+++ b/code/fd-stream.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.50 1999/12/04 16:02:34 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.51 2000/06/19 16:08:38 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -207,7 +207,7 @@
 	)
       (let ((length (- end start)))
 	(multiple-value-bind
-	    (count errno)
+	      (count errno)
 	    (unix:unix-write (fd-stream-fd stream) base start length)
 	  (cond ((not count)
 		 (if (= errno unix:ewouldblock)
@@ -399,7 +399,7 @@
 (defun fd-sout (stream thing start end)
   (let ((start (or start 0))
 	(end (or end (length (the vector thing)))))
-    (declare (fixnum start end))
+    (declare (type index start end))
     (if (stringp thing)
 	(let ((last-newline (and (find #\newline (the simple-string thing)
 				       :start start :end end)
@@ -1033,9 +1033,9 @@
 	 (error "Error fstating ~S: ~A"
 		stream
 		(unix:get-unix-error-msg dev)))
-       (if (zerop (the index mode))
+       (if (zerop mode)
 	   nil
-	   (truncate (the index size) (fd-stream-element-size stream)))))
+	   (truncate size (fd-stream-element-size stream)))))
     (:file-position
      (fd-stream-file-position stream arg1))))
 
@@ -1044,16 +1044,15 @@
 ;;;
 (defun fd-stream-file-position (stream &optional newpos)
   (declare (type fd-stream stream)
-	   (type (or index (member nil :start :end)) newpos))
+	   (type (or (integer 0) (member nil :start :end)) newpos))
   (if (null newpos)
       (system: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)
+	      (posn errno)
 	    (unix:unix-lseek (fd-stream-fd stream) 0 unix:l_incr)
-	  (declare (type (or index null) posn))
-	  (cond ((fixnump posn)
+	  (declare (type (or (integer 0) null) posn))
+	  (cond (posn
 		 ;; Adjust for buffered output:
 		 ;;  If there is any output buffered, the *real* file position
 		 ;; will be larger than reported by lseek because lseek
@@ -1081,8 +1080,9 @@
 		   (error "Error lseek'ing ~S: ~A"
 			  stream
 			  (unix:get-unix-error-msg errno)))))))
-      (let ((offset 0) origin)
-	(declare (type index offset))
+      (let ((offset 0)
+	    origin)
+	(declare (type (integer 0) 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.
@@ -1095,14 +1095,16 @@
 	(setf (fd-stream-unread stream) nil)
 	(setf (fd-stream-ibuf-head stream) 0)
 	(setf (fd-stream-ibuf-tail stream) 0)
-	;; Trash cashed value for listen, so that we check next time.
+	;; Trash cached value for listen, so that we check next time.
 	(setf (fd-stream-listen stream) nil)
 	;; Now move it.
 	(cond ((eq newpos :start)
-	       (setf offset 0 origin unix:l_set))
+	       (setf offset 0
+		     origin unix:l_set))
 	      ((eq newpos :end)
-	       (setf offset 0 origin unix:l_xtnd))
-	      ((typep newpos 'index)
+	       (setf offset 0
+		     origin unix:l_xtnd))
+	      ((typep newpos '(integer 0))
 	       (setf offset (* newpos (fd-stream-element-size stream))
 		     origin unix:l_set))
 	      (t
@@ -1110,7 +1112,7 @@
 	(multiple-value-bind
 	    (posn errno)
 	    (unix:unix-lseek (fd-stream-fd stream) offset origin)
-	  (cond ((typep posn 'fixnum)
+	  (cond (posn
 		 t)
 		((eq errno unix:espipe)
 		 nil)
-- 
GitLab