
    <<SymLiteralPack.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, May 1, 1986 11:52:26 am PDT>>
        <<Maxwell, July 28, 1983 10:21 am>>
        <<Russ Atkinson (RRA) March 7, 1985 4:46:52 am PST>>

    DIRECTORY
        Alloc: TYPE USING [Handle, Notifier, AddNotify, DropNotify, Top, Words],
        ComData: TYPE USING [idINT, interface, mainCtx, ownSymbols, switches, typeATOM, typeRefANY],
        ConvertUnsafe: TYPE USING [SubString],
        Literals: TYPE USING [STIndex],
        LiteralOps: TYPE USING [Find],
        RTBcd: TYPE USING [RefLitIndex, TypeIndex],
        Symbols: TYPE USING [Base, SERecord, Name, Type, ISEIndex, CSEIndex, CTXIndex, MDIndex, BitAddress, nullType, ISENull, CTXNull, 
        StandardContext, lZ, OwnMdi, MDNull, typeANY, ctxType, seType],
        SymbolOps: TYPE USING [ClusterSe, CtxLevel, EnterString, FirstCtxSe, MakeCtxSe, MakeNonCtxSe, NextSe, TypeForm, UnderType],
        SymbolSegment: TYPE USING [atType],
        SymLiteralOps: TYPE USING [RefLitItem],
        Table: TYPE USING [Base, Limit, Selector],
        Tree: TYPE USING [Link, NullIndex],
        TreeOps: TYPE USING [PopTree, PushLit, PushNode, PushSe, SetAttr, SetInfo],
        Types: TYPE USING [Equivalent];

    SymLiteralPack: PROGRAM
        IMPORTS Alloc, LiteralOps, SymbolOps, TreeOps, Types, dataPtr: ComData
        EXPORTS SymLiteralOps = {
        OPEN Symbols;

        RefLitItem: TYPE = SymLiteralOps.RefLitItem;

    <<types>>

        SymLitRecord: TYPE = RECORD [
            SELECT tag: * FROM
                type => [canonical: BOOL, typeCode: Type],
                lit => [info: RefLitItem]
                ENDCASE];

        SymLitIndex: TYPE = Table.Base RELATIVE ORDERED POINTER[0..Table.Limit) TO SymLitRecord;

    <<bases>>

        table: Alloc.Handle;

        atType: Table.Selector = SymbolSegment.atType;
        slb: Table.Base;
        seb: Symbols.Base;
        ctxb: Symbols.Base;

        UpdateBases: Alloc.Notifier = {
            seb _ base[seType]; ctxb _ base[ctxType];
            slb _ base[atType]; seb _ base[seType]};


    <<auxiliary type predicates>>

        Matched: SIGNAL[m1, m2: Type] RETURNS[BOOL] = CODE;

        NameEqual: PROC[key, entry: Type] RETURNS[BOOL] = {
            RETURN[(key = entry) OR Isomorphic[key, entry ! Matched => {RESUME [FALSE]}]]};

        Isomorphic: PROC[key, entry: Type] RETURNS[BOOL] = {
            RETURN[WITH type1: seb[key] SELECT FROM
                id => (SymbolOps.ClusterSe[key] = SymbolOps.ClusterSe[entry]),
                cons =>
                    WITH type2: seb[entry] SELECT FROM
                        cons =>
                            WITH t1: type1 SELECT FROM
                                record =>
                                    WITH t2: type2 SELECT FROM
                                        record =>
                                            (t1.fieldCtx = t2.fieldCtx) OR
                                                (~t1.painted AND ~t2.painted AND (
                                                    (SIGNAL Matched[key, entry])
                                                        OR
                                                        IsoFields[t1.fieldCtx, t2.fieldCtx
                                                            ! Matched => {IF m1=key AND m2=entry THEN RESUME [TRUE]}])),
                                        ENDCASE => FALSE,
                                ref =>
                                    WITH t2: type2 SELECT FROM
                                        ref =>
                                            (t1.counted = t2.counted) AND (t1.ordered = t2.ordered) AND
                                                (t1.readOnly = t2.readOnly) AND Isomorphic[t1.refType, t2.refType],
                                        ENDCASE => FALSE,
                                long =>
                                    WITH t2: type2 SELECT FROM
                                        long => Isomorphic[t1.rangeType, t2.rangeType],
                                        ENDCASE => FALSE,
                                any => WITH t2: type2 SELECT FROM any => TRUE, ENDCASE => FALSE,
                                ENDCASE => (key = entry),
                        ENDCASE => FALSE,
                ENDCASE => ERROR]};

        IsoFields: PROC[ctx1, ctx2: CTXIndex] RETURNS[BOOL] = {
            sei1: ISEIndex _ SymbolOps.FirstCtxSe[ctx1];
            sei2: ISEIndex _ SymbolOps.FirstCtxSe[ctx2];
            UNTIL sei1 = sei2 DO
                IF seb[sei1].hash # seb[sei2].hash OR ~Isomorphic[seb[sei1].idType, seb[sei2].idType] THEN
                    RETURN[FALSE];
                sei1 _ SymbolOps.NextSe[sei1];  sei2 _ SymbolOps.NextSe[sei2];
                ENDLOOP;
            RETURN[sei1 = sei2]};


        Equivalent: PROC[key, entry: Type] RETURNS[BOOL] = {
            RETURN[(key = entry) OR (
                Types.Equivalent[
                    [dataPtr.ownSymbols, SymbolOps.UnderType[key]],
                    [dataPtr.ownSymbols, SymbolOps.UnderType[entry]]]
                    AND ~Fuzzy[key, entry])]};

        Fuzzy: PROC[sei1, sei2: Type] RETURNS[BOOL] = INLINE {
            RETURN[SymbolOps.TypeForm[sei1] = array AND (~seb[sei1].mark4 OR ~seb[sei2].mark4)]};


    <<universal type fingers>>

        UTypeId: PUBLIC PROC[type: Type] RETURNS[mdi: MDIndex, index: Type] = {
            sei: Type = SymbolOps.ClusterSe[type];
            WITH se: seb[sei] SELECT FROM
                id => {
                    ctx: CTXIndex = se.idCtx;
                    WITH c: ctxb[ctx] SELECT FROM
                        included =>
                            IF SymbolOps.CtxLevel[ctx] = lZ THEN {index _ sei; mdi _ OwnMdi}
                            ELSE {index _ se.idValue; mdi _ c.module};
                        ENDCASE => {
                            index _ sei;
                            mdi _ IF Predeclared[sei] THEN MDNull ELSE OwnMdi}};
                cons => {
                    index _ sei;
                    mdi _ WITH t: se SELECT FROM
                        basic => MDNull,
                        enumerated => IF t.valueCtx IN StandardContext THEN MDNull ELSE OwnMdi,
                        record => IF t.fieldCtx IN StandardContext THEN MDNull ELSE OwnMdi,
                        opaque => IF Predeclared[t.id] THEN MDNull ELSE OwnMdi,
                        ENDCASE => OwnMdi};
                ENDCASE;
            RETURN};

        Predeclared: PROC[type: Type] RETURNS[BOOL] = {
            RETURN[type = nullType OR (
                WITH se: seb[type] SELECT FROM
                    id => se.idCtx IN (CTXNull .. StandardContext.LAST],
                    ENDCASE => FALSE)]};


    <<typeIds>>

        minTypes: CARDINAL = 2;   -- type fragment, if any, at least this big (avoid global 0)

        nTypes: CARDINAL;
        nTypeRefs: CARDINAL;
        typeMapId: ISEIndex;

        EnterType: PUBLIC PROC[type: Type, canonical: BOOL] = {
            sei: Type = SymbolOps.ClusterSe[type];
            slLimit: SymLitIndex = table.Top[SymbolSegment.atType];
            nTypeRefs _ nTypeRefs + 1;
            FOR sli: SymLitIndex _ SymLitIndex.FIRST, sli+SymLitRecord.SIZE UNTIL sli = slLimit DO
                WITH s: slb[sli] SELECT FROM
                    type =>
                        IF canonical = s.canonical AND
                            (IF canonical THEN Equivalent ELSE NameEqual)[sei, s.typeCode] THEN EXIT;
                    ENDCASE;
                REPEAT
                    FINISHED => InsertType[sei, canonical];
                ENDLOOP};

        TypeIndex: PUBLIC PROC[type: Type, canonical: BOOL] RETURNS[RTBcd.TypeIndex] = {
            sei: Type = SymbolOps.ClusterSe[type];
            i: CARDINAL _ 0;
            FOR sli: SymLitIndex _ SymLitIndex.FIRST, sli+SymLitRecord.SIZE WHILE i < nTypes DO
                WITH s: slb[sli] SELECT FROM
                    type =>
                        IF canonical = s.canonical AND
                            (IF canonical THEN Equivalent ELSE NameEqual)[sei, s.typeCode] THEN EXIT;
                    ENDCASE;
                i _ i+1;
                REPEAT
                    FINISHED => ERROR;
                ENDLOOP;
            RETURN[[i]]};

        TypeRef: PUBLIC PROC[type: Type, canonical: BOOL] RETURNS[Tree.Link] = {
            RETURN[IndexedRef[typeMapId, TypeIndex[type, canonical], typeANY]]};

        DescribeTypes: PUBLIC PROC RETURNS[offset, length: CARDINAL] = {
            RETURN[offset: WordOffset[typeMapId], length: nTypes]};

        EnumerateTypes: PUBLIC PROC[scan: PROC[canonical: BOOL, type: Type]] = {
            i: CARDINAL _ 0;
            FOR sli: SymLitIndex _ SymLitIndex.FIRST, sli+SymLitRecord.SIZE WHILE i < nTypes DO
                WITH s: slb[sli] SELECT FROM
                    type => scan[s.canonical, s.typeCode];
                    ENDCASE;
                i _ i + 1;
                ENDLOOP
            };


        InsertType: PROC[type: Type, canonical: BOOL] = {
            sli: SymLitIndex = table.Words[atType, SymLitRecord.SIZE];
            slb[sli] _ [type[canonical: canonical, typeCode: type]];
            nTypes _ nTypes + 1};

        PadTypes: PROC[pad: BOOL] = INLINE {
            IF nTypes # 0 THEN {
                totalTypes: CARDINAL = (IF pad THEN ((nTypes+3)/4)*4 ELSE nTypes);
                FOR i: NAT IN [nTypes .. MAX[minTypes, totalTypes]) DO
                    InsertType[Symbols.nullType, FALSE] ENDLOOP}
            };


    <<atoms and REFs to literals>>

        minLitRefs: CARDINAL = 1;    -- ref lit fragment, if any, at least this big (avoid global 0)

        nLits: CARDINAL;
        nLitRefs: CARDINAL;
        firstLit: SymLitIndex;    -- tight bound after Reset
        litMapId: ISEIndex;

        EnterLit: PROC[item: RefLitItem] = {
            key: SymLitRecord = [lit[item]];
            slLimit: SymLitIndex = table.Top[SymbolSegment.atType];
            nLitRefs _ nLitRefs + 1;
            FOR sli: SymLitIndex _ SymLitIndex.FIRST, sli+SymLitRecord.SIZE UNTIL sli = slLimit DO
                IF slb[sli] = key THEN EXIT;
                REPEAT
                    FINISHED => InsertLit[item];
                ENDLOOP
            };

        LitIndex: PROC[item: RefLitItem] RETURNS[RTBcd.RefLitIndex] = {
            key: SymLitRecord = [lit[item]];
            i: CARDINAL _ 0;
            FOR sli: SymLitIndex _ firstLit, sli+SymLitRecord.SIZE WHILE i < nLits DO
                IF slb[sli] = key THEN EXIT;  i _ i+1;
                REPEAT
                    FINISHED => ERROR;
                ENDLOOP;
            RETURN[[i]]};

        InsertLit: PROC[item: RefLitItem] = {
            sli: SymLitIndex = table.Words[atType, SymLitRecord.SIZE];
            slb[sli] _ [lit[item]];
            nLits _ nLits + 1};


        EnterAtom: PUBLIC PROC[name: Name] = {EnterLit[[atom[pName: name]]]};

        AtomIndex: PUBLIC PROC[name: Name] RETURNS[RTBcd.RefLitIndex] = {
            RETURN[LitIndex[[atom[pName: name]]]]};

        AtomRef: PUBLIC PROC[name: Name] RETURNS[Tree.Link] = {
            RETURN[IndexedRef[litMapId, AtomIndex[name], dataPtr.typeATOM]]};


        EnterText: PUBLIC PROC[sti: Literals.STIndex] = {EnterLit[[text[value: sti]]]};

        TextIndex: PUBLIC PROC[sti: Literals.STIndex] RETURNS[RTBcd.RefLitIndex] = {
            RETURN[LitIndex[[text[value: sti]]]]};

        TextRef: PUBLIC PROC[sti: Literals.STIndex] RETURNS[Tree.Link] = {
            RETURN[IndexedRef[litMapId, TextIndex[sti], dataPtr.typeRefANY]]};


        DescribeRefLits: PUBLIC PROC RETURNS[offset, length: CARDINAL] = {
            temp: INTEGER _ WordOffset[litMapId];
            IF dataPtr.switches['z] THEN temp _ - temp;
            RETURN[offset: LOOPHOLE[temp, CARDINAL], length: nLits]};

        EnumerateRefLits: PUBLIC PROC[scan: PROC[RefLitItem]] = {
            i: CARDINAL _ 0;
            FOR sli: SymLitIndex _ firstLit, sli+SymLitRecord.SIZE WHILE i < nLits DO
                WITH s: slb[sli] SELECT FROM
                    lit => {scan[s.info]; i _ i+1};
                    ENDCASE;
                ENDLOOP};

        PadRefLits: PROC[pad: BOOL] = INLINE {
            IF nLits # 0 THEN {
                totalLits: CARDINAL = (IF pad THEN ((nLits+3)/4)*4 ELSE nLits);
                someLit: RefLitItem;    -- need a null RefLitItem

                FindLit: PROC[item: RefLitItem] = {someLit _ item};

                EnumerateRefLits[FindLit];
                FOR i: NAT IN [nLits .. MAX[minLitRefs, totalLits]) DO InsertLit[someLit] ENDLOOP}
            };


    <<state transitions>>

        Initialize: PUBLIC PROC[ownTable: Alloc.Handle] = {
            table _ ownTable; table.AddNotify[UpdateBases];
            nLits _ nLitRefs _ 0;  nTypes _ nTypeRefs _ 0;
            firstLit _ SymLitIndex.FIRST;    -- see Reset
            typeMapId _ litMapId _ ISENull};

        Reset: PUBLIC PROC[pad: BOOL] = {
            PadTypes[pad];  PadRefLits[pad];
            IF nLits # 0 AND ~dataPtr.interface THEN {
                IF dataPtr.switches['z] THEN {    -- the new way
                    mapType: CSEIndex = CreateUnnamedMap[dataPtr.typeRefANY, nLits+1];
                    intermediateType _ LOOPHOLE[mapType];
                        <<Hold on to this type in order to generate the double indirection>>
                    litMapId _ CreateMap["&map"L, dataPtr.typeRefANY, 1, 1];
                        <<Now the literal is a REF to an array (with a dummy word in front) that will hold the actual references>>
                    }
                ELSE litMapId _ CreateMap["&refs"L, dataPtr.typeRefANY, nLits, nLitRefs]};
            IF nTypes # 0 THEN {
                slLimit: SymLitIndex = table.Top[atType];
                lastType: SymLitIndex;
                t: SymLitRecord;
                lastType _ slLimit - SymLitRecord.SIZE;
                DO
                    UNTIL firstLit = slLimit OR slb[firstLit].tag = lit DO
                        firstLit _ firstLit + SymLitRecord.SIZE ENDLOOP;
                    UNTIL slb[lastType].tag = type DO
                        lastType _ lastType - SymLitRecord.SIZE ENDLOOP;
                    IF lastType < firstLit THEN EXIT;
                    t _ slb[firstLit];  slb[firstLit] _ slb[lastType];  slb[lastType] _ t;
                    ENDLOOP;
                IF ~dataPtr.interface
                    THEN typeMapId _ CreateMap["&types"L, typeANY, nTypes, nTypeRefs]}
            };

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


    <<utility routines>>

        CreateMap: PROC[id: LONG STRING, cType: Type, nEntries, nRefs: CARDINAL]
              RETURNS[sei: ISEIndex] = {
            desc: ConvertUnsafe.SubString _ [base:id, offset:0, length:id.length];
            mapType: CSEIndex _ CreateUnnamedMap[cType, nEntries];
            sei _ SymbolOps.MakeCtxSe[SymbolOps.EnterString[desc], dataPtr.mainCtx];
            seb[sei].idType _ mapType;
            seb[sei].public _ seb[sei].extended _ seb[sei].constant _ seb[sei].linkSpace _ FALSE;
            seb[sei].immutable _ TRUE;
            seb[sei].idValue _ Tree.NullIndex;  seb[sei].idInfo _ nRefs;
            seb[sei].mark3 _ seb[sei].mark4 _ TRUE;
            RETURN};

        CreateUnnamedMap: PROC[cType: Type, nEntries: CARDINAL]
              RETURNS[mapType: CSEIndex] = {
            iType: CSEIndex _ SymbolOps.MakeNonCtxSe[SERecord.cons.subrange.SIZE];
            seb[iType].typeInfo _ subrange[
                filled: TRUE, empty: FALSE,
                rangeType: dataPtr.idINT,
                origin: 0, range: nEntries-1];
            seb[iType].mark3 _ seb[iType].mark4 _ TRUE;
            mapType _ SymbolOps.MakeNonCtxSe[SERecord.cons.array.SIZE];
            seb[mapType].typeInfo _ array[packed: FALSE, indexType: iType, componentType: cType];
            seb[mapType].mark3 _ seb[mapType].mark4 _ TRUE;
            RETURN};

        MakeRefType: PROC[referent: CSEIndex] RETURNS[Type] = {
            refCSE: CSEIndex _ SymbolOps.MakeNonCtxSe[SERecord.cons.ref.SIZE];
            longCSE: CSEIndex _ SymbolOps.MakeNonCtxSe[SERecord.cons.long.SIZE];
            seb[longCSE].typeInfo _ long[rangeType: LOOPHOLE[refCSE]];
            seb[longCSE].mark3 _ seb[longCSE].mark4 _ TRUE;
            seb[refCSE].typeInfo _ ref[counted: TRUE, readOnly: TRUE, ordered: FALSE, list: FALSE, var: FALSE, basing: FALSE, refType: 
            LOOPHOLE[referent]];
            seb[refCSE].mark3 _ seb[refCSE].mark4 _ TRUE;
            RETURN[LOOPHOLE[refCSE]]};

        intermediateType: Type;

        WordOffset: PROC[sei: ISEIndex] RETURNS[offset: CARDINAL] = {
            IF sei = ISENull THEN offset _ 0
            ELSE {
                addr: BitAddress = seb[sei].idValue;
                offset _ addr.wd};
            RETURN};


        IndexedRef: PROC[array: ISEIndex, item: CARDINAL, type: CSEIndex] RETURNS[Tree.Link] = {
            OPEN TreeOps;
            IF dataPtr.switches['z] AND type # typeANY THEN {  -- must go one level indirect
                PushSe[array];  PushNode[uparrow, 1];
                SetAttr[1, TRUE];  SetAttr[2, TRUE];  SetInfo[intermediateType];
                PushLit[LiteralOps.Find[item+1]];  PushNode[index, 2]}
                ELSE {PushSe[array];  PushLit[LiteralOps.Find[item]];  PushNode[index, 2]};
            SetAttr[2, FALSE];  SetInfo[type];
            RETURN[PopTree[]]};

        }.