<<>> <> <> <> <> <> <> <> <> <> DIRECTORY Basics USING [LongNumber], File USING [wordsPerPage], IO USING [Put1, PutChar, PutF, PutF1, PutRope, STREAM], ListRTMob USING [], MobDefs USING [Mob, MobBase, VersionStamp], MobListerUtils USING [PrintVersion], OSMiscOps USING [], RCMap USING [Base, FieldDescriptor, Index, Object, RCField], Rope USING [ROPE], RTMob USING [AnyStamp, RefLitList, RTBase, StampList, TypeList, VersionID], Symbols USING [SEIndex, SENull], Table USING [Base, IndexRep], TypeStrings USING [Code, TypeString]; ListRTMobImpl: PROGRAM IMPORTS IO, MobListerUtils EXPORTS ListRTMob = BEGIN unitsPerFilePage: NAT = File.wordsPerPage * UNITS[WORD]; UnitsToFilePages: PROC[units: INT] RETURNS[INT] = { RETURN[(units+unitsPerFilePage-1)/unitsPerFilePage]}; RefMob: TYPE = REF MobDefs.Mob; ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; PrintRTMob: PUBLIC PROC[out: IO.STREAM, mob: MobDefs.MobBase] = { Inner: PROC[ptr: LONG POINTER] = { rtHeader: RTMob.RTBase = LOOPHOLE[ptr]; SELECT TRUE FROM (rtHeader = NIL) => out.PutRope["No RT pages\n"]; (rtHeader.versionIdent # RTMob.VersionID) => out.PutRope["Invalid RT version stamp\n"]; ENDCASE => { PrintHeader[out, rtHeader]; PrintTypes[out, rtHeader]; PrintStamps[out, rtHeader]; PrintRCMap[out, rtHeader]; PrintRefLits[out, rtHeader]}; }; Inner[LOOPHOLE[mob + mob.rtOffset.units]]; <> }; PrintHeader: PROC [out: STREAM, rtHeader: RTMob.RTBase] = { IO.PutF1[out, "Types: %g", [integer[rtHeader[rtHeader.typeTable].length]] ]; IO.PutF1[out, ", Ref Literals: %g", [integer[rtHeader[rtHeader.refLitTable].length]] ]; IO.PutF1[out, ", %g units of RC map", [integer[rtHeader.rcMapLength]] ]; IO.PutF1[out, ", %g units of literals: \n\n", [integer[rtHeader.litLength]] ]; }; PrintTypes: PROC [out: STREAM, rtHeader: RTMob.RTBase] = { typeList: LONG POINTER TO RTMob.TypeList = @rtHeader[rtHeader.typeTable]; stampList: LONG POINTER TO RTMob.StampList = @rtHeader[rtHeader.stampTable]; textBase: LONG POINTER = @rtHeader[rtHeader.litBase]; PrintTypeString: PROC[offset: INT] RETURNS[valid: BOOL] = INLINE { text: TypeStrings.TypeString = textBase + offset; valid ¬ offset <= rtHeader.litLength AND offset+INT[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"]; PrintLongIndex[out, LOOPHOLE[rtHeader.typeTable]]; out.PutChar[':]; FOR i: NAT IN [0 .. typeList.length) DO sei: Symbols.SEIndex = typeList[i].sei; IF sei = Symbols.SENull THEN EXIT; Tab[out, 2]; PrintIndex[out, i]; out.PutRope[" sei: "]; PrintTagged[out, LOOPHOLE[sei]]; out.PutRope[", segment: "]; PrintLongIndex[out, LOOPHOLE[typeList[i].table]]; out.PutRope[", rcMap: "]; PrintLongIndex[out, LOOPHOLE[typeList[i].rcMap]]; out.PutRope[", UTF: [stamp: "]; IF typeList[i].ut.version = RTMob.AnyStamp THEN out.PutRope["(any)"] ELSE PrintLongIndex[out, LOOPHOLE[typeList[i].ut.version]]; out.PutRope[", sei: "]; PrintTagged[out, LOOPHOLE[typeList[i].ut.sei]]; out.PutChar[']]; IF typeList[i].canonical THEN out.PutRope[", canonical"]; Tab[out, 4]; PrintLongIndex[out, LOOPHOLE[typeList[i].ct.index]]; IF ~PrintTypeString[typeList[i].ct.index] THEN EXIT; ENDLOOP; out.PutRope["\n\n"]; }; PrintStamps: PROC[out: STREAM, rtHeader: RTMob.RTBase] = { stampList: LONG POINTER TO RTMob.StampList = @rtHeader[rtHeader.stampTable]; out.PutRope["Version Stamps"]; PrintLongIndex[out, LOOPHOLE[rtHeader.stampTable]]; out.PutRope[":\n"]; FOR i: NAT IN [1 .. stampList.limit) DO Tab[out, 2]; PrintIndex[out, i]; out.PutChar[' ]; MobListerUtils.PrintVersion[stampList[i], out]; <> <> <> ENDLOOP; out.PutRope["\n\n"]}; PrintRCMap: PROC[out: STREAM, rtHeader: RTMob.RTBase] = { rcmb: RCMap.Base = LOOPHOLE[@rtHeader[rtHeader.rcMapBase]]; next: RCMap.Index; out.PutRope["RC Maps"]; PrintLongIndex[out, LOOPHOLE[rtHeader.rcMapBase, CARD]]; out.PutRope[":\n"]; FOR rcmi: RCMap.Index ¬ FIRST[RCMap.Index], next WHILE LOOPHOLE[rcmi, INT] < rtHeader.rcMapLength DO Tab[out, 2]; PrintLongIndex[out, LOOPHOLE[rcmi, CARD]]; 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 => { IO.PutF1[out, "oneRef[offset: %g]", [integer[m.offset]] ]; next ¬ rcmi + RCMap.Object.oneRef.SIZE; }; simple => { IO.PutF1[out, "oneRef[offset: %g], offsets: [", [integer[m.length]] ]; 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 => { IO.PutF1[out, "nonVariant[nComponents: %g], components: [", [integer[m.nComponents]] ]; FOR i: CARDINAL 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: CARDINAL IN [0..m.nVariants) DO PrintLongIndex[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[unitsPerElement: "]; PrintDecimal[out, m.unitsPerElement]; out.PutRope[", nElements: "]; PrintDecimal[out, m.nElements]; out.PutRope[", rcmi: "]; PrintLongIndex[out, LOOPHOLE[m.rcmi]]; out.PutChar[']]; next ¬ rcmi + RCMap.Object.array.SIZE}; sequence => { out.PutRope["sequence[unitsPerElement: "]; PrintDecimal[out, m.unitsPerElement]; out.PutRope[", fdLength: "]; PrintFD[out, m.fdLength]; out.PutRope[", dataOffset: "]; PrintDecimal[out, m.dataOffset]; out.PutRope[", rcmi: "]; PrintLongIndex[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["[unitOffset: "]; PrintDecimal[out, f.unitOffset]; out.PutRope[", rcmi: "]; PrintLongIndex[out, LOOPHOLE[f.rcmi]]; out.PutChar[']]; }; PrintFD: PROC[out: STREAM, fd: RCMap.FieldDescriptor] = { IO.PutF[out, "(bitOffset: %g, bitCount: %g)", [integer[fd.bitOffset]], [cardinal[fd.bitCount]] ]; }; PrintRefLits: PROC[out: STREAM, rtHeader: RTMob.RTBase] = { litList: LONG POINTER TO RTMob.RefLitList = @rtHeader[rtHeader.refLitTable]; textBase: LONG POINTER = @rtHeader[rtHeader.litBase]; PutLitString: PROC[offset, length: INT] RETURNS[valid: BOOL] = INLINE { text: LONG POINTER TO TEXT = textBase + offset; valid ¬ offset + length <= rtHeader.litLength AND length = INT[TEXT[text.length].SIZE]; IF valid THEN PrintText[out, text] ELSE PrintGarbage[out]}; out.PutRope["Atoms and REF Literals"]; PrintLongIndex[out, LOOPHOLE[rtHeader.refLitTable]]; out.PutRope[":\n"]; FOR i: NAT IN [0 .. litList.length) DO Tab[out, 2]; PrintIndex[out, i]; out.PutRope[" type: "]; PrintLongIndex[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]]; }; ParseNum: PROC RETURNS [CARD] = { encodeMod: NAT = 64; v: Basics.LongNumber ¬ [card[0]]; c: BYTE ¬ s[i].ORD; m: BYTE ¬ c MOD encodeMod; i ¬ i + 1; SELECT c / encodeMod FROM 0 => v.card ¬ m; 1 => {v.lh ¬ m; v.ll ¬ s[i].ORD; i ¬ i + 1}; 2 => {v.hl ¬ m; v.lh ¬ s[i].ORD; v.ll ¬ s[i+1].ORD; i ¬ i + 2}; ENDCASE => { IF m # 0 THEN { <> v.int ¬ -INT[m]; } ELSE { <> v.hh ¬ s[i].ORD; v.hl ¬ s[i+1].ORD; v.lh ¬ s[i+2].ORD; v.ll ¬ s[i+3].ORD; i ¬ i + 4; }; }; RETURN [v.card]; }; PutNum: PROC = { c: CARD = ParseNum[]; IO.PutF1[out, "%g", [cardinal[c]]]; }; 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 [c: TypeStrings.Code] = { stamp: MobDefs.VersionStamp; out.PutChar['{]; IF c = $opaque THEN {PutId[]; out.PutChar[',]}; stamp[0] ¬ ParseNum[]; stamp[1] ¬ ParseNum[]; MobListerUtils.PrintVersion[stamp, out]; IF c # $opaque THEN {out.PutChar[',]; PutNum[]}; out.PutChar['}]; }; PutSubType: PROC = { c: TypeStrings.Code = VAL[s[i].ORD]; PutCode[c]; i ¬ i + 1; SELECT c FROM $definition => {}; <> $name => {IO.PutF1[out, "<%g>", [cardinal[s[i].ORD]]]; i ¬ i + 1}; $leftParen => { WHILE LOOPHOLE[s[i], TypeStrings.Code] # rightParen DO PutId[]; PutSubType[]; ENDLOOP; out.PutChar[')]; i ¬ i+1}; $definition, $paint, $opaque, $union => PutPaint[c]; $enumerated => { SELECT LOOPHOLE[s[i], TypeStrings.Code] FROM $paint => { <> i ¬ i+1; PutPaint[c]; }; $leftParen => { <> 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['[]; PutNum[]; out.PutChar['.]; out.PutChar['.]; PutNum[]; out.PutChar[']]; }; $sequence => { PutId[]; PutSubType[]; PutSubType[]; }; $array, $relativeRef, $port, $program, $procedure, $signal, $safeProc => { <> PutSubType[]; PutSubType[]; }; $list, $ref, $pointer, $longPointer, $descriptor, $longDescriptor, $process, $error, $readOnly, $packed, $ordered, $safe, $var => <> PutSubType[]; ENDCASE => NULL; }; IO.PutF1[out, "(%g) ", [integer[s.length]] ]; PutSubType[]; RETURN[i]; }; PrintDecimal: PROC[out: STREAM, int: INT] = {out.Put1[[integer[int]]]}; PrintIndex: PROC [out: STREAM, index: CARDINAL] = { IO.PutF1[out, "[%g]", [cardinal[index]]]; }; PrintLongIndex: PROC [out: STREAM, index: CARD] = { IO.PutF1[out, "[%g]", [cardinal[index]]]; }; PrintTagged: PROC [out: STREAM, index: CARD] = { tag: Table.IndexRep ¬ LOOPHOLE[index]; IO.PutF1[out, "[%g:", [cardinal[tag.tag]]]; tag.tag ¬ 0; IO.PutF1[out, "%g]", [cardinal[LOOPHOLE[tag, CARD]]]]; }; 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.