<<>>
<<SortedSymbolListerImpl.mesa; modified by >>
<<Copyright Ó 1991 by Xerox Corporation.  All rights reserved.>>
    <<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>>
    <<Andy Litman March 3, 1988 3:27:57 pm PST>>
    <<JKF February 27, 1990 1:10:52 pm PST>>
    <<Michael Plass, November 26, 1991 4:36 pm PST>>

    DIRECTORY
        ConvertUnsafe USING [SubString],
        IO,
        MobListerUtils USING [PrintName, PrintSei],
        OSMiscOps USING [bytesPerUnit],
        Rope USING [ROPE],
        SortedSymbolLister USING [],
        StructuredStreams USING [Begin, Bp, Create, End],
        SymbolOps USING [DecodeCard, DecodeType, FindExtension, FirstCtxSe, LinkMode, NextSe, NormalType, RecField, SubStringForName, 
        ToType, TypeLink, UnderType, XferMode],
        Symbols USING [Base, BitAddress, BodyRecord, BTIndex, codeANY, codeCHAR, CSEIndex, CSENull, CTXIndex, CTXNull, ExtensionType, 
        FirstStandardCtx, HTIndex, HTNull, ISEIndex, ISENull, LastStandardCtx, lZ, RecordSEIndex, SEIndex, SENull, SERecord, 
        TransferMode, typeANY, typeTYPE],
        SymbolSegment USING [Base, STHeader],
        SymbolTable USING [SymbolTableBaseRep],
        SymbolTablePrivate USING [SymbolTableBase, SymbolTableBaseRep],
        Tree USING [Base, Index, Link, Node, Null, Scan],
        TreeOps USING [GetTag],
        UnparserBuffer USING [Handle, Init, NewInittedHandle];

    SortedSymbolListerImpl: PROGRAM
        IMPORTS IO, MobListerUtils, StructuredStreams, UnparserBuffer, SymbolOps, TreeOps
        EXPORTS SortedSymbolLister, SymbolTable =
        BEGIN OPEN Symbols;

        bitsPerByte: CARD = 8;
        bitsPerUnit: CARD = OSMiscOps.bytesPerUnit*bitsPerByte;

        STREAM: TYPE = IO.STREAM;
        SymbolTableBase: TYPE = REF SymbolTableBaseRep;
        SymbolTableBaseRep: PUBLIC TYPE = SymbolTablePrivate.SymbolTableBaseRep;
        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
            ];

        PrintInterface: PUBLIC PROC[st: STREAM, stb: SymbolTableBase] = {
            sei: ISEIndex;
            stHandle: LONG POINTER TO SymbolSegment.STHeader = stb.stHandle;
            st.PutRope[" -- Item # -- Item Name\n"];
            FOR sei Ź SymbolOps.FirstCtxSe[stb, stHandle.outerCtx], SymbolOps.NextSe[stb, sei] UNTIL sei = ISENull DO
                SELECT SymbolOps.LinkMode[stb, sei] FROM
                    val => {
                        PutValue[st, stb, sei];
                        st.PutRope[ModePrintName[SymbolOps.XferMode[stb, stb.seb[sei].idType]]];
                        st.PutRope["\n"];
                        };
                    ref => {
                        PutValue[st, stb, sei];
                        st.PutRope["EXPORTED Variable"];
                        st.PutRope["\n"];
                        };
                    manifest => NULL; -- constant
                    ENDCASE;
                ENDLOOP;
            };

        PutValue: PROCEDURE [st: STREAM, stb: SymbolTableBase, sei: Symbols.ISEIndex] = {
            idValue: CARD Ź SymbolOps.DecodeCard[stb.seb[sei].idValue];
            st.PutRope[" -- "];
            IF stb.seb[sei].extended THEN st.PutRope["(INLINE?) "];
            PutUnsigned[st, idValue];
            st.PutRope[" -- "];
            MobListerUtils.PrintSei[sei: sei, stream: st, stb: stb];
            st.PutRope[": "];
            };

        ModePrintName: ARRAY Symbols.TransferMode OF Rope.ROPE =
            ["PROCEDURE", "PORT", "SIGNAL", "ERROR", "PROCESS", "PROGRAM", "OTHER", "NONE"];

        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 Ź SymbolOps.FirstCtxSe[stb, stHandle.directoryCtx], SymbolOps.NextSe[stb, sei] UNTIL sei = ISENull DO 
                mySei Ź sei; 
                ENDLOOP;
            MobListerUtils.PrintSei[mySei, ros, stb];
            ros.PutRope["--"];
            modname Ź ros.RopeFromROS[FALSE];
            upb Ź UnparserBuffer.NewInittedHandle[[output: [stream[ros]]]];
            strc Ź StructuredStreams.Create[upb];
            FOR sei Ź SymbolOps.FirstCtxSe[stb, stHandle.outerCtx], SymbolOps.NextSe[stb, sei] UNTIL sei = ISENull DO
                ros.Reset[];
                upb.Init[];
                DoControl[strc, $begin];
                PrintSym[strc, stb, sei, modname, TRUE]; strc.PutChar[';];
                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 Ź SymbolOps.SubStringForName[stb, 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] = {
                MobListerUtils.PrintSei[sei: val, stream: st, stb: stb]};
            PutRope: PROC[val: ROPE] = {
                st.PutRope[val]};
            typeSei: SEIndex;
            vf: ValFormat;
            hti: HTIndex;
        <<check for weird 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 Ź SymbolOps.DecodeType[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 SymbolOps.XferMode[stb, 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, SymbolOps.FindExtension[stb, sei].tree, vf]
                    ELSE PrintTypedVal[st, stb, SymbolOps.DecodeCard[stb.seb[sei].idValue], vf]}
                };
            DoControl[st, $end]};

        PrintTypedVal: PROC[st: IO.STREAM, stb: SymbolTableBase, val: LONG UNSPECIFIED, vf: ValFormat] =
            {
            PutCharConst: PROC[val: CARDINAL] = {st.PutF1["%bC", [cardinal[val]]]};
            loophole: BOOL Ź FALSE; 
            val Ź val + vf.bias;
            WITH vf SELECT FROM
                signed => PutSigned[st, LOOPHOLE[val, INT]];
                unsigned => PutUnsigned[st, LOOPHOLE[val, CARD]];
                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, LOOPHOLE[val, CARD]];
                st.Put1[[character[']]]]};
            };

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

        PrintFieldCtx: PROC[st: IO.STREAM, stb: SymbolTableBase, ctx: CTXIndex, md: BOOL, defaultPublic: BOOL] = {
            PutChar: PROC[val: CHAR] = {
                st.Put1[[character[val]]]};
            PutRope: PROC[val: ROPE] = {
                st.PutRope[val]};
            isei: ISEIndex Ź SymbolOps.FirstCtxSe[stb, ctx];
            bitspec: ROPE Ź ": ";
            first: BOOL Ź TRUE;
            IF isei # ISENull AND stb.seb[isei].idCtx # ctx THEN isei Ź SymbolOps.NextSe[stb, isei];
            IF isei = ISENull THEN { PutRope["NULL"]; RETURN };
            PutChar['[];
            FOR isei Ź isei, SymbolOps.NextSe[stb, 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: LONG UNSPECIFIED] = {
            lc: LONG CARDINAL Ź LOOPHOLE[value];
            PutUnsigned[st, lc]};

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


        EnumeratedSEIndex: TYPE = 
            Symbols.Base RELATIVE LONG POINTER TO SERecord.cons.enumerated;

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

        GetValFormat: PROC[stb: SymbolTableBase, tsei: SEIndex] RETURNS[vf: ValFormat] = {
            WITH t~~stb.seb[tsei] SELECT FROM
                id => RETURN[GetValFormat[stb, SymbolOps.UnderType[stb, tsei]]];
                cons => WITH t SELECT FROM
                    basic =>  
                        SELECT code FROM
                            codeANY => vf Ź [,unsigned[]];
                            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};
                    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.PutF1["%bB", [integer[val]]]
            ELSE st.PutF1["%d", [integer[val]]]};

        PutUnsigned: PROC[st: IO.STREAM, val: LONG CARDINAL] = {
            IF val > octalThreshold THEN st.PutF1["%bB", [cardinal[val]]]
            ELSE st.PutF1["%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.Put1[[character[val]]]};
            PutRope: PROC[val: ROPE] = {
                st.PutRope[val]};
            PrintSei: PROC[val: ISEIndex] = {
                MobListerUtils.PrintSei[sei: val, stream: st, stb: stb]};
            PrintHti: PROC[val: HTIndex] = {
                MobListerUtils.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 = SymbolOps.DecodeType[t.idInfo];
                    IF stb.seb[l1].seTag = id THEN GO TO noAdj;
                    UNTIL (tseiNext Ź SymbolOps.TypeLink[stb, 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.FirstStandardCtx..Symbols.LastStandardCtx] 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 Ź SymbolOps.UnderType[stb, 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 Ź SymbolOps.FirstCtxSe[stb, valueCtx], SymbolOps.NextSe[stb, 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 Ź SymbolOps.DecodeCard[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 + BodyRecord.Callable.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 Ź SymbolOps.FirstCtxSe[stb, caseCtx], SymbolOps.NextSe[stb, isei] 
                            UNTIL isei = ISENull DO
                                DoControl[st, $tbrk];
                                DoControl[st, $begin];
                                PrintSei[isei];
                                PutRope[" => "];
                                varRec Ź LOOPHOLE[SymbolOps.UnderType[stb, SymbolOps.DecodeType[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/bitsPerUnit]; 
                                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 LONG POINTER 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 Ź SymbolOps.FirstCtxSe[stb, ctx];
                        IF first = ISENull THEN RETURN[FALSE, SENull];
                        element Ź seb[first].idType;
                        rest Ź SymbolOps.NextSe[stb, first];
                        IF rest = ISENull THEN RETURN[FALSE, SENull];
                        restp Ź SymbolOps.UnderType[stb, seb[rest].idType];
                        WITH seb[restp] SELECT FROM
                            ref => RETURN[refType = rft, element];
                            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",
                    "OTHER", "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] Ź SymbolOps.FindExtension[stb, sei];
            IF extType # default THEN RETURN;
            st.PutRope[" _ "];
            WITH tree SELECT TreeOps.GetTag[tree] 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 TreeOps.GetTag[root] 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[CARD] = {
            WITH t~~tree SELECT TreeOps.GetTag[tree] FROM
                literal => WITH lr~~stb.ltb[t.index] SELECT FROM
                    short => RETURN[SymbolOps.DecodeCard[lr.value]];
                    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] = {
                MobListerUtils.PrintSei[sei: val, stream: st, stb: stb]};
            PrintHti: PROC[val: HTIndex] = {
                MobListerUtils.PrintName[name: val, stream: st, stb: stb]};

            IF tree = Tree.Null THEN RETURN;
            WITH t~~tree SELECT TreeOps.GetTag[tree] 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[CARDINAL[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 TreeOps.GetTag[s1] = 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 TreeOps.GetTag[ptr] FROM
                                symbol =>
                                    type Ź SymbolOps.NormalType[stb, SymbolOps.UnderType[stb, 
                                        stb.seb[p.index].idType]];
                                subtree => type Ź LOOPHOLE[SymbolOps.ToType[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];
                string => PutRope["(STRING)"];
                literal => {
                    WITH stb.ltb[t.index] SELECT FROM
                        short => PrintTypedVal [st, stb, SymbolOps.DecodeCard[value], vf];
                        long =>
                            SELECT bits FROM
                                2*bitsPerUnit => {
                                    loophole: BOOL Ź FALSE;
                                    SELECT vf.tag FROM
                                        signed => {
                                        <<li: INT = LOOPHOLE [@value, LUP]^;>>
                                            li: INT = LOOPHOLE[value[0]];
                                            SELECT li FROM
                                                INT.FIRST => PutRope["FIRST[INT]"];
                                                INT.LAST => PutRope["LAST[INT]"];
                                                ENDCASE => PutSigned[st, li];
                                            };
                                        unsigned => {
                                        <<lu: LONG CARDINAL = LOOPHOLE [@value, LUP]^;>>
                                            lu: LONG CARDINAL = LOOPHOLE [value[0]];
                                            SELECT lu FROM
                                                LAST[LONG CARDINAL] => PutRope["LAST[LONG CARDINAL]"];
                                                ENDCASE => PutUnsigned[st, lu];
                                            };
                                        real => st.Put1[[real[LOOPHOLE [value[0]]]]];
                                        transfer, ref =>
                                            IF LOOPHOLE[value[0], LONG UNSPECIFIED] = 0
                                                THEN PutRope["NIL"]
                                                ELSE loophole Ź TRUE;
                                        ENDCASE => loophole Ź TRUE;
                                    IF loophole THEN {
                                        PutRope["LOOPHOLE ["];
                                        PutUnsigned [st, LOOPHOLE [value[0]]];
                                        PutChar [']]};
                                    };
                                ENDCASE => PutRope["--constant--"];
                        ENDCASE; --shouldn't happen! 
                    };
                ENDCASE; --shouldn't happen!
            };


        END.