
<<SortedSymbolListerImpl.mesa; modified by >>
    <<Sweet October 8, 1985 3:29:44 pm PDT>>
    <<Satterthwaite March 11, 1986 10:45:02 am PST>>
    <<Mike Spreitzer July 30, 1986 10:56:28 pm PDT>>

DIRECTORY
ConvertUnsafe: TYPE USING [SubString],
IO: TYPE USING [STREAM, Put, PutChar, PutF, PutRope, Reset, RopeFromROS, ROS],
ListerUtils: TYPE USING [PrintName, PrintSei],
Rope: TYPE USING [ROPE],
SortedSymbolLister: TYPE,
StructuredStreams: TYPE USING [Begin, Bp, Create, End],
Symbols: TYPE,
SymbolSegment: TYPE USING [STHeader],
SymbolTable: TYPE USING [Base],
Tree: TYPE USING [Index, Link, Node, Scan, Null],
UnparserBuffer: TYPE USING [Handle, Init, NewInittedHandle];

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

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, width, 2];
            $tbrk => StructuredStreams.Bp[st, united, 2];
            ENDCASE => ERROR;
        };


alwaysMD: BOOL _ FALSE;

VfTag: TYPE = {signed, unsigned, char, enum, array, transfer, ref, real, 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
real => [],
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] = {
ros: IO.STREAM _ IO.ROS[];
upb: UnparserBuffer.Handle;
strc: IO.STREAM;
modname: ROPE; 
mySei, sei: ISEIndex;
stHandle: LONG POINTER TO SymbolSegment.STHeader = stb.stHandle;
ros.PutRope[": --"]; -- set up modname
FOR sei _ stb.FirstCtxSe[stHandle.directoryCtx], stb.NextSe[sei] UNTIL sei = ISENull DO 
mySei _ sei; 
ENDLOOP;
ListerUtils.PrintSei[mySei, ros, stb];
ros.PutRope["--"];
modname _ ros.RopeFromROS[FALSE];
upb _ UnparserBuffer.NewInittedHandle[[output: [stream[ros]]]];
strc _ StructuredStreams.Create[upb];
FOR sei _ stb.FirstCtxSe[stHandle.outerCtx], stb.NextSe[sei] UNTIL sei = ISENull DO
ros.Reset[];
upb.Init[];
DoControl[strc, $begin];
PrintSym[strc, stb, sei, modname, TRUE]; strc.Put[[character[';]]];
DoControl[strc, $end];
rList _ CONS[ros.RopeFromROS[FALSE], rList]; 
ENDLOOP;
RETURN[rList]};

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

PrintSym: PROC[
  st: IO.STREAM, stb: SymbolTableBase, sei: ISEIndex,
  colonstring: ROPE, defaultPublic: BOOL] = {
PrintSei: PROC[val: ISEIndex] = {
ListerUtils.PrintSei[sei: val, stream: st, stb: stb]};
PutRope: PROC[val: ROPE] = {
st.PutRope[val]};
typeSei: SEIndex;
vf: ValFormat;
hti: HTIndex;
<<check for wierd inserted symbols>>
hti _ stb.seb[sei].hash;
IF FirstChar[stb, hti] = '& THEN RETURN;
DoControl[st, $begin];
IF hti # HTNull THEN {PrintSei[sei]; PutRope[colonstring]};
IF stb.seb[sei].public # defaultPublic THEN {
defaultPublic _ stb.seb[sei].public;
PutRope[IF defaultPublic THEN "PUBLIC " ELSE "PRIVATE "]};
IF stb.seb[sei].idType = typeTYPE THEN {
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]}
ELSE {
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)
<<it's not a proc, signal, error, program, or port>>
THEN PutRope["READONLY "];
vf _ PrintType[st, stb, typeSei, NoSub, defaultPublic];
IF stb.seb[sei].constant AND vf.tag <= enum THEN {
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]}
};
DoControl[st, $end]};

