
    <<CodeListerImpl.mesa>>
        <<Copyright © 1984, 1985 by Xerox Corporation.  All rights reserved.>>
        <<Russ Atkinson, March 7, 1985 4:11:01 am PST>>
        <<Sweet October 10, 1985 5:28:09 pm PDT>>
        <<Satterthwaite March 7, 1986 5:34:44 pm PST>>

    DIRECTORY
        Basics: TYPE USING [BITOR, BYTE],
        BasicTime: TYPE USING [FromPupTime, GMT, nullGMT],
        BcdDefs: TYPE USING [BCD, MTIndex, MTRecord, SGRecord],
        CodeLister: TYPE USING [],
        ConvertUnsafe: TYPE USING [SubString, SubStringToRope, ToRope],
        FS: TYPE USING [Error, Open, OpenFile, StreamFromOpenFile],
        IO: TYPE USING [Close, EndOfStream, GetChar, Put, PutChar, PutF, PutRope, SetIndex, STREAM],
        ListerUtils: TYPE USING [GetOpCodeArray, OpCodeArray, PrintSei, PrintSubString, ReadMtr, ReadSgr, RefBCD, WithSegment],
        PrincOps: TYPE USING [CSegPrefix, EntryVectorItem, FrameHandle, FrameVec, InstWord, zJ2, zJ9, zJEQ2, zJEQ9, zJIB, zJIW, zJNE2, 
        zJNE9, zLI0, zLI6, zLIB, zLIW, zRF, zRFC, zRFL, zRIGP, zRIGPL, zRILP, zRILPL, zRXGPL, zRXLP, zRXLPL, zWF, zWFL, zWIGPL, 
        zWILP, zWILPL, zWSF, zWXGPL, zWXLP, zWXLPL],
        Rope: TYPE USING [Flatten, Match, ROPE],
        RuntimeError: TYPE USING [UNCAUGHT],
        Symbols: TYPE USING [Base, BodyInfo, BTIndex, BTNull, CBTIndex, HTIndex, HTNull, ISEIndex, ISENull, SEIndex, SENull],
        SymbolSegment: TYPE USING [FGTEntry],
        SymbolTable: TYPE USING [Base];

    CodeListerImpl: PROGRAM
        IMPORTS Basics, BasicTime, ConvertUnsafe, FS, IO, ListerUtils, Rope, RuntimeError
        EXPORTS CodeLister
        = BEGIN

        BCD: TYPE = BcdDefs.BCD;
        BodyInfo: TYPE = Symbols.BodyInfo;
        BTIndex: TYPE = Symbols.BTIndex;
            BTNull: BTIndex = Symbols.BTNull;
        BYTE: TYPE = Basics.BYTE;
        CBTIndex: TYPE = Symbols.CBTIndex;
        CSegPrefix: TYPE = PrincOps.CSegPrefix;
        FGTEntry: TYPE = SymbolSegment.FGTEntry;
        FrameHandle: TYPE = PrincOps.FrameHandle;
        HTIndex: TYPE = Symbols.HTIndex;
            HTNull: HTIndex = Symbols.HTNull;
        ISEIndex: TYPE = Symbols.ISEIndex;
            ISENull: ISEIndex = Symbols.ISENull;
        MTIndex: TYPE = BcdDefs.MTIndex;
        MTRecord: TYPE = BcdDefs.MTRecord;
        nullSource: INT = INT.LAST;
        OpCode: TYPE = BYTE;
        RefBCD: TYPE = REF BCD;
        RefMTRecord: TYPE = REF MTRecord;
        RefSGRecord: TYPE = REF SGRecord;
        ROPE: TYPE = Rope.ROPE;
        SEIndex: TYPE = Symbols.SEIndex;
            SENull: SEIndex = Symbols.SENull;
        SGRecord: TYPE = BcdDefs.SGRecord;
        STREAM: TYPE = IO.STREAM;
        SubString: TYPE = ConvertUnsafe.SubString;
        SymbolTableBase: TYPE = SymbolTable.Base;

        JumpOp: TYPE = [PrincOps.zJ2..PrincOps.zJIW];

        FineGrainInfo: TYPE = RECORD[
            firstSource, lastSource: INT_nullSource,
            pc: CARDINAL,
            procEnd: BOOL,
            bti: Symbols.CBTIndex];
        FGT: TYPE = RECORD[
            length: NAT,
            info: SEQUENCE maxLength: NAT OF FineGrainInfo];
        FGHandle: TYPE = REF FGT;

    DigestFGT: PROC[stb: SymbolTableBase, cspp: LONG POINTER TO CSegPrefix]
        RETURNS[myFGT: FGHandle _ NIL] = {
        bti, prev: BTIndex;

        AddMyEntry: PROC[source: INT_nullSource, object: CARDINAL, procEnd: BOOL_FALSE] = {
            IF n = myFGTSize THEN {
                oldFGT: FGHandle _ myFGT;
                myFGTSize _ myFGTSize + myFGTSize/2 + 16;
                myFGT _ NEW[FGT[myFGTSize]];
                IF oldFGT # NIL THEN
                    FOR i: NAT IN [0..oldFGT.maxLength) DO
                        myFGT[i] _ oldFGT[i] ENDLOOP;
                };
            myFGT[n] _
                [firstSource: source, pc: object, procEnd: procEnd, bti: LOOPHOLE[bti]];
            myFGT.length _ n _ n + 1};
        AddBodyFGT: PROC[bti: Symbols.CBTIndex] = {
            procstart: CARDINAL = cspp.entry[stb.bb[bti].entryIndex].initialpc*2;
            info: BodyInfo[External] = NARROW[stb.bb[bti].info, BodyInfo[External]];
            fgLast: CARDINAL = info.startIndex + info.indexLength - 1;
            lastSource: INT _ stb.bb[bti].sourceIndex;
            lastObject: CARDINAL _ procstart;
            FOR i: CARDINAL IN [info.startIndex..fgLast] DO
                f: FGTEntry = stb.fgTable[i];
                WITH f SELECT FROM
                    normal => {
                        lastSource _ lastSource + deltaSource;
                        lastObject _ lastObject + deltaObject;
                        AddMyEntry[source: lastSource, object: lastObject]};
                    step =>
                        IF which = $source THEN lastSource _ lastSource + delta
                        ELSE lastObject _ lastObject + delta;
                    ENDCASE;
                ENDLOOP;
            AddMyEntry[object: procstart + info.bytes, procEnd: TRUE]};
        BySource: PROC[r1, r2: LONG POINTER TO FineGrainInfo] RETURNS[BOOL] = {
            IF r1.firstSource > r2.firstSource THEN RETURN[TRUE];
            IF r1.firstSource = r2.firstSource THEN RETURN[r1.pc > r2.pc];
            RETURN[FALSE]};
        ByPC: PROC[r1, r2: LONG POINTER TO FineGrainInfo] RETURNS[BOOL] = {
            IF r1.pc > r2.pc THEN RETURN[TRUE];
            IF r1.pc < r2.pc THEN RETURN[FALSE];
            IF r1.procEnd THEN RETURN[FALSE];
            IF r2.procEnd THEN RETURN[TRUE];
            RETURN[r1.firstSource > r2.firstSource]};
        Sort: PROC[
            n: CARDINAL,
            greater: PROC[r1, r2: LONG POINTER TO FineGrainInfo] RETURNS[BOOL]] = {
            i: CARDINAL;
            temp: FineGrainInfo;

            SiftUp: PROC[l, u: CARDINAL] = {
                s: CARDINAL;
                key: FineGrainInfo _ myFGT[l-1];
                DO
                    s _ l*2;
                    IF s > u THEN EXIT;
                    IF s < u AND greater[@myFGT[s+1-1], @myFGT[s-1]] THEN s _ s+1;
                    IF greater[@key, @myFGT[s-1]] THEN EXIT;
                    myFGT[l-1] _ myFGT[s-1];
                    l _ s;
                    ENDLOOP;
                myFGT[l-1] _ key};

            FOR i DECREASING IN [2..n/2] DO SiftUp[i, n]; ENDLOOP;
            FOR i DECREASING IN [2..n] DO
                SiftUp[1, i];
                temp _ myFGT[1-1];
                myFGT[1-1] _ myFGT[i-1];
                myFGT[i-1] _ temp;
                ENDLOOP};

        n: CARDINAL _ 0;
        myFGTSize: CARDINAL _ (3*stb.fgTable.LENGTH)/2;
        myFGT _ NEW[FGT[myFGTSize]];
        bti _ BTIndex.FIRST;
        IF stb.bb[bti].sourceIndex # 0 THEN 
            AddMyEntry[source: 0, object: cspp.entry[0].initialpc*2];
        DO
            WITH stb.bb[bti] SELECT FROM
                Callable => IF ~inline THEN AddBodyFGT[LOOPHOLE[bti]];
                ENDCASE;
            IF stb.bb[bti].firstSon # BTNull THEN bti _ stb.bb[bti].firstSon
            ELSE DO
                prev _ bti;
                bti _ stb.bb[bti].link.index;
                IF bti = BTNull THEN GO TO Done;
                IF stb.bb[prev].link.which # $parent THEN EXIT;
                ENDLOOP;
            REPEAT Done => NULL;
            ENDLOOP;
        Sort[n, BySource];
        FOR i: CARDINAL DECREASING IN [0..n - 1) DO
            IF myFGT[i].firstSource = nullSource THEN LOOP;
            IF myFGT[i].firstSource = myFGT[i+1].firstSource THEN {
                myFGT[i].lastSource _ myFGT[i+1].lastSource; 
                myFGT[i+1].firstSource _ myFGT[i+1].lastSource}
            ELSE myFGT[i].lastSource _ myFGT[i + 1].firstSource;
            ENDLOOP;
        Sort[n, ByPC]};

    ListCode: PUBLIC PROC[
          out, inStream: STREAM, stb: SymbolTableBase, bcd: RefBCD, pattern: ROPE] = {

        myFGT: FGHandle _ NIL;
        offset: CARDINAL;
        codebase: LONG POINTER;
        codepages: CARDINAL;
        Tinst, Tbytes, Pinst, Pbytes: CARDINAL _ 0;

        source: STREAM _ NIL;

        OutCheck: PROC[xfirst: INT, xlast: INT] = {
            nextchar: CHAR;
            lastcr: INT;
            IF source = NIL THEN RETURN;
            FOR lastcr _ xfirst, lastcr - 1 UNTIL lastcr = 0 DO
                source.SetIndex[lastcr];
                IF source.GetChar[] = '\n THEN EXIT;
                ENDLOOP;
            THROUGH (lastcr..xfirst) DO out.PutChar[' ] ENDLOOP;
            source.SetIndex[xfirst];
            WHILE xfirst # xlast DO
                nextchar _ source.GetChar[ ! IO.EndOfStream => EXIT];
                xfirst _ xfirst + 1;
                out.PutChar[nextchar];
                ENDLOOP;
            IF nextchar # '\n THEN out.PutChar['\n]};
        SetUpSource: PROC = {
            sourceName: ROPE _ ConvertUnsafe.ToRope[stb.sourceFile];
            sourceTime: BasicTime.GMT _ BasicTime.nullGMT;
            sourceFile: FS.OpenFile;
            sourceTime _ BasicTime.FromPupTime[stb.stHandle.sourceVersion.time
                ! RuntimeError.UNCAUGHT => GO TO nope];
            sourceFile _ FS.Open[name: sourceName, wantedCreatedTime: sourceTime
                ! FS.Error => IF error.group # bug THEN GO TO nope];
            source _ FS.StreamFromOpenFile[sourceFile];
            EXITS nope => {}};
        CloseSource: PROC = {
            IF source # NIL THEN source.Close[]};
        FilterBody: PROC[bti: CBTIndex, key: ROPE] RETURNS[BOOL_TRUE] = {
            IF key # NIL THEN {
                flat: ROPE = key.Flatten[];
                sei: ISEIndex = stb.bb[bti].id;
                hti: HTIndex;
                d1: SubString;
                IF sei = SENull OR (hti _ stb.seb[sei].hash) = HTNull THEN RETURN[FALSE];
                d1 _ stb.SubStringForName[hti];
                RETURN[flat.Match[d1.SubStringToRope[], FALSE]]};
            };
        PrintBodyName: PROC[bti: Symbols.CBTIndex] = {
            IF source = NIL THEN {
                sei: ISEIndex = stb.bb[bti].id;
                hti: HTIndex;
                IF sei # Symbols.SENull AND (hti _ stb.seb[sei].hash) # HTNull THEN {
                    ss: SubString = stb.SubStringForName[hti];
                    ListerUtils.PrintSubString[ss, out];
                    out.PutRope[":\n"]};
                };
            };
        EvenUp: PROC[n: CARDINAL] RETURNS[CARDINAL] =  INLINE { 
            <<Round up to an even number>>
            RETURN[n + n MOD 2]};
        GetByte: PROC[pc: CARDINAL] RETURNS[BYTE] = { 
            <<pc is a byte address>>
            w: LONG POINTER TO PrincOps.InstWord = codebase + pc/2;
            RETURN[IF pc MOD 2 = 0 THEN w.evenbyte ELSE w.oddbyte]};
        GetWord: PROC[pc: CARDINAL] RETURNS[INTEGER] = { 
            <<pc is a word address>>
            RETURN[LOOPHOLE[(codebase + pc)^, INTEGER]]};
        JumpAddress: PROC[jop: OpCode, arg: INTEGER] RETURNS[CARDINAL] = {
            <<given a jump operator and its argument, return its target address>>
            SELECT instArray[jop].length FROM
                1 =>
                    SELECT jop FROM
                        IN [PrincOps.zJ2..PrincOps.zJ9] => arg _ jop - PrincOps.zJ2 + 2;
                        IN [PrincOps.zJEQ2..PrincOps.zJEQ9] => arg _ jop - PrincOps.zJEQ2 + 2;
                        IN [PrincOps.zJNE2..PrincOps.zJNE9] => arg _ jop - PrincOps.zJNE2 + 2;
                        ENDCASE => ERROR;
                2 => {
                    IF arg > 177B THEN arg _ LOOPHOLE[Basics.BITOR[arg, 177400B], INTEGER];
                    arg _ arg - 1};
                ENDCASE =>
                    arg _ arg - 2;
            RETURN[offset + LOOPHOLE[arg, CARDINAL]]};
        OutWJTab: PROC[tabstart, tablength: CARDINAL] = {
            Pbytes _ Pbytes + tablength*2;
            FOR pc: CARDINAL IN [tabstart..tabstart + tablength) DO
                w: INTEGER = GetWord[pc];
                out.PutF["\n\t\t\t\t (%b)", [cardinal[JumpAddress[PrincOps.zJIW, w]]]];
                ENDLOOP;
            };
        OutBJTab: PROC[tabstart, tablength: CARDINAL] = {
            Pbytes _ Pbytes + EvenUp[tablength];
            FOR pc: CARDINAL IN [tabstart*2..tabstart*2 + tablength) DO
                b: BYTE = GetByte[pc];
                out.PutF["\n\t\t\t\t (%b)", [cardinal[JumpAddress[PrincOps.zJIB, b]]]];
                ENDLOOP;
            };
        PutPair: PROC[byte: CARDINAL] = {
            a: CARDINAL = byte/16;
            b: CARDINAL = byte MOD 16;
            IF a < 8 AND b < 8 THEN out.PutChar[' ];
            out.PutF["[%b,%b]",[cardinal[a]],[cardinal[b]]]};
        PrintCode: PROC[
            startcode, endcode: CARDINAL] = {
            <<list opcodes for indicated segment of code>>
            lastconstant: INTEGER;
            FOR offset IN [startcode..endcode) DO
                inst: BYTE = GetByte[offset];
                il: [0..3] = instArray[inst].length;
                <<loginst[inst];>>
                Pinst _ Pinst + 1;
                out.PutF["\t%b", [integer[offset/2]]];
                out.PutRope[(IF offset MOD 2 = 0 THEN ",E " ELSE ",O ")];
                out.PutF["%b:\t[%b]\t", [integer[offset]], [integer[inst]]];
                IF inst < 100B THEN out.PutChar['\t];
                out.PutRope[instArray[inst].name];
                SELECT il FROM
                    0, 1 => {
                        Pbytes _ Pbytes + 1;
                        SELECT inst FROM
                            IN [PrincOps.zLI0..PrincOps.zLI6] => lastconstant _ inst - PrincOps.zLI0;
                            IN JumpOp => {
                                out.PutRope["\t       ("];
                                out.PutF["%b", [integer[JumpAddress[inst, 0]]]];
                                out.PutChar[')]};
                            ENDCASE;
                        };
                    2 => {
                        byte: BYTE = GetByte[(offset _ offset + 1)];
                        Pbytes _ Pbytes + 2;
                        out.PutChar['\t];
                        SELECT inst FROM
                            PrincOps.zRILP, PrincOps.zWILP, PrincOps.zRXLP, PrincOps.zWXLP, PrincOps.zRIGP, PrincOps.zRXLPL, PrincOps.zWXLPL, PrincOps.zRXGPL, 
                            PrincOps.zWXGPL, PrincOps.zRILPL, PrincOps.zWILPL, PrincOps.zRIGPL, PrincOps.zWIGPL => PutPair[byte];
                            ENDCASE => out.PutF["%b", [integer[byte]]];
                        SELECT inst FROM
                            PrincOps.zLIB => lastconstant _ byte;
                            IN JumpOp => {
                                out.PutRope[" ("];
                                out.PutF["%b", [integer[JumpAddress[inst, byte]]]];
                                out.PutChar[')]};
                            ENDCASE;
                        };
                    3 => {
                        ab: RECORD [first, second: BYTE];
                        Pbytes _ Pbytes + 3;
                        ab.first _ GetByte[(offset _ offset + 1)];
                        ab.second _ GetByte[(offset _ offset + 1)];
                        out.PutChar['\t];
                        SELECT inst FROM
                            PrincOps.zRF, PrincOps.zWF, PrincOps.zWSF, PrincOps.zRFC, PrincOps.zRFL, PrincOps.zWFL => {
                                out.PutF["%b", [integer[ab.first]]];
                                out.PutRope[", "];
                                PutPair[ab.second]};
                            ENDCASE => {
                                v: CARDINAL = LOOPHOLE[ab, CARDINAL];
                                vi: INTEGER = LOOPHOLE[v, INTEGER];
                                out.PutF["%b", [integer[v]]];
                                SELECT inst FROM
                                    PrincOps.zJIB => OutBJTab[v, lastconstant];
                                    PrincOps.zJIW => OutWJTab[v, lastconstant];
                                    PrincOps.zLIW => lastconstant _ vi;
                                    IN JumpOp => out.PutF[" (%b)", [integer[JumpAddress[inst, vi]]]];
                                    ENDCASE}};
                    ENDCASE;
                out.PutChar['\n];
                ENDLOOP;
            };
        ShowTotals: PROC = {
            out.PutF[
                "Instructions: %g, Bytes: %g\n\n",
                [integer[Pinst]], [integer[Pbytes _ EvenUp[Pbytes]]]];
            Tinst _ Tinst + Pinst;
            Pinst _ 0;
            Tbytes _ Tbytes + Pbytes;
            Pbytes _ 0};

        <<Executable part of ListCode.>>

        mti: BcdDefs.MTIndex _ LOOPHOLE[0];
        prevBti: BTIndex _ BTNull;
        mtr: RefMTRecord = ListerUtils.ReadMtr[inStream, bcd, mti];
        sgr: RefSGRecord = ListerUtils.ReadSgr[inStream, bcd, mtr.code.sgi];
        crossJumped: BOOL = mtr.crossJumped;
        framesize: CARDINAL = mtr.framesize;
        codeOffset: CARDINAL = mtr.code.offset;
        instArray: ListerUtils.OpCodeArray = ListerUtils.GetOpCodeArray[];
        inner: PROC[base: LONG POINTER] = {
            print: BOOL _ FALSE;
            cspp: LONG POINTER TO PrincOps.CSegPrefix;
            codebase _ base + codeOffset;
            codepages _ sgr.pages;
            cspp _ codebase;
            IF crossJumped THEN out.PutRope["Cross jumped\n"];
            out.PutRope["Global frame size:  "];
            out.Put[[integer[framesize]]];
            out.PutRope["\n\n"];
            Tbytes _ Tinst _ 0;
            myFGT _ DigestFGT[stb, codebase];
            SetUpSource[];
            FOR i: CARDINAL IN [0..myFGT.length) DO
                ff: FineGrainInfo = myFGT[i];
                IF ff.bti # prevBti THEN {
                    IF prevBti # BTNull AND print THEN ShowTotals[];
                    print _ FilterBody[ff.bti, pattern]};
                IF ff.firstSource # nullSource AND print THEN
                    IF ff.lastSource = ff.firstSource THEN out.PutChar['\n]
                    ELSE OutCheck[ff.firstSource, ff.lastSource];
                IF ff.bti # prevBti THEN {
                    ep: CARDINAL = stb.bb[ff.bti].entryIndex;
                    evi: LONG POINTER TO PrincOps.EntryVectorItem = @cspp.entry[ep];
                    fsize: CARDINAL = PrincOps.FrameVec[evi.info.framesize];
                    IF print THEN {
                        PrintBodyName[ff.bti];
                        out.PutChar['\t];
                        out.PutRope["   Entry point: "];
                        out.Put[[integer[ep]]];
                        out.PutRope[",   Frame size:  "];
                        out.Put[[integer[fsize]]];
                        out.PutChar['\n]}};
                IF print THEN {
                    IF ~ff.procEnd THEN PrintCode[ff.pc, myFGT[i + 1].pc];
                    out.PutChar['\n]};
                prevBti _ ff.bti;
                ENDLOOP;
            IF prevBti # BTNull AND print THEN ShowTotals[];
            out.PutF[
                "Total instructions: %g, Bytes: %g\n\n",
                [integer[Tinst]], [integer[Tbytes _ EvenUp[Tbytes]]]];
            out.PutChar['\n]};

        IF pattern = NIL THEN pattern _ "*";

        ListerUtils.WithSegment[inStream, bcd, mtr.code.sgi, inner]};

    ListFGT: PUBLIC PROC[out,inStream: STREAM, stb: SymbolTableBase, bcd: RefBCD] = {

        lastSource: INT;
        lastObject, bodyObject: CARDINAL;

        AbsFGTEntry: TYPE = RECORD [object: CARDINAL, source: INT];
        AbsFGTList: TYPE = RECORD [SEQUENCE length: NAT OF AbsFGTEntry];
        absFGT: REF AbsFGTList;

        code: LONG POINTER TO PrincOps.CSegPrefix;

        BodyData: TYPE = RECORD [firstFG, lastFG: CARDINAL, bti: Symbols.BTIndex];
        BodyList: TYPE = RECORD [SEQUENCE length: NAT OF BodyData];

        SortByFirstFG: PROC[na: REF BodyList] = {
            j: INTEGER;
            key: BodyData;
            FOR i: NAT IN [1..na.length) DO
                key _ na[i];
                j _ i - 1;
                WHILE j >= 0 AND na[j].firstFG > key.firstFG DO
                    na[j + 1] _ na[j];
                    j _ j - 1;
                    ENDLOOP;
                na[j + 1] _ key;
                ENDLOOP;
            };

        GenBT: PROC[p: PROC[BTIndex]] = {
            bti, prev: BTIndex _ FIRST[BTIndex];
            DO
                p[bti];
                IF stb.bb[bti].firstSon # BTNull THEN bti _ stb.bb[bti].firstSon
                ELSE DO
                    prev _ bti;
                    bti _ stb.bb[bti].link.index;
                    IF bti = BTNull THEN RETURN;
                    IF stb.bb[prev].link.which # parent THEN EXIT;
                    ENDLOOP;
                ENDLOOP;
            };

        PrintFGT: PROC = {
            cbti: BTIndex;
            i, n, cfirst, clast: CARDINAL;
            na: REF BodyList;

            countBti: PROC[bti: BTIndex] = {
                WITH stb.bb[bti] SELECT FROM Callable => IF inline THEN RETURN; ENDCASE;
                n _ n + 1};

            insertBti: PROC[bti: BTIndex] = {
                WITH stb.bb[bti] SELECT FROM Callable => IF inline THEN RETURN; ENDCASE;
                WITH stb.bb[bti].info SELECT FROM
                    External => na[i] _ [startIndex, startIndex + indexLength - 1, bti];
                    ENDCASE;
                i _ i + 1};

            PrintBodyLine: PROC[depth: CARDINAL] = {
                first, last: INT;
                origin: CARDINAL;
                bti: BTIndex;
                [first, last, bti] _ na[i];
                THROUGH [1..depth] DO out.PutRope["  "]; ENDLOOP;
                out.PutF["[%g] fg: ", [cardinal[LOOPHOLE[bti, CARDINAL]]]];
                out.PutF["[%g..%g], pc: ", [cardinal[first]], [cardinal[last]]];
                WITH br: stb.bb[bti] SELECT FROM
                    Callable => {
                        bodyObject _ origin _ code.entry[br.entryIndex].initialpc*2;
                        lastObject _ 0;
                        lastSource _ br.sourceIndex};
                    Other => origin _ bodyObject + br.relOffset;
                    ENDCASE;
                WITH bi: stb.bb[bti].info SELECT FROM
                    External =>
                        out.PutF["[%b..%b]", [cardinal[origin]], [cardinal[origin + bi.bytes - 1]]];
                    ENDCASE;
                out.PutF[", source: %g", [cardinal[stb.bb[bti].sourceIndex]]];
                WITH br: stb.bb[bti] SELECT FROM
                    Callable => out.PutF[", ep: %g", [cardinal[br.entryIndex]]];
                    Other => out.PutF[", relO: %b", [cardinal[br.relOffset]]];
                    ENDCASE;
                out.PutRope["\n"];
                i _ i + 1};

            PrintBodyStuff: PROC[depth: CARDINAL] = {
                myLast: CARDINAL = na[i].lastFG;
                PrintBodyLine[depth];
                WHILE i < n AND na[i].firstFG <= myLast DO
                    PrintBodyStuff[depth + 1];
                    ENDLOOP;
                };

            PrintFGEntry: PROC[item: CARDINAL] = {
                out.PutF["  %g: ", [cardinal[item]]];
                WITH ff: stb.fgTable[item] SELECT FROM
                    normal => {
                        out.PutF["%b, %g = ", [cardinal[ff.deltaObject]], [cardinal[ff.deltaSource]]];
                        out.PutF["%b, %g (%b)",
                            [cardinal[absFGT[item - cfirst].object]],
                            [cardinal[absFGT[item - cfirst].source]],
                            [cardinal[absFGT[item - cfirst].object + bodyObject]]
                            ];
                        };
                    step => {
                        IF ff.which = $source THEN out.PutF["Step source: %g ", [cardinal[ff.delta]]]
                        ELSE out.PutF["Step object: %b ", [cardinal[ff.delta]]]};
                    ENDCASE;
                };

            GenAbsFGT: PROC = {
                absFGT _ NEW[AbsFGTList[(clast - cfirst + 1)]];
                FOR i: CARDINAL IN [cfirst..clast] DO
                    WITH ff: stb.fgTable[i] SELECT FROM
                        normal => {
                            lastSource _ lastSource + ff.deltaSource;
                            lastObject _ lastObject + ff.deltaObject};
                        step =>
                            IF ff.which = $source THEN lastSource _ lastSource + ff.delta
                            ELSE lastObject _ lastObject + ff.delta;
                        ENDCASE;
                    absFGT[i - cfirst] _ [source: lastSource, object: lastObject];
                    ENDLOOP;
                };

            n _ 0;
            GenBT[countBti];
            na _ NEW[BodyList[n]];
            i _ 0;
            GenBT[insertBti];
            SortByFirstFG[na];
            i _ 0;
            WHILE i < n DO
                [cfirst, clast, cbti] _ na[i];
                WITH br: stb.bb[cbti] SELECT FROM
                    Callable =>
                        IF ~br.inline THEN {
                            ListerUtils.PrintSei[br.id, out, stb];
                            out.PutRope["\n"];
                            PrintBodyStuff[0];
                            GenAbsFGT[];
                            FOR i: CARDINAL IN [cfirst..clast] DO
                                PrintFGEntry[i];
                                out.PutRope["\n"];
                                ENDLOOP;
                            out.PutRope["\n"];
                            };
                    ENDCASE => ERROR;
                ENDLOOP;
            };

        <<Executable part of ListFGT.>>

        mti: BcdDefs.MTIndex _ LOOPHOLE[0];
        prevBti: BTIndex _ BTNull;
        mtr: RefMTRecord = ListerUtils.ReadMtr[inStream, bcd, mti];
        sgr: RefSGRecord = ListerUtils.ReadSgr[inStream, bcd, mtr.code.sgi];
        crossJumped: BOOL = mtr.crossJumped;
        framesize: CARDINAL = mtr.framesize;
        codeOffset: CARDINAL = mtr.code.offset;
        instArray: ListerUtils.OpCodeArray = ListerUtils.GetOpCodeArray[];
        inner: PROC[base: LONG POINTER] = {
            print: BOOL _ FALSE;
            code _ LOOPHOLE[base + codeOffset];
            IF crossJumped THEN out.PutRope["Cross jumped\n"];
            PrintFGT[];
            out.PutChar['\n]};
        ListerUtils.WithSegment[inStream, bcd, mtr.code.sgi, inner]};

    END.