
    <<BcdListerImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Russ Atkinson (RRA) October 17, 1985 4:33:46 pm PDT>>

    DIRECTORY
        Basics USING [bitsPerWord],
        BcdDefs 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 USING [],
        FS USING [Close, Error, nullOpenFile, Open, OpenFile, OpenFileFromStream, StreamOpen],
        IO USING [Close, Put, PutChar, PutF, PutF1, PutFR, PutRope, RopeFromROS, ROS, STREAM],
        ListerUtils USING [nullName, PrintName, PrintSei, PrintVersion, ReadBcd, ReadMtr, ReadSgr, RefBCD, SubString, WithPages],
        PrincOps USING [globalbase],
        Rope USING [Concat, Equal, Match, ROPE],
        SymbolPack,
        Symbols USING [Base, BitAddress, BodyRecord, BTIndex, BTNull, CBTIndex, ContextLevel, CSEIndex, CSENull, CTXIndex, CTXNull, 
        CTXRecord, HTIndex, ISEIndex, ISENull, lG, RootBti, SEIndex, SENull, SERecord, typeTYPE],
        SymbolTable 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 = {
            IO.PutRope[stream, "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]]]; IO.PutRope[stream, ": "]};
                PutName[ip.name];
                PutFileStamp[ip.file, ip.name];
                REPEAT 
                    Bogus => PrintGarbage[];
                ENDLOOP;
            IO.PutRope[stream, "\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]]]; IO.PutRope[stream, ": "]};
                PutName[ee.name];
                PutFileStamp[ee.file, ee.name];
                REPEAT 
                    Bogus => PrintGarbage[];
                ENDLOOP;
            IO.PutRope[stream, "\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]]];  IO.PutRope[stream, ": "]};
                PutName[mm.name];
                PutFileStamp[mm.file, mm.name];
                REPEAT 
                    Bogus => PrintGarbage[];
                ENDLOOP;
            };

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

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

        PrintConfigs: PROC = {
            cti: CTIndex _ CTIndex.FIRST;
            IO.PutF[stream, "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;
            IO.PutChar[stream, '\n];
            };

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

        PrintImports: PROC = {
            iti: IMPIndex _ IMPIndex.FIRST;
            IO.PutF[stream, "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;
            IO.PutRope[stream, "\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 IO.PutRope[stream, " (module)"];
            IF imp.namedInstance THEN {
                IO.PutRope[stream, ", instance name: "];
                PutInstanceName[[import[iti]]];
                };
            IO.PutRope[stream, ", file: "];
            PrintFileName[imp.file];
            PrintIndex[LOOPHOLE[imp.file]];
            IO.PutF[stream, ", 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];
                        IO.PutRope[stream, "    "];
                        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 _ IO.RopeFromROS[ros];
                                FOR each: AmperTable _ amperTable, each.rest WHILE each # NIL DO
                                    IF Rope.Equal[each.first.name, 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];
                        IO.PutF1[stream, "\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 symbols.bb[bti] SELECT FROM
                                Callable => IF NOT 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>>
                        IO.PutRope[stream, "Sorry, no symbols available (file must be local).\n"];
                        RETURN;
                        };

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

                frames _ frames + 1;
                procs _ 0;

                WithSymbolsForModule[mti, DoBody];

                IF procs # 0
                    THEN {
                        waste _ gfis*32-procs;
                        IO.PutF[stream, "Global frame size: %g, gfi slots: %g, procs: %g (waste: %g)\n\n",
                            [cardinal[frameSize]],
                            [cardinal[gfis]],
                            [cardinal[procs]],
                            [integer[waste]]
                            ]}
                    ELSE {
                        IO.PutF[stream, "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 {
                IO.PutF[stream, "%g words in %g frames using %g gfi slots, %g procs (%g waste)\n",
                    [cardinal[words]],
                    [cardinal[frames]],
                    [cardinal[gfiSlots]],
                    [cardinal[totalProcs]],
                    [cardinal[totalWaste]]
                    ];
                IO.PutRope[stream, "\n&-variables\n"];
                FOR each: AmperTable _ amperTable, each.rest WHILE each # NIL DO
                    IO.PutF[stream, "\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 _ Rope.Concat[NameToRope[ftr.name], ".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];
                            FS.Close[file]};
                        inner[symbols _ SymbolTable.Acquire[[file, [start, pages]]]];
                        SymbolTable.Release[symbols];
                        IF bcd # nBcd THEN FS.Close[file];
                        };
                    };
            EXITS
                loser => inner[NIL];
            };

        PrintExports: PROC [printOffset: BOOL] = {
            eti: EXPIndex _ EXPIndex.FIRST;
            IF printOffset THEN IO.PutF1[stream, "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 IO.PutChar[stream, '\n];
            IO.PutChar[stream, '\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 IO.PutRope[stream, " (module)"];
            IF etr.namedInstance THEN {
                IO.PutRope[stream, ", instance name: "];
                PutInstanceName[[export[eti]]];
                };
            IO.PutRope[stream, ", file: "];
            PrintFileName[etr.file];
            PrintIndex[LOOPHOLE[etr.file]];
            IO.PutRope[stream, ", "]; 
            IF ~etr.typeExported THEN IO.PutChar[stream, '~];  
            IO.PutF1[stream, "typeExported, #links: %g", [cardinal[etr.size]]];
            IF dumpLinks = all THEN {
                bcdName: ROPE = Rope.Concat[NameToRope[ftb[etr.file].name], ".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;
                        IO.PutRope[stream, "\n\t\t"];
                        IF isUnbound THEN IO.PutRope[stream, "** unbound ** "];
                        IO.PutRope[stream, name];
                        IF cmd = $Unbound THEN LOOP;
                        IO.PutRope[stream, ": "];
                        SELECT TRUE FROM
                            (link = NullLink) => 
                                IO.PutRope[stream, "(null link)"];
                            link.proc => 
                                IO.PutF[stream, "proc[%g,%g]", [cardinal[link.gfi]], [cardinal[link.ep]]];
                            link.type =>
                                IF link.typeID = TYPNull
                                    THEN IO.PutRope[stream, "type[null]"]
                                    ELSE IO.PutF1[stream, "type[%g]", [cardinal[LOOPHOLE[link.typeID, CARDINAL]]]]
                            ENDCASE => 
                                IO.PutF[stream, "var[%g,%g]", [cardinal[link.vgfi]], [cardinal[link.var]]];
                        ENDLOOP;
                    };
                IO.PutRope[stream, ", links:"];
                exbcd _ ListerUtils.ReadBcd[bcdName ! FS.Error => CONTINUE];
                SELECT TRUE FROM
                    exbcd = NIL => {
                        IO.PutRope[stream, bcdName];
                        IO.PutRope[stream, " not found.\n"];
                        inner[NIL];
                        };
                    exbcd.version # bcdVersion => {
                        IO.PutRope[stream, bcdName];
                        IO.PutRope[stream, ", version "];
                        ListerUtils.PrintVersion[exbcd.version, stream];
                        IO.PutRope[stream, "found, version "];
                        ListerUtils.PrintVersion[bcdVersion, stream];
                        IO.PutRope[stream, "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]; IO.Close[file]}];
                        SymbolTable.Release[exstb];
                        IO.Close[file];
                        };
                IO.PutChar[stream, '\n];
                };
            };

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

        PrintExpVar: PROC [evi: EVIndex] = {
            evr: LONG POINTER TO EVRecord = @evb[evi];
            Tab[2];
            IO.PutF[stream, "%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 IO.PutChar[stream, ' ];
                IO.PutF1[stream, "%b", [cardinal[evr.offsets[i]]]];
                IF i # evr.length THEN IO.PutChar[stream, ',];
                ENDLOOP;
            IO.PutChar[stream, '\n];
            };

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

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

        PrintModules: PROC = {
            mti: MTIndex _ MTIndex.FIRST;
            IO.PutF1[stream, "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;
            IO.PutChar[stream, '\n];
            };

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

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

                IO.PutRope[stream, "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];
                IO.PutRope[stream, ", "]};
            IF ~mth.packageable THEN IO.PutChar[stream, '~];  IO.PutRope[stream, "packageable, "];
            IF mth.residentFrame THEN IO.PutRope[stream, "resident frame, "];
            Tab[4];
            IO.PutF[stream, "framesize: %g, gfi: %g, ngfi: %g, links: ",
            [cardinal[mth.framesize]], [cardinal[mth.gfi]], [cardinal[mth.ngfi]]];
            IF mth.linkLoc = $frame THEN IO.PutRope[stream, "frame"] ELSE IO.PutRope[stream, "code"];
            Tab[4];
            IO.PutRope[stream, "code: "];  PrintSegment[mth.code.sgi];
            IO.PutF[stream, ", offset: %b, length: %b",
            [cardinal[mth.code.offset]], [cardinal[mth.code.length]]];
            IF mth.code.linkspace THEN IO.PutRope[stream, ", link space"];
            IF mth.code.packed THEN IO.PutRope[stream, ", packed"];
            Tab[4];
            IO.PutRope[stream, "symbols: "];
            PrintSegment[mth.sseg];
            IF mth.variables # EVNull THEN {
                Tab[4];
                IO.PutF1[
                    stream, "exported variables: [%g]", [cardinal[LOOPHOLE[mth.variables, CARDINAL]]]];
                };
            WITH mm: mth^ SELECT FROM
                direct => {
                    Tab[4];
                    IO.PutF1[stream, "#links: %g", [cardinal[mm.length]]];
                    IF dumpLinks = all THEN {
                        IO.PutRope[stream, ", links:"];
                        FOR i: CARDINAL IN [0..mm.length) DO
                            IF i MOD 7 = 0 THEN Tab[6] ELSE IO.PutChar[stream, ' ];
                            PrintControlLink[mm.frag[i]];
                            IF i + 1 # mm.length THEN IO.PutChar[stream, ',];
                            ENDLOOP}};
                indirect => {Tab[4];  PrintLinks[mm.links]};
                multiple => {
                    Tab[4];
                    PrintLinks[mm.links];
                    Tab[4];
                    PrintTypes[mm.types];
                    IF mm.frameRefs THEN {
                        Tab[5];
                        IO.PutF1[stream, "frame type: %g", [cardinal[mm.frameType]]];
                        };
                    Tab[4];
                    PrintRefLits[mm.refLiterals]};
                ENDCASE;
            IO.PutChar[stream, '\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] = {
            IO.PutRope[stream, "#links: "];
            IF lfi = LFNull
                THEN IO.PutRope[stream, "none"]
                ELSE {
                    IO.Put[stream, [cardinal[lfb[lfi].length]]];
                    IF dumpLinks = all THEN {
                        IO.PutRope[stream, ", links:"];
                        FOR i: CARDINAL IN [0..lfb[lfi].length) DO
                            IF i MOD 7 = 0 THEN Tab[6] ELSE IO.PutChar[stream, ' ];
                            PrintControlLink[lfb[lfi].frag[i]];
                            IF i + 1 # lfb[lfi].length THEN IO.PutChar[stream, ',];
                            ENDLOOP;
                        };
                    };
            };

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

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

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

        PrintFramePack: PROC [fpi: FPIndex] = {
            fpr: LONG POINTER TO FPRecord = @fpb[fpi];
            Tab[2];
            PutName[fpr.name];
            IO.PutF[stream, "[%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 IO.PutChar[stream, ' ];
                PutName[mtb[fpr.modules[i]].name];
                PrintIndex[LOOPHOLE[fpr.modules[i]]];
                IF i # fpr.length - 1 THEN IO.PutChar[stream, ',];
                ENDLOOP;
            IO.PutChar[stream, '\n];
            };

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

        PrintFiles: PROC = {
            fti: FTIndex _ FTIndex.FIRST;
            IO.PutF1[stream, "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;
            IO.PutRope[stream, "\n\n"];
            };

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

        <<Utility Prints>>

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

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

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

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

        Tab: PROC [n: CARDINAL] = {
            IO.PutChar[stream, '\n];
            THROUGH [1..n/8] DO IO.PutChar[stream, '\t] ENDLOOP;
            THROUGH [1..n MOD 8] DO IO.PutChar[stream, ' ] 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
                IO.PutChar[stream, 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
                IO.PutChar[ros, ss[i]];
                ENDLOOP;
            RETURN [IO.RopeFromROS[ros]];
            };

        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 IO.PutRope[stream, " (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 => {};
                    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 => IO.PutRope[ros, " [inline]"];
                            ENDCASE;
                        RETURN [IO.RopeFromROS[ros]];
                        };
                    ENDCASE;
                IF (sei _ exstb.NextSe[sei]) = root THEN EXIT;
                ENDLOOP;
            };
        RETURN [IO.PutFR["* * * * item %g", [cardinal[index]]]];
        };

    }.