X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Funix.lisp;h=c1b32ab39c0303c8d8a4076a019447fb21280b8f;hb=8b64d57b865fec6ba082dda965146b5e8aa877b3;hp=dd04eb0fc73fa7fa2277a63c62bab6bd02749f1e;hpb=020de3c04699323437f0c746fe986506b716ab97;p=sbcl.git diff --git a/src/code/unix.lisp b/src/code/unix.lisp index dd04eb0..c1b32ab 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")))