-- RTTypesImpl.Mesa
-- Paul Rovner, December 21, 1982 9:13 am
-- NOTE do Equal, AsGoodAs
-- try to avoid acquisition of already acquired symbol tables
-- status stuff is wrong.

DIRECTORY
AMBridge USING
[SetTVFromLC, SetTVFromLI, TVForReferent],
AMTypes USING[Class, Index, Status, TypedVariable, ErrorReason, New],
Environment USING[bitsPerWord],
Rope USING [ROPE, Equal, Text],
RTBasic USING [nullType],
RTCommon USING [ShortenLongCardinal],
RTStorageOps USING[NewObject],
RTSymbols USING
[EnumerateCtxIseis, EnumerateRecordIseis, CountComponents,
AcquireType, AcquireSequenceType, AcquireRope,
GetTypeSymbols, GetOriginalTypeSymbols, SymbolTableBase, ReleaseSTB,
STBToModuleName, SymbolConstructorIndex, SymbolContextIndex,
SymbolIdIndex, SymbolModuleIndex, SymbolRecordIndex, SymbolIndex, nullSymbolIndex,
symbolIndexForANY, StandardSymbolContextIndex, thisModuleIndex, typeCodeForINT,
typeCodeForCHAR],
RTTCache USING[RefEntry, LookupRef, FillRefEntry, IntEntry, LookupInt, FillIntEntry,
ComponentMap, NewComponentMap, FillTypeComponent,
FillNameComponent, GetComponentAtIndex, GetComponentForName,
ComponentEntry],
RTTypesBasic USING[Type, unspecType, nullType, fhType, gfhType, GetCanonicalType,
listOfRefAnyType, refAnyType, anyType],
RTTypesPrivate USING[GetTVZones];

RTTypesImpl: PROGRAM
IMPORTS AMBridge, AMTypes, Rope, RTCommon, RTStorageOps, RTSymbols, RTTCache,
RTTypesBasic, RTTypesPrivate
EXPORTS AMTypes, RTTypesPrivate
= BEGIN OPEN AMBridge, AMTypes, Environment, Rope, RTTypesPrivate, RTTypesBasic,
RTSymbols, RTStorageOps;

-- T Y P E S
BitsForTypeInfo: TYPE = RECORD
[bft: LONG CARDINAL, argumentRecord, interfaceRecord: BOOLEAN];
-- must be the same as the return type of BitsForType

-- C O N S T A N T S
tvqZone: ZONE = GetTVZones[].qz;
tvpZone: ZONE = GetTVZones[].pz;

-- 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

-- MOVE
BitsForType: PUBLIC PROC[type: Type]
RETURNS [bft: LONG CARDINAL, argumentRecord, interfaceRecord: BOOLEAN] =
{stb: SymbolTableBase;
sei: SymbolIndex;

entry: RTTCache.RefEntry;
info: REF BitsForTypeInfo;
IF type = nullType THEN RETURN[2*bitsPerWord, FALSE, FALSE]; -- NIL
entry ← RTTCache.LookupRef[type, LOOPHOLE[BitsForType]];
info ← NARROW[entry.ref];
IF info # NIL THEN RETURN [info.bft, info.argumentRecord, info.interfaceRecord];

[stb, sei] ← GetTypeSymbols[type];
{ENABLE UNWIND => ReleaseSTB[stb];
csei: SymbolConstructorIndex = stb.UnderType[sei];
WITH ser: stb.seb[csei] SELECT FROM
record =>
{w: LONG CARDINAL = stb.WordsForType[csei];
argumentRecord ← ser.argument;
interfaceRecord ← FALSE;
IF w > 1
THEN bft ← w * bitsPerWord
ELSE bft ← stb.BitsForType[csei]};
definition =>
{ans: CARDINAL ← 0;
proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOLEAN] =
{IF NOT stb.seb[isei].constant THEN ans ← MAX[ans, stb.seb[isei].idValue];
RETURN[FALSE]};
[] ← EnumerateCtxIseis[stb, ser.defCtx, proc];
argumentRecord ← FALSE;
interfaceRecord ← TRUE;
bft ← (ans + 1)*bitsPerWord};
ENDCASE =>
{w: LONG CARDINAL = stb.WordsForType[csei];
argumentRecord ← FALSE;
interfaceRecord ← FALSE;
IF w > 1
THEN bft ← w * bitsPerWord
ELSE bft ← stb.BitsForType[csei];
IF bft = 0 THEN ERROR Error[reason: typeFault, type: type]};
ReleaseSTB[stb]}; -- end ENABLE UNWIND

