MakeDoProcesses.Mesa
Last Edited by: Spreitzer, September 3, 1985 2:28:08 pm PDT
DIRECTORY Basics, CedarProcess, Commander, CommandTool, IO, List, MakeDo, MakeDoPrivate, PrincOpsUtils, Process, ProcessProps, RedBlackTree, Rope, ViewerClasses, ViewerIO;
MakeDoProcesses:
CEDAR
MONITOR
IMPORTS CedarProcess, Commander, CommandTool, IO, List, MakeDo, MakeDoPrivate, Process, ProcessProps, RedBlackTree, Rope
EXPORTS MakeDo, MakeDoPrivate
=
INVARIANT
processAllocation and processUse describe process management.
Subgoals move through queues in order, except among {workToDo, waitForWork, waitForLocks}.
BEGIN OPEN MakeDo, MakeDoPrivate;
NodeRep: PUBLIC TYPE = MakeDoPrivate.NodeRep;
CommandRep: PUBLIC TYPE = MakeDoPrivate.CommandRep;
ActiveSubgoalState: TYPE = SubgoalState[workToDo .. waitForTail];
BasicProcess: TYPE = REF BasicProcessRep;
BasicProcessRep: TYPE = UNSAFE PROCESS;
processAllocation: INTEGER ← 0;
processUse: INTEGER ← 0;
queues:
ARRAY ActiveSubgoalState
OF Table ← [
workToDo: RedBlackTree.Create[IdGetKey, CompareRefs],
waitForWork: RedBlackTree.Create[IdGetKey, CompareRefs],
waitForLocks: RedBlackTree.Create[IdGetKey, CompareRefs],
waitForRecursion: RedBlackTree.Create[IdGetKey, CompareRefs],
needToFinish: RedBlackTree.Create[IdGetKey, CompareRefs],
waitForFinish: RedBlackTree.Create[IdGetKey, CompareRefs],
waitForTail: RedBlackTree.Create[IdGetKey, CompareRefs]
];
processingChange: CONDITION;
abort: BOOL ← FALSE;
locks: Table--of WorkRefs locked-- ← RedBlackTree.Create[IdGetKey, CompareRefs];
workers: Table--of BasicProcess-- ← RedBlackTree.Create[IdGetKey, CompareBPs];
host: BasicProcess ←
NIL;
The one PROCESS that is not FORKED.
complaints: RopeList ← NIL;
helpBase: ROPE = "HelpMakeDo";
helpCmd: ROPE = CommandTool.CurrentWorkingDirectory[].Cat[helpBase, " &"];
AddComplaint:
ENTRY
PROC [msg:
ROPE] = {
complaints ← CONS[msg, complaints];
};
RelayComplaints:
ENTRY
PROC [] = {
ENABLE UNWIND => {};
x: BOOL ← FALSE;
WHILE complaints #
NIL
DO
msg: ROPE = complaints.first;
complaints ← complaints.rest;
SIGNAL Warning[msg];
ENDLOOP;
x ← x;
};
DestroyQueues:
PUBLIC
ENTRY
PROC = {
x: BOOL ← FALSE;
FOR ass: ActiveSubgoalState
IN ActiveSubgoalState
DO
queues[ass].DestroyTable[];
ENDLOOP;
locks.DestroyTable[];
BROADCAST processingChange;
};
GetAssignment:
ENTRY
PROC [joinable:
BOOL]
RETURNS [sg: Subgoal, sub: WorkRef ←
NIL] = {
ENABLE UNWIND => NULL;
sg ← NIL;
DO
someWillProgress, someHeldUp: BOOL;
CedarProcess.CheckAbort[];
IF abort THEN EXIT;
IF joinable AND processUse > processAllocation THEN EXIT;
sg ← NARROW[queues[workToDo].LookupSmallest[]];
IF sg #
NIL
THEN {
fs: WorkRef;
in: BOOL;
sub ← NARROW[sg.toDo.LookupSmallest[]];
sg.working.Insert[sub, sub];
fs ← NARROW[Delete[sg.toDo, sub]];
IF fs # sub THEN ERROR;
in ← MayEnter[sg, sub];
CorrectNewState[sg];
IF NOT in THEN LOOP;
Forkem[];
RETURN;
};
sg ← NARROW[queues[needToFinish].LookupSmallest[]];
IF sg #
NIL
THEN {
SetState[sg, waitForFinish];
sub ← NIL;
Forkem[];
RETURN;
};
someWillProgress ←
queues[waitForWork].Size[] # 0 OR
queues[waitForFinish].Size[] # 0;
someHeldUp ←
queues[waitForLocks].Size[] # 0 OR
queues[waitForRecursion].Size[] # 0 OR
queues[waitForTail].Size[] # 0;
IF (NOT someWillProgress) AND (NOT someHeldUp) AND (NOT joinable) THEN EXIT;
IF someHeldUp AND NOT someWillProgress THEN HandleDeadlock[];
WAIT processingChange;
ENDLOOP;
InnerReturn[joinable];
};
CorrectNewState:
INTERNAL
PROC [sg: Subgoal] = {
old: SubgoalState = sg.state;
allWorkWait: INT = sg.working.Size[];
onlyActiveWorkWait: NAT = allWorkWait - sg.lockoutCount;
new: SubgoalState =
IF sg.toDo.Size[] # 0
THEN workToDo
ELSE IF onlyActiveWorkWait > 0 THEN waitForWork
ELSE IF sg.lockoutCount > 0 THEN waitForLocks
ELSE IF sg.lockoutCount < 0 THEN ERROR
ELSE
IF sg.recursing.Size[] # 0
THEN
SELECT old
FROM
IN [unspecified .. waitForRecursion] => waitForRecursion,
IN [needToFinish .. waitForTail] => waitForTail,
ENDCASE => ERROR
ELSE
SELECT old
FROM
IN [unspecified .. needToFinish] => needToFinish,
IN [waitForFinish .. waitForTail] => done,
ENDCASE => ERROR;
SetState[sg, new];
IF new = done
THEN {
IF sg.locked # NIL THEN InnerUnlock[sg.locked];
ReturnFrom[sg];
};
};
SetState:
INTERNAL
PROC [sg: Subgoal, new: SubgoalState] = {
old: SubgoalState = sg.state;
IF new # old
THEN {
IF new < old AND NOT (new IN Backwardable AND old IN Backwardable) THEN ERROR;
IF new IN ActiveSubgoalState THEN queues[new].Insert[sg, sg];
IF old
IN ActiveSubgoalState
THEN {
fs: Subgoal ← NARROW[Delete[queues[old], sg]];
IF fs # sg THEN ERROR;
};
sg.state ← new;
BROADCAST processingChange;
};
};
Backwardable: TYPE = SubgoalState[workToDo .. waitForRecursion);
MayEnter:
INTERNAL
PROC [sg: Subgoal, work: WorkRef]
RETURNS [in:
BOOL] = {
WITH work
SELECT
FROM
cWork: CWork => {
in ← MayEnterDownCmd[cWork.c];
IF
NOT in
THEN {
cWork.c.lockedOuts ← CONS[[sg, work], cWork.c.lockedOuts];
sg.lockoutCount ← sg.lockoutCount + 1;
};
};
nWork: NWork => {
in ← MayEnterDownNode[nWork.goal];
IF
NOT in
THEN {
nWork.goal.lockedOuts ← CONS[[sg, work], nWork.goal.lockedOuts];
sg.lockoutCount ← sg.lockoutCount + 1;
};
};
ENDCASE => ERROR;
IF in THEN locks.Insert[work, work];
};
Unlock:
ENTRY
PROC [work: WorkRef] = {
ENABLE UNWIND => {};
InnerUnlock[work];
};
UnlockSubject:
INTERNAL
PROC [work: WorkRef]
RETURNS [lockouts: LockoutList] = {
fw: REF ANY ← Delete[locks, work];
WITH work
SELECT
FROM
cWork: CWork => {ExitDownCmd[cWork.c]; lockouts ← cWork.c.lockedOuts; cWork.c.lockedOuts ← NIL};
nWork: NWork => {ExitDownNode[nWork.goal]; lockouts ← nWork.goal.lockedOuts; nWork.goal.lockedOuts ← NIL};
ENDCASE => ERROR;
IF fw # work THEN ERROR
};
InnerUnlock:
INTERNAL
PROC [work: WorkRef] = {
lockouts: LockoutList ← UnlockSubject[work];
FOR lockouts ← lockouts, lockouts.rest
WHILE lockouts #
NIL
DO
sg: Subgoal ← lockouts.first.sg;
work: WorkRef ← lockouts.first.work;
fw: WorkRef;
InsertWork[sg.toDo, work];
fw ← NARROW[Delete[sg.working, work]];
IF fw # work THEN ERROR;
sg.lockoutCount ← sg.lockoutCount - 1;
CorrectNewState[sg];
ENDLOOP;
lockouts ← lockouts;
};
ReturnFrom:
INTERNAL
PROC [child: Subgoal] = {
parent: Subgoal ← child.caller;
fc: Subgoal;
IF parent = NIL THEN RETURN;
SELECT parent.state
FROM
workToDo, waitForWork, waitForLocks, waitForRecursion => {
IF parent.PerFinish # NIL THEN parent.PerFinish[parent.parent, child.parent];
};
ENDCASE => ERROR;
fc ← NARROW[Delete[parent.recursing, child]];
IF fc # child THEN ERROR;
CorrectNewState[parent];
};
CheckIn:
ENTRY
PROC [joinable:
BOOL, sg: Subgoal, sub: WorkRef ←
NIL, ss: Subgoal ←
NIL] = {
ENABLE UNWIND => {};
done: BOOL = (ss = NIL);
IF ss #
NIL
THEN {
ss.caller ← sg;
sg.recursing.Insert[ss, ss];
InnerAdd[ss];
};
SELECT
TRUE
FROM
sub#
NIL => {
fs: WorkRef;
IF done AND sg.PerFinish # NIL THEN sg.PerFinish[sg.parent, sub];
fs ← NARROW[Delete[sg.working, sub]];
IF fs # sub THEN ERROR;
CorrectNewState[sg];
};
sub=
NIL => {
CorrectNewState[sg];
};
ENDCASE => ERROR;
};
InnerAdd:
INTERNAL
PROC [sg: Subgoal] = {
sg.working ← RedBlackTree.Create[IdGetKey, CompareRefs];
sg.recursing ← RedBlackTree.Create[IdGetKey, CompareRefs];
CorrectNewState[sg];
Forkem[];
};
SetProcessAllocation:
PUBLIC
ENTRY
PROC [n:
NAT] = {
ENABLE UNWIND => {};
processAllocation ← n;
BROADCAST processingChange;
Forkem[];
};
Forkem:
INTERNAL
PROC = {
x: BOOL ← FALSE;
IF MayFork[]
THEN {
[] ← CommandTool.DoCommand[
commandLine: helpCmd,
parent: GetCommanderHandle[]
];
BROADCAST processingChange;
};
x ← x;
};
MayFork:
INTERNAL
PROC
RETURNS [may:
BOOL] = {
may ← processUse < processAllocation AND (queues[workToDo].Size[] > 0 OR queues[needToFinish].Size[] > 0) AND NOT abort;
IF may THEN processUse ← processUse + 1;
};
Return:
ENTRY
PROC [joinable:
BOOL] =
{InnerReturn[joinable]};
InnerReturn:
INTERNAL
PROC [joinable:
BOOL] = {
IF joinable
THEN {
processUse ← processUse - 1;
BROADCAST processingChange;
};
};
HelpMakeDo:
PROC [cmd: Commander.Handle]
RETURNS [result:
REF
ANY ←
NIL, msg:
ROPE ←
NIL]
--Commander.CommandProc-- = {
me: BasicProcess ← NEW [BasicProcessRep ← Process.GetCurrent[]];
SELECT ShouldWork[me]
FROM
FALSE => cmd.out.PutRope["Aborted.\n"];
TRUE =>
{
{
ENABLE
UNWIND => {
[] ← workers.Delete[me];
cmd.out.PutRope[" ... (because unwinding) done helping MakeDo\n"];
};
mec: CARDINAL = LOOPHOLE[me^];
cmd.out.PutF["Helping MakeDo, in PROCESS %xH ...\n", IO.card[mec]];
WorkOnQueue[
TRUE !
Warning => {AddComplaint[message]; RESUME}
];
};
[] ← workers.Delete[me];
cmd.out.PutRope[" ... done helping MakeDo\n"];
};
ENDCASE => ERROR;
};
ShouldWork:
ENTRY
PROC [me: BasicProcess]
RETURNS [should:
BOOL] = {
ENABLE UNWIND => {};
should ← NOT abort;
IF should THEN workers.Insert[me, me];
};
SetHost:
ENTRY
PROC [me: BasicProcess] = {
ENABLE UNWIND => {};
IF host # NIL THEN ERROR;
host ← me;
};
ClearHost:
ENTRY
PROC [me: BasicProcess] = {
ENABLE UNWIND => {};
IF host # me THEN ERROR;
host ← NIL;
};
AchieveGoal:
PUBLIC
PROC [sg: Subgoal] = {
ENABLE UNWIND => {};
me: BasicProcess = NEW [BasicProcessRep ← Process.GetCurrent[]];
SetHost[me];
{
ENABLE
UNWIND => {
ClearHost[me];
IF FinishAborting[TRUE] THEN ERROR;
};
Add[sg];
WorkOnQueue[FALSE];
};
ClearHost[me];
IF FinishAborting[FALSE] THEN ERROR ABORTED;
};
Add:
ENTRY
PROC [sg: Subgoal] = {
ENABLE UNWIND => {};
InnerAdd[sg];
};
nonNILsg: Subgoal ← NEW [SubgoalRep];
StartAbort:
ENTRY
PROC = {
ENABLE UNWIND => {};
self: BasicProcessRep = Process.GetCurrent[];
AbortIt:
PROC [data:
REF
ANY]
RETURNS [stop:
BOOL ←
FALSE]
--RedBlackTree.EachNode-- = {
bp: BasicProcess = NARROW[data];
IF bp^ # self THEN TRUSTED {Process.Abort[bp^]};
};
IF
NOT abort
THEN {
abort ← TRUE;
workers.EnumerateIncreasing[AbortIt];
IF host # NIL THEN [] ← AbortIt[host];
};
};
WorkOnQueue:
PROC [joinable:
BOOL] = {
ENABLE
UNWIND => {
Return[joinable];
StartAbort[];
};
sg: Subgoal ← nonNILsg;
sub: WorkRef;
joinable ← joinable;
DO
ss: Subgoal ← NIL;
wDir: ROPE ← CommandTool.CurrentWorkingDirectory[];
IF NOT joinable THEN RelayComplaints[];
[sg, sub] ← GetAssignment[joinable];
IF sg = NIL THEN EXIT;
IF
NOT wDir.Equal[sg.job.wDir,
FALSE]
THEN {
IF joinable
THEN {
SetWorkingDirectory[sg.job.wDir];
wDir ← CommandTool.CurrentWorkingDirectory[];
};
IF NOT wDir.Equal[sg.job.wDir, FALSE] THEN ERROR;
};
SELECT sub
FROM
#
NIL => {
ss ←
WITH sub
SELECT
FROM
nWork: NWork => NodeWork[nWork],
cWork: CWork => CmdWork[cWork],
ENDCASE => ERROR;
SELECT ss
FROM
= NIL => Unlock[sub];
#
NIL => {
IF ss.locked # NIL THEN ERROR;
ss.locked ← sub;
};
ENDCASE => ERROR;
};
=
NIL => {
ss ← IF sg.AllDone # NIL THEN sg.AllDone[sg.parent] ELSE NIL;
IF ss # NIL AND ss.locked # NIL THEN ERROR;
};
ENDCASE => ERROR;
CheckIn[joinable, sg, sub, ss];
ENDLOOP;
joinable ← joinable;
};
SetWorkingDirectory:
PROC [wDir:
ROPE] = {
ch: Commander.Handle = GetCommanderHandle[];
props: List.AList ← ProcessProps.GetPropList[];
ch.out.PutF["Changing working directory to %g\n", IO.rope[wDir]];
IF List.PutAssoc[$WorkingDirectory, wDir, props] # props THEN ERROR;
wDir ← wDir;
};
hardAbort: INTEGER ← 2;
abortCount: INTEGER ← 0;
FinishAborting:
ENTRY
PROC [unwinding:
BOOL]
RETURNS [raiseABORTED:
BOOL] = {
ENABLE UNWIND => {};
x: BOOL ← FALSE;
stack: Table ← NewRefTable[];
IF NOT abort THEN RETURN [FALSE];
x ← x;
abortCount ← 0;
WHILE workers.Size[] > 0
DO
ENABLE ABORTED => IF (abortCount ← abortCount + 1) < hardAbort THEN LOOP;
WAIT processingChange;
ENDLOOP;
x ← x;
FOR ass: ActiveSubgoalState
IN ActiveSubgoalState
DO
queues[ass].DestroyTable[];
ENDLOOP;
x ← x;
DO
work: WorkRef ← NARROW[locks.LookupSmallest[]];
IF work = NIL THEN EXIT;
[] ← UnlockSubject[work];
WITH work
SELECT
FROM
nWork: NWork => NodeMayNeedRemaking[nWork.goal, stack];
cWork: CWork => {
CmdMayNeedRemaking[cWork.c, cmd, stack];
CmdMayNeedRemaking[cWork.c, data, stack];
};
ENDCASE => ERROR;
ENDLOOP;
abort ← FALSE;
RETURN [NOT unwinding];
};
HandleDeadlock:
INTERNAL
PROC = {
out: IO.STREAM = GetCommanderHandle[].out;
explored: Table = RedBlackTree.Create[IdGetKey, CompareRefs];
inStack: Table = RedBlackTree.Create[IdGetKey, CompareRefs];
stack: SubgoalList ← NIL;
PrintSubgoal:
PROC [sg: Subgoal] = {
WITH sg.parent
SELECT
FROM
nWork: NWork => out.PutF["\t%g\n", IO.rope[nWork.goal.name]];
cWork: CWork => out.PutF["\t%g\n", IO.rope[cWork.c.cmd]];
ENDCASE => ERROR;
};
ExploreLockouts:
PROC [lockedOuts: LockoutList] = {
lockedOuts ← lockedOuts;
FOR lockedOuts ← lockedOuts, lockedOuts.rest
WHILE lockedOuts #
NIL
DO
Recurse[lockedOuts.first.sg];
ENDLOOP;
lockedOuts ← lockedOuts;
};
Recurse:
PROC [sg: Subgoal] = {
IF explored.Lookup[sg] # NIL THEN RETURN;
IF inStack.Lookup[sg] #
NIL
THEN {
out.PutRope["Found cycle:\n"];
PrintSubgoal[sg];
FOR sl: SubgoalList ← stack, sl.rest
WHILE sl #
NIL
DO
PrintSubgoal[sl.first];
ENDLOOP;
out.PutRope["\n"];
RETURN;
};
inStack.Insert[sg, sg];
stack ← CONS[sg, stack];
IF sg.caller # NIL THEN Recurse[sg.caller];
IF sg.locked #
NIL
THEN {
WITH sg.locked
SELECT
FROM
nWork: NWork => ExploreLockouts[nWork.goal.lockedOuts];
cWork: CWork => ExploreLockouts[cWork.c.lockedOuts];
ENDCASE => ERROR;
};
stack ← stack.rest;
IF Delete[inStack, sg] # sg THEN ERROR;
explored.Insert[sg, sg];
};
ExploreSubgoal:
PROC [data:
REF
ANY]
RETURNS [stop:
BOOL ←
FALSE]
--RedBlackTree.EachNode-- = {
sg: Subgoal = NARROW[data];
Recurse[sg];
};
ExploreQueue:
PROC [ass: ActiveSubgoalState] = {
queues[ass].EnumerateIncreasing[ExploreSubgoal];
};
out.PutRope["MakeDo is deadlocked!\n"];
out.PutRope["...searching for dependecy cycles...\n"];
out.Flush[];
ExploreQueue[waitForLocks];
ExploreQueue[waitForRecursion];
ExploreQueue[waitForTail];
out.PutRope["...dependency cycle search over ... aborting\n"];
ERROR ABORTED;
};
GetCP:
PROC
RETURNS [cp: CedarProcess.Process] = {
cp ← NARROW[List.Assoc[$CedarProcess, ProcessProps.GetPropList[]]];
};
NewWorkTable:
PUBLIC
PROC
RETURNS [t: Table] = {
t ← RedBlackTree.Create[IdGetKey, CompareRefs];
};
InsertWork:
PUBLIC
PROC [t: Table, w: WorkRef] = {
t.Insert[w, w];
};
Delete:
PROC [t: Table, ra:
REF
ANY]
RETURNS [found:
REF
ANY] = {
n: RedBlackTree.Node ← t.Delete[ra];
found ← IF n # NIL THEN n.data ELSE NIL;
};
QueueSizes: TYPE = ARRAY ActiveSubgoalState OF INT;
GetSizes:
PROC
RETURNS [qs: QueueSizes] = {
FOR ass: ActiveSubgoalState
IN ActiveSubgoalState
DO
qs[ass] ← queues[ass].Size[];
ENDLOOP;
};
SearchQueues:
PROC [n: Node ←
NIL, c: Command ←
NIL]
RETURNS [sl: SubgoalList] = {
sl ← NIL;
FOR ass: ActiveSubgoalState
IN ActiveSubgoalState
DO
t: Table ← queues[ass];
PerSubgoal:
PROC [data:
REF
ANY]
RETURNS [stop:
BOOL ←
FALSE]
--RedBlackTree.EachNode-- = {
sg: Subgoal ← NARROW[data];
IF sg.parent #
NIL
THEN
WITH sg.parent
SELECT
FROM
cWork: CWork => IF cWork.c = c THEN sl ← CONS[sg, sl];
nWork: NWork => IF nWork.goal = n THEN sl ← CONS[sg, sl];
ENDCASE => ERROR;
};
t.EnumerateIncreasing[PerSubgoal];
ENDLOOP;
sl ← sl;
};
PrintQueue:
PROC [ass: ActiveSubgoalState, to:
IO.
STREAM] = {
i: INT ← 0;
PerSubgoal:
PROC [data:
REF
ANY]
RETURNS [stop:
BOOL ←
FALSE]
--RedBlackTree.EachNode-- = {
sg: Subgoal ← NARROW[data];
to.PutF[
"%g: %g\n",
IO.int[i],
IO.rope[
IF sg.parent =
NIL
THEN
NIL
ELSE
WITH sg.parent
SELECT
FROM
cWork: CWork => cWork.c.cmd,
nWork: NWork => nWork.goal.name,
ENDCASE => ERROR
]
];
};
queues[ass].EnumerateIncreasing[PerSubgoal];
};
CompareBPs:
PROC [k, data:
REF
ANY]
RETURNS [c: Basics.Comparison]
--RedBlackTree.Compare-- = {
bp1: BasicProcess ← NARROW[k];
bp2: BasicProcess ← NARROW[data];
k1: CARDINAL ← LOOPHOLE[bp1^];
k2: CARDINAL ← LOOPHOLE[bp2^];
c ←
SELECT k1
FROM
< k2 => less,
= k2 => equal,
> k2 => greater,
ENDCASE => ERROR;
};
Start:
PROC = {
TRUSTED {
cp: Process.ConditionPointer = @processingChange;
Process.InitializeCondition[cp, Process.SecondsToTicks[60]];
Process.EnableAborts[cp];
};
Commander.Register[key: helpBase, proc: HelpMakeDo, doc: "Used by MakeDo to fork processes; not for public consumption."];
};
Start[];
END.