MakeDoBasicImpl.Mesa
Last Edited by: Spreitzer, June 18, 1986 12:53:48 pm PDT
Mike Spreitzer December 11, 1986 6:32:53 pm PST
Carl Hauser, April 11, 1985 3:43:34 pm PST
DIRECTORY Basics, BasicTime, Buttons, CedarProcess, Commander, CommandTool, Containers, FS, Icons, ImagerFont, IO, IOClasses, List, MakeDo, MakeDoBasics, MakeDoPrivate, Menus, MessageWindow, MoreIOClasses, Process, ProcessProps, RedBlackTree, Rope, TypeScript, UserProfile, ViewerClasses, ViewerEvents, ViewerIO, ViewerOps;
MakeDoBasicImpl: CEDAR MONITOR
IMPORTS Buttons, CedarProcess, CommandTool, Containers, Icons, ImagerFont, IO, IOClasses, List, MakeDo, MakeDoPrivate, MessageWindow, MoreIOClasses, Process, RedBlackTree, Rope, TypeScript, UserProfile, ViewerEvents, ViewerIO, ViewerOps
EXPORTS MakeDo, MakeDoBasics, MakeDoPrivate
INVARIANT
in => some process in Basic monitor.
condition variables.
Only one process writing to a commander log at a time.
Integrity of MakeDoAuxBox data structure.
Additional invariants of the Basic monitor:
Integrity of queue reps.
Node is in queue node.state says it is.
node.current=true => node not ready or waiting.
node.current#true & someone wants it true => node in some queue.
processUse & processAllocation are accurate.
halt => make nodes inactive regardless of currency.
halt => queues not all empty.
=
BEGIN OPEN MakeDo, MakeDoPrivate;
NodeRep: PUBLIC TYPE = MakeDoPrivate.NodeRep;
ActionRep: PUBLIC TYPE = MakeDoPrivate.ActionRep;
NodeClassRep: PUBLIC TYPE = MakeDoPrivate.NodeClassRep;
Viewer: TYPE = ViewerClasses.Viewer;
CHList: TYPE = LIST OF Commander.Handle;
CHTList: TYPE = RECORD [head, tail: CHList ← NIL];
in: BOOL ← FALSE;
To help debugging:
whosIn: UNSAFE PROCESS;
whatIn: PROC;
monitorChange: CONDITION;
entryTimeout: INT ← 60;
We don't use Mesa's monitor entry mechanism only because we can't ABORT something waiting on entry --- what a pisser!
DoIn: PUBLIC PROC [p: PROC] = {
CedarProcess.CheckAbort[];
Enter[p];
p[!UNWIND => Exit[]];
Exit[];
};
Enter: ENTRY PROC [p: PROC] = {
ENABLE UNWIND => NULL;
WHILE in DO WAIT monitorChange ENDLOOP;
in ← TRUE;
whosIn ← Process.GetCurrent[];
TRUSTED {whatIn ← p};
};
Exit: ENTRY PROC = {
ENABLE UNWIND => NULL;
in ← FALSE;
whosIn ← NIL;
whatIn ← NIL;
NOTIFY monitorChange;
};
processUse: INTEGER ← 0;
processAllocation: INTEGER ← 0;
SetProcessAllocation: PUBLIC --ENTRY-- PROC [n: NAT] = {
SPAWork: --INTERNAL-- PROC = {
processAllocation ← n;
BroadcastQueue[];
};
DoIn[SPAWork];
};
TrackProfile: PROC [reason: UserProfile.ProfileChangeReason] --UserProfile.ProfileChangedProc-- = {
SELECT reason FROM
rollBack, firstTime => {
pa: INT ← UserProfile.Number["MakeDo.AuxilliaryProcessAllocation", 10];
SetProcessAllocation[pa];
};
edit => {
reason ← reason;
};
ENDCASE => ERROR;
alwaysGush ← UserProfile.Boolean["MakeDo.AlwaysGush", FALSE];
deleteEmptyAuxBox ← UserProfile.Boolean["MakeDo.DeleteEmptyAuxBox", TRUE];
};
EndFork: --ENTRY-- PROC = {
InnerEndFork: --INTERNAL-- PROC = {
processUse ← processUse - 1;
BroadcastQueue[];
};
DoIn[InnerEndFork];
};
halt: BOOL ← FALSE;
readyQueue: NodeList ← NIL;
workCount: INTEGER ← 0;
waitQueue: RefTable ← MakeRefTable[];
queueChange: CONDITION;
queueTimeout: INT ← 60;
BroadcastQueue: ENTRY PROC = {
ENABLE UNWIND => NULL;
BROADCAST queueChange;
};
NotifyQueue: ENTRY PROC = {
ENABLE UNWIND => NULL;
NOTIFY queueChange;
};
WaitQueue: ENTRY PROC = {
ENABLE UNWIND => NULL;
WAIT queueChange;
};
SetState: --INTERNAL-- PROC [n: Node, new: NodeState] = {
ENABLE UNWIND => NULL;
SELECT n.state FROM
inactive => NULL;
ready => readyQueue ← readyQueue.rest;
working => workCount ← workCount - 1;
waiting => IF DeleteFromRefTable[n, waitQueue] # n THEN ERROR;
ENDCASE => ERROR;
n.state ← new;
SELECT n.state FROM
inactive => NULL;
ready => {
readyQueue ← CONS[n, readyQueue];
};
working => workCount ← workCount + 1;
waiting => {
waitQueue.Insert[n, n];
};
ENDCASE => ERROR;
NotifyQueue[];
};
InnerEnqueue: --INTERNAL-- PROC [job: Job, n: Node, inServiceOf: Node ← NIL] = {
IF n.state = inactive THEN {
n.someoneWhoCares ← job;
SetState[n, ready];
};
IF inServiceOf # NIL THEN {
n.waitingOnCurrent ← CONS[inServiceOf, n.waitingOnCurrent];
inServiceOf.waitCount ← inServiceOf.waitCount + 1;
SELECT inServiceOf.state FROM
inactive, ready => ERROR;
working => SetState[inServiceOf, waiting];
waiting => n ← n;
ENDCASE => ERROR;
};
};
InnerEnsureMembership: --INTERNAL-- PROC [job: Job, ns: NodeSet, n: Node] = {
IF ns.nodes.Lookup[n] = NIL THEN {
ns.nodes.Insert[n, n];
n.memberships.Insert[ns, ns];
CountNode[ns, n, 1];
IF n.current#true AND n.state = inactive THEN InnerEnqueue[job, n, NIL];
};
};
DestroyNodeSet: --ENTRY-- PROC [ns: NodeSet] = {
DNSWork: --INTERNAL-- PROC = {
UnMemberize: PROC [data: REF ANY] RETURNS [stop: BOOL ← FALSE] --RedBlackTree.EachNode-- = {
n: Node = NARROW[data];
IF n.memberships.Delete[ns] = NIL THEN ERROR;
};
StatelessEnumerateRefTable[ns.nodes, UnMemberize];
ns^ ← [nodes: ns.nodes];
ns.nodes.DestroyTable[];
};
DoIn[DNSWork];
};
CountNode: --INTERNAL-- PROC [ns: NodeSet, n: Node, D: INT] = {
SELECT n.current FROM
notComputed, false => ns.nonCurrents ← ns.nonCurrents + D;
true => {
ns.currents ← ns.currents + D;
SELECT n.broken FROM
FALSE => ns.ok ← ns.ok + D;
TRUE => ns.broken ← ns.broken + D;
ENDCASE => ERROR;
};
ENDCASE => ERROR;
};
SetCurrency: PUBLIC --INTERNAL-- PROC [n: Node, current: ExpensiveBool] = {
Discount: PROC [data: REF ANY] RETURNS [stop: BOOL ← FALSE] --RedBlackTree.EachNode-- = {
ns: NodeSet = NARROW[data];
CountNode[ns, n, -1];
};
Count: PROC [data: REF ANY] RETURNS [stop: BOOL ← FALSE] --RedBlackTree.EachNode-- = {
ns: NodeSet = NARROW[data];
CountNode[ns, n, 1];
};
IF n.current = current THEN RETURN;
StatelessEnumerateRefTable[n.memberships, Discount];
n.current ← current;
StatelessEnumerateRefTable[n.memberships, Count];
};
SetBroken: PUBLIC --INTERNAL-- PROC [n: Node, broken: BOOL] = {
Discount: PROC [data: REF ANY] RETURNS [stop: BOOL ← FALSE] --RedBlackTree.EachNode-- = {
ns: NodeSet = NARROW[data];
CountNode[ns, n, -1];
};
Count: PROC [data: REF ANY] RETURNS [stop: BOOL ← FALSE] --RedBlackTree.EachNode-- = {
ns: NodeSet = NARROW[data];
CountNode[ns, n, 1];
};
IF n.broken = broken THEN RETURN;
StatelessEnumerateRefTable[n.memberships, Discount];
n.broken ← broken;
StatelessEnumerateRefTable[n.memberships, Count];
};
NoteAchievement: --INTERNAL-- PROC [goal: Node] = {
SetCurrency[goal, true];
IF goal.state # working THEN ERROR;
InnerGiveUp[goal];
};
GiveUp: --ENTRY-- PROC [goal: Node] = {
GUWork: --INTERNAL-- PROC = {InnerGiveUp[goal]};
DoIn[GUWork];
};
InnerGiveUp: --INTERNAL-- PROC [goal: Node] = {
IF goal.state = working THEN {
SetState[goal, inactive];
goal.someoneWhoCares ← NIL;
InnerWakeWaiters[goal];
};
IF readyQueue=NIL AND workCount=0 AND waitQueue.Size[]=0 THEN halt ← FALSE;
};
InnerWakeWaiters: --INTERNAL-- PROC [n: Node] = {
WHILE n.waitingOnCurrent # NIL DO
waiter: Node = n.waitingOnCurrent.first;
n.waitingOnCurrent ← n.waitingOnCurrent.rest;
IF waiter.state # waiting THEN ERROR;
waiter.waitCount ← waiter.waitCount - 1;
SELECT waiter.waitCount FROM
<0 => ERROR;
=0 => SetState[waiter, ready];
>0 => NULL;
ENDCASE => ERROR;
ENDLOOP;
};
Ensure: PUBLIC PROC [goals: RefTable, modifiabilitySpec: ModifiabilitySpec, parent: Commander.Handle] RETURNS [okGoalCount, nonOKGoalCount, nSteps: NAT, failedSteps: ActionList, nonOKGoalList: NodeList] = {
callingJob: Job ← NEW [JobRep ← [
wDir: CommandTool.CurrentWorkingDirectory[],
goals: goals,
processes: MakeRefTable[],
otherModifiable: modifiabilitySpec
]];
goalNS: NodeSet = NEW [NodeSetPrivate ← [
nodes: MakeRefTable[]
]];
NoteGoal: PROC [data: REF ANY] RETURNS [stop: BOOL ← FALSE] --RedBlackTree.EachNode-- = {
n: Node = NARROW[data];
Work: --INTERNAL-- PROC = {
InnerSetModifiability[n, callingJob.goals, callingJob.otherModifiable];
InnerEnsureMembership[callingJob, goalNS, n];
};
DoIn[Work];
};
With potentially non-empty queues:
{ENABLE UNWIND => {
NoteEnsureUnwind[];
};
StatelessEnumerateRefTable[goals, NoteGoal];
[okGoalCount, nonOKGoalCount, nonOKGoalList] ← HelpEmptyQueue[goalNS: goalNS, callingJob: callingJob, parent: parent];
EnsureWDir[callingJob.wDir, parent];
};
nSteps ← callingJob.nSteps;
failedSteps ← callingJob.failedSteps;
goals.DestroyTable[];
DestroyNodeSet[goalNS];
};
NoteEnsureUnwind: --ENTRY-- PROC = {
NEUWork: --INTERNAL-- PROC = {
x: BOOL ← FALSE;
IF readyQueue#NIL OR workCount#0 OR waitQueue.Size[]#0 THEN {
halt ← TRUE;
WHILE readyQueue # NIL DO
victim: Node = readyQueue.first;
SetState[victim, working];
InnerGiveUp[victim];
ENDLOOP;
x ← x;
};
};
DoIn[NEUWork];
};
HelpEmptyQueue: PROC [goalNS: NodeSet, callingJob: Job, parent: Commander.Handle] RETURNS [okGoalCount, nonOKGoalCount: NAT, nonOKGoalList: NodeList] = {
nonOKGoalList ← nonOKGoalList;
DO
ENABLE ABORTED => {
KillIt: PROC [data: REF ANY] RETURNS [stop: BOOL ← FALSE] --RedBlackTree.EachNode-- = {
process: CedarProcess.Process = NARROW[data];
TRUSTED {Process.Abort[process.process]};
};
StatelessEnumerateRefTable[callingJob.processes, KillIt];
};
caringJob: Job ← NIL;
goal: Node ← NIL;
toExecute: Action ← NIL;
consistencyReason: ROPE ← NIL;
fails: ExpensiveBool;
haveWorkers, fork: BOOL;
[caringJob, goal, toExecute, consistencyReason, fails, haveWorkers, okGoalCount, nonOKGoalCount, nonOKGoalList, fork] ← GetActionToExecute[goalNS, callingJob, parent];
IF toExecute = NIL THEN EXIT;
With permission to work on toExecute and goal:
{ENABLE UNWIND => {
ReturnPermission[toExecute];
GiveUp[goal];
IF fork THEN EndFork[];
};
e: Execution = NEW [ExecutionPrivate ← [caringJob, toExecute, goal, parent, parent, fork]];
toExecute.reasonWhyLastDone ← consistencyReason;
IF fails = false THEN Warning[IO.PutFR["Retrying %g", [rope[toExecute.cmd]]]];
IF debugging THEN Confirm[e.a.cmd];
IF fork
THEN {
e.bch ← Buffer[e.ch, e];
{ENABLE UNWIND => Flush[e.bch, e.ch, TRUE, toExecute.cmd];
IF fork THEN Msg[parent, "%lForking %g%l\n", [rope["e"]], [rope[e.a.cmd]], [rope["E"]]];
e.process ← CedarProcess.Fork[Execute, e, [inheritProperties: TRUE]];
caringJob.processes.Insert[e.process, e.process];
}}
ELSE {
[] ← Execute[e];
};
};
ENDLOOP;
nonOKGoalList ← nonOKGoalList;
};
Execution: TYPE = REF ExecutionPrivate;
ExecutionPrivate: TYPE = RECORD [job: Job, a: Action, goal: Node, bch, ch: Commander.Handle, forked: BOOL, process: CedarProcess.Process ← NIL];
Execute: PROC [data: REF ANY] RETURNS [results: REF ANY ← NIL] --CedarProcess.ForkableProc-- = {
e: Execution = NARROW[data];
{OPEN e;
ENABLE UNWIND => IF e.forked THEN {
EndFork[];
Flush[bch, ch, TRUE, a.cmd];
[] ← job.processes.Delete[process];
};
failed: BOOL;
IF forked THEN WHILE e.process=NIL OR job.processes.Lookup[e.process]#e.process DO Process.Pause[Process.SecondsToTicks[1]] ENDLOOP;
IncrementStepCount[job];
failed ← CommandTool.DoCommand[a.cmd, bch !ABORTED => {failed ← TRUE; CONTINUE}] = $Failure;
IF forked THEN Flush[bch, ch, alwaysGush OR failed, a.cmd];
a.fails ← Expensify[failed];
IF failed THEN AddFailedCmd[job, a];
EnumerateResults[a, InnerSuspectNodeChange];
CheckIn[job, goal, a, e.process];
};
IF e.forked THEN EndFork[];
};
alwaysGush: BOOL ← FALSE;
deleteEmptyAuxBox: BOOL ← FALSE;
bufKey: ATOM = $MakeDoBuffer;
vKey: ATOM = $MakeDoForkedCommandViewer;
stopFont: ImagerFont.Font ← ImagerFont.Find["Xerox/TiogaFonts/TimesRoman18"];
auxBoxIcon: Icons.IconFlavor ← Icons.NewIconFromFile["MakeDo.Icons", 0];
auxHeight: INTEGER ← 100;
auxBox: Viewer ← NIL;
auxBoxBottom: INTEGER ← 0;
auxBoxList: CHTList ← [];
auxBoxOccupancy: NAT ← 0;
Buffer: ENTRY PROC [ch: Commander.Handle, e: Execution] RETURNS [bch: Commander.Handle] = {
ENABLE UNWIND => NULL;
bufout: IO.STREAM = MoreIOClasses.CreateBuffer[];
ctr, stop, ts: Viewer;
tsLeft: INTEGER;
this: CHList;
wasRight: BOOL;
IF wasRight ← (auxBox = NIL OR auxBox.destroyed) THEN {
auxBoxOccupancy ← 0;
auxBox ← Containers.Create[info: [iconic: TRUE, name: "MakeDo", icon: icons[1], column: right]];
[] ← ViewerEvents.RegisterEventProc[DestroyGuard, destroy, auxBox, TRUE];
auxBoxBottom ← 0;
auxBoxList ← [];
};
ctr ← Containers.Create[info: [parent: auxBox, wx: 0, wy: auxBoxBottom, ww: auxBox.cw, wh: auxHeight, border: FALSE, scrollable: FALSE], paint: FALSE];
Containers.ChildXBound[auxBox, ctr];
stop ← Buttons.Create[info: [parent: ctr, name: "!", wx: 0, wy: 0, ww: 15, wh: ctr.ch], proc: Stopit, clientData: e, font: stopFont, paint: FALSE];
tsLeft ← stop.wx + stop.ww;
ts ← TypeScript.Create[
info: [parent: ctr, wx: tsLeft, ww: ctr.cw-tsLeft, wy: 0, wh: ctr.ch],
paint: FALSE];
Containers.ChildXBound[ctr, ts];
auxBoxOccupancy ← auxBoxOccupancy + 1;
auxBox.icon ← icons[MIN[auxBoxOccupancy, icons.length-1]];
IF NOT auxBox.iconic THEN ViewerOps.PaintViewer[viewer: ctr, hint: all]
ELSE IF wasRight THEN NULL
ELSE ViewerOps.PaintViewer[viewer: auxBox, hint: all];
auxBoxBottom ← ctr.wy + ctr.wh;
bch ← NEW [Commander.CommandObject ← [
commandLine: "Shouldn't care",
propertyList: List.PutAssoc[vKey, ctr, List.PutAssoc[bufKey, bufout, CommandTool.CopyAList[ch.propertyList]]]
]];
[in: bch.in, out: bch.out] ← ViewerIO.CreateViewerStreams[name: "Jose Frink", viewer: ts];
bch.err ← bch.out ← IOClasses.CreateDribbleOutputStream[bufout, bch.out];
this ← LIST[bch];
IF auxBoxList.tail # NIL THEN auxBoxList.tail.rest ← this ELSE auxBoxList.head ← this;
auxBoxList.tail ← this;
};
Stopit: PROC [parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE] --Buttons.ButtonProc-- = {
e: Execution = NARROW[clientData];
IF e.process # NIL AND e.process.status = busy
THEN TRUSTED {Process.Abort[e.process.process]}
ELSE MessageWindow.Append[
message: IF e.process = NIL
THEN "Can't ABORT because it's not gotten started yet"
ELSE SELECT e.process.status FROM
done => "Can't ABORT because it's already done",
aborted => "Can't ABORT because it's already ABORTED",
debugging => "Won't ABORT because it's being debugged",
busy => "Wouldn't ABORT because it was not busy a few microseconds ago",
invalid => "Won't ABORT because it's invalid",
ENDCASE => "Won't ABORT because status uncrecognized (I'm suffering software rot!)",
clearFirst: TRUE]
};
DestroyGuard: ENTRY PROC [viewer: Viewer, event: ViewerEvents.ViewerEvent, before: BOOL] RETURNS [abort: BOOL ← FALSE] --ViewerEvents.EventProc-- = {
ENABLE UNWIND => NULL;
IF NOT before THEN ERROR;
IF viewer = auxBox AND auxBoxList.head # NIL THEN {
MessageWindow.Append["You don't really want to delete this viewer --- some processes may still write into subviewers", TRUE];
MessageWindow.Blink[];
abort ← TRUE;
};
};
Msg: ENTRY PROC [ch: Commander.Handle, format: ROPE, v1, v2, v3, v4, v5: IO.Value ← [null[]]] = {
ENABLE UNWIND => NULL;
ch.out.PutF[format, v1, v2, v3, v4, v5];
};
Flush: ENTRY PROC [bch, ch: Commander.Handle, long: BOOL, asRope: ROPE] = {
ENABLE UNWIND => NULL;
buffer: IO.STREAM = NARROW[List.Assoc[bufKey, bch.propertyList]];
v: Viewer = NARROW[List.Assoc[vKey, bch.propertyList]];
last: CHList ← NIL;
IF long
THEN MoreIOClasses.SendBuffer[buffer, ch.out, TRUE]
ELSE ch.out.PutF["%lDone with %g%l\n", [rope["e"]], [rope[asRope]], [rope["E"]]];
IF auxBox = NIL OR auxBox.destroyed THEN {
auxBoxBottom ← 0;
auxBoxList ← [];
auxBoxOccupancy ← 0;
}
ELSE FOR cur: CHList ← auxBoxList.head, cur.rest WHILE cur # NIL DO
IF cur.first = bch THEN {
auxBoxBottom ← v.wy;
IF last # NIL THEN last.rest ← cur.rest ELSE auxBoxList.head ← cur.rest;
IF cur = auxBoxList.tail THEN {
IF cur.rest # NIL THEN ERROR;
auxBoxList.tail ← last;
};
ViewerOps.DestroyViewer[v, FALSE];
FOR rest: CHList ← cur.rest, rest.rest WHILE rest # NIL DO
obch: Commander.Handle = rest.first;
v: Viewer = NARROW[List.Assoc[vKey, obch.propertyList]];
ViewerOps.MoveViewer[v, 0, auxBoxBottom, v.ww, v.wh, FALSE];
auxBoxBottom ← v.wy + v.wh;
ENDLOOP;
auxBoxOccupancy ← auxBoxOccupancy - 1;
auxBox.icon ← icons[MIN[auxBoxOccupancy, icons.length-1]];
ViewerOps.PaintViewer[auxBox, all];
EXIT;
};
last ← cur;
ENDLOOP;
};
SetModifiability: --ENTRY-- PROC [n: Node, goals: RefTable, ms: ModifiabilitySpec] = {
SMWork: --INTERNAL-- PROC = {InnerSetModifiability[n, goals, ms]};
DoIn[SMWork];
};
InnerSetModifiability: PUBLIC --INTERNAL-- PROC [n: Node, goals: RefTable, ms: ModifiabilitySpec] = {
new: Modifiability ← SELECT TRUE FROM
goals.Lookup[n] = n => yes,
ms = NIL => guess,
ENDCASE => SELECT ms.Lookup[n] FROM
n => yes,
NIL => no,
ENDCASE => ERROR;
IF n.modifiability = new THEN RETURN;
n.modifiability ← new;
InnerUncurrentNode[n];
n ← n;
};
GetActionToExecute: --ENTRY-- PROC [goalNS: NodeSet, callingJob: Job, parent: Commander.Handle] RETURNS [job: Job, goal: Node, toExecute: Action ← NIL, consistencyReason: ROPE, fails: ExpensiveBool, haveWorkers: BOOL ← FALSE, okGoalCount, nonOKGoalCount: NAT, nonOKGoalList: NodeList, fork: BOOL] = {
either
toExecute = NIL & no work to be done
or {
toExecute#NIL
not consistent
fails = toExecute.fails
fails # true
}
GAEWork: --INTERNAL-- PROC = {
job ← job;
DO
a: Action;
sourceMissing: BOOL ← FALSE;
sourceBroken: BOOL ← FALSE;
waits: BOOL ← FALSE;
missedList: NodeList ← NIL;
CheckSource: --INTERNAL-- PROC [n: Node, which: ActionDep, optional: BOOL] = {
CedarProcess.CheckAbort[];
InnerSetModifiability[n, job.goals, job.otherModifiable];
IF (NOT optional) AND n.created = notExistTime THEN {
sourceMissing ← TRUE;
IF goal.modifiability=yes THEN missedList ← CONS[n, missedList];
};
SELECT n.current FROM
true => {
IF n.broken THEN SetBroken[goal, sourceBroken ← TRUE];
RETURN;
};
false => SetCurrency[goal, false];
notComputed => NULL;
ENDCASE => ERROR;
InnerEnqueue[job, n, goal];
waits ← TRUE;
};
IF goal # NIL AND goal.state = working THEN ERROR;
DO
CedarProcess.CheckAbort[];
IF goalNS.nonCurrents=0 THEN {
SurveyNode: PROC [data: REF ANY] RETURNS [stop: BOOL ← FALSE] --RedBlackTree.EachNode-- = {
n: Node = NARROW[data];
IF n.current=true AND NOT n.broken
THEN {
okGoalCount ← okGoalCount + 1;
}
ELSE {
nonOKGoalCount ← nonOKGoalCount + 1;
nonOKGoalList ← CONS[n, nonOKGoalList];
};
};
okGoalCount ← nonOKGoalCount ← 0;
nonOKGoalList ← NIL;
StatelessEnumerateRefTable[goalNS.nodes, SurveyNode];
IF deleteEmptyAuxBox AND readyQueue = NIL AND workCount = 0 AND waitQueue.Size[] = 0 AND auxBox # NIL AND NOT auxBox.destroyed THEN TRUSTED {Process.Detach[FORK ViewerOps.DestroyViewer[auxBox]]};
RETURN};
IF readyQueue # NIL THEN EXIT;
IF workCount = 0 THEN {
IF waitQueue.Size[] # 0 THEN {
FindCycles[];
LOOP};
Does anything need to be put back in the queue?
{
EnsureQueued: PROC [data: REF ANY] RETURNS [stop: BOOL ← FALSE] --RedBlackTree.EachNode-- = {
n: Node = NARROW[data];
IF n.state # inactive THEN ERROR;
IF n.current#true THEN InnerEnqueue[callingJob, n, NIL];
};
StatelessEnumerateRefTable[goalNS.nodes, EnsureQueued];
IF readyQueue = NIL THEN ERROR;
LOOP;
};
};
Exit[];
WaitQueue[ !
Would you believe...
UNWIND => Enter[GAEWork]
I'm thinking of not surprising the other UNWIND catch phrase cooler in the stack.
];
Enter[GAEWork];
ENDLOOP;
goal ← readyQueue.first;
IF goal.state # ready THEN ERROR;
SetState[goal, working];
IF halt THEN {InnerGiveUp[goal]; LOOP};
With work lock on goal:
{ENABLE UNWIND => InnerGiveUp[goal];
IF (job ← goal.someoneWhoCares) = NIL THEN ERROR;
EnsureWDir[job.wDir, parent];
IF goal.current=true THEN ERROR --shouldn't have current nodes in queue--;
IF debugging THEN Log["Examining %g", [rope[goal.name]] ];
SetBroken[goal, goal.modifiability=yes AND goal.created=notExistTime];
IF goal.producer = NIL THEN InnerGetProduced[goal];
IF InnerLeaf[goal] THEN {NoteAchievement[goal]; LOOP};
a ← goal.producer.a;
IF a.permissionGranted THEN {
a.waitingForPermission ← CONS[goal, a.waitingForPermission];
goal.waitCount ← 1;
SetState[goal, waiting];
LOOP};
a.permissionGranted ← TRUE;
a.queuedFailsInvalidation ← FALSE;
With permission to work on a:
{ENABLE UNWIND => InnerReturnPermission[a];
IF debugging THEN Log["Examining %g", [rope[a.cmd]] ];
InnerEnumerateSources[a, cmd, CheckSource];
IF waits THEN {InnerReturnPermission[a]; LOOP};
IF sourceBroken THEN {InnerReturnPermission[a]; NoteAchievement[goal]; LOOP};
SELECT a.derivedFromCurrentDeterminers FROM
TRUE => NULL;
FALSE => {
InnerRederive[a];
a.derivedFromCurrentDeterminers ← TRUE;
};
ENDCASE => ERROR;
sourceMissing ← FALSE;
InnerEnumerateSources[a, data, CheckSource];
IF waits THEN {InnerReturnPermission[a]; LOOP};
IF sourceBroken THEN {InnerReturnPermission[a]; NoteAchievement[goal]; LOOP};
IF sourceMissing THEN {
IF goal.modifiability=yes THEN {
SetBroken[goal, TRUE];
Warning[IO.PutFR[
"Couldn't %g because %g don't exist",
[rope[a.cmd]],
[rope[EnglishList[missedList].el]]
]];
};
InnerReturnPermission[a];
NoteAchievement[goal];
LOOP};
SELECT fails ← a.fails FROM
true => {SetBroken[goal, TRUE]; InnerReturnPermission[a]; NoteAchievement[goal]; LOOP};
false, notComputed => NULL;
ENDCASE => ERROR;
IF NOT goal.consistencyAsked THEN {
[goal.consistent, goal.consistencyReason] ← a.class.CheckConsistency[a, goal];
goal.consistencyAsked ← TRUE;
};
consistencyReason ← goal.consistencyReason;
IF goal.consistent THEN {InnerReturnPermission[a]; NoteAchievement[goal]; LOOP};
toExecute ← a;
SetCurrency[goal, false];
DO
SELECT processAllocation FROM
=0 => {fork ← FALSE; EXIT};
>processUse => {fork ← TRUE; processUse ← processUse+1; EXIT};
ENDCASE => {
Exit[];
WaitQueue[ !
Would you believe...
UNWIND => Enter[GAEWork]
I'm thinking of not surprising the other UNWIND catch phrase cooler in the stack.
];
Enter[GAEWork];
};
ENDLOOP;
RETURN;
};
};
ENDLOOP;
};
goal ← NIL;
DoIn[GAEWork];
};
CheckIn: --ENTRY-- PROC [job: Job, goal: Node, producer: Action, process: CedarProcess.Process] = {
CIWork: --INTERNAL-- PROC = {
IF goal.state # working THEN ERROR;
SetState[goal, ready];
InnerReturnPermission[producer];
IF process # NIL THEN [] ← job.processes.Delete[process];
};
DoIn[CIWork];
};
ReturnPermission: --ENTRY-- PROC [a: Action] = {
RPWork: --INTERNAL-- PROC = {InnerReturnPermission[a]};
DoIn[RPWork];
};
InnerReturnPermission: --INTERNAL-- PROC [a: Action] = {
a.permissionGranted ← FALSE;
IF a.queuedFailsInvalidation THEN a.fails ← notComputed;
a.queuedFailsInvalidation ← FALSE;
InnerWakePermissionWaiters[a];
};
InnerWakePermissionWaiters: --INTERNAL-- PROC [a: Action] = {
a ← a;
WHILE a.waitingForPermission # NIL DO
waiter: Node = a.waitingForPermission.first;
a.waitingForPermission ← a.waitingForPermission.rest;
IF waiter.state # waiting THEN ERROR;
IF waiter.waitCount # 1 THEN ERROR;
waiter.waitCount ← 0;
SetState[waiter, ready];
ENDLOOP;
a ← a;
};
InnerGetProduced: PUBLIC --INTERNAL-- PROC [n: Node] = {
n2: Node;
IF n.producer # NIL THEN ERROR;
SELECT n.current FROM
true, false => ERROR --we shouldn't know that much if we haven't tried to produce yet--;
notComputed => NULL;
ENDCASE => ERROR;
n2 ← TryToProduce[n.name, n.class];
IF n # n2 THEN Warning[IO.PutFR["Disagreement on cannonical name for %g or %g", IO.rope[n.name], IO.rope[n2.name]]];
InnerVolunteerLeaf[n];
};
FindNode: PUBLIC --ENTRY-- PROC [someName: ROPE, class: NodeClass] RETURNS [node: Node] = {
FNWork: --INTERNAL-- PROC = {
node ← GetNode[someName, class, FALSE];
IF node # NIL THEN RETURN;
node ← TryToProduce[someName, class];
InnerVolunteerLeaf[node];
};
DoIn[FNWork];
};
Found: ERROR = CODE;
TryToProduce: --INTERNAL-- PROC [resultName: ROPE, class: NodeClass] RETURNS [sought: Node] =
BEGIN
PerFinder: --INTERNAL-- PROC [f: Finder] = {
found: BOOLEAN;
makes, cmdFrom: NodeList;
from: From;
cmd: ROPE;
class: ActionClass;
foundData: REF ANY;
CedarProcess.CheckAbort[];
[found, sought, makes, cmdFrom, from, cmd, class, foundData] ← f.finderProc[resultName: resultName, finderData: f.finderData];
IF found THEN {
first: BOOLEAN ← TRUE;
soughtIn: BOOL ← FALSE;
already: Action ← NIL;
FOR ml: NodeList ← makes, ml.rest WHILE ml # NIL DO
this: Action ← IF ml.first.producer = NIL THEN NIL ELSE ml.first.producer.a;
soughtIn ← soughtIn OR (sought = ml.first);
IF first
THEN {already ← this; first ← FALSE}
ELSE {IF this # already
THEN Warning[IO.PutFR[
"Action %g doesn't precisely cover command %g (e.g., at %g)",
IO.refAny[cmd],
IO.refAny[IF already # NIL THEN already.cmd ELSE NIL],
IO.rope[ml.first.name]]]};
ENDLOOP;
IF soughtIn
THEN {
a: Action;
IF already # NIL THEN ERROR Found;
a ← NEW [ActionRep ← [cmd: cmd, class: class, foundData: foundData]];
InnerAddAction[a, makes, cmdFrom, from];
ERROR Found
}
ELSE {
Warning[Rope.Cat["Finder (", f.name, ") blew it"]];
sought ← NIL;
};
}
ELSE sought ← NIL;
};
sought ← NIL;
EnumerateFinders[PerFinder !Found => CONTINUE];
IF sought=NIL THEN sought ← GetNode[resultName, class];
END;
InnerAddAction: --INTERNAL-- PROC [a: Action, makes, cmdFrom: NodeList, from: From] = {
FOR nl: NodeList ← makes, nl.rest WHILE nl # NIL DO
n: Node ← nl.first;
peh: EdgeRingHead ← emptyHead;
IF n.producer # NIL THEN ERROR;
IF n.current # notComputed THEN ERROR;
[a.makes, peh] ← Link[a, a.makes, n, peh, FALSE];
n.producer ← peh.first;
ENDLOOP;
InnerAddConsumption[a, cmdFrom, cmd, TRUE];
InnerAddConsumption[a, from.mustHave, data, FALSE];
InnerAddConsumption[a, from.optional, data, TRUE];
};
VolunteerLeaf: --ENTRY-- PROC [n: Node] = {
VLWork: --INTERNAL-- PROC = {InnerVolunteerLeaf[n]};
DoIn[VLWork];
};
InnerVolunteerLeaf: --INTERNAL-- PROC [n: Node] = {
IF n.producer = NIL THEN n.producer ← NEW [EdgeRep ← [
a: leaf,
n: n,
aNext: NIL, aPrev: NIL, nNext: NIL, nPrev: NIL,
optional: FALSE
]]
ELSE IF n.producer.a = NIL THEN ERROR;
};
InnerRederive: PUBLIC --INTERNAL-- PROC [a: Action] = {
from: From;
InnerRemoveConsumption[a, data];
[from, a.cmd] ← a.class.Rederive[a];
InnerAddConsumption[a, from.mustHave, data, FALSE];
InnerAddConsumption[a, from.optional, data, TRUE];
We don't have to notify anybody because we wouldn't be here unless NOT CorrectlyDerived[a], which implies all upstream stuff is suspicious.
};
AddConsumption: --ENTRY-- PROC [a: Action, nl: NodeList, which: ActionDep, optional: BOOL] = {
ACWork: --INTERNAL-- PROC = {InnerAddConsumption[a, nl, which, optional]};
DoIn[ACWork];
};
InnerAddConsumption: --INTERNAL-- PROC [a: Action, nl: NodeList, which: ActionDep, optional: BOOL] = {
FOR nl ← nl, nl.rest WHILE nl # NIL DO
n: Node ← nl.first;
SELECT which FROM
data => {
[a.from[data], n.to[data]] ← Link[a, a.from[data], n, n.to[data], optional];
};
cmd => {
[a.from[cmd], n.to[cmd]] ← Link[a, a.from[cmd], n, n.to[cmd], optional];
};
ENDCASE => ERROR;
ENDLOOP;
nl ← nl;
};
Link: --INTERNAL-- PROC [a: Action, ah: EdgeRingHead, n: Node, nh: EdgeRingHead, optional: BOOL] RETURNS [ahNew, nhNew: EdgeRingHead] = {
e: Edge ← NEW [EdgeRep ← [
optional: optional,
n: n,
a: a,
aNext: ah.first,
aPrev: NIL,
nNext: nh.first,
nPrev: NIL
]];
ah.first ← nh.first ← e;
IF e.aNext # NIL THEN e.aNext.aPrev ← e ELSE ah.last ← e;
IF e.nNext # NIL THEN e.nNext.nPrev ← e ELSE nh.last ← e;
ahNew ← ah;
nhNew ← nh;
};
InnerRemoveConsumption: --INTERNAL-- PROC [a: Action, which: ActionDep] = {
ah: EdgeRingHead ← a.from[which];
aNext: Edge;
FOR e: Edge ← ah.first, aNext WHILE e # NIL DO
n: Node ← e.n;
IF e.a # a THEN ERROR;
aNext ← e.aNext;
e.aNext ← e.aPrev ← NIL;
UnlinkToFrom[e, which];
e.a ← NIL;
e.n ← NIL;
ENDLOOP;
a.from[which] ← emptyHead;
};
UnlinkToFrom: --INTERNAL-- PROC [e: Edge--on n.to=a.from--, which: ActionDep] = {
n: Node = e.n;
IF e.nNext # NIL THEN e.nNext.nPrev ← e.nPrev ELSE SELECT which FROM cmd => n.to[cmd].last ← e.nPrev; data => n.to[data].last ← e.nPrev; ENDCASE => ERROR;
IF e.nPrev # NIL THEN e.nPrev.nNext ← e.nNext ELSE SELECT which FROM cmd => n.to[cmd].first ← e.nNext; data => n.to[data].first ← e.nNext; ENDCASE => ERROR;
e.nNext ← e.nPrev ← NIL;
};
InnerRemoveProduction: --INTERNAL-- PROC [a: Action] = {
ah: EdgeRingHead ← a.makes;
aNext: Edge;
FOR e: Edge ← ah.first, aNext WHILE e # NIL DO
n: Node ← e.n;
IF e.a # a THEN ERROR;
aNext ← e.aNext;
e.aNext ← e.aPrev ← NIL;
e.nNext ← e.nNext ← NIL;
n.producer ← NIL;
e.a ← NIL;
e.n ← NIL;
ENDLOOP;
a.makes ← emptyHead;
};
Explain: PUBLIC PROC [ch: Commander.Handle, nodes: RefTable] = {
to: IO.STREAM = ch.out;
Work: PROC [data: REF ANY] RETURNS [stop: BOOL ← FALSE] --RedBlackTree.EachNode-- = {
n: Node = NARROW[data];
ExplainNode[n, to];
};
StatelessEnumerateRefTable[nodes, Work];
};
ExplainNode: --ENTRY-- PROC [n: Node, to: IO.STREAM] = {
ShowConsumer: --INTERNAL-- PROC [a: Action, which: ActionDep] = {
to.PutF["\n\t\t%g", [rope[a.cmd]]];
};
ShowDeterminer: --INTERNAL-- PROC [n: Node, which: ActionDep, optional: BOOL] = {
nc: BOOL = n.current # true;
broken: BOOL = n.current=true AND n.broken;
to.PutF["\n%g\t%g\t%g",
[rope[IF nc THEN "*" ELSE IF broken THEN "!" ELSE ""]],
[rope[SELECT InnerGetCreated[n] FROM
notExistTime => "?",
unknownTime => "??",
ENDCASE => ""]],
IO.rope[n.name]
];
};
ShowInput: --INTERNAL-- PROC [n: Node, which: ActionDep, optional: BOOL] = {
nc: BOOL = n.current # true;
broken: BOOL = n.current=true AND n.broken;
to.PutF["\n%g\t%g\t%g%g",
[rope[IF nc THEN "*" ELSE IF broken THEN "!" ELSE ""]],
[rope[SELECT InnerGetCreated[n] FROM
notExistTime => "?",
unknownTime => "??",
ENDCASE => ""]],
IO.rope[n.name],
IO.rope[IF optional THEN "?" ELSE ""]
];
};
ShowOutput: PROC [n: Node] = {
to.PutF["\n\t\t%g", IO.rope[n.name]];
};
ENWork: --INTERNAL-- PROC = {
a: Action ← NIL;
to.PutF["%g\n", [rope[n.name]] ];
to.PutF["\tCreated %g.\n", [rope[FmtTime[n.created]]] ];
to.PutF["\t%g\n", [rope[SELECT n.current FROM
true => "Is Current",
false => "Not Current",
notComputed => "Not known if Current",
ENDCASE => ERROR]]];
IF n.current=true THEN to.PutF["\t%g.\n",
[rope[IF n.broken THEN "Broken" ELSE "Not broken"]]
];
to.PutRope["\tNeeded by {"];
InnerEnumerateConsumers[n, data, ShowConsumer];
to.PutRope["};\n\tdetermines {"];
InnerEnumerateConsumers[n, cmd, ShowConsumer];
to.PutRope["}.\n"];
SELECT TRUE FROM
n.producer = NIL => to.PutRope["\tNever tried to determine producer.\n"];
n.producer.a = leaf => to.PutRope["\tNothing knows how to produce it.\n"];
ENDCASE => a ← n.producer.a;
SELECT n.modifiability FROM
yes => to.PutRope["\tCertainly modifiable.\n"];
no => to.PutRope["\tCertainly NOT modifiable.\n"];
guess => to.PutRope["\tModifiability unspecified.\n"];
uninitialized => to.PutRope["\tModifiability undetermined.\n"];
ENDCASE => ERROR;
IF (a = NIL) OR (n.modifiability = no) THEN RETURN;
IF NOT n.consistencyAsked THEN to.PutRope["\tConsistency not inquired.\n"]
ELSE to.PutF[
"\tCurrently %g consistent with inputs (because %g).\n",
[rope[IF n.consistent THEN "is" ELSE "not"]],
[rope[n.consistencyReason]]
];
to.PutF["%g\n", [rope[a.cmd]] ];
to.PutRope["\tAccording to {"];
InnerEnumerateSources[a, cmd, ShowDeterminer];
to.PutRope["}\n\tMakes {"];
InnerEnumerateResults[a, ShowOutput];
to.PutRope["}\n\tFrom {"];
InnerEnumerateSources[a, data, ShowInput];
to.PutRope["}.\n"];
to.PutF["\t%g from current determiners.\n",
[rope[IF a.derivedFromCurrentDeterminers THEN "Derived" ELSE "Not derived"]] ];
to.PutF["\t%g with current inputs.\n", [rope[SELECT TRUE FROM
a.queuedFailsInvalidation OR a.fails=notComputed => "Not tried",
a.fails=true => "Fails",
a.fails=false => "Succeeds",
ENDCASE => ERROR]] ];
IF a.reasonWhyLastDone # NIL THEN to.PutF["\tLast executed because %g.\n", [rope[a.reasonWhyLastDone]]];
};
DoIn[ENWork];
};
GetActions: PUBLIC --ENTRY-- PROC [goals: RefTable, modifiabilitySpec: ModifiabilitySpec] RETURNS [al: ActionList] = {
GsWork: --INTERNAL-- PROC = {
asTable: RefTable ← MakeRefTable[];
PerNode: INTERNAL PROC [data: REF ANY] RETURNS [stop: BOOL ← FALSE] --RedBlackTree.EachNode-- = {
n: Node = NARROW[data];
a: Action;
InnerSetModifiability[n, goals, modifiabilitySpec];
IF n.producer = NIL OR n.producer.a = leaf OR n.modifiability=no THEN RETURN;
a ← n.producer.a;
IF asTable.Lookup[a] = a THEN RETURN;
asTable.Insert[a, a];
InnerEnumerateSources[a, cmd, PerSource];
InnerEnumerateSources[a, data, PerSource];
al ← CONS[a, al];
};
PerSource: INTERNAL PROC [n: Node, which: ActionDep, optional: BOOL] = {
[] ← PerNode[n];
};
StatelessEnumerateRefTable[goals, PerNode];
asTable.DestroyTable[];
};
DoIn[GsWork];
};
InnerLeaf: PUBLIC --INTERNAL-- PROC [n: Node] RETURNS [isLeaf: BOOL] = {
SELECT n.modifiability FROM
no => RETURN [TRUE];
yes, guess => NULL;
uninitialized => ERROR;
ENDCASE => ERROR;
isLeaf ← n.producer = NIL OR n.producer.a = leaf;
};
SuspectNodeChange: PUBLIC --ENTRY-- PROC [n: Node] = {
SNCWork: --INTERNAL-- PROC = {InnerSuspectNodeChange[n]};
DoIn[SNCWork];
};
InnerSuspectNodeChange: --INTERNAL-- PROC [n: Node] = {
lastCreated: Time = n.created;
n.created ← n.class.GetTime[n];
IF n.created # lastCreated THEN InnerNoteContentChange[n];
};
reasonNotAsked: ROPE = "haven't yet asked if consistent";
InnerNoteContentChange: --INTERNAL-- PROC [n: Node] = {
InnerUnaskConsistency: --INTERNAL-- PROC [n: Node] = {
n.consistencyAsked ← FALSE;
n.consistencyReason ← reasonNotAsked;
};
PerDirectConsumer: --INTERNAL-- PROC [a: Action, which: ActionDep] = {
SELECT which FROM
cmd => {
a.derivedFromCurrentDeterminers ← FALSE;
};
data => {
InnerUnknowFails[a];
InnerEnumerateResults[a, InnerUnaskConsistency];
};
ENDCASE => ERROR;
};
InnerUnaskConsistency[n];
InnerEnumerateConsumers[n, data, PerDirectConsumer];
InnerEnumerateConsumers[n, cmd, PerDirectConsumer];
InnerUncurrentNode[n];
n ← n;
};
InnerUnknowFails: --INTERNAL-- PROC [a: Action] = {
SELECT a.permissionGranted FROM
FALSE => a.fails ← notComputed;
TRUE => a.queuedFailsInvalidation ← TRUE;
ENDCASE => ERROR;
};
UncurrentNode: PUBLIC --ENTRY-- PROC [n: Node] = {
UNWork: --INTERNAL-- PROC = {InnerUncurrentNode[n]};
DoIn[UNWork];
};
InnerUncurrentNode: --INTERNAL-- PROC [n: Node] = {
PerConsumer: --INTERNAL-- PROC [a: Action, which: ActionDep] = {
InnerEnumerateResults[a, InnerUncurrentNode];
};
IF n.current = notComputed THEN RETURN;
SetCurrency[n, notComputed];
InnerEnumerateConsumers[n, data, PerConsumer];
InnerEnumerateConsumers[n, cmd, PerConsumer];
n ← n;
};
UncurrentProducer: PUBLIC --ENTRY-- PROC [n: Node] = {
UPWork: --INTERNAL-- PROC = {InnerUncurrentProducer[n]};
DoIn[UPWork];
};
InnerUncurrentProducer: --INTERNAL-- PROC [n: Node] = {
IF n.producer = NIL OR n.producer.a = leaf
THEN InnerUncurrentNode[n]
ELSE {
a: Action = n.producer.a;
InnerUnknowFails[a];
InnerEnumerateResults[a, InnerUncurrentNode];
};
};
EnumerateConsumers: PUBLIC --ENTRY-- PROC [n: Node, which: ActionDep, to: PROC [Action, ActionDep]] = {
ECWork: --INTERNAL-- PROC = {InnerEnumerateConsumers[n, which, to]};
DoIn[ECWork];
};
InnerEnumerateConsumers: --INTERNAL-- PROC [n: Node, which: ActionDep, to: PROC [Action, ActionDep]] = {
x: BOOL ← FALSE;
x ← x;
FOR e: Edge ← n.to[which].first, e.nNext WHILE e # NIL DO
to[e.a, which];
ENDLOOP;
x ← x;
};
EnumerateResults: PUBLIC --ENTRY-- PROC [a: Action, to: PROC [Node]] = {
ERWork: --INTERNAL-- PROC = {InnerEnumerateResults[a, to]};
DoIn[ERWork];
};
InnerEnumerateResults: --INTERNAL-- PROC [a: Action, to: PROC [Node]] = {
x: BOOL ← FALSE;
x ← x;
FOR e: Edge ← a.makes.first, e.aNext WHILE e # NIL DO
to[e.n];
ENDLOOP;
x ← x;
};
EnumerateSources: PUBLIC --ENTRY-- PROC [a: Action, which: ActionDep, to: PROC [n: Node, which: ActionDep, optional: BOOL]] = {
ESWork: --INTERNAL-- PROC = {InnerEnumerateSources[a, which, to]};
DoIn[ESWork];
};
InnerEnumerateSources: PUBLIC --INTERNAL-- PROC [a: Action, which: ActionDep, to: PROC [n: Node, which: ActionDep, optional: BOOL]] = {
which ← which;
FOR e: Edge ← a.from[which].first, e.aNext WHILE e # NIL DO
IF e.a # a THEN ERROR;
to[e.n, which, e.optional];
ENDLOOP;
which ← which;
};
GetCreated: PUBLIC --ENTRY-- PROC [n: Node] RETURNS [t: Time] = {
GCWork: --INTERNAL-- PROC = {t ← n.created};
DoIn[GCWork];
};
InnerGetCreated: PUBLIC --INTERNAL-- PROC [n: Node] RETURNS [t: Time] = {
t ← n.created;
};
StartTime: PUBLIC PROC [n: Node] = {
n.created ← n.class.GetTime[n];
};
DestroyGraph: PUBLIC --ENTRY-- PROC = {
DGWork: --INTERNAL-- PROC = {
DestroyNode: --INTERNAL-- PROC [n: Node] = {
IF n.producer # NIL AND n.producer.a # leaf THEN {
a: Action = n.producer.a;
a.class ← NIL;
a.foundData ← NIL;
InnerRemoveConsumption[a, cmd];
InnerRemoveConsumption[a, data];
InnerRemoveProduction[a];
};
};
IF workCount > 0 THEN Warning["Hope no other processes in MakeDo..."];
EnumerateNodes[to: DestroyNode, andDestroy: TRUE];
readyQueue ← NIL;
workCount ← 0;
waitQueue.DestroyTable[];
halt ← FALSE;
};
DoIn[DGWork];
};
ForAll: PUBLIC --ENTRY-- PROC [suspectChange, uncurrent: BOOL] = {
FAWork: --INTERNAL-- PROC = {
PerNode: INTERNAL PROC [n: Node] = {
IF suspectChange THEN InnerSuspectNodeChange[n];
IF uncurrent THEN InnerUncurrentProducer[n];
};
EnumerateNodes[to: PerNode, andDestroy: FALSE];
};
DoIn[FAWork];
};
RetryToProduce: PUBLIC --ENTRY-- PROC [n: Node] = {
RPWork: --INTERNAL-- PROC = {
n2: Node;
IF n.producer # NIL AND n.producer.a # leaf THEN RETURN;
IF n.producer # NIL AND n.producer.a = leaf THEN {
e: Edge = n.producer;
IF e.aNext # NIL OR e.aPrev # NIL THEN ERROR;
IF e.nNext # NIL OR e.nPrev # NIL THEN ERROR;
n.producer.a ← NIL;
n.producer ← NIL;
InnerUncurrentNode[n];
};
n2 ← TryToProduce[n.name, n.class];
IF n # n2 THEN Warning[IO.PutFR["Disagreement on cannonical name for %g or %g", IO.rope[n.name], IO.rope[n2.name]]];
InnerVolunteerLeaf[n];
};
DoIn[RPWork];
};
EnsureWDir: PROC [wDir: ROPE, parent: Commander.Handle] = {
IF NOT CommandTool.CurrentWorkingDirectory[].Equal[wDir, FALSE] THEN {
[] ← CommandTool.DoCommand[Rope.Cat["CD ", wDir], parent];
IF NOT CommandTool.CurrentWorkingDirectory[].Equal[wDir, FALSE] THEN ERROR;
};
};
FindCycles: --INTERNAL-- PROC = {
out: IO.STREAM = GetCommanderHandle[].out;
explored: RefTable ← MakeRefTable[];
inStack: RefTable ← MakeRefTable[];
stack: NodeList ← NIL;
cycleCount: INTEGER ← 0;
PerElement: PROC [n: Node] = {
out.PutF["\t%g\n", [rope[n.name]] ];
InnerWakeWaiters[n];
IF n.producer#NIL AND n.producer.a#leaf THEN InnerWakePermissionWaiters[n.producer.a];
};
NoteNode: --INTERNAL-- PROC [n: Node] = {
IF explored.Lookup[n] # NIL THEN RETURN;
IF inStack.Lookup[n] # NIL THEN {
cycleCount ← cycleCount + 1;
out.PutRope["Found cycle:\n"];
PerElement[n];
FOR nl: NodeList ← stack, nl.rest WHILE nl.first # n DO
PerElement[nl.first];
ENDLOOP;
out.PutRope["\n"];
RETURN;
};
inStack.Insert[n, n];
stack ← CONS[n, stack];
FOR wl: NodeList ← n.waitingOnCurrent, wl.rest WHILE wl # NIL DO
[] ← NoteNode[wl.first];
ENDLOOP;
IF n.producer # NIL AND n.producer.a # leaf THEN {
a: Action = n.producer.a;
FOR wl: NodeList ← a.waitingForPermission, wl.rest WHILE wl # NIL DO
[] ← NoteNode[wl.first];
ENDLOOP;
};
stack ← stack.rest;
IF DeleteFromRefTable[n, inStack] # n THEN ERROR;
explored.Insert[n, n];
};
halt ← TRUE;
Warning["MakeDo deadlocked... hang on while I look for dependency cycles... "];
FOR
n: Node ←
NARROW[waitQueue.LookupSmallest[]],
NARROW[waitQueue.LookupNextLarger[n]] WHILE n # NIL DO
NoteNode[n];
ENDLOOP;
Warning[IO.PutFR["... found %g cycle(s) ... halting", [integer[cycleCount]] ]];
};
StatelessEnumerateRefTable: PUBLIC PROC [table: RefTable, EachNode: RedBlackTree.EachNode] = {
table ← table;
FOR ref: REF ANY ← table.LookupSmallest[], table.LookupNextLarger[ref] WHILE ref # NIL DO
IF EachNode[ref] THEN ERROR;
ENDLOOP;
table ← table;
};
Start: PROC = {
TRUSTED {
mcp: Process.ConditionPointer = @monitorChange;
qcp: Process.ConditionPointer = @queueChange;
Process.InitializeCondition[mcp, Process.SecondsToTicks[entryTimeout]];
Process.EnableAborts[mcp];
Process.InitializeCondition[qcp, Process.SecondsToTicks[queueTimeout]];
Process.EnableAborts[qcp];
};
UserProfile.CallWhenProfileChanges[TrackProfile];
};
Start[];
END.