1.0.28.44: better MACHINE-VERSION answers on BSD'ish platforms

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

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 0983f27..f885d57 100644 (file)
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -27,12 +27,6 @@
 
 (/show0 "unix.lisp 21")
 
-(defmacro def-enum (inc cur &rest names)
-  (flet ((defform (name)
-           (prog1 (when name `(defconstant ,name ,cur))
-             (setf cur (funcall inc cur 1)))))
-    `(progn ,@(mapcar #'defform names))))
-
 ;;; Given a C-level zero-terminated array of C strings, return a
 ;;; corresponding Lisp-level list of SIMPLE-STRINGs.
 (defun c-strings->string-list (c-strings)
@@ -48,7 +42,7 @@
 ;;;; Lisp types used by syscalls
 
 (deftype unix-pathname () 'simple-string)
-(deftype unix-fd () `(integer 0 ,most-positive-fixnum))
+(deftype unix-fd () `(integer 0 ,sb!xc:most-positive-fixnum))
 
 (deftype unix-file-mode () '(unsigned-byte 32))
 (deftype unix-pid () '(unsigned-byte 32))
@@ -63,7 +57,8 @@
 ;;; macros in this file, are only used in this file, and could be
 ;;; implemented using SB!XC:DEFMACRO wrapped in EVAL-WHEN.
 
-(defmacro syscall ((name &rest arg-types) success-form &rest args)
+(eval-when (:compile-toplevel :execute)
+(sb!xc:defmacro syscall ((name &rest arg-types) success-form &rest args)
   `(locally
     (declare (optimize (sb!c::float-accuracy 0)))
     (let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types))
@@ -75,7 +70,7 @@
 ;;; 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)
+(sb!xc:defmacro syscall* ((name &rest arg-types) success-form &rest args)
   `(locally
     (declare (optimize (sb!c::float-accuracy 0)))
     (let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types))
@@ -84,15 +79,10 @@
           (error "Syscall ~A failed: ~A" ,name (strerror))
           ,success-form))))
 
-(/show0 "unix.lisp 109")
-
-(defmacro void-syscall ((name &rest arg-types) &rest args)
-  `(syscall (,name ,@arg-types) (values t 0) ,@args))
-
-(defmacro int-syscall ((name &rest arg-types) &rest args)
+(sb!xc:defmacro int-syscall ((name &rest arg-types) &rest args)
   `(syscall (,name ,@arg-types) (values result 0) ,@args))
 
-(defmacro with-restarted-syscall ((&optional (value (gensym))
+(sb!xc:defmacro with-restarted-syscall ((&optional (value (gensym))
                                              (errno (gensym)))
                                   syscall-form &rest body)
   #!+sb-doc
@@ -104,6 +94,12 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted."
         (unless #!-win32 (eql ,errno sb!unix:eintr) #!+win32 nil
           (return (values ,value ,errno))))
      ,@body))
+) ; EVAL-WHEN
+
+;;; FIXME: This could go in the above EVAL-WHEN, but it's used by
+;;; SB-EXECUTABLE.
+(defmacro void-syscall ((name &rest arg-types) &rest args)
+  `(syscall (,name ,@arg-types) (values t 0) ,@args))
 
 #!+win32
 (progn
@@ -206,12 +202,21 @@ corresponds to NAME, or NIL if there is none."
 ;; microsecond but also has a range of years.
 ;; CLH: Note that tv-usec used to be a time-t, but that this seems
 ;; problematic on Darwin x86-64 (and wrong). Trying suseconds-t.
-#!-win32
+#!-(or win32 openbsd)
 (define-alien-type nil
   (struct timeval
           (tv-sec time-t)           ; seconds
           (tv-usec suseconds-t)))   ; and microseconds
 
+;; The above definition doesn't work on 64-bit OpenBSD platforms.
+;; Both tv_sec and tv_usec are declared as long instead of time_t, and
+;; time_t is a typedef for int.
+#!+openbsd
+(define-alien-type nil
+  (struct timeval
+          (tv-sec long)             ; seconds
+          (tv-usec long)))          ; and microseconds
+
 #!+win32
 (define-alien-type nil
   (struct timeval
@@ -772,11 +777,21 @@ corresponds to NAME, or NIL if there is none."
 
 ;; the POSIX.4 structure for a time value. This is like a "struct
 ;; timeval" but has nanoseconds instead of microseconds.
+#!-openbsd
 (define-alien-type nil
     (struct timespec
             (tv-sec long)   ; seconds
             (tv-nsec long))) ; nanoseconds
 
+;; Just as with struct timeval, 64-bit OpenBSD has problems with the
+;; above definition.  tv_sec is declared as time_t instead of long,
+;; and time_t is a typedef for int.
+#!+openbsd
+(define-alien-type nil
+    (struct timespec
+            (tv-sec time-t)  ; seconds
+            (tv-nsec long))) ; nanoseconds
+
 ;; used by other time functions
 (define-alien-type nil
     (struct tm
@@ -1056,8 +1071,7 @@ corresponds to NAME, or NIL if there is none."
 
 ;;; not checked for linux...
 (defmacro fd-set (offset fd-set)
-  (let ((word (gensym))
-        (bit (gensym)))
+  (with-unique-names (word bit)
     `(multiple-value-bind (,word ,bit) (floor ,offset
                                               sb!vm:n-machine-word-bits)
        (setf (deref (slot ,fd-set 'fds-bits) ,word)
@@ -1067,8 +1081,7 @@ corresponds to NAME, or NIL if there is none."
 
 ;;; not checked for linux...
 (defmacro fd-clr (offset fd-set)
-  (let ((word (gensym))
-        (bit (gensym)))
+  (with-unique-names (word bit)
     `(multiple-value-bind (,word ,bit) (floor ,offset
                                               sb!vm:n-machine-word-bits)
        (setf (deref (slot ,fd-set 'fds-bits) ,word)
@@ -1079,8 +1092,7 @@ corresponds to NAME, or NIL if there is none."
 
 ;;; not checked for linux...
 (defmacro fd-isset (offset fd-set)
-  (let ((word (gensym))
-        (bit (gensym)))
+  (with-unique-names (word bit)
     `(multiple-value-bind (,word ,bit) (floor ,offset
                                               sb!vm:n-machine-word-bits)
        (logbitp ,bit (deref (slot ,fd-set 'fds-bits) ,word)))))