
    <<BcdListerImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Russ Atkinson (RRA) October 17, 1985 4:33:46 pm PDT>>
        <<Satterthwaite March 7, 1986 5:41:38 pm PST>>

    DIRECTORY
        Basics: TYPE USING [bitsPerWord],
        BcdDefs: TYPE USING [Base, BCD, ControlItem, CTIndex, CTNull, CTRecord, EVIndex, EVNull, EVRecord, EXPIndex, EXPRecord, FPIndex, 
        FPRecord, FTIndex, FTNull, FTRecord, FTSelf, IMPIndex, IMPRecord, LFIndex, LFNull, Link, LinkFrag, MTIndex, MTRecord, 
        Namee, NameRecord, NameString, NTIndex, NTNull, NTRecord, NullLink, RefLitFrag, RFIndex, RFNull, SGIndex, SGNull, SGRecord, 
        SpaceID, SPIndex, SPRecord, TFIndex, TFNull, TypeFrag, TYPIndex, TYPNull, TYPRecord, VersionStamp],
        BcdLister: TYPE USING [],
        FS: TYPE USING [Close, Error, nullOpenFile, Open, OpenFile, OpenFileFromStream, StreamOpen],
        IO: TYPE USING [Close, Put, PutChar, PutF, PutF1, PutFR, PutRope, RopeFromROS, ROS, STREAM],
        ListerUtils: TYPE USING [nullName, PrintName, PrintSei, PrintVersion, ReadBcd, ReadMtr, ReadSgr, RefBCD, SubString, WithPages],
        PrincOps: TYPE USING [globalbase],
        Rope: TYPE USING [Concat, Equal, Match, ROPE],
        SymbolPack: TYPE,
        Symbols: TYPE USING [Base, BitAddress, BodyRecord, BTIndex, BTNull, CBTIndex, ContextLevel, CSEIndex, CSENull, CTXIndex, CTXNull, 
        CTXRecord, HTIndex, ISEIndex, ISENull, lG, RootBti, SEIndex, SENull, SERecord, typeTYPE],
        SymbolTable: TYPE USING [Acquire, Base, Release];
