[_CDCSL_93-16_]<1>Cedar>release>XLister>ListRTMobImpl.mesa

ListRTMobImpl.mesa

Paul Rovner, October 6, 1983 11:39 am

Satterthwaite March 21, 1986 10:08:30 am PST

Andy Litman March 3, 1988 3:44:03 pm PST

Russ Atkinson (RRA) November 2, 1988 8:03:58 pm PST

JKF January 11, 1989 8:24:50 am PST

Willie-s, September 26, 1991 2:14 pm PDT

Michael Plass, November 26, 1991 4:23 pm PST

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]];

MobListerUtils.WithPages[inStream, mob, UnitsToFilePages[mob.rtOffset.units], UnitsToFilePages[mob.rtLimit.units], Inner];

};

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];

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: 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 {

A small negative number

v.int ¬ -INT[m];

}

ELSE {

A long, large number

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 => {};

Does this ever happen?

$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 => {

This type is painted, so just put out the paint

i ¬ i+1;

PutPaint[c];

};

$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['[];

PutNum[];

out.PutChar['.]; out.PutChar['.];

PutNum[];

out.PutChar[']];

};

$sequence => {

PutId[];

PutSubType[];

};

$array, $relativeRef, $port, $program, $procedure, $signal, $safeProc => {

Binary

PutSubType[];

};

$list, $ref, $pointer, $longPointer, $descriptor, $longDescriptor, $process, $error, $readOnly, $packed, $ordered, $safe, $var =>

Unary

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.