DataMuseum.dk

top - download

    Length: 2853 (0xb25)
    Types: TextFile
    Names: »sysclk.scm.4«

└─⟦a0efdde77⟧ Bits:30001252 EUUGD11 Tape, 1987 Spring Conference Helsinki
    └─ ⟦this⟧ »EUUGD11/gnu-31mar87/scheme/scm/sysclk.scm.4« 

TextFile

;;; -*-Scheme-*-
;;;
;;;	Copyright (c) 1984 Massachusetts Institute of Technology
;;;
;;;	This material was developed by the Scheme project at the
;;;	Massachusetts Institute of Technology, Department of
;;;	Electrical Engineering and Computer Science.  Permission to
;;;	copy this software, to redistribute it, and to use it for any
;;;	purpose is granted, subject to the following restrictions and
;;;	understandings.
;;;
;;;	1. Any copy made of this software must include this copyright
;;;	notice in full.
;;;
;;;	2. Users of this software agree to make their best efforts (a)
;;;	to return to the MIT Scheme project any improvements or
;;;	extensions that they make, so that these may be included in
;;;	future releases; and (b) to inform MIT of noteworthy uses of
;;;	this software.
;;;
;;;	3.  All materials developed as a consequence of the use of
;;;	this software shall duly acknowledge such use, in accordance
;;;	with the usual standards of acknowledging credit in academic
;;;	research.
;;;
;;;	4. MIT has made no warrantee or representation that the
;;;	operation of this software will be error-free, and MIT is
;;;	under no obligation to provide any services, by way of
;;;	maintenance, update, or otherwise.
;;;
;;;	5.  In conjunction with products arising from the use of this
;;;	material, there shall be no use of the name of the
;;;	Massachusetts Institute of Technology nor of any adaptation
;;;	thereof in any advertising, promotional, or sales literature
;;;	without prior written consent from MIT in each case.
;;;

;;;; System Clock

(declare (usual-integrations))
\f


(define system-clock)
(define runtime)
(define measure-interval)
(define wait-interval)

(let ((primitive-clock (make-primitive-procedure 'SYSTEM-CLOCK))
      (offset-time)
      (non-runtime))

(define (clock)
  (- (primitive-datum (primitive-clock)) offset-time))

(define (ticks->seconds ticks)
  (/ ticks 100))

(define (seconds->ticks seconds)
  (* seconds 100))

(define (reset-system-clock!)
  (set! offset-time (primitive-datum (primitive-clock)))
  (set! non-runtime 0))

(reset-system-clock!)
(add-event-receiver! event:after-restore reset-system-clock!)

(set! system-clock
      (named-lambda (system-clock)
	(ticks->seconds (clock))))

(set! runtime
       (named-lambda (runtime)
	 (ticks->seconds (- (clock) non-runtime))))

(set! measure-interval
      (named-lambda (measure-interval runtime? thunk)
	(let ((start (clock)))
	  (let ((receiver (thunk (ticks->seconds start))))
	    (let ((end (clock)))
	      (if (not runtime?) 
		  (set! non-runtime (+ (- end start) non-runtime)))
	      (receiver (ticks->seconds end)))))))

(set! wait-interval
      (named-lambda (wait-interval number-of-seconds)
	(let ((end (+ (clock) (seconds->ticks number-of-seconds))))
	  (let wait-loop ()
	    (if (< (clock) end)
		(wait-loop))))))

;;; end LET.
)