0.8.5.29:

[sbcl.git] / src / code / unix.lisp

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 4dce234..a752549 100644 (file)
--- 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
@@ -209,22 +209,21 @@
   (declare (type unix-fd fd))
   (int-syscall ("isatty" int) fd))
 
-;;; Accept a file descriptor and move the file pointer ahead
-;;; a certain offset for that file. WHENCE can be any of the following:
-;;;  L_SET     Set the file pointer.
-;;;  L_INCR    Increment the file pointer.
-;;;  L_XTND    Extend the file size.
 (defun unix-lseek (fd offset whence)
+  "Unix-lseek accepts a file descriptor and moves the file pointer by 
+   OFFSET octets.  Whence can be any of the following:
+
+   L_SET        Set the file pointer.
+   L_INCR       Increment the file pointer.
+   L_XTND       Extend the file size.
+  "
   (declare (type unix-fd fd)
-          (type (unsigned-byte 32) offset)
           (type (integer 0 2) whence))
-  #!-(and x86 bsd)
-  (int-syscall ("lseek" int off-t int) fd offset whence)
-  ;; Need a 64-bit return value type for this. TBD. For now,
-  ;; don't use this with any 2G+ partitions.
-  #!+(and x86 bsd)
-  (int-syscall ("lseek" int unsigned-long unsigned-long int)
-              fd offset 0 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
@@ -294,14 +293,14 @@
   ;; a constant. Going the grovel_headers route doesn't seem to be
   ;; helpful, either, as Solaris doesn't export PATH_MAX from
   ;; unistd.h.
-  #!-(or linux openbsd freebsd sunos osf1) (,stub,)
-  #!+(or linux openbsd freebsd sunos osf1)
+  #!-(or linux openbsd freebsd sunos osf1 darwin) (,stub,)
+  #!+(or linux openbsd freebsd sunos osf1 darwin)
   (or (newcharstar-string (alien-funcall (extern-alien "getcwd"
                                                       (function (* char)
                                                                 (* char)
                                                                 size-t))
                                         nil 
-                                        #!+(or linux openbsd freebsd) 0
+                                        #!+(or linux openbsd freebsd darwin) 0
                                         #!+(or sunos osf1) 1025))
       (simple-perror "getcwd")))
 
@@ -407,8 +406,8 @@
 ;;; information.
 (defun unix-ioctl (fd cmd arg)
   (declare (type unix-fd fd)
-          (type (unsigned-byte 32) cmd))
-  (void-syscall ("ioctl" int unsigned-int (* char)) fd cmd arg))
+          (type (signed-byte 32) cmd))
+  (void-syscall ("ioctl" int int (* char)) fd cmd arg))
 \f
 ;;;; sys/resource.h
 
@@ -557,14 +556,14 @@
 ;;; longer than 32 bits anyway, right?":-|
 (define-alien-type nil
   (struct wrapped_stat
-    (st-dev unsigned-long)              ; would be dev-t in a real stat
+    (st-dev unsigned-int)              ; would be dev-t in a real stat
     (st-ino ino-t)
     (st-mode mode-t)
     (st-nlink  nlink-t)
     (st-uid  uid-t)
     (st-gid  gid-t)
-    (st-rdev unsigned-long)             ; would be dev-t in a real stat
-    (st-size unsigned-long)            ; would be off-t in a real stat
+    (st-rdev unsigned-int)             ; would be dev-t in a real stat
+    (st-size unsigned-int)             ; would be off-t in a real stat
     (st-blksize unsigned-long)
     (st-blocks unsigned-long)
     (st-atime time-t)
@@ -760,13 +759,11 @@
                        (slot (slot itvo 'it-value) 'tv-usec))
                which (alien-sap (addr itvn))(alien-sap (addr itvo))))))
 
-(defmacro with-timeout (expires &body body)
+(defmacro sb!ext:with-timeout (expires &body body)
   "Execute the body, interrupting it with a SIGALRM after at least
 EXPIRES seconds have passed.  Uses Unix setitimer(), restoring any
 previous timer after the body has finished executing"
-  (let ((saved-seconds (gensym "SAVED-SECONDS"))
-       (saved-useconds (gensym "SAVED-USECONDS"))
-       (s (gensym "S")) (u (gensym "U")))
+  (with-unique-names (saved-seconds saved-useconds s u)
     `(let (- ,saved-seconds ,saved-useconds)
       (multiple-value-setq (- - - ,saved-seconds ,saved-useconds)
        (unix-getitimer :real))
@@ -782,8 +779,8 @@ previous timer after the body has finished executing"
                   (unix-setitimer :real 0 0 ,s ,u)
                   ,@body)
              (unix-setitimer :real 0 0 ,saved-seconds ,saved-useconds))
-           ,@body)))))
-
+           (progn
+             ,@body))))))
 \f
 
 (defconstant ENOENT 2) ; Unix error code, "No such file or directory"