<> <> <> <> <> 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, ":UP"]; 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]; }; }; Skip: PROC [nBytes: CARDINAL] = { THROUGH [1..nBytes] DO i _ i+1 ENDLOOP; }; 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[]; subrange => { PutSubType[]; IO.PutChar[out, '[]; Skip[2]; PutNum[2]; IO.PutChar[out, '.]; IO.PutChar[out, '.]; Skip[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.