info ← tvpZone.NEW[BitsForTypeInfo ← [bft, argumentRecord, interfaceRecord]];
[] ← RTTCache.FillRefEntry[entry, info];
}; -- end BitsForType

-- These procedures are applicable to all types.

-- max for unions
-- Could overflow!
-- MOVE
Size: PUBLIC SAFE PROC[type: Type, length: CARDINAL ← 0--for sequence-containing records--]
RETURNS[ans: CARDINAL ← 0 --number of words--] = TRUSTED
{stb: SymbolTableBase;
uType: Type = UnderType[type];
csei: SymbolConstructorIndex;
sei: SymbolIndex;

entry: RTTCache.IntEntry ← NIL;
int: INT;
IF type = nullType THEN RETURN[2];
SELECT type FROM fhType, gfhType => ERROR Error[reason: typeFault, type: type]; ENDCASE;
IF length = 0 THEN
{entry ← RTTCache.LookupInt[type, Size];
int ← entry.int;
IF int >= 0 THEN RETURN [int]};

[stb, sei] ← GetTypeSymbols[type];
{ENABLE UNWIND => ReleaseSTB[stb];
csei ← stb.UnderType[sei];

-- check for argument records and interface records
WITH ser: stb.seb[csei] SELECT FROM
record =>
IF ser.argument
THEN { FOR isei: SymbolIdIndex ← stb.FirstCtxSe[ser.fieldCtx], stb.NextSe[isei]
UNTIL isei = nullSymbolIndex
DO ans ← MAX[ans,
stb.FnField[isei].offset.wd*bitsPerWord + stb.seb[isei].idInfo]
ENDLOOP;
ReleaseSTB[stb];
ans ← ans/bitsPerWord + (IF ans MOD bitsPerWord # 0 THEN 1 ELSE 0);
IF entry # NIL THEN [] ← RTTCache.FillIntEntry[entry, ans];
RETURN[ans]};
definition =>
{proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOLEAN] =
{IF stb.LinkMode[isei] # manifest THEN ans ← MAX[ans, stb.seb[isei].idValue];
RETURN[FALSE]};
[] ← EnumerateCtxIseis[stb, ser.defCtx, proc];
ReleaseSTB[stb];
ans ← ans + 1;
IF entry # NIL THEN [] ← RTTCache.FillIntEntry[entry, ans];
RETURN[ans]};
ENDCASE; -- not argument record or interface record

SELECT TypeClass[uType] FROM
union, sequence=> ERROR Error[reason: typeFault, type: type];
record, structure =>
{sType: Type;
sClass: Class;
[v: sType, c: sClass] ← VariableType[uType];
SELECT sClass FROM
sequence=>
{sstb: SymbolTableBase;
ssei: SymbolIndex;
[sstb, ssei] ← GetTypeSymbols[sType];
{ENABLE UNWIND => ReleaseSTB[sstb];
scsei: SymbolConstructorIndex = sstb.UnderType[ssei];
WITH ser: sstb.seb[scsei] SELECT FROM
sequence =>
{bpe: LONG CARDINAL =
sstb.BitsPerElement[type: ser.componentType, packed: ser.packed];
ans ← RTCommon.ShortenLongCardinal[(bpe*length+bitsPerWord-1)/bitsPerWord]};
ENDCASE=>ERROR;
ReleaseSTB[sstb]}};
ENDCASE};
ENDCASE;
ans ← ans + stb.WordsForType[csei];
ReleaseSTB[stb]}; -- end ENABLE UNWIND

IF entry # NIL THEN [] ← RTTCache.FillIntEntry[entry, ans];
}; -- end Size

-- the Type itself is the color. Record and enumerated types are painted.
IsPainted: PUBLIC SAFE PROC[type: Type] RETURNS[ans: BOOLEAN] = TRUSTED {
RETURN[SELECT TypeClass[UnderType[type]] FROM
enumerated, record => TRUE,
ENDCASE => FALSE]};

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

