X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Funix.lisp;h=e7cd25e10cf50e03ea739f740f9b9c747e12ce9f;hb=65b5ab7e713d04e0d76bc0ee196374f6e57b922f;hp=3abc1d1623b77df6c2474f9ed5f9d46e1c55fd5a;hpb=47a74763ae1c352ac851d242b426623b06b6ee03;p=sbcl.git diff --git a/src/code/unix.lisp b/src/code/unix.lisp index 3abc1d1..e7cd25e 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -202,7 +202,7 @@ 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. -#!-(or win32 openbsd) +#!-(or win32 openbsd netbsd) (define-alien-type nil (struct timeval (tv-sec time-t) ; seconds @@ -211,7 +211,7 @@ corresponds to NAME, or NIL if there is none." ;; 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 +#!+(or openbsd netbsd) (define-alien-type nil (struct timeval (tv-sec long) ; seconds @@ -777,7 +777,7 @@ 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 +#!-(or openbsd netbsd) (define-alien-type nil (struct timespec (tv-sec long) ; seconds @@ -786,7 +786,7 @@ corresponds to NAME, or NIL if there is none." ;; 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 +#!+(or openbsd netbsd) (define-alien-type nil (struct timespec (tv-sec time-t) ; seconds @@ -808,7 +808,7 @@ corresponds to NAME, or NIL if there is none." (tm-zone c-string))) ; Timezone abbreviation. (define-alien-routine get-timezone sb!alien:void - (when sb!alien:long :in) + (when time-t :in) (seconds-west sb!alien:int :out) (daylight-savings-p sb!alien:boolean :out)) @@ -838,39 +838,6 @@ corresponds to NAME, or NIL if there is none." (struct timezone (tz-minuteswest int) ; minutes west of Greenwich (tz-dsttime int))) ; type of dst correction - -;;; If it works, UNIX-GETTIMEOFDAY returns 5 values: T, the seconds -;;; and microseconds of the current time of day, the timezone (in -;;; minutes west of Greenwich), and a daylight-savings flag. If it -;;; doesn't work, it returns NIL and the errno. -#!-sb-fluid (declaim (inline unix-gettimeofday)) -(defun unix-gettimeofday () - #!+(and x86-64 darwin) - (with-alien ((tv (struct timeval))) - ;; CLH: FIXME! This seems to be a MacOS bug, but on x86-64/darwin, - ;; gettimeofday occasionally fails. passing in a null pointer for - ;; the timezone struct seems to work around the problem. I can't - ;; find any instances in the SBCL where we actually ues the - ;; timezone values, so we just punt for the moment. - (syscall* ("gettimeofday" (* (struct timeval)) - (* (struct timezone))) - (values t - (slot tv 'tv-sec) - (slot tv 'tv-usec)) - (addr tv) - nil)) - #!-(and x86-64 darwin) - (with-alien ((tv (struct timeval)) - (tz (struct timezone))) - (syscall* ("gettimeofday" (* (struct timeval)) - (* (struct timezone))) - (values t - (slot tv 'tv-sec) - (slot tv 'tv-usec) - (slot tz 'tz-minuteswest) - (slot tz 'tz-dsttime)) - (addr tv) - (addr tz)))) ;; Type of the second argument to `getitimer' and @@ -956,12 +923,40 @@ corresponds to NAME, or NIL if there is none." ;;; Windows build. #!-win32 (progn + + #!-sb-fluid (declaim (inline get-time-of-day)) + (defun get-time-of-day () + "Return the number of seconds and microseconds since the beginning of +the UNIX epoch (January 1st 1970.)" + #!+darwin + (with-alien ((tv (struct timeval))) + ;; CLH: FIXME! This seems to be a MacOS bug, but on x86-64/darwin, + ;; gettimeofday occasionally fails. passing in a null pointer for the + ;; timezone struct seems to work around the problem. NS notes: Darwin + ;; manpage says the timezone is not used anymore in their implementation + ;; at all. + (syscall* ("gettimeofday" (* (struct timeval)) + (* (struct timezone))) + (values (slot tv 'tv-sec) + (slot tv 'tv-usec)) + (addr tv) + nil)) + #!-(and x86-64 darwin) + (with-alien ((tv (struct timeval)) + (tz (struct timezone))) + (syscall* ("gettimeofday" (* (struct timeval)) + (* (struct timezone))) + (values (slot tv 'tv-sec) + (slot tv 'tv-usec)) + (addr tv) + (addr tz)))) + (declaim (inline system-internal-run-time system-real-time-values)) (defun system-real-time-values () - (multiple-value-bind (_ sec usec) (unix-gettimeofday) - (declare (ignore _) (type (unsigned-byte 32) sec usec)) + (multiple-value-bind (sec usec) (get-time-of-day) + (declare (type (unsigned-byte 32) sec usec)) (values sec (truncate usec micro-seconds-per-internal-time-unit)))) ;; There are two optimizations here that actually matter (on 32-bit @@ -1036,6 +1031,17 @@ corresponds to NAME, or NIL if there is none." micro-seconds-per-internal-time-unit)))) result)))) +;;; FIXME, KLUDGE: GET-TIME-OF-DAY used to be UNIX-GETTIMEOFDAY, and had a +;;; primary return value indicating sucess, and also returned timezone +;;; information -- though the timezone data was not there on Darwin. +;;; Now we have GET-TIME-OF-DAY, but it turns out that despite SB-UNIX being +;;; an implementation package UNIX-GETTIMEOFDAY has users in the wild. +;;; So we're stuck with it for a while -- maybe delete it towards the end +;;; of 2009. +(defun unix-gettimeofday () + (multiple-value-bind (sec usec) (get-time-of-day) + (values t sec usec nil nil))) + ;;;; opendir, readdir, closedir, and dirent-name (declaim (inline unix-opendir))