
    <<ListRTBcdImpl.mesa  >>
        <<Copyright © 1984, 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite,  4-May-82 13:23:11>>
        <<Paul Rovner, October 6, 1983 11:39 am>>
        <<Russ Atkinson, March 7, 1985 4:10:35 am PST>>
        <<Russ Atkinson (RRA) August 28, 1985 7:18:05 pm PDT>>

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

    ListRTBcdImpl: PROGRAM
        IMPORTS Basics, ConvertUnsafe, 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 =>
                    IO.PutRope[out, "No RT pages\n"];
                rtHeader.versionIdent # RTBcd.VersionID =>
                    IO.PutRope[out, "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] = {
        IO.PutRope[out, "Types: "]; PrintDecimal[out, rtHeader[rtHeader.typeTable].length];
        IO.PutRope[out, ", Ref Literals: "]; PrintDecimal[out, rtHeader[rtHeader.refLitTable].length];
        IO.PutRope[out, ", "];
        PrintDecimal[out, rtHeader.rcMapLength]; IO.PutRope[out, " Words of RC Map"];
        IO.PutRope[out, ", "];
        PrintDecimal[out, rtHeader.litLength]; IO.PutRope[out, " 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: BOOLEAN] = INLINE {
            text: TypeStrings.TypeString = textBase + offset;
            valid _ offset <= rtHeader.litLength
                AND offset+SIZE[StringBody[text.length]] <= rtHeader.litLength;
            IO.PutChar[out, ' ];
            SELECT TRUE FROM
                ~valid => PrintGarbage[out];
                PutType[out, text, 0] # text.length => IO.PutRope[out, " ???"];
                ENDCASE;
            };

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

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

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

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

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

    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: BOOLEAN] = INLINE {
            text: LONG POINTER TO TEXT = textBase + offset;
            valid _ offset + length <= rtHeader.litLength AND length = SIZE[TEXT[text.length]];
            IF valid THEN PrintText[out, text] ELSE PrintGarbage[out];
            };

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

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

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

        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;
            IO.PutChar[out, ''];
            i _ i + 1;
            THROUGH [1..n] DO
                IO.PutChar[out, s[i]];
                i _ i+1
                ENDLOOP;
            IO.PutChar[out, ''];
            };

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

        PutSubType: PROC = {
            c: TypeStrings.Code = LOOPHOLE[s[i]];
            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;
                    IO.PutChar[out, ')]; 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 pairs of names and values>>
                            IO.PutChar[out, '(];
                            i _ i+1;
                            WHILE LOOPHOLE[s[i], TypeStrings.Code] # rightParen DO
                                PutId[]; PutNum[2];
                                ENDLOOP;
                            IO.PutChar[out, ')];
                            i _ i+1;
                            };
                        ENDCASE;
                    };
                subrange => {
                    PutSubType[];
                    IO.PutChar[out, '[];
                    i _ i+2; PutNum[2];
                    IO.PutChar[out, '.];
                    IO.PutChar[out, '.];
                    i _ i+2; PutNum[2];
                    IO.PutChar[out, ']];
                    };
                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
            };

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


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

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

    PrintText: PROC [out: STREAM, t: LONG POINTER TO TEXT] = {
        IF t = NIL
            THEN IO.PutRope[out, "(nil)"]
            ELSE {
                rope: ROPE = ConvertUnsafe.ToRope[LOOPHOLE[t]];
                IO.PutF[out, "%q", [rope[rope]]];
                };
        };

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

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

    END.