ScheduleImpl.mesa
Copyright Ó 1986, 1987 by Xerox Corporation. All rights reserved.
Bertrand Serlet April 15, 1987 4:25:51 pm PDT
Christian Le Cocq October 14, 1987 11:24:56 am PDT
DIRECTORY
Basics,
RedBlackTree,
Schedule;
ScheduleImpl: CEDAR PROGRAM
IMPORTS RedBlackTree
EXPORTS Schedule ~ BEGIN OPEN Schedule;
History management package
CreateHistory: PUBLIC PROC [t: ps, v: REAL] RETURNS [newHistory: History] ~ {
newHistory ← LIST[[t, v]];
};
KillHistory: PUBLIC PROC [history: History] ~ {
h: History;
UNTIL history=NIL DO
h ← history;
history ← history.rest;
h.rest ← NIL;
ENDLOOP;
};
AddToHistory: PUBLIC PROC [oldHistory: History, t: ps, v: REAL] RETURNS [newHistory: History] ~ {
last, prev: History;
historyPt: HistoryPt ← [t, v];
IF oldHistory=NIL THEN RETURN[LIST[historyPt]];
newHistory ← oldHistory;
FOR ih: History ← oldHistory, ih.rest UNTIL ih=NIL DO
IF ih.first.t>=t THEN { --if t occurs before the end of the current history then
ih.first ← historyPt; -- change the present and delete the "old future".
ih.rest ← NIL;
IF prev#NIL THEN IF prev.first.v=last.first.v AND prev.first.v=v THEN prev.rest ← last.rest;
RETURN;
};
prev ← last;
last ← ih;
ENDLOOP;
last.rest ← LIST[historyPt];
IF prev#NIL THEN IF prev.first.v=last.first.v AND prev.first.v=v THEN prev.rest ← last.rest;
};
ForgetBeginings: PUBLIC PROC [oldHistory: History, t: ps] RETURNS [newHistory: History] ~ {
newHistory ← oldHistory;
FOR ih: History ← oldHistory, ih.rest UNTIL ih.rest=NIL DO
IF ih.rest.first.t>t THEN {
newHistory ← ih;
RETURN;
};
ENDLOOP;
};
ForgetBeginings: PUBLIC PROC [oldHistory: History, t: ps] RETURNS [newHistory: History] ~ {
newHistory ← oldHistory;
FOR ih: History ← oldHistory, ih.rest UNTIL ih.rest=NIL DO
newHistory ← ih;
IF ih.rest.first.t>t THEN {
v: REAL ← VFromHistory[ih, t];
ih.first.v ← v;
ih.first.t ← t;
RETURN;
};
ENDLOOP;
};
FirstTimeOfHistory: PUBLIC PROC [history: History] RETURNS [t: ps] ~ {
t ← history.first.t
};
NextTimeOfHistory: PUBLIC PROC [history: History, t: ps] RETURNS [tnext: ps ← -1e30] ~ {
FOR ih: History ← history, ih.rest UNTIL ih=NIL DO
IF ih.first.t>t THEN RETURN[ih.first.t];
ENDLOOP;
};
LastTimeOfHistory: PUBLIC PROC [history: History] RETURNS [t: ps] ~ {
FOR ih: History ← history, ih.rest UNTIL ih.rest=NIL DO REPEAT
FINISHED => t ← ih.first.t;
ENDLOOP;
};
LastValueOfHistory: PUBLIC PROC [history: History] RETURNS [v: REAL] ~ {
FOR ih: History ← history, ih.rest UNTIL ih.rest=NIL DO REPEAT
FINISHED => v ← ih.first.v;
ENDLOOP;
};
VFromHistory: PUBLIC PROC [history: History, t: ps] RETURNS [v: REAL] ~ {
t0: ps;
v0: REAL;
IF t < history.first.t THEN ERROR; -- Why should you return to the past ?
IF t=history.first.t THEN RETURN[history.first.v];
FOR ih: History ← history, ih.rest UNTIL ih=NIL DO
IF t<=ih.first.t THEN {
v ← v0 + (ih.first.v - v0)*(t-t0) /(ih.first.t - t0);
RETURN;
};
v0 ← ih.first.v;
t0 ← ih.first.t;
REPEAT
FINISHED => v ← v0;
ENDLOOP;
};
EnumerateHistory: PUBLIC PROC [history: History, from, to: ps, action: HistoryProc] RETURNS [invalidEnumeration: BOOL ← FALSE] ~ {
quit: BOOLEAN ← FALSE;
FOR ih: History ← history, ih.rest UNTIL ih=NIL OR quit OR ih.first.t>to DO
IF ih.first.t>=from THEN IF action[ih.first.t, ih.first.v] THEN RETURN[TRUE];
ENDLOOP;
};
Schedule: PUBLIC PROC [hList: LIST OF History] RETURNS [lt: LIST OF ps] ~ {
t: ps;
h: LIST OF History;
endlt: LIST OF ps;
finished: BOOLEAN ← FALSE;
endlt ← lt ← LIST[-1e30];
UNTIL finished DO
finished ← TRUE;
t ← 1e30;
FOR ih: LIST OF History ← hList, ih.rest UNTIL ih=NIL DO
IF ih.first#NIL THEN {
finished ← FALSE;
IF t>=ih.first.first.t THEN {
t ← ih.first.first.t;
h ← ih;
};
};
ENDLOOP;
IF ~finished THEN {
IF endlt.first#t THEN {
endlt.rest ← LIST[t];
endlt ← endlt.rest;
};
h.first ← h.first.rest;
};
ENDLOOP;
lt ← lt.rest;
};
Agenda Management
CreateAgenda: PUBLIC PROC [execute: ExecuteProc, data: REF ANY] RETURNS [newAgenda: Agenda] ~ {
newAgenda ← NEW[AgendaRec ← [
execute: execute,
table: RedBlackTree.Create[GetKey, Compare],
data: data
]];
};
KillAgenda: PUBLIC PROC [agenda: Agenda] ~ {
RedBlackTree.DestroyTable[agenda.table];
agenda.data ← NIL;
};
InsertInAgenda: PUBLIC PROC [agenda: Agenda, ref: REF ANY, t: ps] ~ {
event: Event ← [t, ref];
list: LIST OF Event ← LIST[event];
n: RedBlackTree.Node ← RedBlackTree.LookupNode[agenda.table, list];
IF n=NIL THEN
RedBlackTree.Insert[agenda.table, list, list]
ELSE {
list.rest ← NARROW[n.data];
n.data ← list;
};
agenda.nbOfEvents ← agenda.nbOfEvents+1;
};
ExecuteAgenda: PUBLIC PROC [agenda: Agenda] RETURNS [lastTime: ps] ~ {
WHILE RedBlackTree.Size[agenda.table]#0 DO
list: LIST OF Event ← NARROW[RedBlackTree.LookupSmallest[agenda.table]];
[] ← RedBlackTree.Delete[agenda.table, list];
lastTime ← list.first.t;
WHILE list#NIL DO
agenda.execute[list.first.ref, list.first.t, agenda.data];
agenda.nbOfEvents ← agenda.nbOfEvents-1;
list ← list.rest;
ENDLOOP;
ENDLOOP;
IF agenda.nbOfEvents#0 THEN ERROR;
};
GetKey: PROC [data: RedBlackTree.UserData] RETURNS [RedBlackTree.Key] ~ {
RedBlackTree.GetKey
RETURN[data]
};
Compare: PROC [k: RedBlackTree.Key, data: RedBlackTree.UserData] RETURNS [Basics.Comparison] ~ {
RedBlackTree.Compare
t1: ps ← NARROW[k, LIST OF Event].first.t;
t2: ps ← NARROW[data, LIST OF Event].first.t;
RETURN[SELECT TRUE FROM
t1>t2  => greater,
t1<t2  => less,
ENDCASE => equal];
};
END.