X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Funix.lisp;h=43376d36477747fbc3b85d222732333492548d95;hb=4281f3b99891120fea5cabbc3a9d091b19f45995;hp=74f98bef6959eb78ec7ae2912ebd34929eeb6fd6;hpb=074ba0606c687dbca4afc99e8e72e6f1a4486d24;p=sbcl.git diff --git a/src/code/unix.lisp b/src/code/unix.lisp index 74f98be..43376d3 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -64,21 +64,25 @@ ;;; implemented using SB!XC:DEFMACRO wrapped in EVAL-WHEN. (defmacro syscall ((name &rest arg-types) success-form &rest args) - `(let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types)) + `(locally + (declare (optimize (sb!c::float-accuracy 0))) + (let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types)) ,@args))) - (if (minusp result) - (values nil (get-errno)) - ,success-form))) + (if (minusp result) + (values nil (get-errno)) + ,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 ;;; never really get an error. (defmacro syscall* ((name &rest arg-types) success-form &rest args) - `(let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types)) - ,@args))) - (if (minusp result) - (error "Syscall ~A failed: ~A" ,name (strerror)) - ,success-form))) + `(locally + (declare (optimize (sb!c::float-accuracy 0))) + (let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types)) + ,@args))) + (if (minusp result) + (error "Syscall ~A failed: ~A" ,name (strerror)) + ,success-form)))) (/show0 "unix.lisp 109") @@ -390,12 +394,6 @@ (cast buf c-string) (cast buf (* char)) 256))) -;;; Write the core image of the file described by FD to disk. -(defun unix-fsync (fd) - (declare (type unix-fd fd)) - (void-syscall ("fsync" int) fd)) - - (defun unix-setsid () (int-syscall ("setsid"))) @@ -970,7 +968,9 @@ previous timer after the body has finished executing" `(multiple-value-bind (,word ,bit) (floor ,offset 32) (setf (deref (slot ,fd-set 'fds-bits) ,word) (logand (deref (slot ,fd-set 'fds-bits) ,word) - (sb!kernel:32bit-logical-not + ;; FIXME: This may not be quite right for 64-bit + ;; ports of SBCL. --njf, 2004-08-04 + (sb!kernel:word-logical-not (truly-the (unsigned-byte 32) (ash 1 ,bit)))))))) ;;; not checked for linux...