mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 21:59:17 +02:00
8b5eb68238
They can be close()d explicitly with close-file-descriptor, and will close() on gc, but only explicitly closing the last port on them will close the fileno. Notably needed for network sockets where we open separate input and output ports on the same socket.
57 lines
2.1 KiB
Scheme
57 lines
2.1 KiB
Scheme
;; 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))))))
|