[Indigo]<Cedar5.3>Lister>ListerUtilsImpl.mesa!2

ListerUtilsImpl.mesa

Russ Atkinson, July 9, 1984 8:06:38 pm PDT

DIRECTORY

Basics USING [bytesPerWord],

BasicTime USING [FromNSTime],

BcdDefs USING

[BCD, FTIndex, FTSelf, Link, MTIndex, MTNull, MTRecord, SGIndex, SGNull, SGRecord, VersionStamp],

ConvertUnsafe USING [SubString],

DefaultRemoteNames USING [Get],

FS USING [Error, OpenFileFromStream, Read, StreamOpen],

ListerUtils USING [OpCodeArray, OpCodeArrayRep, OpCodeEntry],

Literals USING [LitDescriptor, LTIndex, LTNull, LTRecord, MSTIndex, STIndex, STNull],

IO USING

[Close, EndOfStream, GetChar, GetInt, GetTokenRope, Put, PutChar, PutF, PutRope, SetIndex, SkipWhitespace, STREAM, UnsafeGetBlock],

Rope USING [Concat, Fetch, Flatten, Length, ROPE],

RuntimeError USING [UNCAUGHT],

SymbolPack,

Symbols USING

[BitAddress, BodyRecord, BTIndex, ContextLevel, CSEIndex, CTXIndex, CTXNull, CTXRecord, ISEIndex, ISENull, lG, lL, lZ, MDIndex, Name, nullName, RootBti, SEIndex, SENull, SERecord, TransferMode, TypeClass, typeTYPE],

SymbolTable USING [Base],

Tree USING [Index, Link, Node, NodeName, NullIndex],

VM USING [AddressForPageNumber, Allocate, Free, Interval, MakeReadOnly];

ListerUtilsImpl: PROGRAM

IMPORTS BasicTime, DefaultRemoteNames, FS, IO, Rope, RuntimeError, SymbolPack, VM

EXPORTS ListerUtils

= BEGIN

T Y P E S & C O N S T A N T S

BCD: TYPE = BcdDefs.BCD;

BitAddress: TYPE = Symbols.BitAddress;

BTIndex: TYPE = Symbols.BTIndex;

BTRecord: TYPE = Symbols.BodyRecord;

bytesPerWord: NAT = Basics.bytesPerWord;

CSEIndex: TYPE = Symbols.CSEIndex;

typeTYPE: CSEIndex = Symbols.typeTYPE;

ContextLevel: TYPE = Symbols.ContextLevel;

lZ: ContextLevel = Symbols.lZ;

lG: ContextLevel = Symbols.lG;

lL: ContextLevel = Symbols.lL;

CTXIndex: TYPE = Symbols.CTXIndex;

CTXNull: CTXIndex = Symbols.CTXNull;

CTXRecord: TYPE = Symbols.CTXRecord;

FTIndex: TYPE = BcdDefs.FTIndex;

FTSelf: FTIndex = BcdDefs.FTSelf;

ISEIndex: TYPE = Symbols.ISEIndex;

ISENull: ISEIndex = Symbols.ISENull;

ISERecord: TYPE = SERecord.id;

LTIndex: TYPE = Literals.LTIndex;

LTNull: LTIndex = Literals.LTNull;

LTRecord: TYPE = Literals.LTRecord;

LitDescriptor: TYPE = Literals.LitDescriptor;

MDIndex: TYPE = Symbols.MDIndex;

MSTIndex: TYPE = Literals.MSTIndex;

MSTNull: MSTIndex = LOOPHOLE[STNull];

MTIndex: TYPE = BcdDefs.MTIndex;

MTNull: MTIndex = BcdDefs.MTNull;

MTRecord: TYPE = BcdDefs.MTRecord;

Name: TYPE = Symbols.Name;

nullName: Name = Symbols.nullName;

NodeName: TYPE = Tree.NodeName;

RefBCD: TYPE = REF BCD;

RefMTRecord: TYPE = REF MTRecord;

RefSGRecord: TYPE = REF SGRecord;

RootBti: BTIndex = Symbols.RootBti;

ROPE: TYPE = Rope.ROPE;

SEIndex: TYPE = Symbols.SEIndex;

SENull: SEIndex = Symbols.SENull;

SERecord: TYPE = Symbols.SERecord;

SGIndex: TYPE = BcdDefs.SGIndex;

