ListRTBcdImpl.mesa
Copyright © 1984 by Xerox Corporation. All rights reserved.
Satterthwaite, 4-May-82 13:23:11
Paul Rovner, October 6, 1983 11:39 am
Russ Atkinson, June 27, 1984 8:37:23 pm PDT
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: CARDINALLOOPHOLE[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.