PrintTypedVal: PROC[st: IO.STREAM, stb: SymbolTableBase, val: UNSPECIFIED, vf: ValFormat] =
{
PutCharConst: PROC[val: CARDINAL] = {st.PutF["%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 st.PutRope["NIL"] ELSE loophole _ TRUE;
ENDCASE => loophole _ TRUE;
IF loophole THEN {
st.PutRope["LOOPHOLE ["];
PutUnsigned[st, LONG[LOOPHOLE[val, CARDINAL]]];
st.Put[[character[']]]]};
};

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

PrintFieldCtx: PROC[st: IO.STREAM, stb: SymbolTableBase, ctx: CTXIndex, md: BOOL, defaultPublic: BOOL] = {
PutChar: PROC[val: CHAR] = {
st.Put[[character[val]]]};
PutRope: PROC[val: ROPE] = {
st.PutRope[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 { PutRope["NULL"]; RETURN };
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[']]};

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

NoSub: PROC[ptr: BOOL] = { };


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

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

GetValFormat: PROC[stb: SymbolTableBase, tsei: SEIndex] RETURNS[vf: ValFormat] = {
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];
real => vf _ [,real[]];
ref => vf _ [,ref[]];
ENDCASE => vf _ [,other[]];
ENDCASE => vf _ [,other[]];
};


octalThreshold: NAT _ 1024;

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

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

PrintType: PROC[
    st: IO.STREAM, stb: SymbolTableBase, tsei: SEIndex,
    dosub: PROC[ptr: BOOL], defaultPublic: BOOL]
  RETURNS[vf: ValFormat] = {
PutChar: PROC[val: CHAR] = {
st.Put[[character[val]]]};
PutRope: PROC[val: ROPE] = {
st.PutRope[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 => {
printBase: BOOL _ TRUE;
multiSubrange: BOOL _ FALSE;
bsei: SEIndex _ tsei;
csei: CSEIndex;
<<print adjectives, if any>>
tseiNext: SEIndex;
{
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 => { PrintSei[LOOPHOLE[tsei]]; PutChar[' ]; };
ENDCASE;
tsei _ tseiNext;
ENDLOOP;
EXITS
noAdj => NULL;
};
<<print module qualification of last ID in chain>>
IF t.idCtx NOT IN Symbols.StandardContext THEN
WITH c~~stb.ctxb [t.idCtx] SELECT FROM
included => {
hti: HTIndex = stb.mdb [c.module].moduleId;
PrintHti [hti]; --interface name
PutChar ['.]}; -- dot qualification
<<simple => PutCurrentModuleDot[];>>
ENDCASE;

<<finally print that last ID>>
DO
csei _ stb.UnderType[bsei];
WITH stb.seb[csei] SELECT FROM
basic => {
SELECT code FROM
codeINT => printBase _ multiSubrange;
ENDCASE;
EXIT};
subrange => {bsei _ rangeType; multiSubrange _ TRUE};
enumerated => {printBase _ TRUE; EXIT};
ENDCASE => EXIT;
ENDLOOP;
IF printBase OR dosub = NoSub THEN PrintSei[LOOPHOLE[tsei]];
dosub[FALSE]};
cons =>
WITH t SELECT FROM
<<basic =>  won't see one, see the id first.>>

enumerated => {
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['}]};
record => {
IF stb.ctxb[fieldCtx].level # lZ THEN {
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 => {
IF entry.localCtx = fctx THEN {PrintSei[entry.id]; PutChar[']]; EXIT};
bti _
bti +
(WITH entry SELECT FROM
Inner => BodyRecord.Callable.Inner.SIZE,
ENDCASE => BodyRecord.Callable.Outer.SIZE);
};
ENDCASE => bti _ bti + BodyRecord.Other.SIZE;
ENDLOOP;
}
ELSE {
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];
};
};
ref => {
referent: SEIndex = refType;
IF var THEN PutRope[IF readOnly THEN "READONLY " ELSE "VAR "]
ELSE {
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 "]};
};
DoControl[st, $brk];
[] _ PrintType[st, stb, referent, NoSub, defaultPublic];
EXITS noprint => NULL;
};
array => {
IF packed THEN PutRope["PACKED "];
PutRope["ARRAY "];
[] _ PrintType[st, stb, indexType, NoSub, defaultPublic];
PutRope[" OF "];
DoControl[st, $brk];
[] _ PrintType[st, stb, componentType, NoSub, defaultPublic]};
arraydesc => {
PutRope["DESCRIPTOR FOR "];
IF readOnly THEN PutRope["READONLY "];
DoControl[st, $brk];
[] _ PrintType[st, stb, describedType, NoSub, defaultPublic]};
transfer => {
PutModeName[st, mode];
IF typeIn # CSENull THEN {
PutChar[' ]; 
WITH tt~~stb.seb[typeIn] SELECT FROM
record => PrintFieldCtx[st, stb, tt.fieldCtx, FALSE, defaultPublic]; 
any => PutRope["ANY"];
ENDCASE => ERROR;
};
IF typeOut # CSENull THEN {
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;
};
};
union => {
tagType: SEIndex;
PutRope["SELECT "];
IF ~controlled THEN
PutRope[IF overlaid THEN "OVERLAID " ELSE "COMPUTED "]
ELSE  { 
PrintSei[tagSei]; 
PutRope[IF machineDep OR alwaysMD THEN GetBitSpec[stb, tagSei] ELSE ": "]};
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 "];
{
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"];
};
};
relative => {
IF baseType # SENull THEN [] _ PrintType[st, stb, baseType, NoSub, defaultPublic];
PutRope[" RELATIVE "];
[] _ PrintType[st, stb, offsetType, dosub, defaultPublic]};
sequence => {
tagType: SEIndex;
pubTag: BOOL _ stb.seb[tagSei].public;
IF packed THEN PutRope["PACKED "];
PutRope["SEQUENCE "];
IF ~controlled THEN PutRope["COMPUTED "]
ELSE  { 
PrintSei[tagSei]; 
PutRope[IF machineDep THEN GetBitSpec[stb, tagSei] ELSE ": "]};
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]};
subrange => {
org: INTEGER _ origin;
size: CARDINAL _ range;
mt: BOOL _ empty;

doit: PROC[ptr: BOOL] = {
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[']]}};

[] _ PrintType[st, stb, rangeType, doit, defaultPublic];
vf.bias _ org};
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 => {
IF NOT IsVarOrRef [rangeType, stb] THEN PutRope["LONG "];
[] _ PrintType[st, stb, rangeType, NoSub, defaultPublic]};
real => PutRope["REAL"];
ENDCASE => PutRope["xxxx"];
ENDCASE;
};

IsVarOrRef: PROC[tsei: Symbols.SEIndex, stb: SymbolTableBase] RETURNS[BOOL] = {
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];
};

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

    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] = {
ModePrintName: ARRAY TransferMode OF ROPE =
["PROC", "PORT", "SIGNAL", "ERROR", "PROCESS", "PROGRAM",
"NONE"];
st.PutRope[ModePrintName[n]]};
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] = {
extType: ExtensionType;
tree: Tree.Link;
[extType, tree] _ stb.FindExtension[sei];
IF extType # default THEN RETURN;
st.PutRope[" _ "];
WITH tree SELECT FROM
subtree => IF stb.tb[index].name = list AND  stb.tb[index].nSons = 2 THEN {
PrintTreeLink[st, stb, stb.tb[index].son[1], vf];
st.PutChar['|];
PrintTreeLink[st, stb, stb.tb[index].son[2], vf];
RETURN};
ENDCASE ;
PrintTreeLink [st, stb, tree, vf]};

    endIndex: Tree.Index = Tree.Index.LAST;
    endMark: Tree.Link = [subtree[index: endIndex]];

ScanList: PROC[tb: Symbols.Base, root: Tree.Link, action: Tree.Scan] = {
    IF root # Tree.Null THEN
        WITH root SELECT FROM
            subtree => {
                node: Tree.Index = index;
                i, n: CARDINAL;
                t: Tree.Link;
                IF tb[node].name # $list THEN action[root]
                ELSE IF (n _ tb[node].nSons) # 0 THEN
                    FOR i _ 1, i+1 WHILE i <= n DO action[tb[node].son[i]] ENDLOOP
                ELSE
                    FOR i _ 1, i+1 UNTIL (t_tb[node].son[i]) = endMark DO action[t] ENDLOOP};
            ENDCASE => action[root]};

LiteralValue: PROC[stb: SymbolTableBase, tree: Tree.Link] RETURNS[CARDINAL] = {
WITH t~~tree SELECT FROM
literal => WITH lr~~t.index SELECT FROM
word => WITH stb.ltb[lr.lti] SELECT FROM
short => RETURN[value];
ENDCASE;
ENDCASE;
ENDCASE;
RETURN[0]};


PrintTreeLink: PROC[st: IO.STREAM, stb: SymbolTableBase, tree: Tree.Link, vf: ValFormat] = {
PutChar: PROC[val: CHAR] = {
st.PutChar[val]};
PutRope: PROC[val: ROPE] = {
st.PutRope[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 => {
node: NodePointer = @stb.tb[t.index];
SELECT node.name FROM
all => {
PutRope["ALL["];
WITH v~~vf SELECT FROM
array => PrintTreeLink[st, stb, node.son [1], GetValFormat[stb, v.componentType]];
ENDCASE;
PutChar[']]};
atom => {
PutChar['$];
PrintTreeLink[st, stb, node.son [1], vf]};
clit => {
ch: CHAR _ VAL[LiteralValue[stb, node.son[1]]];
PutChar[''];
PutChar[ch]};
mwconst, cast, loophole => PrintTreeLink[st, stb, node.son [1], vf];
nil => PutRope["NIL"];
void => PutRope["TRASH"];
dot, cdot => {
PrintTreeLink[st, stb, node.son[1], [,other[]]];
PutChar ['.]; --dot
PrintTreeLink[st, stb, node.son[2], [,other[]]]};
first, last, size => {
PutRope[SELECT node.name FROM 
first => "FIRST[", 
last => "LAST[", 
ENDCASE => "SIZE["];
PrintTreeLink[st, stb, node.son[1], vf];
PutChar [']]};
lengthen => {
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 [']]};
};
construct => {
s1: Tree.Link = node.son[1];
PutChar['[];
IF node.nSons = 2 THEN PrintTreeLink [st, stb, node.son[2], vf];
PutChar[']]};
union => {
PrintTreeLink [st, stb, node.son[1], vf];
PutChar ['[];
PrintTreeLink [st, stb, node.son[2], vf];
PutChar [']]};
list => {
first: BOOL _ TRUE;
PrintOne: Tree.Scan = {
IF first THEN first _ FALSE ELSE PutRope[", "];
PrintTreeLink [st, stb, t, [,other[]]]};
ScanList[stb.tb, tree, PrintOne]};
longTC => {
PutRope["LONG "];
PrintTreeLink [st, stb, node.son[1], vf]};
callx => {
PrintTreeLink [st, stb, node.son[1], vf];
PutChar ['[];
PrintTreeLink [st, stb, node.son[2], vf];
PutChar [']]};
uparrow => {
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['^];
};
ENDCASE => PutRope["xxxx"];
};
hash => PrintHti [t.index];
symbol => PrintSei [t.index];
literal => {
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 => {
loophole: BOOL _ FALSE;
SELECT vf.tag FROM
signed => {
li: INT = LOOPHOLE [@value, LUP]^;
    SELECT li FROM
        INT.FIRST => PutRope["FIRST[INT]"];
        INT.LAST => PutRope["LAST[INT]"];
        ENDCASE => PutSigned[st, li];
};
unsigned => {
lu: LONG CARDINAL = LOOPHOLE [@value, LUP]^;
    SELECT lu FROM
        LAST[LONG CARDINAL] => PutRope["LAST[LONG CARDINAL]"];
        ENDCASE => PutUnsigned[st, lu];
};
real => st.Put[[real[LOOPHOLE [@value, LUP]^]]];
transfer, ref =>
IF LOOPHOLE[@value, LUP]^ = 0
THEN PutRope["NIL"]
ELSE loophole _ TRUE;
ENDCASE => loophole _ TRUE;
IF loophole THEN {
PutRope["LOOPHOLE ["];
PutUnsigned [st, LOOPHOLE [@value, LUP]^];
PutChar [']]};
};
ENDCASE => PutRope["--constant--"];
ENDCASE; --shouldn't happen! 
ENDCASE --string-- => PutRope["(STRING)"];
};
ENDCASE; --shouldn't happen!
};


END.