ListRTBcdImpl.mesa
Satterthwaite, 4-May-82 13:23:11
Paul Rovner, October 6, 1983 11:39 am
Russ Atkinson, October 24, 1983 4:48 pm
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
leftParen => IO.PutChar[out, '[];
definition => IO.PutChar[out, '&];
name => IO.PutChar[out, '.];
ref => IO.PutChar[out, '@];
list => IO.PutChar[out, '*];
ENDCASE => {
repr: NAT = LOOPHOLE[c];
offset: NAT = repr - 200b;
IO.PutChar[out,
IF offset < 'Z-'A+1
THEN 'A + offset
ELSE 'a + (offset - ('Z-'A+1))];
};
};
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 = "abcdefghijklmnop";
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[];
Skip[2]; PutNum[2];
IO.PutChar[out, ',];
Skip[2]; PutNum[2];
};
sequence => {
PutId[]; PutSubType[]; PutSubType[]};
array, relativeRef, port, program, procedure, signal =>
{PutSubType[]; PutSubType[]}; -- binary
list, ref, pointer, longPointer, descriptor, longDescriptor,
process, error,
readOnly, packed, ordered =>
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.