X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Funix.lisp;h=43376d36477747fbc3b85d222732333492548d95;hb=4281f3b99891120fea5cabbc3a9d091b19f45995;hp=dd04eb0fc73fa7fa2277a63c62bab6bd02749f1e;hpb=020de3c04699323437f0c746fe986506b716ab97;p=sbcl.git diff --git a/src/code/unix.lisp b/src/code/unix.lisp index dd04eb0..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") @@ -293,14 +297,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 darwin) (,stub,) - #!+(or linux openbsd freebsd sunos osf1 darwin) + #!-(or linux openbsd freebsd netbsd sunos osf1 darwin) (,stub,) + #!+(or linux openbsd freebsd netbsd sunos osf1 darwin) (or (newcharstar-string (alien-funcall (extern-alien "getcwd" (function (* char) (* char) size-t)) nil - #!+(or linux openbsd freebsd darwin) 0 + #!+(or linux openbsd freebsd netbsd darwin) 0 #!+(or sunos osf1) 1025)) (simple-perror "getcwd"))) @@ -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...