SchemeTimerImpl.mesa
Copyright Ó 1988, 1991 by Xerox Corporation. All rights reserved.
Michael Plass, August 24, 1988 10:23:39 am PDT
~
BEGIN
OPEN Scheme;
TimerRep:
TYPE ~
RECORD [pulses: BasicTime.Pulses];
MakeTimerPrim:
PROC [Primitive, Any, Any, Any, ProperList]
RETURNS [Any] ~ {
timer: REF TimerRep ~ NEW[TimerRep];
timer.pulses ¬ BasicTime.GetClockPulses[];
RETURN [timer]
};
TheTimer:
PROC [a: Any]
RETURNS [
REF TimerRep] ~ {
WITH a
SELECT
FROM
t: REF TimerRep => RETURN [t];
ENDCASE => Complain[a, "not a timer"];
};
TimerPrim:
PROC [self: Primitive, a, b, c: Any, rest: ProperList]
RETURNS [Any ¬ unspecified] ~ {
This is an example of several Scheme primitives implemented by one Cedar procedure. This may help conserve scarce system resources, and often allows code sharing. Since there are only a few cases here, we can use an atom as a key, but with many cases it would be better to use a REF to an enumerated type
t: REF TimerRep ~ TheTimer[a];
SELECT self.data
FROM
$ref => {
now: BasicTime.Pulses ~ BasicTime.GetClockPulses[];
RETURN [MakeFixnum[BasicTime.PulsesToMicroseconds[now-t.pulses]]]
};
$set => {
t.pulses ¬ BasicTime.GetClockPulses[];
};
ENDCASE => ERROR;
};
TimerPredPrim:
PROC [self: Primitive, a, b, c: Any, rest: ProperList]
RETURNS [Any ¬ unspecified] ~ {
RETURN [WITH a SELECT FROM t: REF TimerRep => true ENDCASE => false];
};
Init:
PROC [env: Environment] ~ {
DefinePrimitive[name: "make-timer", nArgs: 0, proc: MakeTimerPrim, doc: "Create a timer object", env: env, dotted: FALSE];
DefinePrimitive[name: "timer-start!", nArgs: 1, proc: TimerPrim, doc: "(timer) Start a Timer", env: env, dotted: FALSE, data: $set];
DefinePrimitive[name: "timer-ref", nArgs: 1, proc: TimerPrim, doc: "(timer) Get the number of microseconds since the timer start", env: env, dotted: FALSE, data: $ref];
DefinePrimitive[name: "timer?", nArgs: 1, proc: TimerPredPrim, doc: "test for a Timer", env: env, dotted: FALSE];
};
RegisterInit[Init];