entry: RTTCache.IntEntry;
int: INT;
SELECT type FROM
fhType => RETURN[localFrame];
nullType => RETURN[nil];
gfhType => RETURN[globalFrame];
unspecType => RETURN[unspecified];
ENDCASE;
entry ← RTTCache.LookupInt[type, TypeClass];
int ← entry.int;
IF int >= 0 THEN {card: CARDINAL ← int; RETURN [LOOPHOLE[card]]};

[stb, sei] ← GetTypeSymbols[type];
{ ENABLE UNWIND => ReleaseSTB[stb];
csei: SymbolConstructorIndex ← stb.UnderType[sei];

IF stb.seb[sei].seTag = id THEN {ans ← definition; GO TO answer};
IF GetCanonicalType[type] = GetCanonicalType[CODE[ROPE]]
OR GetCanonicalType[type] = GetCanonicalType[CODE[Text]]
THEN {ans ← rope; GO TO answer};
ans ←
(WITH ser: stb.seb[csei] SELECT FROM
basic => SelectBasicClass[ser.code],
record => (IF ser.painted THEN record ELSE structure),
definition => record,
real => real,
union => union,
array => array,
opaque => opaque,
sequence => sequence,
relative => relativePointer,
ref => (IF ser.counted OR ser.basing THEN ERROR ELSE pointer),
arraydesc => descriptor,
long =>
(WITH rse: stb.seb[stb.UnderType[ser.rangeType] ] SELECT FROM
ref => (IF rse.counted
THEN (IF rse.list
THEN list
ELSE WITH t: stb.seb[stb.UnderType[rse.refType]] SELECT FROM
opaque => IF stb.seb[t.id].idCtx IN StandardSymbolContextIndex
THEN atom ELSE ref
ENDCASE => ref)
ELSE (IF rse.basing THEN basePointer ELSE longPointer)),
basic => (IF rse.code = typeCodeForINT THEN longInteger ELSE ERROR),
arraydesc => longDescriptor,
subrange =>
(WITH rrse: stb.seb[stb.UnderType[rse.rangeType] ] SELECT FROM
basic => (IF rrse.code = typeCodeForINT AND rse.origin = 0
AND rse.range = LAST[CARDINAL]
THEN longCardinal ELSE ERROR),
ENDCASE => ERROR),
ENDCASE => ERROR),
enumerated => enumerated,
subrange =>
(WITH rse: stb.seb[stb.UnderType[ser.rangeType] ] SELECT FROM
basic => (IF rse.code = typeCodeForINT AND ser.origin = 0
AND ser.range = LAST[CARDINAL]
THEN cardinal ELSE subrange),
ENDCASE => subrange),
subrange => subrange,
transfer => (SELECT ser.mode FROM
proc => procedure,
port => port,
signal => signal,
error => error,
process => process,
program => program,
ENDCASE => ERROR),
zone => (IF ser.counted THEN countedZone ELSE uncountedZone),
mode => type,
any => any,
ENDCASE => ERROR Error[reason: typeFault, type: type]);
ReleaseSTB[stb];
EXITS
answer => ReleaseSTB[stb]};
[] ← RTTCache.FillIntEntry[entry, LOOPHOLE[ans, CARDINAL]];
}; -- end TypeClass


-- 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 ← stb.UnderType[sei];

WITH ser: stb.seb[csei] 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, ser.defCtx, proc]};
ENDCASE => ERROR Error[reason: typeFault, type: type]};
ReleaseSTB[stb]};
[] ← RTTCache.FillIntEntry[entry, ans];
};

VariableType: PUBLIC SAFE PROC[type: Type] RETURNS [v: Type, c: Class] = TRUSTED
{type ← UnderType[type];
IF TypeClass[type] # record AND TypeClass[type] # structure
THEN RETURN[v: nullType, c: nil];

{nc: Index = NComponents[type];
IF nc = 0 THEN RETURN[v: nullType, c: nil];
v ← UnderType[IndexToType[type, nc]]};

c ← TypeClass[v];
SELECT c FROM
union, sequence => RETURN;
ENDCASE => RETURN[v: nullType, c: nil];
};

