AMTypesBImpl.Mesa
NOTE do Equal, AsGoodAs
try to avoid acquisition of already acquired symbol tables
status stuff is wrong.
Paul Rovner, November 16, 1983 8:39 pm
Russ Atkinson, May 11, 1984 2:09:21 pm PDT
DIRECTORY
AMTypes USING[UnderType, Error, Index, Class, NComponents, IndexToType],
Basics USING[bitsPerWord],
BrandXSymbolDefs
USING
[SymbolConstructorIndex, SymbolIdIndex, nullSymbolIndex, typeCodeForCHAR, StandardSymbolContextIndex, typeCodeForINT],
BrandYSymbolDefs
USING
[SymbolConstructorIndex, SymbolIdIndex, nullSymbolIndex, typeCodeForCHAR, StandardSymbolContextIndex, typeCodeForINT],
Rope USING [ROPE, Text],
RTCommon USING [ShortenLongCardinal],
RTSymbolDefs
USING
[SymbolTableBase, SymbolConstructorIndex, Brand, SymbolIdIndex, SymbolIndex],
RTSymbolOps
USING
[EnumerateCtxIseis, SEUnderType, ISEConstant, IDCardinalValue, SETagIDP],
RTSymbols USING [GetTypeSymbols, ReleaseSTB],
RTTCache USING[RefEntry, LookupRef, FillRefEntry, IntEntry, LookupInt, FillIntEntry],
RTTypesPrivate USING [],
SafeStorage USING[Type, nullType, fhType, gfhType, unspecType, GetCanonicalType];
AMTypesBImpl:
PROGRAM
IMPORTS AMTypes, RTCommon, 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: LONG CARDINAL, 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 {
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];
};
Size:
PUBLIC
SAFE
PROC
[type: Type, length: CARDINAL ← 0--for sequence-containing records--]
RETURNS [ans: CARDINAL ← 0 --number of words--] = TRUSTED {
max for unions
Could overflow!
stb: SymbolTableBase;
uType: Type = 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:
LONG
CARDINAL =
NARROW[sstb, SymbolTableBase.x].e.BitsPerElement[
type: ser.componentType, packed: ser.packed];
ans ← RTCommon.ShortenLongCardinal[
(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:
LONG
CARDINAL =
NARROW[sstb, SymbolTableBase.y].e.BitsPerElement[
type: ser.componentType, packed: ser.packed];
ans ← RTCommon.ShortenLongCardinal [
(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];
}; -- end Size
IsPainted:
PUBLIC
SAFE
PROC[type: Type]
RETURNS[ans:
BOOL] =
TRUSTED {
the Type itself is the color. Record and enumerated types are painted.
RETURN[
SELECT TypeClass[UnderType[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 =>
ans ←
(
WITH ser: t.e.seb[t.e.UnderType[
NARROW[sei, SymbolIndex.x].e]]
SELECT
FROM
basic => SelectBasicClass[x, 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: t.e.seb[t.e.UnderType[ser.rangeType] ]
SELECT
FROM
ref => (
IF rse.counted
THEN (
IF rse.list
THEN 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 atom ELSE ref
ENDCASE => ref)
ELSE (IF rse.basing THEN basePointer ELSE longPointer)),
basic => (IF rse.code = bx.typeCodeForINT THEN longInteger ELSE ERROR),
arraydesc => 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 longCardinal ELSE ERROR),
ENDCASE => ERROR),
ENDCASE => ERROR),
enumerated => 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 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]);
t: SymbolTableBase.y =>
ans ←
(
WITH ser: t.e.seb[t.e.UnderType[
NARROW[sei, SymbolIndex.y].e]]
SELECT
FROM
basic => SelectBasicClass[y, 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: t.e.seb[t.e.UnderType[ser.rangeType] ]
SELECT
FROM
ref => (
IF rse.counted
THEN (
IF rse.list
THEN 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 atom ELSE ref
ENDCASE => ref)
ELSE (IF rse.basing THEN basePointer ELSE longPointer)),
basic => (IF rse.code = by.typeCodeForINT THEN longInteger ELSE ERROR),
arraydesc => 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 longCardinal ELSE ERROR),
ENDCASE => ERROR),
ENDCASE => ERROR),
enumerated => 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 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]);
ENDCASE => ERROR;
ReleaseSTB[stb];
EXITS
answer => ReleaseSTB[stb]};
[] ← RTTCache.FillIntEntry[entry, LOOPHOLE[ans, CARDINAL]];
}; -- end TypeClass
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: LONG CARDINAL, 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:
LONG
CARDINAL =
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:
LONG
CARDINAL
= 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:
LONG
CARDINAL
= 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:
LONG
CARDINAL =
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:
LONG
CARDINAL
= 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:
LONG
CARDINAL =
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];
}; -- end BitsForType
IsOverlaid:
PUBLIC
SAFE
PROC
[type: Type--union--] RETURNS [ans: BOOL ← FALSE] = TRUSTED {
stb: SymbolTableBase;
sei: SymbolIndex;
class: Class = TypeClass[UnderType[type]];
entry: RTTCache.IntEntry ← NIL;
IF class = nil THEN RETURN;
entry ← RTTCache.LookupInt[type, IsOverlaid];
IF entry.int # -1 THEN RETURN[entry.int = 1]; -- 1 => TRUE, 2 => FALSE
IF class = record OR class = structure THEN type ← IndexToType[type, NComponents[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
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--union, sequence--] RETURNS [ans: BOOL ← FALSE] = TRUSTED {
stb: SymbolTableBase;
sei: SymbolIndex;
class: Class = TypeClass[UnderType[type]];
entry: RTTCache.IntEntry ← NIL;
IF class = nil THEN RETURN;
entry ← RTTCache.LookupInt[type, IsComputed];
IF entry.int # -1 THEN RETURN[entry.int = 1]; -- 1 => TRUE, 2 => FALSE
IF class = record OR class = structure THEN type ← IndexToType[type, NComponents[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
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];
{
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];
{
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.