<<>> <> <> <> <<>> DIRECTORY Scheme, BasicTime; SchemeTimerImpl: CEDAR PROGRAM IMPORTS Scheme, BasicTime ~ 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] ~ { <> 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]; END.