(/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)
;;;; 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))
;;; 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))
;;; 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))
(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
(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
;; 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
;; 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
(setf (values e-sec e-msec) (system-real-time-values)
c-sec 0
c-msec 0))
- ;; If two threads call this at the same time, we're still safe, I believe,
- ;; as long as NOW is updated before either of C-MSEC or C-SEC. Same applies
- ;; to interrupts. --NS
+ ;; If two threads call this at the same time, we're still safe, I
+ ;; believe, as long as NOW is updated before either of C-MSEC or
+ ;; C-SEC. Same applies to interrupts. --NS
+ ;;
+ ;; I believe this is almost correct with x86/x86-64 cache
+ ;; coherency, but if the new value of C-SEC, C-MSEC can become
+ ;; visible to another CPU without NOW doing the same then it's
+ ;; unsafe. It's `almost' correct on x86 because writes by other
+ ;; processors may become visible in any order provided transitity
+ ;; holds. With at least three cpus, C-MSEC and C-SEC may be from
+ ;; different threads and an incorrect value may be returned.
+ ;; Considering that this failure is not detectable by the caller -
+ ;; it looks like time passes a bit slowly - and that it should be
+ ;; an extremely rare occurance I'm inclinded to leave it as it is.
+ ;; --MG
(defun get-internal-real-time ()
(multiple-value-bind (sec msec) (system-real-time-values)
(unless (and (= msec c-msec) (= sec c-sec))
;;; 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)
;;; 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)
;;; 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)))))