

DIRECTORY
CommTimer USING [Event, EventProc, IsNullEvent, nullEvent],
CommTimerPrivate USING [EventObject, TicksSinceBoot, TimerObject],
Process USING [Abort, Detach, EnableAborts, MsecToTicks, priorityClient3, SetPriority, SetTimeout, Ticks, TicksToMsec],
Rope USING [ROPE]
;

CommTimerImpl: CEDAR MONITOR
LOCKS lock USING lock: Timer
IMPORTS Process, CommTimer, CommTimerPrivate
EXPORTS CommTimer
~ {
EventProc: TYPE ~ CommTimer.EventProc;

Timer: TYPE ~ REF TimerObject;
TimerObject: PUBLIC TYPE ~ CommTimerPrivate.TimerObject;

Event: TYPE ~ CommTimer.Event;
EventObject: PUBLIC TYPE ~ CommTimerPrivate.EventObject;
msecPerTick: INT м Process.MsecToTicks[1];
maxSizeOfWheel: CARDINAL м 256;
MsecSinceBoot: PROC RETURNS [msec: INT] ~ {
msec м LOOPHOLE[Process.TicksToMsec[CommTimerPrivate.TicksSinceBoot[]]];
};
Error: PUBLIC ERROR [codes: LIST OF ATOM, msg: Rope.ROPE] ~ CODE;
eventLock: Timer м NEW[TimerObject[0]];
freeList: REF EventObject м NIL;

AllocEvent: ENTRY PROC [lock: Timer м eventLock] RETURNS [e: Event] ~ {
IF freeList = NIL
THEN {
e.ref м NEW[EventObject];
}
ELSE {
e.ref м freeList;
freeList м e.ref.next;
e.ref.next м NIL;
};
e.gen м e.ref.gen;
};

FreeEvent: ENTRY PROC [lock: Timer м eventLock, re: REF EventObject] ~ {
re.gen м re.gen.SUCC;
re.next м freeList;
freeList м re;
};
EntryWaitForEvent: ENTRY PROC [lock: Timer]
RETURNS [list: REF EventObject] ~ {
ENABLE UNWIND => NULL;
t: Timer ~ lock;
nowMsec, rangeMsec, delta: INT;
rangeMsec м t.wheelSize * t.grainSizeMsec;
DO
nowMsec м MsecSinceBoot[];
delta м nowMsec - t.nextMsec;
SELECT delta FROM
> 2 * rangeMsec => {
t.nextMsec м nowMsec - rangeMsec;
EXIT };
>= 0 => {
t.nextMsec м t.nextMsec + t.grainSizeMsec;
EXIT };
>= (-t.grainSizeMsec) => {
ticks: Process.Ticks м Process.MsecToTicks[-delta];
TRUSTED { Process.SetTimeout[@t.wakeup, ticks] };
WAIT t.wakeup;
LOOP };
ENDCASE => {
t.nextMsec м nowMsec - rangeMsec;
EXIT };
ENDLOOP;
{
lDue, lNotDue, e, next: REF EventObject;
FOR e м t.wheel[t.wheelIndex], next WHILE e # NIL DO
next м e.next;
IF (e.whenMsec - t.nextMsec) < 0
THEN { e.next м lDue; lDue м e }
ELSE { e.next м lNotDue; lNotDue м e };
ENDLOOP;
t.wheel[t.wheelIndex] м lNotDue;
list м lDue;
};
t.wheelIndex м t.wheelIndex.SUCC MOD t.wheelSize;
};

DoEvents: PROC [list: REF EventObject, doCalls: BOOL м TRUE] ~ {
WHILE list # NIL DO
e: REF EventObject м list;
clientData: REF м e.clientData;
proc: EventProc м e.proc;
list м list.next;
IF (proc # NIL) AND doCalls THEN proc[clientData];
FreeEvent[eventLock, e];
ENDLOOP;
};

Daemon: PROC [t: Timer] ~ {
ENABLE ABORTED => CONTINUE;
Process.SetPriority[Process.priorityClient3];
DO
list: REF EventObject м EntryWaitForEvent[t];
DoEvents[list];
ENDLOOP;
};
CreateTimer: PUBLIC PROC [grainSizeMsec: INT, expectedWaitMsec: INT]
RETURNS [t: Timer]
~ {
sizeOfWheel: CARDINAL;
IF grainSizeMsec < 0 THEN ERROR Error[LIST[$badGrainSize], "negative grain size"];
grainSizeMsec м MAX[msecPerTick, grainSizeMsec];
expectedWaitMsec м MAX[expectedWaitMsec, grainSizeMsec];
sizeOfWheel м expectedWaitMsec / grainSizeMsec;
IF sizeOfWheel < maxSizeOfWheel
THEN sizeOfWheel м sizeOfWheel + sizeOfWheel/2;
sizeOfWheel м MIN[sizeOfWheel, maxSizeOfWheel];
t м NEW[TimerObject[sizeOfWheel]];
t.grainSizeMsec м grainSizeMsec;
t.nextMsec м MsecSinceBoot[];
TRUSTED { Process.EnableAborts[@t.wakeup] };
t.daemon м FORK Daemon[t];
};

EntryDestroyTimer: ENTRY PROC [lock: Timer] ~ {
lock.destroyed м TRUE;
};

DestroyTimer: PUBLIC PROC [t: Timer, doEvents: BOOL] ~ {
p: PROCESS;
EntryDestroyTimer[t];
IF (p м t.daemon) # NIL THEN TRUSTED {
Process.Abort[p];
Process.Detach[p];
};
FOR i: CARDINAL IN [0..t.wheelSize) DO
list: REF EventObject;
list м t.wheel[i]; t.wheel[i] м NIL;
DoEvents[list, doEvents];
ENDLOOP;
};

GrainSizeMsec: PUBLIC PROC [t: Timer] RETURNS [grainSizeMsec: INT]
~ { RETURN[t.grainSizeMsec] };

EntryScheduleEvent: PUBLIC ENTRY PROC [lock: Timer, waitMsec: INT, e: Event]
RETURNS [Event]
~ {
index: CARDINAL;
IF lock.destroyed THEN RETURN [CommTimer.nullEvent];
e.ref.whenMsec м waitMsec + lock.nextMsec;
index м ((waitMsec / lock.grainSizeMsec) + lock.wheelIndex) MOD lock.wheelSize;
e.ref.next м lock.wheel[index];
lock.wheel[index] м e.ref;
RETURN [e];
};

ScheduleEvent: PUBLIC PROC [t: Timer, waitMsec: INT, proc: EventProc, clientData: REF] RETURNS [Event]
~ {
e: Event м AllocEvent[eventLock];
e.ref.proc м proc;
e.ref.clientData м clientData;
IF waitMsec > 0
THEN {
e м EntryScheduleEvent[t, waitMsec, e];
IF CommTimer.IsNullEvent[e] THEN ERROR Error[LIST[$staleTimer], "timer destroyed"];
}
ELSE {
DoEvents[e.ref];
};
RETURN[ e ];
};

EntryCancelEvent: ENTRY PROC [lock: Timer м eventLock, e: Event] ~ {
IF e.gen # e.ref.gen THEN RETURN;
e.ref.proc м NIL;
e.ref.clientData м NIL;
};

CancelEvent: PUBLIC PROC [t: Timer, e: Event] ~ {
EntryCancelEvent[eventLock, e];
};

EntryMsecUntilOccurs: ENTRY PROC [lock: Timer м eventLock, t: Timer, e: Event]
RETURNS [INT] ~ {
RETURN[ IF e.ref.gen = e.gen THEN e.ref.whenMsec - t.nextMsec ELSE 0 ];
};

MsecUntilOccurs: PUBLIC PROC [t: Timer, e: Event] RETURNS [INT] ~ {
RETURN[ EntryMsecUntilOccurs[eventLock, t, e] ];
};
}.

  b  CommTimerImpl.mesa
