DIRECTORY
Basics: TYPE USING [bytesPerWord],
BasicTime: TYPE USING [FromNSTime],
BcdDefs: TYPE USING [BCD, FTIndex, FTSelf, Link, MTIndex, MTNull, MTRecord, SGIndex, SGNull, SGRecord, VersionStamp],
ConvertUnsafe: TYPE USING [SubString],
DefaultRemoteNames: TYPE USING [Get],
FS: TYPE USING [Error, OpenFileFromStream, Read, StreamOpen],
ListerUtils: TYPE USING [OpCodeArray, OpCodeArrayRep, OpCodeEntry],
Literals: TYPE USING [LitDescriptor, LTIndex, LTNull, LTRecord, MSTIndex, STIndex, STNull],
IO: TYPE USING [Close, EndOfStream, GetChar, GetInt, GetTokenRope, Put, PutChar, PutF, PutRope, SetIndex, SkipWhitespace, STREAM, UnsafeGetBlock],
Rope: TYPE USING [Concat, Fetch, Flatten, Length, ROPE],
RuntimeError: TYPE USING [UNCAUGHT],
SymbolPack: TYPE,
Symbols: TYPE 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: TYPE USING [Base],
Tree: TYPE USING [Index, Link, Node, NodeName, NullIndex],
VM: TYPE USING [AddressForPageNumber, Allocate, Free, Interval, MakeReadOnly];

ListerUtilsImpl: PROGRAM
IMPORTS BasicTime, DefaultRemoteNames, FS, IO, Rope, RuntimeError, SymbolPack, VM
EXPORTS ListerUtils = BEGIN


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;

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: fileName, accessOptions: $read, remoteCheck: FALSE
! FS.Error => IF error.group # bug THEN CONTINUE];
IF stream = NIL THEN {
fileName _ (DefaultRemoteNames.Get[].current).Concat["Compiler>OpCodes.txt"];
stream _ FS.StreamOpen[fileName: fileName, accessOptions: $read, remoteCheck: FALSE
! FS.Error => IF error.group # bug THEN CONTINUE];
};
IF stream # NIL THEN {
DO
ENABLE IO.EndOfStream => EXIT;
index: [0..256) _ 0;
entry: ListerUtils.OpCodeEntry _ [NIL, 0, 0, 0];
[] _ stream.SkipWhitespace[TRUE];
entry.name _ stream.GetTokenRope[].token;
WHILE stream.GetChar[] # '( DO ENDLOOP;
[] _ stream.SkipWhitespace[TRUE];
index _ stream.GetInt[];
IF stream.GetChar[] # ') THEN ERROR OpCodeFormatError;
entry.push _ stream.GetInt[];
IF stream.GetChar[] # ', THEN ERROR OpCodeFormatError;
entry.pop _ stream.GetInt[];
IF stream.GetChar[] # ', THEN ERROR OpCodeFormatError;
entry.length _ stream.GetInt[];
WHILE stream.GetChar[] # '; DO ENDLOOP;
opCodeArray[index] _ entry;
ENDLOOP;
stream.Close[]};
};
RETURN[opCodeArray]};


