DIRECTORY
ConvertUnsafe USING [SubString],
IO,
ListerUtils,
Rope,
SortedSymbolLister,
StructuredStreams,
Symbols,
SymbolSegment,
SymbolTable,
Tree,
UnparserBuffer;

SortedSymbolListerImpl: PROGRAM IMPORTS IO, ListerUtils, StructuredStreams, UnparserBuffer EXPORTS SortedSymbolLister =
BEGIN OPEN Symbols;

CR: CHAR = '\n;
SP: CHAR = ' ;
wordlength: CARDINAL = 16;

SymbolTableBase: TYPE = SymbolTable.Base;
ROPE: TYPE = Rope.ROPE;


Control: TYPE = {begin, end, brk, tbrk};
DoControl: PROC [st: IO.STREAM, cc: Control] = {
SELECT cc FROM
begin => StructuredStreams.Begin[st];
end => StructuredStreams.End[st];
brk => StructuredStreams.Bp[st, FALSE, 2];
tbrk => StructuredStreams.Bp[st, TRUE, 2];
ENDCASE => ERROR;
};


alwaysMD: BOOL _ FALSE;

VfTag: TYPE = {signed, unsigned, char, enum, array, transfer, ref, other};

ValFormat: TYPE = RECORD [
bias: INTEGER _ 0,
var: SELECT tag: VfTag FROM
signed => [], --an INTEGER or subrange with base < 0
unsigned => [], -- a CARDINAL, WORD, UNSPECIFIED, or subrange w/ base >= 0
char => [], --a character
enum => [esei: EnumeratedSEIndex], --an enumerated type
array => [componentType: SEIndex],
transfer => [mode: TransferMode], --a PROC, SIGNAL, ERROR, PROGRAM, or PORT
ref => [], --a pointer
other => [], --anything else (whether single word or multi-word)
ENDCASE];

