
    <<DebugTool.mesa>>
        <<Cedar Debugger:  global control and access to process facilities>>
        <<Copyright © 1984 by Xerox Corporation.  All rights reserved.>>
        <<Andrew Birrell, October 25, 1983 12:37 pm>>
        <<Russ Atkinson, March 5, 1985 7:33:42 pm PST>>
        <<Paul Rovner, April 14, 1983 3:53 pm>>

    DIRECTORY
        AMEvents USING [BootedNotifier, Kill, StopEvents, GetEvents, RegisterBootedNotifier, Screen, UnRegisterBootedNotifier ],
        AMModel USING [Class, Context, ContextClass, ContextChildren, ContextName, ContextWorld, MostRecentNamedContext, RootContext],
        AMProcess USING [Adjust, CallDebugger, Freeze, GetProcesses, GetState, Name, Process, PSBIToTV, State, Thaw, TVToPSBI],
        AMTypes USING [ DynamicParent, Error, TV],
        Atom USING [ GetPName ],
        Buttons USING [ Button, ButtonProc, Create, Destroy, ReLabel, SetDisplayStyle ],
        Commander USING [ CommandProc, Register ],
        Containers USING [ ChildXBound, ChildYBound, Create ],
        EndOps USING [Register],
        IO USING [EndOf, EndOfStream, Error, GetInt, GetTokenRope, PutChar, PutF, PutRope, RIS, RopeFromROS, ROS, STREAM, Value ],
        Labels USING [ Create ],
        MBQueue USING [ Create, CreateButton, Flush, Queue, QueueClientAction ],
        Process USING [ Abort, Detach ],
        PrincOps USING [ PsbIndex ],
        PrintTV USING [ Print, PrintArguments, PrintResults, PrintVariables ],
        Rope USING [ Cat, Equal, Length, ROPE ],
        Rules USING [ Create ],
        TypeScript USING [ Create ],
        ViewerClasses USING [ Viewer ],
        ViewerEvents USING [ EventProc, RegisterEventProc ],
        ViewerIO USING [ CreateViewerStreams ],
        ViewerOps USING [ DestroyViewer, OpenIcon, PaintViewer, SetOpenHeight ],
        ViewerTools USING [ GetContents, MakeNewTextViewer, SetContents, SetSelection],
        WorldVM USING [BadWorld, CurrentIncarnation, GetWorld, Incarnation, LocalWorld, LookupFailed, OtherWorld, World ];

    DebugTool: CEDAR MONITOR
        IMPORTS AMEvents, AMModel, AMProcess, AMTypes, Atom, Buttons, Commander, Containers, EndOps, IO, Labels, MBQueue, Process, PrintTV, 
        Rope, Rules, TypeScript, ViewerEvents, ViewerIO, ViewerOps, ViewerTools, WorldVM
        = {

        ROPE: TYPE = Rope.ROPE;
        STREAM: TYPE = IO.STREAM;


    <<******** Creation/Finding viewer for particular world ********>>

        <<Maintains at most one viewer for any world (destroying extras).  There are two interfaces: buttons in an existing viewer, or 
        userExec command line.  The synchronization is messy - it needs a rework someday.>>

        local: ATOM = $Local;
        outload: ATOM = $Outload;
        remote: ATOM = $Remote;
        viewers: LIST OF MyData _ NIL;

    Debug: Commander.CommandProc = {
        <<[cmd: Commander.Handle]>>
        arg: ROPE = cmd.commandLine;
        in: STREAM = IO.RIS[arg];
        token: ROPE _ NIL;
        token _ in.GetTokenRope[ ! IO.EndOfStream => CONTINUE].token;
        IF token.Length[] = 0 THEN token _ Atom.GetPName[local];
        GetWorldViewer[
            class: SELECT TRUE FROM
                token.Equal[Atom.GetPName[local],FALSE] => local,
                token.Equal[Atom.GetPName[outload],FALSE] => outload,
                ENDCASE => remote,
            worldName: token,
            prev: NIL];
        };

    ChangeWorld: SelectorNotifier = TRUSTED {
        d: MyData = NARROW[clientData];
        IF d.processes # NIL AND NOT DoThaw[d]
            THEN RETURN[FALSE]
            ELSE {
                UnWorld[d]; -- so nobody else expects us to have that world --
                GetWorldViewer[
                    class: value,
                    worldName: SELECT value FROM
                        local => Atom.GetPName[local],
                        outload => Atom.GetPName[outload],
                        ENDCASE => ViewerTools.GetContents[d.hostT],
                    prev: d];
                RETURN[TRUE]
                };
        };

    GetWorldViewer: PROC [class: ATOM, worldName: ROPE, prev: MyData] = {
        d: MyData;
        new: BOOL;
        [d, new] _ CheckExisting[worldName, prev];
        d.class _ class;
        IF new
            THEN IF d = prev
                THEN SetWorld[d]
                ELSE CreateForWorld[d]
            ELSE ViewerOps.OpenIcon[d.self];
        };

    FindViewer: ENTRY PROC [viewer: ViewerClasses.Viewer] RETURNS [d: MyData] = {
        FOR old: LIST OF MyData _ viewers, old.rest UNTIL old = NIL DO
            IF old.first.self = viewer THEN RETURN[old.first];
            ENDLOOP;
        RETURN[NIL]
        };

    CheckExisting: ENTRY PROC [worldName: ROPE, prev: MyData] RETURNS [found: MyData, new: BOOL] = TRUSTED {
        FOR old: LIST OF MyData _ viewers, old.rest UNTIL old = NIL DO
            IF NOT old.first.self.destroyed AND worldName.Equal[old.first.worldName, FALSE] THEN {
                found _ old.first;
                new _ FALSE;
                EXIT
                };
            REPEAT FINISHED => {
                IF prev # NIL
                    THEN { found _ prev; found.worldName _ worldName; found.world _ NIL }
                    ELSE {
                        found _ NEW[MyDataObject _ [worldName: worldName]];
                        found.action _ NEW[ProcessActions _ ALL[FALSE]];
                        viewers _ CONS[first: found, rest: viewers];
                        };
                new _ TRUE;
                }
            ENDLOOP;
        IF prev # NIL AND found # prev THEN
            Process.Detach[FORK ViewerOps.DestroyViewer[prev.self]];
        };

    DestroyProc: ViewerEvents.EventProc = TRUSTED {
        <<PROC [viewer: ViewerClasses.Viewer, event: ViewerEvents.ViewerEvent]>>
        d: MyData = FindViewer[viewer];
        IF d # NIL THEN {
            MBQueue.Flush[d.mbQueue];
            StopFinding[d];
            MBQueue.QueueClientAction[d.mbQueue, UnWorld, d];
            };
        };

    GiveUpFinding: Buttons.ButtonProc = TRUSTED {
        <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
            <<NOTE: this button is not serialized with d.mbQueue, but with the Viewers notifier>>
        d: MyData = NARROW[clientData];
        MBQueue.Flush[d.mbQueue];
        StopFinding[d];
        MBQueue.QueueClientAction[d.mbQueue, UnWorld, d];
        };

    UnWorld: PROC [clientData: REF ANY] = TRUSTED {
        d: MyData = NARROW[clientData];
        d.worldName _ NIL; -- should be inside the monitor, really --
        IF d.finding THEN ERROR;
        AMEvents.UnRegisterBootedNotifier[BootedNotifier, d.world, d];
        IF d.class = remote
        THEN AMEvents.StopEvents[d.world];
        };

    SetWorld: PROC [d: MyData] = TRUSTED {
        out: STREAM _ d.out;
        worldName: ROPE = d.worldName;
        d.self.name _ Rope.Cat["Debug ", worldName];
        ViewerOps.PaintViewer[d.self, caption];
        SELECT d.class FROM
            local => out.PutRope["\n\nPreparing to debug local world ..."];
            outload => out.PutRope["\n\nOpening debuggee outload file ..."];
            ENDCASE => out.PutF["\n\nConnecting to remote debuggee \"%g\" ... ", [rope[worldName]] ];
        IF StartFinding[d] THEN {
            <<Fork it, so that it can be aborted>>
            IF d.class = remote
                THEN {
                    giveUpButton: ViewerClasses.Viewer = Buttons.Create[
                        info: [name: "Click here to give up connection attempt", parent: d.self, border: TRUE,
                            wy: d.kidsY+d.buttH, wx: d.maxW],
                        proc: GiveUpFinding,
                        clientData: d,
                        fork: FALSE];
                    d.world _ JOIN d.finder;
                    ViewerOps.DestroyViewer[giveUpButton];
                    }
                ELSE d.world _ JOIN d.finder;
            };
        IF NOT d.self.destroyed THEN {
            IF d.world = NIL
            THEN {
                SELECT d.class FROM
                    local => out.PutRope["failed!"];
                    outload => out.PutRope["there is no outloaded debuggee"];
                    remote => out.PutF["can't contact \"%g\"", [rope[worldName]] ];
                    ENDCASE => ERROR;
                }
            ELSE {
                out.PutRope["ok"];
                d.rootContext _ AMModel.RootContext[d.world];
                AMEvents.RegisterBootedNotifier[proc: BootedNotifier, world: d.world, clientData: d];
                };
            };
        };

    StartFinding: ENTRY PROC [d: MyData] RETURNS [BOOL] = TRUSTED {
        IF d.self.destroyed THEN RETURN[FALSE]; -- else don't do it: we wouldn't get aborted --
        d.finder _ FORK Finder[d]; d.finding _ TRUE;
        RETURN[TRUE]
        };

    StopFinding: ENTRY PROC [d: MyData] = TRUSTED {
        IF d.finding THEN Process.Abort[LOOPHOLE[d.finder]];
        };

    Found: ENTRY PROC [d: MyData] = { d.finding _ FALSE };

    Finder: PROC [d: MyData] RETURNS [world: WorldVM.World _ NIL] = TRUSTED{
        world _ WorldVM.GetWorld[d.worldName
            ! WorldVM.LookupFailed, WorldVM.BadWorld, ABORTED => CONTINUE];
        IF world # NIL THEN
            AMEvents.GetEvents[world, NIL, NIL ! ABORTED => { world _ NIL; CONTINUE }];
        Found[d];
        };

    <<******** Commands for viewer watching particular world ********>>

    FreezeAll: Buttons.ButtonProc = TRUSTED {
        <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        d: MyData = NARROW[clientData];
        IF d.rootContext # NIL AND d.world # WorldVM.LocalWorld[]
            THEN {
                d.out.PutRope["\n\nFreeze all processes ... "];
                Merge[d, AMProcess.GetProcesses[LIST[d.rootContext]]];
                }
            ELSE d.out.PutRope["\n\nYou don't really want to freeze the entire local world!"];
        };

    FreezeReady: Buttons.ButtonProc = TRUSTED {
        <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        d: MyData = NARROW[clientData];
        IF d.rootContext # NIL AND d.world # WorldVM.LocalWorld[]
            THEN {
                states: LIST OF AMProcess.State;
                SELECT TRUE FROM
                    shift, control => {
                        states _ LIST[waitingML, frameFault, pageFault, writeProtectFault, unknownFault];
                        d.out.PutRope["\n\nFreeze \"waitingML\" and \"faulted\" processes ... "];
                        };
                    ENDCASE => {
                        states _ LIST[ready];
                        d.out.PutRope["\n\nFreeze \"ready\" processes ... "];
                        };
                Merge[d, AMProcess.GetProcesses[LIST[d.rootContext], states]];
                }
            ELSE d.out.PutRope["\n\nYou don't really want to freeze the entire local world!"];
        };

    FreezePSBI: Buttons.ButtonProc = TRUSTED {
        <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        d: MyData = NARROW[clientData];
        IF d.rootContext # NIL
            THEN {
                psbiRope: ROPE = ViewerTools.GetContents[d.psbiT];
                in: STREAM = IO.RIS[psbiRope];
                psbi: INT = in.GetInt[! IO.EndOfStream, IO.Error => GOTO bad];
                IF NOT in.EndOf[] OR psbi NOT IN PrincOps.PsbIndex
                    THEN GOTO bad
                    ELSE {
                        p: AMProcess.Process = AMProcess.PSBIToTV[d.world, psbi];
                        d.out.PutF["\n\nFreeze process %b ... ", [integer[psbi]] ];
                        AMProcess.Freeze[LIST[p], LIST[d.rootContext]];
                        Merge[d, LIST[p]];
                        };
                EXITS bad => d.out.PutRope["\n\nNot a valid PSB index!"]
                }
            ELSE d.out.PutRope["\n\nNo world!"];
        };

    FreezeContext: Buttons.ButtonProc = TRUSTED {
        <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        d: MyData = NARROW[clientData];
        CheckContext[d];
        IF d.context # NIL THEN {
            IF (d.world # WorldVM.LocalWorld[] OR AMModel.ContextClass[d.context.first] # world)
                THEN {
                    new: LIST OF AMProcess.Process;
                    d.out.PutF["\n\nFreeze processes inside \"%g\" ... ", [rope[d.contextName]] ];
                    new _ AMProcess.GetProcesses[d.context];
                    IF mouseButton = blue THEN AMProcess.Adjust[new, LIST[d.rootContext]];
                    Merge[d, new];
                    }
                ELSE d.out.PutRope["\n\nYou don't really want to freeze the entire local world!"];
            };
        };

    Merge: PROC [d: MyData, new: LIST OF AMProcess.Process] = TRUSTED {
        newOne: LIST OF AMProcess.Process _ new;
        oldOne: LIST OF AMProcess.Process _ d.processes;
        prevOld: LIST OF AMProcess.Process _ NIL;
        first: BOOL _ TRUE;
        d.out.PutRope["additional frozen processes: "];
        <<Merge in new processes.  Assumes both lists are sorted -->>
        DO
            oldBits: CARDINAL = IF oldOne = NIL
                THEN LAST[CARDINAL]
                ELSE AMProcess.TVToPSBI[oldOne.first].psbi;
            newBits: CARDINAL;
            IF newOne = NIL THEN EXIT;
            newBits _ AMProcess.TVToPSBI[newOne.first].psbi;
            SELECT TRUE FROM
                newBits < oldBits => {
                    this: LIST OF AMProcess.Process = newOne;
                    IF first THEN first _ FALSE ELSE d.out.PutRope[", "];
                    d.out.PutF["%b", [integer[newBits]] ];
                    newOne _ newOne.rest;
                    this.rest _ oldOne;
                    IF prevOld = NIL
                    THEN d.processes _ this
                    ELSE prevOld.rest _ this;
                    prevOld _ this;
                    };
                newBits = oldBits =>
                    newOne _ newOne.rest;
                newBits > oldBits => { prevOld _ oldOne; oldOne _ oldOne.rest };
                ENDCASE => ERROR;
            ENDLOOP;
        IF first THEN d.out.PutRope["none"];
        CreateButtons[d];
        };

    BootedNotifier: AMEvents.BootedNotifier = {
        <<PROC[world: WorldVM.World, clientData: REF]>>
        d: MyData = NARROW[clientData];
        MBQueue.Flush[d.mbQueue];
        StopFinding[d];
        MBQueue.QueueClientAction[d.mbQueue, CleanupButtons, d];
        };

    CleanupButtons: PROC [clientData: REF ANY] = TRUSTED {
        d: MyData = NARROW[clientData];
        d.out.PutRope["\n\n~~~~~~ End of session ~~~~~~"];
        d.processes _ NIL;
        d.action _ NEW[ProcessActions _ ALL[FALSE]];
        CreateButtons[d];
        };

    ThawAll: Buttons.ButtonProc = {
    <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        [] _ DoThaw[clientData];
        };

    DoThaw: PROC [clientData: REF ANY] RETURNS [BOOL] = TRUSTED {
        d: MyData = NARROW[clientData];
        count: INT = CountActions[d];
        d.out.PutRope["\n\nThaw all processes ... "];
        IF count # 0
        THEN d.out.PutF["there are still %g action areas for frozen processes", [integer[count]] ]
        ELSE {
            AMProcess.Thaw[d.processes];
            d.processes _ NIL;
            CreateButtons[d];
            d.out.PutRope["done"];
            };
        RETURN[count=0]
        };

    ListLoadstate: Buttons.ButtonProc = TRUSTED {
        <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        d: MyData = NARROW[clientData];
        Enum: PROC [c: AMModel.Context] RETURNS [stop: BOOL _ FALSE] = TRUSTED
            {
            d.out.PutChar['\n];
            d.out.PutRope[AMModel.ContextName[c]];
            };
        d.out.PutRope["\n\nLoadstate:"];
        [] _ AMModel.ContextChildren[d.rootContext, Enum];
        d.out.PutRope["\nEnd of loadstate"];
        };

    ListContext: Buttons.ButtonProc = TRUSTED {
        <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        d: MyData = NARROW[clientData];
        level: INT _ 0;
        Enum: PROC [c: AMModel.Context] RETURNS [stop: BOOL _ FALSE] = TRUSTED {
            class: AMModel.Class = AMModel.ContextClass[c];
            d.out.PutChar['\n];
            THROUGH [1..level] DO d.out.PutRope["  "] ENDLOOP;
            d.out.PutRope[AMModel.ContextName[c]];
            IF class = model
            THEN { level _ level+1; [] _ AMModel.ContextChildren[c, Enum]; level _ level-1 };
            };
        CheckContext[d];
        IF d.context # NIL THEN {
            d.out.PutF["\n\nContext \"%g\":", [rope[d.contextName]] ];
            IF AMModel.ContextClass[d.context.first] = prog
            THEN [] _ Enum[d.context.first]
            ELSE [] _ AMModel.ContextChildren[d.context.first, Enum];
            d.out.PutRope["\nEnd of context"];
            };
        };

    UserScreen: Buttons.ButtonProc = TRUSTED {
        <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        d: MyData = NARROW[clientData];
        Process .Detach[FORK AMEvents.Screen[d.world] ];
        };

    Continue: Buttons.ButtonProc = TRUSTED {
        <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        d: MyData = NARROW[clientData];
        d.out.PutRope["\n\nNot implemented"];
        };

    Kill: Buttons.ButtonProc = TRUSTED {
        <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        d: MyData = NARROW[clientData];
        Process.Detach[FORK AMEvents.Kill[d.world] ];
        };

    Stop: Buttons.ButtonProc = TRUSTED {
        <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        d: MyData = NARROW[clientData];
        d.stopCount _ d.stopCount + 1;
        };

    ProcessRec: TYPE = RECORD [d: MyData, p: AMProcess.Process, button: Buttons.Button];

    ThawThis: Buttons.ButtonProc = TRUSTED {
        <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        pData: REF ProcessRec = NARROW[clientData];
        d: MyData = pData.d;
        IF CheckAction[d.action, pData]
        THEN {
            ENABLE UNWIND => EndAction[d.action, pData];
            AMProcess.Thaw[LIST[pData.p]];
            Buttons.ReLabel[pData.button, "thawed"];
            EndAction[d.action, pData];
            }
        ELSE d.out.PutF["\n\n%g still has an action area", [rope[AMProcess.Name[pData.p]]] ];
        };

    AdjustThis: Buttons.ButtonProc = TRUSTED {
        <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        pData: REF ProcessRec = NARROW[clientData];
        d: MyData = pData.d;
        IF CheckAction[d.action, pData]
            THEN {
                ENABLE UNWIND => EndAction[d.action, pData];
                IF mouseButton = blue
                THEN {
                    AMProcess.Adjust[LIST[pData.p], LIST[d.rootContext]];
                    Buttons.ReLabel[pData.button, ProcessLabel[pData.p].label];
                    }
                ELSE {
                    CheckContext[d];
                    IF d.context # NIL
                    THEN {
                        AMProcess.Adjust[LIST[pData.p], d.context];
                        Buttons.ReLabel[pData.button, ProcessLabel[pData.p].label];
                        };
                    };
                EndAction[d.action, pData];
                }
            ELSE d.out.PutF["\n\n%g still has an action area", [rope[AMProcess.Name[pData.p]]] ];
        };

    DebugThis: Buttons.ButtonProc = TRUSTED {
        <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        pData: REF ProcessRec = NARROW[clientData];
        d: MyData = pData.d;
        label: ROPE;
        stack: AMTypes.TV;
        [label, stack] _ ProcessLabel[pData.p]; Buttons.ReLabel[pData.button, label];
        IF mouseButton = blue
            THEN {
                IF CheckAction[d.action, pData]
                THEN Process.Detach[FORK DoAction[d.action, pData] ]
                ELSE d.out.PutF["\n\n%g already has an action area", [rope[AMProcess.Name[pData.p]]] ];
                }
            ELSE {
                d.out.PutF["\n\n%g:", [rope[AMProcess.Name[pData.p]]] ];
                Process.Detach[FORK PutStack[d, stack, FALSE --mouseButton=yellow??--] ];
                };
        };

    CountActions: ENTRY PROC [d: MyData] RETURNS [count: INT _ 0] = {
        FOR psbi: PrincOps.PsbIndex IN PrincOps.PsbIndex
        DO IF d.action[psbi] THEN count _ count+1 ENDLOOP;
        };

    CheckAction: ENTRY PROC [action: REF ProcessActions, pData: REF ProcessRec] RETURNS [BOOL] = TRUSTED {
        psbi: PrincOps.PsbIndex = AMProcess.TVToPSBI[pData.p].psbi;
        IF action[psbi] THEN RETURN[FALSE] ELSE { action[psbi] _ TRUE; RETURN[TRUE] }
        };

    EndAction: ENTRY PROC [action: REF ProcessActions, pData: REF ProcessRec] = TRUSTED { action[AMProcess.TVToPSBI[pData.p].psbi] _ 
    FALSE };

    DoAction: PROC [action: REF ProcessActions, pData: REF ProcessRec] = TRUSTED {
        ENABLE UNWIND => EndAction[action, pData];
        Buttons.SetDisplayStyle[pData.button, $WhiteOnBlack];
        AMProcess.CallDebugger[pData.p, ProcessLabel[pData.p].label];
        Buttons.SetDisplayStyle[pData.button, $BlackOnWhite];
        EndAction[action, pData];
        };

    ProcessLabel: PROC [p: AMProcess.Process] RETURNS [label: ROPE, stack: AMTypes.TV] = TRUSTED {
        str: STREAM = IO.ROS[];
        state: AMProcess.State;
        faultData: LONG CARDINAL;
        priority: [0..7];
        topFrame: BOOL;
        [state, faultData, priority, stack, topFrame] _ AMProcess.GetState[p];
        IF stack = NIL THEN str.PutF["no frozen frame"] ELSE PrintTV.Print[stack, str];
        str.PutF[IF topFrame THEN ", %g" ELSE ", (%g)", [rope[StateRope[state]]] ];
        IF state IN [frameFault..unknownFault]
        THEN str.PutF["[%b]", [cardinal[faultData]] ];
        str.PutF[", %g", [integer[priority]]];
        label _ str.RopeFromROS[];
        };

    PutStack: PROC [d: MyData, top: AMTypes.TV, vars: BOOL] = {
        ENABLE UNWIND => d.out.PutRope["\n ~~~ Unwound ~~~"];
        out: STREAM _ d.out;
        initStopCount: INT _ d.stopCount;
        FOR this: AMTypes.TV _ top, AMTypes.DynamicParent[this] UNTIL this = NIL
        DO 
            IF d.stopCount # initStopCount
            THEN { out.PutRope["\n  ~~~ Display stopped ~~~"]; RETURN };
            PutProc[d, this, vars]
            ENDLOOP;
        out.PutRope["\n  ~~~ End of stack ~~~"];
        };

    PutProc: PROC [d: MyData, l: AMTypes.TV, vars: BOOL] = {
        ENABLE AMTypes.Error => { IO.PutF[d.out, "\nAMTypes.Error[%g]", [rope[msg]] ]; CONTINUE };
        out: STREAM _ d.out;
        initStopCount: INT _ d.stopCount;
        out.PutRope["\n  Procedure: "]; PrintTV.Print[l, out];
        IF vars THEN {
            out.PutRope["\nArgs:\n"]; PrintTV.PrintArguments[l, out];
            out.PutRope["\nVars:\n"]; PrintTV.PrintVariables[l, out];
            out.PutRope["\nResults:\n"]; PrintTV.PrintResults[l, out];
            };
        };

    StateRope: PROC [state: AMProcess.State] RETURNS [ ROPE ] = {
        RETURN[ SELECT state FROM
            ready => "ready",
            waitingSV => "waitingSV",
            waitingCV => "waitingCV",
            waitingML => "waitingML",
            frameFault => "frameFault",
            pageFault => "pageFault",
            writeProtectFault => "writeProtectFault",
            unknownFault => "unknownFault",
            uncaughtSignal => "uncaughtSignal",
            breakpoint => "breakpoint",
            callDebugger => "callDebugger",
            dead => "dead",
            unknown => "unknown",
            ENDCASE => "illegal state!"]
        };


    CheckContext: PROC [d: MyData] = TRUSTED {
        contextName: ROPE = ViewerTools.GetContents[d.contextT];
        IF NOT Rope.Equal[contextName, d.contextName, FALSE]
        OR d.context = NIL
        OR d.world # AMModel.ContextWorld[d.context.first]
        OR d.contextIncarnation # WorldVM.CurrentIncarnation[d.world]
        THEN {
            new: AMModel.Context;
            d.context _ NIL;
            d.contextIncarnation _ WorldVM.CurrentIncarnation[d.world]; 
            new _ SELECT TRUE FROM
                d.world = NIL => NIL,
                Rope.Length[contextName] = 0 => d.rootContext
                ENDCASE => AMModel.MostRecentNamedContext[contextName, d.rootContext];
            IF new # NIL THEN { d.context _ LIST[new]; d.contextName _ contextName };
            };
        IF d.context = NIL THEN d.out.PutRope["\n\nInvalid context"];
        };


    <<******** Viewer management ********>>

    MyData: TYPE = REF MyDataObject;

    MyDataObject: TYPE = MONITORED RECORD[
        in: STREAM,
        out: STREAM,
        mbQueue: MBQueue.Queue _ NIL,
        self,
        kids,
        hostT,
        contextT,
        psbiT,
        script: ViewerClasses.Viewer _ NIL,
        kidsY: INTEGER _ 0,
        finding: BOOL _ FALSE,
        stopCount: INT _ 0,
        finder: UNSAFE PROCESS RETURNS [WorldVM.World] _ NIL,
        worldName: ROPE,
        class: ATOM _ local,
        value: REF ATOM _ NIL,
        world: WorldVM.World _ NIL,
        rootContext: AMModel.Context _ NIL,
        contextName: ROPE _ NIL,
        contextIncarnation: WorldVM.Incarnation _ 0,
        context: LIST OF AMModel.Context _ NIL,
        processes: LIST OF AMProcess.Process _ NIL,
        action: REF ProcessActions,
        pButtons: LIST OF REF ProcessRec _ NIL,
        maxW: INTEGER _ 0,
        buttH: INTEGER _ 0,
        kidsH: INTEGER _ 0];

    ProcessActions: TYPE = ARRAY PrincOps.PsbIndex OF BOOL;

    CreateForWorld: PROC [d: MyData] = {
        d.mbQueue _ MBQueue.Create[];
        MBQueue.QueueClientAction[d.mbQueue, ReallyCreate, d];
        };

    ReallyCreate: PROC [clientData: REF ANY] = {
        <<This is a separate procedure so that it is synchronized with d.mbQueue -->>
        <<Thus, the buttons can't be invoked until we've finished creating them, and called SetWorld.>>
        d: MyData = NARROW[clientData];
        v: ViewerClasses.Viewer = Containers.Create[
            info: [name: "Debug processes", column: left, scrollable: FALSE, iconic: TRUE]];
        child: ViewerClasses.Viewer _ NIL;
        x: INTEGER _ 1;
        y: INTEGER _ 0;
        CommandButton: PROC [name: ROPE, proc: Buttons.ButtonProc, data: REF ANY, newline: BOOL, guarded: BOOL _ FALSE] = {
            child _ MBQueue.CreateButton[
                q: d.mbQueue,
                info: [name: name, parent: v, border: TRUE,
                    wy: y, wx: x, ww: d.maxW],
                proc: proc,
                clientData: data,
                fork: TRUE,
                paint: TRUE,
                guarded: guarded];
            x _ IF newline THEN 1 ELSE child.wx + d.maxW - 1;
            y _ IF newline THEN child.wy + child.wh - 1 ELSE child.wy;
            };
        LabelText: PROC [name, data: ROPE, prev: ViewerClasses.Viewer] RETURNS [ViewerClasses.Viewer] = {
            child _ ViewerTools.MakeNewTextViewer[
                info: [parent: v, wh: d.buttH, ww: 999, scrollable: FALSE,
                    data: IF prev = NIL THEN data ELSE ViewerTools.GetContents[prev],
                    border: FALSE,
                    wx: x + d.maxW + 2, wy: y],
                paint: TRUE ];
            Containers.ChildXBound[v, child];
            [] _ Buttons.Create[
                info: [name: name, parent: v, wh: d.buttH, border: FALSE, wx: x+1, wy: y],
                proc: TextLabelProc, clientData: child, fork: FALSE, paint: TRUE];
            x _ 1;
            y _ child.wy + child.wh - 1;
            RETURN[child]
            };
        Label: PROC [name: ROPE, newline: BOOL] = {
            child _ Labels.Create[
                info: [name: name, parent: v, border: FALSE, wy: y, wx: x+1],
                paint: TRUE ];
            x _ IF newline THEN 1 ELSE child.wx + d.maxW - 1;
            y _ IF newline THEN child.wy + child.wh - 1 ELSE child.wy;
            };
        Rule: PROC = {
            child _ Rules.Create[
                info: [parent: v, border: FALSE, wy: y, wx: 0, ww: v.ww, wh: 1],
                paint: TRUE ];
            Containers.ChildXBound[v, child];
            x _ 1;
            y _ child.wy + child.wh + 1;
            };
        d.self _ v;
        {
            <<kludge to find max button size! -->>
            temp: Buttons.Button = Buttons.Create[
                info: [name: "Loadstate:", parent: v, border: FALSE, wx: 0, wy: 0],
                proc: NIL, clientData: d, fork: FALSE, paint: FALSE];
            d.maxW _ temp.ww;
            d.buttH _ temp.wh;
            Buttons.Destroy[temp];
            };
        [child, d.value] _ CreateSelector[q: d.mbQueue,
            name: "World:", values: LIST[local, outload, remote],
            init: NEW[ATOM_d.class],
            change: ChangeWorld,
            clientData: d, viewer: v, x: x, y: y, w: d.maxW];
        x _ child.wx + child.ww + 2;
        x _ 1 + 5*(d.maxW-1);
        d.hostT _ LabelText["Host:",
            IF d.class # remote THEN "Remote debuggee host name" ELSE d.worldName,
            d.hostT];
        Label["Freeze:", FALSE];
        CommandButton["All", FreezeAll, d, FALSE];
        CommandButton["Ready", FreezeReady, d, FALSE] ;
        CommandButton["Process", FreezePSBI, d, FALSE];
        CommandButton["Context", FreezeContext, d, FALSE];
        d.contextT _ LabelText["Context:", "Module or config name", d.contextT];
        Label["Thaw:", FALSE];
        CommandButton["All", ThawAll, d, FALSE];
        x _ 1 + 5*(d.maxW-1);
        d.psbiT _ LabelText["PsbIndex:", "Freezing an explicit process", d.psbiT];
        Label["List:", FALSE];
        CommandButton["Loadstate", ListLoadstate, d, FALSE];
        CommandButton["Context", ListContext, d, FALSE];
        x _ 1 + 5*(d.maxW-1);
        Label["Control:", FALSE];
        CommandButton["Stop", Stop, d, FALSE];
        CommandButton["Kill", Kill, d, FALSE, TRUE];
        <<CommandButton["Continue", Continue, d, FALSE];>>
        CommandButton["Screen", UserScreen, d, TRUE];
        y _ y + 3;
        Rule[];
        d.kidsY _ y;
        y _ y + (d.kidsH _ 10*(d.buttH-1) + d.buttH/2);
        Rule[];
        d.script _ TypeScript.Create[
            info: [parent: v, wh: v.ch-y, ww: v.cw, border: FALSE, wy: y, wx: 0] ];
        Containers.ChildXBound[v, d.script];
        Containers.ChildYBound[v, d.script];
        [in: d.in, out: d.out] _ ViewerIO.CreateViewerStreams[NIL, d.script];
        ViewerOps.SetOpenHeight[v, y + 10 * d.buttH];
        ViewerOps.OpenIcon[v];
        SetWorld[d];
        };

    CreateButtons: PROC [d: MyData] = TRUSTED {
        parent: ViewerClasses.Viewer = d.self;
        child: ViewerClasses.Viewer _ NIL;
        x: INTEGER _ 1;
        y: INTEGER _ 1;
        CommandButton: PROC [
            name: ROPE, proc: Buttons.ButtonProc, data: REF ANY, newline: BOOL] = TRUSTED {
            child _ MBQueue.CreateButton[
                q: d.mbQueue,
                info: [name: name, parent: kids, border: TRUE,
                    wy: y, wx: x, ww: IF newline THEN kids.cw - x - 2 ELSE d.maxW],
                proc: proc,
                clientData: data,
                fork: TRUE];
            x _ IF newline THEN 1 ELSE child.wx + d.maxW - 1;
            y _ IF newline THEN child.wy + child.wh - 1 ELSE child.wy;
            };
        Label: PROC [name: ROPE, newline: BOOL] = TRUSTED {
            child _ Labels.Create[
                info: [name: name, parent: kids, border: FALSE,
                    wy: y, wx: x+1] ];
            x _ IF newline THEN 1 ELSE child.wx + d.maxW - 1;
            y _ IF newline THEN child.wy + child.wh - 1 ELSE child.wy;
            };
        kids: ViewerClasses.Viewer = Containers.Create[
            info: [parent: parent, border: FALSE, scrollable: TRUE, wx: 0, wy: d.kidsY, ww: parent.cw, wh: d.kidsH] ];
        lastButton: LIST OF REF ProcessRec _ NIL;
        IF d.kids # NIL THEN ViewerOps.DestroyViewer[d.kids]; d.kids _ kids;
        Containers.ChildXBound[parent, kids];
        d.pButtons _ NIL;
        FOR p: LIST OF AMProcess.Process _ d.processes, p.rest UNTIL p = NIL DO
            pData: REF ProcessRec = NEW[ProcessRec _ [d, p.first]];
            Label[AMProcess.Name[p.first], FALSE];
            CommandButton["Adjust", AdjustThis, pData, FALSE];
            CommandButton["Thaw", ThawThis, pData, FALSE];
            CommandButton[NIL, DebugThis, pData, TRUE];
            Containers.ChildXBound[kids, child];
            pData.button _ child;
            IF lastButton = NIL
                THEN d.pButtons _ lastButton _ CONS[first: pData, rest: NIL]
                ELSE { lastButton.rest _ CONS[first: pData, rest: NIL]; lastButton _ lastButton.rest };
            ENDLOOP;
        FOR b: LIST OF REF ProcessRec _ d.pButtons, b.rest UNTIL b = NIL DO
            Buttons.ReLabel[b.first.button, ProcessLabel[b.first.p].label];
            ENDLOOP; 
        };

    TextLabelProc: Buttons.ButtonProc = {
        <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        text: ViewerClasses.Viewer = NARROW[clientData];
        SELECT mouseButton FROM
            red => ViewerTools.SetSelection[text, NIL];
            blue => { ViewerTools.SetContents[text, NIL]; ViewerTools.SetSelection[text, NIL] };
            yellow => NULL;
            ENDCASE => ERROR;
        };

    Selector: TYPE = REF SelectorRec;

    SelectorRec: TYPE = RECORD[
        value: REF ATOM,
        change: SelectorNotifier,
        clientData: REF ANY,
        buttons: LIST OF Buttons.Button,
        values: LIST OF ATOM ];

    SelectorNotifier: TYPE =
        PROC [parent: ViewerClasses.Viewer, clientData: REF ANY, value: ATOM] RETURNS [BOOL];

    CreateSelector: PROC [q: MBQueue.Queue, name: ROPE, values: LIST OF ATOM, init: REF ATOM _ NIL, change: SelectorNotifier _ NIL, 
    clientData: REF ANY _ NIL, viewer: ViewerClasses.Viewer, x, y: INTEGER, w: INTEGER _ 0] RETURNS [child: ViewerClasses.Viewer, 
    value: REF ATOM] = {
        selector: Selector _ NEW[ SelectorRec _ [
            value: IF init # NIL THEN init ELSE NEW[ATOM_values.first],
            change: change,
            clientData: clientData,
            buttons: NIL,
            values: values ] ];
        last: LIST OF Buttons.Button _ NIL;
        value _ selector.value;
        child _ Labels.Create[
            info: [name: name, parent: viewer, border: FALSE, wx: x+1, wy: y, ww: w] ];
        FOR a: LIST OF ATOM _ values, a.rest UNTIL a = NIL DO
            child _ MBQueue.CreateButton[
            q: q,
            info: [name: Atom.GetPName[a.first], parent: viewer, border: TRUE,
                wy: child.wy, wx: child.wx + child.ww - 1, ww: w],
            proc: SelectorProc,
            clientData: selector,
            fork: TRUE,
            paint: TRUE];
            IF last = NIL
                THEN last _ selector.buttons _ CONS[first: child, rest: NIL]
                ELSE { last.rest _ CONS[first: child, rest: NIL]; last _ last.rest };
            IF a.first = selector.value^ THEN Buttons.SetDisplayStyle[child, $WhiteOnBlack];
            ENDLOOP;
        };

    SelectorProc: Buttons.ButtonProc = {
    <<parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL>>
        self: Buttons.Button = NARROW[parent];
        selector: Selector = NARROW[clientData];
        buttons: LIST OF Buttons.Button _ selector.buttons;
        FOR a: LIST OF ATOM _ selector.values, a.rest UNTIL a = NIL DO
            IF self = buttons.first THEN {
                IF selector.change = NIL OR selector.change[self.parent, selector.clientData, a.first]
                THEN {
                    selector.value^ _ a.first;
                    Buttons.SetDisplayStyle[self, $WhiteOnBlack];
                    FOR others: LIST OF Buttons.Button _ selector.buttons, others.rest UNTIL others = NIL
                    DO IF others.first # self
                        THEN Buttons.SetDisplayStyle[others.first, $BlackOnWhite]
                    ENDLOOP;
                    };
                EXIT
                };
            buttons _ buttons.rest;
            ENDLOOP;
        };

    Init: PROC = {
        <<Open a tool on the outload world if there is one>>
        ENABLE WorldVM.BadWorld => CONTINUE;
        TRUSTED { [] _ WorldVM.OtherWorld[] };
        GetWorldViewer[outload, Atom.GetPName[outload], NIL];
        };


    <<START HERE>>

    [] _ ViewerEvents.RegisterEventProc[DestroyProc, destroy];

    Commander.Register[
        key: "Debug",
        proc: Debug,
        doc: "Tool for debugging processes and other worlds"];

    EndOps.Register[Init];

    }.