AMTypesAImpl.Mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
NOTE do Equal, AsGoodAs
try to avoid acquisition of already acquired symbol tables
status stuff is wrong.
Paul Rovner, June 29, 1983 4:50 pm
Russ Atkinson, February 11, 1985 7:37:09 pm PST
DIRECTORY
AMBridge USING [SetTVFromLC, SetTVFromLI],
AMTypes USING [Class, Index, Status, TypedVariable, ErrorReason, New, TypeClass, Size],
BrandXSymbolDefs USING [nullSymbolIndex, SymbolConstructorIndex, SymbolIdIndex, symbolIndexForANY, SymbolModuleIndex, thisModuleIndex],
BrandYSymbolDefs USING [nullSymbolIndex, SymbolConstructorIndex, SymbolIdIndex, symbolIndexForANY, SymbolModuleIndex, thisModuleIndex],
Rope USING [Equal, ROPE],
RTSymbolDefs USING [nullBase, SymbolConstructorIndex, SymbolContextIndex, SymbolIdIndex, SymbolIndex, SymbolRecordIndex, SymbolTableBase],
RTSymbolOps USING [AcquireRope, AcquireSequenceType, AcquireType, CountComponents, EnumerateCtxIseis, EnumerateRecordIseis, IDCardinalValue, ISEConstant, ISEImmutable, ISEInfo, ISEName, ISEType, SEUnderType, STBToModuleName],
RTSymbols USING [GetTypeSymbols, GetOriginalTypeSymbols, ReleaseSTB],
RTTCache USING [ComponentEntry, ComponentMap, FillIntEntry, FillNameComponent, FillRefEntry, FillTypeComponent, GetComponentAtIndex, GetComponentForName, IntEntry, LookupInt, LookupRef, NewComponentMap, RefEntry],
RTTypesPrivate USING[],
SafeStorage USING [nullType, Type, unspecType];
AMTypesAImpl:
PROGRAM
IMPORTS AMBridge, AMTypes, Rope, RTSymbolOps, RTSymbols, RTTCache
EXPORTS AMTypes, RTTypesPrivate
=
BEGIN
OPEN AMBridge, AMTypes, bx: BrandXSymbolDefs, by: BrandYSymbolDefs, SafeStorage, RTSymbolOps, RTSymbolDefs, RTSymbols;
T Y P E S
ROPE: TYPE = Rope.ROPE;
E R R O R
Error:
PUBLIC
ERROR[ reason: ErrorReason,
msg: ROPE ← NIL,
type: Type ← nullType,-- used with TypeFault, IncompatibleTypes
otherType: Type ← nullType -- used with IncompatibleTypes
] = CODE;
P U B L I C P R O C E D U R E S
These procedures have applicability restrictions, noted as comments
NComponents:
PUBLIC
SAFE
PROC [type: Type
--record, structure--]
RETURNS [ans: Index] =
TRUSTED {
entry: RTTCache.IntEntry;
int: INT;
IF type = nullType THEN RETURN[0];
entry ← RTTCache.LookupInt[type, NComponents];
int ← entry.int;
IF int >= 0 THEN RETURN [int];
{stb: SymbolTableBase;
sei: SymbolIndex;
[stb, sei] ← GetTypeSymbols[type];
{
ENABLE
UNWIND => ReleaseSTB[stb];
csei: SymbolConstructorIndex ← SEUnderType[stb, sei];
WITH stb
SELECT
FROM
t: SymbolTableBase.x =>
WITH ser: t.e.seb[
NARROW[csei, SymbolConstructorIndex.x].e]
SELECT
FROM
record => ans ← CountComponents[stb, LOOPHOLE[csei]];
definition =>
{proc:
PROC[stb: SymbolTableBase, isei: SymbolIdIndex]
RETURNS[stop:
BOOL] =
{ans ← ans + 1; RETURN[FALSE]};
ans ← 0;
[] ← EnumerateCtxIseis[stb, [x[ser.defCtx]], proc]};
ENDCASE => ERROR Error[reason: typeFault, type: type];
t: SymbolTableBase.y =>
WITH ser: t.e.seb[
NARROW[csei, SymbolConstructorIndex.y].e]
SELECT
FROM
record => ans ← CountComponents[stb, LOOPHOLE[csei]];
definition =>
{proc:
PROC[stb: SymbolTableBase, isei: SymbolIdIndex]
RETURNS[stop:
BOOL] =
{ans ← ans + 1; RETURN[FALSE]};
ans ← 0;
[] ← EnumerateCtxIseis[stb, [y[ser.defCtx]], proc]};
ENDCASE => ERROR Error[reason: typeFault, type: type];
ENDCASE => ERROR;
};
ReleaseSTB[stb]};
[] ← RTTCache.FillIntEntry[entry, ans];
IndexToType:
PUBLIC
SAFE
PROC [type: Type
--record, structure, union--, index: Index]
RETURNS[ans: Type] =
TRUSTED {
This returns the Type of the specified component of instances of the type. index starts at 1.
proc1:
PROC[stb: SymbolTableBase, isei: SymbolIdIndex] = {
ans ←
IF index = 0
THEN AcquireType[stb, ISEType[stb, isei]]
ELSE AcquireType[stb, ISEInfo[stb, isei]]};
proc2:
PROC[stb: SymbolTableBase, isei: SymbolIdIndex] = {
sei: SymbolIndex ← ISEType[stb, isei];
WITH stb
SELECT
FROM
t: SymbolTableBase.x =>
WITH cse: t.e.seb[t.e.UnderType[
NARROW[sei, SymbolIndex.x].e]]
SELECT
FROM
sequence => {
recstb: SymbolTableBase;
recsei: SymbolIndex;
[recstb, recsei] ← GetTypeSymbols[type];
ans ← AcquireSequenceType[stb, sei, recstb,
LOOPHOLE[SEUnderType[recstb, recsei],
SymbolRecordIndex]
! UNWIND => ReleaseSTB[recstb]];
ReleaseSTB[recstb]};
ref => {
IF cse.var THEN sei ← [x[cse.refType]];
ans ← AcquireType[stb, sei]};
ENDCASE => ans ← AcquireType[stb, sei];
t: SymbolTableBase.y =>
WITH cse: t.e.seb[t.e.UnderType[
NARROW[sei, SymbolIndex.y].e]]
SELECT
FROM
sequence => {
recstb: SymbolTableBase;
recsei: SymbolIndex;
[recstb, recsei] ← GetTypeSymbols[type];
ans ← AcquireSequenceType[stb, sei, recstb,
LOOPHOLE[SEUnderType[recstb, recsei],
SymbolRecordIndex]
! UNWIND => ReleaseSTB[recstb]];
ReleaseSTB[recstb]};
ref => {
IF cse.var THEN sei ← [y[cse.refType]];
ans ← AcquireType[stb, sei]};
ENDCASE => ans ← AcquireType[stb, sei];
ENDCASE => ERROR;
};
entry: RTTCache.RefEntry;
map: RTTCache.ComponentMap;
class: Class;
n: NAT ← 0;
type ← UnderType[type];
class ← TypeClass[type];
SELECT class
FROM
record, structure => n ← NComponents[type];
union => n ← NValues[Domain[type]];
ENDCASE => ERROR Error[reason: typeFault, type: type];
entry ← RTTCache.LookupRef[type, IndexToType];
map ← NARROW[entry.ref, RTTCache.ComponentMap];
IF map #
NIL
AND index
IN [1..map.len]
AND map[index-1].validType
THEN RETURN [map[index-1].type];
SELECT class
FROM
record, structure => RecordComponentISEI[type, index, proc2];
union => ComponentISEI[type, index, proc1];
ENDCASE => ERROR Error[reason: typeFault, type: type];
IF n > 0
AND index
IN [1..n]
THEN {
put the answer back into the cache
IF map =
NIL
THEN
[] ← RTTCache.FillRefEntry[entry, map ← RTTCache.NewComponentMap[n]];
[] ← RTTCache.FillTypeComponent[map, index-1, ans]};
IndexToStatus:
PUBLIC
PROC [type: Type
--record, structure--, index: Index]
RETURNS[ans: Status] = {
This returns the Status of the specified component of instances of the type. index starts at 1.
proc:
PROC[stb: SymbolTableBase, isei: SymbolIdIndex] = {
ans ← (IF ISEImmutable[stb, isei] THEN readOnly
ELSE IF ISEConstant[stb, isei] THEN const
ELSE mutable)};
RecordComponentISEI[type, index, proc];
};
NameToIndex:
PUBLIC
SAFE
PROC [type: Type
--record, structure, union, enumerated--, name:
ROPE]
RETURNS [ans:
CARDINAL ← 0] =
TRUSTED {
index starts at 1
raises typeFault, badName
enumerated: BOOL ← FALSE;
stb: SymbolTableBase;
sei: SymbolIndex;
class: Class;
n: INT ← 0;
found: BOOL ← FALSE;
entry: RTTCache.RefEntry;
map: RTTCache.ComponentMap;
proc:
PROC[stb: SymbolTableBase, isei: SymbolIdIndex]
RETURNS[stop:
BOOL] = {
IF enumerated THEN ans ← IDCardinalValue[stb, isei] + 1 ELSE ans ← ans + 1;
stop ← Rope.Equal[name, AcquireRope[stb, ISEName[stb, isei]]]};
type ← UnderType[type];
class ← TypeClass[type];
SELECT class
FROM
record, structure => n ← NComponents[type];
enumerated => n ← NValues[type];
union => n ← NValues[Domain[type]];
ENDCASE;
IF n
IN [1..256)
THEN {
entry ← RTTCache.LookupRef[type, IndexToType];
map ← NARROW[entry.ref, RTTCache.ComponentMap];
IF map #
NIL
THEN {
int: INT ← RTTCache.GetComponentForName[map, name].index;
IF int >= 0 THEN RETURN [int+1]}};
[stb, sei] ← GetTypeSymbols[type];
{
ENABLE
UNWIND => ReleaseSTB[stb];
WITH stb
SELECT
FROM
t: SymbolTableBase.x =>
{csei: bx.SymbolConstructorIndex ← t.e.UnderType[
NARROW[sei, SymbolIndex.x].e];
WITH ser: t.e.seb[csei]
SELECT
FROM
record => {srx: SymbolIndex = [x[csei]];
found ← EnumerateRecordIseis[stb,
LOOPHOLE[srx, SymbolRecordIndex],
proc]};
definition => found ← EnumerateCtxIseis[stb, [x[ser.defCtx]], proc];
union => found ← EnumerateCtxIseis[stb, [x[ser.caseCtx]], proc];
enumerated =>
{enumerated ← TRUE; found ← EnumerateCtxIseis[stb, [x[ser.valueCtx]], proc]};
ENDCASE => ERROR Error[reason: typeFault, type: type]};
t: SymbolTableBase.y =>
{csei: by.SymbolConstructorIndex ← t.e.UnderType[
NARROW[sei, SymbolIndex.y].e];
WITH ser: t.e.seb[csei]
SELECT
FROM
record => {srx: SymbolIndex = [y[csei]];
found ← EnumerateRecordIseis[stb,
LOOPHOLE[srx, SymbolRecordIndex],
proc]};
definition => found ← EnumerateCtxIseis[stb, [y[ser.defCtx]], proc];
union => found ← EnumerateCtxIseis[stb, [y[ser.caseCtx]], proc];
enumerated =>
{enumerated ← TRUE; found ← EnumerateCtxIseis[stb, [y[ser.valueCtx]], proc]};
ENDCASE => ERROR Error[reason: typeFault, type: type]};
ENDCASE => ERROR;
};
ReleaseSTB[stb];
IF NOT found THEN ERROR Error[reason: badName, type: type, msg: name];
IF ans > 0
AND n
IN [1..256)
THEN {
IF map =
NIL
THEN
[] ← RTTCache.FillRefEntry[entry, map ← RTTCache.NewComponentMap[n]];
[] ← RTTCache.FillNameComponent[map, ans-1, name]};
}; -- end NameToIndex
IndexToName:
PUBLIC
SAFE
PROC [type: Type
--record, structure, union, enumerated--,
index:
CARDINAL]
RETURNS[ans:
ROPE] =
TRUSTED {
proc:
PROC[stb: SymbolTableBase, isei: SymbolIdIndex] = {
ans ← AcquireRope[stb, ISEName[stb, isei]]};
n: INT ← 0;
class: Class;
entry: RTTCache.RefEntry;
map: RTTCache.ComponentMap ← NIL;
type ← UnderType[type];
class ← TypeClass[type];
SELECT class
FROM
record, structure => n ← NComponents[type];
enumerated => n ← NValues[type];
union, sequence =>
IF index = 0
THEN {
RRA: the tag name is cached differently from other component names
entry ← RTTCache.LookupRef[type, IndexToName];
IF entry.valid THEN RETURN [NARROW[entry.ref]];
ComponentISEI[type, 0, proc];
entry.ref ← ans;
entry.valid ← TRUE;
RETURN}
ELSE {
RRA: only union types are further processed
IF class = sequence THEN GO TO err;
n ← NValues[Domain[type]];
};
ENDCASE;
IF n
IN [1..256)
THEN {
entry ← RTTCache.LookupRef[type, IndexToType];
map ← NARROW[entry.ref, RTTCache.ComponentMap];
IF map =
NIL
THEN [] ← RTTCache.FillRefEntry[entry, map ← RTTCache.NewComponentMap[n]];
IF index
IN [1..map.len]
THEN {
comp: RTTCache.ComponentEntry ←
RTTCache.GetComponentAtIndex[map, index-1];
IF comp.validName THEN RETURN [comp.name]};
};
SELECT class
FROM
record, structure => RecordComponentISEI[type, index, proc];
union, enumerated => ComponentISEI[type, index, proc];
ENDCASE => GO TO err;
IF map # NIL THEN [] ← RTTCache.FillNameComponent[map, index-1, ans];
EXITS
err => ERROR Error[reason: typeFault, type: type];
};
IsPacked:
PUBLIC
SAFE
PROC [type: Type
--array, sequence--]
RETURNS [ans:
BOOL] =
TRUSTED {
stb: SymbolTableBase;
sei: SymbolIndex;
[stb, sei] ← GetTypeSymbols[type];
{
ENABLE
UNWIND => ReleaseSTB[stb];
WITH stb
SELECT
FROM
t: SymbolTableBase.x =>
WITH ser: t.e.seb[t.e.UnderType[
NARROW[sei, SymbolIndex.x].e]]
SELECT
FROM
array => ans ← ser.packed;
sequence => ans ← ser.packed;
ENDCASE => ERROR Error[reason: typeFault, type: type];
t: SymbolTableBase.y =>
WITH ser: t.e.seb[t.e.UnderType[
NARROW[sei, SymbolIndex.y].e]]
SELECT
FROM
array => ans ← ser.packed;
sequence => ans ← ser.packed;
ENDCASE => ERROR Error[reason: typeFault, type: type];
ENDCASE => ERROR;
};
ReleaseSTB[stb];
Domain:
PUBLIC
SAFE
PROC [type: Type]
RETURNS[ans: Type] =
TRUSTED {
domain: type {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];
ENDCASE => ERROR Error[reason: typeFault, type: type];
t: SymbolTableBase.y =>
WITH ser: t.e.seb[t.e.UnderType[
NARROW[sei, SymbolIndex.y].e]]
SELECT
FROM
array => ans ← AcquireType[stb, [y[ser.componentType]]];
sequence => ans ← AcquireType[stb, [y[ser.componentType]]];
transfer => ans ← (
IF ser.typeOut = by.nullSymbolIndex
THEN nullType
ELSE AcquireType[stb, [y[ser.typeOut]]]);
relative => ans ← Range[AcquireType[stb, [y[ser.resultType]]]];
ref => {
IF ser.counted
THEN
ERROR Error[reason: typeFault, type: type];
ans ← (
IF t.e.UnderType[ser.refType] = by.symbolIndexForANY
THEN unspecType
ELSE AcquireType[stb, [y[ser.refType]]])};
arraydesc => ans ← AcquireType[stb, [y[ser.describedType]]];
long =>
WITH rse: t.e.seb[t.e.UnderType[ser.rangeType]]
SELECT
FROM
ref => ans ← (
IF t.e.UnderType[rse.refType] = by.symbolIndexForANY
THEN unspecType
ELSE AcquireType[stb, [y[rse.refType]]]);
arraydesc => ans ← AcquireType[stb, [y[rse.describedType]]];
ENDCASE => ERROR Error[reason: typeFault, type: type];
ENDCASE => ERROR Error[reason: typeFault, type: type];
ENDCASE => ERROR;
ReleaseSTB[stb]}; -- END ENABLE UNWIND
[] ← RTTCache.FillIntEntry[entry, LOOPHOLE[ans, CARDINAL]];
};
ReferentStatus:
PUBLIC
SAFE
PROC [type: Type]
RETURNS [ans: Status] =
TRUSTED {
stb: SymbolTableBase;
sei: SymbolIndex;
readOnlyReferent: BOOL ← FALSE;
entry: RTTCache.IntEntry ← RTTCache.LookupInt[type ← UnderType[type], ReferentStatus];
int: INT ← entry.int;
IF int >= 0 THEN {card: CARDINAL ← int; RETURN [LOOPHOLE[card]]};
SELECT TypeClass[type]
FROM
rope, atom => RETURN [readOnly];
basePointer => GO TO fault;
list, ref, pointer, longPointer, descriptor, longDescriptor, relativePointer => {};
ENDCASE => GO TO fault;
[stb, sei] ← GetTypeSymbols[type];
{
ENABLE
UNWIND => ReleaseSTB[stb];
WITH stb
SELECT
FROM
t: SymbolTableBase.x =>
WITH ser: t.e.seb[t.e.UnderType[
NARROW[sei, SymbolIndex.x].e]]
SELECT
FROM
long =>
WITH ser1: t.e.seb[t.e.UnderType[ser.rangeType]]
SELECT
FROM
arraydesc => readOnlyReferent ← ser1.readOnly;
ref => readOnlyReferent ← ser1.readOnly;
ENDCASE => GO TO fault;
ref => readOnlyReferent ← ser.readOnly;
relative =>
WITH ser2: t.e.seb[t.e.UnderType[ser.resultType]]
SELECT
FROM
long =>
WITH ser1: t.e.seb[t.e.UnderType[ser2.rangeType]]
SELECT
FROM
ref => readOnlyReferent ← ser1.readOnly;
ENDCASE => GO TO fault;
ref => readOnlyReferent ← ser2.readOnly;
ENDCASE => GO TO fault;
arraydesc => readOnlyReferent ← ser.readOnly;
ENDCASE => GO TO fault;
t: SymbolTableBase.y =>
WITH ser: t.e.seb[t.e.UnderType[
NARROW[sei, SymbolIndex.y].e]]
SELECT
FROM
long =>
WITH ser1: t.e.seb[t.e.UnderType[ser.rangeType]]
SELECT
FROM
arraydesc => readOnlyReferent ← ser1.readOnly;
ref => readOnlyReferent ← ser1.readOnly;
ENDCASE => ERROR Error[reason: typeFault, type: type];
ref => readOnlyReferent ← ser.readOnly;
relative =>
WITH ser2: t.e.seb[t.e.UnderType[ser.resultType]]
SELECT
FROM
long =>
WITH ser1: t.e.seb[t.e.UnderType[ser2.rangeType]]
SELECT
FROM
ref => readOnlyReferent ← ser1.readOnly;
ENDCASE => GO TO fault;
ref => readOnlyReferent ← ser2.readOnly;
ENDCASE => GO TO fault;
arraydesc => readOnlyReferent ← ser.readOnly;
ENDCASE => GO TO fault;
ENDCASE => ERROR;
};
ReleaseSTB[stb];
ans ← IF readOnlyReferent THEN readOnly ELSE mutable;
[] ← RTTCache.FillIntEntry[entry, LOOPHOLE[ans, CARDINAL]];
EXITS fault => ERROR Error[reason: typeFault, type: type];
TypeToName:
PUBLIC
SAFE
PROC [type: Type, moduleName, fileName:
REF
ROPE ←
NIL]
RETURNS [ans:
ROPE] =
TRUSTED {
class: Class ← TypeClass[type];
SELECT class
FROM
nil => RETURN[NIL];
unspecified => RETURN ["UNSPECIFIED"];
localFrame => RETURN ["%localFrame"];
globalFrame => RETURN["%globalFrame"];
type => RETURN["TYPE"];
any => RETURN["ANY"];
atom => RETURN["ATOM"];
rope => RETURN["ROPE"];
cardinal => RETURN["CARDINAL"];
longCardinal => RETURN["CARD"];
integer => RETURN["INTEGER"];
longInteger => RETURN["INT"];
real => RETURN["REAL"];
character => RETURN["CHAR"];
ENDCASE;
{ stb: SymbolTableBase ← nullBase;
sei: SymbolIndex;
IF moduleName #
NIL
OR fileName #
NIL THEN
[stb, sei] ← GetOriginalTypeSymbols[type ! Error => CONTINUE];
IF stb = nullBase THEN [stb, sei] ← GetTypeSymbols[type];
WITH stb
SELECT
FROM
t: SymbolTableBase.x => {
ENABLE UNWIND => ReleaseSTB[stb];
mdi: bx.SymbolModuleIndex ← bx.thisModuleIndex;
WITH ser: t.e.seb[
NARROW[sei, SymbolIndex.x].e]
SELECT
FROM
id => {ans ← AcquireRope[stb, [x[ser.hash]]];
IF moduleName #
NIL
OR fileName #
NIL
THEN {
WITH cer: t.e.ctxb[ser.idCtx]
SELECT
FROM
included => mdi ← cer.module;
ENDCASE;
IF moduleName #
NIL
THEN
moduleName^ ← AcquireRope[stb, [x[t.e.mdb[mdi].moduleId]]];
IF fileName #
NIL
THEN
fileName^ ← AcquireRope[stb, [x[t.e.mdb[mdi].fileId]]]}};
ENDCASE => {
csei: bx.SymbolConstructorIndex = t.e.UnderType[NARROW[sei, SymbolIndex.x].e];
IF moduleName # NIL THEN moduleName^ ← STBToModuleName[stb];
WITH ser: t.e.seb[csei]
SELECT
FROM
definition => ans ← STBToModuleName[stb]; -- interface type
ENDCASE => ans ← NIL};
};
t: SymbolTableBase.y => {
ENABLE UNWIND => ReleaseSTB[stb];
mdi: by.SymbolModuleIndex ← by.thisModuleIndex;
WITH ser: t.e.seb[
NARROW[sei, SymbolIndex.y].e]
SELECT
FROM
id => {
ans ← AcquireRope[stb, [y[ser.hash]]];
IF moduleName #
NIL
OR fileName #
NIL
THEN {
WITH cer: t.e.ctxb[ser.idCtx]
SELECT
FROM
included => mdi ← cer.module;
ENDCASE;
IF moduleName #
NIL
THEN
moduleName^ ← AcquireRope[stb, [y[t.e.mdb[mdi].moduleId]]];
IF fileName #
NIL
THEN
fileName^ ← AcquireRope[stb, [y[t.e.mdb[mdi].fileId]]]}};
ENDCASE => {
csei: by.SymbolConstructorIndex = t.e.UnderType[NARROW[sei, SymbolIndex.y].e];
IF moduleName # NIL THEN moduleName^ ← STBToModuleName[stb];
WITH ser: t.e.seb[csei]
SELECT
FROM
definition => ans ← STBToModuleName[stb]; -- interface type
ENDCASE => ans ← NIL};
};
ENDCASE => ERROR;
ReleaseSTB[stb];
};
};
Ground:
PUBLIC
SAFE
PROC [type: Type]
RETURNS [ans: Type] =
TRUSTED {
peels off one layer from a definition or subrange type
stb: SymbolTableBase;
sei: SymbolIndex;
entry: RTTCache.IntEntry;
int: INT;
entry ← RTTCache.LookupInt[type, Ground];
int ← entry.int;
IF int >= 0 THEN {card: CARDINAL ← int; RETURN [LOOPHOLE[card]]};
SELECT TypeClass[type]
FROM
definition, subrange => {};
ENDCASE => GO TO fault;
[stb, sei] ← GetTypeSymbols[type];
{
ENABLE
UNWIND => ReleaseSTB[stb];
WITH stb
SELECT
FROM
t: SymbolTableBase.x =>
WITH ser: t.e.seb[
NARROW[sei, SymbolIndex.x].e]
SELECT
FROM
id => ans ← AcquireType[stb, [x[ser.idInfo]]]; -- a definition
ENDCASE => {
csei: bx.SymbolConstructorIndex ← t.e.UnderType[NARROW[sei, SymbolIndex.x].e];
WITH ser: t.e.seb[csei]
SELECT
FROM
subrange => ans ← AcquireType[stb, [x[ser.rangeType]]];
ENDCASE;
};
t: SymbolTableBase.y =>
WITH ser: t.e.seb[
NARROW[sei, SymbolIndex.y].e]
SELECT
FROM
id => ans ← AcquireType[stb, [y[ser.idInfo]]]; -- a definition
ENDCASE => {
csei: by.SymbolConstructorIndex ← t.e.UnderType[NARROW[sei, SymbolIndex.y].e];
WITH ser: t.e.seb[csei]
SELECT
FROM
subrange => ans ← AcquireType[stb, [y[ser.rangeType]]];
ENDCASE;
};
ENDCASE => ERROR;
};
[] ← RTTCache.FillIntEntry[entry, LOOPHOLE[ans, CARDINAL]];
EXITS fault => ERROR Error[reason: typeFault, type: type];
};
GroundStar:
PUBLIC
SAFE
PROC [type: Type
--definition, subrange--]
RETURNS [Type] =
TRUSTED {
peels off one layer from a definition or subrange type (no change for other types)
entry: RTTCache.IntEntry ← RTTCache.LookupInt[type, GroundStar];
int: INT ← entry.int;
IF int >= 0 THEN {card: CARDINAL ← int; RETURN [LOOPHOLE[card]]};
DO
SELECT TypeClass[type]
FROM
definition, subrange => type ← Ground[type];
ENDCASE => EXIT;
ENDLOOP;
[] ← RTTCache.FillIntEntry[entry, LOOPHOLE[type, CARDINAL]];
RETURN[type];
};
UnderType:
PUBLIC
SAFE
PROC [type: Type]
RETURNS [Type] =
TRUSTED {
entry: RTTCache.IntEntry;
int: INT;
entry ← RTTCache.LookupInt[type, UnderType];
int ← entry.int;
IF int >= 0 THEN {card: CARDINAL ← int; RETURN [LOOPHOLE[card]]};
UNTIL TypeClass[type] # definition DO type ← Ground[type]; ENDLOOP;
[] ← RTTCache.FillIntEntry[entry, LOOPHOLE[type, CARDINAL]];
RETURN[type];
};
UnderClass:
PUBLIC
SAFE
PROC [type: Type]
RETURNS [Class] =
TRUSTED {
RETURN[TypeClass[UnderType[type]]];
};
First:
PUBLIC
SAFE
PROC [type: Type
--enumerated, subrange, basic--]
RETURNS [tv: TypedVariable] =
TRUSTED {
class: Class = TypeClass[UnderType[type]];
IF class = subrange
THEN {
stb: SymbolTableBase;
sei: SymbolIndex;
csei: SymbolConstructorIndex;
[stb, sei] ← GetTypeSymbols[type];
csei ← SEUnderType[stb, sei];
WITH stb
SELECT
FROM
t: SymbolTableBase.x =>
WITH ser: t.e.seb[
NARROW[csei, SymbolConstructorIndex.x].e]
SELECT
FROM
subrange => {empty:
BOOL = ser.empty;
ReleaseSTB[stb];
IF empty THEN ERROR Error[reason: rangeFault]};
ENDCASE => {ReleaseSTB[stb]; ERROR};
t: SymbolTableBase.y =>
WITH ser: t.e.seb[
NARROW[csei, SymbolConstructorIndex.y].e]
SELECT
FROM
subrange => {empty:
BOOL = ser.empty;
ReleaseSTB[stb];
IF empty THEN ERROR Error[reason: rangeFault]};
ENDCASE => {ReleaseSTB[stb]; ERROR};
ENDCASE => ERROR;
tv ← New[type];
RETURN};
-- the "0" that's there already is always the right stored representation!!
tv ← New[type];
SELECT class
FROM
enumerated => SetTVFromLC[tv, 0];
cardinal => SetTVFromLC[tv, FIRST[CARDINAL]];
integer => SetTVFromLI[tv, LONG[FIRST[INTEGER]]];
character => SetTVFromLC[tv, LONG[LOOPHOLE[FIRST[CHARACTER], CARDINAL]]];
longInteger => SetTVFromLI[tv, FIRST[LONG INTEGER]];
longCardinal => SetTVFromLC[tv, FIRST[LONG CARDINAL]];
ENDCASE => ERROR Error[reason: typeFault, type: type];
};
Last:
PUBLIC
SAFE
PROC [type: Type
--enumerated, subrange, basic--]
RETURNS[tv: TypedVariable] =
TRUSTED {
class: Class = TypeClass[UnderType[type]];
tv ← New[type];
SELECT class
FROM
enumerated, subrange => {
stb: SymbolTableBase;
sei: SymbolIndex;
i: INTEGER;
[stb, sei] ← GetTypeSymbols[type];
{
ENABLE
UNWIND => ReleaseSTB[stb];
csei: SymbolConstructorIndex ← SEUnderType[stb, sei];
WITH stb
SELECT
FROM
t: SymbolTableBase.x =>
WITH ser: t.e.seb[
NARROW[csei, SymbolConstructorIndex.x].e]
SELECT
FROM
enumerated => i ← LOOPHOLE[ser.nValues - 1, INTEGER];
subrange => {
IF ser.empty THEN ERROR Error[reason: rangeFault];
i ← ser.origin + ser.range};
ENDCASE => ERROR Error[reason: typeFault, type: type];
t: SymbolTableBase.y =>
WITH ser: t.e.seb[
NARROW[csei, SymbolConstructorIndex.y].e]
SELECT
FROM
enumerated => i ← LOOPHOLE[ser.nValues - 1, INTEGER];
subrange => {
IF ser.empty THEN ERROR Error[reason: rangeFault];
i ← ser.origin + ser.range};
ENDCASE => ERROR Error[reason: typeFault, type: type];
ENDCASE => ERROR;
};
ReleaseSTB[stb];
IF class = enumerated
THEN SetTVFromLC[tv, LONG[LOOPHOLE[i, CARDINAL]]]
ELSE SetTVFromLI[tv, LONG[i]];
};
cardinal => SetTVFromLC[tv, LAST[CARDINAL]];
integer => SetTVFromLI[tv, LONG[LAST[INTEGER]]];
character => SetTVFromLC[tv, LONG[LOOPHOLE[LAST[CHARACTER], CARDINAL]]];
longInteger => SetTVFromLI[tv, LAST[LONG INTEGER]];
longCardinal => SetTVFromLC[tv, LAST[LONG CARDINAL]];
ENDCASE => ERROR Error[reason: typeFault, type: type];
};
NValues:
PUBLIC
SAFE
PROC [type: Type
--enumerated, subrange--]
RETURNS [int:
INT] =
TRUSTED {
stb: SymbolTableBase;
sei: SymbolIndex;
csei: SymbolConstructorIndex;
entry: RTTCache.IntEntry;
type ← UnderType[type];
entry ← RTTCache.LookupInt[type, NValues];
int ← entry.int;
IF int >= 0 THEN RETURN[int];
[stb, sei] ← GetTypeSymbols[type];
{
ENABLE
UNWIND => ReleaseSTB[stb];
csei ← SEUnderType[stb, sei];
WITH stb
SELECT
FROM
t: SymbolTableBase.x =>
WITH ser: t.e.seb[
NARROW[csei, SymbolConstructorIndex.x].e]
SELECT
FROM
enumerated => int ← IF ser.nValues = 0 THEN 200000B ELSE ser.nValues;
subrange => int ← IF ser.empty THEN 0 ELSE 1 + ser.range;
ENDCASE => ERROR Error[reason: typeFault, type: type];
t: SymbolTableBase.y =>
WITH ser: t.e.seb[
NARROW[csei, SymbolConstructorIndex.y].e]
SELECT
FROM
enumerated => int ← IF ser.nValues = 0 THEN 200000B ELSE ser.nValues;
subrange => int ← IF ser.empty THEN 0 ELSE 1 + ser.range;
ENDCASE => ERROR Error[reason: typeFault, type: type];
ENDCASE => ERROR;
};
ReleaseSTB[stb];
[] ← RTTCache.FillIntEntry[entry, int];
Value:
PUBLIC
SAFE
PROC [type: Type
--enumerated--, index:
CARDINAL]
RETURNS [tv: TypedVariable] =
TRUSTED {
raises typeFault, badIndex
index range is [1..NValues[type]]
type ← UnderType[type];
IF TypeClass[type] # enumerated THEN ERROR Error[reason: typeFault, type: type];
IF index > NValues[type] THEN ERROR Error[reason: badIndex];
tv ← AMTypes.New[type];
SetTVFromLC[tv, index-1];
ComponentISEI:
PUBLIC
PROC [type: Type
--union, enumerated--, index:
CARDINAL, p:
PROC[stb: SymbolTableBase, isei: SymbolIdIndex]] = {
This is exported to RTTypesPrivate, and is imported by RTTypedVariablesImpl
stb: SymbolTableBase;
sei: SymbolIndex;
[stb, sei] ← GetTypeSymbols[type];
{
ENABLE
UNWIND => ReleaseSTB[stb];
csei: SymbolConstructorIndex ← SEUnderType[stb, sei];
n: CARDINAL ← 0;
ctxi: SymbolContextIndex;
enumeration: BOOL ← FALSE;
looker:
PROC[stb: SymbolTableBase, isei: SymbolIdIndex]
RETURNS[stop:
BOOL] = {
n ← n + 1;
IF enumeration
THEN {
IF index-1 = IDCardinalValue[stb, isei]
THEN {p[stb, isei]; RETURN[TRUE]}
ELSE RETURN[FALSE];
}
ELSE
IF n = index
THEN {p[stb, isei]; RETURN[TRUE]}
ELSE RETURN[FALSE];
WITH stb
SELECT
FROM
t: SymbolTableBase.x =>
WITH ser: t.e.seb[
NARROW[csei, SymbolConstructorIndex.x].e]
SELECT
FROM
union =>
IF index = 0
THEN {p[stb, [x[ser.tagSei]]]; ReleaseSTB[stb]; RETURN}
ELSE ctxi ← [x[ser.caseCtx]];
sequence => {
RRA: to get the name of a sequence tag
p[stb, [x[ser.tagSei]]]; ReleaseSTB[stb]; RETURN};
enumerated => {enumeration ← TRUE; ctxi ← [x[ser.valueCtx]]};
ENDCASE => ERROR Error[reason: typeFault, type: type];
t: SymbolTableBase.y =>
WITH ser: t.e.seb[
NARROW[csei, SymbolConstructorIndex.y].e]
SELECT
FROM
union =>
IF index = 0
THEN {p[stb, [y[ser.tagSei]]]; ReleaseSTB[stb]; RETURN}
ELSE ctxi ← [y[ser.caseCtx]];
sequence => {
RRA: to get the name of a sequence tag
p[stb, [y[ser.tagSei]]]; ReleaseSTB[stb]; RETURN};
enumerated => {enumeration ← TRUE; ctxi ← [y[ser.valueCtx]]};
ENDCASE => ERROR Error[reason: typeFault, type: type];
ENDCASE => ERROR;
IF NOT EnumerateCtxIseis[stb, ctxi, looker] THEN ERROR Error[reason: badIndex];
};
ReleaseSTB[stb];
};
RecordComponentISEI:
PUBLIC
PROC [type: Type
--record, structure--, index: Index,
p:
PROC[stb: SymbolTableBase, isei: SymbolIdIndex]] = {
stb: SymbolTableBase;
sei: SymbolIndex;
[stb, sei] ← GetTypeSymbols[type];
{
ENABLE
UNWIND => ReleaseSTB[stb];
csei: SymbolConstructorIndex ← SEUnderType[stb, sei];
n: Index ← 0;
looker:
PROC[stb: SymbolTableBase, isei: SymbolIdIndex]
RETURNS[stop:
BOOL] = {
n ← n + 1;
IF n = index
THEN {p[stb, isei]; RETURN[TRUE]}
ELSE RETURN[FALSE]};
WITH stb
SELECT
FROM
t: SymbolTableBase.x =>
WITH ser: t.e.seb[
NARROW[csei, SymbolConstructorIndex.x].e]
SELECT
FROM
record =>
IF
NOT EnumerateRecordIseis[stb,
LOOPHOLE[csei, SymbolRecordIndex], looker]
THEN ERROR Error[reason: badIndex];
definition =>
IF
NOT EnumerateCtxIseis[stb, [x[ser.defCtx]], looker]
THEN ERROR Error[reason: badIndex];
ENDCASE => ERROR Error[reason: typeFault, type: type];
t: SymbolTableBase.y =>
WITH ser: t.e.seb[
NARROW[csei, SymbolConstructorIndex.y].e]
SELECT
FROM
record =>
IF
NOT EnumerateRecordIseis[stb,
LOOPHOLE[csei, SymbolRecordIndex], looker]
THEN ERROR Error[reason: badIndex];
definition =>
IF
NOT EnumerateCtxIseis[stb, [y[ser.defCtx]], looker]
THEN ERROR Error[reason: badIndex];
ENDCASE => ERROR Error[reason: typeFault, type: type];
ENDCASE => ERROR;
};
ReleaseSTB[stb];
};
... NOTE and procedures for dealing with code TypedVariables...
Procedures private to this module
CtxEntries:
PROC[stb: SymbolTableBase, ctx: SymbolContextIndex]
RETURNS[
CARDINAL] = {
n: CARDINAL ← 0;
counter:
PROC[stb: SymbolTableBase, isei: SymbolIdIndex]
RETURNS[stop:
BOOL] = {
n ← n + 1;
RETURN[FALSE];
};
[] ← EnumerateCtxIseis[stb, ctx, counter];
RETURN[n];
};
GetOrigin:
PUBLIC
SAFE
PROC[type: Type]
RETURNS[origin:
INTEGER ← 0] =
TRUSTED {
stb: SymbolTableBase;
sei: SymbolIndex;
csei: SymbolConstructorIndex;
entry: RTTCache.IntEntry ← NIL;
IF Size[type] > 1 THEN RETURN[0]; -- no subranges in long domain
entry ← RTTCache.LookupInt[type, GetOrigin];
IF entry.int # -1 THEN RETURN[entry.int];
[stb, sei] ← GetTypeSymbols[type];
{
ENABLE
UNWIND => ReleaseSTB[stb];
csei ← SEUnderType[stb, sei];
WITH stb
SELECT
FROM
t: SymbolTableBase.x =>
WITH ser: t.e.seb[NARROW[csei, SymbolConstructorIndex.x].e] SELECT FROM
subrange => origin ← ser.origin
ENDCASE;
t: SymbolTableBase.y =>
WITH ser: t.e.seb[NARROW[csei, SymbolConstructorIndex.y].e] SELECT FROM
subrange => origin ← ser.origin
ENDCASE;
ENDCASE => ERROR;
};
ReleaseSTB[stb];
IF entry # NIL THEN [] ← RTTCache.FillIntEntry[entry, origin];
};
END.