
    <<ListRTBcdImpl.mesa  >>
        <<Copyright © 1984, 1985 by Xerox Corporation.  All rights reserved.>>
        <<Paul Rovner, October 6, 1983 11:39 am>>
        <<Russ Atkinson (RRA) August 28, 1985 7:18:05 pm PDT>>
        <<Satterthwaite March 21, 1986 10:08:30 am PST>>

    DIRECTORY
        BcdDefs: TYPE USING [BCD, VersionStamp],
        Basics: TYPE USING [bitsPerWord, LowHalf],
        IO: TYPE USING [Put, PutChar, PutF, PutRope, STREAM],
        ListerUtils: TYPE USING [PrintVersion, WithPages],
        ListRTBcd: TYPE USING [],
        RCMap: TYPE USING [Base, FieldDescriptor, Index, Object, RCField],
        Rope: TYPE USING [ROPE],
        RTBcd: TYPE USING [RefLitList, RTBase, StampList, TypeList, VersionID, AnyStamp],
        TypeStrings: TYPE USING [Code, TypeString];

    ListRTBcdImpl: PROGRAM
        IMPORTS Basics, IO, ListerUtils
        EXPORTS ListRTBcd
        = BEGIN

        RefBCD: TYPE = REF BcdDefs.BCD;
        ROPE: TYPE = Rope.ROPE;
        STREAM: TYPE = IO.STREAM;

        PrintRTBcd: PUBLIC PROC[out, inStream: STREAM, bcd: RefBCD] = {

            Inner: PROC[ptr: LONG POINTER] = {
                rtHeader: RTBcd.RTBase = LOOPHOLE[ptr];
                SELECT TRUE FROM
                    (rtHeader = NIL) =>
                        out.PutRope["No RT pages\n"];
                    (rtHeader.versionIdent # RTBcd.VersionID) =>
                        out.PutRope["Invalid RT version stamp\n"];
                    ENDCASE => {
                        PrintHeader[out, rtHeader];
                        PrintTypes[out, rtHeader];
                        PrintStamps[out, rtHeader];
                        PrintRCMap[out, rtHeader];
                        PrintRefLits[out, rtHeader]};
                };

            ListerUtils.WithPages[inStream, bcd, bcd.rtPages.relPageBase, bcd.rtPages.pages, Inner]};

        PrintHeader: PROC[out: STREAM, rtHeader: RTBcd.RTBase] = {
            out.PutRope["Types: "]; PrintDecimal[out, rtHeader[rtHeader.typeTable].length];
            out.PutRope[", Ref Literals: "]; PrintDecimal[out, rtHeader[rtHeader.refLitTable].length];
            out.PutRope[", "];
            PrintDecimal[out, rtHeader.rcMapLength]; out.PutRope[" Words of RC Map"];
            out.PutRope[", "];
            PrintDecimal[out, rtHeader.litLength]; out.PutRope[" Words of Literals\n\n"]};

        PrintTypes: PROC[out: STREAM, rtHeader: RTBcd.RTBase] = {
            typeList: LONG POINTER TO RTBcd.TypeList = @rtHeader[rtHeader.typeTable];
            stampList: LONG POINTER TO RTBcd.StampList = @rtHeader[rtHeader.stampTable];
            textBase: LONG POINTER = @rtHeader[rtHeader.litBase];

            PrintTypeString: PROC[offset: CARDINAL] RETURNS[valid: BOOL] = INLINE {
                text: TypeStrings.TypeString = textBase + offset;
                valid _ offset <= rtHeader.litLength
                    AND offset+StringBody[text.length].SIZE <= rtHeader.litLength;
                out.PutChar[' ];
                SELECT TRUE FROM
                    ~valid => PrintGarbage[out];
                    (PutType[out, text, 0] # text.length) => out.PutRope[" ???"];
                    ENDCASE;
                };

            out.PutRope["Types"];
            PrintIndex[out, LOOPHOLE[rtHeader.typeTable]];
            out.PutChar[':];
            FOR i: NAT IN [0 .. typeList.length) DO
                Tab[out, 2];
                PrintIndex[out, i];
                out.PutRope[" sei: "];  PrintDecimal[out, LOOPHOLE[typeList[i].sei, CARDINAL]];
                out.PutRope[", segment: "];  PrintIndex[out, LOOPHOLE[typeList[i].table]];
                out.PutRope[", rcMap: "];  PrintIndex[out, LOOPHOLE[typeList[i].rcMap]];
                out.PutRope[", UTF: [stamp: "];
                    IF typeList[i].ut.version = RTBcd.AnyStamp THEN out.PutRope["(any)"]
                    ELSE PrintIndex[out, LOOPHOLE[typeList[i].ut.version]];
                    out.PutRope[", sei: "];
                    PrintDecimal[out, LOOPHOLE[typeList[i].ut.sei, CARDINAL]];
                    out.PutChar[']];
                IF typeList[i].canonical THEN out.PutRope[", canonical"];
                Tab[out, 4];
                PrintIndex[out, LOOPHOLE[typeList[i].ct.index]];
                IF ~PrintTypeString[typeList[i].ct.index] THEN EXIT;
                ENDLOOP;
            out.PutRope["\n\n"]};

        PrintStamps: PROC[out: STREAM, rtHeader: RTBcd.RTBase] = {
            stampList: LONG POINTER TO RTBcd.StampList = @rtHeader[rtHeader.stampTable];
            out.PutRope["Version Stamps"];
            PrintIndex[out, LOOPHOLE[rtHeader.stampTable]];
            out.PutRope[":\n"];
            FOR i: NAT IN [1 .. stampList.limit) DO
                Tab[out, 2];
                PrintIndex[out, i];  out.PutChar[' ];
                ListerUtils.PrintVersion[stampList[i], out];
                out.PutF[" (%g, ", [cardinal[stampList[i].time]]];
                out.PutF["%g#", [cardinal[stampList[i].net]]];
                out.PutF["%g#)", [cardinal[stampList[i].host]]];
                ENDLOOP;
            out.PutRope["\n\n"]};

        PrintRCMap: PROC[out: STREAM, rtHeader: RTBcd.RTBase] = {
            rcmb: RCMap.Base = LOOPHOLE[@rtHeader[rtHeader.rcMapBase]];
            next: RCMap.Index;
            out.PutRope["RC Maps"];
            PrintIndex[out, Basics.LowHalf[LOOPHOLE[rtHeader.rcMapBase, LONG CARDINAL]]];
            out.PutRope[":\n"];
            FOR rcmi: RCMap.Index _ FIRST[RCMap.Index], next
                WHILE LOOPHOLE[rcmi, CARDINAL] < rtHeader.rcMapLength DO
                    Tab[out, 2];
                    PrintIndex[out, LOOPHOLE[rcmi, CARDINAL]];
                    out.PutChar[' ];
                    WITH m~~rcmb[rcmi] SELECT FROM
                        null => {
                            out.PutRope["null"];
                            next _ rcmi + RCMap.Object.null.SIZE};
                        ref => {
                            out.PutRope["ref"];
                            next _ rcmi + RCMap.Object.ref.SIZE};
                        controlLink => {
                            out.PutRope["controlLink"];
                            next _ rcmi + RCMap.Object.controlLink.SIZE};
                        oneRef => {
                            out.PutRope["oneRef[offset: "];  PrintDecimal[out, m.offset];  out.PutChar[']];
                            next _ rcmi + RCMap.Object.oneRef.SIZE};
                        simple => {
                            out.PutRope["simple[length: "];  PrintDecimal[out, m.length];
                            out.PutRope[", offsets: ["];
                            FOR i: NAT IN [0 .. m.length) DO
                                IF m.refs[i] THEN {
                                    PrintDecimal[out, i];
                                    IF i + 1 # m.length THEN out.PutRope[", "]};
                                ENDLOOP;
                            out.PutRope["]]"];
                            next _ rcmi + RCMap.Object.simple.SIZE};
                        nonVariant => {
                            out.PutRope["nonVariant[nComponents: "];  PrintDecimal[out, m.nComponents];
                            out.PutRope[", components: ["];
                            FOR i: NAT IN [0..m.nComponents) DO
                                IF i MOD 3 = 0 THEN Tab[out, 8];
                                PrintField[out, m.components[i]];
                                IF i+1 # m.nComponents THEN out.PutRope[", "];
                                ENDLOOP;
                            out.PutRope["]]"];
                            next _ rcmi + (RCMap.Object.nonVariant.SIZE + m.nComponents*RCMap.RCField.SIZE)};
                        variant => {
                            out.PutRope["variant[fdTag: "];  PrintFD[out, m.fdTag];
                            out.PutRope[", nVariants: "];  PrintDecimal[out, m.nVariants];
                            out.PutRope[", variants: ["];
                            FOR i: NAT IN [0..m.nVariants) DO
                                PrintIndex[out, LOOPHOLE[m.variants[i]]];
                                IF i+1 # m.nVariants THEN out.PutRope[", "];
                                ENDLOOP;
                            out.PutRope["]]"];
                            next _ rcmi + (RCMap.Object.variant.SIZE + m.nVariants*RCMap.Index.SIZE)};
                        array => {
                            out.PutRope["array[wordsPerElement: "];  PrintDecimal[out, m.wordsPerElement];
                            out.PutRope[", nElements: "];  PrintDecimal[out, m.nElements];
                            out.PutRope[", rcmi: "];  PrintIndex[out, LOOPHOLE[m.rcmi]];  out.PutChar[']];
                            next _ rcmi + RCMap.Object.array.SIZE};
                        sequence => {
                            out.PutRope["sequence[wordsPerElement: "];
                            PrintDecimal[out, m.wordsPerElement];
                            out.PutRope[", fdLength: "];  PrintFD[out, m.fdLength];
                            out.PutRope[", dataOffset: "];  PrintDecimal[out, m.dataOffset];
                            out.PutRope[", rcmi: "];  PrintIndex[out, LOOPHOLE[m.rcmi]];  out.PutChar[']];
                            next _ rcmi + RCMap.Object.sequence.SIZE};
                        ENDCASE => {PrintGarbage[out]; EXIT};
                    ENDLOOP;
            out.PutRope["\n\n"]};

        PrintField: PROC[out: STREAM, f: RCMap.RCField] = {
            out.PutRope["[offset: "];  PrintDecimal[out, f.wordOffset];
            out.PutRope[", rcmi: "];  PrintIndex[out, LOOPHOLE[f.rcmi]];  out.PutChar[']]};

        PrintFD: PROC[out: STREAM, fd: RCMap.FieldDescriptor] = {
            out.PutChar['(];  PrintDecimal[out, fd.wordOffset];
            IF fd.bitFirst # 0 OR fd.bitCount # Basics.bitsPerWord THEN {
                out.PutChar[':];  PrintDecimal[out, fd.bitFirst];
                out.PutRope[".."];  PrintDecimal[out, fd.bitFirst + fd.bitCount - 1]};
            out.PutChar[')]};

        PrintRefLits: PROC[out: STREAM, rtHeader: RTBcd.RTBase] = {
            litList: LONG POINTER TO RTBcd.RefLitList = @rtHeader[rtHeader.refLitTable];
            textBase: LONG POINTER = @rtHeader[rtHeader.litBase];

            PutLitString: PROC[offset, length: CARDINAL] RETURNS[valid: BOOL] = INLINE {
                text: LONG POINTER TO TEXT = textBase + offset;
                valid _ offset + length <= rtHeader.litLength AND length = TEXT[text.length].SIZE;
                IF valid THEN PrintText[out, text] ELSE PrintGarbage[out]};

            out.PutRope["Atoms and REF Literals"];
            PrintIndex[out, LOOPHOLE[rtHeader.refLitTable]];
            out.PutRope[":\n"];
            FOR i: NAT IN [0 .. litList.length) DO
                Tab[out, 2];
                PrintIndex[out, i];
                out.PutRope[" type: "];  PrintIndex[out, litList[i].referentType];
                out.PutRope[", lit: \""];
                IF ~PutLitString[litList[i].offset, litList[i].length] THEN EXIT;
                out.PutRope["\""];
                ENDLOOP;
            out.PutRope["\n"]};

        PutType: PROC[out: STREAM, s: TypeStrings.TypeString, i: CARDINAL] RETURNS[CARDINAL] = {

            PutCode: PROC[c: TypeStrings.Code] = {
                SELECT c FROM
                    $definition => out.PutChar['=];
                    $name => out.PutChar['&];
                    $record => out.PutRope[":Rec"];
                    $structure => out.PutRope[":Struc"];
                    $union => out.PutRope[":Union"];
                    $array => out.PutRope[":Arr"];
                    $sequence => out.PutRope[":Seq"];
                    $enumerated => out.PutRope[":Enum"];
                    $subrange => out.PutRope[":Sub"];
                    $opaque => out.PutRope[":Op"];
                    $countedZone => out.PutRope[":Z"];
                    $uncountedZone => out.PutRope[":UZ"];
                    $list => out.PutRope[":L"];
                    $relativeRef => out.PutRope[":Rel"];
                    $ref => out.PutChar['^];
                    $refAny => out.PutChar['!];
                    $pointer => out.PutRope[":Ptr"];
                    $longPointer => out.PutRope[":LPtr"];
                    $descriptor => out.PutRope[":Desc"];
                    $longDescriptor => out.PutRope[":LDesc"];
                    $port => out.PutRope[":Port"];
                    $process => out.PutRope[":Process"];
                    $program => out.PutRope[":Prog"];
                    $type => out.PutRope[":Type"];
                    $nil => out.PutRope[":Nil"];
                    $any => out.PutRope[":Any"];
                    $boolean => out.PutRope[":B"];
                    $unspecified => out.PutRope[":U"];
                    $globalFrame => out.PutRope[":GF"];
                    $localFrame => out.PutRope[":LF"];
                    $procedure => out.PutRope[":Proc"];
                    $signal => out.PutRope[":Sig"];    
                    $error => out.PutRope[":Err"];
                    $cardinal => out.PutRope[":C"];
                    $integer => out.PutRope[":I"];
                    $character => out.PutRope[":Ch"];
                    $longInteger => out.PutRope[":LI"];
                    $longCardinal => out.PutRope[":LC"];
                    $string => out.PutRope[":S"];
                    $stringBody => out.PutRope[":SB"];
                    $text => out.PutRope[":Text"];
                    $atomRec => out.PutRope[":AtomRec"];
                    $mds => out.PutRope[":Mds"];
                    $ordered => out.PutRope[":Ord"];
                    $packed => out.PutRope[":Pack"];
                    $readOnly => out.PutRope[":RO"];
                    $real => out.PutRope[":R"];
                    $paint => out.PutChar['#];
                    $leftParen => out.PutChar['(];
                    $rightParen => out.PutChar[')];
                    $safeProc => out.PutRope[":SP"];
                    $safe => out.PutRope[":Safe"];
                    $var => out.PutRope[":Var"];
                    $longUnspecified => out.PutRope[":LU"];
                    ENDCASE => PrintEscape[out, VAL[c.ORD]];
                };

            PutNum: PROC[nBytes: [1..2]] = {
                v: CARDINAL _ 0;
                THROUGH [1..nBytes] DO
                    v _ 256*v + (s[i]-0c);
                    i _ i+1;
                    ENDLOOP;
                PrintDecimal[out, v]};

            PutId: PROC = {
                n: NAT = s[i] - 0c;
                out.PutChar[''];
                i _ i + 1;
                THROUGH [1..n] DO
                    out.PutChar[s[i]];
                    i _ i+1
                    ENDLOOP;
                out.PutChar['']};

            PutPaint: PROC = {
                hex: STRING = "01234567890abcdef";
                out.PutChar['{];
                THROUGH [1..6] DO
                    v: NAT = s[i] - 0c;
                    out.PutChar[hex[v/16]];
                    out.PutChar[hex[v MOD 16]];
                    i _ i + 1;
                    ENDLOOP;
                PutNum[2];
                out.PutChar['}]};

            PutSubType: PROC = {
                c: TypeStrings.Code = VAL[s[i].ORD];
                PutCode[c];
                i _ i + 1;
                SELECT c FROM
                    $definition => {PutNum[1]; PutSubType[]};
                    $name => {PutNum[1]};
                    $leftParen => {
                        WHILE LOOPHOLE[s[i], TypeStrings.Code] # rightParen DO
                            PutId[]; PutSubType[];
                            ENDLOOP;
                        out.PutChar[')]; i _ i+1};
                    $paint, $opaque, $union => PutPaint[];
                    $enumerated => {
                        SELECT LOOPHOLE[s[i], TypeStrings.Code] FROM
                            $paint => {
                                <<This type is painted, so just put out the paint>>
                                i _ i+1;
                                PutPaint[]};
                            $leftParen => {
                                <<This type is unpainted, so it has a list of names (MD enumerations are always painted)>>
                                out.PutChar['(];
                                i _ i+1;
                                WHILE LOOPHOLE[s[i], TypeStrings.Code] # rightParen DO PutId[] ENDLOOP;
                                out.PutChar[')];
                                i _ i+1};
                            ENDCASE;
                        };
                    $subrange => {
                        PutSubType[];
                        out.PutChar['[];
                        i _ i+2;  PutNum[2];
                        out.PutChar['.];  out.PutChar['.];
                        i _ i+2;  PutNum[2];
                        out.PutChar[']]};
                    $sequence => {
                        PutId[];
                        PutSubType[];
                        PutSubType[]};
                    $array, $relativeRef, $port, $program, $procedure, $signal, $safeProc => {
                        PutSubType[];  PutSubType[]};    -- binary
                    $list, $ref, $pointer, $longPointer, $descriptor, $longDescriptor, $process, $error, $readOnly, $packed, $ordered, $safe, $var =>
                        PutSubType[];    -- unary
                    ENDCASE => NULL;    -- nullary
                };

            out.PutChar['(]; PrintDecimal[out, s.length]; out.PutChar[')]; out.PutChar[' ];
            PutSubType[];
            RETURN[i]};


        PrintDecimal: PROC[out: STREAM, int: INT] = {out.Put[[integer[int]]]};

        PrintIndex: PROC[out: STREAM, index: CARDINAL] = {
            out.PutChar['[];  PrintDecimal[out, index];  out.PutChar[']]};

        PrintEscape: PROC[out: STREAM, char: CHAR] = {
            c: CARDINAL _ char.ORD;
            out.PutChar['\\];
            out.PutChar['0 + c/64];  c _ c MOD 64;
            out.PutChar['0 + c/8];   c _ c MOD 8;
            out.PutChar['0 + c]};

        PrintText: PROC[out: STREAM, t: LONG POINTER TO TEXT] = {
            IF t = NIL THEN out.PutRope["(nil)"]
            ELSE
                FOR i: NAT IN [0..t.length) DO
                    c: CHAR = t[i];
                    SELECT t[i] FROM
                        '\n => {out.PutChar['\\]; out.PutChar['n]};
                        '\r => {out.PutChar['\\]; out.PutChar['r]};
                        '\l => {out.PutChar['\\]; out.PutChar['l]};
                        '\f => {out.PutChar['\\]; out.PutChar['f]};
                        '\t => {out.PutChar['\\]; out.PutChar['n]};
                        '\b => {out.PutChar['\\]; out.PutChar['b]};
                        '\\ =>  {out.PutChar['\\]; out.PutChar['\\]};
                        '" => {out.PutChar['\\]; out.PutChar['\"]};
                        IN ['\000 .. ' ), IN ['\177 .. CHAR.LAST] => PrintEscape[out, c];
                        ENDCASE => out.PutChar[c]
                    ENDLOOP
                };

        PrintGarbage: PROC[out: STREAM] = INLINE {out.PutRope["? Looks like garbage ...\n"]};

        Tab: PROC[out: STREAM, n: CARDINAL] = {
            out.PutChar['\n];
            FOR i: NAT IN [1..n] DO out.PutChar['\t]; ENDLOOP};

        END.