Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Incorporating Alan Watson's TAI time library.

Browse source
This commit is contained in:
Alex Shinn 2012-08-17 10:04:37 +09:00
parent 748ccc06ea
commit e562cc0be3
7 changed files with 597 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
Makefile.detect
View file

@ -95,3 +95,14 @@ ifeq ($(PLATFORM),unix)
#RLDFLAGS=-rpath $(LIBDIR)
RLDFLAGS=-Wl,-R$(DESTDIR)$(LIBDIR)
endif
########################################################################
# Check for NTP (who needs autoconf?)
ifndef $(SEXP_USE_NTP_GETTIME)
SEXP_USE_NTP_GETTIME := $(shell echo "main(){struct ntptimeval n; ntp_gettime(&n);}" | gcc -fsyntax-only -include sys/timex.h -xc - >/dev/null 2>/dev/null && echo 1 || echo 0)
endif
ifeq ($(SEXP_USE_NTP_GETTIME),1)
CPPFLAGS += -DSEXP_USE_NTPGETTIME
endif

3
eval.c
View file

@ -1999,6 +1999,9 @@ static const char* sexp_initial_features[] = {
#if SEXP_USE_GREEN_THREADS
"threads",
#endif
#if SEXP_USE_NTP_GETTIME
"ntp",
#endif
#if SEXP_USE_AUTO_FORCE
"auto-force",
#endif

4
include/chibi/features.h
View file

@ -563,6 +563,10 @@
#define SEXP_PORT_BUFFER_SIZE 4096
#endif
#ifndef SEXP_USE_NTP_GETTIME
#define SEXP_USE_NTP_GETTIME 0
#endif
#ifndef SEXP_USE_2010_EPOCH
#define SEXP_USE_2010_EPOCH ! SEXP_USE_NO_FEATURES
#endif

84
lib/scheme/time.c
View file

@ -1,5 +1,6 @@
/* time.c -- R7RS time routines */
/* Copyright (c) 2011-2012 Alex Shinn. All rights reserved. */
/* Copyright (c) 2012 Alan Watson. All rights reserved. */
/* BSD-style license: http://synthcode.com/license.txt */
#include <chibi/eval.h>
@ -10,20 +11,85 @@
typedef long time_t;
#endif
/* TODO: Check a leap second table file at appropriate intervals. */
static time_t leap_seconds_since_epoch = 24;
#if SEXP_USE_NTP_GETTIME
#include <sys/timex.h>
static sexp sexp_current_second (sexp ctx, sexp self, sexp_sint_t n) {
/* We can determine the clock resolution by calling ntp_adjtime() and */
/* seeing if the STA_NANO bit of the status word is set. If it is, we */
/* have nanosecond resolution, otherwise we have microsecond resolution. */
/* The time member of the ntptimeval struct may be either a struct */
/* timeval (with the fraction in microseconds) or a struct timespec */
/* (with the fraction in nanoseconds). */
/* However, there are systems (e.g., Ubuntu 10.4 on X86_64) that use */
/* nanosecond resolution but still declare the time member of struct */
/* ntptimeval to be a struct timeval. Therefore, we explicitly use casts */
/* to access this member either as a struct timeval or struct timespec */
/* depending on the resolution. */
static double ntp_resolution = 0.0;
static void determine_ntp_resolution (void) {
struct timex tx;
tx.modes = 0;
if (ntp_adjtime(&tx) < 0) {
ntp_resolution = 0;
} else if (tx.status & STA_NANO) {
ntp_resolution = 1e-9;
} else {
ntp_resolution = 1e-6;
}
}
static void current_ntp_clock_values (double *second, int *leap_second_indicator) {
struct ntptimeval ntv;
int status = ntp_gettime(&ntv);
if (ntp_resolution != 0 && (
status == TIME_OK ||
status == TIME_INS ||
status == TIME_DEL ||
status == TIME_OOP ||
status == TIME_WAIT)) {
if (ntp_resolution == 1e-6) {
struct timeval *tv = (struct timeval *) &ntv.time;
*second = tv->tv_sec + ntp_resolution * tv->tv_usec;
} else {
struct timespec *ts = (struct timespec *) &ntv.time;
*second = ts->tv_sec + ntp_resolution * ts->tv_nsec;
}
*leap_second_indicator = (status == TIME_OOP);
} else {
*second = current_clock_second();
*leap_second_indicator = 0;
}
}
static sexp sexp_current_ntp_clock_values (sexp ctx, sexp self, sexp_sint_t n) {
double second;
int leap_second_indicator;
sexp_gc_var3(res, car, cdr);
current_ntp_clock_values (&second, &leap_second_indicator);
sexp_gc_preserve3(ctx, res, car, cdr);
cdr = sexp_make_boolean(leap_second_indicator);
car = sexp_make_flonum(ctx, second);
res = sexp_cons(ctx, car, cdr);
sexp_gc_release3(ctx);
return res;
}
#endif /* def SEXP_USE_NTP_GETTIME */
static sexp sexp_current_clock_second (sexp ctx, sexp self, sexp_sint_t n) {
#ifndef PLAN9
struct timeval tv;
struct timezone tz;
if (gettimeofday(&tv, &tz))
return sexp_user_exception(ctx, self, "couldn't gettimeofday", SEXP_FALSE);
return sexp_make_flonum(ctx, tv.tv_sec + tv.tv_usec / 1000000.0
+ leap_seconds_since_epoch);
return sexp_make_flonum(ctx, tv.tv_sec + tv.tv_usec / 1000000.0);
#else
time_t res = time(NULL);
return sexp_make_flonum(ctx, res + leap_seconds_since_epoch);
return sexp_make_flonum(ctx, res);
#endif
}
@ -31,6 +97,10 @@ sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char
if (!(sexp_version_compatible(ctx, version, sexp_version)
&& sexp_abi_compatible(ctx, abi, SEXP_ABI_IDENTIFIER)))
return sexp_global(ctx, SEXP_G_ABI_ERROR);
sexp_define_foreign(ctx, env, "current-second", 0, sexp_current_second);
sexp_define_foreign(ctx, env, "current-clock-second", 0, sexp_current_clock_second);
#if SEXP_USE_NTP_GETTIME
determine_ntp_resolution();
sexp_define_foreign(ctx, env, "current-ntp-clock-values", 0, sexp_current_ntp_clock_values);
#endif
return SEXP_VOID;
}

76
lib/scheme/time.sld
View file

@ -1,8 +1,78 @@
;; time.sld - (scheme time) library definition
;;
;; Copyright (c) 2012 Alex Shinn. All rights reserved.
;; Copyright (c) 2012 Alan Watson. All rights reserved.
;; BSD-style license: http://synthcode.com/license.txt
(define-library (scheme time)
(import (scheme))
(export current-second current-jiffy jiffies-per-second)
(import (scheme))
(import (scheme process-context))
(import (scheme time tai))
(include-shared "time")
;; If the environment variable SEXP_CLOCK_TYPE is set, its value
;; is used for the system clock type. If the environment variable
;; SEXP_CLOCK_TYPE is not set, then the system clock is ntp-like
;; if current-ntp-clock-values is a procedure and is posix-like
;; otherwise.
(cond-expand
(ntp
(begin
(define clock-type
(cond
((get-environment-variable "SEXP_CLOCK_TYPE")
=> (lambda (x)
(let ((type (string->symbol x)))
(case type
((posix-like tai-like ntp-like) type)
(else
(display "invalid value for SEXP_CLOCK_TYPE: " (current-error-port))
(write x (current-error-port))
(display " - expected \"ntp-like\", \"posix-like\" or \"tai-like\"\n" (current-error-port))
'ntp-like)))))
(else 'ntp-like)))))
(else
(begin (define clock-type 'posix-like))))
(begin
(define current-jiffy current-second)
(define (jiffies-per-second) 1)))
;; The value of the environment variable SEXP_CLOCK_EPOCH_OFFSET
;; specifies the offset of the system clock relative to the
;; standard epoch (1970-01-01 00:00:00 UTC for posix-like and
;; ntp-like clocks and 1970-01-01 00:00:00 TAI for tai-like system
;; clocks). If it not set, the offset is assumed to be zero. In
;; call-with-current-clock-values, the offset is added to the
;; current seconds before calling the procedure argument.
(define epoch-offset
(exact->inexact
(string->number
(or (get-environment-variable "SEXP_CLOCK_EPOCH_OFFSET")
"0"))))
;; Normally, one does not need to specify either the clock type or
;; clock epoch explicitly. One case where it might be necessary is
;; if the system clock runs on the TAI-10 timescale. In this case,
;; one should set SEXP_CLOCK_TYPE to "tai-like" and
;; SEXP_CLOCK_EPOCH_OFFSET to -10.
;;
;; The call-with-current-clock-values obtains the clock values
;; from the current-ntp-clock-values procedure, if the system
;; clock is ntp-like, and from the current-clock-second procedure
;; otherwise.
(define call-with-current-clock-values
(cond-expand
(ntp
(case clock-type
((ntp-like)
(lambda (p)
(let ((values-pair (current-ntp-clock-values)))
(p (+ (car values-pair) epoch-offset) (cdr values-pair)))))
(else
(lambda (p) (p (+ (current-clock-second) epoch-offset) #f)))))
(else
(lambda (p) (p (+ (current-clock-second) epoch-offset) #f)))))
;; Exported interface.
(define current-second
(make-tai-clock clock-type call-with-current-clock-values))
(define (current-jiffy)
(inexact->exact (round (* (current-second) (jiffies-per-second)))))
(define (jiffies-per-second) 1000)))

372
lib/scheme/time/tai-to-utc-offset.sld Normal file
View file

@ -0,0 +1,372 @@
;; Copyright (c) 2012 Alan Watson. All rights reserved. BSD-style
;; license: http://synthcode.com/license.txt
;; This library implements procedures that give the TAI to UTC offset a
;; specified instant in the UTC or TAI timescales.
(define-library (scheme time tai-to-utc-offset)
(export tai-to-utc-offset-at-utc-day
tai-to-utc-offset-at-tai-second
set-open-leap-seconds-list-port!
set-update-exception-handler!)
(import (scheme base))
(import (scheme file))
(import (scheme read))
(import (scheme process-context))
(import (srfi 18))
(cond-expand
(chibi
(begin
(define *file-name-environment-variable* "SEXP_LEAP_SECONDS_LIST_FILE")))
(else
(begin
(error "Need to define *file-name-environment-variable*."))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(cond-expand
;; We ensure thread-safe atomic access to mutated bindings using
;; atomic boxes.
(chibi
(begin
;; This implementation relies on record accessors and mutators
;; being atomic in Chibi Scheme.
(define-record-type atomic-box-record-type
(make-atomic-box value)
atomic-box?
(value atomic-box-value atomic-box-value-set!))))
(else
(begin
;; This implementation uses SRFI-18 mutexes.
(define (make-atomic-box value)
(let ((mutex (make-mutex)))
(mutex-specific-set! mutex value)
mutex))
(define atomic-box? mutex?)
(define (atomic-box-value mutex)
(mutex-lock! mutex)
(let ((value (mutex-specific mutex)))
(mutex-unlock! mutex)
value))
(define (atomic-box-value-set! mutex value)
(mutex-lock! mutex)
(mutex-specific-set! mutex value)
(mutex-unlock! mutex)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(begin
(define seconds-per-day 86400)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; First, a remark on timescales.
;;
;; The TAI timescale used in this library has an epoch of 1970-01-01
;; 00:00:00 TAI. The epoch used by the current-second procedure in
;; the draft R7RS (scheme time) library is the "TAI-10" timescale
;; with an epoch of 1970-01-01 00:00:10 TAI.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The library maintains a cache of values derived from the leap
;; seconds list.
;;
;; The first cached value is the utc-day-alist. This is an alist
;; whose cars are the UTC days since 1970-01-01 00:00:00 UTC and
;; whose cdrs are the corresponding TAI to UTC offsets.
;;
;; The second cached value is the tai-second-alist. This is an alist
;; whose cars are the TAI seconds since 1970-01-01 00:00:00 TAI and
;; whose cdrs are the corresponding TAI to UTC offsets.
(define-record-type cache-record-type
(make-cache utc-day-alist tai-second-alist)
cache?
(utc-day-alist cache-utc-day-alist)
(tai-second-alist cache-tai-second-alist))
(define (make-cache-from-port port)
(let ((utc-day-alist (read-leap-seconds-list port)))
(make-cache utc-day-alist
(utc-day-alist->tai-second-alist utc-day-alist))))
;; The utc-day-alist->tai-second-alist procedure converts an alist
;; indexed by the number of UTC day since 1970-01-01 00:00:00 UTC
;; into an equivalent alist indexed by the number of TAI seconds
;; since 1970-01-01 00:00:00 TAI.
;;
;; This procedure does not have to worry about the complications of
;; transforming UTC dates prior to 1972-01-01 00:00:00 UTC to TAI,
;; since there were no leap seconds prior to this date.
(define (utc-day-alist->tai-second-alist utc-day-alist)
(map
(lambda (p)
(let* ((utc-day (car p))
(leap-seconds (cdr p))
(tai-second (+ (* utc-day seconds-per-day) leap-seconds)))
(cons tai-second leap-seconds)))
utc-day-alist))
;; The library updates the cache: when the library is loaded; when
;; the set-open-leap-seconds-list-port! is called; and once per day.
;; These automatic periodic updates are useful in long-running
;; programs.
;;
;; The choice of daily updates is motivated by the following
;; considerations. ITU-R TF.460-6, which contains the current
;; definition of UTC, requires that the IERS should announce leap
;; seconds with at least eight weeks in advance. However, NIST,
;; which maintains the leap-seconds.list file, only guarantees one
;; month. Recently the IERS and NIST have managed six months of
;; notice, but we should not rely on this.
;;
;; During updates, we install the update-exception-handler.
(define *cache-lifetime* (* 1 seconds-per-day))
(define (update-cache! open-port)
(with-exception-handler
(update-exception-handler)
(lambda ()
(let ((port (open-port)))
(when port
(set-cache! (make-cache-from-port port)))))))
(thread-start!
(make-thread
(lambda ()
(let loop ()
(thread-sleep! *cache-lifetime*)
(update-cache! (open-leap-seconds-list-port))
(loop)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The read-leap-seconds-list procedure reads text from the port
;; argument. The text must follow the format of a NIST leap seconds
;; file, for example,
;;
;; ftp://time.nist.gov/pub/leap-seconds.list
;;
;; The procedure returns an alist. The cars of the pairs are the
;; number of whole UTC days since 1970-01-01 00:00:00 UTC and the
;; cdrs of the pairs are the corresponding TAI to UTC offset. The
;; alist is ordered by decreasing car. The cars and cdrs are exact
;; integers.
;;
;; TODO: Do not rely on the input file being correctly ordered. Do
;; not rely on the input data being exact integers.
;;
;; TODO: Check known leap seconds.
(define (read-leap-seconds-list port)
(define (ntp-second->utc-day ntp-second)
;; The NTP initial epoch is 1900-01-01 00:00:00 UTC. The UTC
;; initial epoch is 1970-01-01 00:00:00 UTC. There are 70 years,
;; containing 17 leap days, between these epochs.
(- (quotient ntp-second seconds-per-day) (* 70 365) 17))
(define (leap-seconds-line->pair line)
(let* ((line-port (open-input-string line))
(ntp-second (read line-port))
(tai-to-utc-offset (read line-port))
(utc-day (ntp-second->utc-day ntp-second))
(leap-seconds tai-to-utc-offset))
(cons utc-day leap-seconds)))
(define (leap-seconds-comment-line? line)
(char=? #\# (string-ref line 0)))
(define (read-leap-seconds-line port)
(let ((line (read-line port)))
(cond
((eof-object? line) line)
((leap-seconds-comment-line? line) (read-leap-seconds-line port))
(else line))))
(let loop ((alist '()))
(let ((line (read-leap-seconds-line port)))
(if (eof-object? line)
alist
(loop (cons (leap-seconds-line->pair line) alist))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (set-open-leap-seconds-list-port! p)
;;
;; The set-open-leap-seconds-list-port! procedure sets the value of
;; procedure called to obtain the leap second list is read to its
;; argument p and then performs a cache update. The procedure should
;; return either #f, signifying that no leap second list is
;; available, or an input port, from which a leap-second list,
;; following the format of the NIST leap-second list, will be read.
;; The NIST leap-second file can be found here:
;;
;; ftp://time.nist.gov/pub/leap-seconds.list
;;
;; The default procedure attempts to open the file named by the
;; environment variable SEXP_LEAP_SECOND_LIST_FILE and returns the
;; port. If the environment variable is not set or if the file does
;; not exist, it return #f.
(define *open-leap-seconds-list-port*
(make-atomic-box
(lambda ()
(when *file-name-environment-variable*
(let ((file-name
(get-environment-variable *file-name-environment-variable*)))
(if file-name
(open-input-file file-name)
#f))))))
(define (open-leap-seconds-list-port)
(atomic-box-value *open-leap-seconds-list-port*))
(define (set-open-leap-seconds-list-port! p)
(atomic-box-value-set! *open-leap-seconds-list-port* p)
(update-cache! (open-leap-seconds-list-port)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (set-update-exception-handler! p)
;;
;; The set-update-exception-handler! procedure sets the value of the
;; error handler installed during cache updates. The default error
;; handler simply raises the exception again.
(define *update-exception-handler*
(make-atomic-box raise))
(define (update-exception-handler)
(atomic-box-value *update-exception-handler*))
(define (set-update-exception-handler! p)
(atomic-box-value-set! *update-exception-handler* p))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define *cache*
(make-atomic-box #f))
(define (cache)
(atomic-box-value *cache*))
(define (set-cache! value)
(atomic-box-value-set! *cache* value))
(update-cache!
(lambda ()
(open-input-string
(string-append
;; These strings are lines extracted from:
;;
;; ftp://time.nist.gov/pub/leap-seconds.3535228800
;;
;; The original file contains extensive comments on the format
;; and provenance of the data, which have been removed from
;; this version.
"2272060800 10 # 1 Jan 1972\n"
"2287785600 11 # 1 Jul 1972\n"
"2303683200 12 # 1 Jan 1973\n"
"2335219200 13 # 1 Jan 1974\n"
"2366755200 14 # 1 Jan 1975\n"
"2398291200 15 # 1 Jan 1976\n"
"2429913600 16 # 1 Jan 1977\n"
"2461449600 17 # 1 Jan 1978\n"
"2492985600 18 # 1 Jan 1979\n"
"2524521600 19 # 1 Jan 1980\n"
"2571782400 20 # 1 Jul 1981\n"
"2603318400 21 # 1 Jul 1982\n"
"2634854400 22 # 1 Jul 1983\n"
"2698012800 23 # 1 Jul 1985\n"
"2776982400 24 # 1 Jan 1988\n"
"2840140800 25 # 1 Jan 1990\n"
"2871676800 26 # 1 Jan 1991\n"
"2918937600 27 # 1 Jul 1992\n"
"2950473600 28 # 1 Jul 1993\n"
"2982009600 29 # 1 Jul 1994\n"
"3029443200 30 # 1 Jan 1996\n"
"3076704000 31 # 1 Jul 1997\n"
"3124137600 32 # 1 Jan 1999\n"
"3345062400 33 # 1 Jan 2006\n"
"3439756800 34 # 1 Jan 2009\n"
"3550089600 35 # 1 Jul 2012\n"))))
(update-cache! (open-leap-seconds-list-port))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (tai-to-utc-offset-at-utc-day utc-day)
;;
;; The tai-to-utc-offset-at-utc-day procedure returns the TAI to UTC
;; offset at the instant specified by its argument utc-day. The
;; instant is specified by the number of UTC days since 1970-01-01
;; 00:00:00 UTC.
;;
;; To convert a UTC time since 1972-01-01 00:00:00 UTC to number of
;; TAI seconds since 1972-01-01 00:00:00 TAI, first find the number
;; of whole UTC days D since 1970-01-01 00:00:00 UTC and the number
;; of UTC seconds S since the start of the current day. The number
;; of TAI seconds since 1972-01-01 00:00:00 TAI is then
;;
;; (+ (* D 86400) S (tai-to-utc-offset-at-utc-day D))
;;
;; This implementation does not return the correct result for
;; instants prior to 1972-01-01 00:00:00 UTC.
;;
;; Converting a UTC time prior to 1972-01-01 00:00:00 UTC to TAI is
;; more involved, since prior to this date UTC and TAI seconds were
;; not equal. See,
;;
;; http://hpiers.obspm.fr/eop-pc/index.php?index=TAI-UTC_tab
(define (tai-to-utc-offset-at-utc-day-loop utc-day alist)
(cond ((null? alist) 10)
((>= utc-day (caar alist)) (cdar alist))
(else (tai-to-utc-offset-at-utc-day-loop utc-day (cdr alist)))))
(define (tai-to-utc-offset-at-utc-day utc-day)
(tai-to-utc-offset-at-utc-day-loop
utc-day
(cache-utc-day-alist (cache))))
;; (tai-to-utc-offset-at-tai-second tai-second)
;;
;; The tai-to-utc-offset-at-tai-second procedure returns TAI to UTC
;; offset at the instant specified by its argument tai-second. The
;; instant is specified by the number of TAI seconds since
;; 1970-01-01 00:00:00 TAI.
;;
;; This implementation does not return the correct result for
;; instants prior to 1972-01-01 00:00:00 UTC.
(define (tai-to-utc-offset-at-tai-second-loop tai-second alist)
(cond
((null? alist) 10)
((>= tai-second (caar alist)) (cdar alist))
(else (tai-to-utc-offset-at-tai-second-loop tai-second (cdr alist)))))
(define (tai-to-utc-offset-at-tai-second tai-second)
(tai-to-utc-offset-at-tai-second-loop
tai-second
(cache-tai-second-alist (cache))))))

57
lib/scheme/time/tai.sld Normal file
View file

@ -0,0 +1,57 @@
;; Copyright (c) 2012 Alan Watson. All rights reserved. BSD-style
;; license: http://synthcode.com/license.txt
;; This library implements TAI clocks with an epoch of 1970-01-01
;; 00:00:00 TAI.
(define-library (scheme time tai)
(export make-tai-clock)
(import (scheme base))
(import (scheme time tai-to-utc-offset))
(begin
(define seconds-per-day (* 24.0 60.0 60.0))
(define (make-tai-clock-from-tai-like-clock call-with-current-clock-values)
(define (consumer second leap-second-indicator)
second)
(lambda ()
(call-with-current-clock-values consumer)))
(define (make-tai-clock-from-posix-like-clock call-with-current-clock-values)
(define (consumer second leap-second-indicator)
(+ second (tai-to-utc-offset-at-utc-day (/ second seconds-per-day))))
(lambda ()
(call-with-current-clock-values consumer)))
(define (make-tai-clock-from-ntp-like-clock call-with-current-clock-values)
(define (consumer second leap-second-indicator)
(+ second
(tai-to-utc-offset-at-utc-day (/ second seconds-per-day))
(if leap-second-indicator 1.0 0.0)))
(lambda ()
(call-with-current-clock-values consumer)))
;; (make-tai-clock type call-with-current-clock-values)
;;
;; The make-tai-clock procedure returns a procedure that, when
;; called with no arguments, returns an estimate of the number of
;; TAI seconds since 1970-01-01 00:00:00 TAI.
;;
;; The type and call-with-current-clock-values argument should
;; conform to the descriptions in the documentation of the (clock
;; system-clock) library.
(define (make-tai-clock type call-with-current-clock-values)
(case type
((tai-like)
(make-tai-clock-from-tai-like-clock call-with-current-clock-values))
((posix-like)
(make-tai-clock-from-posix-like-clock call-with-current-clock-values))
((ntp-like)
(make-tai-clock-from-ntp-like-clock call-with-current-clock-values))
(else
(error "invalid clock type" type))))))