AddSymbols: PUBLIC PROC [rList: LIST OF REF ANY , stb: SymbolTableBase] RETURNS [LIST OF REF ANY] =
BEGIN
ros: IO.STREAM _ IO.ROS[];
upb: UnparserBuffer.Handle;
strc: IO.STREAM;
modname: ROPE; 
mySei, sei: ISEIndex;
stHandle: LONG POINTER TO SymbolSegment.STHeader = stb.stHandle;
IO.PutRope[ros, ": --"]; -- set up modname
FOR sei _ stb.FirstCtxSe[stHandle.directoryCtx], stb.NextSe[sei] UNTIL sei = ISENull DO 
mySei _ sei; 
ENDLOOP;
ListerUtils.PrintSei[mySei, ros, stb];
IO.PutRope[ros, "--"];
modname _ IO.RopeFromROS[ros, FALSE];
upb _ UnparserBuffer.NewHandle[[stream[ros]]];
strc _ StructuredStreams.Create[upb];
FOR sei _ stb.FirstCtxSe[stHandle.outerCtx], stb.NextSe[sei] UNTIL sei = ISENull DO
IO.Reset[ros];
UnparserBuffer.Init[upb];
DoControl[strc, begin];
PrintSym[strc, stb, sei, modname, TRUE]; IO.Put[strc, [character[';]]];
DoControl[strc, end];
rList _ CONS [IO.RopeFromROS[ros, FALSE], rList]; 
ENDLOOP;
RETURN [rList];
END;

FirstChar: PROC [stb: SymbolTableBase, hti: HTIndex] RETURNS [CHAR] = {
ss: ConvertUnsafe.SubString;
IF hti = HTNull  THEN RETURN [0C];
ss _ stb.SubStringForName[hti];
IF ss.length = 0 THEN RETURN [0C];
RETURN[ss.base[ss.offset]]};

PrintSym: PROC [st: IO.STREAM, stb: SymbolTableBase, sei: ISEIndex, colonstring: ROPE, defaultPublic: BOOL] =
BEGIN
PrintSei: PROC [val: ISEIndex] = {
ListerUtils.PrintSei[sei: val, stream: st, stb: stb]};
PutRope: PROC[val: ROPE] = {
IO.PutRope[st, val]};
typeSei: SEIndex;
hti: HTIndex;
hti _ stb.seb[sei].hash;
IF FirstChar[stb, hti] = '& THEN RETURN;
DoControl[st, begin];
IF hti # HTNull THEN
BEGIN PrintSei[sei]; PutRope[colonstring]; END;
IF stb.seb[sei].public # defaultPublic THEN
BEGIN
defaultPublic _ stb.seb[sei].public;
PutRope[IF defaultPublic THEN "PUBLIC " ELSE "PRIVATE "];
END;
IF stb.seb[sei].idType = typeTYPE THEN
BEGIN
vf: ValFormat;
typeSei _ stb.seb[sei].idInfo;
PutRope["TYPE"];
WITH t: stb.seb[typeSei] SELECT FROM
cons => WITH t SELECT FROM
opaque => NULL;
ENDCASE => PutRope[" = "];
ENDCASE => PutRope[" = "];
DoControl[st, brk];
vf _ PrintType[st, stb, typeSei, NoSub, defaultPublic];
DoControl[st, brk];
PrintDefaultValue [st, stb, sei, vf];
END
ELSE
BEGIN
vf: ValFormat;
typeSei _ stb.seb[sei].idType;
IF stb.seb[sei].immutable
AND NOT stb.seb[sei].constant
AND (SELECT stb.XferMode [typeSei] FROM
none, process => TRUE, ENDCASE => FALSE)
THEN PutRope["READONLY "];
vf _ PrintType[st, stb, typeSei, NoSub, defaultPublic];
IF stb.seb[sei].constant AND vf.tag <= enum THEN
BEGIN
PutRope[" = "];
DoControl[st, brk];
IF stb.seb[sei].extended THEN 
PrintTreeLink [st, stb, stb.FindExtension[sei].tree, vf]
ELSE PrintTypedVal[st, stb, stb.seb[sei].idValue, vf];
END;
END;
DoControl[st, end];
END;

PrintTypedVal: PROC [st: IO.STREAM, stb: SymbolTableBase, val: UNSPECIFIED, vf: ValFormat] =
BEGIN
PutCharConst: PROC [val: CARDINAL] = {IO.PutF[st, "%bC", [cardinal[val]]]};
loophole: BOOL _ FALSE; 
val _ val + vf.bias;
WITH vf SELECT FROM
signed => PutSigned[st, LONG[LOOPHOLE[val, INTEGER]]];
unsigned => PutUnsigned[st, LONG[LOOPHOLE[val, CARDINAL]]];
char => PutCharConst[val];
enum => PutEnum[st, stb, val, esei];
transfer, ref => IF val = 0 THEN IO.PutRope[st, "NIL"] ELSE loophole _ TRUE;
ENDCASE => loophole _ TRUE;
IF loophole THEN
{IO.PutRope[st, "LOOPHOLE ["];
PutUnsigned[st, LONG[LOOPHOLE[val, CARDINAL]]];
IO.Put[st, [character[']]]]};
END;

GetBitSpec: PROC [stb: SymbolTableBase, isei: ISEIndex] RETURNS [ROPE] =
BEGIN
a: Symbols.BitAddress;
s: CARDINAL;
ros: IO.STREAM _ IO.ROS[];
[offset: a, size: s] _ stb.RecField[isei];
IO.PutF[ros, " (%d", [cardinal[a.wd]]];
IF s # 0 THEN IO.PutF[ros, ":%d..%d", [cardinal[a.bd]], [cardinal[a.bd+s-1]]];
IO.PutRope[ros, "): "];
RETURN [IO.RopeFromROS[ros]];
END;

PrintFieldCtx: PROC [st: IO.STREAM, stb: SymbolTableBase, ctx: CTXIndex, md: BOOL, defaultPublic: BOOL] =
BEGIN
PutChar: PROC [val: CHAR] = {
IO.Put[st, [character[val]]]};
PutRope: PROC[val: ROPE] = {
IO.PutRope[st, val]};
isei: ISEIndex _ stb.FirstCtxSe[ctx];
bitspec: ROPE _ ": ";
first: BOOL _ TRUE;
IF isei # ISENull AND stb.seb[isei].idCtx # ctx THEN isei _ stb.NextSe[isei];
IF isei = ISENull THEN BEGIN PutRope["NULL"]; RETURN END;
PutChar['[];
FOR isei _ isei, stb.NextSe[isei] UNTIL isei = ISENull DO
IF first THEN first _ FALSE ELSE PutRope[", "];
DoControl[st, brk];
IF md THEN bitspec _ GetBitSpec[stb, isei];
DoControl[st, begin];
PrintSym[st, stb, isei, bitspec, defaultPublic];
PrintDefaultValue [st, stb, isei, GetValFormat[stb, stb.seb[isei].idType]];
DoControl[st, end];
ENDLOOP;
PutChar[']];
END;

PrintValue: PROC [st: IO.STREAM, value: UNSPECIFIED] =
BEGIN
lc: LONG CARDINAL _ LOOPHOLE[value, CARDINAL];
PutUnsigned[st, lc];
END;

NoSub: PROC [ptr: BOOL] = BEGIN RETURN END;


EnumeratedSEIndex: TYPE = 
Symbols.Base RELATIVE POINTER [0..Limit) TO enumerated cons SERecord;

PutEnum: PROC [st: IO.STREAM, stb: SymbolTableBase, val: UNSPECIFIED, esei: EnumeratedSEIndex] =
BEGIN
sei: ISEIndex;
FOR sei _ stb.FirstCtxSe[stb.seb[esei].valueCtx], stb.NextSe[sei] 
WHILE sei # ISENull DO
IF stb.seb[sei].idValue = val THEN BEGIN ListerUtils.PrintSei[sei, st, stb]; RETURN; END;
ENDLOOP;
IO.PutRope[st, "LOOPHOLE ["];
PrintValue[st, val];
IO.Put[st, [character[']]]];
END;

GetValFormat: PROC [stb: SymbolTableBase, tsei: SEIndex] RETURNS [vf: ValFormat] =
BEGIN
WITH t: stb.seb[tsei] SELECT FROM
id => RETURN [GetValFormat[stb, stb.UnderType[tsei]]];
cons => WITH t SELECT FROM
basic =>  
SELECT code FROM
codeANY => vf _ [,unsigned []];
codeINT => vf _ [,signed []];
codeCHAR => vf _ [,char[]];
ENDCASE;
enumerated => vf _ [,enum [LOOPHOLE [tsei]]];
array => vf _ [,array [componentType]];
transfer => vf _ [,transfer[mode]];
relative => vf _ GetValFormat[stb, offsetType];
subrange => {
vf _ GetValFormat [stb, rangeType];
IF vf.tag = signed AND origin >= 0 THEN vf _ [,unsigned[]];
vf.bias _ origin};
long => vf _ GetValFormat[stb, rangeType];
ref => vf _ [,ref []];
ENDCASE => vf _ [,other[]];
ENDCASE => vf _ [,other[]];
END;


octalThreshold: NAT _ 1024;

PutSigned: PROC [st: IO.STREAM, val: INT] = {
IF val > octalThreshold THEN IO.PutF[st, "%bB", [integer[val]]]
ELSE IO.PutF[st, "%d", [integer[val]]]};

PutUnsigned: PROC [st: IO.STREAM, val: LONG CARDINAL] = {
IF val > octalThreshold THEN IO.PutF[st, "%bB", [cardinal[val]]]
ELSE IO.PutF[st, "%d", [cardinal[val]]]};

PrintType: PROC [st: IO.STREAM, stb: SymbolTableBase, tsei: SEIndex, dosub: PROC [ptr: BOOL], defaultPublic: BOOL]
RETURNS [vf: ValFormat] =
BEGIN OPEN Symbols;
PutChar: PROC [val: CHAR] = {
IO.Put[st, [character[val]]]};
PutRope: PROC[val: ROPE] = {
IO.PutRope[st, val]};
PrintSei: PROC [val: ISEIndex] = {
ListerUtils.PrintSei[sei: val, stream: st, stb: stb]};
PrintHti: PROC [val: HTIndex] = {
ListerUtils.PrintName[name: val, stream: st, stb: stb]};

vf _ GetValFormat[stb, tsei];
WITH t: stb.seb[tsei] SELECT FROM
id =>
BEGIN
printBase: BOOL _ TRUE;
multiSubrange: BOOL _ FALSE;
bsei: SEIndex _ tsei;
csei: CSEIndex;
tseiNext: SEIndex;
BEGIN
l1: SEIndex = t.idInfo;
IF stb.seb[l1].seTag = id THEN GO TO noAdj;
UNTIL (tseiNext _ stb.TypeLink[tsei]) = SENull DO
WITH stb.seb[tsei] SELECT FROM
id => BEGIN PrintSei[LOOPHOLE[tsei]]; PutChar[SP]; END;
ENDCASE;
tsei _ tseiNext;
ENDLOOP;
EXITS
noAdj => NULL;
END;
IF t.idCtx NOT IN Symbols.StandardContext THEN
WITH c: stb.ctxb [t.idCtx] SELECT FROM
included =>
BEGIN
hti: HTIndex = stb.mdb [c.module].moduleId;
PrintHti [hti]; --interface name
PutChar ['.]; -- dot qualification
END;
ENDCASE;

DO
csei _ stb.UnderType[bsei];
WITH stb.seb[csei] SELECT FROM
basic =>
BEGIN
SELECT code FROM
codeINT => printBase _ multiSubrange;
ENDCASE;
EXIT;
END;
subrange => {bsei _ rangeType; multiSubrange _ TRUE};
enumerated => {printBase _ TRUE; EXIT};
ENDCASE => EXIT;
ENDLOOP;
IF printBase OR dosub = NoSub THEN PrintSei[LOOPHOLE[tsei]];
dosub[FALSE];
END;
cons =>
WITH t SELECT FROM

enumerated =>
BEGIN
isei: ISEIndex;
v: CARDINAL _ 0;
sv: CARDINAL;
md: BOOL = machineDep;
first: BOOL _ TRUE;
IF md THEN PutRope["MACHINE DEPENDENT "];
PutChar['{];
FOR isei _ stb.FirstCtxSe[valueCtx], stb.NextSe[isei] UNTIL isei = ISENull DO
IF first THEN first _ FALSE ELSE PutRope[", "];
DoControl[st, brk];
IF md THEN {
hti: Symbols.HTIndex = stb.seb[isei].hash;
sv _ stb.seb[isei].idValue;
IF hti # HTNull THEN PrintSei[isei];
IF hti = HTNull OR sv # v THEN 
{PutChar['(]; PutUnsigned[st, sv]; PutChar[')]};
v _ sv + 1}
ELSE PrintSei[isei];
ENDLOOP;
PutChar['}];
END;
record =>
BEGIN
IF stb.ctxb[fieldCtx].level # lZ THEN
BEGIN
fctx: CTXIndex = fieldCtx;
bti: BTIndex _ FIRST[BTIndex];
btlimit: BTIndex = bti + stb.stHandle.bodyBlock.size;
PutRope["FRAME ["];
UNTIL bti = btlimit DO
WITH entry: stb.bb[bti] SELECT FROM
Callable =>
BEGIN
IF entry.localCtx = fctx THEN
BEGIN PrintSei[entry.id]; PutChar[']]; EXIT END;
bti _
bti +
(WITH entry SELECT FROM
Inner => SIZE[Inner Callable BodyRecord],
ENDCASE => SIZE[Outer Callable BodyRecord]);
END;
ENDCASE => bti _ bti + SIZE[Other BodyRecord];
ENDLOOP;
END
ELSE
BEGIN
IF defaultPublic AND hints.privateFields THEN PutRope["PRIVATE "];
IF monitored THEN PutRope["MONITORED "];
IF machineDep THEN PutRope["MACHINE DEPENDENT "];
PutRope["RECORD"];
PrintFieldCtx[st, stb, fieldCtx, machineDep, defaultPublic AND ~hints.privateFields];
END;
END;
ref =>
BEGIN
referent: SEIndex _ refType;
IF var THEN 
IF readOnly THEN PutRope["READONLY "]
ELSE PutRope["VAR "]
ELSE
BEGIN
IF ordered THEN PutRope["ORDERED "];
IF basing THEN PutRope["BASE "];
IF counted THEN {
isList: BOOL;
element: SEIndex;
[isList, element] _ CheckForList[stb, LOOPHOLE[tsei]];
IF isList THEN {
PutRope["LIST OF "];
[] _ PrintType[st, stb, element, NoSub, defaultPublic];
GO TO noprint;
}
ELSE PutRope["REF "];
WITH rt: stb.seb[referent] SELECT FROM
cons => WITH rt SELECT FROM
any => {
PutRope["ANY"];
GO TO noprint};
ENDCASE;
ENDCASE;
}
ELSE {
PutRope["POINTER"];
IF dosub # NoSub THEN {
PutChar[' ];
dosub[TRUE];
};
WITH rt: stb.seb[referent] SELECT FROM
cons => WITH rt SELECT FROM
basic => IF code = Symbols.codeANY AND ~readOnly THEN 
GO TO noprint;
ENDCASE;
ENDCASE;
PutRope[" TO "];
IF readOnly THEN PutRope["READONLY "];
};
END;
DoControl[st, brk];
[] _ PrintType[st, stb, referent, NoSub, defaultPublic];
EXITS noprint => NULL;
END;
array =>
BEGIN
IF packed THEN PutRope["PACKED "];
PutRope["ARRAY "];
[] _ PrintType[st, stb, indexType, NoSub, defaultPublic];
PutRope[" OF "];
DoControl[st, brk];
[] _ PrintType[st, stb, componentType, NoSub, defaultPublic];
END;
arraydesc =>
BEGIN
PutRope["DESCRIPTOR FOR "];
IF readOnly THEN PutRope["READONLY "];
DoControl[st, brk];
[] _ PrintType[st, stb, describedType, NoSub, defaultPublic];
END;
transfer =>
BEGIN
PutModeName[st, mode];
IF typeIn # CSENull THEN
BEGIN PutChar[' ]; 
WITH tt: stb.seb[typeIn] SELECT FROM
record => PrintFieldCtx[st, stb, tt.fieldCtx, FALSE, defaultPublic]; 
any => PutRope["ANY"];
ENDCASE => ERROR;
END;
IF typeOut # CSENull THEN
BEGIN
DoControl[st, brk];
PutRope[" RETURNS "];
WITH tt: stb.seb[typeOut] SELECT FROM
record => PrintFieldCtx[st, stb, tt.fieldCtx, FALSE, defaultPublic];
any => PutRope["ANY"];
ENDCASE => ERROR;
END;
END;
union =>
BEGIN
tagType: SEIndex;
PutRope["SELECT "];
IF ~controlled THEN
IF overlaid THEN PutRope["OVERLAID "]
ELSE PutRope["COMPUTED "]
ELSE 
BEGIN 
PrintSei[tagSei]; 
IF machineDep OR alwaysMD THEN PutRope[GetBitSpec[stb, tagSei]]
ELSE PutRope[": "];
END;
tagType _ stb.seb[tagSei].idType;
IF stb.seb[tagSei].public # defaultPublic THEN
PutRope[
IF defaultPublic THEN "PRIVATE " ELSE "PUBLIC "];
WITH stb.seb[tagType] SELECT FROM
id => [] _ PrintType[st, stb, tagType, NoSub, defaultPublic];
cons => PutChar['*];
ENDCASE;
PutRope[" FROM "];
BEGIN
isei: ISEIndex;
varRec: RecordSEIndex;
FOR isei _ stb.FirstCtxSe[caseCtx], stb.NextSe[isei] 
UNTIL isei = ISENull DO
DoControl[st, tbrk];
DoControl[st, begin];
PrintSei[isei];
PutRope[" => "];
varRec _ LOOPHOLE[stb.UnderType[stb.seb[isei].idInfo]];
PrintFieldCtx[st, stb, stb.seb[varRec].fieldCtx, machineDep, defaultPublic];
PutRope[", "];
DoControl[st, end];
ENDLOOP;
DoControl[st, tbrk];
PutRope["ENDCASE"];
END;
END;
relative =>
BEGIN
IF baseType # SENull THEN [] _ PrintType[st, stb, baseType, NoSub, defaultPublic];
PutRope[" RELATIVE "];
[] _ PrintType[st, stb, offsetType, dosub, defaultPublic];
END;
sequence =>
BEGIN
tagType: SEIndex;
pubTag: BOOL _ stb.seb[tagSei].public;
IF packed THEN PutRope["PACKED "];
PutRope["SEQUENCE "];
IF ~controlled THEN PutRope["COMPUTED "]
ELSE 
BEGIN 
PrintSei[tagSei]; 
IF machineDep THEN PutRope[GetBitSpec[stb, tagSei]]
ELSE PutRope[": "];
END;
tagType _ stb.seb[tagSei].idType;
IF pubTag # defaultPublic THEN
PutRope[
IF defaultPublic THEN "PRIVATE " ELSE "PUBLIC "];
[] _ PrintType[st, stb, tagType, NoSub, pubTag];
PutRope[" OF "];
[] _ PrintType[st, stb, componentType, NoSub, defaultPublic];
END;
subrange =>
BEGIN
org: INTEGER _ origin;
size: CARDINAL _ range;
mt: BOOL _ empty;

doit: PROC [ptr: BOOL] =
BEGIN
vfSub: ValFormat _ IF ptr THEN [,unsigned[]] ELSE vf;
vfSub.bias _ 0;
PutChar['[];
PrintTypedVal[st, stb, org, vfSub];
PutRope[".."];
IF mt THEN {PrintTypedVal[st, stb, org, vfSub]; PutChar[')]}
ELSE {PrintTypedVal[st, stb, org + size, vfSub]; PutChar[']]};
END;

[] _ PrintType[st, stb, rangeType, doit, defaultPublic];
vf.bias _ org;
END;
zone => SELECT TRUE FROM
counted => PutRope["ZONE"];
mds => PutRope["MDSZone"];
ENDCASE => PutRope["UNCOUNTED ZONE"];
opaque => {
IF lengthKnown THEN {
PutChar['[]; 
PutUnsigned[st, length / wordlength]; 
PutChar[']]}};
long =>
BEGIN
IF NOT IsVarOrRef [rangeType, stb] THEN PutRope["LONG "];
[] _ PrintType[st, stb, rangeType, NoSub, defaultPublic];
END;
real => PutRope["REAL"];
ENDCASE => PutRope["xxxx"];
ENDCASE;
END;

IsVarOrRef: PROC [tsei: Symbols.SEIndex, stb: SymbolTableBase] RETURNS [BOOL] =
BEGIN
WITH t: stb.seb[tsei] SELECT FROM
id => RETURN [FALSE];
cons => WITH t2: t SELECT FROM
ref => RETURN [t2.var OR t2.counted]
ENDCASE => RETURN [FALSE];
ENDCASE => RETURN [FALSE];
END;

RefIndex: TYPE = Symbols.Base RELATIVE POINTER [0..Limit) TO ref cons SERecord;

CheckForList: PROC [stb: SymbolTableBase, rsei: RefIndex] RETURNS [BOOL, SEIndex] = {
rft: SEIndex _ stb.seb[rsei].refType;
seb: Symbols.Base = stb.seb;
WITH rt: seb[rft] SELECT FROM
id => RETURN [FALSE, SENull];
cons => WITH rec: rt SELECT FROM
record => {
ctx: CTXIndex = rec.fieldCtx;
first, rest: ISEIndex;
element: SEIndex;
restp: CSEIndex;
IF ctx = CTXNull THEN RETURN [FALSE, SENull];
first _ stb.FirstCtxSe[ctx];
IF first = ISENull THEN RETURN [FALSE, SENull];
element _ seb[first].idType;
rest _ stb.NextSe[first];
IF rest = ISENull THEN RETURN [FALSE, SENull];
restp _ stb.UnderType[seb[rest].idType];
WITH seb[restp] SELECT FROM
long => {
rgt: CSEIndex = stb.UnderType[rangeType];
WITH seb[rgt] SELECT FROM
ref => RETURN [refType = rft, element];
ENDCASE => RETURN [FALSE, SENull];
};
ENDCASE => RETURN [FALSE, SENull];
};
ENDCASE => RETURN [FALSE, SENull];
ENDCASE => RETURN [FALSE, SENull];
};

PutModeName: PROC [st: IO.STREAM, n: TransferMode] =
BEGIN
ModePrintName: ARRAY TransferMode OF ROPE =
["PROC", "PORT", "SIGNAL", "ERROR", "PROCESS", "PROGRAM",
"NONE"];
IO.PutRope[st, ModePrintName[n]]
END;
LUP: TYPE = LONG POINTER TO LONG UNSPECIFIED;
NodePointer: TYPE = LONG POINTER TO Tree.Node;

PrintDefaultValue: PROC [st: IO.STREAM, stb: SymbolTableBase, sei: ISEIndex, vf: ValFormat] =
BEGIN
extType: ExtensionType;
tree: Tree.Link;
[extType, tree] _ stb.FindExtension[sei];
IF extType # default THEN RETURN;
IO.PutRope[st, " _ "];
PrintTreeLink [st, stb, tree, vf];
END;

PrintTreeLink: PROC [st: IO.STREAM, stb: SymbolTableBase, tree: Tree.Link, vf: ValFormat] =
BEGIN
PutChar: PROC [val: CHAR] = {
IO.Put[st, [character[val]]]};
PutRope: PROC[val: ROPE] = {
IO.PutRope[st, val]};
PrintSei: PROC [val: ISEIndex] = {
ListerUtils.PrintSei[sei: val, stream: st, stb: stb]};
PrintHti: PROC [val: HTIndex] = {
ListerUtils.PrintName[name: val, stream: st, stb: stb]};

IF tree = Tree.Null THEN RETURN;
WITH t: tree SELECT FROM
subtree =>
BEGIN
node: NodePointer = @stb.tb[t.index];
SELECT node.name FROM
all =>
BEGIN
PutRope["ALL["];
WITH v: vf SELECT FROM
array => PrintTreeLink[st, stb, node.son [1], GetValFormat[stb, v.componentType]];
ENDCASE;
PutChar[']];
END;
mwconst, cast, loophole => PrintTreeLink[st, stb, node.son [1], vf];
nil => PutRope["NIL"];
void => PutRope["TRASH"];
dot, cdot =>
BEGIN
PrintTreeLink[st, stb, node.son[1], [,other[]]];
PutChar ['.]; --dot
PrintTreeLink[st, stb, node.son[2], [,other[]]];
END;
first, last, size => 
BEGIN
PutRope[SELECT node.name FROM 
first => "FIRST[", 
last => "LAST[", 
ENDCASE => "SIZE["];
PrintTreeLink[st, stb, node.son[1], vf];
PutChar [']];
END;
lengthen => 
BEGIN
s1: Tree.Link = node.son[1];
IF s1.tag = literal THEN PrintTreeLink[st, stb, s1, vf]
ELSE {
PutRope["LONG["];
PrintTreeLink[st, stb, s1, vf];
PutChar [']]};
END;
construct => 
BEGIN
s1: Tree.Link = node.son[1];
PutChar['[];
IF node.nSons = 2 THEN PrintTreeLink [st, stb, node.son[2], vf];
PutChar[']];
END;
union => PutRope["xxxx"];
list => IF node.nSons # 0 THEN PutRope["xxxx"];
longTC =>
BEGIN
PutRope["LONG "];
PrintTreeLink [st, stb, node.son[1], vf];
END;
uparrow =>
BEGIN
ptr: Tree.Link = node.son[1];
type: Symbols.CSEIndex;
WITH p: ptr SELECT FROM
symbol =>
type _ stb.NormalType [stb.UnderType[
stb.seb[p.index].idType]];
subtree => type _ stb.tb[p.index].info;
ENDCASE => type _ Symbols.typeANY;
PrintTreeLink[st, stb, node.son[1], [,other[]]];
WITH q: stb.seb[type] SELECT FROM
ref => IF ~q.var THEN PutChar['^];
ENDCASE => PutChar['^];
END;
ENDCASE => PutRope["xxxx"];
END;
hash => PrintHti [t.index];
symbol => PrintSei [t.index];
literal =>
BEGIN
WITH lr: t.index SELECT FROM
word =>
WITH stb.ltb[lr.lti] SELECT FROM
short => PrintTypedVal [st, stb, value, vf];
long =>
SELECT length FROM
2 =>
BEGIN
loophole: BOOL _ FALSE;
SELECT vf.tag FROM
signed => PutSigned [st, LOOPHOLE [@value, LUP]^];
unsigned => PutUnsigned [st, LOOPHOLE [@value, LUP]^];
transfer, ref =>
IF LOOPHOLE[@value, LUP]^ = 0
THEN PutRope["NIL"]
ELSE loophole _ TRUE;
ENDCASE => loophole _ TRUE;
IF loophole THEN
BEGIN
PutRope["LOOPHOLE ["];
PutUnsigned [st, LOOPHOLE [@value, LUP]^];
PutChar [']];
END;
END;
ENDCASE => PutRope["--constant--"];
ENDCASE; --shouldn't happen! 
ENDCASE --string-- => PutRope["(STRING)"];
END;
ENDCASE; --shouldn't happen!
END;


END...

zSortedSymbolListerImpl.mesa; modified by 
Sweet October 1, 1985 10:56:51 am PDT
check for wierd inserted symbols
it's not a proc, signal, error, program, or port
print adjectives, if any
print module qualification of last ID in chain
simple => PutCurrentModuleDot[];
finally print that last ID
basic =>  won't see one, see the id first.
BEGIN
PrintTreeLink [node.son[1], vf];
PutChar ['[];
PrintTreeLink [node.son[2], vf];
PutChar [']];
END;
BEGIN
FOR j: CARDINAL IN [1..node.nSons) DO
PrintTreeLink [node.son[j], [other[]]];
PutRope[", "];
ENDLOOP;
IF node.nSons # 0
THEN PrintTreeLink [node.son[node.nSons], [other[]]]; 
END;
Κ˜š
œ)™)Icode™%—J˜š
Οk	˜	Jšœœ
˜ J˜J˜J˜J˜J˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜J˜—š	œœ
œ
œ1œ˜wJšœ
œ	˜J˜Jšœœ˜Jšœœ˜Jšœœ˜J˜Jšœœ˜)Jšœœœ
˜J˜J˜Jšœ	œ˜(šΟn	œœœ
œ˜0šœ˜K˜%K˜!Kšœ œ˜*Kšœ!œ˜*Kšœ
˜—Kš
œ˜—J˜J˜Jšœ
œœ
˜J˜Jšœœ?˜JJ˜šœœœ˜Jšœœ˜šœœ˜JšœΟc&˜4JšœŸ:˜JJšœŸ
˜Jšœ#Ÿ˜7J˜"Jšœ"Ÿ)˜KJšœŸ˜Jšœ
Ÿ3˜@Jšœ˜	—J˜—šž
œœ	œ
œ
œœœ
œ
œ˜cJš
˜Jš	œœ
œœ
œ˜Jš
œ˜Jšœœ
œ
˜Jšœ	œ˜J˜Jšœ
œ
œ
œ'˜@JšœŸ˜*šœ>œœ
˜XJš
œ
˜
Jšœ
˜—Jš
œ&˜&J˜Jšœ
œœ˜%Jš
œ.˜.Jš
œ%˜%šœ:œ˜SJšœ˜Jš
œ˜J˜Jšœ"œœ˜GJ˜Jšœœœœ˜2Jšœ
˜—Jšœ	˜Jšœ
˜J˜—šž	œœ&œœ˜GJš
œ˜Jšœœ
œ˜"Jš
œ˜Jšœœ
œ˜"Jšœ˜J˜—šžœœœ
œ4œœ˜mJš
˜šžœœ˜"J˜6—šžœœœ˜Jšœ˜—J˜J˜
Jš
œ ™ Jš
œ˜Jšœœ
œ
˜(J˜šœ˜Jšœ&œ
˜/—šœ%˜+Jš
˜J˜$Jšœœœœ
˜9Jšœ
˜—šœ ˜&Jš
˜J˜J˜J˜šœœ
˜$šœœœ
˜Jšœ
œ
˜Jšœ˜—Jšœ˜—J˜J˜7J˜J˜%Jš
˜—š
˜Jš
˜J˜J˜šœ˜Jšœ
œ˜šœœ˜'šœœœœ
˜(Jš
œ0™0——Jšœ˜—J˜7šœœ˜0Jš
˜J˜J˜šœœ
˜J˜8—Jšœ2˜6Jšœ
˜—Jšœ
˜—J˜Jšœ
˜J˜—š
ž
œœœ
œœ˜\Jš
˜Jšžœœœœ#˜KJšœ
œœ˜J˜šœœ
˜Jšœœ
œœ˜6Jšœœ
œœ˜;J˜J˜$Jš	œœ	œœœ
˜LJšœœ
˜—šœ
˜Jšœ
œ˜Jšœœ
œœ˜/J˜—Jšœ
˜J˜—šž
œœ(œœ˜HJš
˜J˜Jšœœ
˜Jš	œœ
œœ
œ˜J˜*Jšœ%˜'Jšœœ
œ>˜NJšœ˜Jšœœ˜Jšœ
˜J˜—šž
œœœ
œ+œœ˜iJš
˜šžœœœ˜J˜—šžœœœ˜Jšœ˜—J˜%Jšœ	œ˜Jšœœœ
˜Jšœœœ˜MJš
œœ
œœ
œ
˜9J˜šœœ˜9Jšœœ	œ
œ˜/J˜Jšœœ!˜+J˜J˜0J˜KJ˜Jšœ
˜—J˜Jšœ
˜J˜—š
ž
œœœ
œ	œ˜6Jš
˜Jš	œœ
œœœ˜.Jš
œ˜Jšœ
˜J˜—šžœœœœ
œ
œ
˜+J˜—J˜šœœ˜Jšœ
œ
œœ˜EJ˜—š
žœœœ
œœ˜`Jš
˜J˜šœ?˜BJšœ˜Jš
œœ
œ%œœ
˜YJšœ
˜—J˜J˜J˜Jšœ
˜J˜—šžœœ'œ˜RJš
˜šœœ
˜!Jšœœ*˜6šœœœ
˜˜
šœ˜J˜J˜J˜Jšœ
˜——Jšœœ
˜-J˜'J˜#J˜/˜
J˜#Jšœœ
œ˜;J˜—J˜*Jš
œ˜Jšœ˜—Jšœ˜—šœ
˜J˜—J˜—Jšœœ˜J˜š
ž	œœœ
œœ˜-Jšœœ
œ ˜?Jšœ
œ!˜(J˜—šžœœœ
œœ
œ˜9Jšœœ
œ!˜@Jšœ
œ"˜)J˜—šž	œœœ
œ.œœœ
˜rJšœ˜Jšœ
œ	˜šžœœœ˜J˜—šžœœœ˜Jšœ˜—šžœœ˜"J˜6—šžœœ˜!J˜8J˜—J˜šœœ
˜!˜Jš
˜Jšœœœ
˜Jšœœœ
˜J˜J˜Jš
œ™J˜Jš
˜J˜Jšœœ
œ
œ˜+šœ*˜1šœœ
˜Jš	œœ
œœœ
˜7Jšœ
˜—J˜Jšœ
˜—š
˜Jšœ	œ
˜—Jšœ
˜Jš
œ.™.šœ	œ
œ˜.šœœ
˜&˜Jš
˜J˜+JšœŸ˜ JšœŸ˜"Jšœ
˜—Jš
œ ™ šœ
˜J˜———Jš
œ™š
˜J˜šœœ
˜˜Jš
˜šœ˜J˜%Jšœ
˜—Jšœ
˜Jšœ
˜—Jšœ/œ˜5Jšœœœ˜'Jšœœ
˜—Jšœ
˜—Jšœœœ
œ˜<Jšœœ˜
Jšœ
˜—˜šœœ
˜Jš
œ*™*J˜˜
Jš
˜J˜Jšœœ˜Jšœœ
˜
Jšœœ˜Jšœœœ
˜Jšœœ˜)J˜šœ3œ˜MJšœœ	œ
œ˜/J˜šœœ˜J˜*J˜Jšœœ˜$šœœœ
˜J˜0—J˜—Jšœ˜Jšœ
˜—J˜Jšœ
˜—˜	Jš
˜šœ˜%Jš
˜J˜Jšœœ
˜J˜5J˜šœ˜šœœ
˜#˜Jš
˜šœ˜Jšœ"œ
œ
˜0—˜˜šœ
œœ
˜Jšœ	œ˜)Jšœœ˜,———Jšœ
˜—Jšœœ˜.—Jšœ
˜—Jš
˜—š
˜Jš
˜Jšœœœ˜BJšœœ˜(Jšœœ˜1J˜Jšœ;œ˜UJšœ
˜—Jšœ
˜—˜Jš
˜Jš
œ˜šœœ
˜Jšœ	œ˜%Jšœ˜—š
˜Jš
˜Jšœ	œ˜$Jšœœ˜ šœœ˜Kšœœ
˜
K˜Kšœ&œ˜6šœœ˜Kš
œ˜K˜7Kšœ
œ	˜Kš
œ
˜
—Kšœ˜šœœ
˜&šœœœ
˜š
œ˜K˜Kšœ
œ
˜—Kšœ
˜—Jšœ
˜—Kš
œ
˜
—šœ˜K˜šœœ˜Kš
œ˜Kšœœ˜Kš
œ˜—šœœ
˜&šœœœ
˜šœ	œ%œ
˜6Kšœ
œ	˜—Kšœ
˜—Jšœ
˜—J˜Jšœ
œ˜&Kš
œ˜—Jšœ
˜—J˜Jš
œ8˜8Jšœœ
˜Jšœ
˜—˜Jš
˜Jšœœ˜"J˜J˜9J˜J˜J˜=Jšœ
˜—˜Jš
˜J˜Jšœ
œ˜&J˜J˜=Jšœ
˜—˜Jš
˜J˜šœ˜Jšœ˜šœœ
˜$Jšœ.œ˜EJ˜Jšœœ
˜—Jšœ
˜—šœ˜Jš
˜J˜J˜šœœ
˜%Jšœ.œ˜DJ˜Jšœœ
˜—Jšœ
˜—Jšœ
˜—˜Jš
˜J˜J˜šœ
˜Jšœ
œ˜%Jšœ˜—šœ
˜Jšœ
˜J˜Jšœœ
œ!˜?Jšœ˜Jšœ
˜—J˜!šœ(˜.˜Jšœœœ˜1——šœœ
˜!J˜=J˜Jšœ
˜—J˜Jš
˜J˜J˜Jšœ2˜5šœ˜J˜J˜J˜J˜Jšœ	œ&˜7J˜LJ˜J˜Jšœ
˜—J˜J˜Jšœ
˜Jšœ
˜—˜Jš
˜Jšœœ9˜RJ˜J˜:Jšœ
˜—˜Jš
˜J˜Jšœœ˜&Jšœœ˜"J˜Jšœ
œ˜(šœ
˜Jšœ
˜J˜Jšœœ!˜3Jšœ˜Jšœ
˜—J˜!šœ˜˜Jšœœœ˜1——J˜0J˜J˜=Jšœ
˜—˜Jš
˜Jšœœ
˜Jšœœ	˜Jšœœ	˜J˜šœœœ˜Jš
˜Jšœœœœ˜5J˜J˜J˜#J˜Jšœœ2˜<Jšœ:˜>Jšœ
˜J˜—J˜8J˜Jšœ
˜—šœœ
œ
˜J˜J˜Jšœ˜%—˜šœ
œ˜J˜
J˜&J˜——˜Jš
˜Jšœ
œœ˜9J˜9Jšœ
˜—J˜Jšœ˜——Jšœ
˜—Jšœ
˜J˜—šž
œœ/œœ˜OJš
˜šœœ
˜!Jšœœœ˜šœœœ
˜Jšœœ	œ˜$Jšœœœ˜—Jšœœœ˜—Jšœ
˜J˜—Jšœœ
œœ˜OJ˜šžœœ(œœ˜UK˜%K˜šœœ
˜Kšœœœ
˜šœœ	œ
˜ š
œ˜K˜K˜K˜K˜Kšœœ
œœ
˜-K˜Kšœœ
œœ
˜/K˜K˜Kšœœ
œœ
˜.K˜(šœœ
˜š
œ	˜	K˜)šœ
œ
˜Kšœœ˜'Kšœœœ
˜"—Kš
œ˜—Kšœœœ
˜"—Kš
œ˜—Kšœœœ
˜"—Kšœœœ
˜"—Kš
œ˜J˜—šžœœœ
œ˜4Jš
˜šœœœ
œ˜+˜9J˜——J˜ Jšœ
˜—Jšœœœ
œ
œ
œ
œ
˜-Jš	œ
œœ
œ
œ˜.J˜šžœœœ
œ7˜]Jš
˜J˜J˜J˜)Jšœœ
œ
˜!J˜J˜"Jšœ
˜—J˜šž
œœœ
œ9˜[Jš
˜šžœœœ˜J˜—šžœœœ˜Jšœ˜—šžœœ˜"J˜6—šžœœ˜!J˜8J˜—Jšœœ
œ
˜ šœ	œ
˜˜
Jš
˜J˜%šœ˜˜Jš
˜J˜šœœ
˜J˜RJšœ
˜—J˜Jšœ
˜—J˜DJ˜J˜˜Jš
˜J˜0JšœŸ˜J˜0Jšœ
˜—˜Jš
˜šœœœ
˜J˜J˜Jšœ
˜—J˜(J˜
Jšœ
˜—˜Jš
˜J˜Jšœœ˜7šœ˜J˜J˜J˜—Jšœ
˜—˜
Jš
˜J˜J˜Jšœœ*˜@J˜Jšœ
˜—˜Jš
œ™Jš
œ ™ Jš
œ
™
Jš
œ ™ Jš
œ
™
Jš
œ™—šœœœ˜/Jš
œ™š
œ%™%Jš
œ'™'Jš
œ™Jš
œ™—š
œ™Jš
œ6™6—Jš
œ™—˜	Jš
˜J˜J˜)Jšœ
˜—˜
Jš
˜J˜J˜šœœ
˜˜	˜%J˜——J˜'Jšœ˜"—J˜0šœœ
˜!Jšœœœ
˜"Jšœ˜—Jšœ
˜—Jšœ˜—Jšœ
˜—J˜J˜˜
Jš
˜šœ
œ
˜˜šœœ
˜ J˜,˜šœ˜˜Jš
˜Jšœ
œœ
˜šœ˜Jšœœ
œ˜2Jšœœ
œ˜6˜šœ
œ	œ˜Jšœ˜Jšœœ
˜——Jšœœ
˜—šœ
˜Jš
˜J˜Jšœœ
œ˜*J˜
Jšœ
˜—Jšœ
˜—Jšœ˜#——JšœŸ˜—Jšœ
Ÿ
œ˜*—Jšœ
˜——JšœŸ˜—Jšœ
˜J˜——˜Jšœ˜—J˜—…—Lšj