
    <<ListerUtilsImpl.mesa>>
        <<Copyright © 1984, 1985, 1986 by Xerox Corporation.  All rights reserved.>>
        <<Russ Atkinson (RRA) September 2, 1986 4:00:22 pm PDT>>
        <<Sweet October 8, 1985 9:38:39 am PDT>>
        <<Satterthwaite March 11, 1986 8:56:47 am PST>>

        DIRECTORY
            Basics USING [bytesPerWord],
            BasicTime USING [FromNSTime],
            BcdDefs USING [BCD, FTIndex, FTSelf, Link, MTIndex, MTNull, MTRecord, SGIndex, SGNull, SGRecord, VersionStamp],
            ConvertUnsafe USING [SubString],
            DefaultRemoteNames USING [Get],
            FS USING [BytesForPages, defaultStreamOptions, Error, minimumStreamBufferParms, StreamOpen, StreamOptions],
            ListerUtils USING [OpCodeArray, OpCodeArrayRep, OpCodeEntry],
            Literals USING [LitDescriptor, LTIndex, LTNull, LTRecord, MSTIndex, STIndex, STNull],
            IO USING [Close, EndOfStream, GetChar, GetInt, GetTokenRope, Put, PutChar, PutF, PutRope, SetIndex, SkipWhitespace, STREAM, 
            UnsafeGetBlock],
            Rope USING [Concat, Fetch, Flatten, Length, ROPE],
            RuntimeError USING [UNCAUGHT],
            SymbolPack,
            Symbols USING [BitAddress, BodyRecord, BTIndex, ContextLevel, CSEIndex, CTXIndex, CTXNull, CTXRecord, ISEIndex, ISENull, lG, lL, 
            lZ, MDIndex, Name, nullName, RootBti, SEIndex, SENull, SERecord, TransferMode, TypeClass, typeTYPE],
            SymbolTable USING [Base],
            Tree USING [Index, Link, Node, NodeName, NullIndex],
            VM USING [AddressForPageNumber, Allocate, BytesForPages, Free, Interval, MakeReadOnly];

    ListerUtilsImpl: PROGRAM
        IMPORTS BasicTime, DefaultRemoteNames, FS, IO, Rope, RuntimeError, SymbolPack, VM
        EXPORTS ListerUtils = BEGIN

    <<T Y P E S  &  C O N S T A N T S>>

        BCD: TYPE = BcdDefs.BCD;
        BitAddress: TYPE = Symbols.BitAddress;
        BTIndex: TYPE = Symbols.BTIndex;
        BTRecord: TYPE = Symbols.BodyRecord;
        bytesPerWord: NAT = Basics.bytesPerWord;
        CSEIndex: TYPE = Symbols.CSEIndex;
            typeTYPE: CSEIndex = Symbols.typeTYPE;
        ContextLevel: TYPE = Symbols.ContextLevel;
            lZ: ContextLevel = Symbols.lZ;
            lG: ContextLevel = Symbols.lG;
            lL: ContextLevel = Symbols.lL;
        CTXIndex: TYPE = Symbols.CTXIndex;
            CTXNull: CTXIndex = Symbols.CTXNull;
        CTXRecord: TYPE = Symbols.CTXRecord;
        FTIndex: TYPE = BcdDefs.FTIndex;
            FTSelf: FTIndex = BcdDefs.FTSelf;
        ISEIndex: TYPE = Symbols.ISEIndex;
            ISENull: ISEIndex = Symbols.ISENull;
        ISERecord: TYPE = SERecord.id;
        LTIndex: TYPE = Literals.LTIndex;
            LTNull: LTIndex = Literals.LTNull;
        LTRecord: TYPE = Literals.LTRecord;
        LitDescriptor: TYPE = Literals.LitDescriptor;
        MDIndex: TYPE = Symbols.MDIndex;
        MSTIndex: TYPE = Literals.MSTIndex;
            MSTNull: MSTIndex = LOOPHOLE[STNull];
        MTIndex: TYPE = BcdDefs.MTIndex;
            MTNull: MTIndex = BcdDefs.MTNull;
        MTRecord: TYPE = BcdDefs.MTRecord;
        Name: TYPE = Symbols.Name;
            nullName: Name = Symbols.nullName;
        NodeName: TYPE = Tree.NodeName;
        RefBCD: TYPE = REF BCD;
        RefMTRecord: TYPE = REF MTRecord;
        RefSGRecord: TYPE = REF SGRecord;
        RootBti: BTIndex = Symbols.RootBti;
        ROPE: TYPE = Rope.ROPE;
        SEIndex: TYPE = Symbols.SEIndex;
            SENull: SEIndex = Symbols.SENull;
        SERecord: TYPE = Symbols.SERecord;
        SGIndex: TYPE = BcdDefs.SGIndex;
            SGNull: SGIndex = BcdDefs.SGNull;
        SGRecord: TYPE = BcdDefs.SGRecord;
        STIndex: TYPE = Literals.STIndex;
            STNull: STIndex = Literals.STNull;
        STREAM: TYPE = IO.STREAM;
        SubString: TYPE = ConvertUnsafe.SubString;
        SymbolTableBase: TYPE = SymbolTable.Base;
        TransferMode: TYPE = Symbols.TransferMode;
        TypeClass: TYPE = Symbols.TypeClass;
        VersionStamp: TYPE = BcdDefs.VersionStamp;

    <<OpCode types & procedures>>
        <<>>
        opCodeArray: ListerUtils.OpCodeArray _ NIL;
        OpCodeFormatError: ERROR = CODE;

        GetOpCodeArray: PUBLIC PROC RETURNS [ListerUtils.OpCodeArray] = {
            IF opCodeArray = NIL THEN {
                stream: STREAM _ NIL;
                fileName: ROPE _ "OpCodes.txt";
                opCodeArray _ NEW[ListerUtils.OpCodeArrayRep _ ALL[[NIL, 0, 0, 0]]];
                stream _ FS.StreamOpen[fileName: fileName, accessOptions: $read, remoteCheck: FALSE
                    ! FS.Error => IF error.group # bug THEN CONTINUE];
                IF stream = NIL THEN {
                    fileName _ (DefaultRemoteNames.Get[].current).Concat["Compiler>OpCodes.txt"];
                    stream _ FS.StreamOpen[fileName: fileName, accessOptions: $read, remoteCheck: FALSE
                        ! FS.Error => IF error.group # bug THEN CONTINUE];
                    };
                IF stream # NIL THEN {
                    <<Parse the opcodes file.  Each entry has the form>>
                        <<name octal(decimal)push,pop,length,aligned;>>
                    <<where the octal number has no trailing 'B.  There can be comments and blank lines in the file, and we allow multiple entries per 
                    line.  Most, although not all, punctuation problems will cause ERROR OpCodeFormatError.>>
                    DO
                        ENABLE IO.EndOfStream => EXIT;
                        index: [0..256) _ 0;
                        entry: ListerUtils.OpCodeEntry _ [NIL, 0, 0, 0];
                        [] _ stream.SkipWhitespace[TRUE];
                        entry.name _ stream.GetTokenRope[].token;
                        WHILE stream.GetChar[] # '( DO ENDLOOP;
                        [] _ stream.SkipWhitespace[TRUE];
                        index _ stream.GetInt[];
                        IF stream.GetChar[] # ') THEN ERROR OpCodeFormatError;
                        entry.push _ stream.GetInt[];
                        IF stream.GetChar[] # ', THEN ERROR OpCodeFormatError;
                        entry.pop _ stream.GetInt[];
                        IF stream.GetChar[] # ', THEN ERROR OpCodeFormatError;
                        entry.length _ stream.GetInt[];
                        WHILE stream.GetChar[] # '; DO ENDLOOP;
                        opCodeArray[index] _ entry;
                        ENDLOOP;
                    stream.Close[]};
                };
            RETURN [opCodeArray];
            };

    <<Bcd acquisition procedures>>

        ReadBcd: PUBLIC PROC [fileName: ROPE] RETURNS [bcd: RefBCD] = {
            <<Reads the given BCD.  Allows FS.Error to fall through to the caller.>>
            stream: STREAM;
            options: FS.StreamOptions _ FS.defaultStreamOptions;
            options[tiogaRead] _ FALSE;
            stream _ FS.StreamOpen[
            fileName: fileName,
            streamOptions: options,
            streamBufferParms: FS.minimumStreamBufferParms];
            bcd _ NEW[BCD];
            [] _ stream.UnsafeGetBlock[
                [base: LOOPHOLE[bcd], startIndex: 0, count: BCD.SIZE*bytesPerWord]];
            IO.Close[stream];
            };
            <<>>
        ReadMtr: PUBLIC PROC [inStream: STREAM, bcd: RefBCD, mti: MTIndex] RETURNS [mtr: RefMTRecord _ NIL] = TRUSTED {
            <<Reads the given module record.>>
            IF mti # MTNull THEN {
                <<Get the module.>>
                mtr _ NEW[MTRecord];
                inStream.SetIndex[(bcd.mtOffset+LOOPHOLE[mti, CARDINAL])*bytesPerWord];
                [] _ inStream.UnsafeGetBlock[
                    [base: LOOPHOLE[mtr], startIndex: 0, count: MTRecord.SIZE*bytesPerWord]];
                };
            };
            <<>>
        ReadSgr: PUBLIC PROC [inStream: STREAM, bcd: RefBCD, sgi: SGIndex] RETURNS [sgr: RefSGRecord _ NIL] = TRUSTED {
            <<Reads the given module record.>>
            IF sgi # SGNull THEN {
                <<Get the module.>>
                sgr _ NEW[SGRecord];
                inStream.SetIndex[(bcd.sgOffset+LOOPHOLE[sgi, CARDINAL])*bytesPerWord];
                [] _ inStream.UnsafeGetBlock[
                    [base: LOOPHOLE[sgr], startIndex: 0, count: SGRecord.SIZE*bytesPerWord]];
                };
            };
            <<>>
        WithSegment: PUBLIC PROC [inStream: STREAM, bcd: RefBCD, sgi: SGIndex, inner: PROC [LONG POINTER]] = {
            <<Reads the given segment, invoking the inner procedure with a pointer to it.>>
            IF sgi # SGNull
                THEN {
                    <<Get the segment record.>>
                    sgr: RefSGRecord = ReadSgr[inStream, bcd, sgi];
                    pages: CARDINAL = IF bcd.extended THEN sgr.pages+sgr.extraPages ELSE sgr.pages;
                    IF pages = 0 OR sgr.file # FTSelf
                        THEN inner[NIL]
                        ELSE TRUSTED {
                            interval: VM.Interval = VM.Allocate[count: pages];
                            ptr: LONG POINTER = VM.AddressForPageNumber[interval.page];
                            inStream.SetIndex[index: FS.BytesForPages[sgr.base-1]];
                            [] _ inStream.UnsafeGetBlock[block: [base: ptr, startIndex: 0, count: VM.BytesForPages[interval.count]]];
                            <<(FS.OpenFileFromStream[inStream]).Read[sgr.base-1, interval.count, ptr];>>
                            VM.MakeReadOnly[interval];  -- don't want anyone messing with our tables
                            inner[ptr ! UNWIND => VM.Free[interval]];
                            VM.Free[interval];
                            };
                    }
                ELSE inner[NIL];
            };
            <<>>
        WithPages: PUBLIC PROC [inStream: STREAM, bcd: RefBCD, start,pages: CARDINAL, inner: PROC [LONG POINTER]] = {
            <<Reads the given segment, invoking the inner procedure with a pointer to it.>>
            IF pages # 0
                THEN TRUSTED {
                    <<Get the pages.>>
                    interval: VM.Interval = VM.Allocate[count: pages];
                    ptr: LONG POINTER = VM.AddressForPageNumber[interval.page];
                    inStream.SetIndex[index: FS.BytesForPages[start]];
                    [] _ inStream.UnsafeGetBlock[block: [base: ptr, startIndex: 0, count: VM.BytesForPages[interval.count]]];
                    <<(FS.OpenFileFromStream[inStream]).Read[start, interval.count, ptr];>>
                    VM.MakeReadOnly[interval];  -- don't want anyone messing with our tables
                    inner[ptr ! UNWIND => VM.Free[interval]];
                    VM.Free[interval];
                    }
                ELSE inner[NIL];
            };
            <<>>
    <<Utility procedures>>
        <<>>
        <<Some of these routines were cloned from various places to allow stream: STREAM and stb: SymbolTableBase as arguments, so we don't 
        have to use global variables.>>

        PrintSE: PUBLIC PROC [sei: ISEIndex, nBlanks: CARDINAL, definitionsOnly: BOOL, stream: STREAM, stb: SymbolTableBase] = {
            sep: LONG POINTER TO ISERecord = @stb.seb[sei];
            typeSei: SEIndex;
            Indent[stream, nBlanks];
            PrintSei[sei, stream, stb];
            stream.PutRope[" ["];
            PrintIndex[sei, stream];
            stream.PutChar[']];
            IF sep.public THEN stream.PutRope[" [public]"];
            IF sep.mark3 THEN {
                val: CARDINAL = LOOPHOLE[sep.idValue];
                idInfo: CARDINAL = LOOPHOLE[sep.idInfo];
                stream.PutRope[", type = "];
                IF sep.idType = typeTYPE
                    THEN {
                        typeSei _ sep.idInfo;
                        stream.PutRope["TYPE, equated to: "];
                        PrintType[typeSei, stream, stb];
                        IF stb.ctxb[sep.idCtx].level = lZ AND stb.TypeLink[sei] # SENull THEN
                            stream.PutF[", tag code: %g", [cardinal[val]]];
                        }
                    ELSE {
                        typeSei _ sep.idType;
                        PrintType[typeSei, stream, stb];
                        SELECT TRUE FROM
                            sep.constant => stream.PutRope[" [const]"];
                            sep.immutable => stream.PutRope[" [init only]"];
                            ENDCASE;
                        SELECT TRUE FROM
                            ~sep.mark4 =>
                                stream.PutF[", # refs: %g", [cardinal[idInfo]]];
                            sep.constant =>
                                IF ~ sep.extended THEN {
                                    stream.PutRope[", value: "];
                                    SELECT stb.XferMode[typeSei] FROM
                                        proc, program, signal, error =>
                                            PrintBcdLink[LOOPHOLE[val], stream];
                                        ENDCASE =>
                                            IF val < 1000 THEN stream.Put[[cardinal[val]]]
                                            ELSE stream.PutF["%b", [cardinal[val]]];
                                    };
                            (definitionsOnly AND stb.ctxb[sep.idCtx].level = lG) =>
                                stream.PutF[", index: %g", [cardinal[val]]];
                            ENDCASE => {
                                addr: BitAddress = LOOPHOLE[val];
                                stream.PutF[
                                    ", address: %g [%g:%g]",
                                    [cardinal[addr.wd]], [cardinal[addr.bd]], [cardinal[idInfo]]];
                                IF sep.linkSpace THEN stream.PutChar['*];
                                };
                        };
                PrintTypeInfo[typeSei, nBlanks+2, stream, stb];
                IF sep.extended THEN PrintTree[stb.FindExtension[sei].tree, nBlanks+4, stream, stb];
                };
            };

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

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

        PrintTree: PUBLIC PROC [tree: Tree.Link, nBlanks: NAT, stream: STREAM, stb: SymbolTableBase] = {
            PrintSubTree: PROC [tree: Tree.Link] = {
                Indent[stream, nBlanks];
                WITH s~~tree SELECT FROM
                    hash =>
                        PrintName[s.index, stream, stb];
                    symbol => {
                        PrintSei[s.index, stream, stb];
                        stream.PutChar['[];
                        PrintIndex[s.index, stream];
                        stream.PutChar[']]};
                    literal =>
                        PrintLiteral[s, stream, stb];
                    subtree => {
                        node: Tree.Index = s.index;
                        SELECT node FROM
                            Tree.NullIndex => stream.PutRope["<empty>"];
                            Tree.Index.LAST => stream.PutRope["<last>"];
                            ENDCASE => {
                                tp: LONG POINTER TO Tree.Node _ @stb.tb[node];
                                stream.PutRope[NodeNameTable[tp.name]];
                                stream.PutChar['[];
                                PrintIndex[node, stream];
                                stream.PutRope["] "];
                                IF tp.info # 0 THEN {
                                    stream.PutRope["  info="];
                                    PrintIndex[tp.info, stream]};
                                IF tp.attr1 OR tp.attr2 OR tp.attr3 THEN {
                                    IF tp.info = 0 THEN stream.PutChar[' ];
                                    stream.PutChar['(];
                                    IF tp.attr1 THEN stream.PutChar['1];
                                    IF tp.attr2 THEN stream.PutChar['2];
                                    IF tp.attr3 THEN stream.PutChar['3];
                                    stream.PutChar[')]};
                                nBlanks _ nBlanks + 2;
                                IF tp.name # thread THEN {
                                    EndIndex: Tree.Index = Tree.Index.LAST;
                                    EndMark: Tree.Link = [subtree[index: EndIndex]];
                                    n: NAT = tp.nSons;
                                    IF tp.name = list AND n = 0 THEN
                                        <<Very long lists have end markers, not explcit lengths.>>
                                        FOR i: NAT IN [1..NAT.LAST] DO
                                            son: Tree.Link = tp.son[i];
                                            IF son = EndMark THEN EXIT;
                                            PrintSubTree[tp.son[i]];
                                            ENDLOOP
                                    ELSE
                                        <<For all other nodes, believe the given length.>>
                                        FOR i: CARDINAL IN [1 .. n] DO
                                            PrintSubTree[tp.son[i]];
                                            ENDLOOP;
                                    }
                                ELSE {
                                    stream.PutRope[" link="];
                                    PrintTreeLink[tp.son[2], stream];
                                    stream.PutRope[" to "];
                                    PrintTreeLink[tp.son[1], stream]};
                                nBlanks _ nBlanks - 2};
                        };
                    ENDCASE => ERROR;
                };
            PrintSubTree[tree];
            };

        PrintLiteral: PUBLIC PROC [t: Tree.Link.literal, stream: STREAM, stb: SymbolTableBase] = {
            WITH t.index SELECT FROM
                string => {
                    msti: MSTIndex = MasterString[stb, sti];
                    s: LONG STRING = @stb.ltb[msti].string;
                    stream.PutChar['"];
                    FOR i: CARDINAL IN [0..s.length) DO stream.PutChar[s[i]] ENDLOOP;
                    stream.PutChar['"];
                    IF sti # msti THEN stream.PutChar['L]};
                word => {
                    desc: Literals.LitDescriptor = DescriptorValue[stb, lti];
                    v: WORD;
                    IF desc.length # 1 THEN stream.PutChar['[];
                    FOR i: CARDINAL IN [0 .. desc.length) DO
                        IF (v _ stb.ltb[desc.offset][i]) < 1000 THEN stream.Put[[cardinal[v]]]
                        ELSE stream.PutF["%b", [cardinal[v]]]; -- octal
                        IF i+1 # desc.length THEN stream.PutChar[',];
                        ENDLOOP;
                    IF desc.length # 1 THEN stream.PutChar[']]};
                ENDCASE;
            };

        PrintBcdLink: PUBLIC PROC [link: BcdDefs.Link, stream: STREAM] = {
            SELECT TRUE FROM
                link.proc =>
                    stream.PutF["proc[%g,%g]", [cardinal[link.gfi]], [cardinal[link.ep]]];
                link.type => {
                    stream.PutRope["type["]; PrintIndex[link.typeID, stream]};
                ENDCASE =>
                    stream.PutF["var[%g,%g]", [cardinal[link.gfi]], [cardinal[link.var]]];
            };

        PrintTreeLink: PUBLIC PROC [link: Tree.Link, stream: STREAM] = {
            WITH t~~link SELECT FROM
                subtree => PrintIndex[t.index, stream];
                hash => {stream.PutRope["hash#"]; PrintIndex[t.index, stream]};
                symbol => {stream.PutRope["symbol#"]; PrintIndex[t.index, stream]};
                literal => {stream.PutRope["literal#"]; PrintIndex[t.index, stream]};
                ENDCASE => ERROR;
            };

        PrintSei: PUBLIC PROC [sei: ISEIndex, stream: STREAM, stb: SymbolTableBase] = {
            PrintName[stb.NameForSe[sei], stream, stb];
            };

        PrintName: PUBLIC PROC [name: Name, stream: STREAM, stb: SymbolTableBase] = {
            IF name = nullName
                THEN stream.PutRope["(anon)"]
                ELSE {
                    ss: SubString = stb.SubStringForName[name];
                    FOR i: NAT IN [ss.offset..ss.offset+ss.length) DO
                        stream.PutChar[ss.base[i]];
                        ENDLOOP;
                    };
            };

        WriteNodeName: PUBLIC PROC [n: NodeName, stream: STREAM] = {
            stream.PutRope[NodeNameTable[n]];
            };

        WriteTypeName: PUBLIC PROC [n: TypeClass, stream: STREAM] = {
            stream.PutRope[TypeNameTable[n]];
            };

        WriteModeName: PUBLIC PROC [n: TransferMode, stream: STREAM] = {
            stream.PutRope[ModeNameTable[n]];
            };

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

        OutArgType: PUBLIC PROC [message: ROPE, sei: CSEIndex, stream: STREAM, stb: SymbolTableBase] = {
            IF sei = SENull
                THEN {stream.PutRope[message]; stream.PutRope[": NIL"]}
                ELSE
                    WITH t~~stb.seb[sei] SELECT FROM
                        record => OutCtx[message, t.fieldCtx, stream];
                        any => {stream.PutRope[message]; stream.PutRope[": ANY"]};
                        ENDCASE
            };

        PrintVersion: PUBLIC PROC [stamp: VersionStamp, stream: STREAM, useTime: BOOL _ FALSE] = {
            str: PACKED ARRAY [0..12) OF [0..16) = LOOPHOLE[stamp];
            FOR i: NAT IN [0..12) DO
                d: [0..16) = str[i];
                IF d < 10 THEN stream.PutChar['0+d] ELSE stream.PutChar['a-10+d];
                ENDLOOP;
            IF useTime THEN {
                IF stamp.net # 0 OR stamp.host # 0 THEN
                    stream.PutF[" (%g, %g, ", [cardinal[stamp.net]], [cardinal[stamp.host]]]
                ELSE stream.PutRope[" ("];
                <<This next statement is separate to deal with potential errors in time conversion.>>
                {ENABLE RuntimeError.UNCAUGHT => GO TO dreck;
                    stream.PutF["%g)", [time[BasicTime.FromNSTime[stamp.time]]]];
                    EXITS
                        dreck => stream.PutRope["??)"];
                    };
                };
            };

        PrintStringFromTable: PUBLIC PROC [index: CARDINAL, stream: STREAM, stb: SymbolTableBase] = {
            str: LONG STRING = stb.ssb;
            len: CARDINAL = str[index]-0C;
            FOR i: NAT IN [1..MIN[64, len]] DO
                stream.PutChar[str[i]];
                ENDLOOP;
            };

        PrintString: PUBLIC PROC [str: LONG STRING, stream: STREAM] = {
            IF str # NIL THEN 
                FOR i: NAT IN [0..str.length) DO
                    stream.PutChar[str[i]];
                    ENDLOOP;
            };

        PrintSubString: PUBLIC PROC [ss: SubString, stream: STREAM] = {
            FOR i: NAT IN [ss.offset..ss.offset+ss.length) DO stream.PutChar[ss.base[i]] ENDLOOP;
            };

        PrintIndex: PUBLIC PROC [index: UNSPECIFIED, stream: STREAM] = {
            stream.Put[[integer[LOOPHOLE[index, CARDINAL]]]];
            };

        Indent: PUBLIC PROC [stream: STREAM, nBlanks: NAT] = {
            stream.PutChar['\n];
            THROUGH [0..nBlanks) DO stream.PutChar[' ]; ENDLOOP;
            };

        DescriptorValue: PUBLIC PROC [stb: SymbolTableBase, lti: LTIndex] RETURNS [LitDescriptor] = {
            WITH entry~~stb.ltb[lti] SELECT FROM
                short => {
                    deltaShort: CARDINAL = LOOPHOLE[@(NIL[POINTER TO LTRecord.short]).value];
                    RETURN [[offset: LOOPHOLE[lti + deltaShort], length: 1]]};
                long => {
                    deltaLong: CARDINAL = LOOPHOLE[@(NIL[POINTER TO LTRecord.long]).value];
                    RETURN [[offset: LOOPHOLE[lti + deltaLong], length: entry.length]]};
                ENDCASE => ERROR;
            };

        MasterString: PUBLIC PROC [stb: SymbolTableBase, sti: STIndex] RETURNS [MSTIndex _ MSTNull] = {
            WITH s~~stb.ltb[sti] SELECT FROM
                master => RETURN [LOOPHOLE[sti]];
                copy => RETURN [s.link];
                heap => RETURN [s.link];
                ENDCASE;
            };

        ShortName: PUBLIC PROC [rope: ROPE] RETURNS [ROPE] = {
            pos: INT _ rope.Length[];
            bang: INT _ pos;
            WHILE pos > 0 DO
                under: INT = pos - 1;
                SELECT rope.Fetch[under] FROM
                    '! => bang _ under;
                    '>, '/, '<, '] => RETURN [rope.Flatten[pos, bang-pos]]; 
                    ENDCASE;
                pos _ under;
                ENDLOOP;
            RETURN [rope];
            };

    <<T A B L E S>>

        NodeNameArray: TYPE = ARRAY NodeName OF ROPE;
        NodeNameTable: PUBLIC REF NodeNameArray = NEW[NodeNameArray _[
        "list", "item", "decl", "typedecl", "basicTC", "enumeratedTC", "recordTC", "monitoredTC", "variantTC", "refTC", 
        "pointerTC", "listTC", "arrayTC", "arraydescTC", "sequenceTC", "procTC", "processTC", "portTC", "signalTC", "errorTC", 
        "programTC", "anyTC", "definitionTC", "unionTC", "relativeTC", "subrangeTC", "longTC", "opaqueTC", "zoneTC", "linkTC", 
        "varTC", "implicitTC", "frameTC", "discrimTC", "paintTC", "spareTC", "unit", "diritem", "module", "body", "inline", 
        "lambda", "block", "assign", "extract", "if", "case", "casetest", "caseswitch", "bind", "do", "forseq", "upthru", 
        "downthru", "return", "result", "goto", "exit", "loop", "free", "resume", "reject", "continue", "retry", "catchmark", 
        "restart", "stop", "lock", "wait", "notify", "broadcast", "unlock", "null", "label", "open", "enable", "catch", "dst", 
        "lste", "lstf", "syscall", "checked", "lst", "spareS3", "subst", "call", "portcall", "signal", "error", "syserror", 
        "xerror", "start", "join", "apply", "callx", "portcallx", "signalx", "errorx", "syserrorx", "startx", "fork", "joinx", 
        "index", "dindex", "seqindex", "reloc", "construct", "union", "rowcons", "sequence", "listcons", "substx", "ifx", "casex", 
        "bindx", "assignx", "extractx", "or", "and", "relE", "relN", "relL", "relGE", "relG", "relLE", "in", "notin", "plus", 
        "minus", "times", "div", "mod", "dot", "cdot", "dollar", "create", "not", "uminus", "addr", "uparrow", "min", "max", 
        "lengthen", "abs", "all", "size", "first", "last", "pred", "succ", "arraydesc", "length", "base", "loophole", "nil", "new", 
        "void", "clit", "llit", "cast", "check", "float", "pad", "chop", "safen", "syscallx", "narrow", "istype", "openx", 
        "mwconst", "cons", "atom", "typecode", "stringinit", "textlit", "signalinit", "procinit", "intOO", "intOC", "intCO", 
        "intCC", "thread", "none", "exlist", "initlist", "ditem", "shorten", "self", "gcrt", "proccheck", "ord", "val", "entry", 
        "internal", "mergecons"]];

        TypeNameArray: TYPE = ARRAY TypeClass OF ROPE;
        TypeNameTable: REF TypeNameArray = NEW[TypeNameArray _ [
        "mode", "basic", "enumerated", "record", "ref", "array", "arraydesc", "transfer", "definition", "union", "sequence", 
        "relative", "subrange", "long", "real", "opaque", "zone", "any", "nil"]];

        ModeNameArray: TYPE = ARRAY TransferMode OF ROPE;
        ModeNameTable: PUBLIC REF ModeNameArray = NEW[ModeNameArray _ [
        "proc", "port", "signal", "error", "process", "program", "none"]];

    END.