
    <<KLister.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Sweet October 9, 1985 2:45:46 pm PDT>>
        <<Russ Atkinson (RRA) June 25, 1986 3:28:56 pm PDT>>
        <<Satterthwaite March 8, 1986 5:20:20 pm PST>>

    DIRECTORY
        Basics USING [bytesPerWord],
        BcdDefs USING [BCD, FTIndex, FTRecord, MTIndex, MTNull, MTRecord, SGRecord, VersionID],
        BcdLister USING [ListBcd],
        CodeLister USING [ListCode, ListFGT],
        Commander USING [CommandProc, Register],
        CommandTool USING [Failed, ParseToList],
        ConvertUnsafe USING [SubString],
        FS,
        FSBackdoor,
        List USING [CompareProc, Sort],
        Literals USING [LitDescriptor, LTIndex, LTNull, LTRecord, MSTIndex, STIndex, STNull],
        ListerUtils USING [PrintIndex, PrintName, PrintSE, PrintSei, PrintTree, PrintVersion, ReadMtr, ReadSgr, ShortName],
        ListRTBcd USING [PrintRTBcd],
        IO USING [Close, EndOf, GetChar, GetLineRope, PutChar, PutF, PutF1, PutFR1, PutRope, RIS, RopeFromROS, ROS, SetIndex, STREAM, 
        UnsafeGetBlock],
        Rope USING [Compare, Concat, Equal, Fetch, Flatten, Length, Match, Replace, ROPE, SkipTo],
        SortedSymbolLister USING [AddSymbols],
        SymbolPack,
        Symbols USING [BitAddress, BodyRecord, BTIndex, ContextLevel, CSEIndex, CTXIndex, CTXNull, CTXRecord, HTIndex, ISEIndex, ISENull, 
        lZ, MDIndex, Name, nullName, RootBti, SEIndex, SENull, SERecord, TransferMode, TypeClass, typeTYPE],
        SymbolTable USING [Acquire, Base, Release],
        Tree USING [Index, Link, NodeName];
