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


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


ReadBcd: PUBLIC PROC
[fileName: ROPE] RETURNS [bcd: RefBCD] = {
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 {
IF mti # MTNull THEN {
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 {
IF sgi # SGNull THEN {
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]] = {
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.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]] = {
IF pages # 0
THEN TRUSTED {
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];
};

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
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 {
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, " ("];
{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];
};


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.

xListerUtilsImpl.mesa
Russ Atkinson, October 24, 1983 1:32 pm
T Y P E S  &  C O N S T A N T S
OpCode types & procedures

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
�ʘš
œ™Jš
œ'™'—J˜š
Ïk	˜	Jšœ�œ˜Jšœ
�œ˜šœ�˜
Jšœ
�œ]˜a—Jšœ�œ
˜ Jš�œ
�œ/˜7Jšœ�œ,˜=Jšœ	�œG˜Uš�œ
�˜Jšœk�œ˜ƒ
—Jšœ�œ�œ˜*Jšœ
�œ�œ˜Jš
œ˜šœ�˜
Jš
œ×
˜×
—Jšœ�œ˜Jšœ�œ*˜4Jš�œ
�œ@˜H—J˜šœ�˜Jš�œ�œ�œ"�˜=Jš�œ˜Jšœ�˜—J˜š
œ™J˜Jš�œ�œ�œ
˜Jšœ�œ˜&Jšœ	�œ˜ Jšœ
�œ˜$Jšœ�œ˜(šœ
�œ˜"Jš
œ&˜&—šœ�œ˜*Jš
œ˜Jš
œ˜Jš
œ˜—šœ
�œ˜"Jš
œ$˜$—Jšœ�œ˜$šœ	�œ˜ Jš
œ!˜!—šœ
�œ˜"Jš
œ$˜$—Jšœ�œ˜šœ	�œ˜!Jš
œ"˜"—Jšœ
�œ˜#Jšœ�œ˜-Jšœ	�œ˜ šœ
�œ˜#Jšœ�œ	˜%—šœ	�œ˜ Jš
œ!˜!—Jšœ
�œ˜"šœ�œ˜Jš
œ"˜"—Jšœ
�œ˜Jšœ�œ�œ
�œ
˜Jšœ
�œ�œ
˜!Jšœ
�œ�œ
˜!Jš
œ#˜#Jš�œ�œ�œ
˜šœ	�œ˜ Jš
œ!˜!—Jšœ
�œ˜"šœ	�œ˜ Jš
œ!˜!—Jšœ
�œ˜"šœ	�œ˜!Jš
œ"˜"—Jš�œ�œ�œ
�œ
˜Jšœ�œ˜*Jšœ�œ˜)Jšœ�œ˜*Jšœ�œ˜$Jšœ�œ˜*J˜—š
œ™J™Jšœ'�œ
˜+Jšœ�œ�œ
˜ J˜šÏnœ�œ
�œ˜Aš�œ�œ
�œ˜Jšœ�œ�œ
˜Jšœ�œ�œ�œ
˜Dšœ	�œ ˜+Jš	œ�œ
�œ�œ
�œ˜2—š�œ
�œ
�˜šœ	�œ5˜@Jš	œ�œ
�œ�œ
�œ˜2——š�œ
�œ
�˜šœ	�œ8˜CJš	œ�œ
�œ�œ
�œ˜2——š
�˜Jš�œ
�œ�œ
˜J˜Jšœ"�œ˜0Jšœ�œ�œ˜%Jšœ
�œ˜+Jš�œ
�œ�œ
�œ
˜)Jšœ�œ�œ˜%Jšœ�œ˜Jš�œ
�œ�œ
�œ˜8Jšœ
�œ˜Jš�œ
�œ�œ
�œ˜8Jšœ�œ˜Jš�œ
�œ�œ
�œ˜8Jšœ�œ˜!Jš�œ
�œ�œ
�œ
˜)Jš
œ˜Jš�œ
˜—Jš�œ˜Jš
œ˜—Jš�œ˜J˜—J˜—š
œ™J˜šžœ�˜Jšœ�œ�œ˜*Jš
œD™DJšœ�œ�œ˜)Jšœ�œ
�œ˜šœ�œ˜Jš
œ˜Jšœ�œ�œ
�œ˜E—Jš�œ˜Jš
œ˜J™—šžœ�œ
�˜Jšœ�œ˜-Jš�œ�œ�œ˜,Jš
œ™š�œ�œ˜Jš
œ™Jšœ�œ˜Jš�œ"�œ�œ˜Kšœ�œ˜Jš
œ	˜	Jšœ�œ�œ˜J—J˜—Jš
œ˜J™—šžœ�œ
�˜Jšœ�œ˜-Jš�œ�œ�œ˜,Jš
œ™š�œ�œ˜Jš
œ™Jšœ�œ˜Jš�œ"�œ�œ˜Kšœ�œ˜Jš
œ	˜	Jšœ�œ�œ˜J—J˜—Jš
œ˜J™—šžœ�œ
�˜Jš	œ�œ$�œ�œ
�œ˜MJš
œK™Kš�œ
˜š�œ˜Jš
œ™Jš
œ/˜/Jš	œ�œ�œ�œ�œ˜Oš�œ�œ˜!Jš�œ�œ
˜š�œ
�œ˜Jšœ
�œ�œ˜2Jšœ�œ
�œ�œ%˜;Jš�œ�œ@˜JJš�œÏc,˜HJšœ�œ�œ˜)Jš�œ˜J˜——J˜
—š
�˜Jšœ�œ˜——Jš
œ˜J™—šž	œ�œ
�˜Jšœ�œ�œ	�œ�œ
�œ˜VJš
œK™Kš�œ
˜š�œ
�œ˜Jš
œ™Jšœ
�œ�œ˜2Jšœ�œ
�œ�œ%˜;Jš�œ�œ;˜EJš�œŸ,˜HJšœ�œ�œ˜)Jš�œ˜J˜
—š
�˜Jšœ�œ˜——Jš
œ˜J™——š
œ™J™JšœH�œQ™Ÿ
J˜šžœ�˜Jšœ�œ�œ
�œ˜cJšœ�œ
�œ
�œ˜/J˜J˜J˜Jš�œ˜Jš
œ˜Jš�œ˜Jš�œ�œ
�œ˜3š�œ�œ˜Jšœ�œ�œ˜&Jšœ�œ�œ
˜(Jš�œ˜ š�œ˜š�œ˜J˜Jš�œ'˜)J˜ š�œ �œ˜@Jš�œ
�œ1˜8—Jš
œ
˜
—š�œ˜J˜J˜ š�œ
�œ
�˜Jšœ�œ˜/Jšœ�œ!˜4Jš�œ
˜—š�œ˜
Jš�œ
�œ1˜8š
�˜š�œ
�œ
�˜˜š�œ�œ˜Jš�œ˜ š�œ�˜!š
œ˜Jšœ
�œ˜$—š�œ˜
š�œ˜
Jš�œ
�œ˜%Jš�œ
�œ%˜,———Jš
œ˜——šœ�œ#˜7Jš�œ.˜0—š�œ˜Jšœ�œ˜!š�œ˜Jš
œ ˜ Jš
œ>˜>—Jš�œ�œ
�œ˜-Jš
œ˜————Jš
œ˜——Jš
œ/˜/Jš�œ�œ@˜TJš
œ˜—Jš
œ˜J˜—šž	œ�œ�œ˜OJ˜š�œ
˜Jš�œ
�œ˜š
�˜š�œ�œ
�˜ ˜š�œ�œ
�˜J˜(Jš�œ%˜,——˜š�œ �œ�˜9š�œ�œ
�˜˜Jš�œ�œ
�œ˜*Jšœ	�œ˜0Jš�œ�œ�œ
�œ
˜2Jš
œ˜—Jš�œ
˜—Jš�œ
˜——Jš�œ
˜———Jš�œ˜Jš
œ˜Jš�œ˜Jš
œ˜J˜—šž
œ�˜Jšœ�œ
�œ˜Kš�œ�œ˜Jšœ�œ
�œ
�œ˜-š�œ�œ
�˜˜	J˜Jš�œ˜Jš
œ˜Jš�œ˜š�œ�œ
�˜Jš
œ(˜(Jš�œ%˜,—š�œ�œ
�˜Jšœ	�œ
˜˜Jš�œ�œ
�œ˜0Jš�œ
�œ
�œ
�œ ˜;Jš�œ"˜$Jš
œ˜Jš
œ˜—˜Jš�œ�œ
�œ˜1Jš�œ
�œ
�œ!˜7Jš�œ�œ
�œ˜9J˜&š�œ�œ
�˜%Jšœ�œ�œ
�œ˜?Jšœ�œ˜-Jš�œ
˜—š�œ�œ
�˜š
œ˜Jš�œ˜Jš
œ"˜"—Jš�œ
˜—Jš
œ˜—˜š�œ
�œ
�˜Jšœ
�œ˜.Jšœ	�œ˜&Jš�œ
˜—Jš�œ�œ
�œ˜3Jš�œ
�œ
�œ˜/Jš�œ˜Jš
œ"˜"Jš�œ�œ
�œ ˜5Jš
œ1˜1J˜—˜
Jš�œ
�œ
�œ˜1Jš�œ#˜%Jš
œ$˜$Jš�œ'˜)Jš
œ(˜(Jš
œ3˜3Jš
œ7˜7Jš
œ˜—˜Jš�œ'˜)Jš
œ(˜(Jš�œ�œ
�œ ˜5Jš
œ7˜7Jš
œ˜—˜
Jš�œ�œ
�œ˜-Jš
œ-˜-Jš
œ/˜/J˜—˜Jš�œ˜Jš
œ˜Jš�œ0˜2Jš
œ˜—˜
Jš�œ�œ
�œ ˜5š�œ�œ˜Jš�œ˜Jš
œ!˜!—Jš�œ!˜#Jš
œ1˜1Jš�œ!˜#Jš
œ˜Jš�œ�œ�œ˜FJš
œ˜—˜
Jš�œ
�œ
�œ˜1š�œ
˜š�œ˜Jš�œ˜Jš
œ ˜ —š�œ˜Jš�œ#˜%Jš
œ2˜2——Jš�œ'˜)Jš
œ(˜(š�œ
˜Jš�œ�œ˜5Jš�œA˜E—Jš
œ7˜7Jš
œ˜—˜
Jš�œ"˜$Jš
œ#˜#Jš�œ$˜&Jš
œ%˜%Jš
œ2˜2Jš
œ4˜4Jš
œ˜—˜Jš�œ˜Jš
œ˜š�œ�˜Jš�œ2˜4—Jš
œ˜—˜	Jš�œ�œ
�œ˜3Jš�œ�œ
�œ˜+Jš
œ˜—˜
Jš�œ˜Jš
œ$˜$š�œ
�œ˜Jš�œ3˜5Jš�œ3˜5—Jš
œ3˜3Jš
œ˜—˜Jš�œ˜Jš
œ$˜$Jš
œ3˜3Jš
œ˜—Jš�œ
˜—Jš
œ˜—Jš
�˜—Jš
œ˜—J˜J˜—šž	œ�˜Jšœ�œ
�œ˜Išžœ�œ˜(Jš
œ˜š�œ	�œ
�˜š
œ˜Jš
œ ˜ —˜Jš
œ˜Jš�œ˜Jš
œ˜Jš�œ˜Jš
œ˜—˜
Jš
œ˜—˜J˜š�œ�˜Jšœ�œ˜0Jšœ�œ�œ˜0š�œ˜Jšœ�œ
�œ
�œ˜.Jš�œ)˜+Jš�œ˜Jš
œ˜Jš�œ˜š�œ
�œ˜Jš�œ˜Jš
œ˜Jš
œ˜—š�œ
�œ
�œ
�œ˜*Jš�œ
�œ
�œ˜+Jš�œ˜Jš�œ
�œ
�œ˜(Jš�œ
�œ
�œ˜(Jš�œ
�œ
�œ˜(Jš�œ˜Jš
œ˜—J˜š�œ˜š�œ˜Jšœ"�œ
˜'Jš
œ0˜0Jšœ�œ˜š�œ�œ˜š
�˜Jš
œ6™6š�œ�œ
�œ�œ
�œ�˜Jš
œ˜Jš�œ�œ
�œ
˜Jš
œ˜Jš
�˜——š
�˜Jš
œ.™.š�œ�œ
�œ
�˜Jš
œ˜Jš�œ
˜———J˜
—š�œ˜Jš
œ˜Jš
œ!˜!Jš
œ˜Jš
œ!˜!J˜——J˜——J˜—Jš�œ�œ
˜—J˜—Jš
œ˜J˜J˜—šžœ�œ �œ˜Zš�œ	�œ
�˜˜Jš
œ(˜(Jšœ�œ
�œ˜'Jš�œ˜Jš�œ�œ
�œ�œ
�œ�œ
˜EJš�œ˜Jš�œ�œ
�œ˜+—˜	J˜9Jšœ�œ
˜Jš�œ�œ˜/š�œ�œ
�œ�˜(š�œ%˜'Jš�œ
�œ˜"Jš�œ
�œ$Ÿ˜3—Jš�œ�œ
�œ˜1Jš�œ
˜—Jš�œ�œ
�œ˜0—Jš�œ˜	J˜——šžœ�œ�œ˜Bš�œ
�œ
�˜š
œ˜Jš�œH˜J—š
œ˜Jš�œ<˜>—š�œ˜
Jš�œH˜J——J˜J˜—šž
œ�œ�œ˜@š�œ	�œ
�˜Jš
œ'˜'Jšœ	�œ8˜CJšœ�œ:˜GJšœ�œ;˜IJš�œ�œ
˜—J˜J˜—šžœ�œ�œ˜OJš
œ+˜+Jš
œ˜J˜—šž	œ�œ�œ˜Mš�œ˜Jš�œ
�œ˜!š�œ˜Jš
œ+˜+š�œ�œ
�œ"�˜1Jš�œ˜Jš�œ
˜—Jš
œ˜——J˜J˜—šž
œ�œ�œ˜<Jš�œ#˜%J˜J˜—šž
œ�œ�œ˜=Jš�œ#˜%J˜J˜—šž
œ�œ�œ˜@Jš�œ#˜%J˜J˜—šžœ�œ�œ�œ˜KJš�œ˜Jš�œ˜Jš�œ�œ
�œ�œ˜MJš
œ˜J˜—šž
œ�˜Jšœ
�œ�œ˜Hš�œ
˜Jš�œ�œ�œ˜?š
�˜š�œ�œ
�˜ J˜.Jšœ�œ�œ˜BJš
�˜———š
œ˜J˜——šžœ�˜Jšœ�œ�œ�œ˜@Jš	œ�œ
�œ	�œ�œ˜7š�œ�œ
�œ	�˜Jš
œ˜š�œ˜	Jš�œ
�œ˜Jš�œ
�œ˜!—Jš�œ
˜—š�œ	�œ˜š�œ�œ˜"Jš�œ
�œJ˜QJš�œ
�œ˜—Jš
œQ™Qš	œ
�œ�œ�œ
�œ˜-š�œ˜Jš
œ˜Jš
œ(˜(Jš
œ˜—š
�˜Jšœ	�œ˜#—J˜—J˜—J˜J˜—šžœ�˜!Jšœ�œ
�œ˜;Jšœ�œ
�œ˜Jšœ�œ˜š	�œ�œ
�œ�œ�˜"Jš�œ˜Jš�œ
˜—J˜J˜—š
žœ�œ�œ
�œ
�œ˜?š�œ�œ
�œ
˜š�œ�œ
�œ�˜ Jš�œ˜Jš�œ
˜——J˜J˜—šžœ�œ�œ˜?š�œ�œ
�œ"�˜1Jš�œ˜Jš�œ
˜—J˜J˜—šž
œ�œ	�œ
�œ˜@Jš�œ�œ�œ˜5J˜J˜—šžœ�œ
�œ�œ˜6Jš�œ˜Jš�œ�œ
�œ�œ
˜8J˜J˜—šžœ�˜Jšœ%�œ˜@š�œ�œ
�˜$š
œ
˜
Jšœ�œ�œ�œ
�œ
�œ˜IJš�œ�œ ˜9J˜—š
œ	˜	Jšœ�œ�œ�œ
�œ
�œ˜GJš�œ�œ*˜CJ˜—Jš�œ�œ
˜—š
œ˜J˜——šžœ�˜Jšœ%�œ˜Eš�œ�œ
�˜ Jšœ
�œ
�œ˜ Jšœ�œ	˜Jšœ�œ	˜Jš�œ
˜—J˜J˜—š
ž	œ�œ�œ�œ�œ˜6Jšœ�œ˜Jšœ�œ˜š�œ	�˜Jšœ�œ˜š�œ�˜#Jš
œ˜Jšœ�œ&˜>Jš�œ
˜—J˜Jš�œ
˜—Jš�œ˜J˜J˜——š
œ™J˜Jš	œ�œ�œ
�œ
�œ
˜-šœ�œ
�œ˜)š�œ˜Jš
œû˜û——Jš	œ�œ�œ�œ
�œ
˜.šœ�œ˜"š�œ˜Jš
œÀ
˜À
——Jš	œ�œ�œ�œ
�œ
˜1šœ�œ
�œ˜)š�œ˜Jš
œC˜C—J˜——Jš�œ
˜J˜—…—Wv¡