X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Funix.lisp;h=7c1298d3ec7813c1bd707fbd93e448c90a2fbc25;hb=15d6e7c9a2c3234f95dfe278046fa2fee1b0c007;hp=b0e1811a7a0fb3e5568e2965241d0e544c6843da;hpb=1d794dfd69a5cfd7150166a48096cf5a5e4fe1e7;p=sbcl.git diff --git a/src/code/unix.lisp b/src/code/unix.lisp index b0e1811..7c1298d 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") @@ -237,7 +241,7 @@ ;;; UNIX-WRITE accepts a file descriptor, a buffer, an offset, and the ;;; length to write. It attempts to write len bytes to the device -;;; associated with fd from the the buffer starting at offset. It returns +;;; associated with fd from the buffer starting at offset. It returns ;;; the actual number of bytes written. (defun unix-write (fd buf offset len) (declare (type unix-fd fd) @@ -964,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...