[Ivy]<Sweet>crosslister>ListRTBcdImpl.mesa!1

ListRTBcdImpl.mesa

Satterthwaite, 4-May-82 13:23:11

Paul Rovner, October 6, 1983 11:39 am

Russ Atkinson, March 7, 1985 4:10:35 am PST

Russ Atkinson (RRA) August 28, 1985 7:18:05 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, ":Proc"];

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: CARDINAL ← LOOPHOLE[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];

};

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

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 pairs of names and values

IO.PutChar[out, '(];

i ← i+1;

WHILE LOOPHOLE[s[i], TypeStrings.Code] # rightParen DO

PutId[]; PutNum[2];

ENDLOOP;

IO.PutChar[out, ')];

i ← i+1;

};

ENDCASE;

};

subrange => {

PutSubType[];

IO.PutChar[out, '[];

i ← i+2; PutNum[2];

IO.PutChar[out, '.];

i ← i+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.