BcdListerImpl: PROGRAM
    IMPORTS FS, IO, ListerUtils, Rope, SymbolPack, SymbolTable
    EXPORTS BcdLister = {

    Base: TYPE = BcdDefs.Base;
    BCD: TYPE = BcdDefs.BCD;
    BitAddress: TYPE = Symbols.BitAddress;
    bitsPerWord: NAT = Basics.bitsPerWord;
    BodyRecord: TYPE = Symbols.BodyRecord;
    BTIndex: TYPE = Symbols.BTIndex;
        RootBti: BTIndex = Symbols.RootBti;
    CBTIndex: TYPE = Symbols.CBTIndex;
    ContextLevel: TYPE = Symbols.ContextLevel;
        lG: ContextLevel = Symbols.lG;
    ControlItem: TYPE = BcdDefs.ControlItem;
    CSEIndex: TYPE = Symbols.CSEIndex;
        CSENull: CSEIndex = Symbols.CSENull;
        typeTYPE: CSEIndex = Symbols.typeTYPE;
    CTIndex: TYPE = BcdDefs.CTIndex;
        CTNull: CTIndex = BcdDefs.CTNull;
    CTRecord: TYPE = BcdDefs.CTRecord;
    CTXIndex: TYPE = Symbols.CTXIndex;
        CTXNull: CTXIndex = Symbols.CTXNull;
    CTXRecord: TYPE = Symbols.CTXRecord;
    EVIndex: TYPE = BcdDefs.EVIndex;
        EVNull: EVIndex = BcdDefs.EVNull;
    EVRecord: TYPE = BcdDefs.EVRecord;
    EXPIndex: TYPE = BcdDefs.EXPIndex;
    EXPRecord: TYPE = BcdDefs.EXPRecord;
    FPIndex: TYPE = BcdDefs.FPIndex;
    FPRecord: TYPE = BcdDefs.FPRecord;
    FTIndex: TYPE = BcdDefs.FTIndex;
        FTNull: FTIndex = BcdDefs.FTNull;
        FTSelf: FTIndex = BcdDefs.FTSelf;
    FTRecord: TYPE = BcdDefs.FTRecord;
    HTIndex: TYPE = Symbols.HTIndex;
    ISEIndex: TYPE = Symbols.ISEIndex;
        ISENull: ISEIndex = Symbols.ISENull;
    ISERecord: TYPE = SERecord.id;
    LFIndex: TYPE = BcdDefs.LFIndex;
        LFNull: LFIndex = BcdDefs.LFNull;
    LFRecord: TYPE = BcdDefs.LinkFrag;
    Link: TYPE = BcdDefs.Link;
        NullLink: Link = BcdDefs.NullLink;
    Namee: TYPE = BcdDefs.Namee;
    NameRecord: TYPE = BcdDefs.NameRecord;
    NameString: TYPE = BcdDefs.NameString;
    NTIndex: TYPE = BcdDefs.NTIndex;
        NTNull: NTIndex = BcdDefs.NTNull;
    NTRecord: TYPE = BcdDefs.NTRecord;
    IMPIndex: TYPE = BcdDefs.IMPIndex;
    IMPRecord: TYPE = BcdDefs.IMPRecord;
    MTIndex: TYPE = BcdDefs.MTIndex;
    MTRecord: TYPE = BcdDefs.MTRecord;
    RefBCD: TYPE = REF BCD;
    RefMTRecord: TYPE = REF MTRecord;
    RefSGRecord: TYPE = REF SGRecord;
    RFIndex: TYPE = BcdDefs.RFIndex;
        RFNull: RFIndex = BcdDefs.RFNull;
    RFRecord: TYPE = BcdDefs.RefLitFrag;
    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;
    SpaceID: TYPE = BcdDefs.SpaceID;
    SPIndex: TYPE = BcdDefs.SPIndex;
    SPRecord: TYPE = BcdDefs.SPRecord;
    STREAM: TYPE = IO.STREAM;
    SymbolTableBase: TYPE = SymbolTable.Base;
    TFIndex: TYPE = BcdDefs.TFIndex;
        TFNull: TFIndex = BcdDefs.TFNull;
    TFRecord: TYPE = BcdDefs.TypeFrag;
    TYPIndex: TYPE = BcdDefs.TYPIndex;
        TYPNull: TYPIndex = BcdDefs.TYPNull;
    TYPRecord: TYPE = BcdDefs.TYPRecord;
    VersionStamp: TYPE = BcdDefs.VersionStamp;

    ListBcd: PUBLIC PROC[stream, inStream: STREAM, bcd: RefBCD, cmd: ATOM] = {

        PrintStamps: PROC = {
            stream.PutRope["Imports:\n\n"];
            FOR iti: IMPIndex _ IMPIndex.FIRST, iti + IMPRecord.SIZE UNTIL iti = bcd.impLimit DO
                ip: LONG POINTER TO IMPRecord = @itb[iti];
                IF LOOPHOLE[iti, CARDINAL] > LOOPHOLE[bcd.impLimit, CARDINAL] THEN
                    GO TO Bogus;
                IF ip.namedInstance THEN {PutInstanceName[[import[iti]]]; stream.PutRope[": "]};
                PutName[ip.name];
                PutFileStamp[ip.file, ip.name];
                REPEAT 
                    Bogus => PrintGarbage[];
                ENDLOOP;
            stream.PutRope["\nExports:\n\n"];
            FOR eti: EXPIndex _ EXPIndex.FIRST, eti + etb[eti].size + EXPRecord.SIZE
                UNTIL eti = bcd.expLimit DO
                ee: LONG POINTER TO EXPRecord = @etb[eti];
                IF LOOPHOLE[eti, CARDINAL] > LOOPHOLE[bcd.expLimit, CARDINAL] THEN GO TO Bogus;
                IF ee.namedInstance THEN {PutInstanceName[[export[eti]]]; stream.PutRope[": "]};
                PutName[ee.name];
                PutFileStamp[ee.file, ee.name];
                REPEAT 
                    Bogus => PrintGarbage[];
                ENDLOOP;
            stream.PutRope["\nModules:\n\n"];
            FOR mti: MTIndex _ MTIndex.FIRST, mti + MTSize[mti] UNTIL mti = bcd.mtLimit DO
                mm: LONG POINTER TO MTRecord = @mtb[mti];
                IF LOOPHOLE[mti, CARDINAL] > LOOPHOLE[bcd.mtLimit, CARDINAL] THEN GO TO Bogus;
                IF mm.namedInstance THEN {PutInstanceName[[module[mti]]];  stream.PutRope[": "]};
                PutName[mm.name];
                PutFileStamp[mm.file, mm.name];
                REPEAT 
                    Bogus => PrintGarbage[];
                ENDLOOP;
            };

        PutFileStamp: PROC[fti: FTIndex, mName: NameRecord] = {
            SELECT fti FROM
                FTNull => stream.PutRope["(null)"];
                FTSelf => stream.PutRope["(self)"];
                ENDCASE => {
                    ftr: LONG POINTER TO FTRecord = @ftb[fti];
                    IF ftr.name # mName THEN {stream.PutRope[", file: "]; PutName[ftr.name]};
                    stream.PutRope[", version: "];
                    ListerUtils.PrintVersion[ftr.version, stream]};
            stream.PutChar['\n]};

        PrintHeader: PROC = {
            stream.PutF1["Configurations: %g", [cardinal[bcd.nConfigs]]];
            stream.PutF1[", Modules: %g", [cardinal[bcd.nModules]]];
            stream.PutF1[", Imports: %g", [cardinal[bcd.nImports]]];
            stream.PutF1[", Exports: %g", [cardinal[bcd.nExports]]];
            stream.PutF1[", Dummy: %g", [cardinal[bcd.firstdummy]]];
            stream.PutF1[", #Dummies: %g\n", [cardinal[bcd.nDummies]]];
            IF ~bcd.definitions THEN stream.PutChar['~];  
            stream.PutRope["definitions, "];
            IF ~bcd.repackaged THEN stream.PutChar['~];  
            stream.PutRope["repackaged, "];
            IF ~bcd.typeExported THEN stream.PutChar['~];  
            stream.PutRope["type exported, "];
            IF ~bcd.tableCompiled THEN stream.PutChar['~];  
            stream.PutRope["table compiled, "];
            IF ~bcd.versions THEN stream.PutChar['~];  
            stream.PutRope["versions, "];
            IF ~bcd.extended THEN stream.PutChar['~];  
            stream.PutRope["extended\n\n"]};

        PrintConfigs: PROC = {
            cti: CTIndex _ CTIndex.FIRST;
            stream.PutF["Configurations[%g]:\n", [cardinal[bcd.ctOffset]]];
            UNTIL cti = bcd.ctLimit DO
                PrintConfig[cti];
                cti _ cti + CTRecord.SIZE + ctb[cti].nControls*ControlItem.SIZE;
                IF LOOPHOLE[cti, CARDINAL] > LOOPHOLE[bcd.ctLimit, CARDINAL] THEN GO TO Bogus;
                REPEAT 
                    Bogus => PrintGarbage[];
                ENDLOOP;
            stream.PutChar['\n]};

        PrintConfig: PROC[cti: CTIndex] = {
            ctp: LONG POINTER TO CTRecord = @ctb[cti];
            Tab[2];
            PutName[ctp.name];
            PrintIndex[LOOPHOLE[cti]];
            IF ctp.namedInstance THEN {
                stream.PutRope[", instance name: "];
                PutInstanceName[[config[cti]]]};
            stream.PutRope[", file: "];
            PrintFileName[ctp.file];
            PrintIndex[LOOPHOLE[ctp.file]];
            IF cti # CTNull THEN {
                stream.PutRope[", parent: "];
                PutName[ctb[cti].name];
                PrintIndex[LOOPHOLE[cti]]};
            stream.PutF1[", #controls: %g", [cardinal[ctp.nControls]]];
            IF ctp.nControls # 0 THEN {
                stream.PutRope[", controls:"];
                FOR i: CARDINAL IN [0..ctp.nControls) DO
                    IF i MOD 6 = 0 THEN Tab[6] ELSE stream.PutRope[", "];
                    WITH c~~ctp.controls[i] SELECT FROM
                        module => PutName[mtb[c.mti].name];
                        config => {PutName[ctb[c.cti].name]; stream.PutChar['*]};
                        ENDCASE => ERROR;
                    PrintIndex[LOOPHOLE[ctp.controls[i]]];
                    ENDLOOP};
            stream.PutChar['\n]};

        PrintImports: PROC = {
            iti: IMPIndex _ IMPIndex.FIRST;
            stream.PutF["Imports[%g]:\n", [cardinal[bcd.impOffset]]];
            UNTIL iti = bcd.impLimit DO
                PrintImport[iti];
                iti _ iti + IMPRecord.SIZE;
                IF LOOPHOLE[iti, CARDINAL] > LOOPHOLE[bcd.impLimit, CARDINAL] THEN GO TO Bogus;
                REPEAT 
                    Bogus => PrintGarbage[];
                ENDLOOP;
            stream.PutRope["\n\n"]};

        PrintImport: PROC[iti: IMPIndex] = {
            imp: LONG POINTER TO IMPRecord = @itb[iti];
            Tab[2];
            PutName[imp.name];
            PrintIndex[LOOPHOLE[iti]];
            IF imp.port = $module THEN stream.PutRope[" (module)"];
            IF imp.namedInstance THEN {
                stream.PutRope[", instance name: "];
                PutInstanceName[[import[iti]]]};
            stream.PutRope[", file: "];
            PrintFileName[imp.file];
            PrintIndex[LOOPHOLE[imp.file]];
            stream.PutF[", gfi: %g, ngfi: %g", [cardinal[imp.gfi]], [cardinal[imp.ngfi]]]};

        PrintGlobals: PROC[] = {
            amperTable: AmperTable _ NIL;
            words: INT _ 0;
            frames: INT _ 0;
            totalProcs: INT _ 0;
            procs: INT _ 0;
            waste: INT _ 0;
            totalWaste: INT _ 0;
            gfiSlots: INT _ 0;
            AmperTable: TYPE = LIST OF AmperTableEntry;
            AmperTableEntry: TYPE = RECORD [name: ROPE, count: INT, size: INT];
            FOR mti: MTIndex _ MTIndex.FIRST, mti + MTSize[mti] UNTIL mti = bcd.mtLimit DO
                mtr: LONG POINTER TO MTRecord = @mtb[mti];
                frameSize: CARDINAL _ mtr.framesize;
                gfis: CARDINAL _ mtr.ngfi;
                DoBody: PROC[symbols: SymbolTableBase] = {
                    DoFields: PROC[rSei: CSEIndex] RETURNS[maxSpan: CARDINAL _ 0] = {
                        WITH t~~symbols.seb[rSei] SELECT FROM
                            record => maxSpan _ DoContext[t.fieldCtx];
                            ENDCASE;
                        };
                    DoContext: PROC[ctx: CTXIndex] RETURNS[maxSpan: CARDINAL _ 0] = {
                        FOR sei: ISEIndex _ symbols.FirstCtxSe[ctx], symbols.NextSe[sei]
                            UNTIL sei = ISENull DO
                            IF ~symbols.seb[sei].constant THEN maxSpan _ MAX[DoSymbol[sei], maxSpan];
                            ENDLOOP;
                        };
                    DoSymbol: PROC[sei: ISEIndex] RETURNS[span: CARDINAL] = {
                        addr: BitAddress = symbols.seb[sei].idValue;
                        size: CARDINAL = (symbols.seb[sei].idInfo+bitsPerWord-1) / bitsPerWord;
                        hti: HTIndex = symbols.NameForSe[sei];
                        stream.PutRope["    "];
                        IF hti # ListerUtils.nullName THEN {
                            <<check for leading &>>
                        ss: ListerUtils.SubString = symbols.SubStringForName[hti];
                            IF ss.length # 0 AND ss.base[ss.offset] = '& THEN {
                                ros: STREAM _ IO.ROS[];
                                rope: ROPE _ NIL;
                                ListerUtils.PrintName[hti, ros, symbols];
                                rope _ ros.RopeFromROS[];
                                FOR each: AmperTable _ amperTable, each.rest WHILE each # NIL DO
                                    IF (each.first.name).Equal[rope] THEN {
                                        each.first.size _ each.first.size + size;
                                        each.first.count _ each.first.count + 1;
                                        GO TO found};
                                    ENDLOOP;
                                amperTable _ CONS [[name: rope, count: 1, size: size], amperTable];
                                EXITS found => {};
                                };
                            };
                        ListerUtils.PrintName[hti, stream, symbols];
                        stream.PutF1["\t%g\n", [cardinal[size]]];
                        RETURN[addr.wd + size]};
                    CountProcs: PROC RETURNS[n: CARDINAL _ 0] = TRUSTED {
                        <<Counts all of the procedures>>
                        prev: Symbols.BTIndex _ FIRST[Symbols.BTIndex];
                        bti: Symbols.BTIndex _ prev;
                        DO
                            WITH body~~symbols.bb[bti] SELECT FROM
                                Callable => IF NOT body.inline THEN n _ n + 1;
                                ENDCASE;
                            IF symbols.bb[bti].firstSon # Symbols.BTNull THEN bti _ symbols.bb[bti].firstSon
                            ELSE DO
                                prev _ bti;
                                bti _ symbols.bb[bti].link.index;
                                IF bti = Symbols.BTNull THEN RETURN;
                                IF symbols.bb[prev].link.which # parent THEN EXIT;
                                ENDLOOP;
                            ENDLOOP;
                        };
                    bti: CBTIndex _ LOOPHOLE[RootBti];
                    frameOverhead: CARDINAL = PrincOps.globalbase+1; -- for start trap pointer
                    maxSpan: CARDINAL _ frameOverhead-1;
                    typeIn, typeOut: CSEIndex;

                    IF symbols = NIL THEN {
                        <<No symbols, so say so>>
                        stream.PutRope["Sorry, no symbols available (file must be local).\n"];
                        RETURN};

                    [typeIn, typeOut] _ symbols.TransferTypes[symbols.bb[bti].ioType];
                    IF typeIn # CSENull THEN {
                        stream.PutRope["  Global arguments:\n"];
                        maxSpan _ MAX[DoFields[typeIn], maxSpan]};
                    IF typeOut # CSENull THEN {
                        stream.PutRope["  Global results:\n"];
                        maxSpan _ MAX[DoFields[typeOut], maxSpan]};
                    IF symbols.bb[bti].localCtx # CTXNull THEN {
                        stream.PutRope["  Global variables: (name & words)\n"];
                        maxSpan _ MAX[DoContext[symbols.bb[bti].localCtx], maxSpan]};
                    IF ~symbols.bb[bti].hints.noStrings THEN
                        stream.PutRope["  Global string literals or string bodies\n"];
                    IF maxSpan # frameSize AND frameSize > frameOverhead THEN
                        stream.PutF1[
                            "  %g words not in listed variables or overhead\n",
                            [integer[frameSize - maxSpan]]];
                    stream.PutRope["\n"];
                    procs _ CountProcs[]};
                IF LOOPHOLE[mti, CARDINAL] > LOOPHOLE[bcd.mtLimit, CARDINAL] THEN GO TO Bogus;
                IF mtr.namedInstance THEN {PutInstanceName[[module[mti]]]; stream.PutRope[": "]};
                PutName[mtr.name];
                PutFileStamp[mtr.file, mtr.name];

                frames _ frames + 1;
                procs _ 0;

                WithSymbolsForModule[mti, DoBody];

                IF procs # 0 THEN {
                    waste _ gfis*32-procs;
                    stream.PutF["Global frame size: %g, gfi slots: %g, procs: %g (waste: %g)\n\n",
                        [cardinal[frameSize]],
                        [cardinal[gfis]],
                        [cardinal[procs]],
                        [integer[waste]]
                        ]}
                ELSE {
                    stream.PutF["Global frame size: %g, gfi slots: %g, procs: ?? (waste: ??)\n\n",
                        [cardinal[frameSize]],
                        [cardinal[gfis]]
                        ];
                    };

                gfiSlots _ gfiSlots + gfis;
                words _ words + frameSize;
                totalWaste _ totalWaste + waste;
                totalProcs _ totalProcs + procs;

                REPEAT 
                    Bogus => PrintGarbage[];
                ENDLOOP;
            IF frames > 1 THEN {
                stream.PutF["%g words in %g frames using %g gfi slots, %g procs (%g waste)\n",
                    [cardinal[words]],
                    [cardinal[frames]],
                    [cardinal[gfiSlots]],
                    [cardinal[totalProcs]],
                    [cardinal[totalWaste]]
                    ];
                stream.PutRope["\n&-variables\n"];
                FOR each: AmperTable _ amperTable, each.rest WHILE each # NIL DO
                    stream.PutF["\t%g\t%g\t%g\n",
                        [rope[each.first.name]], [integer[each.first.count]], [integer[each.first.size]]];
                    ENDLOOP;
                };
            };

        WithSymbolsForModule: PROC[mti: MTIndex, inner: PROC[symbols: SymbolTableBase]] = {
            mm: LONG POINTER TO MTRecord = @mtb[mti];
            IF mm.sseg = SGNull THEN GO TO loser
            ELSE {
                symbols: SymbolTableBase _ NIL;
                sgr: LONG POINTER TO SGRecord = @sgb[mm.sseg];
                start: CARDINAL _ sgr.base;
                pages: CARDINAL _ sgr.pages;
                file: FS.OpenFile _ FS.nullOpenFile;
                nBcd: RefBCD _ bcd;
                version: VersionStamp _ bcd.version;
                IF start = 0 OR sgr.pages = 0 OR sgr.file = FTNull THEN GO TO loser;
                start _ start - 1;
                SELECT sgr.file FROM
                    FTSelf => {
                        <<There really is no problem, since the symbols are already here.>>
                        ENABLE UNWIND => IF symbols # NIL THEN SymbolTable.Release[symbols];
                        version _ bcd.version;
                        file _ FS.OpenFileFromStream[inStream]};
                    ENDCASE => {
                        <<We have to pull in the symbols from the file system.>>
                        ftr: LONG POINTER TO FTRecord = @ftb[sgr.file];
                        fileName: ROPE _ NameToRope[ftr.name].Concat[".bcd"];
                        version _ ftr.version;
                        file _ FS.Open[fileName, $read
                            ! FS.Error => IF error.group # bug THEN GO TO loser];
                        nBcd _ ListerUtils.ReadBcd[fileName]};
                version _ bcd.version;
                IF nBcd.extended THEN pages _ pages + sgr.extraPages;
                {ENABLE
                    UNWIND => {
                        IF symbols # NIL THEN SymbolTable.Release[symbols];
                        file.Close[]};
                    inner[symbols _ SymbolTable.Acquire[[file, [start, pages]]]];
                    SymbolTable.Release[symbols];
                    IF bcd # nBcd THEN file.Close[];
                    };
                };
            EXITS
                loser => inner[NIL];
            };

        PrintExports: PROC[printOffset: BOOL] = {
            eti: EXPIndex _ EXPIndex.FIRST;
            IF printOffset THEN stream.PutF1["Exports[%g]:\n", [cardinal[bcd.expOffset]]];
            UNTIL eti = bcd.expLimit DO
                PrintExport[eti];
                eti _ eti + etb[eti].size + EXPRecord.SIZE;
                IF LOOPHOLE[eti, CARDINAL] > LOOPHOLE[bcd.expLimit, CARDINAL] THEN GO TO Bogus;
                REPEAT 
                    Bogus => PrintGarbage[];
                ENDLOOP;
            IF dumpLinks # all THEN stream.PutChar['\n];
            stream.PutChar['\n]};

        PrintExport: PROC[eti: EXPIndex] = {
            etr: LONG POINTER TO EXPRecord = @etb[eti];
            size: CARDINAL _ etr.size;
            Tab[2];
            PutName[etr.name];
            PrintIndex[LOOPHOLE[eti]];
            IF etr.port = $module THEN stream.PutRope[" (module)"];
            IF etr.namedInstance THEN {
                stream.PutRope[", instance name: "];
                PutInstanceName[[export[eti]]]};
            stream.PutRope[", file: "];
            PrintFileName[etr.file];
            PrintIndex[LOOPHOLE[etr.file]];
            stream.PutRope[", "]; 
            IF ~etr.typeExported THEN stream.PutChar['~];  
            stream.PutF1["typeExported, #links: %g", [cardinal[etr.size]]];
            IF dumpLinks = all THEN {
                bcdName: ROPE = NameToRope[ftb[etr.file].name].Concat[".bcd"];
                bcdVersion: VersionStamp = ftb[etr.file].version;
                exbcd: RefBCD _ NIL;
                inner: PROC[exstb: SymbolTableBase] = {
                    FOR i: CARDINAL IN [0..size) DO
                        link: Link = etr.links[i];
                        name: ROPE = NameFromIndex[exbcd, exstb, i];
                        isInline: BOOL = Rope.Match["*[inline]*", name, FALSE];
                        isUnbound: BOOL = link = NullLink AND NOT isInline;
                        IF cmd = $Unbound AND NOT isUnbound THEN LOOP;
                        stream.PutRope["\n\t\t"];
                        IF isUnbound THEN stream.PutRope["** unbound ** "];
                        stream.PutRope[name];
                        IF cmd = $Unbound THEN LOOP;
                        stream.PutRope[": "];
                        SELECT TRUE FROM
                            (link = NullLink) => 
                                stream.PutRope["(null link)"];
                            link.proc => 
                                stream.PutF["proc[%g,%g]", [cardinal[link.gfi]], [cardinal[link.ep]]];
                            link.type =>
                                IF link.typeID = TYPNull THEN stream.PutRope["type[null]"]
                                ELSE stream.PutF1["type[%g]", [cardinal[LOOPHOLE[link.typeID, CARDINAL]]]]
                            ENDCASE => 
                                stream.PutF["var[%g,%g]", [cardinal[link.vgfi]], [cardinal[link.var]]];
                        ENDLOOP;
                    };
                stream.PutRope[", links:"];
                exbcd _ ListerUtils.ReadBcd[bcdName ! FS.Error => CONTINUE];
                SELECT TRUE FROM
                    exbcd = NIL => {
                        stream.PutRope[bcdName];
                        stream.PutRope[" not found.\n"];
                        inner[NIL]};
                    exbcd.version # bcdVersion => {
                        stream.PutRope[bcdName];
                        stream.PutRope[", version "];
                        ListerUtils.PrintVersion[exbcd.version, stream];
                        stream.PutRope["found, version "];
                        ListerUtils.PrintVersion[bcdVersion, stream];
                        stream.PutRope["needed.\n"];
                        exbcd _ NIL;
                        inner[NIL]};
                    ENDCASE => {
                        file: STREAM = FS.StreamOpen[bcdName, $read];
                        mtr: RefMTRecord = ListerUtils.ReadMtr[file, exbcd, LOOPHOLE[0]];
                        sgr: RefSGRecord = ListerUtils.ReadSgr[file, exbcd, mtr.sseg];
                        pages: CARDINAL = IF exbcd.extended THEN sgr.pages+sgr.extraPages ELSE sgr.pages;
                        exstb: SymbolTable.Base _ SymbolTable.Acquire[
                            [FS.OpenFileFromStream[file], [sgr.base-1, pages]]];
                        inner[exstb
                            ! UNWIND => {SymbolTable.Release[exstb]; file.Close[]}];
                        SymbolTable.Release[exstb];
                        file.Close[]};
                stream.PutChar['\n];
                };
            };

        PrintExpVars: PROC = {
            evi: EVIndex _ EVIndex.FIRST;
            evLimit: EVIndex = bcd.evLimit;
            stream.PutRope["Exported variables:\n"];
            UNTIL evi = evLimit DO
                PrintExpVar[evi]; 
                evi _ evi + evb[evi].length + EVRecord.SIZE; 
                ENDLOOP;
            stream.PutChar['\n]};

        PrintExpVar: PROC[evi: EVIndex] = {
            evr: LONG POINTER TO EVRecord = @evb[evi];
            Tab[2];
            stream.PutF["%g, #offsets: %g, offsets:",
            [cardinal[LOOPHOLE[evi, CARDINAL]]], [cardinal[evr.length]]];
            FOR i: CARDINAL IN [1..evr.length] DO
                IF i MOD 8 = 1 THEN Tab[4] ELSE stream.PutChar[' ];
                stream.PutF1["%b", [cardinal[evr.offsets[i]]]];
                IF i # evr.length THEN stream.PutChar[',];
                ENDLOOP;
            stream.PutChar['\n]};

        PrintSpaces: PROC = {
            spi: SPIndex _ SPIndex.FIRST;
            spLimit: SPIndex = bcd.spLimit;
            stream.PutRope["Spaces:\n"];
            UNTIL spi = spLimit DO
                PrintSpace[spi];
                spi _ spi + SPRecord.SIZE + spb[spi].length*SpaceID.SIZE;
                ENDLOOP;
            stream.PutChar['\n]};

        PrintSpace: PROC[spi: SPIndex] = {
            spr: LONG POINTER TO SPRecord = @spb[spi];
            Tab[2];
            PrintIndex[LOOPHOLE[spi, CARDINAL]];
            stream.PutF1[", segment: [%g]", [cardinal[LOOPHOLE[spr.seg, CARDINAL]]]];
            stream.PutF1[", #code packs: %g", [cardinal[spr.length]]];
            IF spr.length # 0 THEN stream.PutRope[", code packs: "];
            FOR i: CARDINAL IN [0..spr.length) DO
                Tab[4];
                stream.PutRope["  code pack "];
                PutName[spr.spaces[i].name];
                stream.PutRope[", "];
                IF ~spr.spaces[i].resident THEN stream.PutChar['~];
                stream.PutF["resident, offset: %b, pages: %g\n",
                [cardinal[spr.spaces[i].offset]], [cardinal[spr.spaces[i].pages]]];
                ENDLOOP;
            };

        PrintModules: PROC = {
            mti: MTIndex _ MTIndex.FIRST;
            stream.PutF1["Modules[%g]:\n", [cardinal[bcd.mtOffset]]];
            UNTIL mti = bcd.mtLimit DO
                PrintModule[@mtb[mti], mti];
                mti _ mti + MTSize[mti];
                IF LOOPHOLE[mti, CARDINAL] > LOOPHOLE[bcd.mtLimit, CARDINAL] THEN GO TO Bogus;
                REPEAT 
                    Bogus => PrintGarbage[];
                ENDLOOP;
            stream.PutChar['\n]};

        PrintModule: PROC[mth: LONG POINTER TO MTRecord, mti: MTIndex] = {
            Tab[2];
            PutName[mth.name];
            PrintIndex[LOOPHOLE[mti]];
            IF mth.namedInstance THEN {
                stream.PutRope["instance name: "];
                PutInstanceName[[module[mti]]]};
            stream.PutRope[", file: "];
            PrintFileName[mth.file];
            PrintIndex[LOOPHOLE[mth.file]];
            IF mth.config # CTNull THEN {
                stream.PutRope[", config: "];
                PutName[ctb[mth.config].name];
                PrintIndex[LOOPHOLE[mth.config]]};
            Tab[4];
            IF mth.tableCompiled THEN stream.PutRope["table compiled, "] ELSE {

                PutSwitch: PROC[sw: CHAR, value: BOOL] = {
                    IF ~value THEN stream.PutChar['-];  stream.PutChar[sw]};

                stream.PutRope["switches: "];
                PutSwitch['b, mth.boundsChecks];
                PutSwitch['c, mth.long];
                PutSwitch['j, mth.crossJumped];
                PutSwitch['l, mth.linkLoc = $code];
                PutSwitch['n, mth.nilChecks];
                PutSwitch['s, ~mth.initial];
                stream.PutRope[", "]};
            IF ~mth.packageable THEN stream.PutChar['~];  stream.PutRope["packageable, "];
            IF mth.residentFrame THEN stream.PutRope["resident frame, "];
            Tab[4];
            stream.PutF["framesize: %g, gfi: %g, ngfi: %g, links: ",
            [cardinal[mth.framesize]], [cardinal[mth.gfi]], [cardinal[mth.ngfi]]];
            IF mth.linkLoc = $frame THEN stream.PutRope["frame"] ELSE stream.PutRope["code"];
            Tab[4];
            stream.PutRope["code: "];  PrintSegment[mth.code.sgi];
            stream.PutF[", offset: %b, length: %b",
            [cardinal[mth.code.offset]], [cardinal[mth.code.length]]];
            IF mth.code.linkspace THEN stream.PutRope[", link space"];
            IF mth.code.packed THEN stream.PutRope[", packed"];
            Tab[4];
            stream.PutRope["symbols: "];
            PrintSegment[mth.sseg];
            IF mth.variables # EVNull THEN {
                Tab[4];
                stream.PutF1[
                    "exported variables: [%g]", [cardinal[LOOPHOLE[mth.variables, CARDINAL]]]];
                };
            WITH mm~~mth^ SELECT FROM
                direct => {
                    Tab[4];
                    stream.PutF1["#links: %g", [cardinal[mm.length]]];
                    IF dumpLinks = all THEN {
                        stream.PutRope[", links:"];
                        FOR i: CARDINAL IN [0..mm.length) DO
                            IF i MOD 7 = 0 THEN Tab[6] ELSE stream.PutChar[' ];
                            PrintControlLink[mm.frag[i]];
                            IF i + 1 # mm.length THEN stream.PutChar[',];
                            ENDLOOP}};
                indirect => {Tab[4];  PrintLinks[mm.links]};
                multiple => {
                    Tab[4];
                    PrintLinks[mm.links];
                    Tab[4];
                    PrintTypes[mm.types];
                    IF mm.frameRefs THEN {
                        Tab[5];
                        stream.PutF1["frame type: %g", [cardinal[mm.frameType]]]};
                    Tab[4];
                    PrintRefLits[mm.refLiterals]};
                ENDCASE;
            stream.PutChar['\n]};

        MTSize: PROC[mti: MTIndex] RETURNS[NAT] = {
            RETURN[WITH m~~mtb[mti] SELECT FROM
                direct => MTRecord.direct.SIZE + m.length*Link.SIZE,
                indirect => MTRecord.indirect.SIZE,
                multiple => MTRecord.multiple.SIZE,
                ENDCASE => ERROR]
            };

        PrintLinks: PROC[lfi: LFIndex] = {
            stream.PutRope["#links: "];
            IF lfi = LFNull THEN stream.PutRope["none"]
            ELSE {
                stream.Put[[cardinal[lfb[lfi].length]]];
                IF dumpLinks = all THEN {
                    stream.PutRope[", links:"];
                    FOR i: CARDINAL IN [0..lfb[lfi].length) DO
                        IF i MOD 7 = 0 THEN Tab[6] ELSE stream.PutChar[' ];
                        PrintControlLink[lfb[lfi].frag[i]];
                        IF i + 1 # lfb[lfi].length THEN stream.PutChar[',];
                        ENDLOOP;
                    };
                };
            };

        PrintTypes: PROC[tfi: TFIndex] = {
            stream.PutRope["#types: "];
            IF tfi = TFNull THEN stream.PutRope["none"]
            ELSE {
                stream.PutF["%g, offset: %g", [cardinal[tfb[tfi].length]], [cardinal[tfb[tfi].offset]]];
                IF dumpLinks # none THEN {
                    stream.PutRope[", indices:"];
                    FOR i: CARDINAL IN [0..tfb[tfi].length) DO
                        IF i MOD 7 = 0 THEN Tab[6] ELSE stream.PutChar[' ];
                        stream.PutF1["[%g]", [cardinal[tfb[tfi].frag[i]]]];
                        IF i + 1 # tfb[tfi].length THEN stream.PutChar[',];
                        ENDLOOP;
                    };
                };
            };

        PrintRefLits: PROC[rfi: RFIndex] = {
            stream.PutRope["#ref lits: "];
            IF rfi = RFNull THEN stream.PutRope["none"]
            ELSE {
                stream.PutF["%g, offset: %g", [cardinal[rfb[rfi].length]], [cardinal[rfb[rfi].offset]]];
                IF dumpLinks # none THEN {
                    stream.PutRope[", indices:"];
                    FOR i: CARDINAL IN [0..rfb[rfi].length) DO
                        IF i MOD 7 = 0 THEN Tab[6] ELSE stream.PutChar[' ];
                        stream.PutF1["[%g]", [cardinal[rfb[rfi].frag[i]]]];
                        IF i + 1 # rfb[rfi].length THEN stream.PutChar[',];
                        ENDLOOP;
                    };
                };
            };

        PrintFramePacks: PROC = {
            fpi: FPIndex _ FPIndex.FIRST;
            fpLimit: FPIndex = bcd.fpLimit;
            stream.PutRope["Frame Packs:\n"];
            UNTIL fpi = fpLimit DO
                PrintFramePack[fpi];
                fpi _ fpi + FPRecord.SIZE + fpb[fpi].length*MTIndex.SIZE;
                ENDLOOP;
            stream.PutChar['\n]};

        PrintFramePack: PROC[fpi: FPIndex] = {
            fpr: LONG POINTER TO FPRecord = @fpb[fpi];
            Tab[2];
            PutName[fpr.name];
            stream.PutF["[%g], #modules: %g, modules:\n",
            [cardinal[LOOPHOLE[fpi, CARDINAL]]], [cardinal[fpr.length]]];
            FOR i: CARDINAL IN [0..fpr.length) DO
                IF i MOD 4 = 0 THEN Tab[4] ELSE stream.PutChar[' ];
                PutName[mtb[fpr.modules[i]].name];
                PrintIndex[LOOPHOLE[fpr.modules[i]]];
                IF i # fpr.length - 1 THEN stream.PutChar[',];
                ENDLOOP;
            stream.PutChar['\n]};

        PrintSegment: PROC[sgi: SGIndex] = {
            IF sgi = SGNull THEN stream.PutRope["(null)"]
            ELSE {
                PrintFileName[sgb[sgi].file];
                stream.PutF[" [base: %g, pages: %g",
                [cardinal[sgb[sgi].base]], [cardinal[sgb[sgi].pages]]];
                IF sgb[sgi].extraPages # 0 THEN
                    stream.PutF["+%g", [cardinal[sgb[sgi].extraPages]]];
                stream.PutChar[']]};
            };

        PrintFiles: PROC = {
            fti: FTIndex _ FTIndex.FIRST;
            stream.PutF1["Files[%g]:\n", [cardinal[bcd.ftOffset]]];
            UNTIL fti = bcd.ftLimit DO
                PrintFile[fti];
                fti _ fti + FTRecord.SIZE;
                IF LOOPHOLE[fti, CARDINAL] > LOOPHOLE[bcd.ftLimit, CARDINAL] THEN {
                    PrintGarbage[];
                    EXIT};
                ENDLOOP;
            stream.PutRope["\n\n"]};

        PrintFile: PROC[fti: FTIndex] = {
            Tab[2];
            SELECT fti FROM
                FTNull => stream.PutRope["(null)"];
                FTSelf => stream.PutRope["(self)"];
                ENDCASE => {
                    ftr: LONG POINTER TO FTRecord = @ftb[fti];
                    PutName[ftr.name];
                    PrintIndex[LOOPHOLE[fti]];
                    stream.PutRope[", version: "];
                    ListerUtils.PrintVersion[ftr.version, stream]};
            };

        <<Utility Prints>>

        PrintControlLink: PROC[link: Link] = {
            SELECT TRUE FROM
                (link = NullLink) => 
                    stream.PutRope["(null link)"];
                link.proc => 
                    stream.PutF["proc[%g,%g]", [cardinal[link.gfi]], [cardinal[link.ep]]];
                link.type =>
                    IF link.typeID = TYPNull THEN stream.PutRope["type[null]"]
                    ELSE stream.PutF1["type[%g]", [cardinal[LOOPHOLE[link.typeID, CARDINAL]]]]
                ENDCASE => 
                    stream.PutF["var[%g,%g]", [cardinal[link.vgfi]], [cardinal[link.var]]];
            };

        PrintFileName: PROC[fti: FTIndex] = {
            SELECT fti FROM
                FTNull => stream.PutRope["(null)"];
                FTSelf => stream.PutRope["(self)"];
                ENDCASE => PutName[ftb[fti].name];
            };

        PrintIndex: PROC[index: CARDINAL] = {
            stream.PutF1[" [%g]", [cardinal[index]]]};

        PrintGarbage: PROC = {
            Tab[2];
            stream.PutRope["? Looks like garbage ...\n"];
            };

        Tab: PROC[n: CARDINAL] = {
            stream.PutChar['\n];
            THROUGH [1..n/8] DO stream.PutChar['\t] ENDLOOP;
            THROUGH [1..n MOD 8] DO stream.PutChar[' ] ENDLOOP};

        <<Utility Puts>>

        PutName: PROC[n: NameRecord] = {
            CharSeq: TYPE = RECORD[PACKED SEQUENCE COMPUTED CARDINAL OF CHAR];
            ss: LONG POINTER TO CharSeq = LOOPHOLE[ssb];
            index: CARDINAL = n+3;
            len: CARDINAL = ss[index]-0C;
            FOR i: NAT IN [index+1..index+len] DO
                stream.PutChar[ss[i]];
                ENDLOOP};

        NameToRope: PROC[n: NameRecord] RETURNS[ROPE] = {
            CharSeq: TYPE = RECORD[PACKED SEQUENCE COMPUTED CARDINAL OF CHAR];
            ss: LONG POINTER TO CharSeq = LOOPHOLE[ssb];
            index: CARDINAL = n+3;
            len: CARDINAL = ss[index]-0C;
            ros: STREAM = IO.ROS[];
            FOR i: NAT IN [index+1..index+len] DO
                ros.PutChar[ss[i]];
                ENDLOOP;
            RETURN[ros.RopeFromROS[]]};

        PutInstanceName: PROC[n: Namee] = {
            FindName: PROC[ntb: Base, nti: NTIndex] RETURNS[stop: BOOL] = {
                RETURN[ntb[nti].item = n];
                };
            nti: NTIndex = EnumerateNameTable[FindName];
            IF nti = NTNull THEN stream.PutRope[" (anon) "] ELSE PutName[ntb[nti].name]};

        EnumerateNameTable: PROC[
            proc: PROC[Base, NTIndex] RETURNS[BOOL]] RETURNS[nti: NTIndex] = {
            FOR nti _ NTIndex.FIRST, nti + NTRecord.SIZE UNTIL nti = bcd.ntLimit DO
                IF proc[ntb, nti] THEN RETURN[nti]; 
                ENDLOOP;
            RETURN[NTNull]};

        <<Executable part of ListBcd>>

        inner: PROC[ptr: LONG POINTER] = {
            tb _ LOOPHOLE[ptr];
            ssb _ LOOPHOLE[ptr + bcd.ssOffset];
            ctb _ tb + bcd.ctOffset;
            mtb _ tb + bcd.mtOffset;
            IF bcd.extended THEN {
                lfb _ tb + bcd.lfOffset;
                tfb _ tb + bcd.tfOffset;
                rfb _ tb + bcd.rfOffset};
            itb _ tb + bcd.impOffset;
            etb _ tb + bcd.expOffset;
            sgb _ tb + bcd.sgOffset;
            ftb _ tb + bcd.ftOffset;
            ntb _ tb + bcd.ntOffset;
            evb _ tb + bcd.evOffset;
            spb _ tb + bcd.spOffset;
            fpb _ tb + bcd.fpOffset;
            SELECT cmd FROM
                $Globals =>
                    PrintGlobals[];
                $Exports, $Unbound =>
                    PrintExports[FALSE];
                $Bcd, $ShortBcd => {
                    PrintHeader[];
                    PrintConfigs[];
                    PrintImports[];
                    PrintExports[TRUE];
                    PrintExpVars[];
                    PrintModules[];
                    PrintFiles[];
                    PrintFramePacks[];
                    PrintSpaces[]};
                ENDCASE;
            };
        <<Table Bases>>
            tb:  BcdDefs.Base _ NIL;
            ssb: BcdDefs.NameString _ NIL;
            evb: BcdDefs.Base _ NIL;
            spb: BcdDefs.Base _ NIL;
            fpb: BcdDefs.Base _ NIL;
            ctb: BcdDefs.Base _ NIL;
            mtb: BcdDefs.Base _ NIL;
            lfb: BcdDefs.Base _ NIL;
            tfb: BcdDefs.Base _ NIL;
            rfb: BcdDefs.Base _ NIL;
            itb: BcdDefs.Base _ NIL;
            etb: BcdDefs.Base _ NIL;
            sgb: BcdDefs.Base _ NIL;
            ftb: BcdDefs.Base _ NIL;
            ntb: BcdDefs.Base _ NIL;
        dumpLinks: {none, all} _ IF cmd # $ShortBcd THEN all ELSE none;
        ListerUtils.WithPages[inStream, bcd, 0, bcd.nPages, inner];
        };

    NameFromIndex: PROC[exbcd: RefBCD, exstb: SymbolTableBase, index: CARDINAL]
          RETURNS[ROPE _ NIL] = {
        IF exstb # NIL THEN {
            btr: LONG POINTER TO BodyRecord = @exstb.bb[RootBti];
            ctx: CTXIndex _ btr.localCtx;
            ctxr: LONG POINTER TO CTXRecord = @exstb.ctxb[ctx];
            root: ISEIndex = exstb.ctxb[ctx].seList;
            sei: ISEIndex _ root;
            DO
                sep: LONG POINTER TO ISERecord _ NIL;
                IF sei = SENull THEN EXIT;
                sep _ @exstb.seb[sei];
                SELECT TRUE FROM
                    ~sep.mark4 OR exstb.LinkMode[sei] = $manifest => {};
                    index = LOOPHOLE[sep.idValue, CARDINAL] => {
                        <<We found the item!>>
                        ros: STREAM = IO.ROS[];
                        ListerUtils.PrintSei[sei, ros, exstb];
                        SELECT TRUE FROM
                            sep.idType = typeTYPE => {};
                            sep.constant => ros.PutRope[" [inline]"];
                            ENDCASE;
                        RETURN[ros.RopeFromROS[]];
                        };
                    ENDCASE;
                IF (sei _ exstb.NextSe[sei]) = root THEN EXIT;
                ENDLOOP;
            };
        RETURN[IO.PutFR["* * * * item %g", [cardinal[index]]]]};

    }.