Copyright ╙ 1988, 1991 by Xerox Corporation.  All rights reserved.
Demers, October 11, 1990 8:36 am PDT
Willie-s, March 24, 1992 3:33 pm PST
Copied Types
Parameters
Glue
Error
Event Freelist
Daemon
We've fallen way behind, so lose some time ... 
We've fallen incredibly far behind and wrapped, so lose some time ... 
Operations
 Э╩y  Ц(cedarcode) styleХNewlineDelimiter
Ш codeЩKЪЬ
╧eЬ7ЩBKЩ$KЩ$KШ ЧЪ╧k	Ш	KЪЬ
ЮЬ,Ш;KЪЬЮЬ,ШBKЪЬЮЬjШwKЪЬЮЬЮЬШKШKШ ЧЪ╧nЬЮЬЮШKЪЮЬЮЬШKЪЮЬ%Ш,KЪЮЬ
ШKШheadЩKЪЬЮЬШ&KШ KЪЬЮЬЮЬШKЪЬЮЬЮЬ Ш8KШ KЪЬЮЬШKЪЬЮЬЮЬ Ш8ЧЩ
KЪЬЮЬШ*KЪЬЮЬШЧЩЪЯЬЮЬЮЬЮЬШ+KЪЬЮЬ9ШHKШЧЧЩKЪЯЬЮЬЮЬ	ЮЬЮЬЮЬШAЧЩKЪЬЮЬШ'KЪЬ
ЮЬЮЬШ KШ ЪЯ
ЬЮЬЮЬЮЬШGЪЮЬЮШЪЮЬШKЪЬЮЬШKШЧЪЮЬШKШKШKЪЬЮЬШKШЧKШЧKШKШ ЧЪЯ	ЬЮЬЮЬЮЬШHKЪЬЮЬШKШKШKШЧЧЩЪ
ЯЬЮЬЮЬЮЬЮЬШOKЪЮЬЮЬЮЬШKШKЪЬЮЬШKЪЬ*Ш*ЪЮШKЪЬШKЪЬШЪЮЬЮШЪЬШKЩ/KЪЬ!Ш!KЪЮЬШЧЪЬ	Ш	KЪЬ*Ш*KЪЮЬШЧЪЬШKЪЬ3Ш3KЪЮЬ*Ш1KЪЮЬ
ШKЪЮЬШЧЪЮЬШKЩFKЪЬ!Ш!KЪЮЬШЧЧKЪЮЬШЧШKЪЬЮЬШ(ЪЮЬ!ЮЬЮЬЮШ4KШЪЮЬШ KЪЮЬШ KЪЮЬ#Ш'ЧKЪЮЬШЧKЪЬ Ш KЪЬШKШЧKЪЬЮЬЮЬШ1KШKШ ЧЧЪ
ЯЬЮЬЮЬЮЬЮЬШ@ЪЮЬЮЬЮШKЪЬЮЬШKЪЬЮЬШKШKЪЬШKЪЮЬ	ЮЬЮЬ	ЮЬШ2KШKЪЮЬШЧKЪЬШKШ ЧЪЯЬЮЬШKЪЮЬЮЬЮЬШKЪЬ-Ш-ЪЮШKЪЬЮЬ$Ш-KШKЪЮЬШЧKЪЬШЧЩ
ЪЯЬЮЬЮЬЮЬЮЬЮЬШWKШKЪЬЮЬШKЪЮЬЮЬЮЬЮЬ(ШRKЪЬЮЬШ0KЪЬЮЬ"Ш8KЪЬ/Ш/ЪЮЬШKЪЮЬ+Ш/ЧKЪЬЮЬШ/KЪЬЮЬШ"KЪЬ Ш KШKЪЮЬ%Ш,KЪЬЮЬШKШЧKШ ЪЯЬЮЬЮЬШ/KЪЬЮЬШKШKШ ЧЪЯЬЮЬЮЬЮЬШ8KЪЬЮЬШKЪЬШЪЮЬЮЬЮЬЮЬШ&KЪЬШKЪЬШKЪЬШЧЪЮЬЮЬЮЬЮШ&KЪЬЮЬШKЪЬ ЮЬШ$KШKЪЮЬШЧKШKШ ЧKЪЯЬЮЬЮЬЮЬЮЬЮЬШaKШ ЪЯЬЮЬЮЬЮЬЮЬЮЬШ\KШKЪЬЮЬШKЪЮЬЮЬЮЬШ4KЪЬ*Ш*KЪЬ<ЮЬШOKЪЬШKЪЬШKЪЮЬШKШKШ ЧЪЯЬЮЬЮЬЮЬЮЬЮЬШfKШKШ!KЪЬШKШЪЮЬШЪЮЬШKЪЬ'Ш'KЪЮЬЮЬЮЬЮЬ"ШSKШЧЪЮЬШKШKШЧЧKЪЮЬШKШKШ ЧЪЯЬЮЬЮЬ(ШDKЪЮЬЮЬЮЬШ!KЪЬЮЬШKЪЬЮЬШKШKШ ЧЪЯЬЮЬЮЬШ1KЪЬШKШKШ ЧЪ
ЯЬЮЬЮЬ/ЮЬЮЬШ`KЪЮЬЮЬЮЬЮЬШGKШKШ ЧЪ
ЯЬЮЬЮЬЮЬЮЬШCKЪЮЬ*Ш0KШЧЧKШKШ ЧЧ ЕЧ      ▌  