
    <<CDebugInterface.mesa >>
    <<Last Edited by: Sweet, February 11, 1986 11:25:16 am PST>>

    DIRECTORY
        Buttons USING [Button, ButtonProc, Create, SetDisplayStyle],
        CDebugDefs USING [Cmd, CmdIndex, DataRec, DoCommand, Handle, NumberCell],
        CodeDefs USING [CCInfoType],
        Commander USING [CommandProc, Handle, Register],
        Containers USING [ChildXBound, Create],
        Convert USING [CardFromWholeNumberLiteral, Error, RopeFromInt],
        IO USING [NUL, SP],
        Labels USING [Create],
        Menus USING [MouseButton],
        MessageWindow USING [Append],
        PrincOps USING [],
        RESOut USING [cancelAction, Complain],
        Rope USING [Concat, Fetch, Length, ROPE],
        Rules USING [Create, Rule],
        SafeStorage USING [NarrowFault],
        STDebugDefs USING [STDebugMisc, STDebugSymbols, STDebugTrees],
        VFonts USING [CharWidth, StringWidth],
        ViewerClasses USING [Viewer],
        ViewerEvents USING [EventProc, RegisterEventProc],
        ViewerIO USING [CreateViewerStreams, GetViewerFromStream],
        ViewerOps USING [AddProp, DestroyViewer, FetchProp, PaintViewer, SetOpenHeight],
        ViewerTools USING [GetContents, GetSelectionContents, MakeNewTextViewer, SetContents, SetSelection];
    CDebugInterface: CEDAR PROGRAM 
        IMPORTS 
            Buttons, Commander, Containers, Convert, CDebugDefs, Labels, MessageWindow, RESOut, Rope, Rules, SafeStorage, STDebugDefs, VFonts, 
            ViewerEvents, ViewerIO, ViewerOps, ViewerTools 
        EXPORTS CDebugDefs =
        BEGIN
        OPEN CDebugDefs;

        entryHeight: CARDINAL = 15;    -- how tall to make each line of items
        entryVSpace: CARDINAL = 2;     -- vertical leading space between lines
        entryHSpace: CARDINAL = 5;     -- min horizontal space between items in a line
        ROPE: TYPE = Rope.ROPE;

        PromptRec: TYPE = RECORD [handle: CDebugDefs.Handle, cell: ViewerClasses.Viewer, radix: INT _ 8];
        PromptHandle: TYPE = REF PromptRec;
        CmdRec: TYPE = RECORD [handle: CDebugDefs.Handle, cmd: CDebugDefs.CmdIndex];
        CmdHandle: TYPE = REF CmdRec;

        EnumItem: TYPE = RECORD [tag: ROPE, value: UNSPECIFIED];
        ERef: TYPE = REF UNSPECIFIED; -- can't figure out how to make generic safely
        EnumItemSeqRec: TYPE = RECORD [SEQUENCE count: CARDINAL OF EnumItem];
        EnumItemSeq: TYPE = REF EnumItemSeqRec;
        EnumRec: TYPE = RECORD [handle: CDebugDefs.Handle, choice: ViewerClasses.Viewer, choices: EnumItemSeq, showing: CARDINAL, eCell: 
        ERef];
        EnumHandle: TYPE = REF EnumRec;

        MakeTool: Commander.CommandProc = BEGIN
            rule: Rules.Rule;
            my: Handle _ NEW[DataRec];
            my.en _ VFonts.CharWidth['0]; -- width of 'n was too wide
            my.outer _ Containers.Create[[-- construct the outer container
                name: "CDebug commands",    -- name displayed in the caption
                iconic: FALSE,    -- so tool will be open when first created
                column: left,    -- initially in the left column
                guardDestroy: TRUE,
                scrollable: FALSE ]];    -- inhibit user from scrolling contents
            my.msg _ Labels.Create[ [
                name: NIL,
                wx: 0, wy: my.height,
                wh: 2*entryHeight,
                parent: my.outer,
                border: FALSE]];
            my.height _ my.height + 2*entryHeight + 2;    -- interline spacing
            Containers.ChildXBound[my.outer, my.msg];
            rule _ Rules.Create [[parent: my.outer, wy: my.height, ww: my.outer.cw, wh: 2]];
            Containers.ChildXBound[my.outer, rule];
            MakeCommands[my];
            <<rule _ Rules.Create [[parent: my.outer, wy: my.height, ww: my.outer.cw, wh: 2]];>>
            <<Containers.ChildXBound[my.outer, rule];>>
            <<my.height _ my.height + 2;    -- interline spacing>>
            my.charsOnLine _ 0;
            ViewerOps.AddProp[my.outer, $cdebugHandle, my];
            ViewerOps.SetOpenHeight[viewer: my.outer, clientHeight: my.height];
            ViewerOps.PaintViewer[viewer: my.outer, hint: all];
            [] _ ViewerEvents.RegisterEventProc[proc: DestroyTool, event: destroy, filter: my.outer];
            MakeTypescript[my];
            END;

        DestroyTool: ViewerEvents.EventProc = {
            <<[viewer: ViewerClasses.Viewer, event: ViewerEvents.ViewerEvent, before: BOOL] RETURNS [abort: BOOL _ FALSE]>>
            IF before THEN {
                h: Handle _ NARROW[ViewerOps.FetchProp[viewer, $cdebugHandle]];
                IF h = NIL OR h.outer # viewer THEN RETURN;
                h.dying _ TRUE;
                ViewerOps.DestroyViewer[h.ts]};
            };

        -- locations of the various fields
            Place: TYPE = RECORD [x, y: CARDINAL];
            TreeCol: CARDINAL = 0;
            RepCol: CARDINAL = TreeCol + 7;
            MTCol: CARDINAL = RepCol + 6;
            TempCol: CARDINAL = MTCol + 9;
            FirstCol: CARDINAL = TempCol + 14;
            BodyCol: CARDINAL = FirstCol + 13;
            FopCol: CARDINAL = BodyCol + 7;

            treePlace: Place = [x: TreeCol+0, y: 0];
            depthPlace: Place = [x: TreeCol+0, y: 1];
            linksPlace: Place = [x: TreeCol+0, y: 2];
            stopPlace: Place = [x: TreeCol+0, y: 3];

            repPlace: Place = [x: RepCol+0, y: 0];

            mdiPlace: Place = [x: MTCol+0, y: 0];
            htiPlace: Place = [x: MTCol+4, y: 0];
            ctiPlace: Place = [x: MTCol+0, y: 1];
            btiPlace: Place = [x: MTCol+4, y: 1];
            seiPlace: Place = [x: MTCol+0, y: 2];
            nextsePlace: Place = [x: MTCol+4, y: 2];
            sourcePlace: Place = [x: MTCol+0, y: 3];

            varPlace: Place = [x: TempCol+0, y: 0];
            vcompPlace: Place = [x: TempCol+5, y: 0];
            tempPlace: Place = [x: TempCol+0, y: 1];
            allStackPlace: Place = [x: TempCol+7, y: 1];
            stackPlace: Place = [x: TempCol+0, y: 2];
            tosPlace: Place = [x: TempCol+6, y: 2];
            downPlace: Place = [x: TempCol+0, y: 3];
            upPlace: Place = [x: TempCol+7, y: 3];

            asCCPlace: Place = [x: FirstCol+0, y: 0];
            curPlace: Place = [x: FirstCol+6, y: 0];
            rcntPlace: Place = [x: FirstCol+0, y: 1];
            fwdPlace: Place = [x: FirstCol+6, y: 1];
            prevPlace: Place = [x: FirstCol+0, y: 2];
            nextPlace: Place = [x: FirstCol+6, y: 2];
            firstPlace: Place = [x: FirstCol+0, y: 3];
            infoPlace: Place = [x: FirstCol+6, y: 3];


            fopPlace: Place = [x: FopCol+0, y: 0];
            mopPlace: Place = [x: FopCol+0, y: 1];
            lblPlace: Place = [x: FopCol+0, y: 2];
            liiPlace: Place = [x: FopCol+0, y: 3];

            bodyPlace: Place = [x: BodyCol+0, y: 0];
            stmtPlace: Place = [x: BodyCol+0, y: 1];
            exprPlace: Place = [x: BodyCol+0, y: 2];
            <<gFramesPlace: Place = [x: BodyCol+0, y: 3];>>


        MakeCommands: PROC [handle: Handle] = BEGIN    
            cmdy: INT = handle.height + entryVSpace;
            maxY: INT _ 0;

            MakeCmd: PROC [at: Place, name: ROPE, cmd: CDebugDefs.CmdIndex] = {
                b: Cmd _ Buttons.Create[
                    info: [
                        name: Rope.Concat[name, "!"], 
                        wx: at.x*handle.en,
                        wy: cmdy + at.y * (entryHeight + entryVSpace),
                        <<-- default the width so that it will be computed for us>>
                        wh: entryHeight,    -- specify rather than defaulting so line is uniform
                        parent: handle.outer,
                        border: FALSE],
                    proc: OtherCmd,
                    clientData: NEW [CmdRec _ [handle: handle, cmd: cmd]]];
                maxY _ MAX[maxY, at.y];
                };

            MakeBool: PROC [at: Place, name: ROPE, initial: BOOL] RETURNS [flag: REF BOOL] = {
                b: Cmd;
                flag _ NEW[BOOL _ initial];
                b _ Buttons.Create[
                    info: [
                        name: name, 
                        wx: at.x*handle.en,
                        wy: cmdy + at.y * (entryHeight + entryVSpace),
                        <<-- default the width so that it will be computed for us>>
                        wh: entryHeight,    -- specify rather than defaulting so line is uniform
                        parent: handle.outer,
                        border: FALSE],
                    proc: ToggleBool,
                    clientData: flag];
                Buttons.SetDisplayStyle[
                    button: b,
                    style: IF initial THEN $WhiteOnBlack ELSE $BlackOnWhite];
                maxY _ MAX[maxY, at.y];
                };

            NamedCell: PROC [at: Place, name: ROPE, width: CARDINAL, initial: ROPE _ NIL, radix: INT _ 8]
                RETURNS [v: ViewerClasses.Viewer] = {
                ph: PromptHandle _ NEW[PromptRec _ [handle: handle, radix: radix, cell: NIL]];
                cmdx: INT _ at.x*handle.en;
                b: Buttons.Button _ Buttons.Create[
                    info: [
                        name: Rope.Concat[name, ": "], 
                        wx: cmdx,
                        wy: cmdy + at.y * (entryHeight + entryVSpace),
                        wh: entryHeight,
                        parent: handle.outer,
                        border: FALSE],
                    proc: SimplePrompt,
                    clientData: ph];
                cmdx _ cmdx + b.ww;
                v _ ViewerTools.MakeNewTextViewer[
                    info: [
                        wx: cmdx,
                        wy: cmdy + at.y * (entryHeight + entryVSpace) + 1,
                        ww: width*handle.en + 8,
                        wh: entryHeight,
                        parent: handle.outer,
                        data: initial,
                        scrollable: FALSE,
                        border: FALSE]];
                ph.cell _ v;
                maxY _ MAX[maxY, at.y];
                };

            MakeEnum: PROC [at: Place, name: ROPE, choices: EnumItemSeq, initial: CARDINAL _ 0]
                RETURNS [er: ERef] = {
                eh: EnumHandle _ NEW[EnumRec _ [handle: handle, choices: choices, showing: initial, eCell: (er _ NEW[UNSPECIFIED])]];
                cmdx: INT _ at.x*handle.en;
                v: ViewerClasses.Viewer;
                width: INT _ 0;
                b: Buttons.Button _ Buttons.Create[
                    info: [
                        name: Rope.Concat[name, ": "], 
                        wx: cmdx,
                        wy: cmdy + at.y * (entryHeight + entryVSpace),
                        wh: entryHeight,
                        parent: handle.outer,
                        border: FALSE],
                    proc: CycleOptions,
                    clientData: eh];
                FOR i: CARDINAL IN [0..choices.count) DO
                    width _ MAX[width, VFonts.StringWidth[choices[i].tag]];
                    ENDLOOP;
                er^ _ choices[initial].value;
                cmdx _ cmdx + b.ww;
                v _ ViewerTools.MakeNewTextViewer[
                    info: [
                        wx: cmdx,
                        wy: cmdy + at.y * (entryHeight + entryVSpace) + 1,
                        ww: width + 12,
                        wh: entryHeight,
                        parent: handle.outer,
                        data: choices[initial].tag,
                        scrollable: FALSE,
                        border: FALSE]];
                eh.choice _ v;
                cmdx _ cmdx + v.ww + entryHSpace;
                maxY _ MAX[maxY, at.y];
                };

            infoEnum: EnumItemSeq _ NEW[EnumItemSeqRec[3]];
            infoEnum[0] _ [tag: "gen", value: CodeDefs.CCInfoType[generating]];
            infoEnum[1] _ [tag: "bind", value: CodeDefs.CCInfoType[binding]];
            infoEnum[2] _ [tag: "code", value: CodeDefs.CCInfoType[coding]];

            MakeCmd[at: treePlace, name: "Tree", cmd: tree];
            MakeCmd[at: asCCPlace, name: "CC", cmd: asCC];
            MakeCmd[at: varPlace, name: "Var", cmd: var];
            MakeCmd[at: vcompPlace, name: "VComp", cmd: vcomp];
            handle.showLinks _ MakeBool[at: linksPlace, name: "lnks", initial: FALSE];
            handle.cmd.dVal _ NamedCell[at: depthPlace, name: "d", width: 3, initial: "2", radix: 10];
            MakeCmd[at: stopPlace, name: "STOP", cmd: stop];

            MakeCmd[at: firstPlace, name: "first", cmd: first];
            MakeCmd[at: curPlace, name: "cur", cmd: cur];
            MakeCmd[at: rcntPlace, name: "rcnt", cmd: rcnt];
            MakeCmd[at: fwdPlace, name: "fwd", cmd: fwd];
            MakeCmd[at: prevPlace, name: "prev", cmd: prev];
            MakeCmd[at: nextPlace, name: "next", cmd: next];
            handle.infoVar _ MakeEnum[at: infoPlace, name: "t", choices: infoEnum];

            MakeCmd[at: tempPlace, name: "temp", cmd: temp];
            MakeCmd[at: allStackPlace, name: "Stk", cmd: allStack];
            MakeCmd[at: stackPlace, name: "sti", cmd: stack];
            MakeCmd[at: tosPlace, name: "TOS", cmd: tos];
            MakeCmd[at: downPlace, name: "down", cmd: down];
            MakeCmd[at: upPlace, name: "up", cmd: up];
            MakeCmd[at: lblPlace, name: "lbl", cmd: lbl];
            MakeCmd[at: liiPlace, name: "lii", cmd: lii];

            MakeCmd[at: mdiPlace, name: "mt", cmd: mdi];
            MakeCmd[at: htiPlace, name: "ht", cmd: hti];
            MakeCmd[at: ctiPlace, name: "ct", cmd: cti];
            MakeCmd[at: btiPlace, name: "bt", cmd: bti];
            MakeCmd[at: seiPlace, name: "se", cmd: sei];
            MakeCmd[at: nextsePlace, name: "nx", cmd: nextse];

            MakeCmd[at: fopPlace, name: "fop", cmd: fop];
            MakeCmd[at: mopPlace, name: "mop", cmd: mop];
            MakeCmd[at: repPlace, name: "rep", cmd: rep];

            MakeCmd[at: bodyPlace, name: "Body", cmd: body];
            MakeCmd[at: stmtPlace, name: "Stmt", cmd: stmt];
            MakeCmd[at: exprPlace, name: "Expr", cmd: expr];
            <<MakeCmd[at: gFramesPlace, name: "GFrames", cmd: gFrames];>>

            MakeCmd[at: sourcePlace, name: "Source", cmd: source];
            handle.height _ cmdy + (maxY+1) * (entryHeight + entryVSpace)
            END;

        CellInt: PUBLIC PROC [handle: Handle, n: NumberCell] RETURNS [INT] = {
            contents: Rope.ROPE _ ViewerTools.GetContents[n];
            RETURN [GetNumber[handle, contents]]};

        CellCard: PUBLIC PROC [handle: Handle, n: NumberCell] RETURNS [CARDINAL] = {
            contents: Rope.ROPE _ ViewerTools.GetContents[n];
            i: INT _ GetNumber[handle, contents];
            IF ~ (i IN [0..CARDINAL.LAST]) THEN 
                RESOut.Complain[h: handle, msg: "number out of range"];
            RETURN [CARDINAL[i]]};

        GetNumber: PUBLIC PROC [handle: Handle, contents: Rope.ROPE] RETURNS [v: INT _ 0] = {
            ENABLE SafeStorage.NarrowFault => GO TO bad;
            neg: BOOL _ FALSE;
            first: CARDINAL _ 0;
            IF Rope.Length[contents] = 0 THEN RETURN;
            FOR i: CARDINAL IN [0..CARDINAL[Rope.Length[contents]]) DO
                c: CHAR = Rope.Fetch[contents, i];
                SELECT  c FROM
                    IN [IO.NUL..IO.SP] => NULL;
                    '- => {neg _ TRUE; first _ i+1; EXIT};
                    ENDCASE => {first _ i; EXIT};
                ENDLOOP;
            v _ Convert.CardFromWholeNumberLiteral[contents, first !
                Convert.Error => {
                    SELECT reason FROM
                        $empty => RESOut.Complain[h: handle, msg: "number is blank."]; 
                        $syntax => RESOut.Complain[h: handle, msg: "number syntax error."];
                        $overflow => RESOut.Complain[h: handle, msg: "number overflowed."];
                        ENDCASE; -- above cases won't return (they raise cancelAction)
                    GO TO bad}];
            IF neg THEN v _ -v;
            EXITS
                bad => RETURN [0];
            };

        MakeTypescript: PROC [handle: Handle] = BEGIN    
            v: ViewerClasses.Viewer;
            [handle.in, handle.out] _ ViewerIO.CreateViewerStreams [
                name: "CDebug typescript", viewer: NIL, backingFile: NIL, editedStream: FALSE];
            handle.ts _ ViewerIO.GetViewerFromStream[handle.out];
            ViewerOps.AddProp[handle.ts, $cdebugHandle, handle];
            handle.dying _ FALSE;
            [] _ ViewerEvents.RegisterEventProc[proc: DestroyTypescript, event: destroy, filter: v];
            END;

        DestroyTypescript: ViewerEvents.EventProc = {
            <<[viewer: ViewerClasses.Viewer, event: ViewerEvents.ViewerEvent, before: BOOL] RETURNS [abort: BOOL _ FALSE]>>
            h: Handle _ NARROW[ViewerOps.FetchProp[viewer, $cdebugHandle]];
            IF before AND h # NIL AND h.ts = viewer AND ~h.dying THEN {
                MessageWindow.Append[message: "destroy command window instead", clearFirst: TRUE];
                RETURN[TRUE]};
            };

        SetCell: PRIVATE PROC [handle: Handle, button: Menus.MouseButton, cell: ViewerClasses.Viewer, radix: CARDINAL] = {
            ENABLE RESOut.cancelAction => GO TO dont;
            SELECT button FROM
                blue =>  ViewerTools.SetSelection[cell];
                red, yellow => {
                    r: ROPE = ViewerTools.GetSelectionContents[];
                    i: INT = GetNumber[handle, r];
                    IF button = yellow THEN radix _ 8;
                    ViewerTools.SetContents[cell, Convert.RopeFromInt[from: i, base: radix, showRadix: TRUE]]};
                ENDCASE;
            EXITS
                dont => RETURN;
            };

        SetTextCell: PRIVATE PROC [handle: Handle, button: Menus.MouseButton, cell: ViewerClasses.Viewer] = {
            ENABLE RESOut.cancelAction => GO TO dont;
            SELECT button FROM
                blue =>  ViewerTools.SetSelection[cell];
                red => {
                    r: ROPE = ViewerTools.GetSelectionContents[];
                    ViewerTools.SetContents[cell, r]};
                ENDCASE;
            EXITS
                dont => RETURN;
            };

        SimplePrompt: Buttons.ButtonProc  = {
            ph: PromptHandle _ NARROW[clientData];
            IF ph.radix = 0 THEN SetTextCell[ph.handle, mouseButton, ph.cell]
            ELSE SetCell[ph.handle, mouseButton, ph.cell, ph.radix];
            };

        GetSelectionValue: PUBLIC PROC [handle: Handle] RETURNS [UNSPECIFIED] = {
            r: ROPE = ViewerTools.GetSelectionContents[];
            i: INT = GetNumber[handle, r];
            IF ~(i IN [0..CARDINAL.LAST]) THEN 
                RESOut.Complain[h: handle, msg: "Selected number too large"];
            RETURN [CARDINAL[i]]};

        GetLongSelectionValue: PUBLIC  PROC [handle: Handle] RETURNS [INT] = {
            r: ROPE = ViewerTools.GetSelectionContents[];
            RETURN [GetNumber[handle, r]]};

        OtherCmd: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ 
        FALSE, control: BOOL _ FALSE] --  = {
            ENABLE RESOut.cancelAction, ABORTED => GO TO dont;
            ch: CmdHandle = NARROW[clientData];
            IF ch.cmd = stop THEN ch.handle.stopFlag _ TRUE
            ELSE TRUSTED {
                ch.handle.stopFlag _ FALSE;
                CDebugDefs.DoCommand[ch.handle, ch.cmd, mouseButton]};
            EXITS
                dont => RETURN;
            };

        ToggleBool: Buttons.ButtonProc  = {
            switch: REF BOOL _ NARROW [clientData]; 
            switch^ _ ~switch^;
            Buttons.SetDisplayStyle[
             button: NARROW[parent], 
             style: IF switch^ THEN $WhiteOnBlack ELSE $BlackOnWhite];
            };

        CycleOptions: Buttons.ButtonProc  = {
            eh: EnumHandle _ NARROW [clientData]; 
            next: CARDINAL;
            IF mouseButton = blue THEN {
                next _ IF eh.showing = 0 THEN eh.choices.count-1 ELSE eh.showing-1}
            ELSE {
                next _ IF eh.showing = eh.choices.count-1 THEN 0 ELSE eh.showing+1};
            eh.eCell^ _ eh.choices[next].value;
            eh.showing _ next;
            ViewerTools.SetContents[eh.choice, eh.choices[next].tag];
            };

        TRUSTED {
            START STDebugDefs.STDebugMisc;
            START STDebugDefs.STDebugTrees;
            START STDebugDefs.STDebugSymbols};

        Commander.Register[key: "CDebug", proc: MakeTool, doc: "Debugger for compiler internals"];
        END.
        <<>>