ReadBcd: PUBLIC PROC[fileName: ROPE] RETURNS[bcd: RefBCD] = {
stream: STREAM = FS.StreamOpen[fileName];
bcd _ NEW[BCD];
[] _ stream.UnsafeGetBlock[
[base: LOOPHOLE[bcd], startIndex: 0, count: BCD.SIZE*bytesPerWord]];
stream.Close[]};
ReadMtr: PUBLIC PROC[inStream: STREAM, bcd: RefBCD, mti: MTIndex] RETURNS[mtr: RefMTRecord _ NIL] = TRUSTED {
IF mti # MTNull THEN {
mtr _ NEW[MTRecord];
inStream.SetIndex[(bcd.mtOffset+LOOPHOLE[mti, CARDINAL])*bytesPerWord];
[] _ inStream.UnsafeGetBlock[
[base: LOOPHOLE[mtr], startIndex: 0, count: MTRecord.SIZE*bytesPerWord]];
};
};
ReadSgr: PUBLIC PROC[inStream: STREAM, bcd: RefBCD, sgi: SGIndex] RETURNS[sgr: RefSGRecord _ NIL] = TRUSTED {
IF sgi # SGNull THEN {
sgr _ NEW[SGRecord];
inStream.SetIndex[(bcd.sgOffset+LOOPHOLE[sgi, CARDINAL])*bytesPerWord];
[] _ inStream.UnsafeGetBlock[
[base: LOOPHOLE[sgr], startIndex: 0, count: SGRecord.SIZE*bytesPerWord]];
};
};
WithSegment: PUBLIC PROC[inStream: STREAM, bcd: RefBCD, sgi: SGIndex, inner: PROC[LONG POINTER]] = {
IF sgi # SGNull THEN {
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.OpenFileFromStream[inStream]).Read[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]] = {
IF pages # 0 THEN TRUSTED {
interval: VM.Interval = VM.Allocate[count: pages];
ptr: LONG POINTER = VM.AddressForPageNumber[interval.page];
(FS.OpenFileFromStream[inStream]).Read[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]};

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];
stream.PutRope[" ["];
PrintIndex[sei, stream];
stream.PutChar[']];
IF sep.public THEN stream.PutRope[" [public]"];
IF sep.mark3 THEN {
val: CARDINAL = LOOPHOLE[sep.idValue];
idInfo: CARDINAL = LOOPHOLE[sep.idInfo];
stream.PutRope[", type = "];
IF sep.idType = typeTYPE THEN {
typeSei _ sep.idInfo;
stream.PutRope["TYPE, equated to: "];
PrintType[typeSei, stream, stb];
IF stb.ctxb[sep.idCtx].level = lZ AND stb.TypeLink[sei] # SENull THEN
stream.PutF[", tag code: %g", [cardinal[val]]];
}
ELSE {
typeSei _ sep.idType;
PrintType[typeSei, stream, stb];
SELECT TRUE FROM
sep.constant => stream.PutRope[" [const]"];
sep.immutable => stream.PutRope[" [init only]"];
ENDCASE;
IF ~sep.mark4 THEN stream.PutF[", # refs: %g", [cardinal[idInfo]]]
ELSE
SELECT TRUE FROM
sep.constant =>
IF ~ sep.extended THEN {
stream.PutRope[", value: "];
SELECT stb.XferMode[typeSei] FROM
proc, program, signal, error =>
PrintBcdLink[LOOPHOLE[val], stream];
ENDCASE =>
IF val < 1000 THEN stream.Put[[cardinal[val]]]
ELSE stream.PutF["%b", [cardinal[val]]];
};
(definitionsOnly AND stb.ctxb[sep.idCtx].level = lG) =>
stream.PutF[", index: %g", [cardinal[val]]];
ENDCASE => {
addr: BitAddress = LOOPHOLE[val];
stream.PutF[
", address: %g [%g:%g]",
[cardinal[addr.wd]], [cardinal[addr.bd]], [cardinal[idInfo]]];
IF sep.linkSpace THEN stream.PutChar['*]};
};
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 stream.PutChar['?]
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 stream.PutChar[' ];
PrintSei[LOOPHOLE[tSei, ISEIndex], stream, stb];
IF ~mark3 OR stb.ctxb[idCtx].level # lZ THEN EXIT};
ENDCASE;
ENDLOOP;
ENDCASE;
stream.PutRope[" ["];
PrintIndex[sei, stream];
stream.PutChar[']]};

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];
stream.PutChar['[];
PrintIndex[sei, stream];
stream.PutRope["] "];
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 stream.PutRope[" (md)"]
ELSE IF t.unpainted THEN stream.PutRope[" (~painted)"];
stream.PutRope[", value ctx: "];
PrintIndex[t.valueCtx, stream]};
record => {
IF t.machineDep THEN stream.PutRope[" (md)"];
IF t.monitored THEN stream.PutRope[" (monitored)"];
IF t.hints.variant THEN stream.PutRope[" (variant)"];
OutCtx[", field", t.fieldCtx, stream];
WITH stb.ctxb[t.fieldCtx] SELECT FROM
included => IF ~complete THEN stream.PutRope[" [partial]"];
imported => stream.PutRope[" [partial]"];
ENDCASE;
WITH t SELECT FROM
linked => {
stream.PutRope[", link: "];  PrintType[linkType, stream, stb]};
ENDCASE;
};
ref => {
SELECT TRUE FROM
t.counted => stream.PutRope[" (counted)"];
t.var => stream.PutRope[" (var)"];
ENDCASE;
IF t.ordered THEN stream.PutRope[" (ordered)"];
IF t.basing THEN stream.PutRope[" (base)"];
stream.PutRope[", to: "];
PrintType[t.refType, stream, stb];
IF t.readOnly THEN stream.PutRope[" (readonly)"];
PrintTypeInfo[t.refType, nBlanks+2, stream, stb]};
array => {
IF t.packed THEN stream.PutRope[" (packed)"];
stream.PutRope[", index type: "];
PrintType[t.indexType, stream, stb];
stream.PutRope[", component type: "];
PrintType[t.componentType, stream, stb];
PrintTypeInfo[t.indexType, nBlanks+2, stream, stb];
PrintTypeInfo[t.componentType, nBlanks+2, stream, stb]};
arraydesc => {
stream.PutRope[", described type: "];
PrintType[t.describedType, stream, stb];
IF t.readOnly THEN stream.PutRope[" (readonly)"];
PrintTypeInfo[t.describedType, nBlanks+2, stream, stb]};
transfer => {
IF t.safe THEN stream.PutRope[" (safe)"];
OutArgType[", input", t.typeIn, stream, stb];
OutArgType[", output", t.typeOut, stream, stb]};
definition => {
stream.PutRope[", ctx: "];
PrintIndex[t.defCtx, stream];
stream.PutF[", ngfi: %g", [cardinal[t.nGfi]]]};
union => {
IF t.overlaid THEN stream.PutRope[" (overlaid)"];
IF t.controlled THEN {
stream.PutRope[", tag: "];
PrintSei[t.tagSei, stream, stb]};
stream.PutRope[", tag type: "];
PrintType[stb.seb[t.tagSei].idType, stream, stb];
stream.PutRope[", case ctx: "];
PrintIndex[t.caseCtx, stream];
IF t.controlled THEN PrintSE[t.tagSei, nBlanks+2, FALSE, stream, stb]};
sequence => {
IF t.packed THEN stream.PutRope[" (packed)"];
IF t.controlled THEN {
stream.PutRope[", tag: "];
PrintSei[t.tagSei, stream, stb]}
ELSE {
stream.PutRope[", index type: "];
PrintType[stb.seb[t.tagSei].idType, stream, stb]};
stream.PutRope[", 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 => {
stream.PutRope[", base type: "];
PrintType[t.baseType, stream, stb];
stream.PutRope[", offset type: "];
PrintType[t.offsetType, stream, stb];
PrintTypeInfo[t.baseType, nBlanks+2, stream, stb];
PrintTypeInfo[t.offsetType, nBlanks+2, stream, stb]};
opaque => {
stream.PutRope[", id: "];
PrintSei[t.id, stream, stb];
IF t.lengthKnown THEN stream.PutF[", size: %g", [cardinal[t.length]]]};
zone => {
IF t.counted THEN stream.PutRope[" (counted)"];
IF t.mds THEN stream.PutRope[" (mds)"]};
subrange => {
stream.PutRope[" of: "];
PrintType[t.rangeType, stream, stb];
IF t.filled THEN {
stream.PutF[" origin: %g", [integer[t.origin]]];
stream.PutF[", range: %g", [cardinal[t.range]]]};
PrintTypeInfo[t.rangeType, nBlanks+2, stream, stb]};
long, real => {
stream.PutRope[" 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];
stream.PutChar['[];
PrintIndex[s.index, stream];
stream.PutChar[']]};
literal =>
PrintLiteral[s, stream, stb];
subtree => {
node: Tree.Index = s.index;
SELECT node FROM
Tree.NullIndex => stream.PutRope["<empty>"];
Tree.Index.LAST => stream.PutRope["<last>"];
ENDCASE => {
tp: LONG POINTER TO Tree.Node _ @stb.tb[node];
stream.PutRope[NodeNameTable[tp.name]];
stream.PutChar['[];
PrintIndex[node, stream];
stream.PutRope["] "];
IF tp.info # 0 THEN {
stream.PutRope["  info="];
PrintIndex[tp.info, stream]};
IF tp.attr1 OR tp.attr2 OR tp.attr3 THEN {
IF tp.info = 0 THEN stream.PutChar[' ];
stream.PutChar['(];
IF tp.attr1 THEN stream.PutChar['1];
IF tp.attr2 THEN stream.PutChar['2];
IF tp.attr3 THEN stream.PutChar['3];
stream.PutChar[')]};
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
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 i: CARDINAL IN [1 .. n] DO
PrintSubTree[tp.son[i]];
ENDLOOP;
}
ELSE {
stream.PutRope[" link="];
PrintTreeLink[tp.son[2], stream];
stream.PutRope[" 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;
stream.PutChar['"];
FOR i: CARDINAL IN [0..s.length) DO stream.PutChar[s[i]] ENDLOOP;
stream.PutChar['"];
IF sti # msti THEN stream.PutChar['L]};
word => {
desc: Literals.LitDescriptor = DescriptorValue[stb, lti];
v: WORD;
IF desc.length # 1 THEN stream.PutChar['[];
FOR i: CARDINAL IN [0 .. desc.length) DO
IF (v _ stb.ltb[desc.offset][i]) < 1000 THEN stream.Put[[cardinal[v]]]
ELSE stream.PutF["%b", [cardinal[v]]]; -- octal
IF i+1 # desc.length THEN stream.PutChar[',];
ENDLOOP;
IF desc.length # 1 THEN stream.PutChar[']]};
ENDCASE;
};

PrintBcdLink: PUBLIC PROC[link: BcdDefs.Link, stream: STREAM] = {
SELECT TRUE FROM
link.proc =>
stream.PutF["proc[%g,%g]", [cardinal[link.gfi]], [cardinal[link.ep]]];
link.type => {
stream.PutRope["type["]; PrintIndex[link.typeID, stream]};
ENDCASE =>
stream.PutF["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 => {stream.PutRope["hash#"]; PrintIndex[t.index, stream]};
symbol => {stream.PutRope["symbol#"]; PrintIndex[t.index, stream]};
literal => {stream.PutRope["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 stream.PutRope["(anon)"]
ELSE {
ss: SubString = stb.SubStringForName[name];
FOR i: NAT IN [ss.offset..ss.offset+ss.length) DO
stream.PutChar[ss.base[i]];
ENDLOOP;
};
};

WriteNodeName: PUBLIC PROC[n: NodeName, stream: STREAM] = {
stream.PutRope[NodeNameTable[n]]};

WriteTypeName: PUBLIC PROC[n: TypeClass, stream: STREAM] = {
stream.PutRope[TypeNameTable[n]]};

WriteModeName: PUBLIC PROC[n: TransferMode, stream: STREAM] = {
stream.PutRope[ModeNameTable[n]]};

OutCtx: PUBLIC PROC[message: Rope.ROPE, ctx: CTXIndex, stream: STREAM] = {
stream.PutRope[message];
stream.PutRope[" ctx: "];
IF ctx = CTXNull THEN stream.PutRope["NIL"] ELSE PrintIndex[ctx, stream]};

OutArgType: PUBLIC PROC[message: ROPE, sei: CSEIndex, stream: STREAM, stb: SymbolTableBase] = {
IF sei = SENull THEN {stream.PutRope[message]; stream.PutRope[": NIL"]}
ELSE
WITH t~~stb.seb[sei] SELECT FROM
record => OutCtx[message, t.fieldCtx, stream];
any => {stream.PutRope[message]; stream.PutRope[": 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 stream.PutChar['0+d] ELSE stream.PutChar['a-10+d];
ENDLOOP;
IF useTime THEN {
IF stamp.net # 0 OR stamp.host # 0 THEN
stream.PutF[" (%g, %g, ", [cardinal[stamp.net]], [cardinal[stamp.host]]]
ELSE stream.PutRope[" ("];
{ENABLE RuntimeError.UNCAUGHT => GO TO dreck;
stream.PutF["%g)", [time[BasicTime.FromNSTime[stamp.time]]]];
EXITS
dreck => stream.PutRope["??)"];
};
};
};

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
stream.PutChar[str[i]];
ENDLOOP;
};

PrintString: PUBLIC PROC[str: LONG STRING, stream: STREAM] = {
IF str # NIL THEN 
FOR i: NAT IN [0..str.length) DO
stream.PutChar[str[i]];
ENDLOOP;
};

PrintSubString: PUBLIC PROC[ss: SubString, stream: STREAM] = {
FOR i: NAT IN [ss.offset..ss.offset+ss.length) DO stream.PutChar[ss.base[i]] ENDLOOP};

PrintIndex: PUBLIC PROC[index: UNSPECIFIED, stream: STREAM] = {
stream.Put[[integer[LOOPHOLE[index, CARDINAL]]]]};

Indent: PUBLIC PROC[stream: STREAM, nBlanks: NAT] = {
stream.PutChar['\n];
THROUGH [0..nBlanks) DO stream.PutChar[' ]; 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[];
bang: INT _ pos;
WHILE pos > 0 DO
under: INT = pos - 1;
SELECT rope.Fetch[under] FROM
'! => bang _ under;
'>, '/, '<, '] => RETURN[rope.Flatten[pos, bang-pos]]; 
ENDCASE;
pos _ under;
ENDLOOP;
RETURN[rope]};


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.

NListerUtilsImpl.mesa
Copyright c 1984, 1985 by Xerox Corporation.  All rights reserved.
Russ Atkinson (RRA) August 20, 1985 6:05:11 pm PDT
Sweet October 8, 1985 9:38:39 am PDT
Satterthwaite March 11, 1986 8:56:47 am PST
T Y P E S  &  C O N S T A N T S
OpCode types & procedures

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.
Bcd acquisition procedures
Reads the given BCD.  Allows FS.Error to fall through to the caller.

Reads the given module record.
Get the module.

Reads the given module record.
Get the module.

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

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

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.
Very long lists have end markers, not explcit lengths.
For all other nodes, believe the given length.
This next statement is separate to deal with potential errors in time conversion.
T A B L E S
�Ê[˜
codeš
œ™Kšœ
Ïm
œ7™BK™2K™$K™+—K˜š
Ïk	˜	Kšœžœ
žœ˜"Kšœžœ
žœ˜#Kšœ	žœ
žœžœ]˜uKšœžœ
žœ
˜&Kšœžœ
žœ˜%Kšžœžœ
žœ/˜=Kšœ
žœ
žœ,˜CKšœ
žœ
žœG˜[Kšžœžœ
žœlžœ˜’
Kšœžœ
žœ"žœ˜8Kšœžœ
žœžœ˜$Kšœžœ
˜Kšœ	žœ
žœØ
˜ë
Kšœ
žœ
žœ˜Kšœžœ
žœ*˜:Kšžœžœ
žœ@˜N—K˜šœž˜Kšžœ žœžœ"ž˜QKšžœž˜—K˜š
œ™K˜Kšžœžœžœ
˜Kšœžœ˜&Kšœ	žœ˜ Kšœ
žœ˜$Kšœžœ˜(šœ
žœ˜"Kš
œ&˜&—šœžœ˜*Kš
œ˜Kš
œ˜Kš
œ˜—šœ
žœ˜"Kš
œ$˜$—Kšœžœ˜$šœ	žœ˜ Kš
œ!˜!—šœ
žœ˜"Kš
œ$˜$—Kšœžœ˜šœ	žœ˜!Kš
œ"˜"—Kšœ
žœ˜#Kšœžœ˜-Kšœ	žœ˜ šœ
žœ˜#Kšœžœ	˜%—šœ	žœ˜ Kš
œ!˜!—Kšœ
žœ˜"šœžœ˜Kš
œ"˜"—Kšœ
žœ˜Kšœžœžœ
žœ
˜Kšœ
žœžœ
˜!Kšœ
žœžœ
˜!Kš
œ#˜#Kšžœžœžœ
˜šœ	žœ˜ Kš
œ!˜!—Kšœ
žœ˜"šœ	žœ˜ Kš
œ!˜!—Kšœ
žœ˜"šœ	žœ˜!Kš
œ"˜"—Kšžœžœžœ
žœ
˜Kšœžœ˜*Kšœžœ˜)Kšœžœ˜*Kšœžœ˜$Kšœžœ˜*K˜—š
œ™K™Kšœ'žœ
˜+Kšœžœžœ
˜ K˜šÏnœžœ
žœ
žœ˜@šžœžœ
žœ˜Kšœžœžœ
˜Kšœ
žœ˜Kšœžœžœžœ
˜Dšœ	žœCž˜SKš	œžœ
žœžœ
žœ˜2—šžœ
žœ
žœ˜Kš
œM˜Mšœ	žœCž˜SKš	œžœ
žœžœ
žœ˜2—K˜—šžœ
žœ
žœ˜š
œ0™0Kšœ
Ïb
œ 
œ 
œ 
œ 
œ 
™+—Kš
ϯ
™Ø
š
ž˜Kšžœ
žœžœ
˜K˜Kšœ"žœ˜0Kšœžœ˜!Kš
œ)˜)Kšžœžœ
žœ
˜'Kšœžœ˜!Kš
œ˜Kšžœžœ
žœ˜6Kš
œ˜Kšžœžœ
žœ˜6Kš
œ˜Kšžœžœ
žœ˜6Kš
œ˜Kšžœžœ
žœ
˜'Kš
œ˜Kšžœ
˜—Kš
œ˜—Kš
œ˜—Kšžœ˜—K˜—š
œ™K˜š
Ÿœžœ
žœžœžœ˜=Kš
œD™DKšœžœžœ˜)Kšœžœ
žœ˜š
œ˜Kšœžœžœ
žœ˜D—Kš
œ˜K™—šŸœžœ
žœžœžœžœžœ˜mKš
œ™šžœžœ˜Kš
œ™Kšœžœ˜Kšœ žœžœ˜Gš
œ˜Kšœžœ&žœ˜I—K˜—Kš
œ˜K™—šŸœžœ
žœžœžœžœžœ˜mKš
œ™šžœžœ˜Kš
œ™Kšœžœ˜Kšœ žœžœ˜Gš
œ˜Kšœžœ&žœ˜I—K˜—Kš
œ˜K™—šŸœžœ
žœžœ$žœ
žœ
žœ˜dKš
œK™Kšžœžœ˜Kš
œ™Kš
œ/˜/Kš	œžœžœžœžœ˜OKšžœžœžœžœ
˜1šžœ
žœ˜Kšœ
žœžœ˜2Kšœžœ
žœžœ%˜;Kšœ
žœE˜HKšžœÏc,˜HKšœžœžœ˜)Kšžœ˜—K˜
—Kšžœžœ˜K™—šŸ	œžœ
žœžœžœ	žœ
žœ
žœ˜kKš
œK™Kšžœžœ
žœ˜Kš
œ™Kšœ
žœžœ˜2Kšœžœ
žœžœ%˜;Kšœ
žœ@˜CKšžœ¡,˜HKšœžœžœ˜)Kšžœ˜—Kšžœžœ˜K™——š
œ™K™KšœHžœQ™Ÿ
K˜šŸœžœ
žœžœžœ
žœ˜wKšœžœ
žœ
žœ˜/K˜K˜K˜Kš
œ˜Kš
œ˜Kš
œ˜Kšžœžœ˜/šžœžœ˜Kšœžœžœ˜&Kšœžœžœ
˜(Kš
œ˜šžœžœ˜K˜Kš
œ%˜%K˜ šžœ žœž˜EKš
œ/˜/—Kš
œ
˜
—šžœ˜K˜K˜ šžœ
žœ
ž˜Kš
œ+˜+Kš
œ0˜0Kšžœ
˜—Kšžœžœ0˜Bš
ž˜šžœ
žœ
ž˜˜šžœžœ˜Kš
œ˜šžœž˜!š
œ˜Kšœ
žœ˜$—šžœ˜
Kšžœžœ˜.Kšžœ$˜(——Kš
œ˜——šœžœ#˜7Kš
œ,˜,—šžœ˜Kšœžœ˜!š
œ˜Kš
œ˜Kš
œ>˜>—Kšžœžœ˜*———Kš
œ˜—Kš
œ/˜/KšžœžœA˜U—Kš
œ˜K˜—šŸ	œžœ
žœžœ˜NK˜Kšžœžœ˜'š
ž˜šžœžœ
ž˜ ˜šžœžœ
ž˜K˜(Kšžœ%˜,——˜šžœ žœž˜9šžœžœ
ž˜˜Kšžœžœ˜&Kšœ	žœ˜0Kšžœžœžœ
žœ˜3—Kšžœ
˜—Kšžœ
˜——Kšžœ
˜——Kš
œ˜Kš
œ˜Kš
œ˜K˜—š
Ÿ
œžœ
žœžœ
žœ˜ešžœžœ˜Kšœžœ
žœ
žœ˜-šžœžœ
ž˜˜	K˜Kš
œ˜Kš
œ˜Kš
œ˜šžœžœ
ž˜Kš
œ(˜(Kšžœ%˜,—šžœžœ
ž˜Kšœ	žœ
˜˜Kšžœžœ˜,Kšžœ
žœ
žœ˜7Kš
œ ˜ Kš
œ ˜ —˜Kšžœžœ˜-Kšžœ
žœ ˜3Kšžœžœ˜5K˜&šžœžœ
ž˜%Kšœžœžœ˜;Kš
œ)˜)Kšžœ
˜—šžœžœ
ž˜š
œ˜Kš
œ?˜?—Kšžœ
˜—Kš
œ˜—˜šžœ
žœ
ž˜Kš
œ*˜*Kš
œ"˜"Kšžœ
˜—Kšžœžœ˜/Kšžœ
žœ˜+Kš
œ˜Kš
œ"˜"Kšžœžœ˜1Kš
œ2˜2—˜
Kšžœ
žœ˜-Kš
œ!˜!Kš
œ$˜$Kš
œ%˜%Kš
œ(˜(Kš
œ3˜3Kš
œ8˜8—˜Kš
œ%˜%Kš
œ(˜(Kšžœžœ˜1Kš
œ8˜8—˜
Kšžœžœ˜)Kš
œ-˜-Kš
œ0˜0—˜Kš
œ˜Kš
œ˜Kš
œ/˜/—˜
Kšžœžœ˜1šžœžœ˜Kš
œ˜Kš
œ!˜!—Kš
œ˜Kš
œ1˜1Kš
œ˜Kš
œ˜Kšžœžœžœ˜G—˜
Kšžœ
žœ˜-šžœžœ˜Kš
œ˜Kš
œ ˜ —šžœ˜Kš
œ!˜!Kš
œ2˜2—Kš
œ%˜%Kš
œ(˜(Kšžœžœžœ˜EKšžœA˜EKš
œ8˜8—˜
Kš
œ ˜ Kš
œ#˜#Kš
œ"˜"Kš
œ%˜%Kš
œ2˜2Kš
œ5˜5—˜Kš
œ˜Kš
œ˜Kšžœžœ2˜G—˜	Kšžœžœ˜/Kšžœžœ˜(—˜
Kš
œ˜Kš
œ$˜$šžœ
žœ˜Kš
œ0˜0Kš
œ1˜1—Kš
œ4˜4—˜Kš
œ˜Kš
œ$˜$Kš
œ4˜4—Kšžœ
˜—Kš
œ˜—Kš
ž˜—Kš
œ˜—K˜K˜—š
Ÿ	œžœ
žœžœ
žœ˜_šŸœžœ˜'Kš
œ˜šžœ	žœ
ž˜š
œ˜Kš
œ ˜ —˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜—˜
Kš
œ˜—˜K˜šžœž˜Kš
œ,˜,Kšœžœ˜,šžœ˜Kšœžœ
žœ
žœ˜.Kš
œ'˜'Kš
œ˜Kš
œ˜Kš
œ˜šžœ
žœ˜Kš
œ˜Kš
œ˜—šžœ
žœ
žœ
žœ˜*Kšžœ
žœ˜'Kš
œ˜Kšžœ
žœ˜$Kšžœ
žœ˜$Kšžœ
žœ˜$Kš
œ˜—K˜šžœžœ˜Kšœ"žœ
˜'Kš
œ0˜0Kšœžœ˜šžœžœž˜ Kš
œ6™6šžœžœ
žœžœ
žœž˜Kš
œ˜Kšžœžœ
žœ
˜Kš
œ˜Kš
ž˜——š
ž˜Kš
œ.™.šžœžœ
žœ
ž˜Kš
œ˜Kšžœ
˜——K˜
—šžœ˜Kš
œ˜Kš
œ!˜!Kš
œ˜Kš
œ"˜"—K˜——K˜—Kšžœžœ
˜—K˜—Kš
œ˜K˜—šŸœžœ
žœžœ˜Yšžœ	žœ
ž˜˜Kš
œ(˜(Kšœžœ
žœ˜'Kš
œ˜Kš
žœžœ
žœžœžœ
˜AKš
œ˜Kšžœžœ˜'—˜	K˜9Kšœžœ
˜Kšžœžœ˜+šžœžœ
žœž˜(Kšžœ&žœ˜FKšžœ
žœ¡˜/Kšžœžœ˜-Kšžœ
˜—Kšžœžœ˜,—Kšžœ
˜—š
œ˜K˜——šŸœžœ
žœžœ˜Ašžœ
žœ
ž˜š
œ˜Kš
œF˜F—š
œ˜Kš
œ:˜:—šžœ˜
Kš
œF˜F——K˜K˜—šŸ
œžœ
žœžœ˜?šžœ	žœ
ž˜Kš
œ'˜'Kš
œ?˜?Kš
œC˜CKš
œE˜EKšžœžœ
˜—K˜K˜—šŸœžœ
žœžœ˜NKš
œ,˜,K˜—šŸ	œžœ
žœžœ˜LKšžœžœ˜0šžœ˜Kš
œ+˜+šžœžœ
žœ"ž˜1Kš
œ˜Kšžœ
˜—Kš
œ˜—K˜K˜—šŸ
œžœ
žœžœ˜;Kš
œ"˜"K˜—šŸ
œžœ
žœžœ˜<Kš
œ"˜"K˜—šŸ
œžœ
žœžœ˜?Kš
œ"˜"K˜—š
Ÿœžœ
žœžœžœ˜JKš
œ˜Kš
œ˜Kšžœžœžœ˜JK˜—š
Ÿ
œžœ
žœ
žœžœ˜_Kšžœžœ3˜Gš
ž˜šžœžœ
ž˜ K˜.Kš
œ:˜:Kš
ž˜——š
œ˜K˜——šŸœžœ
žœžœžœžœ˜YKš	œžœ
žœ	žœžœ˜7šžœžœ
žœ	ž˜Kš
œ˜Kšžœžœžœ˜AKšžœ
˜—šžœ	žœ˜šžœžœž˜'Kš
œH˜H—Kšžœ˜Kš
œQ™Qš	œ
žœžœžœ
žœ˜-Kš
œ=˜=š
ž˜Kš
œ˜—K˜—K˜—K˜K˜—š
Ÿœžœ
žœžœ
žœ˜\Kšœžœ
žœ˜Kšœžœ˜š	žœžœ
žœžœž˜"Kš
œ˜Kšžœ
˜—K˜K˜—šŸœžœ
žœžœ
žœ
žœ˜>šžœžœ
žœ
˜šžœžœ
žœž˜ Kš
œ˜Kšžœ
˜——K˜K˜—šŸœžœ
žœžœ˜>Kš
žœžœ
žœ"žœžœ˜VK˜—š
Ÿ
œžœ
žœžœ
žœ˜?Kšœžœžœ˜2K˜—š
Ÿœžœ
žœ	žœžœ˜5Kš
œ˜Kšžœžœžœ˜5K˜—šŸœžœ
žœ%žœ˜[šžœžœ
ž˜$š
œ
˜
Kšœžœžœžœ
žœ
žœ˜IKšžœ
žœ!˜9—š
œ	˜	Kšœžœžœžœ
žœ
žœ˜GKšžœ
žœ+˜C—Kšžœžœ
˜—š
œ˜K˜——šŸœžœ
žœ%žœ˜]šžœžœ
ž˜ Kšœ
žœ
žœ˜ Kšœžœ	˜Kšœžœ	˜Kšžœ
˜—K˜K˜—šŸ	œžœ
žœžœžœ
žœ˜4Kšœžœ˜Kšœžœ˜šžœ	ž˜Kšœžœ˜šžœž˜Kš
œ˜Kšœžœ˜7Kšžœ
˜—K˜Kšžœ
˜—Kšžœ˜K˜——š
œ™K˜Kš	œžœžœ
žœ
žœ
˜-Kšœžœ
žœžœŒ˜¹Kš	œžœžœžœ
žœ
˜.KšœžœžœÒ
˜ø
Kš	œžœžœžœ
žœ
˜1šœžœ
žœžœU˜‚
K˜——Kšžœ
˜K˜—…—U\t