From ffb6a8bb70c9baf2d7170d65fc78877e89d27a5a Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Mon, 7 Feb 2011 21:49:52 +0000 Subject: [PATCH] New primitive NANOTIME-SINCE-UTC-EPOCH. This returns the number of seconds, with at most nanosecond resolution, that have elapsed since the start of 1972 in UTC. Representation is fixed-point, stored in a pair given as input. See the comments in uxenv.c for more details. --- src/microcode/configure.ac | 47 +++++++++- src/microcode/ntenv.c | 9 ++ src/microcode/osenv.h | 17 ++++ src/microcode/prosenv.c | 11 +++ src/microcode/syscall.h | 3 + src/microcode/ux.h | 32 +++++++ src/microcode/uxenv.c | 186 +++++++++++++++++++++++++++++++++++++ src/microcode/uxtop.c | 3 + 8 files changed, 305 insertions(+), 3 deletions(-) diff --git a/src/microcode/configure.ac b/src/microcode/configure.ac index 1ee081116..96e133dd1 100644 --- a/src/microcode/configure.ac +++ b/src/microcode/configure.ac @@ -410,7 +410,8 @@ AC_HEADER_TIME AC_CHECK_HEADERS([bsdtty.h fcntl.h fenv.h ieeefp.h limits.h malloc.h sgtty.h]) AC_CHECK_HEADERS([stropts.h time.h]) AC_CHECK_HEADERS([sys/file.h sys/ioctl.h sys/mount.h sys/param.h sys/poll.h]) -AC_CHECK_HEADERS([sys/ptyio.h sys/socket.h sys/time.h sys/un.h sys/vfs.h]) +AC_CHECK_HEADERS([sys/ptyio.h sys/socket.h sys/time.h sys/timex.h sys/un.h]) +AC_CHECK_HEADERS([sys/vfs.h]) AC_CHECK_HEADERS([termio.h termios.h unistd.h utime.h]) AC_CHECK_HEADERS([dlfcn.h netdb.h signal.h]) AC_CHECK_HEADERS([sys/mman.h float.h assert.h stdint.h]) @@ -429,6 +430,14 @@ define([SCM_INC_TIME], #endif ]) +define([SCM_INC_SYS_TIMEX], + [ + SCM_INC_TIME + #ifdef HAVE_SYS_TIMEX_H + # include + #endif + ]) + define([SCM_INC_TERMIO], [ #ifdef HAVE_TERMIOS_H @@ -650,6 +659,38 @@ AC_CHECK_TYPE([struct sigcontext], [], [SCM_INC_SIGNAL]) +AC_CHECK_TYPE([struct ntptimeval], + [AC_DEFINE([HAVE_STRUCT_NTPTIMEVAL], [1], + [Define if `struct ntptimeval' is defined in .]) + AC_CHECK_MEMBER([struct ntptimeval.tai], + [AC_DEFINE([HAVE_NTPTIMEVAL_TAI], [1], + [Define if `struct ntptimeval' has the `tai' member.])], + [], + [SCM_INC_SYS_TIMEX]) + AC_CHECK_MEMBER([struct ntptimeval.time.tv_nsec], + [AC_DEFINE([HAVE_NTPTIMEVAL_TIME_TV_NSEC], [1], + [Define if `struct ntptimeval' has the `time.tv_nsec' member.])], + [], + [SCM_INC_SYS_TIMEX])], + [], + [SCM_INC_SYS_TIMEX]) + +AC_CHECK_TYPE([struct timex], + [AC_DEFINE([HAVE_STRUCT_TIMEX], [1], + [Define if `struct timex' is defined in .]) + AC_CHECK_MEMBER([struct timex.tai], + [AC_DEFINE([HAVE_TIMEX_TAI], [1], + [Define if `struct timex' has the `tai' member.])], + [], + [SCM_INC_SYS_TIMEX]) + AC_CHECK_MEMBER([struct timex.time.tv_usec], + [AC_DEFINE([HAVE_TIMEX_TIME_TV_USEC], [1], + [Define if `struct timex' has the `time.tv_usec' member.])], + [], + [SCM_INC_SYS_TIMEX])], + [], + [SCM_INC_SYS_TIMEX]) + dnl Checks for compiler characteristics. AC_C_BIGENDIAN AC_C_CHAR_UNSIGNED @@ -665,7 +706,7 @@ AC_FUNC_UTIME_NULL AC_FUNC_VFORK AC_FUNC_VPRINTF AC_FUNC_WAIT3 -AC_CHECK_FUNCS([ctermid]) +AC_CHECK_FUNCS([clock_gettime ctermid]) AC_CHECK_FUNCS([dup2]) AC_CHECK_FUNCS([fcntl fdatasync feclearexcept fedisableexcept feenableexcept]) AC_CHECK_FUNCS([fegetenv fegetexcept fegetexceptflag fegetround feholdexcept]) @@ -677,7 +718,7 @@ AC_CHECK_FUNCS([getpt gettimeofday getwd grantpt]) AC_CHECK_FUNCS([kill]) AC_CHECK_FUNCS([lockf]) AC_CHECK_FUNCS([memcpy mkdir mktime modf]) -AC_CHECK_FUNCS([nice]) +AC_CHECK_FUNCS([nice ntp_adjtime ntp_gettime]) AC_CHECK_FUNCS([poll prealloc]) AC_CHECK_FUNCS([rename rmdir]) AC_CHECK_FUNCS([select setitimer setpgrp setpgrp2 shmat sigaction]) diff --git a/src/microcode/ntenv.c b/src/microcode/ntenv.c index a07cb39d7..fc176d586 100644 --- a/src/microcode/ntenv.c +++ b/src/microcode/ntenv.c @@ -49,6 +49,15 @@ unix_time_to_system_time (unsigned long ut, SYSTEMTIME * st) } #endif +void +OS_nanotime_since_utc_epoch (struct scheme_nanotime *t) +{ + /* I have no idea what the NT clock does about leap seconds. If you + know, please adjust this comment and/or code accordingly. */ + (t->seconds) = ((intmax_t) (OS_encoded_time ())); + (t->nanoseconds) = 0; +} + time_t OS_encoded_time (void) { diff --git a/src/microcode/osenv.h b/src/microcode/osenv.h index 581d363f2..956dd87ef 100644 --- a/src/microcode/osenv.h +++ b/src/microcode/osenv.h @@ -41,6 +41,23 @@ struct time_structure int time_zone; }; +struct scheme_nanotime +{ + intmax_t seconds; + uint32_t nanoseconds; +}; + +#if 0 +/* Any practical use? */ + +struct scheme_attotime +{ + intmax_t seconds; + uint64_t attoseconds; +}; +#endif + +extern void OS_nanotime_since_utc_epoch (struct scheme_nanotime *); extern time_t OS_encoded_time (void); extern void OS_decode_time (time_t, struct time_structure *); extern void OS_decode_utc (time_t, struct time_structure *); diff --git a/src/microcode/prosenv.c b/src/microcode/prosenv.c index 335d79646..72f9a1304 100644 --- a/src/microcode/prosenv.c +++ b/src/microcode/prosenv.c @@ -30,6 +30,17 @@ USA. #include "osenv.h" #include "ostop.h" +DEFINE_PRIMITIVE ("NANOTIME-SINCE-UTC-EPOCH", Prim_nanotime_since_utc_epoch, 1, 1, 0) +{ + struct scheme_nanotime t; + PRIMITIVE_HEADER (1); + CHECK_ARG (1, PAIR_P); + OS_nanotime_since_utc_epoch (&t); + SET_PAIR_CAR ((ARG_REF (1)), (intmax_to_integer (t.seconds))); + SET_PAIR_CDR ((ARG_REF (1)), (uintmax_to_integer (t.nanoseconds))); + PRIMITIVE_RETURN (UNSPECIFIC); +} + DEFINE_PRIMITIVE ("ENCODED-TIME", Prim_encoded_time, 0, 0, "Return the current time as an integer.") { diff --git a/src/microcode/syscall.h b/src/microcode/syscall.h index 45026db5c..010bb6789 100644 --- a/src/microcode/syscall.h +++ b/src/microcode/syscall.h @@ -49,6 +49,7 @@ enum syscall_names syscall_bind, syscall_chdir, syscall_chmod, + syscall_clock_gettime, syscall_close, syscall_connect, syscall_fcntl_GETFL, @@ -76,6 +77,8 @@ enum syscall_names syscall_malloc, syscall_mkdir, syscall_mktime, + syscall_ntp_adjtime, + syscall_ntp_gettime, syscall_open, syscall_opendir, syscall_pause, diff --git a/src/microcode/ux.h b/src/microcode/ux.h index 06929fa1d..13c9147ed 100644 --- a/src/microcode/ux.h +++ b/src/microcode/ux.h @@ -213,6 +213,35 @@ USA. # endif #endif +#ifdef HAVE_SYS_TIMEX_H +# include +#endif + +/* This detects both the NTP system calls found in BSD systems (NetBSD, + FreeBSD) and the NTP system calls found in Linux systems. What is + found on other systems, I don't know. We use this to get at the + system's record of the UTC - TAI offset. */ + +#ifdef HAVE_NTP_GETTIME +#ifdef HAVE_STRUCT_NTPTIMEVAL +#ifdef HAVE_NTPTIMEVAL_TAI +#ifdef HAVE_NTPTIMEVAL_TIME_TV_NSEC +# define HAVE_BSD_NTP +#endif +#endif +#endif +#endif + +#ifdef HAVE_NTP_ADJTIME +#ifdef HAVE_STRUCT_TIMEX +#ifdef HAVE_TIMEX_TAI +#ifdef HAVE_TIMEX_TIME_TV_USEC +# define HAVE_LINUX_NTP +#endif +#endif +#endif +#endif + #ifdef HAVE_UTIME_H # include #else @@ -458,6 +487,7 @@ typedef RETSIGTYPE Tsignal_handler_result; #define UX_bind bind #define UX_chdir chdir #define UX_chmod chmod +#define UX_clock_gettime clock_gettime #define UX_close close #define UX_connect connect #define UX_ctime ctime @@ -493,6 +523,8 @@ typedef RETSIGTYPE Tsignal_handler_result; #define UX_malloc malloc #define UX_mknod mknod #define UX_mktime mktime +#define UX_ntp_adjtime ntp_adjtime +#define UX_ntp_gettime ntp_gettime #define UX_open open #define UX_pause pause #define UX_pipe pipe diff --git a/src/microcode/uxenv.c b/src/microcode/uxenv.c index 41eb49230..4705f6964 100644 --- a/src/microcode/uxenv.c +++ b/src/microcode/uxenv.c @@ -28,6 +28,192 @@ USA. #include "ux.h" #include "osenv.h" +/* Seconds since the UTC Epoch */ + +/* This is a disaster, thanks to the mind-boggling brain damage of + POSIX. At any time t, the POSIX time P(t) is the number of SI + seconds, S(t), since the UTC epoch (1972-01-01T00:00:00Z), plus + 63072000 (= 2*365*86400, to adjust for the Unix epoch, which would + be `1970-01-01T00:00:00Z' if modern UTC hadn't begun only in 1972), + *minus* the number L(t) of those seconds that were leap seconds in + UTC. That is, P(t) = S(t) + 63072000 - L(t). + + Problem (in the sense of problem set): Find S given P. + Problem (in the sense of disaster): POSIX doesn't tell us S or L. + + So what do we do? Fortunately, many popular Unix systems set their + clocks using the Network Time Protocol with the NTP Project's ntpd. + In order to support this, they provide a couple of extra-POSIX + routines, ntp_gettime and ntp_adjtime, giving the TAI - UTC offset. + + What if we don't have ntp_gettime or ntp_adjtime, or if the kernel + doesn't know the TAI - UTC offset? We're screwed. We could guess + that there have been 24 leap seconds, which is true at the time of + writing (2010-12-09). But this is wrong if the clock is set to TAI, + and this causes the Scheme clock to misbehave if the kernel assumes + the TAI - UTC offset to be zero and then increments it when an NTP + server tells it of a new leap second: at this point Scheme would + switch from assuming a TAI - UTC offset of 24 seconds to assuming a + TAI - UTC offset of 1 second, and rewind the clock by 23 seconds -- + it would behave even worse than a POSIX clock. + + So instead, if the kernel reports a TAI - UTC offset of under ten, + we take that to be the number of leap seconds, so that at least when + it is incremented and the system clock is rewound by a second, we + can show a smoothly advancing clock. If the kernel reports a TAI - + UTC offset of at least ten, we subtract ten from it to compute the + number of leap seconds (because 1972-01-01T00:00:00Z is 1972-01-01 + at 00:00:10 in TAI). + + Why a threshold of ten? Since modern UTC began, the TAI - UTC + offset has never been under ten. So if you represent times during + the entire existence of modern UTC so far, this heuristic will + work. */ + +/* Summary of scenarios: + + (a) If your system lacks ntp_gettime/ntp_adjtime, and its clock is + set to POSIX time, then you lose exactly as badly as any POSIX + program does. (The clock is wrong by 24 at the time of writing, + and it misbehaves during a leap second.) + + (b) If your system lacks ntp_gettime/ntp_adjtime, and its clock is + set to TAI, then you win. (The clock is correct and behaves + well.) + + (c) If your system has ntp_gettime/ntp_adjtime, its clock is set to + POSIX time, and its TAI - UTC offset is initialized to 0 but is + incremented at the same time the POSIX clock is rewound, then + + . you will have time stamps that are off by 24 seconds at the + time of writing, but + + . your clock will behave well, + + at least for the next net of nine positive leap seconds during + continuous operation of your system, which should cover a good + decade or so. + + (d) If your system has ntp_gettime/ntp_adjtime, and its clock is set + to POSIX time with the correct TAI - UTC offset, then you win, + at least for the next net of fourteen negative leap seconds, but + there never has been a negative leap second and probably never + will be. + + (e) If your system has ntp_gettime/ntp_adjtime, and its clock is set + to TAI with a constant TAI - UTC offset of 0, then you win. + + Scenario (c) is the case for most modern Unix systems that I know. + Scenario (d) is easily configured for most such Unix systems. + Scenarios (b) and (e) are the case for any system administered by + users of djbware (see ). + + What about time zones? I will think about them some other time. */ + +static intmax_t utc_epoch_minus_unix_epoch = 63072000L; + +static long +guess_n_leap_seconds (long tai) +{ + return ((tai < 10) ? tai : (tai - 10)); +} + +static intmax_t +guess_time_from_posix (intmax_t posix, long tai) +{ + /* This is to be used only for querying the current clock -- it + assumes tai is the current TAI - UTC offset. To find the (best + approximation of) the seconds since an epoch from POSIX time + requires consulting a leap second table. */ + /* FIXME: There is a minor danger of arithmetic overflow here -- but + only on broken operating systems with wildly bogus values for + POSIX time and the TAI - UTC offset, or near 2038 on archaic + systems with no 64-bit integer type. */ + return (posix - utc_epoch_minus_unix_epoch + (guess_n_leap_seconds (tai))); +} + +/* The following routines may lose information -- namely, the + information that the system's clock is bogus. But if this is so, + you'll probably notice the fact anyway, and this paranoia prevents + bad values from making Scheme crash. These are macros because the + signedness of the types defined in struct timeval and struct + timespec is pretty random. */ + +#define SANITIZE_NSEC(NSEC) \ + (((NSEC) < 0) ? 0 \ + : (((uintmax_t) (NSEC)) < 1000000000UL) ? ((uint32_t) (NSEC)) \ + : 999999999UL) + +#define SANITIZE_USEC(USEC) \ + (((USEC) < 0) ? 0 \ + : (((uintmax_t) (USEC)) < 1000000UL) ? (1000UL * ((uint32_t) (USEC))) \ + : 999999UL) + +#if defined(HAVE_BSD_NTP) + +void +OS_nanotime_since_utc_epoch (struct scheme_nanotime *t) +{ + struct ntptimeval ntv; + STD_VOID_SYSTEM_CALL (syscall_ntp_gettime, (UX_ntp_gettime (&ntv))); + (t->seconds) + = (guess_time_from_posix (((intmax_t) (ntv.time.tv_sec)), (ntv.tai))); + (t->nanoseconds) = (SANITIZE_NSEC (ntv.time.tv_nsec)); +} + +#elif defined(HAVE_LINUX_NTP) + +void +OS_nanotime_since_utc_epoch (struct scheme_nanotime *t) +{ + static const struct timex zero_tx; + struct timex tx = zero_tx; + /* This doesn't actually adjust the time, because we have set + tx.modes to zero, meaning no modifications. It does, however, + return some useful information in tx, which Linux's ntp_gettime + failed to return until recent versions. */ + STD_VOID_SYSTEM_CALL (syscall_ntp_adjtime, (UX_ntp_adjtime (&tx))); + (t->seconds) + = (guess_time_from_posix (((intmax_t) (tx.time.tv_sec)), (tx.tai))); + (t->nanoseconds) = (SANITIZE_USEC (tx.time.tv_usec)); +} + +#elif defined(HAVE_CLOCK_GETTIME) + +void +OS_nanotime_since_utc_epoch (struct scheme_nanotime t) +{ + struct timespec ts; + STD_VOID_SYSTEM_CALL + (syscall_clock_gettime, (UX_clock_gettime (CLOCK_REALTIME, (&ts)))); + (t->seconds) = (guess_time_from_posix (((intmax_t) (ts.tv_sec)), 0)); + (t->nanoseconds) = (SANITIZE_NSEC (ts.tv_nsec)); +} + +#elif defined(HAVE_GETTIMEOFDAY) + +void +OS_nanotime_since_utc_epoch (struct scheme_nanotime *t) +{ + struct timeval tv; + STD_VOID_SYSTEM_CALL (syscall_gettimeofday, (UX_gettimeofday ((&tv), 0))); + (t->seconds) = (guess_time_from_posix (((intmax_t) (tv.tv_sec)), 0)); + (t->nanoseconds) = (SANITIZE_USEC (tv.tv_usec)); +} + +#else /* You are a sad, strange little Unix. */ + +void +OS_nanotime_since_utc_epoch (struct scheme_nanotime *t) +{ + intmax_t posix_time; + STD_UINT_SYSTEM_CALL (syscall_time, posix_time, (UX_time (0))); + (t->seconds) = (guess_time_from_posix (posix_time, 0)); + (t->nanoseconds) = 0; +} + +#endif + time_t OS_encoded_time (void) { diff --git a/src/microcode/uxtop.c b/src/microcode/uxtop.c index 86eb805c4..81b4df9ca 100644 --- a/src/microcode/uxtop.c +++ b/src/microcode/uxtop.c @@ -430,6 +430,7 @@ static const char * syscall_names_table [] = "bind", "chdir", "chmod", + "clock_gettime", "close", "connect", "fcntl-getfl", @@ -457,6 +458,8 @@ static const char * syscall_names_table [] = "malloc", "mkdir", "mktime", + "ntp_adjtime", + "ntp_gettime", "open", "opendir", "pause", -- 2.25.1