/usr/share/scheme48-1.9/cml/time.scm is in scheme48 1.9-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 | ; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Mike Sperber
;; Rendezvous that happen at a specified time
(define (at-real-time-rv time)
(make-time-rv (lambda () time)))
(define (after-time-rv time-difference)
(make-time-rv (lambda () (+ (real-time) time-difference))))
(define (make-time-rv compute-time)
(make-base
(lambda ()
(let ((time (compute-time)))
(if (> (real-time) time)
(make-enabled 0
(lambda (queue)
(unspecific)))
(make-blocked
(lambda (trans-id cleanup-proc wrap-proc)
(register-dozer!
time
;; alive?
(lambda ()
(not (trans-id-cancelled? trans-id)))
;; wakeup
;; It doesn't matter if this is repeated due to a
;; failed commit or due to a race. A stillborn commit
;; will result in a no-op, and trans-ids can deal with
;; a premature set.
(lambda ()
(with-new-proposal (lose)
(let ((thread-queue (make-queue)))
(cleanup-proc thread-queue)
(trans-id-set-value! trans-id
(cons (unspecific)
wrap-proc))
(enqueue! thread-queue
(trans-id-thread-cell trans-id))
;; we can't lose because we're running in the
;; root scheduler
(maybe-commit-and-make-ready thread-queue))))))))))))
|