X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Funix.lisp;h=a752549e111c3cdf6edb92f35b160b19e47cd288;hb=1e9966d5f24709d227e20911b4e1ddd27c87a00e;hp=0a0da11540469c053512bfbd2c7747c05570e881;hpb=f9ef8b045b60ae064c7bd40af599b46707ea4d8a;p=sbcl.git diff --git a/src/code/unix.lisp b/src/code/unix.lisp index 0a0da11..a752549 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -47,7 +47,7 @@ ;;;; Lisp types used by syscalls -(deftype unix-pathname () 'simple-string) +(deftype unix-pathname () 'simple-base-string) (deftype unix-fd () `(integer 0 ,most-positive-fixnum)) (deftype unix-file-mode () '(unsigned-byte 32)) @@ -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 @@ -204,22 +204,26 @@ (defconstant l_incr 1) ; to increment the file pointer (defconstant l_xtnd 2) ; to extend the file size -;;; 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. +;;; Is a stream interactive? +(defun unix-isatty (fd) + (declare (type unix-fd fd)) + (int-syscall ("isatty" int) fd)) + (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 @@ -289,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"))) @@ -391,6 +395,10 @@ (declare (type unix-fd fd)) (void-syscall ("fsync" int) fd)) + +(defun unix-setsid () + (int-syscall ("setsid"))) + ;;;; sys/ioctl.h ;;; UNIX-IOCTL performs a variety of operations on open i/o @@ -398,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)) ;;;; sys/resource.h @@ -548,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) @@ -751,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)) @@ -773,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)))))) (defconstant ENOENT 2) ; Unix error code, "No such file or directory" @@ -796,7 +802,7 @@ previous timer after the body has finished executing" (defun unix-file-kind (name &optional check-for-links) #!+sb-doc "Return either :FILE, :DIRECTORY, :LINK, :SPECIAL, or NIL." - (declare (simple-string name)) + (declare (simple-base-string name)) (multiple-value-bind (res dev ino mode) (if check-for-links (unix-lstat name) (unix-stat name)) (declare (type (or fixnum null) mode)