-- 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, stb.seb[isei].idType]
ELSE AcquireType[stb, stb.seb[isei].idInfo]};
proc2: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] =
{ sei: SymbolIndex ← stb.seb[isei].idType;
csei: SymbolConstructorIndex ← stb.UnderType[sei];
WITH cse: stb.seb[csei] SELECT FROM
sequence =>
{recstb: SymbolTableBase;
recsei: SymbolIndex;
[recstb, recsei] ← GetTypeSymbols[type];
ans ← AcquireSequenceType[stb, sei, recstb, LOOPHOLE[recstb.UnderType[recsei]]
! UNWIND => ReleaseSTB[recstb]];
ReleaseSTB[recstb]};
ref =>
{IF cse.var THEN sei ← cse.refType;
ans ← AcquireType[stb, sei]};
ENDCASE => ans ← AcquireType[stb, sei];
};
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 ← 0;
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 stb.seb[isei].immutable THEN readOnly
ELSE IF stb.seb[isei].constant 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 ← stb.seb[isei].idValue + 1 ELSE ans ← ans + 1;
stop ← Equal[name, AcquireRope[stb, stb.seb[isei].hash]]};

type ← UnderType[type];
class ← TypeClass[type];
SELECT class FROM
record, structure => n ← NComponents[type];
enumerated => n ← NValues[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];
csei: SymbolConstructorIndex ← stb.UnderType[sei];
WITH ser: stb.seb[csei] SELECT FROM
record => found ← EnumerateRecordIseis[stb, LOOPHOLE[csei, SymbolRecordIndex], proc];
definition => found ← EnumerateCtxIseis[stb, ser.defCtx, proc];
union => found ← EnumerateCtxIseis[stb, ser.caseCtx, proc];
enumerated =>
{enumerated ← TRUE; found ← EnumerateCtxIseis[stb, ser.valueCtx, proc]};
ENDCASE => ERROR Error[reason: typeFault, type: type];
};

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, stb.seb[isei].hash]};
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];
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 => ERROR Error[reason: typeFault, type: type];
IF map # NIL THEN [] ← RTTCache.FillNameComponent[map, index-1, ans];
};

-- 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];
csei: SymbolConstructorIndex ← stb.UnderType[sei];

WITH ser: stb.seb[csei] SELECT FROM
array => ans ← ser.packed;
sequence => ans ← ser.packed;
ENDCASE => ERROR Error[reason: typeFault, type: type];
ReleaseSTB[stb];
}};

-- break up and MOVE
IsOverlaid: PUBLIC SAFE PROC
[type: Type--union--] RETURNS [ans: BOOLEAN] = TRUSTED {
stb: SymbolTableBase;
sei: SymbolIndex;
class: Class = TypeClass[UnderType[type]];
IF class = record OR class = structure THEN type ← IndexToType[type, NComponents[type]];
IF class = nil THEN RETURN[FALSE];
[stb, sei] ← GetTypeSymbols[type];
{ ENABLE UNWIND => ReleaseSTB[stb];
csei: SymbolConstructorIndex ← stb.UnderType[sei];

WITH ser: stb.seb[csei] SELECT FROM
union => ans ← ser.overlaid;
ENDCASE => {ReleaseSTB[stb]; RETURN[FALSE]};
ReleaseSTB[stb];
}};

-- break up and MOVE
IsComputed: PUBLIC SAFE PROC
[type: Type--union, sequence--] RETURNS [ans: BOOLEAN] = TRUSTED {
stb: SymbolTableBase;
sei: SymbolIndex;
class: Class = TypeClass[UnderType[type]];
IF class = nil THEN RETURN[FALSE];
IF class = record OR class = structure THEN type ← IndexToType[type, NComponents[type]];
[stb, sei] ← GetTypeSymbols[type];
{ ENABLE UNWIND => ReleaseSTB[stb];
csei: SymbolConstructorIndex ← stb.UnderType[sei];

WITH ser: stb.seb[csei] SELECT FROM
union => ans ← NOT ser.controlled;
sequence => ans ← NOT ser.controlled;
ENDCASE => {ReleaseSTB[stb]; RETURN[FALSE]};
ReleaseSTB[stb];
}};

