
    <<CDDebugCommands.mesa   (part of ChipNDale)>>
        <<Copyright © 1983, 1986, 1987 by Xerox Corporation.  All rights reserved.>>
        <<Created by Christian Jacobi, June 29, 1983 4:44 pm >>
        <<Last edited by: Christian Jacobi, April 7, 1987 2:36:39 pm PDT>>

    DIRECTORY
        AMBridge,
        Atom,
        CD,
        CDAtomicObjects,
        CDDebug,
        CDDirectory,
        CDEnvironment,
        CDEvents,
        CDOps,
        CDProperties,
        CDSequencer,
        CDValue,
        CDViewer,
        Commander,
        IO,
        PopUpSelection USING [Request],
        PrintTV,
        Process,
        Rope,
        RuntimeError USING [UNCAUGHT],
        TerminalIO,
        UserProfile,
        ViewerClasses USING [Viewer];

    CDDebugCommands: CEDAR PROGRAM
        IMPORTS AMBridge, Atom, CD, CDEnvironment, CDEvents, CDOps, CDProperties, CDSequencer, CDValue, CDViewer, IO, PopUpSelection, 
        PrintTV, Process, Rope, RuntimeError, TerminalIO, UserProfile
        EXPORTS CDDebug = 
    BEGIN

    rememberDesigns: PUBLIC BOOL _ FALSE;
    someDesign: PUBLIC CD.Design;  -- last created or debugged design; accessable from debugger

    debug: SIGNAL = CODE;

    BreakProc: PROC [comm: CDSequencer.Command] = {
        ENABLE ABORTED => TerminalIO.PutRope["debugger aborted\n"];
        Include: PROC [x: REF_NIL] RETURNS [Rope.ROPE] = {--called from debugger
            RETURN [DoInclude[x, comm]]
            };
        design: CD.Design _ comm.design;
        ob: CD.Object _ NIL;
        inst: CD.Instance _ CDOps.SelectedInstance[design].first;
        specific: REF _ NIL;
        viewer: ViewerClasses.Viewer _ CDViewer.GetViewer[comm];
        IF inst#NIL THEN {ob _ inst.ob; specific _ ob.specific};
        IF rememberDesigns THEN someDesign _ design ELSE someDesign _ NIL;
        TerminalIO.PutRopes[
            "  Look:    ob, inst, design, comm, specific, viewer\n",
            "  Call:     Include[x]\n"];
        SIGNAL debug;
        TerminalIO.PutRope["debugger disabled\n"];
        };

    DoInclude: PROC [x: REF, comm: CDSequencer.Command] RETURNS [r: Rope.ROPE_NIL] = {
        <<--Implements Include, which is called interactively through the debugger>>
        WITH x SELECT FROM
            ob: CD.Object => {
                TerminalIO.PutRope[r _ CD.Describe[ob, NIL, comm.design, 2]];
                TerminalIO.PutRope[" put down from interpreter\n"];
                [] _ CDOps.IncludeObjectI[comm.design, ob, comm.pos];
                };
            inst: CD.Instance => {
                TerminalIO.PutRope[r _ CD.Describe[inst.ob, inst.properties, comm.design, 2]];
                TerminalIO.PutRope[" put down from interpreter\n"];
                CDOps.IncludeInstance[comm.design, inst];
                };
            rob: REF CD.Object =>         RETURN[DoInclude[rob^, comm]];
            rrob: REF REF CD.Object =>     RETURN[DoInclude[rrob^^, comm]];
            rinst: REF CD.Instance =>     RETURN[DoInclude[rinst^, comm]];
            rrinst: REF REF CD.Instance => RETURN[DoInclude[rrinst^^, comm]];
            ENDCASE => {
                r _ Rope.Cat[
                    IF x=NIL THEN "NIL" ELSE CDOps.ToRope[x, "unknown"], 
                    "; not included"
                    ];
                };
        CDOps.DoTheDelayedRedraws[comm.design]
        };

    TestCommand: PROC [comm: CDSequencer.Command] = {
        p: CDSequencer.CommandProc _ CDSequencer.FetchCommand[$test].proc;
        IF p=DebugComm OR p=NIL THEN TerminalIO.PutRope["no test procedure loaded\n"]
        ELSE {
            stream: IO.STREAM _ IO.ROS[];
            TRUSTED {PrintTV.Print[AMBridge.TVForProc[p], stream]};
            IF TerminalIO.Confirm[Rope.Cat["call procedure ", IO.RopeFromROS[stream]]] THEN
                CDSequencer.ExecuteCommand[key: $test, comm: comm];
            };
        };

    DebugComm: PROC [comm: CDSequencer.Command] = {
        ForkedBreak: PROC = {
            TerminalIO.PutRope["**open detached debugger view\n"];
            BreakProc[comm];
            };
        InLineBreak: PROC = TRUSTED {
            TerminalIO.PutRope["Try open debugger view with designs lock\n"];
            CDSequencer.ExecuteCommand[key: $BreakProc, comm: comm];
            };
        IF comm.design.mutability#editable THEN {
            TerminalIO.PutF["%l**Warning: design %g NOT editable but debug may break locks%l\n",
                IO.rope["b"],
                IO.rope[CD.DesignName[comm.design]],
                IO.rope[" "]
                ];
            Process.PauseMsec[300]; -- better than flush
            };
        SELECT PopUpSelection.Request[
            header: "Debug options",
            choice: LIST["detached debug", "queued debug", "run test", "garbage menu"],
            headerDoc: "discard menu for not debugging", 
            choiceDoc: LIST["enter debugger; not monitored; can still issue commands", "enter debugger; safe, but can't issue commands", 
            "executes a prepared test procedure", "contains entries included in undefined menus"],
            timeOut: 20
            ] FROM
            1 => ForkedBreak[];
            2 => InLineBreak[];
            3 => TestCommand[comm];
            4 => CDSequencer.ExecuteCommand[key: $GarbageMenu, comm: comm];
            ENDCASE => TerminalIO.PutRope["skipped\n"];
        };

    NewDesign: CDEvents.EventProc = {
        IF rememberDesigns THEN someDesign _ design ELSE someDesign _ NIL;
        };

    ClassRope: PROC [c: REF READONLY CD.ObjectClassRec] RETURNS [Rope.ROPE] = TRUSTED {
        RETURN [SELECT TRUE FROM
            c=NIL => "NIL class",
            Rope.IsEmpty[c.description] AND c.objectType#NIL => Atom.GetPName[c.objectType],
            ENDCASE => c.description]
        };

    PrintInstance: PrintTV.TVPrintProc = TRUSTED {
        ENABLE RuntimeError.UNCAUGHT => GOTO someErr;
        x: REF;
        i: REF READONLY CD.InstanceRep _ NARROW[AMBridge.TVToRef[tv]];
        IF i=NIL THEN RETURN [useOld_TRUE];
        stream.PutRope["{ob: "];
        PrintTV.Print[AMBridge.TVForReferent[i.ob], stream, depth-1];
        IF depth>0 THEN {
            stream.PutF[", at: [%g, %g]", IO.int[i.trans.off.x], IO.int[i.trans.off.y]];
            IF i.trans.orient#original THEN stream.PutF[", orient: %g", IO.int[ORD[i.trans.orient]]];
            IF i.selected THEN stream.PutRope[", S"];
            IF depth>1 THEN {
                x _ CDProperties.GetListProp[i.properties, $SignalName];
                IF x#NIL THEN stream.PutF[", SignalName: %g", IO.refAny[x]];
                x _ CDProperties.GetListProp[i.properties, $InstanceName];
                IF x#NIL THEN stream.PutF[", InstanceName: %g", IO.refAny[x]];
                };
            };
        stream.PutChar['}];
        EXITS someErr => useOld_TRUE
        };

    PrintObject: PrintTV.TVPrintProc = TRUSTED {
        ENABLE RuntimeError.UNCAUGHT => GOTO someErr;
        o: REF READONLY CD.ObjectRep _ NARROW[AMBridge.TVToRef[tv]];
        IF o=NIL OR o.class=NIL THEN RETURN [useOld_TRUE];
        stream.PutChar['{];
        stream.PutRope[ClassRope[o.class]];
        IF depth>=1 THEN { 
            stream.PutF[",  bbox: [%g, %g, %g, %g]", IO.int[o.bbox.x1], IO.int[o.bbox.y1], IO.int[o.bbox.x2], IO.int[o.bbox.y2]];
            IF CD.LayerTechnology[o.layer]#NIL OR o.class.wireTyped THEN
                stream.PutF[", layer: %g", IO.rope[CDOps.LayerRope[o.layer]]];
            IF ~o.class.wireTyped AND ~ISTYPE[o.specific, CDAtomicObjects.AtomicObsSpecific] AND o.specific#NIL THEN {
                stream.PutRope[", "];
                PrintTV.Print[AMBridge.TVForReferent[o.specific], stream, depth-1];
                }
            };
        stream.PutChar['}];
        EXITS someErr => useOld_TRUE
        };

    TechName: PROC [t: REF READONLY CD.TechnologyRep] RETURNS [Rope.ROPE] = {
        IF t=NIL THEN RETURN ["NIL"] 
        ELSE IF t.name#NIL THEN RETURN [t.name]
        ELSE RETURN [Atom.GetPName[t.key]]
        };

    PrintDesign: PrintTV.TVPrintProc = TRUSTED {
        d: REF READONLY CD.DesignRec _ NARROW[AMBridge.TVToRef[tv]];
        IF d=NIL THEN RETURN [useOld_TRUE];
        stream.PutF["{name: %g, technology: %g}", 
            IO.rope[IF Rope.Length[d.name]>0 THEN d.name ELSE "(no name)"],
            IO.rope[TechName[d.technology]]
            ];
        };

    PrintTechnology: PrintTV.TVPrintProc = TRUSTED {
        t: REF READONLY CD.TechnologyRep = NARROW[AMBridge.TVToRef[tv]];
        stream.PutRope[TechName[t]] ;
        };

    Draw: PUBLIC PROC [ob: CD.Object, technologyHint: REF_NIL, name: Rope.ROPE_NIL] RETURNS [dummyDesign: CD.Design, viewer: 
    ViewerClasses.Viewer] = {
        <<--Creates a viewer which allows looking at an object>>
        <<--Procedure to be called for debugging purposes only>>
        <<--Invalidates directory invariants>>
        tech: CD.Technology;
        IF ob=NIL THEN ERROR;
        IF tech=NIL THEN WITH technologyHint SELECT FROM
            a: ATOM => tech _ CD.FetchTechnology[a];
            t: CD.Technology => tech _ t;
            ENDCASE => NULL;
        IF tech=NIL THEN tech _ ob.class.technology;
        IF tech=NIL THEN tech _ CD.FetchTechnology[$cmosB];
        IF tech=NIL THEN ERROR;
        IF ob.class.technology#NIL AND ob.class.technology#tech THEN ERROR;
        dummyDesign _ CDOps.CreateDesign[tech];
        dummyDesign.name  _ name;
        CDValue.Store[dummyDesign, $DontGC, $DontGC]; -- avoid finalization !
        [] _ CDOps.IncludeObjectI[dummyDesign, ob, [0, 0]];
        CDOps.SetMutability[dummyDesign, inaccessible];
        <<-- don't clean up: to get the original objects>>
        viewer _ CDViewer.CreateViewer[dummyDesign, FALSE];
        TerminalIO.PutRope["inaccessible debugging design created\n"]
        };

    RegisterPrintProcs: PUBLIC PROC [on: BOOL_TRUE] = {
        IF on THEN {
            PrintTV.RegisterTVPrintProc[type: CODE[CD.Instance], proc: PrintInstance];
            PrintTV.RegisterTVPrintProc[type: CODE[CD.Object], proc: PrintObject];
            PrintTV.RegisterTVPrintProc[type: CODE[CD.Design], proc: PrintDesign];
            PrintTV.RegisterTVPrintProc[type: CODE[CD.Technology], proc: PrintTechnology];
            }
        ELSE {
            PrintTV.RegisterTVPrintProc[type: CODE[CD.Instance], proc: NIL];
            PrintTV.RegisterTVPrintProc[type: CODE[CD.Object], proc: NIL];
            PrintTV.RegisterTVPrintProc[type: CODE[CD.Design], proc: NIL];
            PrintTV.RegisterTVPrintProc[type: CODE[CD.Technology], proc: NIL];
            }
        };

    PrintProcsCommand: Commander.CommandProc = {
        off: BOOL _ Rope.Match["*off*", cmd.commandLine, FALSE]; 
        IF off THEN IO.PutRope[cmd.out, "--off"] ELSE cmd.out.PutRope["--on"];
        RegisterPrintProcs[~off];
        };

    RemDCommand: Commander.CommandProc = {
        off: BOOL _ Rope.Match["*off*", cmd.commandLine, FALSE]; 
        IF off THEN IO.PutRope[cmd.out, "--off"] ELSE cmd.out.PutRope["--on"];
        rememberDesigns _ off;
        };

    CDProperties.PutAtomProp[$CDDebugPrivate, $CDDebugPrivate, NEW[SIGNAL ANY RETURNS ANY_debug]];
    CDEvents.RegisterEventProc[$CreateNewDesign, NewDesign];
    CDEnvironment.RegisterCommander["CDRememberDesigns", RemDCommand, "Set whether ChipNDales remembers last design (CDRememberDesigns 
    {on|off})"];
    CDEnvironment.RegisterCommander["CDPrintProcs", PrintProcsCommand, "Set whether ChipNDales uses tv print procs (CDPrintProcs 
    {on|off})"];
    CDSequencer.ImplementCommand[$Debug, DebugComm,, dontQueue];
    CDSequencer.ImplementCommand[$BreakProc, BreakProc,, doQueue];
    CDSequencer.ImplementCommand[$test, DebugComm];
    IF UserProfile.Boolean["ChipNDale.RegisterTVPrintProcs", TRUE] THEN RegisterPrintProcs[]
    END.