
    <<AMTypesAImpl.Mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<NOTE do Equal, AsGoodAs>>
            <<try to avoid acquisition of already acquired symbol tables>>
            <<status stuff is wrong. >>
        <<Paul Rovner, June 29, 1983 4:50 pm>>
        <<Russ Atkinson, February 11, 1985 7:37:09 pm PST>>

    DIRECTORY
        AMBridge USING [SetTVFromLC, SetTVFromLI],
        AMTypes USING [Class, Index, Status, TypedVariable, ErrorReason, New, TypeClass, Size],
        BrandXSymbolDefs USING [nullSymbolIndex, SymbolConstructorIndex, SymbolIdIndex, symbolIndexForANY, SymbolModuleIndex, 
        thisModuleIndex],
        BrandYSymbolDefs USING [nullSymbolIndex, SymbolConstructorIndex, SymbolIdIndex, symbolIndexForANY, SymbolModuleIndex, 
        thisModuleIndex],
        Rope USING [Equal, ROPE],
        RTSymbolDefs USING [nullBase, SymbolConstructorIndex, SymbolContextIndex, SymbolIdIndex, SymbolIndex, SymbolRecordIndex, 
        SymbolTableBase],
        RTSymbolOps USING [AcquireRope, AcquireSequenceType, AcquireType, CountComponents, EnumerateCtxIseis, EnumerateRecordIseis, 
        IDCardinalValue, ISEConstant, ISEImmutable, ISEInfo, ISEName, ISEType, SEUnderType, STBToModuleName],
        RTSymbols USING [GetTypeSymbols, GetOriginalTypeSymbols, ReleaseSTB],
        RTTCache USING [ComponentEntry, ComponentMap, FillIntEntry, FillNameComponent, FillRefEntry, FillTypeComponent, 
        GetComponentAtIndex, GetComponentForName, IntEntry, LookupInt, LookupRef, NewComponentMap, RefEntry],
        RTTypesPrivate USING[],
        SafeStorage USING [nullType, Type, unspecType];

    AMTypesAImpl: PROGRAM
        IMPORTS AMBridge, AMTypes, Rope, RTSymbolOps, RTSymbols, RTTCache
        EXPORTS AMTypes, RTTypesPrivate
        = BEGIN OPEN AMBridge, AMTypes, bx: BrandXSymbolDefs, by: BrandYSymbolDefs, SafeStorage, RTSymbolOps, RTSymbolDefs, RTSymbols;

    <<T Y P E S>>
        ROPE: TYPE = Rope.ROPE;

    <<E R R O R>>
        Error: PUBLIC ERROR[ reason: ErrorReason,
            msg: ROPE _ NIL,
            type: Type _ nullType,-- used with TypeFault, IncompatibleTypes
            otherType: Type _ nullType -- used with IncompatibleTypes
            ] = CODE; 

    <<P U B L I C   P R O C E D U R E S>>

        <<These procedures have applicability restrictions, noted as comments>>

    NComponents: PUBLIC SAFE PROC [type: Type--record, structure--] RETURNS [ans: Index] = TRUSTED {
        entry: RTTCache.IntEntry;
        int: INT;
        IF type = nullType THEN RETURN[0];
        entry _ RTTCache.LookupInt[type, NComponents];
        int _ entry.int;
        IF int >= 0 THEN RETURN [int];

        {stb: SymbolTableBase;
            sei: SymbolIndex;
            [stb, sei] _ GetTypeSymbols[type];
            { ENABLE UNWIND => ReleaseSTB[stb];
                csei: SymbolConstructorIndex _ SEUnderType[stb, sei];

                WITH stb SELECT FROM
                    t: SymbolTableBase.x =>
                        WITH ser: t.e.seb[NARROW[csei, SymbolConstructorIndex.x].e] SELECT FROM
                            record => ans _ CountComponents[stb, LOOPHOLE[csei]];
                            definition =>
                                {proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOL] =
                                    {ans _ ans + 1; RETURN[FALSE]};
                                    ans _ 0;
                                    [] _ EnumerateCtxIseis[stb, [x[ser.defCtx]], proc]};
                            ENDCASE => ERROR Error[reason: typeFault, type: type];
                    t: SymbolTableBase.y =>
                        WITH ser: t.e.seb[NARROW[csei, SymbolConstructorIndex.y].e] SELECT FROM
                            record => ans _ CountComponents[stb, LOOPHOLE[csei]];
                            definition =>
                                {proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOL] =
                                    {ans _ ans + 1; RETURN[FALSE]};
                                    ans _ 0;
                                    [] _ EnumerateCtxIseis[stb, [y[ser.defCtx]], proc]};
                            ENDCASE => ERROR Error[reason: typeFault, type: type];
                    ENDCASE => ERROR;
                };
            ReleaseSTB[stb]};
        [] _ RTTCache.FillIntEntry[entry, ans];
        };

    IndexToType: PUBLIC SAFE PROC [type: Type--record, structure, union--, index: Index] RETURNS[ans: Type] = TRUSTED {
        <<This returns the Type of the specified component of instances of the type. index starts at 1.>>
        proc1: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] = {
            ans _ IF index = 0
                THEN AcquireType[stb, ISEType[stb, isei]]
                ELSE AcquireType[stb, ISEInfo[stb, isei]]};
        proc2: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] = {
            sei: SymbolIndex _ ISEType[stb, isei];
            WITH stb SELECT FROM
                t: SymbolTableBase.x =>
                    WITH cse: t.e.seb[t.e.UnderType[NARROW[sei, SymbolIndex.x].e]] SELECT FROM
                        sequence => {
                            recstb: SymbolTableBase;
                            recsei: SymbolIndex;
                            [recstb, recsei] _ GetTypeSymbols[type];
                            ans _ AcquireSequenceType[stb, sei, recstb,
                                LOOPHOLE[SEUnderType[recstb, recsei],
                                    SymbolRecordIndex]
                                ! UNWIND => ReleaseSTB[recstb]];
                            ReleaseSTB[recstb]};
                        ref => {
                            IF cse.var THEN sei _ [x[cse.refType]];
                            ans _ AcquireType[stb, sei]};
                        ENDCASE => ans _ AcquireType[stb, sei];
                t: SymbolTableBase.y =>
                    WITH cse: t.e.seb[t.e.UnderType[NARROW[sei, SymbolIndex.y].e]] SELECT FROM
                        sequence => {
                            recstb: SymbolTableBase;
                            recsei: SymbolIndex;
                            [recstb, recsei] _ GetTypeSymbols[type];
                            ans _ AcquireSequenceType[stb, sei, recstb,
                                LOOPHOLE[SEUnderType[recstb, recsei],
                                    SymbolRecordIndex]
                                ! UNWIND => ReleaseSTB[recstb]];
                            ReleaseSTB[recstb]};
                        ref => {
                            IF cse.var THEN sei _ [y[cse.refType]];
                            ans _ AcquireType[stb, sei]};
                        ENDCASE => ans _ AcquireType[stb, sei];
                ENDCASE => ERROR;
            };
        entry: RTTCache.RefEntry;
        map: RTTCache.ComponentMap;
        class: Class;
        n: NAT _ 0;
        type _ UnderType[type];
        class _ TypeClass[type];
        SELECT class FROM
            record, structure => n _ NComponents[type];
            union => n _ NValues[Domain[type]];
            ENDCASE => ERROR Error[reason: typeFault, type: type];
        entry _ RTTCache.LookupRef[type, IndexToType];
        map _ NARROW[entry.ref, RTTCache.ComponentMap];
        IF map # NIL AND index IN [1..map.len] AND map[index-1].validType
            THEN RETURN [map[index-1].type];

        SELECT class FROM
            record, structure => RecordComponentISEI[type, index, proc2];
            union => ComponentISEI[type, index, proc1];
            ENDCASE => ERROR Error[reason: typeFault, type: type];  

        IF n > 0 AND index IN [1..n] THEN {
            <<put the answer back into the cache>>
            IF map = NIL THEN
                [] _ RTTCache.FillRefEntry[entry, map _ RTTCache.NewComponentMap[n]];
            [] _ RTTCache.FillTypeComponent[map, index-1, ans]};
        };

    IndexToStatus: PUBLIC PROC [type: Type--record, structure--, index: Index] RETURNS[ans: Status] = {
        <<This returns the Status of the specified component of instances of the type. index starts at 1.>>
        proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] = {
            ans _ (IF ISEImmutable[stb, isei] THEN readOnly
            ELSE IF ISEConstant[stb, isei] THEN const
            ELSE mutable)};
        RecordComponentISEI[type, index, proc];
        };

    NameToIndex: PUBLIC SAFE PROC [type: Type--record, structure, union, enumerated--, name: ROPE] RETURNS [ans: CARDINAL _ 0] = 
    TRUSTED  {
        <<index starts at 1>>
        <<raises typeFault, badName>>
        enumerated: BOOL _ FALSE;
        stb: SymbolTableBase;
        sei: SymbolIndex;
        class: Class;
        n: INT _ 0;
        found: BOOL _ FALSE;
        entry: RTTCache.RefEntry;
        map: RTTCache.ComponentMap;
        proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOL] = {
            IF enumerated THEN ans _ IDCardinalValue[stb, isei] + 1 ELSE ans _ ans + 1;
            stop _ Rope.Equal[name, AcquireRope[stb, ISEName[stb, isei]]]};

        type _ UnderType[type];
        class _ TypeClass[type];
        SELECT class FROM
            record, structure => n _ NComponents[type];
            enumerated => n _ NValues[type];
            union => n _ NValues[Domain[type]];
            ENDCASE;

        IF n IN [1..256) THEN {
            entry _ RTTCache.LookupRef[type, IndexToType];
            map _ NARROW[entry.ref, RTTCache.ComponentMap];
            IF map # NIL THEN {
                int: INT _ RTTCache.GetComponentForName[map, name].index;
                IF int >= 0 THEN RETURN [int+1]}};

        [stb, sei] _ GetTypeSymbols[type];

        { ENABLE UNWIND => ReleaseSTB[stb];
            WITH stb SELECT FROM
                t: SymbolTableBase.x =>
                    {csei: bx.SymbolConstructorIndex _ t.e.UnderType[NARROW[sei, SymbolIndex.x].e];
                        WITH ser: t.e.seb[csei] SELECT FROM
                            record => {srx: SymbolIndex = [x[csei]];
                                found _ EnumerateRecordIseis[stb,
                                    LOOPHOLE[srx, SymbolRecordIndex],
                                    proc]};
                            definition => found _ EnumerateCtxIseis[stb, [x[ser.defCtx]], proc];
                            union => found _ EnumerateCtxIseis[stb, [x[ser.caseCtx]], proc];
                            enumerated =>
                                {enumerated _ TRUE; found _ EnumerateCtxIseis[stb, [x[ser.valueCtx]], proc]};
                            ENDCASE => ERROR Error[reason: typeFault, type: type]};
                t: SymbolTableBase.y =>
                    {csei: by.SymbolConstructorIndex _ t.e.UnderType[NARROW[sei, SymbolIndex.y].e];
                        WITH ser: t.e.seb[csei] SELECT FROM
                            record => {srx: SymbolIndex = [y[csei]];
                                found _ EnumerateRecordIseis[stb,
                                    LOOPHOLE[srx, SymbolRecordIndex],
                                    proc]};
                            definition => found _ EnumerateCtxIseis[stb, [y[ser.defCtx]], proc];
                            union => found _ EnumerateCtxIseis[stb, [y[ser.caseCtx]], proc];
                            enumerated =>
                                {enumerated _ TRUE; found _ EnumerateCtxIseis[stb, [y[ser.valueCtx]], proc]};
                            ENDCASE => ERROR Error[reason: typeFault, type: type]};
            ENDCASE => ERROR;
            };

        ReleaseSTB[stb];
        IF NOT found THEN ERROR Error[reason: badName, type: type, msg: name];
        IF ans > 0 AND n IN [1..256) THEN {
            IF map = NIL THEN
                [] _ RTTCache.FillRefEntry[entry, map _ RTTCache.NewComponentMap[n]];
            [] _ RTTCache.FillNameComponent[map, ans-1, name]};
        };  -- end NameToIndex

    IndexToName: PUBLIC SAFE PROC [type: Type--record, structure, union, enumerated--, index: CARDINAL] RETURNS[ans: ROPE] = TRUSTED  {
        proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] = {
            ans _ AcquireRope[stb, ISEName[stb, isei]]};
        n: INT _ 0;
        class: Class;
        entry: RTTCache.RefEntry;
        map: RTTCache.ComponentMap _ NIL;

        type _ UnderType[type];
        class _ TypeClass[type];

        SELECT class FROM
            record, structure => n _ NComponents[type];
            enumerated => n _ NValues[type];
            union, sequence =>
                IF index = 0
                    THEN {
                        <<RRA: the tag name is cached differently from other component names>>
                        entry _ RTTCache.LookupRef[type, IndexToName];
                        IF entry.valid THEN RETURN [NARROW[entry.ref]];
                        ComponentISEI[type, 0, proc];
                        entry.ref _ ans;
                        entry.valid _ TRUE;
                        RETURN}
                    ELSE {
                        <<RRA: only union types are further processed>>
                        IF class = sequence THEN GO TO err;
                        n _ NValues[Domain[type]];
                        }; 
            ENDCASE;

        IF n IN [1..256) THEN {
            entry _ RTTCache.LookupRef[type, IndexToType];
            map _ NARROW[entry.ref, RTTCache.ComponentMap];
            IF map = NIL
                THEN [] _ RTTCache.FillRefEntry[entry, map _ RTTCache.NewComponentMap[n]];
            IF index IN [1..map.len] THEN {
                comp: RTTCache.ComponentEntry _
                RTTCache.GetComponentAtIndex[map, index-1];
                IF comp.validName THEN RETURN [comp.name]};
            };

        SELECT class FROM
            record, structure => RecordComponentISEI[type, index, proc];
            union, enumerated => ComponentISEI[type, index, proc];
            ENDCASE => GO TO err;
        IF map # NIL THEN [] _ RTTCache.FillNameComponent[map, index-1, ans];
        EXITS
            err => ERROR Error[reason: typeFault, type: type];
        };

    IsPacked: PUBLIC SAFE PROC [type: Type--array, sequence--] RETURNS [ans: BOOL] = TRUSTED {
        stb: SymbolTableBase;
        sei: SymbolIndex;
        [stb, sei] _ GetTypeSymbols[type];
        { ENABLE UNWIND => ReleaseSTB[stb];
            WITH stb SELECT FROM
                t: SymbolTableBase.x =>
                    WITH ser: t.e.seb[t.e.UnderType[NARROW[sei, SymbolIndex.x].e]] SELECT FROM
                        array => ans _ ser.packed;
                        sequence => ans _ ser.packed;
                        ENDCASE => ERROR Error[reason: typeFault, type: type];
                t: SymbolTableBase.y =>
                    WITH ser: t.e.seb[t.e.UnderType[NARROW[sei, SymbolIndex.y].e]] SELECT FROM
                        array => ans _ ser.packed;
                        sequence => ans _ ser.packed;
                        ENDCASE => ERROR Error[reason: typeFault, type: type];
                ENDCASE => ERROR;
            };
        ReleaseSTB[stb];
        };

    Domain: PUBLIC SAFE PROC [type: Type] RETURNS[ans: Type] = TRUSTED {
        <<domain: type >>
        stb: SymbolTableBase;
        sei: SymbolIndex;

        entry: RTTCache.IntEntry _ RTTCache.LookupInt[type _ UnderType[type], Domain];
        int: INT _ entry.int;
        IF int >= 0 THEN {card: CARDINAL _ int; RETURN [LOOPHOLE[card]]};

        [stb, sei] _ GetTypeSymbols[type];
        { ENABLE UNWIND => ReleaseSTB[stb];
            WITH stb SELECT FROM
                t: SymbolTableBase.x =>
                    WITH ser: t.e.seb[t.e.UnderType[NARROW[sei, SymbolIndex.x].e]] SELECT FROM
                        relative => ans _ AcquireType[stb, [x[ser.offsetType]]];
                        array => ans _ AcquireType[stb, [x[ser.indexType]]];
                        sequence => ans _ AcquireType[stb, [x[t.e.seb[ser.tagSei].idType]]];
                        union =>    ans _ AcquireType[stb, [x[t.e.seb[ser.tagSei].idType]]];
                        transfer =>  ans _ (IF ser.typeIn = bx.nullSymbolIndex
                            THEN nullType
                            ELSE AcquireType[stb, [x[ser.typeIn]]]);
                        ENDCASE => ERROR Error[reason: typeFault, type: type];
                t: SymbolTableBase.y =>
                    WITH ser: t.e.seb[t.e.UnderType[NARROW[sei, SymbolIndex.y].e]] SELECT FROM
                        relative => ans _ AcquireType[stb, [y[ser.offsetType]]];
                        array => ans _ AcquireType[stb, [y[ser.indexType]]];
                        sequence => ans _ AcquireType[stb, [y[t.e.seb[ser.tagSei].idType]]];
                        union =>    ans _ AcquireType[stb, [y[t.e.seb[ser.tagSei].idType]]];
                        transfer =>  ans _ (IF ser.typeIn = by.nullSymbolIndex
                            THEN nullType
                            ELSE AcquireType[stb, [y[ser.typeIn]]]);
                        ENDCASE => ERROR Error[reason: typeFault, type: type];
                ENDCASE => ERROR;
            };
        ReleaseSTB[stb];
        [] _ RTTCache.FillIntEntry[entry, LOOPHOLE[ans, CARDINAL]];
        };

    Range: PUBLIC SAFE PROC[type: Type] RETURNS[ans: Type] = TRUSTED {
        <<domain: type >>

        stb: SymbolTableBase;
        sei: SymbolIndex;

        entry: RTTCache.IntEntry _ RTTCache.LookupInt[type _ UnderType[type], Range];
        int: INT _ entry.int;
        IF int >= 0 THEN {card: CARDINAL _ int; RETURN [LOOPHOLE[card]]};

        SELECT TypeClass[type] FROM
            array, sequence, procedure, signal, process,
            list, ref, pointer, longPointer, descriptor,
            longDescriptor, relativePointer, basePointer => NULL;
            ENDCASE => ERROR Error[reason: typeFault, type: type];

            [stb, sei] _ GetTypeSymbols[type];
        { ENABLE UNWIND => ReleaseSTB[stb];
            WITH stb SELECT FROM
                t: SymbolTableBase.x =>
                    WITH ser: t.e.seb[t.e.UnderType[NARROW[sei, SymbolIndex.x].e]] SELECT FROM
                        array => ans _ AcquireType[stb, [x[ser.componentType]]];
                        sequence => ans _ AcquireType[stb, [x[ser.componentType]]];
                        transfer => ans _ (IF ser.typeOut = bx.nullSymbolIndex
                            THEN nullType
                            ELSE AcquireType[stb, [x[ser.typeOut]]]);
                        relative => ans _ Range[AcquireType[stb, [x[ser.resultType]]]];
                        ref => {IF ser.counted THEN ERROR Error[reason: typeFault, type: type];
                            ans _ (IF t.e.UnderType[ser.refType] = bx.symbolIndexForANY
                                THEN unspecType
                                ELSE AcquireType[stb, [x[ser.refType]]])};
                        arraydesc => ans _ AcquireType[stb, [x[ser.describedType]]];
                        long => WITH rse: t.e.seb[t.e.UnderType[ser.rangeType]] SELECT FROM
                            ref => ans _ (IF t.e.UnderType[rse.refType] = bx.symbolIndexForANY
                                THEN unspecType
                                ELSE AcquireType[stb, [x[rse.refType]]]);
                            arraydesc => ans _ AcquireType[stb, [x[rse.describedType]]];
                            ENDCASE => ERROR Error[reason: typeFault, type: type];
                        ENDCASE => ERROR Error[reason: typeFault, type: type];
                t: SymbolTableBase.y =>
                    WITH ser: t.e.seb[t.e.UnderType[NARROW[sei, SymbolIndex.y].e]] SELECT FROM
                        array => ans _ AcquireType[stb, [y[ser.componentType]]];
                        sequence => ans _ AcquireType[stb, [y[ser.componentType]]];
                        transfer => ans _ (IF ser.typeOut = by.nullSymbolIndex
                            THEN nullType
                            ELSE AcquireType[stb, [y[ser.typeOut]]]);
                        relative => ans _ Range[AcquireType[stb, [y[ser.resultType]]]];
                        ref => {IF ser.counted THEN ERROR Error[reason: typeFault, type: type];
                            ans _ (IF t.e.UnderType[ser.refType] = by.symbolIndexForANY
                                THEN unspecType
                                ELSE AcquireType[stb, [y[ser.refType]]])};
                        arraydesc => ans _ AcquireType[stb, [y[ser.describedType]]];
                        long => WITH rse: t.e.seb[t.e.UnderType[ser.rangeType]] SELECT FROM
                            ref => ans _ (IF t.e.UnderType[rse.refType] = by.symbolIndexForANY
                                THEN unspecType
                                ELSE AcquireType[stb, [y[rse.refType]]]);
                            arraydesc => ans _ AcquireType[stb, [y[rse.describedType]]];
                            ENDCASE => ERROR Error[reason: typeFault, type: type];
                        ENDCASE => ERROR Error[reason: typeFault, type: type];
                ENDCASE => ERROR;
            ReleaseSTB[stb]};  -- END ENABLE UNWIND

        [] _ RTTCache.FillIntEntry[entry, LOOPHOLE[ans, CARDINAL]];
        };

    ReferentStatus: PUBLIC SAFE PROC [type: Type] RETURNS [ans: Status] = TRUSTED {
        stb: SymbolTableBase;
        sei: SymbolIndex;
        readOnlyReferent: BOOL _ FALSE;
        entry: RTTCache.IntEntry _ RTTCache.LookupInt[type _ UnderType[type], ReferentStatus];
        int: INT _ entry.int;
        IF int >= 0 THEN {card: CARDINAL _ int; RETURN [LOOPHOLE[card]]};

        SELECT TypeClass[type] FROM
            rope, atom => RETURN [readOnly];
            basePointer => GO TO fault;
            list, ref, pointer, longPointer, descriptor, longDescriptor, relativePointer => {};
            ENDCASE => GO TO fault;

        [stb, sei] _ GetTypeSymbols[type];
        { ENABLE UNWIND => ReleaseSTB[stb];

            WITH stb SELECT FROM
                t: SymbolTableBase.x =>
                    WITH ser: t.e.seb[t.e.UnderType[NARROW[sei, SymbolIndex.x].e]] SELECT FROM
                        long => WITH ser1: t.e.seb[t.e.UnderType[ser.rangeType]] SELECT FROM
                            arraydesc => readOnlyReferent _ ser1.readOnly;
                            ref => readOnlyReferent _ ser1.readOnly;
                            ENDCASE => GO TO fault;
                            ref => readOnlyReferent _ ser.readOnly;
                        relative => WITH ser2: t.e.seb[t.e.UnderType[ser.resultType]] SELECT FROM
                            long => WITH ser1: t.e.seb[t.e.UnderType[ser2.rangeType]] SELECT FROM
                                ref => readOnlyReferent _ ser1.readOnly;
                                ENDCASE => GO TO fault;
                            ref => readOnlyReferent _ ser2.readOnly;
                            ENDCASE => GO TO fault;
                        arraydesc => readOnlyReferent _ ser.readOnly;
                        ENDCASE => GO TO fault;
                t: SymbolTableBase.y =>
                    WITH ser: t.e.seb[t.e.UnderType[NARROW[sei, SymbolIndex.y].e]] SELECT FROM
                        long => WITH ser1: t.e.seb[t.e.UnderType[ser.rangeType]] SELECT FROM
                            arraydesc => readOnlyReferent _ ser1.readOnly;
                            ref => readOnlyReferent _ ser1.readOnly;
                            ENDCASE => ERROR Error[reason: typeFault, type: type];
                            ref => readOnlyReferent _ ser.readOnly;
                        relative => WITH ser2: t.e.seb[t.e.UnderType[ser.resultType]] SELECT FROM
                            long => WITH ser1: t.e.seb[t.e.UnderType[ser2.rangeType]] SELECT FROM
                                ref => readOnlyReferent _ ser1.readOnly;
                                ENDCASE => GO TO fault;
                            ref => readOnlyReferent _ ser2.readOnly;
                            ENDCASE => GO TO fault;
                        arraydesc => readOnlyReferent _ ser.readOnly;
                        ENDCASE => GO TO fault;
                ENDCASE => ERROR;
            };
        ReleaseSTB[stb];

        ans _ IF readOnlyReferent THEN readOnly ELSE mutable;
        [] _ RTTCache.FillIntEntry[entry, LOOPHOLE[ans, CARDINAL]];
        EXITS fault => ERROR Error[reason: typeFault, type: type];
        };

    TypeToName: PUBLIC SAFE PROC [type: Type, moduleName, fileName: REF ROPE _ NIL] RETURNS [ans: ROPE] = TRUSTED {
        class: Class _ TypeClass[type];
        SELECT class FROM
            nil => RETURN[NIL];
            unspecified => RETURN ["UNSPECIFIED"];
            localFrame => RETURN ["%localFrame"];
            globalFrame => RETURN["%globalFrame"];
            type => RETURN["TYPE"];
            any => RETURN["ANY"];
            atom => RETURN["ATOM"];
            rope => RETURN["ROPE"];
            cardinal => RETURN["CARDINAL"];
            longCardinal => RETURN["CARD"];
            integer => RETURN["INTEGER"];
            longInteger => RETURN["INT"];
            real => RETURN["REAL"];
            character => RETURN["CHAR"];
            ENDCASE;

        { stb: SymbolTableBase _ nullBase;
            sei: SymbolIndex;

            IF moduleName # NIL OR fileName # NIL THEN
                [stb, sei] _ GetOriginalTypeSymbols[type ! Error => CONTINUE];

            IF stb = nullBase THEN [stb, sei] _ GetTypeSymbols[type];
            WITH stb SELECT FROM
                t: SymbolTableBase.x => {
                    ENABLE UNWIND => ReleaseSTB[stb];
                    mdi: bx.SymbolModuleIndex _ bx.thisModuleIndex;
                    WITH ser: t.e.seb[NARROW[sei, SymbolIndex.x].e] SELECT FROM
                        id => {ans _ AcquireRope[stb, [x[ser.hash]]];
                            IF moduleName # NIL OR fileName # NIL THEN {
                                WITH cer: t.e.ctxb[ser.idCtx] SELECT FROM
                                    included => mdi _ cer.module;
                                    ENDCASE;
                                IF moduleName # NIL THEN
                                    moduleName^ _ AcquireRope[stb, [x[t.e.mdb[mdi].moduleId]]];
                                IF fileName # NIL THEN
                                    fileName^ _ AcquireRope[stb, [x[t.e.mdb[mdi].fileId]]]}};
                        ENDCASE => {
                            csei: bx.SymbolConstructorIndex = t.e.UnderType[NARROW[sei, SymbolIndex.x].e];
                            IF moduleName # NIL THEN moduleName^ _ STBToModuleName[stb];
                            WITH ser: t.e.seb[csei] SELECT FROM
                                definition => ans _ STBToModuleName[stb];  -- interface type
                                ENDCASE => ans _ NIL};
                    };
                t: SymbolTableBase.y => {
                    ENABLE UNWIND => ReleaseSTB[stb];
                    mdi: by.SymbolModuleIndex _ by.thisModuleIndex;
                    WITH ser: t.e.seb[NARROW[sei, SymbolIndex.y].e] SELECT FROM
                        id => {
                            ans _ AcquireRope[stb, [y[ser.hash]]];
                            IF moduleName # NIL OR fileName # NIL THEN {
                                WITH cer: t.e.ctxb[ser.idCtx] SELECT FROM
                                    included => mdi _ cer.module;
                                    ENDCASE;
                                IF moduleName # NIL THEN
                                    moduleName^ _ AcquireRope[stb, [y[t.e.mdb[mdi].moduleId]]];
                                IF fileName # NIL THEN
                                    fileName^ _ AcquireRope[stb, [y[t.e.mdb[mdi].fileId]]]}};
                        ENDCASE => {
                            csei: by.SymbolConstructorIndex = t.e.UnderType[NARROW[sei, SymbolIndex.y].e];
                            IF moduleName # NIL THEN moduleName^ _ STBToModuleName[stb];
                            WITH ser: t.e.seb[csei] SELECT FROM
                                definition => ans _ STBToModuleName[stb];  -- interface type
                                ENDCASE => ans _ NIL};
                    };
                ENDCASE => ERROR;
            ReleaseSTB[stb];
            };
        };

    Ground: PUBLIC SAFE PROC [type: Type] RETURNS [ans: Type] = TRUSTED {
        <<peels off one layer from a definition or subrange type>>
        stb: SymbolTableBase;
        sei: SymbolIndex;
        entry: RTTCache.IntEntry;
        int: INT;
        entry _ RTTCache.LookupInt[type, Ground];
        int _ entry.int;
        IF int >= 0 THEN {card: CARDINAL _ int; RETURN [LOOPHOLE[card]]};

        SELECT TypeClass[type] FROM
            definition, subrange => {};
            ENDCASE => GO TO fault;

        [stb, sei] _ GetTypeSymbols[type];

        {ENABLE UNWIND => ReleaseSTB[stb];
            WITH stb SELECT FROM
                t: SymbolTableBase.x =>
                    WITH ser: t.e.seb[NARROW[sei, SymbolIndex.x].e] SELECT FROM
                        id => ans _ AcquireType[stb, [x[ser.idInfo]]]; -- a definition
                        ENDCASE => {
                            csei: bx.SymbolConstructorIndex _ t.e.UnderType[NARROW[sei, SymbolIndex.x].e];
                            WITH ser: t.e.seb[csei] SELECT FROM
                                subrange => ans _ AcquireType[stb, [x[ser.rangeType]]];
                            ENDCASE;
                            };
                t: SymbolTableBase.y =>
                    WITH ser: t.e.seb[NARROW[sei, SymbolIndex.y].e] SELECT FROM
                        id => ans _ AcquireType[stb, [y[ser.idInfo]]]; -- a definition
                        ENDCASE => {
                            csei: by.SymbolConstructorIndex _ t.e.UnderType[NARROW[sei, SymbolIndex.y].e];
                            WITH ser: t.e.seb[csei] SELECT FROM
                                subrange => ans _ AcquireType[stb, [y[ser.rangeType]]];
                            ENDCASE;
                        };
                ENDCASE => ERROR;
            };
        ReleaseSTB[stb];

        [] _ RTTCache.FillIntEntry[entry, LOOPHOLE[ans, CARDINAL]];
        EXITS fault => ERROR Error[reason: typeFault, type: type];
        };

    GroundStar: PUBLIC SAFE PROC [type: Type--definition, subrange--] RETURNS [Type] = TRUSTED {
        <<peels off one layer from a definition or subrange type (no change for other types)>>
        entry: RTTCache.IntEntry _ RTTCache.LookupInt[type, GroundStar];
        int: INT _ entry.int;
        IF int >= 0 THEN {card: CARDINAL _ int; RETURN [LOOPHOLE[card]]};
        DO
            SELECT TypeClass[type] FROM
                definition, subrange => type _ Ground[type];
                ENDCASE => EXIT;
            ENDLOOP;
        [] _ RTTCache.FillIntEntry[entry, LOOPHOLE[type, CARDINAL]];
        RETURN[type];
        };

    UnderType: PUBLIC SAFE PROC [type: Type] RETURNS [Type] = TRUSTED {
        entry: RTTCache.IntEntry;
        int: INT;
        entry _ RTTCache.LookupInt[type, UnderType];
        int _ entry.int;
        IF int >= 0 THEN {card: CARDINAL _ int; RETURN [LOOPHOLE[card]]};
        UNTIL TypeClass[type] # definition DO type _ Ground[type]; ENDLOOP;
        [] _ RTTCache.FillIntEntry[entry, LOOPHOLE[type, CARDINAL]];
        RETURN[type];
        };

    UnderClass: PUBLIC SAFE PROC [type: Type] RETURNS [Class] = TRUSTED {
        RETURN[TypeClass[UnderType[type]]];
        };

    First: PUBLIC SAFE PROC [type: Type--enumerated, subrange, basic--] RETURNS [tv: TypedVariable] = TRUSTED {
        class: Class = TypeClass[UnderType[type]];
        IF class = subrange THEN {
            stb: SymbolTableBase;
            sei: SymbolIndex;
            csei: SymbolConstructorIndex;
            [stb, sei] _ GetTypeSymbols[type];
            csei _ SEUnderType[stb, sei];
            WITH stb SELECT FROM
                t: SymbolTableBase.x =>
                    WITH ser: t.e.seb[NARROW[csei, SymbolConstructorIndex.x].e] SELECT FROM
                        subrange => {empty: BOOL = ser.empty;
                            ReleaseSTB[stb];
                            IF empty THEN ERROR Error[reason: rangeFault]};
                    ENDCASE => {ReleaseSTB[stb]; ERROR};
                t: SymbolTableBase.y =>
                    WITH ser: t.e.seb[NARROW[csei, SymbolConstructorIndex.y].e] SELECT FROM
                        subrange => {empty: BOOL = ser.empty;
                            ReleaseSTB[stb];
                            IF empty THEN ERROR Error[reason: rangeFault]};
                    ENDCASE => {ReleaseSTB[stb]; ERROR};
                ENDCASE => ERROR;
            tv _ New[type];
            RETURN}; -- the "0" that's there already is always the right stored representation!!

        tv _ New[type];
        SELECT class FROM
            enumerated => SetTVFromLC[tv, 0];
            cardinal => SetTVFromLC[tv, FIRST[CARDINAL]];
            integer => SetTVFromLI[tv, LONG[FIRST[INTEGER]]];
            character => SetTVFromLC[tv, LONG[LOOPHOLE[FIRST[CHARACTER], CARDINAL]]];
            longInteger => SetTVFromLI[tv, FIRST[LONG INTEGER]];
            longCardinal => SetTVFromLC[tv, FIRST[LONG CARDINAL]];
            ENDCASE => ERROR Error[reason: typeFault, type: type];
        };

    Last: PUBLIC SAFE PROC [type: Type--enumerated, subrange, basic--] RETURNS[tv: TypedVariable] = TRUSTED  {
        class: Class = TypeClass[UnderType[type]];
        tv _ New[type];
        SELECT class FROM
            enumerated, subrange =>  {
                stb: SymbolTableBase;
                sei: SymbolIndex;
                i: INTEGER;
                [stb, sei] _ GetTypeSymbols[type];
                { ENABLE UNWIND => ReleaseSTB[stb];
                    csei: SymbolConstructorIndex _ SEUnderType[stb, sei];
                    WITH stb SELECT FROM
                        t: SymbolTableBase.x =>
                            WITH ser: t.e.seb[NARROW[csei, SymbolConstructorIndex.x].e] SELECT FROM
                                enumerated => i _ LOOPHOLE[ser.nValues - 1, INTEGER];
                                subrange => {
                                    IF ser.empty THEN ERROR Error[reason: rangeFault];
                                    i _ ser.origin + ser.range};
                                ENDCASE => ERROR Error[reason: typeFault, type: type];
                        t: SymbolTableBase.y =>
                            WITH ser: t.e.seb[NARROW[csei, SymbolConstructorIndex.y].e] SELECT FROM
                                enumerated => i _ LOOPHOLE[ser.nValues - 1, INTEGER];
                                subrange => {
                                    IF ser.empty THEN ERROR Error[reason: rangeFault];
                                    i _ ser.origin + ser.range};
                                ENDCASE => ERROR Error[reason: typeFault, type: type];
                        ENDCASE => ERROR;
                    };
                ReleaseSTB[stb];
                IF class = enumerated
                    THEN SetTVFromLC[tv, LONG[LOOPHOLE[i, CARDINAL]]]
                    ELSE SetTVFromLI[tv, LONG[i]];
                };
            cardinal => SetTVFromLC[tv, LAST[CARDINAL]];
            integer => SetTVFromLI[tv, LONG[LAST[INTEGER]]];
            character => SetTVFromLC[tv, LONG[LOOPHOLE[LAST[CHARACTER], CARDINAL]]];
            longInteger => SetTVFromLI[tv, LAST[LONG INTEGER]];
            longCardinal => SetTVFromLC[tv, LAST[LONG CARDINAL]];
            ENDCASE => ERROR Error[reason: typeFault, type: type];
        };

    NValues: PUBLIC SAFE PROC [type: Type--enumerated, subrange--] RETURNS [int: INT] = TRUSTED  {
        stb: SymbolTableBase;
        sei: SymbolIndex;
        csei: SymbolConstructorIndex;
        entry: RTTCache.IntEntry;
        type _ UnderType[type];

        entry _ RTTCache.LookupInt[type, NValues];
        int _ entry.int;
        IF int >= 0 THEN RETURN[int];

        [stb, sei] _ GetTypeSymbols[type];
        {ENABLE UNWIND => ReleaseSTB[stb];
            csei _ SEUnderType[stb, sei];
            WITH stb SELECT FROM
                t: SymbolTableBase.x =>
                    WITH ser: t.e.seb[NARROW[csei, SymbolConstructorIndex.x].e] SELECT FROM
                        enumerated => int _ IF ser.nValues = 0 THEN 200000B ELSE ser.nValues;
                        subrange => int _ IF ser.empty THEN 0 ELSE 1 + ser.range;
                        ENDCASE => ERROR Error[reason: typeFault, type: type];
                t: SymbolTableBase.y =>
                    WITH ser: t.e.seb[NARROW[csei, SymbolConstructorIndex.y].e] SELECT FROM
                        enumerated => int _ IF ser.nValues = 0 THEN 200000B ELSE ser.nValues;
                        subrange => int _ IF ser.empty THEN 0 ELSE 1 + ser.range;
                        ENDCASE => ERROR Error[reason: typeFault, type: type];
                ENDCASE => ERROR;
                };
        ReleaseSTB[stb];
        [] _ RTTCache.FillIntEntry[entry, int];
        };

    Value: PUBLIC SAFE PROC [type: Type--enumerated--, index: CARDINAL] RETURNS [tv: TypedVariable] = TRUSTED {
        <<raises typeFault, badIndex>>
        <<index range is [1..NValues[type]]>>
        type _ UnderType[type];
        IF TypeClass[type] # enumerated THEN ERROR Error[reason: typeFault, type: type];
        IF index > NValues[type] THEN ERROR Error[reason: badIndex];
        tv _ AMTypes.New[type];
        SetTVFromLC[tv, index-1];
        };

    ComponentISEI: PUBLIC PROC [type: Type--union, enumerated--, index: CARDINAL, p: PROC[stb: SymbolTableBase, isei: SymbolIdIndex]] = 
    {
        <<This is exported to RTTypesPrivate, and is imported by RTTypedVariablesImpl>>
        stb: SymbolTableBase;
        sei: SymbolIndex;
        [stb, sei] _ GetTypeSymbols[type];
        { ENABLE UNWIND => ReleaseSTB[stb];
            csei: SymbolConstructorIndex _ SEUnderType[stb, sei];
            n: CARDINAL _ 0;
            ctxi: SymbolContextIndex;
            enumeration: BOOL _ FALSE;

            looker: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOL] = {
                n _ n + 1;
                IF enumeration
                    THEN {
                        IF index-1 = IDCardinalValue[stb, isei]
                            THEN {p[stb, isei]; RETURN[TRUE]}
                            ELSE RETURN[FALSE];
                        }
                    ELSE
                        IF n = index
                            THEN {p[stb, isei]; RETURN[TRUE]}
                            ELSE RETURN[FALSE];
                };

            WITH stb SELECT FROM
                t: SymbolTableBase.x =>
                    WITH ser: t.e.seb[NARROW[csei, SymbolConstructorIndex.x].e] SELECT FROM
                        union =>
                            IF index = 0
                                THEN {p[stb, [x[ser.tagSei]]]; ReleaseSTB[stb]; RETURN}
                                ELSE ctxi _ [x[ser.caseCtx]];
                        sequence => {
                            <<RRA: to get the name of a sequence tag>>
                            p[stb, [x[ser.tagSei]]]; ReleaseSTB[stb]; RETURN};
                        enumerated => {enumeration _ TRUE; ctxi _ [x[ser.valueCtx]]};
                        ENDCASE => ERROR Error[reason: typeFault, type: type];
                t: SymbolTableBase.y =>
                    WITH ser: t.e.seb[NARROW[csei, SymbolConstructorIndex.y].e] SELECT FROM
                        union =>
                            IF index = 0
                                THEN {p[stb, [y[ser.tagSei]]]; ReleaseSTB[stb]; RETURN}
                                ELSE ctxi _ [y[ser.caseCtx]];
                        sequence => {
                            <<RRA: to get the name of a sequence tag>>
                            p[stb, [y[ser.tagSei]]]; ReleaseSTB[stb]; RETURN};
                        enumerated => {enumeration _ TRUE; ctxi _ [y[ser.valueCtx]]};
                        ENDCASE => ERROR Error[reason: typeFault, type: type];
                ENDCASE => ERROR;
            IF NOT EnumerateCtxIseis[stb, ctxi, looker] THEN ERROR Error[reason: badIndex];
            };
        ReleaseSTB[stb];
        };

    RecordComponentISEI: PUBLIC PROC [type: Type--record, structure--, index: Index, p: PROC[stb: SymbolTableBase, isei: 
    SymbolIdIndex]] = {
        stb: SymbolTableBase;
        sei: SymbolIndex;
        [stb, sei] _ GetTypeSymbols[type];
        { ENABLE UNWIND => ReleaseSTB[stb];
            csei: SymbolConstructorIndex _ SEUnderType[stb, sei];
            n: Index _ 0;

            looker: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOL] = {
                n _ n + 1;
                IF n = index
                    THEN {p[stb, isei]; RETURN[TRUE]}
                    ELSE RETURN[FALSE]};

            WITH stb SELECT FROM
                t: SymbolTableBase.x =>
                    WITH ser: t.e.seb[NARROW[csei, SymbolConstructorIndex.x].e] SELECT FROM
                        record =>
                            IF NOT EnumerateRecordIseis[stb, LOOPHOLE[csei, SymbolRecordIndex], looker]
                                THEN ERROR Error[reason: badIndex];
                        definition =>
                            IF NOT EnumerateCtxIseis[stb, [x[ser.defCtx]], looker]
                                THEN ERROR Error[reason: badIndex];
                        ENDCASE => ERROR Error[reason: typeFault, type: type];
                t: SymbolTableBase.y =>
                    WITH ser: t.e.seb[NARROW[csei, SymbolConstructorIndex.y].e] SELECT FROM
                        record =>
                            IF NOT EnumerateRecordIseis[stb, LOOPHOLE[csei, SymbolRecordIndex], looker]
                                THEN ERROR Error[reason: badIndex];
                        definition =>
                            IF NOT EnumerateCtxIseis[stb, [y[ser.defCtx]], looker]
                                THEN ERROR Error[reason: badIndex];
                        ENDCASE => ERROR Error[reason: typeFault, type: type];
                ENDCASE => ERROR;
            };
        ReleaseSTB[stb];
        };

    <<... NOTE and procedures for dealing with code TypedVariables...>>

        <<Procedures private to this module>>

    CtxEntries: PROC[stb: SymbolTableBase, ctx: SymbolContextIndex] RETURNS[CARDINAL] = {
        n: CARDINAL _ 0;
        counter: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOL] = {
            n _ n + 1;
            RETURN[FALSE];
            };
        [] _ EnumerateCtxIseis[stb, ctx, counter];
        RETURN[n];
        };

    GetOrigin: PUBLIC SAFE PROC[type: Type] RETURNS[origin: INTEGER _ 0] = TRUSTED {
        stb: SymbolTableBase;
        sei: SymbolIndex;
        csei: SymbolConstructorIndex;
        entry: RTTCache.IntEntry _ NIL;

        IF Size[type] > 1 THEN RETURN[0]; -- no subranges in long domain
        entry _ RTTCache.LookupInt[type, GetOrigin];
        IF entry.int # -1 THEN RETURN[entry.int];
        [stb, sei] _ GetTypeSymbols[type];
        { ENABLE UNWIND => ReleaseSTB[stb];
            csei _ SEUnderType[stb, sei];
            WITH stb SELECT FROM
                t: SymbolTableBase.x =>
                    WITH ser: t.e.seb[NARROW[csei, SymbolConstructorIndex.x].e] SELECT FROM
                    subrange => origin _ ser.origin
                    ENDCASE; 
                t: SymbolTableBase.y =>
                    WITH ser: t.e.seb[NARROW[csei, SymbolConstructorIndex.y].e] SELECT FROM
                    subrange => origin _ ser.origin
                    ENDCASE; 
                ENDCASE => ERROR; 
            };
        ReleaseSTB[stb];
        IF entry # NIL THEN [] _ RTTCache.FillIntEntry[entry, origin];
        };

    END.