-- MOVE
IsOrdered: PUBLIC SAFE PROC[type: Type]
RETURNS [ans: BOOLEAN] = TRUSTED {
stb: SymbolTableBase;
sei: SymbolIndex;
[stb, sei] ← GetTypeSymbols[type];
{ ENABLE UNWIND => ReleaseSTB[stb];
csei: SymbolConstructorIndex ← stb.UnderType[sei];

WITH ser: stb.seb[csei] SELECT FROM
long => ans ← WITH rse: stb.seb[stb.UnderType[ser.rangeType]]
SELECT FROM
ref => rse.ordered,
enumerated => rse.ordered,
basic => rse.ordered,
ENDCASE => ERROR Error[reason: typeFault, type: type];
ref => ans ← ser.ordered;
enumerated => ans ← ser.ordered;
basic => ans ← ser.ordered;
ENDCASE => ERROR Error[reason: typeFault, type: type];
ReleaseSTB[stb];
}};


-- MOVE
IsMachineDependent: PUBLIC SAFE PROC
[type: Type--record, structure, union, enumerated, sequence--]
RETURNS[ans: BOOLEAN] = TRUSTED {
stb: SymbolTableBase;
sei: SymbolIndex;
[stb, sei] ← GetTypeSymbols[type];
{ ENABLE UNWIND => ReleaseSTB[stb];
csei: SymbolConstructorIndex ← stb.UnderType[sei];

WITH ser: stb.seb[csei] SELECT FROM
union => ans ← ser.machineDep;
definition => ans ← FALSE;
enumerated => ans ← ser.machineDep;
record => ans ← ser.machineDep;
sequence => ans ← ser.machineDep;
ENDCASE => ERROR Error[reason: typeFault, type: type];
ReleaseSTB[stb];
}};

-- 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];
csei: SymbolConstructorIndex ← stb.UnderType[sei];

WITH ser: stb.seb[csei] SELECT FROM
relative => ans ← AcquireType[stb, ser.offsetType];
array => ans ← AcquireType[stb, ser.indexType];
sequence => ans ← AcquireType[stb, stb.seb[ser.tagSei].idType];
union => ans ← AcquireType[stb, stb.seb[ser.tagSei].idType];
transfer => ans ← (IF ser.typeIn = nullSymbolIndex
THEN nullType
ELSE AcquireType[stb, ser.typeIn]);
ENDCASE => ERROR Error[reason: typeFault, type: type];
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];
csei: SymbolConstructorIndex ← stb.UnderType[sei];

WITH ser: stb.seb[csei] SELECT FROM
array => ans ← AcquireType[stb, ser.componentType];
sequence => ans ← AcquireType[stb, ser.componentType];
transfer => ans ← (IF ser.typeOut = nullSymbolIndex
THEN nullType
ELSE AcquireType[stb, ser.typeOut]);
relative => ans ← Range[AcquireType[stb, ser.resultType]];
ref => {IF ser.counted THEN ERROR Error[reason: typeFault, type: type];
ans ← (IF stb.UnderType[ser.refType] = symbolIndexForANY
THEN unspecType
ELSE AcquireType[stb, ser.refType])};
arraydesc => ans ← AcquireType[stb, ser.describedType];
long => WITH rse: stb.seb[stb.UnderType[ser.rangeType]] SELECT FROM
ref => ans ← (IF stb.UnderType[rse.refType] = symbolIndexForANY THEN unspecType
ELSE AcquireType[stb, rse.refType]);
arraydesc => ans ← AcquireType[stb, rse.describedType];
ENDCASE => ERROR Error[reason: typeFault, type: type];
ENDCASE => ERROR Error[reason: typeFault, type: type];
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];
csei: SymbolConstructorIndex ← stb.UnderType[sei];
readOnlyReferent: BOOLEAN ← FALSE;