SGNull: SGIndex = BcdDefs.SGNull;

SGRecord: TYPE = BcdDefs.SGRecord;

STIndex: TYPE = Literals.STIndex;

STNull: STIndex = Literals.STNull;

STREAM: TYPE = IO.STREAM;

SubString: TYPE = ConvertUnsafe.SubString;

SymbolTableBase: TYPE = SymbolTable.Base;

TransferMode: TYPE = Symbols.TransferMode;

TypeClass: TYPE = Symbols.TypeClass;

VersionStamp: TYPE = BcdDefs.VersionStamp;

OpCode types & procedures

opCodeArray: ListerUtils.OpCodeArray ← NIL;

OpCodeFormatError: ERROR = CODE;

GetOpCodeArray: PUBLIC PROC RETURNS [ListerUtils.OpCodeArray] = {

IF opCodeArray = NIL THEN {

stream: STREAM ← NIL;

fileName: ROPE ← "OpCodes.txt";

opCodeArray ← NEW[ListerUtils.OpCodeArrayRep ← ALL[[NIL, 0, 0, 0]]];

stream ← FS.StreamOpen[fileName, $read

! FS.Error => IF error.group # bug THEN CONTINUE];

IF stream = NIL THEN {

fileName ← Rope.Concat[DefaultRemoteNames.Get[].current, "Lister>OpCodes.txt"];

stream ← FS.StreamOpen[fileName, $read

! FS.Error => IF error.group # bug THEN CONTINUE];

};

IF stream = NIL THEN {

fileName ← Rope.Concat[DefaultRemoteNames.Get[].previous, "Lister>OpCodes.txt"];

stream ← FS.StreamOpen[fileName, $read

! FS.Error => IF error.group # bug THEN CONTINUE];

};

Parse the opcodes file. Each entry has the form

name octal(decimal)push,pop,length,aligned;

where the octal number has no trailing 'B. There can be comments and blank lines in the file, and we allow multiple entries per line. Most, although not all, punctuation problems will cause ERROR OpCodeFormatError.

ENABLE IO.EndOfStream => EXIT;

index: [0..256) ← 0;

entry: ListerUtils.OpCodeEntry ← [NIL, 0, 0, 0];

[] ← IO.SkipWhitespace[stream, TRUE];

entry.name ← IO.GetTokenRope[stream].token;

WHILE IO.GetChar[stream] # '( DO ENDLOOP;

[] ← IO.SkipWhitespace[stream, TRUE];

index ← IO.GetInt[stream];

IF IO.GetChar[stream] # ') THEN ERROR OpCodeFormatError;

entry.push ← IO.GetInt[stream];

IF IO.GetChar[stream] # ', THEN ERROR OpCodeFormatError;

entry.pop ← IO.GetInt[stream];

IF IO.GetChar[stream] # ', THEN ERROR OpCodeFormatError;

entry.length ← IO.GetInt[stream];

WHILE IO.GetChar[stream] # '; DO ENDLOOP;

opCodeArray[index] ← entry;

ENDLOOP;

IO.Close[stream];

};

RETURN [opCodeArray];

};

Bcd acquisition procedures

ReadBcd: PUBLIC PROC

[fileName: ROPE] RETURNS [bcd: RefBCD] = {

Reads the given BCD. Allows FS.Error to fall through to the caller.

stream: STREAM = FS.StreamOpen[fileName];

bcd ← NEW[BCD];

[] ← IO.UnsafeGetBlock[

stream,

[base: LOOPHOLE[bcd], startIndex: 0, count: SIZE[BCD]*bytesPerWord]];

IO.Close[stream];

};

ReadMtr: PUBLIC PROC

[inStream: STREAM, bcd: RefBCD, mti: MTIndex]

RETURNS [mtr: RefMTRecord ← NIL] = TRUSTED {

Reads the given module record.

IF mti # MTNull THEN {

Get the module.

mtr ← NEW[MTRecord];

IO.SetIndex[inStream, (bcd.mtOffset+LOOPHOLE[mti, CARDINAL])*bytesPerWord];

[] ← IO.UnsafeGetBlock[

inStream,

[base: LOOPHOLE[mtr], startIndex: 0, count: SIZE[MTRecord]*bytesPerWord]];

};

ReadSgr: PUBLIC PROC

[inStream: STREAM, bcd: RefBCD, sgi: SGIndex]

RETURNS [sgr: RefSGRecord ← NIL] = TRUSTED {

Reads the given module record.

IF sgi # SGNull THEN {

Get the module.

sgr ← NEW[SGRecord];

IO.SetIndex[inStream, (bcd.sgOffset+LOOPHOLE[sgi, CARDINAL])*bytesPerWord];

[] ← IO.UnsafeGetBlock[

inStream,

[base: LOOPHOLE[sgr], startIndex: 0, count: SIZE[SGRecord]*bytesPerWord]];

};

WithSegment: PUBLIC PROC

[inStream: STREAM, bcd: RefBCD, sgi: SGIndex, inner: PROC [LONG POINTER]] = {

Reads the given segment, invoking the inner procedure with a pointer to it.

IF sgi # SGNull

THEN {

Get the segment record.

sgr: RefSGRecord = ReadSgr[inStream, bcd, sgi];

pages: CARDINAL = IF bcd.extended THEN sgr.pages+sgr.extraPages ELSE sgr.pages;

IF pages = 0 OR sgr.file # FTSelf

THEN inner[NIL]

ELSE TRUSTED {

interval: VM.Interval = VM.Allocate[count: pages];

ptr: LONG POINTER = VM.AddressForPageNumber[interval.page];

FS.Read[FS.OpenFileFromStream[inStream], sgr.base-1, interval.count, ptr];

VM.MakeReadOnly[interval]; -- don't want anyone messing with our tables

inner[ptr ! UNWIND => VM.Free[interval]];

VM.Free[interval];

};

}

ELSE

inner[NIL];

};

WithPages: PUBLIC PROC

[inStream: STREAM, bcd: RefBCD, start,pages: CARDINAL, inner: PROC [LONG POINTER]] = {

Reads the given segment, invoking the inner procedure with a pointer to it.

IF pages # 0

THEN TRUSTED {

Get the pages.

interval: VM.Interval = VM.Allocate[count: pages];

ptr: LONG POINTER = VM.AddressForPageNumber[interval.page];

FS.Read[FS.OpenFileFromStream[inStream], start, interval.count, ptr];

VM.MakeReadOnly[interval]; -- don't want anyone messing with our tables

inner[ptr ! UNWIND => VM.Free[interval]];

VM.Free[interval];

}

ELSE

inner[NIL];

};

Utility procedures

Some of these routines were cloned from various places to allow stream: STREAM and stb: SymbolTableBase as arguments, so we don't have to use global variables.

PrintSE: PUBLIC PROC

[sei: ISEIndex, nBlanks: CARDINAL, definitionsOnly: BOOL, stream: STREAM, stb: SymbolTableBase] = {

sep: LONG POINTER TO ISERecord = @stb.seb[sei];

typeSei: SEIndex;

Indent[stream, nBlanks];

PrintSei[sei, stream, stb];

IO.PutRope[stream, " ["];

PrintIndex[sei, stream];

IO.PutChar[stream, ']];

IF sep.public THEN IO.PutRope[stream, " [public]"];

IF sep.mark3 THEN {

val: CARDINAL = LOOPHOLE[sep.idValue];

idInfo: CARDINAL = LOOPHOLE[sep.idInfo];

IO.PutRope[stream, ", type = "];

IF sep.idType = typeTYPE

THEN {

typeSei ← sep.idInfo;

IO.PutRope[stream, "TYPE, equated to: "];

PrintType[typeSei, stream, stb];

IF stb.ctxb[sep.idCtx].level = lZ AND stb.TypeLink[sei] # SENull

THEN IO.PutF[stream, ", tag code: %g", [cardinal[val]]];

}

ELSE {

typeSei ← sep.idType;

PrintType[typeSei, stream, stb];

SELECT TRUE FROM

sep.constant => IO.PutRope[stream, " [const]"];

sep.immutable => IO.PutRope[stream, " [init only]"];

ENDCASE;

IF ~sep.mark4

THEN IO.PutF[stream, ", # refs: %g", [cardinal[idInfo]]]

ELSE

SELECT TRUE FROM

sep.constant =>

IF ~ sep.extended THEN {

IO.PutRope[stream, ", value: "];

SELECT stb.XferMode[typeSei] FROM

proc, program, signal, error =>

PrintBcdLink[LOOPHOLE[val], stream];

ENDCASE =>

IF val < 1000

THEN IO.Put [stream, [cardinal[val]]]

ELSE IO.PutF[stream, "%b", [cardinal[val]]];

};

(definitionsOnly AND stb.ctxb[sep.idCtx].level = lG) =>

IO.PutF[stream, ", index: %g", [cardinal[val]]];

ENDCASE => {

addr: BitAddress = LOOPHOLE[val];

IO.PutF[

stream, ", address: %g [%g:%g]",

[cardinal[addr.wd]], [cardinal[addr.bd]], [cardinal[idInfo]]];

IF sep.linkSpace THEN IO.PutChar[stream, '*];

};

PrintTypeInfo[typeSei, nBlanks+2, stream, stb];

IF sep.extended THEN PrintTree[stb.FindExtension[sei].tree, nBlanks+4, stream, stb];

};

PrintType: PUBLIC PROC [sei: SEIndex, stream: STREAM, stb: SymbolTableBase] = {

tSei: SEIndex;

IF sei = SENull

THEN IO.PutChar[stream, '?]

ELSE

WITH t: stb.seb[sei] SELECT FROM

cons =>

WITH t SELECT FROM

transfer => WriteModeName[mode, stream];

ENDCASE => WriteTypeName[t.typeTag, stream];

id =>

FOR tSei ← sei, stb.TypeLink[tSei] UNTIL tSei = SENull DO

WITH stb.seb[tSei] SELECT FROM

id => {

IF sei # tSei THEN IO.PutChar[stream, ' ];

PrintSei[LOOPHOLE[tSei, ISEIndex], stream, stb];

IF ~mark3 OR stb.ctxb[idCtx].level # lZ THEN EXIT;

};

ENDCASE;

ENDLOOP;

ENDCASE;

IO.PutRope[stream, " ["];

PrintIndex[sei, stream];

IO.PutChar[stream, ']];

};

PrintTypeInfo: PUBLIC PROC

[sei: SEIndex, nBlanks: CARDINAL, stream: STREAM, stb: SymbolTableBase] = {

IF sei # SENull THEN {

sp: LONG POINTER TO SERecord = @stb.seb[sei];

WITH s: sp SELECT FROM

cons => {

Indent[stream, nBlanks];

IO.PutChar[stream, '[];

PrintIndex[sei, stream];

IO.PutRope[stream, "] "];

WITH s SELECT FROM

transfer => WriteModeName[mode, stream];

ENDCASE => WriteTypeName[s.typeTag, stream];

WITH t: s SELECT FROM

basic => NULL;

enumerated => {

IF t.machineDep THEN IO.PutRope[stream, " (md)"]

ELSE IF t.unpainted THEN IO.PutRope[stream, " (~painted)"];

IO.PutRope[stream, ", value ctx: "];

PrintIndex[t.valueCtx, stream];

};

record => {

IF t.machineDep THEN IO.PutRope[stream, " (md)"];

IF t.monitored THEN IO.PutRope[stream, " (monitored)"];

IF t.hints.variant THEN IO.PutRope[stream, " (variant)"];

OutCtx[", field", t.fieldCtx, stream];

WITH stb.ctxb[t.fieldCtx] SELECT FROM

included => IF ~complete THEN IO.PutRope[stream, " [partial]"];

imported => IO.PutRope[stream, " [partial]"];

ENDCASE;

WITH t SELECT FROM

linked => {

IO.PutRope[stream, ", link: "];

PrintType[linkType, stream, stb]};

ENDCASE;

};

ref => {

SELECT TRUE FROM

t.counted => IO.PutRope[stream, " (counted)"];

t.var => IO.PutRope[stream, " (var)"];

ENDCASE;

IF t.ordered THEN IO.PutRope[stream, " (ordered)"];

IF t.basing THEN IO.PutRope[stream, " (base)"];

IO.PutRope[stream, ", to: "];

PrintType[t.refType, stream, stb];

IF t.readOnly THEN IO.PutRope[stream, " (readonly)"];

PrintTypeInfo[t.refType, nBlanks+2, stream, stb];

};

array => {

IF t.packed THEN IO.PutRope[stream, " (packed)"];

IO.PutRope[stream, ", index type: "];

PrintType[t.indexType, stream, stb];

IO.PutRope[stream, ", component type: "];

PrintType[t.componentType, stream, stb];

PrintTypeInfo[t.indexType, nBlanks+2, stream, stb];

PrintTypeInfo[t.componentType, nBlanks+2, stream, stb];

};

arraydesc => {

IO.PutRope[stream, ", described type: "];

PrintType[t.describedType, stream, stb];

IF t.readOnly THEN IO.PutRope[stream, " (readonly)"];

PrintTypeInfo[t.describedType, nBlanks+2, stream, stb];

};

transfer => {

IF t.safe THEN IO.PutRope[stream, " (safe)"];

OutArgType[", input", t.typeIn, stream, stb];

OutArgType[", output", t.typeOut, stream, stb];

};

definition => {

IO.PutRope[stream, ", ctx: "];

PrintIndex[t.defCtx, stream];

IO.PutF[stream, ", ngfi: %g", [cardinal[t.nGfi]]];

};

union => {

IF t.overlaid THEN IO.PutRope[stream, " (overlaid)"];

IF t.controlled THEN {

IO.PutRope[stream, ", tag: "];

PrintSei[t.tagSei, stream, stb]};

IO.PutRope[stream, ", tag type: "];

PrintType[stb.seb[t.tagSei].idType, stream, stb];

IO.PutRope[stream, ", case ctx: "];

PrintIndex[t.caseCtx, stream];

IF t.controlled THEN PrintSE[t.tagSei, nBlanks+2, FALSE, stream, stb];

};

sequence => {

IF t.packed THEN IO.PutRope[stream, " (packed)"];

IF t.controlled

THEN {

IO.PutRope[stream, ", tag: "];

PrintSei[t.tagSei, stream, stb]}

ELSE {

IO.PutRope[stream, ", index type: "];

PrintType[stb.seb[t.tagSei].idType, stream, stb]};

IO.PutRope[stream, ", component type: "];

PrintType[t.componentType, stream, stb];

IF t.controlled

THEN PrintSE[t.tagSei, nBlanks+2, FALSE, stream, stb]

ELSE PrintTypeInfo[stb.seb[t.tagSei].idType, nBlanks+2, stream, stb];

PrintTypeInfo[t.componentType, nBlanks+2, stream, stb];

};

relative => {

IO.PutRope[stream, ", base type: "];

PrintType[t.baseType, stream, stb];

IO.PutRope[stream, ", offset type: "];

PrintType[t.offsetType, stream, stb];

PrintTypeInfo[t.baseType, nBlanks+2, stream, stb];

PrintTypeInfo[t.offsetType, nBlanks+2, stream, stb];

};

opaque => {

IO.PutRope[stream, ", id: "];

PrintSei[t.id, stream, stb];

IF t.lengthKnown THEN

IO.PutF[stream, ", size: %g", [cardinal[t.length]]];

};

zone => {

IF t.counted THEN IO.PutRope[stream, " (counted)"];

IF t.mds THEN IO.PutRope[stream, " (mds)"];

};

subrange => {

IO.PutRope[stream, " of: "];

PrintType[t.rangeType, stream, stb];

IF t.filled THEN {

IO.PutF[stream, " origin: %g", [integer[t.origin]]];

IO.PutF[stream, ", range: %g", [cardinal[t.range]]]};

PrintTypeInfo[t.rangeType, nBlanks+2, stream, stb];

};

long, real => {

IO.PutRope[stream, " of: "];

PrintType[t.rangeType, stream, stb];

PrintTypeInfo[t.rangeType, nBlanks+2, stream, stb];

};

ENDCASE;

};

ENDCASE

};

PrintTree: PUBLIC PROC

[tree: Tree.Link, nBlanks: NAT, stream: STREAM, stb: SymbolTableBase] = {

PrintSubTree: PROC [tree: Tree.Link] = {

Indent[stream, nBlanks];

WITH s: tree SELECT FROM

hash =>

PrintName[s.index, stream, stb];

symbol => {

PrintSei[s.index, stream, stb];

IO.PutChar[stream, '[];

PrintIndex[s.index, stream];

IO.PutChar[stream, ']];

};

literal =>

PrintLiteral[s, stream, stb];

subtree => {

node: Tree.Index = s.index;

SELECT node FROM

Tree.NullIndex => IO.PutRope[stream, "<empty>"];

Tree.Index.LAST => IO.PutRope[stream, "<last>"];

ENDCASE => {

tp: LONG POINTER TO Tree.Node ← @stb.tb[node];

IO.PutRope[stream, NodeNameTable[tp.name]];

IO.PutChar[stream, '[];

PrintIndex[node, stream];

IO.PutRope[stream, "] "];

IF tp.info # 0 THEN {

IO.PutRope[stream, " info="];

PrintIndex[tp.info, stream];

};

IF tp.attr1 OR tp.attr2 OR tp.attr3 THEN {

IF tp.info = 0 THEN IO.PutChar[stream, ' ];

IO.PutChar[stream, '(];

IF tp.attr1 THEN IO.PutChar[stream, '1];

IF tp.attr2 THEN IO.PutChar[stream, '2];

IF tp.attr3 THEN IO.PutChar[stream, '3];

IO.PutChar[stream, ')];

};

nBlanks ← nBlanks + 2;

IF tp.name # thread

THEN {

EndIndex: Tree.Index = Tree.Index.LAST;

EndMark: Tree.Link = [subtree[index: EndIndex]];

n: NAT = tp.nSons;

IF tp.name = list AND n = 0

THEN

Very long lists have end markers, not explcit lengths.

FOR i: NAT IN [1..NAT.LAST] DO

son: Tree.Link = tp.son[i];

IF son = EndMark THEN EXIT;

PrintSubTree[tp.son[i]];

ENDLOOP

ELSE

For all other nodes, believe the given length.

FOR i: CARDINAL IN [1 .. n] DO

PrintSubTree[tp.son[i]];

ENDLOOP;

}

ELSE {

IO.PutRope[stream, " link="];

PrintTreeLink[tp.son[2], stream];

IO.PutRope[stream, " to "];

PrintTreeLink[tp.son[1], stream];

};

nBlanks ← nBlanks - 2};

};

ENDCASE => ERROR;

};

PrintSubTree[tree];

};

PrintLiteral: PUBLIC PROC [t: Tree.Link.literal, stream: STREAM, stb: SymbolTableBase] = {

WITH t.index SELECT FROM

string => {

msti: MSTIndex = MasterString[stb, sti];

s: LONG STRING = @stb.ltb[msti].string;

IO.PutChar[stream, '"];

FOR i: CARDINAL IN [0..s.length) DO IO.PutChar[stream, s[i]] ENDLOOP;

IO.PutChar[stream, '"];

IF sti # msti THEN IO.PutChar[stream, 'L]};

word => {

desc: Literals.LitDescriptor = DescriptorValue[stb, lti];

v: WORD;

IF desc.length # 1 THEN IO.PutChar[stream, '[];

FOR i: CARDINAL IN [0 .. desc.length) DO

IF (v ← stb.ltb[desc.offset][i]) < 1000

THEN IO.Put[stream, [cardinal[v]]]

ELSE IO.PutF[stream, "%b", [cardinal[v]]]; -- octal

IF i+1 # desc.length THEN IO.PutChar[stream, ',];

ENDLOOP;

IF desc.length # 1 THEN IO.PutChar[stream, ']]};

ENDCASE};

PrintBcdLink: PUBLIC PROC [link: BcdDefs.Link, stream: STREAM] = {

SELECT TRUE FROM

link.proc =>

IO.PutF[stream, "proc[%g,%g]", [cardinal[link.gfi]], [cardinal[link.ep]]];

link.type => {

IO.PutRope[stream, "type["]; PrintIndex[link.typeID, stream]};

ENDCASE =>

IO.PutF[stream, "var[%g,%g]", [cardinal[link.gfi]], [cardinal[link.var]]];

};

PrintTreeLink: PUBLIC PROC [link: Tree.Link, stream: STREAM] = {

WITH t: link SELECT FROM

subtree => PrintIndex[t.index, stream];

hash => {IO.PutRope[stream, "hash#"]; PrintIndex[t.index, stream]};

symbol => {IO.PutRope[stream, "symbol#"]; PrintIndex[t.index, stream]};

literal => {IO.PutRope[stream, "literal#"]; PrintIndex[t.index, stream]};

ENDCASE => ERROR;

};

PrintSei: PUBLIC PROC [sei: ISEIndex, stream: STREAM, stb: SymbolTableBase] = {

PrintName[stb.NameForSe[sei], stream, stb];

};

PrintName: PUBLIC PROC [name: Name, stream: STREAM, stb: SymbolTableBase] = {

IF name = nullName

THEN IO.PutRope[stream, "(anon)"]

ELSE {

ss: SubString = stb.SubStringForName[name];

FOR i: NAT IN [ss.offset..ss.offset+ss.length) DO

IO.PutChar[stream, ss.base[i]];

ENDLOOP;

};

WriteNodeName: PUBLIC PROC [n: NodeName, stream: STREAM] = {

IO.PutRope[stream, NodeNameTable[n]];

};

WriteTypeName: PUBLIC PROC [n: TypeClass, stream: STREAM] = {

IO.PutRope[stream, TypeNameTable[n]];

};

WriteModeName: PUBLIC PROC [n: TransferMode, stream: STREAM] = {

IO.PutRope[stream, ModeNameTable[n]];

};

OutCtx: PUBLIC PROC [message: Rope.ROPE, ctx: CTXIndex, stream: STREAM] = {

IO.PutRope[stream, message];

IO.PutRope[stream, " ctx: "];

IF ctx = CTXNull THEN IO.PutRope[stream, "NIL"] ELSE PrintIndex[ctx, stream];

};

OutArgType: PUBLIC PROC

[message: ROPE, sei: CSEIndex, stream: STREAM, stb: SymbolTableBase] = {

IF sei = SENull

THEN {IO.PutRope[stream, message]; IO.PutRope[stream, ": NIL"]}

ELSE

WITH t: stb.seb[sei] SELECT FROM

record => OutCtx[message, t.fieldCtx, stream];

any => {IO.PutRope[stream, message]; IO.PutRope[stream, ": ANY"]};

ENDCASE

};

PrintVersion: PUBLIC PROC

[stamp: VersionStamp, stream: STREAM, useTime: BOOL ← FALSE] = {

str: PACKED ARRAY [0..12) OF [0..16) = LOOPHOLE[stamp];

FOR i: NAT IN [0..12) DO

d: [0..16) = str[i];

IF d < 10

THEN IO.PutChar[stream, '0+d]

ELSE IO.PutChar[stream, 'a-10+d];

ENDLOOP;

IF useTime THEN {

IF stamp.net # 0 OR stamp.host # 0

THEN IO.PutF[stream, " (%g, %g, ", [cardinal[stamp.net]], [cardinal[stamp.host]]]

ELSE IO.PutRope[stream, " ("];

This next statement is separate to deal with potential errors in time conversion.

{ENABLE RuntimeError.UNCAUGHT => GO TO dreck;

IO.PutF[

stream, "%g)",

[time[BasicTime.FromNSTime[stamp.time]]]

];

EXITS

dreck => IO.PutRope[stream, "??)"];

};

PrintStringFromTable: PUBLIC PROC

[index: CARDINAL, stream: STREAM, stb: SymbolTableBase] = {

str: LONG STRING = stb.ssb;

len: CARDINAL = str[index]-0C;

FOR i: NAT IN [1..MIN[64, len]] DO

IO.PutChar[stream, str[i]];

ENDLOOP;

};

PrintString: PUBLIC PROC [str: LONG STRING, stream: STREAM] = {

IF str # NIL THEN

FOR i: NAT IN [0..str.length) DO

IO.PutChar[stream, str[i]];

ENDLOOP;

};

PrintSubString: PUBLIC PROC [ss: SubString, stream: STREAM] = {

FOR i: NAT IN [ss.offset..ss.offset+ss.length) DO

IO.PutChar[stream, ss.base[i]];

ENDLOOP;

};

PrintIndex: PUBLIC PROC [index: UNSPECIFIED, stream: STREAM] = {

IO.Put[stream, [integer[LOOPHOLE[index, CARDINAL]]]];

};

Indent: PUBLIC PROC [stream: STREAM, nBlanks: NAT] = {

IO.PutChar[stream, '\n];

THROUGH [0..nBlanks) DO IO.PutChar[stream, ' ]; ENDLOOP;

};

DescriptorValue: PUBLIC PROC

[stb: SymbolTableBase, lti: LTIndex] RETURNS [LitDescriptor] = {

WITH entry: stb.ltb[lti] SELECT FROM

short => {

deltaShort: CARDINAL = LOOPHOLE[@(NIL[POINTER TO LTRecord.short]).value];

RETURN [[offset: LOOPHOLE[lti + deltaShort], length: 1]];

};

long => {

deltaLong: CARDINAL = LOOPHOLE[@(NIL[POINTER TO LTRecord.long]).value];

RETURN [[offset: LOOPHOLE[lti + deltaLong], length: entry.length]];

};

ENDCASE => ERROR;

};

MasterString: PUBLIC PROC

[stb: SymbolTableBase, sti: STIndex] RETURNS [MSTIndex ← MSTNull] = {

WITH s: stb.ltb[sti] SELECT FROM

master => RETURN[LOOPHOLE[sti]];

copy => RETURN[s.link];

heap => RETURN[s.link];

ENDCASE;

};

ShortName: PUBLIC PROC [rope: ROPE] RETURNS [ROPE] = {

pos: INT ← Rope.Length[rope];

bang: INT ← pos;

WHILE pos > 0 DO

under: INT = pos - 1;

SELECT Rope.Fetch[rope, under] FROM

'! => bang ← under;

'>, '/, '<, '] => RETURN [Rope.Flatten[rope, pos, bang-pos]];

ENDCASE;

pos ← under;

ENDLOOP;

RETURN [rope];

};

T A B L E S

NodeNameArray: TYPE = ARRAY NodeName OF ROPE;

NodeNameTable: PUBLIC REF NodeNameArray =

NEW[NodeNameArray ←

["list", "item", "decl", "typedecl", "basicTC", "enumeratedTC", "recordTC", "monitoredTC", "variantTC", "refTC", "pointerTC", "listTC", "arrayTC", "arraydescTC", "sequenceTC", "procTC", "processTC", "portTC", "signalTC", "errorTC", "programTC", "anyTC", "definitionTC", "unionTC", "relativeTC", "subrangeTC", "longTC", "opaqueTC", "zoneTC", "linkTC", "varTC", "implicitTC", "frameTC", "discrimTC", "paintTC", "spareTC", "unit", "diritem", "module", "body", "inline", "lambda", "block", "assign", "extract", "if", "case", "casetest", "caseswitch", "bind", "do", "forseq", "upthru", "downthru", "return", "result", "goto", "exit", "loop", "free", "resume", "reject", "continue", "retry", "catchmark", "restart", "stop", "lock", "wait", "notify", "broadcast", "unlock", "null", "label", "open", "enable", "catch", "dst", "lste", "lstf", "syscall", "checked", "lst", "spareS3", "subst", "call", "portcall", "signal", "error", "syserror", "xerror", "start", "join", "apply", "callx", "portcallx", "signalx", "errorx", "syserrorx", "startx", "fork", "joinx", "index", "dindex", "seqindex", "reloc", "construct", "union", "rowcons", "sequence", "listcons", "substx", "ifx", "casex", "bindx", "assignx", "extractx", "or", "and", "relE", "relN", "relL", "relGE", "relG", "relLE", "in", "notin", "plus", "minus", "times", "div", "mod", "dot", "cdot", "dollar", "create", "not", "uminus", "addr", "uparrow", "min", "max", "lengthen", "abs", "all", "size", "first", "last", "pred", "succ", "arraydesc", "length", "base", "loophole", "nil", "new", "void", "clit", "llit", "cast", "check", "float", "pad", "chop", "safen", "syscallx", "narrow", "istype", "openx", "mwconst", "cons", "atom", "typecode", "stringinit", "textlit", "signalinit", "procinit", "intOO", "intOC", "intCO", "intCC", "thread", "none", "exlist", "initlist", "ditem", "shorten", "self", "gcrt", "proccheck", "ord", "val", "entry", "internal", "mergecons"]];

TypeNameArray: TYPE = ARRAY TypeClass OF ROPE;

TypeNameTable: REF TypeNameArray =

NEW[TypeNameArray ←

["mode", "basic", "enumerated", "record", "ref", "array", "arraydesc", "transfer", "definition", "union", "sequence", "relative", "subrange", "long", "real", "opaque", "zone", "any", "nil"]];

ModeNameArray: TYPE = ARRAY TransferMode OF ROPE;

ModeNameTable: PUBLIC REF ModeNameArray =

NEW[ModeNameArray ←

["proc", "port", "signal", "error", "process", "program", "none"]];

END.