ListerUtilsImpl.mesa
Russ Atkinson, October 24, 1983 1:32 pm
DIRECTORY
Basics USING [bytesPerWord],
BasicTime USING [FromNSTime],
BcdDefs USING
[BCD, FTIndex, FTSelf, Link, MTIndex, MTNull, MTRecord, SGIndex, SGNull, SGRecord, VersionStamp],
ConvertUnsafe USING [SubString],
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 [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, 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;
opCodeArray ← NEW[ListerUtils.OpCodeArrayRep ← ALL[[NIL, 0, 0, 0]]];
stream ← FS.StreamOpen["OpCodes.txt", $read
! FS.Error => IF error.group # bug THEN CONTINUE];
IF stream = NIL THEN
stream ← FS.StreamOpen["/indigo/cedar/lister/OpCodes.txt", $read
! FS.Error => IF error.group # bug THEN CONTINUE];
IF stream = NIL THEN
stream ← FS.StreamOpen["/indigo/precedar/lister/OpCodes.txt", $read
! FS.Error => IF error.group # bug THEN CONTINUE];
DO
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", [cardinal[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.