
    <<SymbolPackExt.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, June 13, 1986 4:17:19 pm PDT>>
        <<Rovner, September 19, 1983 10:29 pm>>
        <<Levin, September 22, 1983 10:58 am>>
    <<Russ Atkinson (RRA) January 31, 1985 1:23:07 pm PST>>

    DIRECTORY
        Alloc: TYPE USING [Handle, Index, Notifier, AddNotify, Bounds, DropNotify, Top, Words],
        ConvertUnsafe: TYPE USING [AppendSubString, EqualSubStrings, LS, SubString],
        Host: TYPE MachineParms USING [bitsPerChar, bitsPerWord],
        Symbols: TYPE USING [Base, ExtensionType, HashVector, HVIndex, HTRecord, HTIndex, Name, SERecord, ISEIndex, CSEIndex, ContextLevel, 
        CTXIndex, CTXRecord, MDIndex, BTIndex, nullName, HTNull, ISENull, CSENull, CTXNull, MDFirst, BTNull, lG, lL, lZ, typeANY, 
        typeTYPE, htType, ssType, seType, ctxType, mdType, bodyType],
        SymbolOps: TYPE USING [CtxEntries, CtxLevel, FindExtension, FirstCtxSe, HashValue, NextSe, ParentBti, SubStringForName, TypeForm, 
        XferMode, DecodeBti],
        SymbolPack: TYPE,
        SymbolSegment: TYPE USING [Base, ExtIndex, ExtRecord, ExtFirst, extType, ltType, stType, treeType],
        Tree: TYPE USING [Base, Link, Map, Null],
        UnsafeStorage: TYPE USING [GetSystemUZone];

    SymbolPackExt: PROGRAM
        IMPORTS Alloc, ConvertUnsafe, SymbolOps, own: SymbolPack, UnsafeStorage
        EXPORTS SymbolOps = {
        OPEN SymbolOps, Symbols;

        charsPerWord: NAT = Host.bitsPerWord/Host.bitsPerChar;
        SubString: TYPE = ConvertUnsafe.SubString;

    <<variables for building the symbol string>>

        ssw: Alloc.Index;

    <<tables defining the current symbol table>>

        table: Alloc.Handle;

        hashVec: LONG POINTER TO HashVector;

        htb: Symbols.Base;        -- hash table
        ssb: LONG STRING;        -- id string
        seb: Symbols.Base;        -- se table
        ctxb: Symbols.Base;        -- context table
        mdb: Symbols.Base;        -- module directory base
        bb: Symbols.Base;        -- body table
        extb: SymbolSegment.Base;    -- extension table

        UpdateBases: Alloc.Notifier = {
            <<called whenever the main symbol table is repacked>>
            own.hashVec _ hashVec;
            own.htb _ htb _ base[htType];
            own.ssb _ ssb _ LOOPHOLE[base[ssType], ConvertUnsafe.LS];
            own.seb _ seb _ base[seType];
            own.ctxb _ ctxb _ base[ctxType];  own.mdb _ mdb _ base[mdType];
            own.bb _ bb _ base[bodyType];
            own.tb _ base[SymbolSegment.treeType];
            own.ltb _ base[SymbolSegment.ltType];
            own.stb _ base[SymbolSegment.stType];
            own.extb _ extb _ base[SymbolSegment.extType];
            own.notifier[own]};


        initialized: BOOL _ FALSE;

        Initialize: PUBLIC PROC[ownTable: Alloc.Handle, scratchZone: UNCOUNTED ZONE] = { 
            <<called to set up the compiler's symbol table >>
            IF initialized THEN Finalize[];
            hashVec^ _ ALL[HTNull];
            own.notifier _ own.NullNotifier;
            own.mdLimit _ MDFirst;
            own.extLimit _ SymbolSegment.ExtFirst;
            own.mainCtx _ CTXNull;  own.stHandle _ NIL;  own.sourceFile _ NIL;
            table _ ownTable;  table.AddNotify[UpdateBases];
            ssw _ table.Words[ssType, TEXT[0].SIZE] + TEXT[0].SIZE;
            ssb^ _ StringBody[length: 0, maxlength: 0, text:];
            IF AllocateHash[] # nullName THEN ERROR;
            IF MakeNonCtxSe[SERecord.cons.nil.SIZE] # CSENull THEN ERROR;
            seb[CSENull] _ SERecord[mark3: FALSE, mark4: FALSE, body: cons[nil[]]];
            IF MakeNonCtxSe[SERecord.cons.mode.SIZE] # typeTYPE THEN ERROR;
            seb[typeTYPE] _ SERecord[mark3: TRUE, mark4: TRUE, body: cons[mode[]]];
            IF table.Words[ctxType, CTXRecord.nil.SIZE] # CTXNull THEN ERROR;
            ctxb[CTXNull] _ CTXRecord[FALSE, ISENull, lZ, nil[]];
            initialized _ TRUE};

        Reset: PUBLIC PROC = {
            nC: CARDINAL = (table.Bounds[ssType].size - TEXT[0].SIZE)*charsPerWord;
            desc: SubString;
            hvi: HVIndex;
            htLimit: HTIndex = table.Top[htType];
            ssw _ table.Top[ssType];
            ssb^ _ StringBody[length: htb[htLimit-HTRecord.SIZE].ssIndex, maxlength: nC, text:];
            hashVec^ _ ALL[HTNull];
            FOR hti: HTIndex _ HTNull+HTRecord.SIZE, hti+HTRecord.SIZE UNTIL hti = htLimit DO
                desc _ SubStringForName[hti];  hvi _ HashValue[desc];
                htb[hti].link _ hashVec[hvi];  hashVec[hvi] _ hti;
                htb[hti].anyInternal _ htb[hti].anyPublic _ FALSE;
                ENDLOOP;
            own.mdLimit _ table.Top[mdType];
            own.extLimit _ table.Top[SymbolSegment.extType]};

        Finalize: PUBLIC PROC = {
            table.DropNotify[UpdateBases];  table _ NIL;
            initialized _ FALSE};


    <<hash entry creation>>

        EnterString: PUBLIC PROC[s: SubString] RETURNS[name: Name] = {
            hvi: HVIndex = HashValue[s];
            desc: SubString;
            offset, length, nw: CARDINAL;
            ssi: Alloc.Index;
            FOR name _ hashVec[hvi], htb[name].link UNTIL name = nullName DO
                desc _ SubStringForName[name];
                IF ConvertUnsafe.EqualSubStrings[s, desc] THEN RETURN[name];
                ENDLOOP;
            offset _ ssb.length;  length _ s.length;
            nw _ (offset+length+(charsPerWord-1) - ssb.maxlength)/charsPerWord;
            IF nw # 0 THEN {
                IF (ssi _ table.Words[ssType, nw]) # ssw THEN ERROR;
                ssw _ ssw + nw;
                ssb^ _ StringBody[length: offset, maxlength: ssb.maxlength + nw*charsPerWord, text:]};
            ConvertUnsafe.AppendSubString[to: ssb, from: s];
            name _ AllocateHash[];  htb[name].link _ hashVec[hvi];  hashVec[hvi] _ name;
            RETURN};

        AllocateHash: PROC RETURNS[HTIndex] = {
            hti: HTIndex = table.Words[htType, HTRecord.SIZE];
            htb[hti] _ HTRecord[
                anyInternal: FALSE, anyPublic: FALSE,
                link: HTNull,
                ssIndex: ssb.length];
            RETURN[hti]};

        HashBlock: PUBLIC PROC RETURNS[LONG POINTER TO HashVector] = {
            RETURN[hashVec]};


    <<lexical level accounting>>

        StaticNestError: PUBLIC SIGNAL = CODE;

        NextLevel: PUBLIC PROC[cl: ContextLevel] RETURNS[nl: ContextLevel] = {
            IF cl+1 < ContextLevel.LAST THEN nl _ cl+1
            ELSE {SIGNAL StaticNestError; nl _ cl};
            RETURN};

        BlockLevel: PUBLIC PROC[cl: ContextLevel] RETURNS[nl: ContextLevel] = {
            RETURN[IF cl = lG THEN lL ELSE cl]};


    <<context table manipulation>>

        ctxLevelSplit: NAT = (ContextLevel.LAST+1)/2;

        Circular: PROC[ctx: CTXIndex] RETURNS[BOOL] = INLINE {
            RETURN[WITH c: ctxb[ctx] SELECT FROM included => ~c.reset, ENDCASE=> FALSE]};

        NewCtx: PUBLIC PROC[level: ContextLevel] RETURNS[ctx: CTXIndex] = {
            <<makes a non-include context entry>>
            ctx _ table.Words[ctxType, CTXRecord.simple.SIZE];
            ctxb[ctx] _ [
                level: level,
                varUpdated: FALSE,
                seList: ISENull,
                extension: simple[]];
            RETURN};

        SetMainCtx: PUBLIC PROC[ctx: CTXIndex] = {own.mainCtx _ ctx};

        SetCtxLevel: PUBLIC PROC[ctx: CTXIndex, level: ContextLevel] = {
            ctxb[ctx].level _ level};

        ResetCtxList: PUBLIC PROC[ctx: CTXIndex] = {
            <<change the list for ctx to a proper chain>>
            sei: ISEIndex = ctxb[ctx].seList;
            IF sei # ISENull THEN {ctxb[ctx].seList _ NextSe[sei]; SetSeLink[sei, ISENull]}};


        FirstVisibleSe: PUBLIC PROC[ctx: CTXIndex] RETURNS[sei: ISEIndex] = {
            sei _ ctxb[ctx].seList;
            WHILE sei # ISENull AND seb[sei].idCtx # ctx DO sei _ NextSe[sei] ENDLOOP;
            RETURN};

        NextVisibleSe: PUBLIC PROC[sei: ISEIndex] RETURNS[next: ISEIndex] = {
            IF (next _ sei) # ISENull THEN
                UNTIL (next _ NextSe[next]) = ISENull OR seb[next].idCtx = seb[sei].idCtx DO
                    NULL ENDLOOP;
            RETURN};

        VisibleCtxEntries: PUBLIC PROC[ctx: CTXIndex] RETURNS[n: CARDINAL _ 0] = {
            IF ctx = CTXNull OR Circular[ctx] THEN RETURN;
            FOR sei: ISEIndex _ FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
                IF seb[sei].idCtx = ctx THEN n _ n+1 ENDLOOP;
            RETURN};


        CtxVariant: PUBLIC PROC[ctx: CTXIndex] RETURNS[sei: ISEIndex] = {
            FOR sei _ FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO 
                IF TypeForm[seb[sei].idType] = union THEN RETURN ENDLOOP;
            RETURN[ISENull]};



    <<semantic entry creation>>

        MakeSeChain: PUBLIC PROC[ctx: CTXIndex, n: CARDINAL, linked: BOOL]
            RETURNS[seChain: ISEIndex] = {
            sei: ISEIndex;
            IF n = 0 THEN RETURN[ISENull];
            seChain _ table.Words[seType,
                (n-1)*SERecord.id.sequential.SIZE + 
                    (IF linked THEN SERecord.id.linked.SIZE ELSE SERecord.id.terminal.SIZE)];
            sei _ seChain;
            THROUGH [1..n) DO
                seb[sei] _ [mark3:FALSE, mark4:FALSE, body:id[,,ctx,,,,,,nullName,,sequential[]]];
                sei _ sei + SERecord.id.sequential.SIZE;
                ENDLOOP;
            IF linked THEN
                seb[sei] _ [mark3:FALSE, mark4:FALSE, body:id[,,ctx,,,,,,nullName,,linked[ISENull]]]
            ELSE seb[sei] _ [mark3:FALSE, mark4:FALSE, body:id[,,ctx,,,,,,nullName,,terminal[]]];
            RETURN};


        MakeCtxSe: PUBLIC PROC[name: Name, ctx: CTXIndex] RETURNS[sei: ISEIndex] = {
            next, pSei: ISEIndex;
            sei _ table.Words[seType, SERecord.id.linked.SIZE];
            SELECT TRUE FROM
                (ctx = CTXNull) => next _ ISENull;
                Circular[ctx] => {
                    pSei _ ctxb[ctx].seList;
                    IF pSei = ISENull THEN next _ sei
                    ELSE {next _ NextSe[pSei]; SetSeLink[pSei, sei]};
                    ctxb[ctx].seList _ sei};
                ENDCASE => {
                    pSei _ ctxb[ctx].seList;
                    IF pSei = ISENull THEN {next _ ISENull; ctxb[ctx].seList _ sei}
                    ELSE {
                        UNTIL (next _ NextSe[pSei]) = ISENull DO pSei _ next ENDLOOP;
                        SetSeLink[pSei, sei]}};
            seb[sei] _ [mark3:FALSE, mark4:FALSE, body:id[,,ctx,,,,,,name,,linked[link: next]]];
            RETURN};

        NameClash: PUBLIC SIGNAL [name: Name] = CODE;

        FillCtxSe: PUBLIC PROC[sei: ISEIndex, name: Name, public: BOOL] = {
            ctx: CTXIndex = seb[sei].idCtx;
            seb[sei].hash _ name;
            IF name # nullName THEN {
                IF htb[name].anyInternal AND ctx # CTXNull THEN
                    FOR pSei: ISEIndex _ FirstCtxSe[ctx], NextSe[pSei] UNTIL pSei = sei DO
                        IF seb[pSei].hash = name THEN {SIGNAL NameClash[name]; EXIT};
                        ENDLOOP;
                htb[name].anyInternal _ TRUE;
                IF public THEN htb[name].anyPublic _ TRUE}};

        EnterExtension: PUBLIC PROC[sei: ISEIndex, type: ExtensionType, tree: Tree.Link] = {
            OPEN SymbolSegment;
            exti: ExtIndex;
            extLimit: ExtIndex = own.extLimit;
            FOR exti _ ExtFirst, exti + ExtRecord.SIZE UNTIL exti = extLimit DO
                IF extb[exti].sei = sei THEN GO TO Update;
                REPEAT
                    Update => extb[exti] _ ExtRecord[sei:sei, type:type, tree:tree];
                    FINISHED =>
                        IF tree # Tree.Null THEN {
                            exti _ table.Words[extType, ExtRecord.SIZE];
                            own.extLimit _ own.extLimit + ExtRecord.SIZE;
                            extb[exti] _ ExtRecord[sei:sei, type:type, tree:tree]};
                ENDLOOP;
            seb[sei].extended _ TRUE};

        SetSeLink: PUBLIC PROC[sei, next: ISEIndex] = {
            WITH seb[sei] SELECT FROM linked => link _ next; ENDCASE => ERROR};


        MakeNonCtxSe: PUBLIC PROC[size: CARDINAL] RETURNS[sei: CSEIndex] = {
            sei _ table.Words[seType, size];
            seb[sei] _ [mark3: FALSE, mark4: FALSE, body: cons[typeInfo: ]];
            RETURN};


    <<copying within current table>>

        CopyBasicType: PUBLIC PROC[type: CSEIndex] RETURNS[copy: CSEIndex] = {
            WITH master: seb[type] SELECT FROM
                basic => {
                    copy _ MakeNonCtxSe[SERecord.cons.basic.SIZE];
                    seb[copy] _ SERecord[
                        mark3: master.mark3, mark4: master.mark4,
                        body: cons[basic[
                            code: master.code, ordered: master.ordered,
                            length: master.length]]]}
                ENDCASE => copy _ typeANY;
            RETURN};


        CopyXferType: PUBLIC PROC[type: CSEIndex, mapper: Tree.Map]
            RETURNS[copy: CSEIndex] = {
            WITH master: seb[type] SELECT FROM
                transfer => {
                    copy _ MakeNonCtxSe[SERecord.cons.transfer.SIZE];
                    seb[copy] _ SERecord[
                        mark3: master.mark3, mark4: master.mark4,
                        body: cons[transfer[
                            mode: master.mode, safe: master.safe,
                            typeIn: CopyArgs[master.typeIn, NIL],
                            typeOut: CopyArgs[master.typeOut, mapper]]]]};
                ENDCASE => copy _ typeANY;
            RETURN};

        CopyArgSe: PUBLIC PROC[copy, master: ISEIndex] = {CopyArg[copy, master, NIL]};


        CopyArgs: PROC[args: CSEIndex, mapper: Tree.Map] RETURNS[copy: CSEIndex] = {
            IF args = CSENull THEN copy _ CSENull
            ELSE
                WITH t: seb[args] SELECT FROM
                    record => {
                        ctx1: CTXIndex = t.fieldCtx;
                        ctx2: CTXIndex = NewCtx[CtxLevel[ctx1]];
                        seChain: ISEIndex = MakeSeChain[ctx2, CtxEntries[ctx1], FALSE];
                        sei1: ISEIndex _ ctxb[ctx1].seList;
                        sei2: ISEIndex _ ctxb[ctx2].seList _ seChain;
                        UNTIL sei1 = ISENull DO
                            CopyArg[sei2, sei1, mapper];
                            sei1 _ NextSe[sei1]; sei2 _ NextSe[sei2];
                            ENDLOOP;
                        copy _ MakeNonCtxSe[SERecord.cons.record.notLinked.SIZE];
                        seb[copy] _ SERecord[mark3: t.mark3, mark4: t.mark4,
                            body: cons[
                                record[
                                    machineDep: FALSE,
                                    painted: t.painted, argument: TRUE,
                                    hints: t.hints,
                                    fieldCtx: ctx2,
                                    length: t.length,
                                    monitored: FALSE,
                                    linkPart: notLinked[]]]]};
                    any => {
                        copy _ MakeNonCtxSe[SERecord.cons.any.SIZE];
                        seb[copy] _ SERecord[mark3: t.mark3, mark4: t.mark4,
                            body: cons[any[]]]};
                    ENDCASE => ERROR;
            RETURN};

        CopyArg: PROC[copy, master: ISEIndex, mapper: Tree.Map] = {
            seb[copy].hash _ seb[master].hash;
            seb[copy].public _ seb[master].public;
            seb[copy].immutable _ seb[master].immutable;
            seb[copy].constant _ seb[master].constant;
            seb[copy].idType _ seb[master].idType;
            seb[copy].idInfo _  seb[master].idInfo;
            seb[copy].idValue _ seb[master].idValue;
            seb[copy].linkSpace _ FALSE;
            seb[copy].mark3 _ seb[master].mark3; seb[copy].mark4 _ seb[master].mark4;
            IF mapper # NIL AND seb[master].extended THEN {
                type: ExtensionType;
                t: Tree.Link;
                [type, t] _ FindExtension[master];
                EnterExtension[copy, type, mapper[t]]}
            ELSE seb[copy].extended _ FALSE};


    <<body table utilities>>

        LinkBti: PUBLIC PROC[bti, parent: BTIndex] = {
            prev: BTIndex;
            IF parent # BTNull THEN {
                IF (prev _ bb[parent].firstSon) = BTNull THEN bb[parent].firstSon _ bti
                ELSE {
                    UNTIL bb[prev].link.which = parent DO prev _ bb[prev].link.index ENDLOOP;
                    bb[prev].link _ [which:sibling, index:bti]}};
            bb[bti].link _ [which:parent, index:parent]};

        DelinkBti: PUBLIC PROC[bti: BTIndex] = {
            prev, next: BTIndex;
            parent: BTIndex = ParentBti[bti];
            IF parent # BTNull THEN {
                prev _ bb[parent].firstSon;
                IF prev = bti THEN
                    bb[parent].firstSon _
                        IF bb[bti].link.which = parent THEN BTNull ELSE bb[bti].link.index
                ELSE {
                    UNTIL (next _ bb[prev].link.index) = bti DO prev _ next ENDLOOP;
                    bb[prev].link _ bb[next].link}};
            bb[bti].link _ [which:parent, index:BTNull]};


    <<attribute extraction>>

        ConstantId: PUBLIC PROC[sei: ISEIndex] RETURNS[BOOL] = {
            RETURN[IF ~seb[sei].constant
                THEN FALSE
                ELSE
                    SELECT XferMode[seb[sei].idType] FROM
                        proc, signal, error, program =>
                            seb[sei].mark4 AND SymbolOps.DecodeBti[seb[sei].idInfo] = BTNull,
                        ENDCASE => TRUE]
            };

    <<START HERE>>

        hashVec _ UnsafeStorage.GetSystemUZone[].NEW[HashVector _ ALL[HTNull]];

        }.

