-- file Pass3T.mesa
-- last modified by Satterthwaite, December 7, 1982 10:46 am
DIRECTORY
Alloc: TYPE USING [Notifier],
ComData: TYPE USING [ownSymbols, typeAtomRecord],
P3: TYPE USING [
Attr, DefaultForm, LhsMode, NarrowOp, NPUse, phraseNP, voidAttr,
CompleteRecord, CopyTree, Initialization, RPush, UpdateTreeAttr,
VariantUnionType],
Symbols: TYPE USING [
Base, SERecord, SEIndex, ISEIndex, CSEIndex, RecordSEIndex, RefSEIndex, CTXIndex,
SENull, ISENull, lZ, typeANY, seType, ctxType, mdType],
SymbolOps: TYPE USING [
CtxEntries, FindExtension, MakeNonCtxSe, NormalType, TypeForm, TypeLink,
TypeRoot, UnderType, VisibleCtxEntries],
Tree: TYPE USING [Base, Link, Null, Scan, treeType],
TreeOps: TYPE USING [
PushSe, PopTree, PushNode, PushProperList, PushTree, OpName, ScanList],
Types: TYPE USING [Equivalent];
Pass3T: PROGRAM
IMPORTS P3, SymbolOps, TreeOps, Types, dataPtr: ComData
EXPORTS P3 = {
OPEN TreeOps, SymbolOps, Symbols, P3;
tb: Tree.Base; -- tree base address (local copy)
seb: Symbols.Base; -- se table base address (local copy)
ctxb: Symbols.Base; -- context table base address (local copy)
mdb: Symbols.Base; -- module table base address (local copy)
TypeNotify: PUBLIC Alloc.Notifier = {
-- called by allocator whenever table area is repacked
tb ← base[Tree.treeType];
seb ← base[seType]; ctxb ← base[ctxType]; mdb ← base[mdType]};
-- type mappings
CanonicalType: PUBLIC PROC [type: CSEIndex] RETURNS [CSEIndex] = {
RETURN [WITH t: seb[type] SELECT FROM
subrange => CanonicalType[UnderType[t.rangeType]],
record =>
IF Bundling[type] # 0
THEN CanonicalType[Unbundle[LOOPHOLE[type, RecordSEIndex]]]
ELSE type,
ENDCASE => type]};
TargetType: PUBLIC PROC [type: CSEIndex] RETURNS [target: CSEIndex] = {
RETURN [WITH t: seb[type] SELECT FROM
subrange => TargetType[UnderType[t.rangeType]],
ENDCASE => type]};
Unbundle: PUBLIC PROC [record: RecordSEIndex] RETURNS [CSEIndex] = {
RETURN [UnderType[seb[ctxb[seb[record].fieldCtx].seList].idType]]};
-- type predicates
AccessMode: PUBLIC PROC [type: CSEIndex] RETURNS [LhsMode] = {
nType: CSEIndex = NormalType[type];
RETURN [WITH t: seb[nType] SELECT FROM
ref => SELECT TRUE FROM
t.readOnly => none,
t.counted => counted,
ENDCASE => uncounted,
arraydesc => IF t.readOnly THEN none ELSE uncounted,
relative => AccessMode[UnderType[t.offsetType]],
ENDCASE => none]};
AssignableType: PUBLIC PROC [type: CSEIndex, safe: BOOL] RETURNS [BOOL] = {
RETURN [WITH t: seb[type] SELECT FROM
mode, definition, any, nil, sequence => FALSE,
record => t.hints.assignable AND (~safe OR ~t.hints.variant),
array => AssignableType[UnderType[t.componentType], safe],
transfer => t.mode # port,
opaque => t.lengthKnown,
ENDCASE => TRUE]};
Bundling: PUBLIC PROC [type: CSEIndex] RETURNS [nLevels: CARDINAL] = {
next: CSEIndex;
ctx: CTXIndex;
nLevels ← 0;
DO
IF type = SENull THEN EXIT;
WITH t: seb[type] SELECT FROM
record => {
IF ~t.hints.unifield THEN EXIT;
ctx ← t.fieldCtx;
WITH c: ctxb[ctx] SELECT FROM
included => {
IF t.hints.privateFields AND ~mdb[c.module].shared THEN EXIT;
IF ~c.complete THEN CompleteRecord[LOOPHOLE[type, RecordSEIndex]];
IF ~c.complete THEN EXIT};
ENDCASE;
IF CtxEntries[ctx] # 1 OR t.hints.variant THEN EXIT;
nLevels ← nLevels + 1;
next ← Unbundle[LOOPHOLE[type, RecordSEIndex]]};
ENDCASE => EXIT;
type ← next;
ENDLOOP;
RETURN};
IdentifiedType: PUBLIC PROC [type: CSEIndex] RETURNS [BOOL] = {
RETURN [WITH t: seb[type] SELECT FROM
mode, definition, any, nil, union, sequence => FALSE,
record =>
IF t.hints.variant AND ~t.hints.comparable THEN
SELECT seb[VariantUnionType[type]].typeTag FROM -- force copying now
sequence => FALSE,
ENDCASE => TRUE
ELSE TRUE,
opaque => t.lengthKnown,
ENDCASE => TRUE]};
IndexType: PUBLIC PROC [type: SEIndex] RETURNS [BOOL] = {
sei: CSEIndex = UnderType[type];
RETURN [WITH t: seb[sei] SELECT FROM
basic => t.ordered,
enumerated => t.ordered,
subrange => IndexType[t.rangeType],
long => IndexType[t.rangeType],
ENDCASE => FALSE]};
NewableType: PUBLIC PROC [type: SEIndex] RETURNS [BOOL] = {
sei: CSEIndex = UnderType[type];
RETURN [WITH t: seb[sei] SELECT FROM
mode, any, nil => FALSE,
opaque => t.lengthKnown,
ENDCASE => TRUE]};
NullableType: PUBLIC PROC [type: SEIndex] RETURNS [BOOL] = {
sei: CSEIndex = NormalType[UnderType[type]];
RETURN [WITH t: seb[sei] SELECT FROM
ref, transfer, arraydesc, zone => TRUE,
ENDCASE => FALSE]};
OrderedType: PUBLIC PROC [type: SEIndex] RETURNS [BOOL] = {
sei: CSEIndex = UnderType[type];
RETURN [WITH t: seb[sei] SELECT FROM
basic => t.ordered,
enumerated => t.ordered,
ref => t.ordered,
relative => OrderedType[t.offsetType],
subrange => OrderedType[t.rangeType],
long, real => OrderedType[t.rangeType],
ENDCASE => FALSE]};
DiscrimId: PROC [sei: ISEIndex] RETURNS [BOOL] = INLINE {
RETURN [ctxb[seb[sei].idCtx].level = lZ AND TypeLink[sei] # SENull]};
-- defaults
Default: PUBLIC PROC [type: SEIndex] RETURNS [form: DefaultForm] = {
next: SEIndex;
form ← none;
FOR s: SEIndex ← type, next DO
WITH se: seb[s] SELECT FROM
id => {
sei: ISEIndex = LOOPHOLE[s];
TestOption: Tree.Scan = {
IF OpName[t] = void THEN {IF form = none THEN form ← void}
ELSE form ← nonVoid};
IF seb[sei].extended THEN {ScanList[FindExtension[sei].tree, TestOption]; EXIT};
next ← seb[sei].idInfo};
cons =>
WITH t: se SELECT FROM
ref => {IF t.counted THEN form ← nonVoid; EXIT};
array => next ← t.componentType;
record => {IF t.hints.default THEN form ← nonVoid; EXIT};
transfer => {form ← nonVoid; EXIT};
long => next ← t.rangeType;
zone => {IF t.counted THEN form ← nonVoid; EXIT};
ENDCASE => EXIT;
ENDCASE => ERROR;
ENDLOOP;
RETURN};
DefaultInit: PUBLIC PROC [type: SEIndex] RETURNS [v: Tree.Link] = {
next: SEIndex;
subType: CSEIndex ← UnderType[type];
recordTail: Tree.Link ← Tree.Null;
tagId: ISEIndex ← ISENull;
v ← Tree.Null;
FOR s: SEIndex ← type, next DO
WITH se: seb[s] SELECT FROM
id => {
sei: ISEIndex = LOOPHOLE[s];
CopyNonVoid: Tree.Scan = {
IF OpName[t] # void AND v = Tree.Null THEN v ← CopyTree[t]};
SELECT TRUE FROM
(seb[sei].extended AND recordTail = Tree.Null) => {
ScanList[FindExtension[sei].tree, CopyNonVoid]; GO TO copy};
(DiscrimId[sei] AND tagId = ISENull) => tagId ← sei;
ENDCASE;
next ← seb[sei].idInfo};
cons =>
WITH t: se SELECT FROM
ref =>
IF t.counted THEN {PushTree[Tree.Null]; PushNode[nil, 1]; GO TO eval}
ELSE GO TO none;
array =>
IF Default[t.componentType] = nonVoid THEN {
PushTree[Tree.Null]; PushNode[all, 1]; GO TO eval}
ELSE GO TO none;
record =>
IF t.hints.default OR recordTail # Tree.Null THEN {
n: CARDINAL;
CompleteRecord[LOOPHOLE[s]];
n ← VisibleCtxEntries[t.fieldCtx];
FOR i: CARDINAL IN [1..n] DO
PushTree[IF i # n THEN Tree.Null ELSE recordTail] ENDLOOP;
PushProperList[n]; recordTail ← Tree.Null;
IF tagId = ISENull THEN {PushTree[Tree.Null]; PushNode[apply, -2]; GO TO eval}
ELSE {
PushSe[tagId]; tagId ← ISENull;
PushNode[apply,-2]; recordTail ← PopTree[];
next ← TypeLink[s]; subType ← UnderType[next]}}
ELSE GO TO none;
transfer => {
PushTree[Tree.Null]; PushNode[nil, 1]; GO TO eval};
zone =>
IF t.counted THEN {PushTree[Tree.Null]; PushNode[nil, 1]; GO TO eval}
ELSE GO TO none;
long => next ← t.rangeType;
ENDCASE => GO TO none;
ENDCASE => ERROR;
REPEAT
none => {v ← Tree.Null; phraseNP ← none; RPush[subType, voidAttr]};
copy => RPush[subType, IF v=Tree.Null THEN voidAttr ELSE UpdateTreeAttr[v]];
eval => v ← Initialization[TargetType[subType], PopTree[]];
ENDLOOP;
RETURN};
Voidable: PUBLIC PROC [type: SEIndex] RETURNS [BOOL] = {
next: SEIndex;
FOR s: SEIndex ← type, next DO
WITH se: seb[s] SELECT FROM
id => {
sei: ISEIndex = LOOPHOLE[s];
IF seb[sei].extended THEN RETURN [VoidItem[FindExtension[sei].tree]];
next ← seb[sei].idInfo};
cons =>
WITH t: se SELECT FROM
ref => RETURN [~t.counted];
array => next ← t.componentType;
record => RETURN [t.hints.voidable];
union => RETURN [t.hints.voidable];
long => next ← t.rangeType;
zone => RETURN [~t.counted];
ENDCASE => RETURN [TRUE];
ENDCASE => ERROR;
ENDLOOP};
VoidItem: PUBLIC PROC [t: Tree.Link] RETURNS [void: BOOL] = {
TestVoid: Tree.Scan = {IF OpName[t] = void THEN void ← TRUE};
void ← FALSE; ScanList[t, TestVoid]; RETURN};
-- discrimination operations
Narrowing: PUBLIC PROC [type, target: CSEIndex] RETURNS [op: NarrowOp ← []] = {
typeL: CSEIndex ← target;
typeR: CSEIndex ← type;
nextL, nextR: SEIndex;
IF ~Types.Equivalent[[dataPtr.ownSymbols, type], [dataPtr.ownSymbols, target]] THEN
DO
WITH tR: seb[typeR] SELECT FROM
any =>
WITH tL: seb[typeL] SELECT FROM
any => EXIT;
opaque => {
op.rtTest ← TRUE;
IF typeL # dataPtr.typeAtomRecord THEN op.unImpl ← TRUE;
EXIT};
ENDCASE => {
op.rtTest ← TRUE;
IF ~Discriminated[typeL] THEN EXIT;
nextL ← typeL; nextR ← TypeRoot[typeL]};
record =>
WITH tL: seb[typeL] SELECT FROM
record => {
IF Types.Equivalent[[dataPtr.ownSymbols, typeL], [dataPtr.ownSymbols, typeR]]
THEN EXIT;
WITH vL: tL SELECT FROM
linked => {
uType: CSEIndex = VariantUnionType[vL.linkType];
WITH u: seb[uType] SELECT FROM
union => IF u.controlled THEN op.tagTest ← TRUE ELSE op.computed ← TRUE;
ENDCASE => op.error ← TRUE;
nextL ← vL.linkType; nextR ← typeR};
ENDCASE => op.error ← TRUE};
ENDCASE => op.error ← TRUE;
ref =>
WITH tL: seb[typeL] SELECT FROM
ref => {
IF op.indirect OR (tL.counted # tR.counted) OR (tR.readOnly AND ~tL.readOnly)
THEN op.error ← TRUE;
op.indirect ← TRUE;
nextL ← tL.refType; nextR ← tR.refType};
ENDCASE => op.error ← TRUE;
transfer =>
WITH tL: seb[typeL] SELECT FROM
transfer => {
IF op.indirect OR tL.mode # tR.mode OR tL.safe # tR.safe THEN
op.error ← TRUE;
SELECT tL.mode FROM
proc, signal, error => NULL;
ENDCASE => op.error ← TRUE;
IF TypeForm[tL.typeIn] = any OR TypeForm[tL.typeOut] = any THEN
op.error ← TRUE; -- for now
IF TypeForm[tR.typeIn] = any THEN
op.rtTest ← TRUE
ELSE IF ~Types.Equivalent[
[dataPtr.ownSymbols, tL.typeIn],
[dataPtr.ownSymbols, tR.typeIn]] THEN op.error ← TRUE;
IF TypeForm[tR.typeOut] = any THEN
op.rtTest ← TRUE
ELSE IF ~Types.Equivalent[
[dataPtr.ownSymbols, tL.typeOut],
[dataPtr.ownSymbols, tR.typeOut]] THEN op.error ← TRUE;
EXIT};
ENDCASE => op.error ← TRUE;
long =>
WITH tL: seb[typeL] SELECT FROM
long => {nextL ← tL.rangeType; nextR ← tR.rangeType};
ENDCASE => op.error ← TRUE;
ENDCASE => {
IF Types.Equivalent[[dataPtr.ownSymbols, typeL], [dataPtr.ownSymbols, typeR]]
THEN EXIT;
op.error ← TRUE};
IF op.error THEN EXIT;
typeL ← UnderType[nextL]; typeR ← UnderType[nextR];
ENDLOOP;
RETURN};
Discriminated: PROC [type: CSEIndex] RETURNS [BOOL] = INLINE {
RETURN [TypeLink[type] # SENull]}; -- check that at tag exists?
MarkedType: PUBLIC PROC [type: CSEIndex] RETURNS [CSEIndex] = {
subType: CSEIndex = NormalType[type];
RETURN [WITH t: seb[subType] SELECT FROM
ref => UnderType[TypeRoot[t.refType]],
transfer => subType,
ENDCASE => typeANY]};
-- type construction
MakeLongType: PUBLIC PROC [rType: SEIndex, hint: CSEIndex]
RETURNS [type: CSEIndex] = {
subType: CSEIndex = UnderType[rType];
WITH t: seb[hint] SELECT FROM
long => IF TargetType[UnderType[t.rangeType]] = TargetType[subType] THEN RETURN [hint];
ENDCASE;
WITH t: seb[subType] SELECT FROM
relative => {
oType: CSEIndex = MakeLongType[UnderType[t.offsetType], UnderType[t.resultType]];
type ← MakeNonCtxSe[SERecord.cons.relative.SIZE];
seb[type] ← [mark3: TRUE, mark4: TRUE,
body: cons[relative[
baseType: t.baseType, offsetType: oType, resultType: oType]]]};
ENDCASE => {
type ← MakeNonCtxSe[SERecord.cons.long.SIZE];
seb[type] ← [mark3: TRUE, mark4: TRUE, body: cons[long[rangeType: rType]]]};
RETURN};
MakeRefType: PUBLIC PROC [
cType: SEIndex, hint: CSEIndex, readOnly, counted, var: BOOL]
RETURNS [type: RefSEIndex] = {
WITH t: seb[hint] SELECT FROM
ref =>
IF ~t.ordered
AND t.readOnly = readOnly AND t.counted = counted AND t.var = var
AND UnderType[t.refType] = UnderType[cType] THEN RETURN [LOOPHOLE[hint]];
ENDCASE;
type ← LOOPHOLE[MakeNonCtxSe[SERecord.cons.ref.SIZE]];
seb[type] ← [mark3: TRUE, mark4: TRUE,
body: cons[ref[
counted: counted,
var: var,
readOnly: readOnly, ordered: FALSE, list: FALSE, basing: FALSE,
refType: cType]]];
RETURN};
}.