0.8.13.69:

[sbcl.git] / src / code / unix.lisp

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index dd04eb0..43376d3 100644 (file)
--- 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))
-\f
-
 (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...