
    <<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];
                };
            waitForTail => {
                };
            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.