From 02abc70f6d8d522d0b1b94a5eababda9409d1e53 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sun, 27 Jul 2003 14:08:18 +0000 Subject: [PATCH] 0.8.2.2: Patch from Patrik Nordebo allowing FILE-POSITION/lseek to work over its entire range of acceptability. --- NEWS | 3 +++ src/code/fd-stream.lisp | 16 ++++++++-------- src/code/stream.lisp | 2 +- src/code/unix.lisp | 8 ++++++-- version.lisp-expr | 2 +- 5 files changed, 19 insertions(+), 12 deletions(-) diff --git a/NEWS b/NEWS index c833b23..39d85a8 100644 --- 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 diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 61781f0..95b7ce2 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -888,22 +888,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 @@ -924,7 +924,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. @@ -944,14 +944,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) diff --git a/src/code/stream.lisp b/src/code/stream.lisp index db2865d..e3dbd91 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -145,7 +145,7 @@ ;;; 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+) diff --git a/src/code/unix.lisp b/src/code/unix.lisp index d96189e..91a8e39 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -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 @@ -219,7 +219,11 @@ " (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 diff --git a/version.lisp-expr b/version.lisp-expr index 2668ff9..3a7afaa 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -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" -- 1.7.10.4