X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Funix.lisp;h=e6dfddf5912df2a1891bedee2712b3f1a10a3138;hb=5369caf4d418065012b96af0d29c74d7851c04ff;hp=95f8fb12916e74fcf6ef7f1da71f6a34c640ee76;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git diff --git a/src/code/unix.lisp b/src/code/unix.lisp index 95f8fb1..e6dfddf 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -565,7 +565,7 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." ;;; synthesize a nice consistent structure for us. ;;; ;;; Note that st-dev is a long, not a dev-t. This is because dev-t on -;;; linux 32 bit archs is a 64 bit quantity, but alien doesn's support +;;; linux 32 bit archs is a 64 bit quantity, but alien doesn't support ;;; those. We don't actually access that field anywhere, though, so ;;; until we can get 64 bit alien support it'll do. Also note that ;;; st_size is a long, not an off-t, because off-t is a 64-bit @@ -573,14 +573,23 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." ;;; longer than 32 bits anyway, right?":-| (define-alien-type nil (struct wrapped_stat + #!-mips (st-dev unsigned-int) ; would be dev-t in a real stat + #!+mips + (st-dev unsigned-long) ; this is _not_ a dev-t on mips (st-ino ino-t) (st-mode mode-t) - (st-nlink nlink-t) - (st-uid uid-t) - (st-gid gid-t) + (st-nlink nlink-t) + (st-uid uid-t) + (st-gid gid-t) + #!-mips (st-rdev unsigned-int) ; would be dev-t in a real stat + #!+mips + (st-rdev unsigned-long) ; this is _not_ a dev-t on mips + #!-mips (st-size unsigned-int) ; would be off-t in a real stat + #!+mips + (st-size off-t) (st-blksize unsigned-long) (st-blocks unsigned-long) (st-atime time-t) @@ -782,28 +791,6 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted." (slot (slot itvo 'it-value) 'tv-usec)) which (alien-sap (addr itvn))(alien-sap (addr itvo)))))) -(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" - (with-unique-names (saved-seconds saved-useconds s u) - `(let (- ,saved-seconds ,saved-useconds) - (multiple-value-setq (- - - ,saved-seconds ,saved-useconds) - (unix-getitimer :real)) - (multiple-value-bind (,s ,u) (floor ,expires) - (setf ,u (floor (* ,u 1000000))) - (if (and (> ,expires 0) - (or (and (zerop ,saved-seconds) (zerop ,saved-useconds)) - (> ,saved-seconds ,s) - (and (= ,saved-seconds ,s) - (> ,saved-useconds ,u)))) - (unwind-protect - (progn - (unix-setitimer :real 0 0 ,s ,u) - ,@body) - (unix-setitimer :real 0 0 ,saved-seconds ,saved-useconds)) - (progn - ,@body)))))) ;;; FIXME: Many Unix error code definitions were deleted from the old ;;; CMU CL source code here, but not in the exports of SB-UNIX. I @@ -1026,5 +1013,3 @@ previous timer after the body has finished executing" `(progn ,@(loop for index upfrom 0 below (/ fd-setsize sb!vm:n-machine-word-bits) collect `(setf (deref (slot ,fd-set 'fds-bits) ,index) 0)))) - -