0.8.2.2:
authorChristophe Rhodes <csr21@cam.ac.uk>
Sun, 27 Jul 2003 14:08:18 +0000 (14:08 +0000)
committerChristophe Rhodes <csr21@cam.ac.uk>
Sun, 27 Jul 2003 14:08:18 +0000 (14:08 +0000)
Patch from Patrik Nordebo allowing FILE-POSITION/lseek to work
over its entire range of acceptability.

NEWS
src/code/fd-stream.lisp
src/code/stream.lisp
src/code/unix.lisp
version.lisp-expr

diff --git a/NEWS b/NEWS
index c833b23..39d85a8 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1941,6 +1941,9 @@ changes in sbcl-0.8.3 relative to sbcl-0.8.2:
   * bug fix: WITH-OUTPUT-TO-STRING (and MAKE-STRING-OUTPUT-STREAM) now
     accept and act upon their :ELEMENT-TYPE keyword argument.
     (reported by Edi Weitz)
+  * bug fix: FILE-POSITION now accepts position designators up to 
+    ARRAY-DIMENSION-LIMIT or the extreme of the off_t range, whichever 
+    is the greater.  (thanks to Patrik Nordebo)
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles
index 61781f0..95b7ce2 100644 (file)
 
 (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
                                         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.
               (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)
index db2865d..e3dbd91 100644 (file)
 ;;; Call the MISC method with the :FILE-POSITION operation.
 (defun file-position (stream &optional position)
   (declare (type stream stream))
-  (declare (type (or index (member nil :start :end)) position))
+  (declare (type (or index (alien sb!unix:off-t) (member nil :start :end)) position))
   (cond
    (position
     (setf (ansi-stream-in-index stream) +ansi-stream-in-buffer-length+)
index d96189e..91a8e39 100644 (file)
@@ -68,7 +68,7 @@
                                ,@args)))
      (if (minusp result)
         (values nil (get-errno))
-        ,success-form)))
+        ,success-form)))
 
 ;;; This is like SYSCALL, but if it fails, signal an error instead of
 ;;; returning error codes. Should only be used for syscalls that will
   "
   (declare (type unix-fd fd)
           (type (integer 0 2) whence))
-  (int-syscall ("lseek" int off-t int) fd offset whence))
+  (let ((result (alien-funcall (extern-alien "lseek" (function off-t int off-t int))
+                fd offset whence)))
+    (if (minusp result )
+       (values nil (get-errno))
+      (values result 0))))
 
 ;;; UNIX-READ accepts a file descriptor, a buffer, and the length to read.
 ;;; It attempts to read len bytes from the device associated with fd
index 2668ff9..3a7afaa 100644 (file)
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.2.1"
+"0.8.2.2"