KLister: PROGRAM
    IMPORTS BcdLister, CodeLister, Commander, CommandTool, FS, FSBackdoor, IO, List, ListerUtils, ListRTBcd, Rope, SortedSymbolLister, 
    SymbolPack, SymbolTable
    = 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;
        CTXIndex: TYPE = Symbols.CTXIndex;
            CTXNull: CTXIndex = Symbols.CTXNull;
        CTXRecord: TYPE = Symbols.CTXRecord;
        FTIndex: TYPE = BcdDefs.FTIndex;
        FTRecord: TYPE = BcdDefs.FTRecord;
        HTIndex: TYPE = Symbols.HTIndex;
        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;
        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;

    <<Major procedures>>
    <<>>
        UC: PROC [c: CHAR] RETURNS [CHAR] = {
            RETURN [IF c IN ['a..'z] THEN 'A + (c - 'a) ELSE c];
            };

        ListSymbols: Commander.CommandProc = TRUSTED {
            <<[cmd: Handle] RETURNS [result: REF _ NIL, msg: ROPE _ NIL]>>
            in: STREAM = IO.RIS[cmd.commandLine];
            name: ROPE;
            tempName: ROPE;
            combinedSymbols, totalFiles: LIST OF REF ANY _ NIL;
            sortedSymbols: BOOL _ cmd.procData.clientData = $SortedSymbols OR cmd.procData.clientData = $SortedDefs;
            stream: STREAM _ NIL;
            inStream: STREAM _ NIL;
            stb: SymbolTableBase _ NIL;
            any: BOOL _ FALSE;
            switches: PACKED ARRAY CHAR['A..'Z] OF BOOL _ ALL[FALSE];
            args: LIST OF ROPE _ CommandTool.ParseToList[cmd
                ! CommandTool.Failed => {msg _ errorMsg; GO TO failed}
                ].list;
            Cleanup: PROC = {
                IF stream # NIL AND stream # cmd.out THEN stream.Close[];
                IF inStream # NIL THEN inStream.Close[];
                IF stb # NIL THEN {SymbolTable.Release[stb]; stb _ NIL}};
            IsInCache: PROC [name: ROPE] RETURNS [present: BOOL _ FALSE] = {
                noteName: FSBackdoor.NameProc = TRUSTED {
                    <<[fullGName: ROPE] RETURNS [continue: BOOLEAN]>>
                    present _ TRUE;
                    continue _ FALSE};
                FSBackdoor.EnumerateCacheForNames[proc: noteName, pattern: name]};
            EachName: FS.NameProc = TRUSTED {
                <<[fullFName: ROPE] RETURNS [continue: BOOL]>>
                IF IsInCache[fullFName] THEN tempName _ fullFName
                ELSE
                    tempName _ FS.Copy[from: fullFName, to: "///Temp/Lister.temp$", setKeep: TRUE, keep: 6, remoteCheck: FALSE
                        ! FS.Error => {msg _ error.explanation; GO TO failed}
                        ];
                inStream _ FS.StreamOpen[fileName: tempName, remoteCheck: FALSE, streamOptions: [FALSE, TRUE, TRUE, TRUE, TRUE]
                    ! FS.Error => {msg _ error.explanation; GO TO failed}
                    ];
                {ENABLE UNWIND => Cleanup[];
                    short: ROPE = ListerUtils.ShortName[fullFName];
                    bcd: RefBCD _ NEW[BCD];
                    ext: ROPE _ NIL;
                    outName: ROPE _ NIL;
                    configOk: BOOL _ FALSE;
                    defsOK: BOOL _ FALSE;
                    file: FS.OpenFile _ FS.OpenFileFromStream[inStream];
                    [] _ inStream.UnsafeGetBlock[
                        [base: LOOPHOLE[bcd], startIndex: 0, count: SIZE[BCD]*bytesPerWord]];
                    IF switches['M] AND (bcd.nConfigs # 0 OR bcd.definitions) THEN GO TO processNext;
                    SELECT cmd.procData.clientData FROM
                        $Bcd, $ShortBcd => {ext _ ".bcdList"; configOk _ TRUE; defsOK _ TRUE};
                        $Bodies => ext _ ".bodyList";
                        $Code => ext _ ".codeList";
                        $Exports => {ext _ ".exportsList"; configOk _ TRUE};
                        $FGT => ext _ ".fgtList";
                        $Files => {ext _ ".filesList"; configOk _ TRUE; defsOK _ TRUE};
                        $Globals => {ext _ ".globalFramesList"; configOk _ TRUE};
                        $RTBcd => {ext _ ".rtBcdList"; configOk _ TRUE};
                        $Symbols => {ext _ ".symbolList"; defsOK _ TRUE};
                        $Unbound => {ext _ NIL; configOk _ TRUE};
                        $Using => {ext _ ".usingList"; defsOK _ TRUE};
                        $SortedSymbols, $SortedDefs => {ext _ NIL; defsOK _ TRUE};
                        ENDCASE => ext _ ".list";
                    IF ext # NIL THEN {
                        SELECT TRUE FROM
                            switches['C] => ext _ NIL;
                            Rope.Match["*.bcd", short, FALSE] =>
                                outName _ short.Replace[short.Length[]-4, 4, ext];
                            ENDCASE => outName _ short.Concat[ext];
                        };
                    SELECT TRUE FROM
                        bcd.versionIdent # BcdDefs.VersionID =>
                            (cmd.out).PutF1["Not a valid Cedar bcd file: %g\n", [rope[short]]];
                        bcd.nConfigs # 0 AND ~configOk =>
                            (cmd.out).PutF1["Bound configurations not supported: %g\n", [rope[short]]];
                        bcd.definitions AND NOT defsOK =>
                            (cmd.out).PutF1["Definitions files not supported: %g\n", [rope[short]]];
                        ENDCASE => {
                            sourceName: ROPE _ NIL;
                            IF bcd.nConfigs = 0 THEN {
                                <<Now we have a single-module file.>>
                                <<Get the module.>>
                                mtr: RefMTRecord = ListerUtils.ReadMtr[inStream, bcd, LOOPHOLE[0]];
                                sgr: RefSGRecord = ListerUtils.ReadSgr[inStream, bcd, mtr.sseg];
                                pages: CARDINAL =
                                    IF bcd.extended THEN sgr.pages+sgr.extraPages ELSE sgr.pages;
                                IF pages = 0 THEN {
                                    (cmd.out).PutF1["Error - no symbols from %g\n", [rope[fullFName]]];
                                    result _ $Failure;
                                    GO TO bailOut;
                                    };
                                stb _ SymbolTable.Acquire[[file, [sgr.base-1, pages]]]};
                            <<Get the source fullFName for later>>
                            sourceName _ RopeForBcdName[inStream, bcd.ssOffset, bcd.source];
                            <<>>
                            <<Open the output stream (if any)>>
                            IF ext = NIL THEN {
                                stream _ cmd.out;
                                (cmd.out).PutF1["Listing for %g\n", [rope[fullFName]] ]}
                            ELSE {
                                (cmd.out).PutF[
                                    "%g output to %g\n", [rope[cmd.command]], [rope[outName]]];
                                stream _ FS.StreamOpen[outName, $create];
                                stream.PutRope[outName]};
                            IF sortedSymbols THEN {
                                IF ~bcd.definitions AND cmd.procData.clientData = $SortedDefs THEN GO TO bailOut;
                                totalFiles _ CONS[short, totalFiles]}
                            ELSE {
                                stream.PutF1["\n  object: %g {", [rope[short]]];
                                ListerUtils.PrintVersion[bcd.version, stream];
                                stream.PutRope["}\n  source: "];
                                stream.PutRope[sourceName];
                                stream.PutRope[" {"];
                                ListerUtils.PrintVersion[bcd.sourceVersion, stream, TRUE];
                                stream.PutRope["}\n  creator: {"];
                                ListerUtils.PrintVersion[bcd.creator, stream];
                                stream.PutRope["}\n\n"]};
                            SELECT cmd.procData.clientData FROM
                                $Bcd => BcdLister.ListBcd[stream, inStream, bcd, $Bcd];
                                $Bodies => PrintBodies[stream, stb];
                                $Code => CodeLister.ListCode[stream, inStream, stb, bcd, NIL];
                                $Exports => BcdLister.ListBcd[stream, inStream, bcd, $Exports];
                                $FGT => CodeLister.ListFGT[stream, inStream, stb, bcd];
                                $Files => PrintFiles[stream, bcd, fullFName];
                                $Globals => BcdLister.ListBcd[stream, inStream, bcd, $Globals];
                                $RTBcd => ListRTBcd.PrintRTBcd[stream, inStream, bcd];
                                $Symbols => PrintSymbols[bcd.definitions, stream, stb];
                                $Unbound => BcdLister.ListBcd[stream, inStream, bcd, $Unbound];
                                $SortedSymbols, $SortedDefs => combinedSymbols _ SortedSymbolLister.AddSymbols[rList: combinedSymbols, stb: stb];
                                $Using => PrintUsing[stream, stb];
                                ENDCASE;
                            EXITS bailOut => {};
                            };
                    Cleanup[];
                    continue _ TRUE;
                    EXITS processNext => continue _ TRUE;
                    };
                EXITS failed => {result _ $Failed; Cleanup[]; continue _ FALSE};
                };
            IF sortedSymbols THEN 
                (cmd.out).PutRope["Combined symbols listing to Symbols.sort\n"];
            WHILE args # NIL DO
                name _ args.first;
                args _ args.rest;
                SELECT TRUE FROM
                    Rope.Match["-*", name] => {
                        sense: BOOL _ TRUE;
                        num: INT _ 0;
                        FOR i: INT IN [1..name.Length[]) DO
                            c: CHAR _ name.Fetch[i];
                            SELECT c FROM
                                IN ['A..'Z] => switches[c] _ sense;
                                IN ['a..'z] => switches[c-('a-'A)] _ sense;
                                IN ['0..'9] => num _ num * 10 + (c - '0);
                                '~ => sense _ NOT sense;
                                ENDCASE;
                            ENDLOOP;
                        LOOP;
                        };
                    Rope.Match["*.bcd", name, FALSE], Rope.Match["*.bcd!*", name, FALSE] => {};
                    ENDCASE => name _ name.Concat[".bcd"];
                any _ TRUE;
                name _ FS.ExpandName[name
                    ! FS.Error => {msg _ error.explanation; GO TO failed};
                    ].fullFName;
                IF NOT Rope.Match["*!*", name] THEN name _ name.Concat["!h"];
                FS.EnumerateForNames[name, EachName];
                IF result # NIL THEN GO TO failed;
                ENDLOOP;
            IF sortedSymbols THEN {
                lastChar: CHAR _ 0C;
                CompareCaseless: List.CompareProc = TRUSTED {
                    <<[ref1: REF ANY, ref2: REF ANY] RETURNS [Basics.Comparison]>>
                    r1: ROPE = NARROW[ref1];
                    r2: ROPE = NARROW[ref2];
                    RETURN [r1.Compare[r2, FALSE]]}; 
                totalFiles _ List.Sort[totalFiles, CompareCaseless];
                stream _ FS.StreamOpen["Symbols.sort", $create];
                stream.PutRope["Combined symbols for: "];
                WHILE totalFiles # NIL DO
                    stream.PutF1["%g ", [rope[NARROW[totalFiles.first]]]];
                    totalFiles _ totalFiles.rest;
                    ENDLOOP;
                stream.PutRope["\n\n"];
                combinedSymbols _ List.Sort[combinedSymbols, CompareCaseless];
                WHILE combinedSymbols # NIL DO
                    line: ROPE;
                    entry: ROPE = NARROW[combinedSymbols.first];
                    ch: CHAR _ UC[entry.Fetch[0]];
                    ris: IO.STREAM _ IO.RIS[entry];
                    IF ch # lastChar THEN {stream.PutF1["--%g\n", [character[ch]]]; lastChar _ ch};
                    WHILE ~ris.EndOf[] DO
                        line _ ris.GetLineRope[];
                        stream.PutF1["  %g\n", [rope[line]]];
                        ENDLOOP;
                    combinedSymbols _ combinedSymbols.rest;
                    ENDLOOP;
                stream.Close[]};
            IF NOT any THEN {
                result _ $Failure;
                msg _ IO.PutFR1["Usage: %g file ...", [rope[cmd.command]]]};
            EXITS failed => result _ $Failure;
            };

        PrintBodies: PUBLIC PROC [stream: STREAM, stb: SymbolTableBase] = {
            PrintBody: PROC [bti: BTIndex] RETURNS [BOOL] = {
                body: LONG POINTER TO BTRecord = @stb.bb[bti];
                stream.PutRope["Body: "];
                WITH b~~body SELECT FROM
                    Callable => {
                        ListerUtils.PrintSei[b.id, stream, stb];
                        IF b.inline THEN stream.PutRope[" [inline]"]
                        ELSE {
                            stream.PutF1[", ep: %g", [cardinal[b.entryIndex]]];
                            WITH b SELECT FROM
                                Inner => stream.PutF1[", frame addr: %g", [cardinal[frameOffset]]];
                                ENDCASE;
                            };
                        stream.PutRope[", attrs: "];
                        stream.PutChar[IF ~b.noXfers THEN 'x ELSE '-];
                        stream.PutChar[IF b.hints.safe THEN 's ELSE '-];
                        stream.PutChar[IF b.hints.nameSafe THEN 'n ELSE '-];
                        IF ~b.hints.noStrings THEN stream.PutRope["\n  string literals"]};
                    ENDCASE => stream.PutRope["(anon)"];
                stream.PutRope["\n  context: "];
                ListerUtils.PrintIndex[body.localCtx, stream];
                stream.PutF1[", level: %g", [cardinal[body.level]]];
                WITH body.info SELECT FROM
                    Internal => {
                        stream.PutF1[", frame size: %g", [cardinal[frameSize]]];
                        IF body.kind = Callable THEN
                            ListerUtils.PrintTree[[subtree[index: bodyTree]], 0, stream, stb]
                        ELSE {stream.PutRope[", tree root: "]; ListerUtils.PrintIndex[bodyTree, stream]}};
                    ENDCASE;
                stream.PutRope["\n\n"];
                RETURN [FALSE]};
            [] _ stb.EnumerateBodies[RootBti, PrintBody];
            stream.PutRope["\n"];
            };

        PrintGlobalFrames: PUBLIC PROC [stream: STREAM, stb: SymbolTableBase] = {
            PrintBody: PROC [bti: BTIndex] RETURNS [BOOL] = {
                body: LONG POINTER TO BTRecord = @stb.bb[bti];
                stream.PutRope["Body: "];
                WITH b~~body SELECT FROM
                    Callable => {
                        ListerUtils.PrintSei[b.id, stream, stb];
                        IF b.inline THEN stream.PutRope[" [inline]"]
                        ELSE {
                            stream.PutF1[", ep: %g", [cardinal[b.entryIndex]]];
                            WITH b SELECT FROM
                                Inner => stream.PutF1[", frame addr: %g", [cardinal[frameOffset]]];
                                ENDCASE;
                            };
                        stream.PutRope[", attrs: "];
                        stream.PutChar[IF ~b.noXfers THEN 'x ELSE '-];
                        stream.PutChar[IF b.hints.safe THEN 's ELSE '-];
                        stream.PutChar[IF b.hints.nameSafe THEN 'n ELSE '-];
                        IF ~b.hints.noStrings THEN stream.PutRope["\n  string literals"]};
                    ENDCASE => RETURN [FALSE];
                stream.PutRope["\n  context: "];
                ListerUtils.PrintIndex[body.localCtx, stream];
                stream.PutF1[", level: %g", [cardinal[body.level]]];
                WITH body.info SELECT FROM
                    Internal => {
                        stream.PutF1[", frame size: %g", [cardinal[frameSize]]];
                        IF body.kind = Callable THEN
                            ListerUtils.PrintTree[[subtree[index: bodyTree]], 0, stream, stb]
                        ELSE {stream.PutRope[", tree root: "]; ListerUtils.PrintIndex[bodyTree, stream]}};
                    ENDCASE;
                stream.PutRope["\n\n"];
                RETURN [FALSE]};
            [] _ stb.EnumerateBodies[RootBti, PrintBody];
            stream.PutRope["\n"];
            };

        PrintSymbols: PUBLIC PROC [definitions: BOOL, stream: STREAM, stb: SymbolTableBase] = {
            ctx: CTXIndex;
            limit: CTXIndex;
            limit _ LOOPHOLE[stb.stHandle.ctxBlock.size];
            ctx _ CTXIndex.FIRST + CTXRecord.nil.SIZE;
            UNTIL ctx = limit DO
                PrintContext[ctx, definitions, stream, stb];
                stream.PutRope["\n\n"];
                ctx _ ctx + (WITH stb.ctxb[ctx] SELECT FROM
                    included => CTXRecord.included.SIZE,
                    imported => CTXRecord.imported.SIZE,
                    ENDCASE => CTXRecord.simple.SIZE);
                ENDLOOP;
            stream.PutRope["\n"];
            };

        PrintContext: PROC [ctx: CTXIndex, definitionsOnly: BOOL, stream: STREAM, stb: SymbolTableBase] = {
            sei, root: ISEIndex;
            cp: LONG POINTER TO CTXRecord = @stb.ctxb[ctx];
            stream.PutRope["Context: "];
            ListerUtils.PrintIndex[ctx, stream];
            IF stb.ctxb[ctx].level # lZ THEN stream.PutF1[", level: %g", [cardinal[cp.level]]];
            WITH c~~cp SELECT FROM
                included => {
                    stream.PutRope[", copied from: "];
                    ListerUtils.PrintName[stb.mdb[c.module].moduleId, stream, stb];
                    stream.PutRope[" ["];
                    ListerUtils.PrintName[stb.mdb[c.module].fileId, stream, stb];
                    stream.PutRope[", "];
                    ListerUtils.PrintVersion[stb.mdb[c.module].stamp, stream];
                    stream.PutRope["], context: "];
                    ListerUtils.PrintIndex[c.map, stream]};
                imported => {
                    stream.PutRope[", imported from: "];
                    ListerUtils.PrintName[stb.mdb[stb.ctxb[c.includeLink].module].moduleId, stream, stb]};
                ENDCASE;
            root _ sei _ stb.ctxb[ctx].seList;
            DO
                IF sei = SENull THEN EXIT;
                ListerUtils.PrintSE[sei, 2, definitionsOnly , stream, stb];
                IF (sei _ stb.NextSe[sei]) = root THEN EXIT;
                ENDLOOP;
            };

        PrintUsing: PROC [stream: STREAM, stb: SymbolTableBase] = {
            limit: CTXIndex = LOOPHOLE[stb.stHandle.ctxBlock.size];
            ctx: CTXIndex _ CTXIndex.FIRST + CTXRecord.nil.SIZE;
            firstUsing: BOOL _ TRUE;
            pairs: LIST OF Pair _ NIL;
            ros: STREAM _ IO.ROS[];
            firstCopiedHash: Symbols.HTIndex;
            InDirectory: PROC [ctx: CTXIndex] RETURNS [BOOL] = {
                FOR dirSei: ISEIndex
                    _ stb.FirstCtxSe[stb.stHandle.directoryCtx], stb.NextSe[dirSei] UNTIL dirSei = ISENull DO
                    WITH se~~stb.seb[stb.UnderType[stb.seb[dirSei].idType]] SELECT FROM
                        definition => IF ctx = se.defCtx THEN RETURN [TRUE];
                        ENDCASE;
                    ENDLOOP;
                RETURN [FALSE]};
            DoContext: PROC [ctx: CTXIndex] = {
                IF ctx # CTXNull THEN {
                    sei, root: ISEIndex;
                    cp: LONG POINTER TO CTXRecord = @stb.ctxb[ctx];
                    which: LIST OF Pair _ NIL;
                    key, modName: ROPE _ NIL;
                    mdi: MDIndex;
                    DoSei: PROC [sei: ISEIndex] = {
                        sep: LONG POINTER TO ISERecord = @stb.seb[sei];
                        IF sep.hash < firstCopiedHash THEN {
                            name: ROPE _ NIL;
                            IF sep.idType = typeTYPE THEN {
                                typeSei: SEIndex _ sep.idInfo;
                                WITH tse~~stb.seb[typeSei] SELECT FROM
                                    id => {
                                        IF tse.idCtx # ctx AND InDirectory[tse.idCtx] THEN RETURN};
                                    ENDCASE;
                                };
                            ros _ IO.ROS[ros];
                            ListerUtils.PrintSei[sei, ros, stb];
                            name _ ros.RopeFromROS[FALSE];
                            which.first.names _ InsertName[name, which.first.names]};
                        };
                    WITH c~~cp SELECT FROM
                        included => {
                            mdi _ c.module};
                        imported => {
                            mdi _ stb.ctxb[c.includeLink].module};
                        ENDCASE => RETURN;

                    <<Get the module name>>
                    ros _ IO.ROS[ros];
                    ListerUtils.PrintName[stb.mdb[mdi].moduleId, ros, stb];
                    modName _ ros.RopeFromROS[FALSE];

                    [which, pairs] _ FindList[modName, pairs];
                    IF which.first.file = NIL THEN {
                        <<Get the module file name>>
                        modFileName: ROPE _ NIL;
                        ros _ IO.ROS[ros];
                        ListerUtils.PrintName[stb.mdb[mdi].fileId, ros, stb];
                        modFileName _ ros.RopeFromROS[FALSE];
                        modFileName _ modFileName.Flatten[0, modFileName.SkipTo[0, "."]];
                        which.first.file _ modFileName};
                    root _ sei _ stb.ctxb[ctx].seList;
                    DO
                        IF sei = SENull THEN EXIT;
                        DoSei[sei];
                        IF (sei _ stb.NextSe[sei]) = root THEN EXIT;
                        ENDLOOP;
                    };
                };
            FOR hti: HTIndex IN (0..LENGTH[stb.ht]) DO
                IF stb.ht[hti].ssIndex = stb.ht[hti - 1].ssIndex THEN {
                    firstCopiedHash _ hti; EXIT};
                REPEAT FINISHED => firstCopiedHash _ LENGTH[stb.ht];
                ENDLOOP;
            FOR dirSei: ISEIndex
                _ stb.FirstCtxSe[stb.stHandle.directoryCtx], stb.NextSe[dirSei] UNTIL dirSei = ISENull DO
                WITH se~~stb.seb[stb.UnderType[stb.seb[dirSei].idType]] SELECT FROM
                    definition => DoContext[se.defCtx];
                    ENDCASE;
                ENDLOOP;
            FOR dirSei: ISEIndex
                _ stb.FirstCtxSe[stb.stHandle.importCtx], stb.NextSe[dirSei] UNTIL dirSei = ISENull DO
                WITH se~~stb.seb[stb.UnderType[stb.seb[dirSei].idType]] SELECT FROM
                    definition => DoContext[se.defCtx];
                    transfer => {
                        bti: BTIndex = stb.seb[dirSei].idInfo;
                        DoContext[stb.bb[bti].localCtx]};
                    ENDCASE;
                ENDLOOP;
            <<At this point all of the entries have been made.>>
            IF pairs = NIL THEN stream.PutRope["No DIRECTORY.\n"]
            ELSE {
                stream.PutRope["DIRECTORY\n"];
                WHILE pairs # NIL DO
                    pair: Pair = pairs.first;
                    names: LIST OF ROPE _ pair.names;
                    stream.PutRope["  "];
                    stream.PutRope[pair.key];
                    IF NOT (pair.key).Equal[pair.file, FALSE] THEN {
                        stream.PutF1[": FROM \"%g\"", [rope[pair.file]]]};
                    stream.PutRope[" USING ["];
                    WHILE names # NIL DO
                        stream.PutRope[names.first];
                        IF names.rest # NIL THEN stream.PutRope[", "];
                        names _ names.rest;
                        ENDLOOP;
                    stream.PutRope[IF pairs.rest # NIL THEN "],\n" ELSE "];\n"];
                    pairs _ pairs.rest;
                    ENDLOOP;
                };
            };

        PrintFiles: PROC [stream: STREAM, bcd: RefBCD, fileName: ROPE] = {
            FTRSeq: TYPE = RECORD [SEQUENCE len: NAT OF FTRecord];
            nFiles: CARDINAL = (bcd.ftLimit-FIRST[FTIndex])/SIZE[FTRecord];
            IF nFiles IN [1..1024] THEN {
                bytes: CARDINAL = nFiles*SIZE[FTRecord]*bytesPerWord;
                fileSeq: REF FTRSeq = NEW[FTRSeq[nFiles]];
                ftp: LONG POINTER TO FTRecord _ @fileSeq[0];
                inStream: STREAM = FS.StreamOpen[fileName, $read];
                fti: CARDINAL = LOOPHOLE[FIRST[FTIndex]];
                stream.PutF1["# files: %g\n\n", [integer[nFiles]]];
                inStream.SetIndex[(fti+bcd.ftOffset)*bytesPerWord];
                [] _ inStream.UnsafeGetBlock[
                    [base: LOOPHOLE[@fileSeq[0]], startIndex: 0, count: bytes]];
                FOR i: NAT IN [0..nFiles) DO
                    stream.PutF["%g - fti: %g",
                        [rope[RopeForBcdName[inStream, bcd.ssOffset, ftp.name]]],
                        [integer[i*SIZE[FTRecord]]]];
                    stream.PutRope[", version: "];
                    ListerUtils.PrintVersion[ftp.version, stream];
                    stream.PutRope["\n"];
                    ftp _ ftp + SIZE[FTRecord];
                    ENDLOOP;
                inStream.Close[];
                };
            };

    <<Utility procedures>>

        RopeForBcdName: PROC [inStream: STREAM, base: CARDINAL, index: CARDINAL] RETURNS [ROPE] = {
            ros: STREAM = IO.ROS[];
            inStream.SetIndex[base*bytesPerWord+index+3];
            THROUGH [0..inStream.GetChar[]-0C) DO ros.PutChar[inStream.GetChar[]]; ENDLOOP; 
            RETURN [ros.RopeFromROS[]];
            };

        Pair: TYPE = RECORD [key: ROPE, file: ROPE, names: LIST OF ROPE];
        FindList: PROC [key: ROPE, base: LIST OF Pair] RETURNS [which,newBase: LIST OF Pair _ NIL] = {
            <<If no such named list is found, one is created and inserted into the base.>>
            newBase _ base;
            WHILE which = NIL DO
                FOR each: LIST OF Pair _ newBase, each.rest WHILE each # NIL DO
                    IF key.Equal[each.first.key] THEN {which _ each; RETURN};
                    ENDLOOP;
                newBase _ InsertPair[[key, NIL, NIL], newBase];
                ENDLOOP;
            };

        InsertName: PROC [rope: ROPE, list: LIST OF ROPE] RETURNS [LIST OF ROPE] = {
            lag: LIST OF ROPE _ NIL;
            FOR each: LIST OF ROPE _ list, each.rest WHILE each # NIL DO
                SELECT rope.Compare[each.first, FALSE] FROM
                    $less => EXIT;
                    $equal =>
                        SELECT rope.Compare[each.first, TRUE] FROM
                            $less => EXIT;
                            $equal => RETURN [list];
                            $greater => {};
                            ENDCASE;
                    $greater => {};
                    ENDCASE => ERROR;
                lag _ each;
                ENDLOOP;
            IF lag = NIL THEN RETURN [CONS[rope, list]]
            ELSE {lag.rest _ CONS[rope, lag.rest]; RETURN [list]}};

        InsertPair: PROC [pair: Pair, list: LIST OF Pair] RETURNS [LIST OF Pair] = {
            lag: LIST OF Pair _ NIL;
            key: ROPE _ pair.key;
            FOR each: LIST OF Pair _ list, each.rest WHILE each # NIL DO
                SELECT key.Compare[each.first.key, FALSE] FROM
                    $less => EXIT;
                    $equal =>
                        SELECT key.Compare[each.first.key, TRUE] FROM
                            $less => EXIT;
                            $equal => RETURN [list];
                            $greater => {};
                            ENDCASE;
                    $greater => {};
                    ENDCASE => ERROR;
                lag _ each;
                ENDLOOP;
            IF lag = NIL
                THEN RETURN [CONS[pair, list]]
                ELSE {lag.rest _ CONS[pair, lag.rest]; RETURN [list]};
            };

    <<I N I T>>

        Commander.Register[
            "BcdLister", ListSymbols,
            "List the contents of a bcd file.", $Bcd];

        Commander.Register[
            "BodyLister", ListSymbols,
            "List the bodies for a bcd file.", $Bodies];

        Commander.Register[
            "CodeLister", ListSymbols,
            "List the code for a bcd file.", $Code];

        Commander.Register[
            "ExportsLister", ListSymbols,
            "List the exports for a bcd file.", $Exports];

        Commander.Register[
            "FGTLister", ListSymbols,
            "List the fine grain table for a bcd file.", $FGT];

        Commander.Register[
            "FilesLister", ListSymbols,
            "List the items used by a bcd file.", $Files];

        Commander.Register[
            "GlobalFramesLister", ListSymbols,
            "List the global frames for a bcd file.", $Globals];

        Commander.Register[
            "ShortBcdLister", ListSymbols,
            "List the symbols (no links) for a bcd file.", $ShortBcd];

        Commander.Register[
            "SymbolLister", ListSymbols,
            "List the symbols for a bcd file.", $Symbols];

        Commander.Register[
            "RTBcdLister", ListSymbols,
            "List the symbols for a bcd file.", $RTBcd];

        Commander.Register[
            "UnboundLister", ListSymbols,
            "List the items used by a bcd file.", $Unbound];

        Commander.Register[
            "UsingLister", ListSymbols,
            "List the items used by a bcd file.", $Using];

        Commander.Register[
            "SortedSymbolLister", ListSymbols,
            "Produce a sorted list of all symbols in a collection of files (writes Symbols.sorted)", $SortedSymbols];

        Commander.Register[
            "SortedDefsLister", ListSymbols,
            "Produce a sorted list of all symbols in the defs files of a collection of files (writes Symbols.sorted)", $SortedDefs];

    END.