-- AMTypesAImpl.Mesa
-- Paul Rovner, March 4, 1983 4:01 pm
-- NOTE do Equal, AsGoodAs
-- try to avoid acquisition of already acquired symbol tables
-- status stuff is wrong.
-- Russ Atkinson, April 4, 1983 8:06 pm
-- IndexToName[seqType, 0] now returns tag name
-- IndexToName, NameToIndex & IndexToType cache values for union types

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

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

-- E R R O R
Error: PUBLIC ERROR[ reason: ErrorReason,
msg: ROPE ← NIL,
type: Type ← RTBasic.nullType,-- used with TypeFault, IncompatibleTypes
otherType: Type ← RTBasic.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

-- MOVE
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: BOOLEAN] =
{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: BOOLEAN] =
{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];
};

-- This returns the Type of the specified component of
-- instances of the type. index starts at 1.
-- break up and MOVE
IndexToType: PUBLIC SAFE PROC[type: Type--record, structure, union--, index: Index]
RETURNS[ans: Type] = TRUSTED
{ 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]};
};

-- This returns the Status of the specified component of
-- instances of the type. index starts at 1.
-- MOVE
IndexToStatus: PUBLIC PROC[type: Type--record, structure--, index: Index]
RETURNS[ans: Status] =
{ 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]};

-- index starts at 1
-- raises typeFault, badName
-- break up and MOVE
NameToIndex: PUBLIC SAFE PROC
[type: Type--record, structure, union, enumerated--, name: ROPE]
RETURNS[ans: CARDINAL ← 0] = TRUSTED
{ enumerated: BOOLEAN ← 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: BOOLEAN] =
{IF enumerated THEN ans ← IDCardinalValue[stb, isei] + 1 ELSE ans ← ans + 1;
stop ← 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

-- break up and MOVE
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];
};

-- MOVE
IsPacked: PUBLIC SAFE PROC[type: Type--array, sequence--]
RETURNS [ans: BOOLEAN] = 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];
}};

-- break up and MOVE
-- MOVE
Domain: PUBLIC SAFE PROC
[type: Type--array, sequence, union, transfer, descriptor, longDescriptor, relativePointer--]
RETURNS[ans: Type] = TRUSTED {
stb: SymbolTableBase;
sei: SymbolIndex;

entry: RTTCache.IntEntry;
int: INT;
entry ← RTTCache.LookupInt[type, Domain];
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]}; -- end ENABLE UNWIND

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

--applicable to array, sequence, procedure, signal, process, address (not atom, rope)--
-- break up and MOVE
Range: PUBLIC SAFE PROC[type: Type] RETURNS[ans: Type] = TRUSTED {
stb: SymbolTableBase;
sei: SymbolIndex;

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

SELECT TypeClass[UnderType[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]]}; -- end Range

-- MOVE
ReferentStatus: PUBLIC SAFE PROC
[type: Type--address--] RETURNS [ans: Status] = TRUSTED {
stb: SymbolTableBase;
sei: SymbolIndex;

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

[stb, sei] ← GetTypeSymbols[type];
{ ENABLE UNWIND => ReleaseSTB[stb];
readOnlyReferent: BOOLEAN ← FALSE;

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 => 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 => ERROR Error[reason: typeFault, type: type];
ref => readOnlyReferent ← ser2.readOnly;
ENDCASE => ERROR Error[reason: typeFault, type: type];
arraydesc => readOnlyReferent ← ser.readOnly;
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
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 => ERROR Error[reason: typeFault, type: type];
ref => readOnlyReferent ← ser2.readOnly;
ENDCASE => ERROR Error[reason: typeFault, type: type];
arraydesc => readOnlyReferent ← ser.readOnly;
ENDCASE => ERROR Error[reason: typeFault, type: type];
ENDCASE => ERROR;
ReleaseSTB[stb];

ans ← IF readOnlyReferent THEN readOnly ELSE mutable}; -- end ENABLE UNWIND
[] ← RTTCache.FillIntEntry[entry, LOOPHOLE[ans, CARDINAL]]}; -- end ReferentStatus

-- break up and MOVE
TypeToName: PUBLIC SAFE PROC
[type: Type--definition--, moduleName, fileName: REF ROPE ← NIL]
RETURNS [ans: ROPE] = TRUSTED
{ IF type = nullType THEN RETURN[NIL];
IF type = unspecType THEN RETURN ["UNSPECIFIED"];
IF type = fhType THEN RETURN ["SomeFrameHandle"];
IF type = gfhType THEN RETURN["SomeGlobalFrameHandle"];
IF type = listOfRefAnyType THEN RETURN["ListOfREFANY"];
IF type = refAnyType THEN RETURN["REFANY"];
IF type = anyType THEN RETURN["ANY"];

{ stb: SymbolTableBase ← nullBase;
sei: SymbolIndex;
class: Class ← TypeClass[type];
IF class = atom THEN RETURN["ATOM"] ELSE IF class = rope THEN RETURN["ROPE"];

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};
ReleaseSTB[stb]}; -- end ENABLE UNWIND
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};
ReleaseSTB[stb]}; -- end ENABLE UNWIND
ENDCASE => ERROR;
}};

-- peels off one layer
-- MOVE
Ground: PUBLIC SAFE PROC
[type: Type--definition, subrange--] RETURNS[ans: Type] = TRUSTED {
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]]};
[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 =>
{ IF TypeClass[type] = cardinal THEN {ReleaseSTB[stb]; GO TO fault};
ans ← AcquireType[stb, [x[ser.rangeType]]]};
ENDCASE => {ReleaseSTB[stb]; GO TO fault}};
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 =>
{ IF TypeClass[type] = cardinal THEN {ReleaseSTB[stb]; GO TO fault};
ans ← AcquireType[stb, [y[ser.rangeType]]]};
ENDCASE => {ReleaseSTB[stb]; GO TO fault}};
ENDCASE => ERROR;
ReleaseSTB[stb]}; -- end ENABLE UNWIND

[] ← 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
{entry: RTTCache.IntEntry;
int: INT;
entry ← RTTCache.LookupInt[type, GroundStar];
int ← entry.int;
IF int >= 0 THEN {card: CARDINAL ← int; RETURN [LOOPHOLE[card]]};
UNTIL AtGround[type] DO type ← Ground[type] ENDLOOP;
[] ← RTTCache.FillIntEntry[entry, LOOPHOLE[type, CARDINAL]];
RETURN[type]};

UnderType: PUBLIC SAFE PROC[type: Type--definition--] 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]};

AtGround: PROC[type: Type] RETURNS [BOOLEAN] =
{ class: Class = TypeClass[type];
RETURN[class # definition AND class # subrange]};

-- break up and MOVE
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: BOOLEAN = 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: BOOLEAN = 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];
};

-- break up and MOVE
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];
};

-- MOVE
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];
};

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

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

looker: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOLEAN] =
{ 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]};
};


-- MOVE
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: BOOLEAN] =
{ 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]}; -- end ENABLE UNWIND
};

-- ... 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: BOOLEAN] =
{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.