[Cyan]<CedarChest6.1>Lister>ListRTBcdImpl.mesa!1

ListRTBcdImpl.mesa

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.