AMTypesBImpl.Mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Paul Rovner, November 16, 1983 8:39 pm
Russ Atkinson, February 11, 1985 7:43:53 pm PST
DIRECTORY
AMTypes USING [Class, Error, Index, IndexToType, NComponents, TypeClass, UnderClass, UnderType],
Basics USING [bitsPerWord, CARD],
BrandXSymbolDefs USING [nullSymbolIndex, StandardSymbolContextIndex, SymbolConstructorIndex, SymbolIdIndex, typeCodeForCHAR, typeCodeForINT],
BrandYSymbolDefs USING [nullSymbolIndex, StandardSymbolContextIndex, SymbolConstructorIndex, SymbolIdIndex, typeCodeForCHAR, typeCodeForINT],
Rope USING [ROPE, Text],
RTSymbolDefs USING [Brand, SymbolConstructorIndex, SymbolIdIndex, SymbolIndex, SymbolTableBase],
RTSymbolOps USING [EnumerateCtxIseis, IDCardinalValue, ISEConstant, SETagIDP, SEUnderType],
RTSymbols USING [GetTypeSymbols, ReleaseSTB],
RTTCache USING [FillIntEntry, FillRefEntry, IntEntry, LookupInt, LookupRef, RefEntry],
RTTypesPrivate USING [],
SafeStorage USING [fhType, GetCanonicalType, gfhType, nullType, Type, unspecType];
AMTypesBImpl:
PROGRAM
IMPORTS AMTypes, RTTCache, RTSymbolOps, RTSymbols, SafeStorage
EXPORTS AMTypes, RTTypesPrivate
=
BEGIN
OPEN AMTypes, Basics, bx: BrandXSymbolDefs, by: BrandYSymbolDefs, Rope, RTSymbolDefs, RTSymbolOps, RTSymbols, SafeStorage;
T Y P E S
BitsForTypeInfo:
TYPE =
RECORD
[bft: CARD, argumentRecord, interfaceRecord: BOOL];
must be the same as the return type of BitsForType
P U B L I C P R O C E D U R E S
VariableType:
PUBLIC
SAFE
PROC[type: Type]
RETURNS [v: Type, c: Class] =
TRUSTED {
SELECT AMTypes.TypeClass[type ← AMTypes.UnderType[type]]
FROM
record, structure => {
nc: Index = AMTypes.NComponents[type];
IF nc = 0 THEN RETURN[v: nullType, c: nil];
v ← AMTypes.UnderType[IndexToType[type, nc]];
c ← AMTypes.TypeClass[v];
SELECT c
FROM
union, sequence => RETURN;
ENDCASE;
};
ENDCASE;
RETURN [v: nullType, c: nil];
};
Size:
PUBLIC
SAFE
PROC [type: Type, length:
CARDINAL ← 0
--for sequence-containing records--]
RETURNS [ans:
INT ← 0
--number of words--] =
TRUSTED {
max for unions
Could overflow!
stb: SymbolTableBase;
uType: Type = AMTypes.UnderType[type];
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];
WITH stb
SELECT
FROM
t: SymbolTableBase.x => {
ENABLE UNWIND => ReleaseSTB[stb];
csei: bx.SymbolConstructorIndex = t.e.UnderType[NARROW[sei, SymbolIndex.x].e];
check for argument records and interface records
WITH ser: t.e.seb[csei]
SELECT
FROM
record =>
IF ser.argument
THEN {
FOR isei: bx.SymbolIdIndex ← t.e.FirstCtxSe[ser.fieldCtx], t.e.NextSe[isei]
UNTIL isei = bx.nullSymbolIndex
DO
ans ←
MAX[ans,
t.e.FnField[isei].offset.wd*bitsPerWord + t.e.seb[isei].idInfo]
ENDLOOP;
ans ← ans/bitsPerWord + (IF ans MOD bitsPerWord # 0 THEN 1 ELSE 0);
GO TO gotAnswer;
};
definition => {
proc:
PROC[stb: SymbolTableBase, isei: SymbolIdIndex]
RETURNS[stop:
BOOL] = {
IF
NARROW[stb, SymbolTableBase.x].e.LinkMode[
NARROW[isei, SymbolIdIndex.x].e] # manifest
THEN
ans ← MAX[ans, IDCardinalValue[stb, isei]];
RETURN[FALSE];
};
[] ← EnumerateCtxIseis[stb, [x[ser.defCtx]], proc];
ans ← ans + 1;
GO TO gotAnswer;
};
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: bx.SymbolConstructorIndex = NARROW[SEUnderType[sstb, ssei], SymbolConstructorIndex.x].e;
WITH ser:
NARROW[sstb, SymbolTableBase.x].e.seb[scsei]
SELECT
FROM
sequence => {
bpe:
CARD =
NARROW[sstb, SymbolTableBase.x].e.BitsPerElement[
type: ser.componentType, packed: ser.packed];
ans ← (bpe*length+bitsPerWord-1)/bitsPerWord;
};
ENDCASE=>ERROR;
};
ReleaseSTB[sstb]};
ENDCASE};
ENDCASE;
ans ← ans + t.e.WordsForType[csei];
EXITS gotAnswer => {};
};
t: SymbolTableBase.y => {
ENABLE UNWIND => ReleaseSTB[stb];
csei: by.SymbolConstructorIndex = t.e.UnderType[NARROW[sei, SymbolIndex.y].e];
check for argument records and interface records
WITH ser: t.e.seb[csei]
SELECT
FROM
record =>
IF ser.argument
THEN {
FOR isei: by.SymbolIdIndex ← t.e.FirstCtxSe[ser.fieldCtx], t.e.NextSe[isei]
UNTIL isei = by.nullSymbolIndex
DO
ans ← MAX[ans, t.e.FnField[isei].offset.wd*bitsPerWord + t.e.seb[isei].idInfo]
ENDLOOP;
ans ← ans/bitsPerWord + (IF ans MOD bitsPerWord # 0 THEN 1 ELSE 0);
GO TO gotAnswer;
};
definition => {
proc:
PROC[stb: SymbolTableBase, isei: SymbolIdIndex]
RETURNS[stop:
BOOL] = {
IF
NARROW[stb, SymbolTableBase.y].e.LinkMode[
NARROW[isei, SymbolIdIndex.y].e] # manifest
THEN
ans ← MAX[ans, IDCardinalValue[stb, isei]];
RETURN[FALSE]};
[] ← EnumerateCtxIseis[stb, [y[ser.defCtx]], proc];
ans ← ans + 1;
GO TO gotAnswer;
};
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: by.SymbolConstructorIndex = NARROW[SEUnderType[sstb, ssei], SymbolConstructorIndex.y].e;
WITH ser:
NARROW[sstb, SymbolTableBase.y].e.seb[scsei]
SELECT
FROM
sequence => {
bpe: CARD = NARROW[sstb, SymbolTableBase.y].e.BitsPerElement[ type: ser.componentType, packed: ser.packed];
ans ← (bpe*length+bitsPerWord-1)/bitsPerWord;
};
ENDCASE => ERROR;
};
ReleaseSTB[sstb]};
ENDCASE};
ENDCASE;
ans ← ans + t.e.WordsForType[csei];
EXITS gotAnswer => {};
}; -- end ENABLE UNWIND
ENDCASE => ERROR;
ReleaseSTB[stb];
IF entry # NIL THEN [] ← RTTCache.FillIntEntry[entry, ans];
IsPainted:
PUBLIC
SAFE
PROC[type: Type]
RETURNS[ans:
BOOL] =
TRUSTED {
the Type itself is the color. Record and enumerated types are painted.
RETURN[
SELECT AMTypes.UnderClass[type]
FROM
enumerated, record => TRUE,
ENDCASE => FALSE];
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];
IF SETagIDP[stb, sei] THEN {ans ← definition; GO TO answer};
IF GetCanonicalType[type] = GetCanonicalType[
CODE[
ROPE]]
OR GetCanonicalType[type] = GetCanonicalType[CODE[Text]]
THEN {ans ← rope; GO TO answer};
WITH stb
SELECT
FROM
t: SymbolTableBase.x => {
WITH ser: t.e.seb[t.e.UnderType[
NARROW[sei, SymbolIndex.x].e]]
SELECT
FROM
basic => ans ← SelectBasicClass[x, ser.code];
record => IF ser.painted THEN ans ← record ELSE ans ← structure;
definition => ans ← record;
real => ans ← real;
union => ans ← union;
array => ans ← array;
opaque => ans ← opaque;
sequence => ans ← sequence;
relative => ans ← relativePointer;
ref => IF ser.counted OR ser.basing THEN ERROR ELSE ans ← pointer;
arraydesc => ans ← descriptor;
long =>
WITH rse: t.e.seb[t.e.UnderType[ser.rangeType] ]
SELECT
FROM
ref =>
SELECT
TRUE
FROM
rse.counted => {
IF rse.list
THEN ans ← list
ELSE
WITH z: t.e.seb[t.e.UnderType[rse.refType]]
SELECT
FROM
opaque =>
IF t.e.seb[z.id].idCtx
IN bx.StandardSymbolContextIndex
THEN ans ← atom ELSE ans ← ref;
ENDCASE => ans ← ref};
rse.basing => ans ← basePointer;
ENDCASE => ans ← longPointer;
basic => IF rse.code = bx.typeCodeForINT THEN ans ← longInteger ELSE ERROR;
arraydesc => ans ← longDescriptor;
subrange =>
WITH rrse: t.e.seb[t.e.UnderType[rse.rangeType] ]
SELECT
FROM
basic =>
IF rrse.code = bx.typeCodeForINT
AND rse.origin = 0
AND rse.range = LAST[CARDINAL]
THEN ans ← longCardinal ELSE ERROR;
ENDCASE => ERROR;
ENDCASE => ERROR;
enumerated => ans ← enumerated;
subrange =>
WITH rse: t.e.seb[t.e.UnderType[ser.rangeType] ]
SELECT
FROM
basic =>
IF rse.code = bx.typeCodeForINT
AND ser.origin = 0
AND ser.range = LAST[CARDINAL]
THEN ans ← cardinal ELSE ans ← subrange;
ENDCASE => ans ← subrange;
transfer =>
SELECT ser.mode
FROM
proc => ans ← procedure;
port => ans ← port;
signal => ans ← signal;
error => ans ← error;
process => ans ← process;
program => ans ← program;
ENDCASE => ERROR;
zone => IF ser.counted THEN ans ← countedZone ELSE ans ← uncountedZone;
mode => ans ← type;
any => ans ← any;
ENDCASE => GO TO gleep;
};
t: SymbolTableBase.y => {
WITH ser: t.e.seb[t.e.UnderType[
NARROW[sei, SymbolIndex.y].e]]
SELECT
FROM
basic => ans ← SelectBasicClass[y, ser.code];
record => IF ser.painted THEN ans ← record ELSE ans ← structure;
definition => ans ← record;
real => ans ← real;
union => ans ← union;
array => ans ← array;
opaque => ans ← opaque;
sequence => ans ← sequence;
relative => ans ← relativePointer;
ref => IF ser.counted OR ser.basing THEN ERROR ELSE ans ← pointer;
arraydesc => ans ← descriptor;
long =>
WITH rse: t.e.seb[t.e.UnderType[ser.rangeType] ]
SELECT
FROM
ref =>
SELECT
TRUE
FROM
rse.counted => {
IF rse.list
THEN ans ← list
ELSE
WITH z: t.e.seb[t.e.UnderType[rse.refType]]
SELECT
FROM
opaque =>
IF t.e.seb[z.id].idCtx
IN by.StandardSymbolContextIndex
THEN ans ← atom ELSE ans ← ref;
ENDCASE => ans ← ref};
rse.basing => ans ← basePointer;
ENDCASE => ans ← longPointer;
basic => IF rse.code = by.typeCodeForINT THEN ans ← longInteger ELSE ERROR;
arraydesc => ans ← longDescriptor;
subrange =>
WITH rrse: t.e.seb[t.e.UnderType[rse.rangeType] ]
SELECT
FROM
basic =>
IF rrse.code = by.typeCodeForINT
AND rse.origin = 0
AND rse.range = LAST[CARDINAL]
THEN ans ← longCardinal ELSE ERROR;
ENDCASE => ERROR;
ENDCASE => ERROR;
enumerated => ans ← enumerated;
subrange =>
WITH rse: t.e.seb[t.e.UnderType[ser.rangeType] ]
SELECT
FROM
basic =>
IF rse.code = by.typeCodeForINT
AND ser.origin = 0
AND ser.range = LAST[CARDINAL]
THEN ans ← cardinal ELSE ans ← subrange;
ENDCASE => ans ← subrange;
transfer =>
SELECT ser.mode
FROM
proc => ans ← procedure;
port => ans ← port;
signal => ans ← signal;
error => ans ← error;
process => ans ← process;
program => ans ← program;
ENDCASE => ERROR;
zone => IF ser.counted THEN ans ← countedZone ELSE ans ← uncountedZone;
mode => ans ← type;
any => ans ← any;
ENDCASE => GO TO gleep;
};
ENDCASE => ERROR;
GO TO answer;
EXITS
gleep => {ReleaseSTB[stb]; GO TO boom};
answer => ReleaseSTB[stb];
};
[] ← RTTCache.FillIntEntry[entry, LOOPHOLE[ans, CARDINAL]];
EXITS boom => ERROR Error[reason: typeFault, type: type];
};
IsInterface:
PUBLIC
SAFE
PROC[type: Type]
RETURNS[ans:
BOOL ←
FALSE] =
TRUSTED {
stb: SymbolTableBase;
sei: SymbolIndex;
entry: RTTCache.RefEntry;
info: REF BOOL;
IF type = nullType THEN RETURN[FALSE];
entry ← RTTCache.LookupRef[type, LOOPHOLE[IsInterface]];
info ← NARROW[entry.ref, REF BOOL];
IF info # NIL THEN RETURN[info^];
[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
definition => ans ← TRUE;
ENDCASE;
t: SymbolTableBase.y =>
WITH ser: t.e.seb[
NARROW[csei, SymbolConstructorIndex.y].e]
SELECT
FROM
definition => ans ← TRUE;
ENDCASE;
ENDCASE => ERROR;
}; -- end ENABLE UNWIND
ReleaseSTB[stb];
[] ← RTTCache.FillRefEntry[entry, NEW[BOOL ← ans]];
BitsForType:
PUBLIC
PROC [type: Type]
RETURNS [bft:
CARD, argumentRecord, interfaceRecord:
BOOL] = {
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 = SEUnderType[stb, sei];
WITH stb
SELECT
FROM
t: SymbolTableBase.x =>
WITH ser: t.e.seb[
NARROW[csei, SymbolConstructorIndex.x].e]
SELECT
FROM
record => {
w:
CARD =
t.e.WordsForType[NARROW[csei, SymbolConstructorIndex.x].e];
argumentRecord ← ser.argument;
interfaceRecord ← FALSE;
IF w > 1
THEN bft ← w * bitsPerWord
ELSE bft ← t.e.BitsForType[NARROW[csei, SymbolConstructorIndex.x].e];
};
definition => {
ans: CARDINAL ← 0;
proc:
PROC[stb: SymbolTableBase, isei: SymbolIdIndex]
RETURNS[stop:
BOOL] = {
IF
NOT ISEConstant[stb, isei]
THEN ans ← MAX[ans, IDCardinalValue[stb, isei]];
RETURN[FALSE];
};
[] ← EnumerateCtxIseis[stb, [x[ser.defCtx]], proc];
argumentRecord ← FALSE;
interfaceRecord ← TRUE;
bft ← (ans + 1)*bitsPerWord;
};
subrange => {
w: CARD = t.e.WordsForType[NARROW[csei, SymbolConstructorIndex.x].e];
argumentRecord ← FALSE;
interfaceRecord ← FALSE;
IF w > 1
THEN bft ← w * bitsPerWord
ELSE bft ← t.e.BitsForType[NARROW[csei, SymbolConstructorIndex.x].e];
IF bft = 0
THEN {
IF ser.empty
THEN bft ← bitsPerWord
ELSE ERROR Error[reason: typeFault, type: type];
};
};
ENDCASE => {
w: CARD = t.e.WordsForType[NARROW[csei, SymbolConstructorIndex.x].e];
argumentRecord ← FALSE;
interfaceRecord ← FALSE;
IF w > 1
THEN bft ← w * bitsPerWord
ELSE bft ← t.e.BitsForType[NARROW[csei, SymbolConstructorIndex.x].e];
IF bft = 0 THEN ERROR Error[reason: typeFault, type: type];
};
t: SymbolTableBase.y =>
WITH ser: t.e.seb[
NARROW[csei, SymbolConstructorIndex.y].e]
SELECT
FROM
record => {
w: CARD = t.e.WordsForType[NARROW[csei, SymbolConstructorIndex.y].e];
argumentRecord ← ser.argument;
interfaceRecord ← FALSE;
IF w > 1
THEN bft ← w * bitsPerWord
ELSE bft ← t.e.BitsForType[NARROW[csei, SymbolConstructorIndex.y].e];
};
definition => {
ans: CARDINAL ← 0;
proc:
PROC[stb: SymbolTableBase, isei: SymbolIdIndex]
RETURNS[stop:
BOOL] = {
IF NOT ISEConstant[stb, isei] THEN ans ← MAX[ans, IDCardinalValue[stb, isei]];
RETURN[FALSE]};
[] ← EnumerateCtxIseis[stb, [y[ser.defCtx]], proc];
argumentRecord ← FALSE;
interfaceRecord ← TRUE;
bft ← (ans + 1)*bitsPerWord};
subrange => {
w: CARD = t.e.WordsForType[NARROW[csei, SymbolConstructorIndex.y].e];
argumentRecord ← FALSE;
interfaceRecord ← FALSE;
IF w > 1
THEN bft ← w * bitsPerWord
ELSE bft ← t.e.BitsForType[NARROW[csei, SymbolConstructorIndex.y].e];
IF bft = 0
THEN {
IF ser.empty
THEN bft ← bitsPerWord
ELSE ERROR Error[reason: typeFault, type: type];
};
};
ENDCASE => {
w: CARD = t.e.WordsForType[NARROW[csei, SymbolConstructorIndex.y].e];
argumentRecord ←
FALSE;
interfaceRecord ← FALSE;
IF w > 1
THEN bft ← w * bitsPerWord
ELSE bft ← t.e.BitsForType[NARROW[csei, SymbolConstructorIndex.y].e];
IF bft = 0 THEN ERROR Error[reason: typeFault, type: type];
};
ENDCASE => ERROR;
};
ReleaseSTB[stb];
info ← NEW[BitsForTypeInfo ← [bft, argumentRecord, interfaceRecord]];
[] ← RTTCache.FillRefEntry[entry, info];
};
IsOverlaid:
PUBLIC
SAFE
PROC [type: Type]
RETURNS [ans:
BOOL ←
FALSE] =
TRUSTED {
stb: SymbolTableBase;
sei: SymbolIndex;
entry: RTTCache.IntEntry ← NIL;
class: Class ← AMTypes.TypeClass[type ← AMTypes.UnderType[type]];
SELECT class
FROM
union => {};
record, structure => {
[type, class] ← VariableType[type];
IF class # union THEN RETURN [FALSE];
};
ENDCASE => RETURN [FALSE];
entry ← RTTCache.LookupInt[type, IsOverlaid];
IF entry.int # -1 THEN RETURN[entry.int = 1]; -- 1 => TRUE, 2 => FALSE
[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
union => ans ← ser.overlaid;
ENDCASE;
t: SymbolTableBase.y =>
WITH ser: t.e.seb[t.e.UnderType[
NARROW[sei, SymbolIndex.y].e]]
SELECT
FROM
union => ans ← ser.overlaid;
ENDCASE;
ENDCASE => ERROR;
};
ReleaseSTB[stb];
IF entry # NIL THEN [] ← RTTCache.FillIntEntry[entry, (IF ans THEN 1 ELSE 2)];
};
IsComputed:
PUBLIC
SAFE
PROC [type: Type]
RETURNS [ans:
BOOL ←
FALSE] =
TRUSTED {
stb: SymbolTableBase;
sei: SymbolIndex;
entry: RTTCache.IntEntry ← NIL;
class: Class ← AMTypes.TypeClass[type ← AMTypes.UnderType[type]];
SELECT class
FROM
union, sequence => {};
record, structure => {
[type, class] ← VariableType[type];
IF class # union AND class # sequence THEN RETURN [FALSE];
};
ENDCASE => RETURN [FALSE];
entry ← RTTCache.LookupInt[type, IsComputed];
IF entry.int # -1 THEN RETURN[entry.int = 1]; -- 1 => TRUE, 2 => FALSE
[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
union => ans ← NOT ser.controlled;
sequence => ans ← NOT ser.controlled;
ENDCASE;
t: SymbolTableBase.y =>
WITH ser: t.e.seb[t.e.UnderType[
NARROW[sei, SymbolIndex.y].e]]
SELECT
FROM
union => ans ← NOT ser.controlled;
sequence => ans ← NOT ser.controlled;
ENDCASE;
ENDCASE => ERROR;
};
ReleaseSTB[stb];
IF entry # NIL THEN [] ← RTTCache.FillIntEntry[entry, (IF ans THEN 1 ELSE 2)];
};
IsOrdered:
PUBLIC
SAFE
PROC[type: Type]
RETURNS [ans:
BOOL] =
TRUSTED {
stb: SymbolTableBase;
sei: SymbolIndex;
[stb, sei] ← GetTypeSymbols[type ← AMTypes.UnderType[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 => ans ←
WITH rse: t.e.seb[t.e.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];
t: SymbolTableBase.y =>
WITH ser: t.e.seb[t.e.UnderType[
NARROW[sei, SymbolIndex.y].e]]
SELECT
FROM
long => ans ←
WITH rse: t.e.seb[t.e.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];
ENDCASE => ERROR;
};
ReleaseSTB[stb];
IsMachineDependent:
PUBLIC
SAFE
PROC [type: Type
--record, structure, union, enumerated, sequence--]
RETURNS[ans:
BOOL] =
TRUSTED {
stb: SymbolTableBase;
sei: SymbolIndex;
[stb, sei] ← GetTypeSymbols[type ← AMTypes.UnderType[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
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];
t: SymbolTableBase.y =>
WITH ser: t.e.seb[t.e.UnderType[
NARROW[sei, SymbolIndex.y].e]]
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];
ENDCASE => ERROR;
};
ReleaseSTB[stb];
SelectBasicClass:
PROC[brand: Brand, code: [0..16)]
RETURNS[Class] = {
SELECT brand
FROM
x =>
SELECT code
FROM
bx.typeCodeForINT => RETURN[integer];
bx.typeCodeForCHAR => RETURN[character];
ENDCASE => ERROR;
y =>
SELECT code
FROM
by.typeCodeForINT => RETURN[integer];
by.typeCodeForCHAR => RETURN[character];
ENDCASE => ERROR;
ENDCASE => ERROR;
};
END.