From: Christophe R. <cr...@us...> - 2003-07-27 14:08:21
|
Update of /cvsroot/sbcl/sbcl/src/code In directory sc8-pr-cvs1:/tmp/cvs-serv2800/src/code Modified Files: fd-stream.lisp stream.lisp unix.lisp Log Message: 0.8.2.2: Patch from Patrik Nordebo allowing FILE-POSITION/lseek to work over its entire range of acceptability. Index: fd-stream.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/fd-stream.lisp,v retrieving revision 1.36 retrieving revision 1.37 diff -u -d -r1.36 -r1.37 --- fd-stream.lisp 19 Jul 2003 14:36:13 -0000 1.36 +++ fd-stream.lisp 27 Jul 2003 14:08:18 -0000 1.37 @@ -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) Index: stream.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/stream.lisp,v retrieving revision 1.45 retrieving revision 1.46 diff -u -d -r1.45 -r1.46 --- stream.lisp 27 Jul 2003 13:52:36 -0000 1.45 +++ stream.lisp 27 Jul 2003 14:08:18 -0000 1.46 @@ -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+) Index: unix.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/unix.lisp,v retrieving revision 1.38 retrieving revision 1.39 diff -u -d -r1.38 -r1.39 --- unix.lisp 7 Jun 2003 22:46:10 -0000 1.38 +++ unix.lisp 27 Jul 2003 14:08:18 -0000 1.39 @@ -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 |