[Cyan]<Cedar6.1>AMTypes>AMTypesAImpl.mesa!1

AMTypesAImpl.Mesa

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;

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;

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;

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 {array, sequence, union, transfer, descriptor, longDescriptor, relativePointer}

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 {array, sequence, procedure, signal, process, address} (not atom, rope)

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

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;

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 {

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

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 {

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 {

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.