DIRECTORY
Inline USING [ BITSHIFT ],
IntervalTimer USING [ Microseconds, Now, NowInPulses, Pulses ],
IntervalTimerFace USING [ exists, SetExpirationTime, Wait ],
PriorityQueue USING [ Create, Empty, Insert, Ref, Remove, SortPred, Top ],
(This implementation borrows the insertion/removal algorithm from the PQ package)
Process USING [ Detach, Priority, priorityInterrupt, SetPriority ],
ProcessOperations USING [ HandleToIndex, ReadPSB ],
RTOS USING [ UnregisterCedarProcess ],
Runtime USING [ GlobalFrame ],
Space USING [ Create, Handle, LongPointer, Map, virtualMemory, wordsPerPage ],
SpecialSpace USING [ MakeResident, MakeCodeResident, MakeGlobalFrameResident ],
System USING [ MicrosecondsToPulses, PulsesToMicroseconds ]
;
IntervalTimerImpl:
CEDAR
MONITOR
IMPORTS Inline, IntervalTimer, IntervalTimerFace, Process, ProcessOperations, RTOS, Runtime, Space, SpecialSpace, System
EXPORTS IntervalTimer = {
TooManyWaiters: PUBLIC ERROR = CODE;
IntervalItem: TYPE = POINTER TO IntervalRec;
IntervalRec:
TYPE =
RECORD [
time: IntervalTimer.Pulses,
wakeup: CONDITION,
timedOut: BOOLEAN
];
QIndex: TYPE = NAT;
maxQueueLength: QIndex = Space.wordsPerPage - 5; -- max # processes is 1024 these days
PSeq: TYPE = LONG POINTER TO PSequ;
PSequ:
TYPE =
RECORD [
queueLength: QIndex,
elements: ARRAY [0..maxQueueLength) OF IntervalItem
];
spaceHandle: Space.Handle;
intervalQ: PSeq ← NIL;
timerIdle: CONDITION;
Operations for debugging
SoftNow:
PROC
RETURNS [now: IntervalTimer.Microseconds] = {
RETURN[IntervalTimer.Now[]];
};
SoftNowInPulses:
PROC
RETURNS [now: IntervalTimer.Pulses] = {
RETURN[IntervalTimer.NowInPulses[]];
};
WaitForExpirationTimeInPulses:
PUBLIC
ENTRY
PROCEDURE[time: IntervalTimer.Pulses] =
TRUSTED {
item: IntervalRec;
IF ~IntervalTimerFace.exists THEN RETURN;
item.time ← time;
item.timedOut←FALSE;
IF ~PQInsert[@item] THEN ERROR TooManyWaiters;
Assert queue cannot be empty here, since Remove[] holds the same monitor.
IntervalTimerFace.SetExpirationTime[PQTop[].time];
NOTIFY timerIdle;
Note: WAIT cannot be aborted. Process will not proceed until the timeout occurs!
UNTIL item.timedOut DO WAIT item.wakeup; ENDLOOP
};
WaitForExpirationTime:
PUBLIC
PROCEDURE[time: IntervalTimer.Microseconds] =
TRUSTED {
nowInPulses: IntervalTimer.Pulses;
timeToWait: IntervalTimer.Microseconds;
IF ~IntervalTimerFace.exists THEN RETURN;
nowInPulses ← IntervalTimer.NowInPulses[];
timeToWait ← time - System.PulsesToMicroseconds[nowInPulses];
IF LOOPHOLE[timeToWait, INT] <= 0 THEN RETURN; -- in the past already
WaitForExpirationTimeInPulses[[nowInPulses + System.MicrosecondsToPulses[timeToWait]]];
};
WaitForExpirationInterval:
PUBLIC
PROCEDURE[microseconds:
INT] =
TRUSTED {
WaitForExpirationTimeInPulses[[IntervalTimer.NowInPulses[] + System.MicrosecondsToPulses[microseconds]]];
};
WaitForExpirationIntervalInPulses:
PUBLIC
PROCEDURE[pulses:
INT] =
TRUSTED {
WaitForExpirationTimeInPulses[[IntervalTimer.NowInPulses[] + pulses]];
};
IntervalTimerMultiplexor:
PROC =
TRUSTED {
Notifier:
ENTRY
PROC =
TRUSTED
INLINE {
PQTop[].timedOut ← TRUE;
NOTIFY PQTop[].wakeup;
PQRemove[];
};
WaitForWork:
ENTRY
PROC =
TRUSTED
INLINE {
WHILE PQEmpty[]
DO
WAIT timerIdle;
ENDLOOP;
IntervalTimerFace.SetExpirationTime[PQTop[].time];
};
SpecialSpace.MakeCodeResident[Runtime.GlobalFrame[IntervalTimerMultiplexor]];
SpecialSpace.MakeGlobalFrameResident[Runtime.GlobalFrame[IntervalTimerMultiplexor]];
RTOS.UnregisterCedarProcess[ProcessOperations.HandleToIndex[ProcessOperations.ReadPSB[]]];
Process.SetPriority[Process.priorityInterrupt];
DO
WaitForWork[];
IntervalTimerFace.Wait[];
Notifier[];
ENDLOOP;
};
InitializeIntervalTimer:
PROC =
TRUSTED {
spaceHandle ← Space.Create[size: 1, parent: Space.virtualMemory];
Space.Map[spaceHandle];
SpecialSpace.MakeResident[spaceHandle];
intervalQ ← Space.LongPointer[spaceHandle];
intervalQ.queueLength ← 0;
Process.Detach[FORK IntervalTimerMultiplexor[]];
};
Priority Queue implementation. Unsafe if Wait procedure can be aborted or otherwise terminated while a wait is in progress!!! Is that OK?
Call only when it is known that PQEmpty[] is FALSE
PQTop:
PROC
RETURNS [IntervalItem] =
TRUSTED
INLINE {
RETURN[intervalQ.elements[1]];
};
PQEmpty:
PROC
RETURNS [
BOOL] =
TRUSTED
INLINE {
RETURN[intervalQ.queueLength = 0];
};
PQInsert:
INTERNAL
PROC [item: IntervalItem]
RETURNS [ok:
BOOL ←
TRUE] =
TRUSTED
INLINE {
size, son: QIndex ← intervalQ.queueLength + 1;
dad: QIndex ← Inline.BITSHIFT[son, -1];
IF size > maxQueueLength THEN RETURN[FALSE];
WHILE dad > 0
AND
LOOPHOLE[intervalQ.elements[dad].time - item.time, INT] > 0 DO
Item is better than q[dad], so shuffle q[dad] down
intervalQ.elements[son] ← intervalQ.elements[dad];
son�
dad ← Inline.BITSHIFT[son, -1]; ENDLOOP;
intervalQ.elements[son] ← item; -- insert the new item and
intervalQ.queueLength ← size; -- update the size.
};
Call only when it is known that PQEmpty[] is FALSE
PQRemove:
INTERNAL
PROC =
TRUSTED
INLINE {
size: QIndex ← intervalQ.queueLength;
item: IntervalItem ← NIL;
dad, maxDad: QIndex;
IF size = 0 THEN ERROR; -- Paranoid: assert that PQRemove is only called when non-empty
item ← intervalQ.elements[size];
intervalQ.elements[size] ← NIL;
intervalQ.queueLength ← (size ← size - 1);
IF size = 0 THEN RETURN;
dad ← 1; maxDad ← Inline.BITSHIFT[size, -1];
WHILE dad <= maxDad
DO
son: QIndex ← dad + dad;
IF son < size
THEN
IF LOOPHOLE[intervalQ.elements[son].time - intervalQ.elements[son + 1].time, INT] > 0 THEN son ← son + 1;
IF LOOPHOLE[intervalQ.elements[son].time - item.time, INT] > 0 THEN EXIT;
intervalQ.elements[dad] ← intervalQ.elements[son];
dad ← son;
ENDLOOP;
intervalQ.elements[dad] ← item;
};
InitializeIntervalTimer[];
}.