WITH ser: stb.seb[csei] SELECT FROM
long => WITH ser1: stb.seb[stb.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: stb.seb[stb.UnderType[ser.resultType]] SELECT FROM
long => WITH ser1: stb.seb[stb.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];
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 ← NIL;
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 = NIL THEN [stb, sei] ← GetTypeSymbols[type];
{ ENABLE UNWIND => ReleaseSTB[stb];
mdi: SymbolModuleIndex ← thisModuleIndex;
WITH ser: stb.seb[sei] SELECT FROM
id => {ans ← AcquireRope[stb, ser.hash];
IF moduleName # NIL OR fileName # NIL THEN
{WITH cer: stb.ctxb[ser.idCtx] SELECT FROM
included => mdi ← cer.module;
ENDCASE;
IF moduleName # NIL THEN
moduleName^ ← AcquireRope[stb, stb.mdb[mdi].moduleId];
IF fileName # NIL THEN
fileName^ ← AcquireRope[stb, stb.mdb[mdi].fileId]}};
ENDCASE =>
{csei: SymbolConstructorIndex = stb.UnderType[sei];
IF moduleName # NIL THEN moduleName^ ← STBToModuleName[stb];
WITH ser: stb.seb[csei] SELECT FROM
definition => ans ← STBToModuleName[stb]; -- interface type
ENDCASE => ans ← NIL};
ReleaseSTB[stb]}}};

-- 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 ser: stb.seb[sei] SELECT FROM
id =>
{-- a definition
ans ← AcquireType[stb, ser.idInfo]};
ENDCASE =>
{csei: SymbolConstructorIndex ← stb.UnderType[sei];
WITH ser: stb.seb[csei] SELECT FROM
subrange =>
{ IF TypeClass[type] = cardinal THEN {ReleaseSTB[stb]; GO TO fault};
ans ← AcquireType[stb, ser.rangeType]};
ENDCASE => {ReleaseSTB[stb]; GO TO fault}};
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
{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 ← stb.UnderType[sei];
WITH ser: stb.seb[csei] SELECT FROM
subrange => {empty: BOOLEAN = ser.empty;
ReleaseSTB[stb];
IF empty THEN ERROR Error[reason: rangeFault]};
ENDCASE => {ReleaseSTB[stb]; 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 ← stb.UnderType[sei];
WITH ser: stb.seb[csei] 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];
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 ← stb.UnderType[sei];
WITH ser: stb.seb[csei] 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];
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 ← stb.UnderType[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 = stb.seb[isei].idValue
THEN {p[stb, isei]; RETURN[TRUE]}
ELSE RETURN[FALSE]}
ELSE {IF n = index
THEN {p[stb, isei]; RETURN[TRUE]}
ELSE RETURN[FALSE]}};

WITH ser: stb.seb[csei] SELECT FROM
union => IF index = 0
THEN {p[stb, ser.tagSei]; ReleaseSTB[stb]; RETURN}
ELSE ctxi ← ser.caseCtx;
enumerated => {enumeration ← TRUE; ctxi ← ser.valueCtx};
ENDCASE => ERROR Error[reason: typeFault, type: type];
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 ← stb.UnderType[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 ser: stb.seb[csei] SELECT FROM
record => IF NOT EnumerateRecordIseis[stb, LOOPHOLE[csei], looker]
THEN ERROR Error[reason: badIndex];
definition => IF NOT EnumerateCtxIseis[stb, ser.defCtx, looker]
THEN ERROR Error[reason: badIndex];
ENDCASE => ERROR Error[reason: typeFault, type: type];
ReleaseSTB[stb]};
};

-- ... NOTE and procedures for dealing with code TypedVariables...

-- Procedures private to this module

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

SelectBasicClass: PROC[code: [0..16)] RETURNS[Class] =
{ SELECT code FROM
typeCodeForINT => RETURN[integer];
typeCodeForCHAR => RETURN[character];
ENDCASE => ERROR};

-- MOVE
GetOrigin: PUBLIC PROC[type: Type] RETURNS[origin: INTEGER ← 0] =
{ stb: SymbolTableBase;
sei: SymbolIndex;
csei: SymbolConstructorIndex;
IF Size[type] > 1 THEN RETURN[0]; -- no subranges in long domain
[stb, sei] ← GetTypeSymbols[type];
csei ← stb.UnderType[sei];
WITH ser: stb.seb[csei] SELECT FROM
subrange => origin ← ser.origin
ENDCASE;
ReleaseSTB[stb]};

END.