DIRECTORY
BcdDefs: TYPE USING [VersionStamp],
Environment: TYPE USING [bitsPerWord],
Inline: TYPE USING [LowHalf],
ListerDefs: TYPE USING [Indent, WriteVersionId],
OutputDefs: TYPE USING [PutChar, PutDecimal, PutString],
RCMap: TYPE USING [Base, FieldDescriptor, Index, Object, RCField],
RTBcd:
TYPE
USING [
RefLitList, RTBase, StampList, TypeList, VersionID, AnyStamp],
TypeStrings: TYPE USING [Code, TypeString];
ListRTBcd:
PROGRAM
IMPORTS Inline, ListerDefs, OutputDefs
EXPORTS ListerDefs =
BEGIN OPEN OutputDefs;
PrintRTBcd:
PUBLIC
PROC [rtHeader: RTBcd.RTBase] =
BEGIN
IF rtHeader =
NIL
THEN
PutString["No RT pages\n"L]
ELSE
IF rtHeader.versionIdent # RTBcd.VersionID
THEN
PutString["Invalid RT version stamp\n"L]
ELSE
BEGIN
PrintHeader[rtHeader];
PrintTypes[rtHeader];
PrintStamps[rtHeader];
PrintRCMap[rtHeader];
PrintRefLits[rtHeader];
END;
END;
PrintHeader:
PROC [rtHeader: RTBcd.RTBase] =
BEGIN
PutString["Types: "L]; PutDecimal[rtHeader[rtHeader.typeTable].length];
PutString[", Ref Literals: "L]; PutDecimal[rtHeader[rtHeader.refLitTable].length];
PutString[", "L];
PutDecimal[rtHeader.rcMapLength]; PutString[" Words of RC Map"L];
PutString[", "L];
PutDecimal[rtHeader.litLength]; PutString[" Words of Literals\n\n"L];
END;
PrintTypes:
PROC [rtHeader: RTBcd.RTBase] =
BEGIN
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
BEGIN
text: TypeStrings.TypeString = textBase + offset;
valid ← offset <= rtHeader.litLength
AND offset+SIZE[StringBody[text.length]] <= rtHeader.litLength;
PutChar[' ];
IF ~valid THEN PrintGarbage[]
ELSE
IF PutType[text, 0] # text.length THEN PutString[" ???"L];
END;
PutString["Types"L];
PrintIndex[rtHeader.typeTable];
PutString[":\n"L];
FOR i:
NAT
IN [0 .. typeList.length)
DO
Tab[2];
PrintIndex[i];
PutString[" sei: "L]; PutIndex[typeList[i].sei];
PutString[", segment: "L]; PrintIndex[typeList[i].table];
PutString[", rcMap: "L]; PrintIndex[typeList[i].rcMap];
PutString[", UTF: [stamp: "L];
IF typeList[i].ut.version = RTBcd.AnyStamp THEN PutString["(any)"L]
ELSE PrintIndex[typeList[i].ut.version];
PutString[", sei: "L];
PutIndex[typeList[i].ut.sei];
PutChar[']];
IF typeList[i].canonical THEN PutString[", canonical"L];
Tab[4];
PrintIndex[typeList[i].ct.index];
IF ~PrintTypeString[typeList[i].ct.index] THEN EXIT;
ENDLOOP;
PutString["\n\n"L];
END;
PrintStamps:
PROC [rtHeader: RTBcd.RTBase] =
BEGIN
stampList: LONG POINTER TO RTBcd.StampList = @rtHeader[rtHeader.stampTable];
PutString["Version Stamps"L];
PrintIndex[rtHeader.stampTable];
PutString[":\n"L];
FOR i:
NAT
IN [1 .. stampList.limit)
DO
Tab[2];
PrintIndex[i];
PutChar[' ];
ListerDefs.WriteVersionId[stampList[i]];
ENDLOOP;
PutString["\n\n"L];
END;
PrintRCMap:
PROC [rtHeader: RTBcd.RTBase] =
BEGIN
rcmb: RCMap.Base = LOOPHOLE[@rtHeader[rtHeader.rcMapBase]];
next: RCMap.Index;
PutString["RC Maps"L];
PrintIndex[Inline.LowHalf[LOOPHOLE[rtHeader.rcMapBase, LONG CARDINAL]]];
PutString[":\n"L];
FOR rcmi: RCMap.Index ←
FIRST[RCMap.Index], next
WHILE
LOOPHOLE[rcmi,
CARDINAL] < rtHeader.rcMapLength
DO
Tab[2];
PrintIndex[rcmi];
PutChar[' ];
WITH m: rcmb[rcmi]
SELECT
FROM
null => {
PutString["null"L];
next ← rcmi + SIZE[RCMap.Object[null]]};
ref => {
PutString["ref"L];
next ← rcmi + SIZE[RCMap.Object[ref]]};
controlLink => {
PutString["controlLink"L];
next ← rcmi + SIZE[RCMap.Object[controlLink]]};
oneRef => {
PutString["oneRef[offset: "L]; PutDecimal[m.offset]; PutChar[']];
next ← rcmi + SIZE[RCMap.Object[oneRef]]};
simple => {
PutString["simple[length: "L]; PutDecimal[m.length];
PutString[", offsets: ["L];
FOR i:
NAT
IN [0 .. m.length)
DO
IF m.refs[i]
THEN
BEGIN
PutDecimal[i];
IF i + 1 # m.length THEN PutString[", "L];
END;
ENDLOOP;
PutString["]]"L];
next ← rcmi + SIZE[RCMap.Object[simple]]};
nonVariant => {
PutString["nonVariant[nComponents: "L]; PutDecimal[m.nComponents];
PutString[", components: ["L];
FOR i:
NAT
IN [0..m.nComponents)
DO
IF i MOD 3 = 0 THEN Tab[8];
PrintField[m.components[i]];
IF i+1 # m.nComponents THEN PutString[", "L];
ENDLOOP;
PutString["]]"L];
next ← rcmi + (SIZE[RCMap.Object[nonVariant]] + m.nComponents*SIZE[RCMap.RCField])};
variant => {
PutString["variant[fdTag: "L]; PrintFD[m.fdTag];
PutString[", nVariants: "L]; PutDecimal[m.nVariants];
PutString[", variants: ["L];
FOR i:
NAT
IN [0..m.nVariants)
DO
PrintIndex[m.variants[i]];
IF i+1 # m.nVariants THEN PutString[", "L];
ENDLOOP;
PutString["]]"L];
next ← rcmi + (SIZE[RCMap.Object[variant]] + m.nVariants*SIZE[RCMap.Index])};
array => {
PutString["array[wordsPerElement: "L]; PutDecimal[m.wordsPerElement];
PutString[", nElements: "L]; PutDecimal[m.nElements];
PutString[", rcmi: "L]; PrintIndex[m.rcmi]; PutChar[']];
next ← rcmi + SIZE[RCMap.Object[array]]};
sequence => {
PutString["sequence[wordsPerElement: "L]; PutDecimal[m.wordsPerElement];
PutString[", fdLength: "L]; PrintFD[m.fdLength];
PutString[", dataOffset: "L]; PutDecimal[m.dataOffset];
PutString[", rcmi: "L]; PrintIndex[m.rcmi]; PutChar[']];
next ← rcmi + SIZE[RCMap.Object[sequence]]};
ENDCASE => {PrintGarbage[]; EXIT};
ENDLOOP;
PutString["\n\n"L];
END;
PrintField:
PROC [f: RCMap.RCField] =
BEGIN
PutString["[offset: "L]; PutDecimal[f.wordOffset];
PutString[", rcmi: "L]; PrintIndex[f.rcmi]; PutChar[']];
END;
PrintFD:
PROC [fd: RCMap.FieldDescriptor] =
BEGIN
PutChar['(]; PutDecimal[fd.wordOffset];
IF fd.bitFirst # 0
OR fd.bitCount # Environment.bitsPerWord
THEN
BEGIN
PutChar[':]; PutDecimal[fd.bitFirst];
PutString[".."L]; PutDecimal[fd.bitFirst + fd.bitCount - 1];
END;
PutChar[')];
END;
PrintRefLits:
PROC [rtHeader: RTBcd.RTBase] =
BEGIN
litList: LONG POINTER TO RTBcd.RefLitList = @rtHeader[rtHeader.refLitTable];
textBase: LONG POINTER = @rtHeader[rtHeader.litBase];
PutLitString:
PROC [offset, length:
CARDINAL]
RETURNS [valid:
BOOLEAN] =
INLINE
BEGIN
text: LONG POINTER TO TEXT = textBase + offset;
valid ← offset + length <= rtHeader.litLength AND length = SIZE[TEXT[text.length]];
IF valid THEN PrintText[text] ELSE PrintGarbage[];
END;
PutString["Atoms and REF Literals"L];
PrintIndex[rtHeader.refLitTable];
PutString[":\n"L];
FOR i:
NAT
IN [0 .. litList.length)
DO
Tab[2];
PrintIndex[i];
PutString[" type: "L];
PrintIndex[litList[i].referentType];
PutString[", "L];
IF ~PutLitString[litList[i].offset, litList[i].length] THEN EXIT;
ENDLOOP;
PutString["\n\n"L];
END;
PutIndex: PROC [index: UNSPECIFIED] = LOOPHOLE[PutDecimal];
PutType:
PROC [s: TypeStrings.TypeString, i:
CARDINAL]
RETURNS [
CARDINAL] =
BEGIN
PutCode:
PROC [c: TypeStrings.Code] =
BEGIN
SELECT c
FROM
leftParen => PutChar['[];
definition => PutChar['&];
name => PutChar['.];
ref => PutChar['@];
list => PutChar['*];
ENDCASE =>
BEGIN
repr: NAT = LOOPHOLE[c];
offset: NAT = repr - 200b;
PutChar[
IF offset < 'Z-'A+1
THEN 'A + offset
ELSE 'a + (offset - ('Z-'A+1))];
END;
END;
Skip:
PROC [nBytes:
CARDINAL] =
{THROUGH [1..nBytes] DO i ← i+1 ENDLOOP};
PutNum:
PROC [nBytes: [1..2]] =
BEGIN
v: CARDINAL ← 0;
THROUGH [1..nBytes]
DO
v ← 256*v + (s[i]-0c); i ← i+1;
ENDLOOP;
PutDecimal[v];
END;
PutId:
PROC =
BEGIN
n: NAT = s[i] - 0c;
PutChar['']; i ← i + 1;
THROUGH [1..n]
DO
PutChar[s[i]]; i ← i+1
ENDLOOP;
PutChar[''];
END;
PutPaint:
PROC =
BEGIN
hex: STRING = "abcdefghijklmnop"L;
PutChar['{];
THROUGH [1..6]
DO
v: NAT = s[i] - 0c;
PutChar[hex[v/16]]; PutChar[hex[v MOD 16]];
i ← i + 1;
ENDLOOP;
PutNum[2];
PutChar['}];
END;
PutSubType:
PROC =
BEGIN
c: TypeStrings.Code = LOOPHOLE[s[i]];
PutCode[c];
i ← i + 1;
SELECT c
FROM
definition => {PutNum[1]; PutSubType[]};
name => {PutNum[1]};
leftParen =>
BEGIN
WHILE
LOOPHOLE[s[i], TypeStrings.Code] # rightParen
DO
PutId[]; PutSubType[];
ENDLOOP;
PutChar[']]; i ← i+1;
END;
paint, opaque, union => {PutPaint[]};
subrange =>
BEGIN
PutSubType[];
Skip[2]; PutNum[2];
PutChar[',];
Skip[2]; PutNum[2];
END;
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
END;
PutChar['(]; PutDecimal[s.length]; PutChar[')]; PutChar[' ];
PutSubType[];
RETURN [i]
END;
PrintIndex:
PROC [index:
UNSPECIFIED] =
{PutString["["L]; PutDecimal[index]; PutChar[']]};
PrintText:
PROC [t:
LONG
POINTER
TO
TEXT] =
BEGIN
IF t = NIL THEN PutString["(nil)"L]
ELSE
FOR i: NAT IN [0 .. t.length) DO PutChar[t[i]] ENDLOOP;
END;
PrintGarbage:
PROC =
INLINE
BEGIN
PutString["? Looks like garbage ...\n"L];
END;
Tab: PROC [n: CARDINAL] = {ListerDefs.Indent[n]};
END.