X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Funix.lisp;h=f885d57c86922bc55816d17259ff2614010ca112;hb=2b0851c405b494143009f68e2bc7e91017a809d4;hp=9959ae42c052e30a068a7cd644088c89dea26c33;hpb=8eee0d3a30bf39d9f201acff28c92059fe6c3e4e;p=sbcl.git diff --git a/src/code/unix.lisp b/src/code/unix.lisp index 9959ae4..f885d57 100644 --- 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 @@ -996,9 +1011,21 @@ corresponds to NAME, or NIL if there is none." (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)) @@ -1044,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) @@ -1055,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) @@ -1067,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)))))