
    <<Debug.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, January 28, 1986 8:41:33 am PST>>
        <<Maxwell, August 2, 1983 2:39 pm>>
        <<Russ Atkinson (RRA) March 6, 1985 10:31:51 pm PST>>

    DIRECTORY
        Alloc USING [Base, Handle, Notifier, AddNotify, DropNotify, Top],
        BcdDefs USING [Link, VersionStamp],
        CompilerUtil USING [AcquireStream, AcquireTable, ReleaseStream, ReleaseTable],
        ConvertUnsafe USING [SubString],
        DebugTable USING [CSRptr],
        IO USING [card, CR, int, Put, PutChar, PutF, rope, STREAM, TAB],
        Literals USING [Base, LitDescriptor, ltType],
        LiteralOps USING [DescriptorValue, MasterString, StringValue],
        Rope USING [ROPE],
        Symbols USING [Base, BitAddress, CTXRecord, TransferMode, TypeClass, Name, SEIndex, ISEIndex, CSEIndex, CTXIndex, BTIndex, 
        nullName, SENull, CTXNull, lG, lZ, RootBti, typeTYPE, seType, ctxType, mdType, bodyType],
        SymbolOps USING [CtxLevel, EnumerateBodies, FindExtension, NameForSe, NextSe, SubStringForName, TypeLink, XferMode],
        Tree USING [Base, Index, Link, NodeName, Scan, NullIndex, treeType],
        TreeOps USING [GetNode, ScanSons];

    Debug: PROGRAM
        IMPORTS Alloc, CompilerUtil, IO, LiteralOps, SymbolOps, TreeOps
        EXPORTS CompilerUtil = {
        OPEN Symbols;

        tb: Tree.Base;
        seb: Symbols.Base;
        ctxb: Symbols.Base;
        mdb: Symbols.Base;
        bb: Symbols.Base;
        ltb: Literals.Base;

        definitionsOnly: BOOL;

        DebugNotify: Alloc.Notifier = {
            tb _ base[Tree.treeType];
            seb _ base[seType];  ctxb _ base[ctxType];  mdb _ base[mdType];
            bb _ base[bodyType];
            ltb _ base[Literals.ltType]};

        SubString: TYPE = ConvertUnsafe.SubString;

    <<basic io>>

        errorStream: IO.STREAM _ NIL;

        WriteChar: PROC [c: CHAR] = {IO.PutChar[errorStream, c]};

        WriteRope: PROC [s: Rope.ROPE] = {IO.Put[errorStream, IO.rope[s]]};

        WriteDecimal: PROC [n: INTEGER] = {
            IO.Put[errorStream, IO.int[n]]};

        NewLine: PROC = INLINE {WriteChar[IO.CR]};

        Indent: PROC [n: CARDINAL] = {
            NewLine[];
            <<THROUGH [1..n/8] DO WriteChar[IO.TAB] ENDLOOP;>>
            THROUGH [1..n/8] DO WriteRope["        "] ENDLOOP;
            THROUGH [1..n MOD 8] DO WriteChar[' ] ENDLOOP};


        <<errorStream, csrP and desc.base are set by Enter>>

        csrP: DebugTable.CSRptr;
        ss: SubString;

        LockStringTable: PROC = INLINE {
            csrP _ CompilerUtil.AcquireTable[debug];
            ss.base _ @csrP[csrP.stringOffset]};

        UnlockStringTable: PROC = INLINE {CompilerUtil.ReleaseTable[debug]; csrP _ NIL};

        Enter: PROC [table: Alloc.Handle] = {
            table.AddNotify[DebugNotify];
            errorStream _ CompilerUtil.AcquireStream[log];  LockStringTable[]};

        Exit: PROC [table: Alloc.Handle] = {
            UnlockStringTable[];  CompilerUtil.ReleaseStream[log]; errorStream _ NIL;
            table.DropNotify[DebugNotify]};

        WriteSubString: PROC [ss: SubString] = {
            FOR i: CARDINAL IN [ss.offset..ss.offset+ss.length) DO
                WriteChar[ss.base[i]] ENDLOOP};


        <<tree printing>>

        PrintLiteral: PROC [t: Tree.Link.literal] = {
            WITH t.index SELECT FROM
                string => {
                    s: LONG STRING = LiteralOps.StringValue[sti];
                    WriteChar['"];
                    FOR i: CARDINAL IN [0..s.length) DO WriteChar[s[i]] ENDLOOP;
                    WriteChar['"];
                    IF sti # LiteralOps.MasterString[sti] THEN WriteChar['L]};
                word => {
                    desc: Literals.LitDescriptor = LiteralOps.DescriptorValue[lti];
                    v: WORD;
                    IF desc.length # 1 THEN WriteChar['[];
                    FOR i: CARDINAL IN [0 .. desc.length) DO
                        IF (v _ ltb[desc.offset][i]) < 1000 THEN WriteDecimal[v]
                        ELSE IO.PutF[errorStream, "%b", IO.int[v]]; -- octal
                        IF i+1 # desc.length THEN WriteChar[',];
                        ENDLOOP;
                    IF desc.length # 1 THEN WriteChar[']]};
                ENDCASE};

        WriteNodeName: PROC [n: Tree.NodeName] = {
            ss.offset _ csrP.NodePrintName[n].offset; ss.length _ csrP.NodePrintName[n].length;
            WriteSubString[ss]};

        PrintSubTree: PROC [t: Tree.Link, nBlanks: CARDINAL] = {
            OPEN Tree;

            Printer: Tree.Scan = {
                Indent[nBlanks];
                WITH s: t SELECT FROM
                    hash => PrintName[s.index];
                    symbol => {PrintSei[s.index]; WriteChar['[]; PrintIndex[s.index]; WriteChar[']]};
                    literal => PrintLiteral[s];
                    subtree => {
                        node: Tree.Index = s.index;
                        IF node = Tree.NullIndex THEN WriteRope["<empty>"]
                        ELSE {
                            OPEN tb[node];
                            WriteNodeName[name];
                            WriteChar['[];  PrintIndex[node];  WriteRope["] "];
                            IF info # 0 THEN {WriteRope["  info="]; PrintIndex[info]};
                            IF attr1 OR attr2 OR attr3 THEN {
                                IF info = 0 THEN WriteChar[' ];
                                WriteChar['(];
                                IF attr1 THEN WriteChar['1];
                                IF attr2 THEN WriteChar['2];
                                IF attr3 THEN WriteChar['3];
                                WriteChar[')]};
                            nBlanks _ nBlanks + 2;
                            IF name # thread THEN TreeOps.ScanSons[s, Printer]
                            ELSE {
                                WriteRope[" link="]; PrintIndex[TreeOps.GetNode[son[2]]];
                                Printer[son[1]]};
                            nBlanks _ nBlanks - 2}};
                    ENDCASE};

            Printer[t]};


        PrintTree: PUBLIC PROC [table: Alloc.Handle, root: Tree.Link] = {
            Enter[table];
            PrintSubTree[root, 0];  NewLine[];  NewLine[];
            Exit[table]};

        PrintBodies: PUBLIC PROC [table: Alloc.Handle] = {
            Enter[table];
            [] _ SymbolOps.EnumerateBodies[RootBti, PrintBody];  NewLine[];
            Exit[table]};

        PrintBody: PROC [bti: BTIndex] RETURNS [BOOL] = {
            OPEN body: bb[bti];
            WriteRope["Body: "];
            WITH b: body SELECT FROM
                Callable => {
                    PrintSei[b.id];
                    IF b.inline THEN WriteRope[" [inline]"]
                    ELSE {
                        WriteRope[", ep: "];  WriteDecimal[b.entryIndex];
                        WITH b SELECT FROM
                            Inner => {WriteRope[", frame addr: "]; WriteDecimal[frameOffset]};
                            ENDCASE};
                    WriteRope[", attrs: "];
                    WriteChar[IF ~b.noXfers THEN 'x ELSE '-];
                    WriteChar[IF b.hints.safe THEN 's ELSE '-];
                    WriteChar[IF b.hints.nameSafe THEN 'n ELSE '-];
                    IF ~b.hints.noStrings THEN {Indent[2]; WriteRope["string literals"]}};
                ENDCASE => WriteRope["(anon)"];
            Indent[2];
            WriteRope["context: "];  PrintIndex[body.localCtx];
            WriteRope[", level: "];  WriteDecimal[body.level];
            WITH body.info SELECT FROM
                Internal => {
                    WriteRope[", frame size: "];  WriteDecimal[frameSize];
                    IF body.kind = Callable THEN PrintSubTree[[subtree[index: bodyTree]], 0]
                    ELSE {WriteRope[", tree root: "]; PrintIndex[bodyTree]}};
                ENDCASE;
            NewLine[];  NewLine[];  RETURN[FALSE]};


        PrintSymbols: PUBLIC PROC [table: Alloc.Handle, definitions: BOOL] = {
            ctx: CTXIndex;
            limit: CTXIndex;
            Enter[table];
            definitionsOnly _ definitions;
            limit _ table.Top[Symbols.ctxType];
            ctx _ CTXIndex.FIRST + CTXRecord.nil.SIZE;
            UNTIL ctx = limit DO
                PrintContext[ctx];  NewLine[];  NewLine[];
                ctx _ ctx + (WITH ctxb[ctx] SELECT FROM
                    included => CTXRecord.included.SIZE,
                    imported => CTXRecord.imported.SIZE,
                    ENDCASE => CTXRecord.simple.SIZE);
                ENDLOOP;
            NewLine[];
            Exit[table]};

        PrintContext: PROC [ctx: CTXIndex] = {
            sei, root: ISEIndex;
            WriteRope["Context: "];  PrintIndex[ctx];
            IF SymbolOps.CtxLevel[ctx] # lZ THEN {
                WriteRope[", level: "]; WriteDecimal[SymbolOps.CtxLevel[ctx]]};
            WITH c: ctxb[ctx] SELECT FROM
                included => {
                    WriteRope[", copied from: "]; PrintName[mdb[c.module].moduleId];
                    WriteRope[" ["]; PrintName[mdb[c.module].fileId];
                    WriteRope[", "]; PrintVersion[mdb[c.module].stamp];
                    WriteRope["], context: "];  PrintIndex[c.map]};
                imported => {
                    WriteRope[", imported from: "]; PrintName[mdb[ctxb[c.includeLink].module].moduleId]};
                ENDCASE;
            root _ sei _ ctxb[ctx].seList;
            DO
                IF sei = SENull THEN EXIT;
                PrintSE[sei, 2];
                IF (sei _ SymbolOps.NextSe[sei]) = root THEN EXIT;
                ENDLOOP
            };


        PrintSE: PROC [sei: ISEIndex, nBlanks: CARDINAL] = {
            OPEN seb[sei];
            typeSei: SEIndex;
            Indent[nBlanks];
            PrintSei[sei];
            WriteRope[" ["];  PrintIndex[sei];  WriteChar[']];
            IF public THEN WriteRope[" [public]"];
            IF mark3 THEN {
                WriteRope[", type = "];
                IF idType = typeTYPE THEN {
                    typeSei _ idInfo;
                    WriteRope["TYPE, equated to: "];
                    PrintType[typeSei];
                    IF SymbolOps.CtxLevel[idCtx] = lZ AND SymbolOps.TypeLink[sei] # SENull THEN {
                        WriteRope[", tag code: "]; WriteDecimal[idValue]}}
                    ELSE {
                        typeSei _ idType;  PrintType[typeSei];
                        SELECT TRUE FROM
                            constant => WriteRope[" [const]"];
                            immutable => WriteRope[" [init only]"];
                            ENDCASE;
                        IF ~mark4 THEN {WriteRope[", # refs: "]; WriteDecimal[idInfo]}
                        ELSE
                            SELECT TRUE FROM
                                constant =>
                                    IF ~ extended THEN {
                                        WriteRope[", value: "];
                                        SELECT SymbolOps.XferMode[typeSei] FROM
                                            proc, program, signal, error => PrintLink[idValue];
                                            ENDCASE =>
                                                IF LOOPHOLE[idValue, CARDINAL] < 1000 THEN WriteDecimal[idValue]
                                                ELSE IO.PutF[errorStream, "%b", IO.card[LOOPHOLE[idValue, CARDINAL]]]}; -- octal
                                (definitionsOnly AND SymbolOps.CtxLevel[idCtx] = lG) => {
                                    WriteRope[", index: "]; WriteDecimal[idValue]};
                                ENDCASE => {
                                    addr: BitAddress = idValue;
                                    WriteRope[", address: "];
                                    WriteDecimal[addr.wd];  WriteChar[' ];
                                    WriteChar['[];  WriteDecimal[addr.bd];
                                    WriteChar[':];  WriteDecimal[idInfo];  WriteChar[']];
                                    IF linkSpace THEN WriteChar['*]}};
                    PrintTypeInfo[typeSei, nBlanks+2];
                    IF extended THEN PrintSubTree[SymbolOps.FindExtension[sei].tree, nBlanks+4]}};


        PrintName: PROC [name: Name] = {
            s: SubString;
            IF name = nullName THEN WriteRope["(anon)"]
            ELSE {s _ SymbolOps.SubStringForName[name]; WriteSubString[s]}};

        PrintSei: PROC [sei: ISEIndex] = {PrintName[SymbolOps.NameForSe[sei]]};


        WriteTypeName: PROC [n: TypeClass] = {
            ss.offset _ csrP.TypePrintName[n].offset;  ss.length _ csrP.TypePrintName[n].length;
            WriteSubString[ss]};

        WriteModeName: PROC [n: TransferMode] = {
            ss.offset _ csrP.ModePrintName[n].offset;  ss.length _ csrP.ModePrintName[n].length;
            WriteSubString[ss]};

        PrintType: PROC [sei: SEIndex] = {
            tSei: SEIndex;
            IF sei = SENull THEN WriteChar['?]
            ELSE
                WITH t: seb[sei] SELECT FROM
                    cons =>
                        WITH t SELECT FROM
                            transfer => WriteModeName[mode];
                            ENDCASE => WriteTypeName[t.typeTag];
                    id =>
                        FOR tSei _ sei, SymbolOps.TypeLink[tSei] UNTIL tSei = SENull DO
                            WITH seb[tSei] SELECT FROM
                                id => {
                                    IF sei # tSei THEN WriteChar[' ];
                                    PrintSei[LOOPHOLE[tSei, ISEIndex]];
                                    IF ~mark3 OR SymbolOps.CtxLevel[idCtx] # lZ THEN EXIT};
                                ENDCASE;
                            ENDLOOP;
                    ENDCASE;
            WriteRope[" ["];  PrintIndex[sei];  WriteChar[']]};

        PrintTypeInfo: PROC [sei: SEIndex, nBlanks: CARDINAL] = {
            IF sei # SENull THEN
                WITH s: seb[sei] SELECT FROM
                    cons => {
                        Indent[nBlanks];
                        WriteChar['[];  PrintIndex[sei];  WriteRope["] "];
                        WITH s SELECT FROM
                            transfer => WriteModeName[mode];
                            ENDCASE => WriteTypeName[s.typeTag];
                        WITH t: s SELECT FROM
                            basic => NULL;
                            enumerated => {
                                IF t.machineDep THEN WriteRope[" (md)"]
                                ELSE IF t.unpainted THEN WriteRope[" (~painted)"];
                                WriteRope[", value ctx: "];  PrintIndex[t.valueCtx]};
                            record => {
                                IF t.machineDep THEN WriteRope[" (md)"];
                                IF t.monitored THEN WriteRope[" (monitored)"];
                                IF t.hints.variant THEN WriteRope[" (variant)"];
                                OutCtx[", field", t.fieldCtx];
                                WITH ctxb[t.fieldCtx] SELECT FROM
                                    included => IF ~complete THEN WriteRope[" [partial]"];
                                    imported => WriteRope[" [partial]"];
                                    ENDCASE;
                                WITH t SELECT FROM
                                    linked => {WriteRope[", link: "]; PrintType[linkType]};
                                    ENDCASE};
                            ref => {
                                SELECT TRUE FROM
                                    t.counted => WriteRope[" (counted)"];
                                    t.var => WriteRope[" (var)"];
                                    ENDCASE;
                                IF t.ordered THEN WriteRope[" (ordered)"];
                                IF t.basing THEN WriteRope[" (base)"];
                                WriteRope[", to: "]; PrintType[t.refType];
                                IF t.readOnly THEN WriteRope[" (readonly)"];
                                PrintTypeInfo[t.refType, nBlanks+2]};
                            array => {
                                IF t.packed THEN WriteRope[" (packed)"];
                                WriteRope[", index type: "]; PrintType[t.indexType];
                                WriteRope[", component type: "]; PrintType[t.componentType];
                                PrintTypeInfo[t.indexType, nBlanks+2];
                                PrintTypeInfo[t.componentType, nBlanks+2]};
                            arraydesc => {
                                WriteRope[", described type: "]; PrintType[t.describedType];
                                IF t.readOnly THEN WriteRope[" (readonly)"];
                                PrintTypeInfo[t.describedType, nBlanks+2]};
                            transfer => {
                                IF t.safe THEN WriteRope[" (safe)"];
                                OutArgType[", input", t.typeIn];
                                OutArgType[", output", t.typeOut]};
                            definition => {
                                WriteRope[", ctx: "];  PrintIndex[t.defCtx];
                                WriteRope[", ngfi: "];  WriteDecimal[4*t.nDummyGfi.q + t.nDummyGfi.r]};
                            union => {
                                IF t.overlaid THEN WriteRope[" (overlaid)"];
                                IF t.controlled THEN {WriteRope[", tag: "]; PrintSei[t.tagSei]};
                                WriteRope[", tag type: "];
                                PrintType[seb[t.tagSei].idType];
                                WriteRope[", case ctx: "];  PrintIndex[t.caseCtx];
                                IF t.controlled THEN PrintSE[t.tagSei, nBlanks+2]};
                            sequence => {
                                IF t.packed THEN WriteRope[" (packed)"];
                                IF t.controlled THEN {WriteRope[", tag: "]; PrintSei[t.tagSei]}
                                ELSE {WriteRope[", index type: "];  PrintType[seb[t.tagSei].idType]};
                                WriteRope[", component type: "]; PrintType[t.componentType];
                                IF t.controlled THEN PrintSE[t.tagSei, nBlanks+2]
                                ELSE PrintTypeInfo[seb[t.tagSei].idType, nBlanks+2];
                                PrintTypeInfo[t.componentType, nBlanks+2]};
                            relative => {
                                WriteRope[", base type: "]; PrintType[t.baseType];
                                WriteRope[", offset type: "]; PrintType[t.offsetType];
                                PrintTypeInfo[t.baseType, nBlanks+2];
                                PrintTypeInfo[t.offsetType, nBlanks+2]};
                            opaque => {
                                WriteRope[", id: "]; PrintSei[t.id];
                                IF t.lengthKnown THEN {WriteRope[", size: "]; WriteDecimal[t.length]}};
                            zone => {
                                IF t.counted THEN WriteRope[" (counted)"];
                                IF t.mds THEN WriteRope[" (mds)"]};
                            subrange => {
                                WriteRope[" of: "];  PrintType[t.rangeType];
                                IF t.filled THEN {
                                    WriteRope[" origin: "];  WriteDecimal[t.origin];
                                    WriteRope[", range: "];  WriteDecimal[t.range]};
                                PrintTypeInfo[t.rangeType, nBlanks+2]};
                            long, real => {
                                WriteRope[" of: "];  PrintType[t.rangeType];
                                PrintTypeInfo[t.rangeType, nBlanks+2]};
                            ENDCASE};
                    ENDCASE};

        OutCtx: PROC [message: Rope.ROPE, ctx: CTXIndex] = {
            WriteRope[message]; WriteRope[" ctx: "];
            IF ctx = CTXNull THEN WriteRope["NIL"] ELSE PrintIndex[ctx]};

        OutArgType: PROC [message: Rope.ROPE, sei: CSEIndex] = {
            IF sei = SENull THEN {WriteRope[message]; WriteRope[": NIL"]}
            ELSE
                WITH t: seb[sei] SELECT FROM
                    record => OutCtx[message, t.fieldCtx];
                    any => {WriteRope[message]; WriteRope[": ANY"]};
                    ENDCASE};

        PrintIndex: PROC [v: UNSPECIFIED] = LOOPHOLE[WriteDecimal];

        PrintLink: PROC [link: BcdDefs.Link] = {
            SELECT TRUE FROM
                link.proc => {
                    WriteRope["proc["]; WriteDecimal[link.gfi]; WriteChar[',]; WriteDecimal[link.ep]};
                link.type => {WriteRope["type["]; PrintIndex[link.typeID]};
                ENDCASE => {
                    WriteRope["var["]; WriteDecimal[link.gfi]; WriteChar[',]; WriteDecimal[link.var]};
            WriteChar[']]};

        PrintVersion: PROC [stamp: BcdDefs.VersionStamp] = {
            stampWords: CARDINAL = BcdDefs.VersionStamp.SIZE;
            str: PACKED ARRAY [0..4*stampWords) OF [0..16) = LOOPHOLE[stamp];
            digit: STRING = "0123456789abcdef"L;
            FOR i: NAT IN [0..4*stampWords) DO WriteChar[digit[str[i]]] ENDLOOP};

        }.