-- file Pass3Xa.mesa
-- last modified by Satterthwaite, March 24, 1983 1:05 pm
-- last modified by Donahue, 10-Dec-81 11:23:00
DIRECTORY
A3: TYPE USING [
AssignableType, BodyForTree, CanonicalType, Default, DefaultInit, LongPath,
OperandInternal, OperandLevel, OperandLhs, OperandType, PermanentType,
TargetType, TypeForTree, Unwrap, VarType, Voidable, VoidItem, Wrappings],
Alloc: TYPE USING [Notifier],
ComData: TYPE USING [
interface, mainCtx, ownSymbols, seAnon, textIndex,
typeCONDITION, typeStringBody],
Copier: TYPE USING [SEToken, nullSEToken, CtxNext, TokenName, TokenValue],
Log: TYPE USING [Error, ErrorHti, ErrorN, ErrorNode, ErrorSei, ErrorTree],
P3: TYPE USING [
Attr, emptyAttr, fullAttr, voidAttr, NPUse, MergeNP, SetNP,
And, ArrangeKeys, CatchPhrase, ClusterId, CompleteRecord, CopyTree,
DiscriminatedType, EnterComposite, Exp, FieldId, ForceType,
InterfaceId, MainIncludedCtx, MiscXfer, PopCtx, PushCtx, RAttr, Rhs,
RPop, RPush, RType, Shared, Span, SearchCtxList, SelectVariantType,
SequenceField, UpdateTreeAttr, VariantUnionType, VoidExp, XferForFrame],
P3S: TYPE USING [
ImplicitInfo, SelfInfo, currentBody, currentScope, implicit, safety],
Symbols: TYPE USING [
Base, Name, Type, ISEIndex, CSEIndex, ArraySEIndex, RecordSEIndex,
ContextLevel, CTXIndex, CBTIndex, TransferMode,
nullName, nullType, ISENull, CSENull, RecordSENull, CTXNull, CBTNull,
lG, typeANY, typeTYPE, bodyType, ctxType, seType],
SymbolOps: TYPE USING [
ArgCtx, ConstantId, FindExtension, FirstCtxSe, FirstVisibleSe, NextSe,
NextVisibleSe, NormalType, RCType, ReferentType, TransferTypes,
TypeForm, TypeRoot, UnderType, VisibleCtxEntries, XferMode],
Tree: TYPE USING [
Base, Index, Link, Map, NodeName, Scan, Null, treeType],
TreeOps: TYPE USING [
FreeNode, FreeTree, GetHash, GetNode, ListHead, ListLength, ListTail, MakeList,
MakeNode, MarkShared, NthSon, OpName, PopTree, PushHash, PushList,
PushNode, PushProperList, PushSe, PushTree, ScanList, SetAttr, SetInfo, UpdateList],
Types: TYPE USING [SymbolTableBase, Assignable];
Pass3Xa: PROGRAM
IMPORTS
A3, Copier, Log, P3, P3S, SymbolOps, TreeOps, Types,
dataPtr: ComData
EXPORTS P3, P3S = {
OPEN SymbolOps, Symbols, TreeOps, A3, P3;
tb: Tree.Base; -- tree base address (local copy)
seb: Base; -- se table base address (local copy)
ctxb: Base; -- context table base address (local copy)
bb: Base; -- body table base address (local copy)
own: Types.SymbolTableBase;
ExpANotify: PUBLIC Alloc.Notifier = {
-- called by allocator whenever table area is repacked
seb ← base[seType]; ctxb ← base[ctxType];
bb ← base[bodyType];
tb ← base[Tree.treeType];
own ← dataPtr.ownSymbols};
-- parameter reference bookkeeping
phraseNP: PUBLIC NPUse;
-- expression list manipulation
KeyedList: PROC [t: Tree.Link] RETURNS [BOOL] = {
RETURN [OpName[ListHead[t]] = item]};
PopKeyList: PROC [nItems: CARDINAL] RETURNS [t: Tree.Link] = {
t ← MakeList[nItems];
IF t = Tree.Null AND nItems # 0 THEN {PushTree[t]; PushProperList[1]; t ← PopTree[]};
RETURN};
CheckLength: PROC [t: Tree.Link, length: INTEGER] = {
n: INTEGER = ListLength[t];
SELECT n FROM
= length => NULL;
> length => Log.ErrorN[listLong, n-length];
< length => Log.ErrorN[listShort, length-n];
ENDCASE};
ContextComplete: PROC [ctx: CTXIndex] RETURNS [BOOL] = {
RETURN [WITH ctxb[ctx] SELECT FROM
simple => TRUE,
included => complete,
ENDCASE => FALSE]};
CheckScope: PUBLIC PROC [t: Tree.Link, type: Type] RETURNS [v: Tree.Link] = {
SELECT XferMode[type] FROM
proc, signal, error =>
SELECT OperandLevel[t] FROM
global => v ← t;
local => {Log.ErrorTree[scopeFault, t]; v ← t};
ENDCASE => {
PushTree[t]; PushNode[proccheck, 1]; SetInfo[type];
v ← PopTree[]};
ENDCASE => v ← t;
RETURN};
KeyForHash: PROC [name: Name] RETURNS [Name] = {
RETURN [IF name = nullName THEN seb[dataPtr.seAnon].hash ELSE name]};
HashForSe: PROC [sei: ISEIndex] RETURNS [Name] = {
RETURN [IF sei = ISENull THEN nullName ELSE KeyForHash[seb[sei].hash]]};
PadList: PROC [record: RecordSEIndex, expList: Tree.Link] RETURNS [Tree.Link] = {
ctx: CTXIndex = seb[record].fieldCtx;
sei: ISEIndex ← FirstVisibleSe[ctx];
added: BOOL ← FALSE;
nFields: CARDINAL ← 0;
PushField: Tree.Map = {
PushTree[t]; nFields ← nFields + 1; sei ← NextSe[sei];
RETURN [Tree.Null]};
[] ← FreeTree[UpdateList[expList, PushField]];
UNTIL sei = ISENull DO
IF ~seb[sei].extended AND (seb[record].argument OR Default[seb[sei].idType] = none) THEN
EXIT;
PushTree[Tree.Null]; added ← TRUE; nFields ← nFields + 1;
sei ← NextSe[sei];
ENDLOOP;
IF added THEN PushProperList[nFields] ELSE PushList[nFields];
RETURN [PopTree[]]};
FieldDefault: PUBLIC PROC [sei: ISEIndex] RETURNS [v: Tree.Link] = {
CheckOption: Tree.Scan = {IF OpName[t] # void THEN v ← CopyTree[t]};
v ← Tree.Null; ScanList[FindExtension[sei].tree, CheckOption];
RPush[seb[sei].idType, IF v=Tree.Null THEN voidAttr ELSE UpdateTreeAttr[v]];
RETURN};
FieldVoid: PROC [t: Tree.Link] RETURNS [Tree.Link] = {
[] ← FreeTree[t]; phraseNP ← none; RPush[typeANY, voidAttr];
RETURN [Tree.Null]};
MatchFields: PUBLIC PROC [
record: RecordSEIndex, expList: Tree.Link,
init: BOOL←FALSE, scopeCheck: BOOL←TRUE]
RETURNS [val: Tree.Link] = {
nFields: CARDINAL;
ctx: CTXIndex;
sei: ISEIndex;
attr: Attr ← fullAttr;
exitNP: NPUse ← none;
EvaluateField: Tree.Map = {
subAttr: Attr;
type: Type;
IF sei # ISENull AND ~(seb[sei].public OR init OR Shared[ctx]) THEN
Log.ErrorSei[noAccess, sei];
SELECT TRUE FROM
(t = Tree.Null) =>
v ← SELECT TRUE FROM
(sei = ISENull) => FieldVoid[t],
(seb[sei].extended) => FieldDefault[sei],
(seb[record].argument) => FieldVoid[t],
ENDCASE => DefaultInit[seb[sei].idType];
(OpName[t] = void) => v ← FieldVoid[t];
ENDCASE => {
target: CSEIndex =
TargetType[IF sei=ISENull THEN typeANY ELSE UnderType[seb[sei].idType]];
v ← IF init THEN Initialization[target, t] ELSE Rhs[t, target]};
subAttr ← RAttr[]; type ← RType[]; RPop[];
IF v = Tree.Null AND
~(IF seb[sei].extended
THEN VoidItem[FindExtension[sei].tree]
ELSE Voidable[seb[sei].idType]) THEN Log.ErrorSei[elision, sei];
IF scopeCheck AND P3S.safety = checked THEN
IF TypeForm[type] = transfer THEN v ← CheckScope[v, type];
attr ← And[attr, subAttr]; exitNP ← MergeNP[exitNP][phraseNP];
sei ← NextSe[sei];
RETURN};
IF record = CSENull THEN {CheckLength[expList, 0]; sei ← ISENull}
ELSE {
CompleteRecord[record];
IF ~ContextComplete[seb[record].fieldCtx] THEN {
IF seb[record].hints.privateFields THEN Log.Error[noAccess];
sei ← ISENull}
ELSE {
ctx ← seb[record].fieldCtx;
IF KeyedList[expList] THEN {
sei: ISEIndex;
started: BOOL ← FALSE;
NextKey: PROC RETURNS [Name] = {
SELECT TRUE FROM
~started => {sei ← FirstVisibleSe[ctx]; started ← TRUE};
(sei # ISENull) => sei ← NextVisibleSe[sei];
ENDCASE;
RETURN [HashForSe[sei]]};
OmittedValue: PROC RETURNS [t: Tree.Link] = {
IF ~seb[sei].extended AND (seb[record].argument OR Default[seb[sei].idType] = none)
THEN {
Log.ErrorHti[omittedKey, seb[sei].hash];
t ← [symbol[dataPtr.seAnon]]}
ELSE t ← Tree.Null;
RETURN};
nFields ← ArrangeKeys[expList, NextKey, OmittedValue];
expList ← PopKeyList[nFields]}
ELSE {
nFields ← VisibleCtxEntries[ctx];
IF ListLength[expList] < nFields THEN expList ← PadList[record, expList];
CheckLength[expList, nFields]};
sei ← FirstVisibleSe[ctx]}};
val ← UpdateList[expList, EvaluateField];
RPush[record, attr]; phraseNP ← exitNP; RETURN};
Dereference: PROC [t: Tree.Link, type: Type, long: BOOL] RETURNS [Tree.Link] = {
PushTree[t]; PushNode[uparrow, 1]; SetInfo[type]; SetAttr[2, long];
RETURN[PopTree[]]};
ClusterCtx: PROC [ctx: CTXIndex] RETURNS [CTXIndex] = {
RETURN [WITH c: ctxb[ctx] SELECT FROM
simple => IF dataPtr.interface THEN dataPtr.mainCtx ELSE CTXNull,
included => MainIncludedCtx[c.module],
ENDCASE => CTXNull]};
ClusterForType: PROC [type: Type] RETURNS [CTXIndex] = {
subType: CSEIndex = UnderType[type];
RETURN [WITH t: seb[subType] SELECT FROM
enumerated => ClusterCtx[t.valueCtx],
record => IF ~t.argument THEN ClusterCtx[t.fieldCtx] ELSE CTXNull,
ref => ClusterForType[t.refType],
relative => ClusterForType[t.offsetType],
subrange => ClusterForType[t.rangeType],
long => ClusterForType[t.rangeType],
opaque => seb[t.id].idCtx,
ENDCASE => CTXNull]};
-- operators
Initialization: PUBLIC PROC [type: CSEIndex, t: Tree.Link] RETURNS [v: Tree.Link] = {
WITH seb[type] SELECT FROM
record =>
IF OpName[t] = apply THEN {Construct[GetNode[t], LOOPHOLE[type], TRUE]; v ← t}
ELSE v ← Rhs[t, type];
union =>
IF OpName[t] = apply THEN {
subType: CSEIndex = UnderType[TypeForTree[NthSon[t, 1]]];
WITH seb[subType] SELECT FROM
record => {Construct[GetNode[t], LOOPHOLE[subType], TRUE]; v ← t};
ENDCASE => v ← Rhs[t, type]}
ELSE v ← Rhs[t, type];
array =>
IF OpName[t] = all THEN {All[GetNode[t], type, TRUE]; v ← t}
ELSE v ← Rhs[t, type];
ENDCASE => v ← Rhs[t, type];
RETURN};
Assignment: PUBLIC PROC [node: Tree.Index] = {
OPEN tb[node];
lhsType, rhsType: Type;
attr: Attr;
saveNP: NPUse;
son[1] ← Exp[son[1], typeANY]; saveNP ← phraseNP;
lhsType ← RType[]; attr ← RAttr[]; RPop[];
son[2] ← Rhs[son[2], TargetType[lhsType]];
rhsType ← RType[]; attr ← And[RAttr[], attr]; RPop[];
attr.noAssign ← FALSE; phraseNP ← MergeNP[phraseNP][saveNP];
RPush[rhsType, attr];
IF ~AssignableType[lhsType, P3S.safety=checked] THEN
Log.ErrorTree[nonLHS, son[1]];
SELECT TypeForm[lhsType] FROM
transfer => IF P3S.safety = checked THEN son[2] ← CheckScope[son[2], rhsType];
union =>
IF ~Types.Assignable[
[own, DiscriminatedType[typeANY, son[1]]],
[own, DiscriminatedType[typeANY, son[2]]]] THEN Log.ErrorTree[typeClash, son[2]];
sequence => Log.ErrorTree[typeClash, son[2]];
ENDCASE;
tb[node].attr1 ← FALSE;
SELECT OperandLhs[son[1]] FROM
counted =>
SELECT RCType[lhsType] FROM
simple => {tb[node].attr2 ← TRUE; tb[node].attr3 ← FALSE};
composite => {
tb[node].attr2 ← tb[node].attr3 ← TRUE;
EnterComposite[lhsType, son[2], FALSE]};
ENDCASE => tb[node].attr2 ← FALSE;
none => Log.ErrorTree[nonLHS, son[1]];
ENDCASE => tb[node].attr2 ← FALSE};
implicitRecord: PUBLIC RecordSEIndex;
Extract: PUBLIC PROC [node: Tree.Index] = {
OPEN tb[node];
type: Type;
attr: Attr;
ctx: CTXIndex;
sei: ISEIndex;
nL, nR: CARDINAL;
saveImplicit: P3S.ImplicitInfo = P3S.implicit;
saveRecord: RecordSEIndex = implicitRecord;
saveNP: NPUse;
PushItem: Tree.Map = {PushTree[t]; RETURN [Tree.Null]};
Extractor: PROC [t: Tree.Link] RETURNS [BOOL] = INLINE {
RETURN [OpName[t] = apply AND NthSon[t, 1] = Tree.Null]};
AssignItem: Tree.Map = {
saveType: Type = P3S.implicit.type;
IF sei # ISENull AND ~seb[sei].public AND ~Shared[ctx] THEN
Log.ErrorSei[noAccess, sei];
IF t = Tree.Null THEN v ← Tree.Null
ELSE {
P3S.implicit.type ← IF sei = ISENull THEN typeANY ELSE seb[sei].idType;
IF Extractor[t] THEN {
subNode: Tree.Index = GetNode[t];
PushTree[tb[subNode].son[2]];
tb[subNode].son[2] ← Tree.Null; FreeNode[subNode];
PushTree[Tree.Null]; v ← MakeNode[extract, 2];
Extract[GetNode[v]]}
ELSE {
PushTree[t]; PushTree[Tree.Null]; v ← MakeNode[assign, 2];
Assignment[GetNode[v]]};
attr ← And[RAttr[], attr]; saveNP ← MergeNP[saveNP][phraseNP]; RPop[]};
sei ← NextSe[sei];
P3S.implicit.type ← saveType; RETURN};
P3S.implicit.tree ← son[2] ← ExtractorRhs[son[2]];
type ← RType[]; P3S.implicit.attr ← attr ← RAttr[]; RPop[];
saveNP ← phraseNP;
IF type = nullType THEN {nR ← 0; sei ← ISENull}
ELSE {
subType: CSEIndex = UnderType[TypeRoot[type]];
WITH seb[subType] SELECT FROM
record => {
CompleteRecord[LOOPHOLE[subType, RecordSEIndex]];
IF ContextComplete[fieldCtx] THEN {
implicitRecord ← LOOPHOLE[subType, RecordSEIndex];
ctx ← fieldCtx; sei ← FirstVisibleSe[ctx];
nR ← VisibleCtxEntries[ctx]}
ELSE {Log.Error[noAccess]; type ← typeANY; nR ← 0; sei ← ISENull}};
ENDCASE => {
Log.ErrorTree[typeClash, son[2]];
type ← typeANY; nR ← 0; sei ← ISENull}};
IF KeyedList[son[1]] AND nR # 0 THEN {
sei: ISEIndex;
started: BOOL ← FALSE;
NextKey: PROC RETURNS [Name] = {
SELECT TRUE FROM
~started => {sei ← FirstVisibleSe[ctx]; started ← TRUE};
(sei # ISENull) => sei ← NextVisibleSe[sei];
ENDCASE;
RETURN [HashForSe[sei]]};
FillNull: PROC RETURNS [Tree.Link] = {RETURN [Tree.Null]};
nL ← ArrangeKeys[son[1], NextKey, FillNull]}
ELSE {
nL ← ListLength[son[1]];
son[1] ← FreeTree[UpdateList[son[1], PushItem]];
IF nL > nR AND type # typeANY THEN Log.ErrorN[listLong, nL-nR];
THROUGH (nL .. nR] DO PushTree[Tree.Null] ENDLOOP;
nL ← MAX[nL, nR]};
PushTree[UpdateList[MakeList[nR], AssignItem]];
PushNode[exlist, 1]; SetInfo[type]; son[1] ← PopTree[];
RPush[type, attr]; phraseNP ← saveNP;
P3S.implicit ← saveImplicit; implicitRecord ← saveRecord};
ExtractorRhs: PROC [t: Tree.Link] RETURNS [v: Tree.Link] = INLINE {
SELECT OpName[t] FROM
apply => {
node: Tree.Index = Apply[GetNode[t], typeANY, FALSE];
tb[node].info ← RType[]; v ← [subtree[node]]};
signalx, errorx, joinx, startx => {
PushTree[MiscXfer[GetNode[t], typeANY]]; SetInfo[RType[]]; v ← PopTree[]};
ENDCASE => v ← Exp[t, typeANY];
RETURN};
self: PUBLIC P3S.SelfInfo;
Dot: PUBLIC PROC [node: Tree.Index, target: CSEIndex] RETURNS [Tree.Index] = {
IF DotExpr[node].selfAppl THEN {
saveSelf: P3S.SelfInfo = self;
v: Tree.Link = tb[node].son[2];
self ← [tree: tb[node].son[1], type: RType[], attr: RAttr[], np: phraseNP];
RPop[]; tb[node].son[1] ← tb[node].son[2] ← Tree.Null; FreeNode[node];
node ← GetNode[Exp[ApplyToSelf[v, Tree.Null, Tree.Null], target]];
self ← saveSelf};
RETURN [node]};
DotExpr: PROC [node: Tree.Index] RETURNS [selfAppl: BOOL ← FALSE] = {
OPEN tb[node];
type, lType: CSEIndex;
rType: Type;
sei: ISEIndex;
fieldName: Name = GetHash[son[2]];
attr: Attr;
nDerefs: CARDINAL ← 0;
son[1] ← Exp[son[1], typeANY]; type ← lType ← RType[]; attr ← RAttr[]; RPop[];
-- N.B. failure is avoided only by EXITing the following loop
DO
nType: CSEIndex = NormalType[type];
WITH t: seb[nType] SELECT FROM
record => {
nHits: CARDINAL;
[nHits, sei] ← FieldId[fieldName, LOOPHOLE[nType, RecordSEIndex]];
SELECT nHits FROM
0 => {
matched: BOOL;
[matched, sei] ← ClusterId[fieldName, ClusterForType[nType]];
IF matched AND XferMode[seb[sei].idType] # none THEN {
name ← cdot; selfAppl ← TRUE; attr2 ← FALSE;
son[2] ← [symbol[sei]]; rType ← lType;
attr.const ← ConstantId[sei];
EXIT};
IF Wrappings[nType] = 0 THEN GO TO nomatch};
1 => {
long: BOOL ← LongPath[son[1]];
counted: BOOL ← TRUE;
WHILE lType # type DO -- rederive path, update tree
subType: CSEIndex = NormalType[lType];
WITH s: seb[subType] SELECT FROM
ref => {
long ← seb[lType].typeTag = long;
lType ← UnderType[s.refType];
IF ~(s.counted OR PermanentType[s.refType]) THEN counted ← FALSE;
IF nDerefs > 1 OR lType # type THEN {
son[1] ← Dereference[son[1], lType, long]; nDerefs ← nDerefs-1}};
record => {
lType ← Unwrap[LOOPHOLE[subType, RecordSEIndex]];
son[1] ← ForceType[son[1], lType]};
ENDCASE;
ENDLOOP;
IF nDerefs = 0 THEN name ← dollar;
attr2 ← long;
IF ~attr.const AND ConstantId[sei] THEN {name ← cdot; attr.const ← TRUE};
IF P3S.safety = checked AND ~counted THEN
Log.ErrorNode[unsafeOperation, node];
son[2] ← [symbol[sei]]; rType ← seb[sei].idType;
EXIT};
ENDCASE => GO TO ambiguous;
type ← Unwrap[LOOPHOLE[nType, RecordSEIndex]]};
opaque, enumerated, relative => {
matched: BOOL;
[matched, sei] ← ClusterId[fieldName, ClusterForType[nType]];
IF matched AND XferMode[seb[sei].idType] # none THEN {
name ← cdot; selfAppl ← TRUE; attr2 ← FALSE;
son[2] ← [symbol[sei]]; rType ← lType;
attr.const ← ConstantId[sei];
EXIT};
GO TO nomatch};
ref => {
IF (nDerefs ← nDerefs+1) > 63 THEN GO TO nomatch;
type ← UnderType[t.refType]; attr.const ← FALSE};
definition, transfer =>
IF ([sei: sei]←InterfaceId[fieldName, InterfaceCtx[nType, son[1]]]).found THEN {
name ← cdot; son[2] ← [symbol[sei]]; attr2 ← FALSE;
rType ← seb[sei].idType; type ← UnderType[rType];
attr.const ← ConstantId[sei];
IF VarType[type] OR (
ctxb[seb[sei].idCtx].ctxType = imported AND ~dataPtr.interface
AND TypeForm[type] = ref) THEN {
rType ← ReferentType[type]; son[2] ← Dereference[son[2], rType, FALSE]};
EXIT}
ELSE GOTO nomatch;
mode => {
rType ← NormalType[TypeForTree[tb[node].son[1]]];
WITH t: seb[rType] SELECT FROM
enumerated =>
IF ([sei: sei]←SearchCtxList[fieldName, t.valueCtx]).found THEN
name ← cdot
ELSE GOTO nomatch;
record => {
sei ← SelectVariantType[rType, fieldName];
rType ← typeTYPE; name ← discrimTC};
ENDCASE => GO TO nomatch;
son[2] ← [symbol[sei]]; attr2 ← FALSE; attr.const ← TRUE; EXIT};
ENDCASE => GO TO nomatch;
REPEAT
nomatch => {
son[2] ← [symbol[dataPtr.seAnon]];
IF son[1] # son[2] AND fieldName # nullName THEN
Log.ErrorHti[unknownField, fieldName];
rType ← typeANY; attr ← emptyAttr};
ambiguous => {
Log.ErrorHti[ambiguousId, fieldName];
son[2] ← [symbol[dataPtr.seAnon]];
rType ← typeANY; attr ← emptyAttr};
ENDLOOP;
tb[node].info ← rType; RPush[rType, attr]; RETURN};
Apply: PUBLIC PROC [node: Tree.Index, target: CSEIndex, mustXfer: BOOL]
RETURNS [Tree.Index] = {
opType, type: CSEIndex;
attr: Attr;
leftNP: NPUse;
long: BOOL;
nDerefs: CARDINAL ← 0;
indirect: BOOL ← FALSE;
string, desc: BOOL ← FALSE;
saveSelf: P3S.SelfInfo = self;
ForceDirect: PROC = {
IF indirect THEN
tb[node].son[1] ← Dereference[tb[node].son[1], opType, long];
indirect ← FALSE};
IF tb[node].son[1] # Tree.Null THEN {
IF OpName[tb[node].son[1]] = dot AND ~tb[node].attr1 THEN node ← DotApply[node]
ELSE
WITH t: seb[target] SELECT FROM
union => {
PushCtx[t.caseCtx]; tb[node].son[1] ← Exp[tb[node].son[1], typeANY]; PopCtx[]};
ENDCASE => tb[node].son[1] ← Exp[tb[node].son[1], typeANY];
opType ← RType[]; attr ← RAttr[]; leftNP ← phraseNP; RPop[];
IF opType = typeTYPE THEN type ← UnderType[TypeForTree[tb[node].son[1]]]}
ELSE {
opType ← typeTYPE;
SELECT seb[target].typeTag FROM
record => type ← UnderType[TypeRoot[target]];
array => type ← target;
ENDCASE => {type ← CSENull; Log.ErrorNode[noTarget, node]}};
long ← LongPath[tb[node].son[1]];
-- dereferencing/deproceduring loop
DO
OPEN tb[node];
nType: CSEIndex = NormalType[opType];
WITH t: seb[nType] SELECT FROM
mode => {
ForceDirect[];
SELECT TypeForm[NormalType[type]] FROM
record => Construct[node, LOOPHOLE[type, RecordSEIndex]];
array => RowCons[node, LOOPHOLE[type, ArraySEIndex]];
enumerated, basic => {
temp: Tree.Link = son[1];
IF UniOperand[node] THEN son[2] ← Rhs[son[2], TargetType[type]];
attr ← And[RAttr[], attr]; phraseNP ← MergeNP[leftNP][phraseNP]; RPop[];
son[1] ← son[2]; son[2] ← temp;
name ← check; RPush[type, attr]};
ENDCASE => ApplyError[node, type # CSENull];
EXIT};
transfer => {
mode: TransferMode = t.mode;
OpName: ARRAY TransferMode OF Tree.NodeName = [
proc: callx, port: portcallx, signal: signalx, error: errorx,
process: joinx, program: startx, none: apply];
ForceDirect[];
SELECT mode FROM
proc =>
IF ~P3S.currentBody.lockHeld AND OperandInternal[son[1]] THEN
Log.ErrorTree[internalCall, son[1]];
program =>
IF BodyForTree[son[1]] # CBTNull THEN Log.ErrorTree[typeClash, son[1]];
port => IF long THEN Log.ErrorTree[long, son[1]];
ENDCASE;
IF t.typeIn = CSENull THEN
son[2] ← MatchFields[RecordSENull, son[2], FALSE, FALSE]
ELSE
WITH in: seb[t.typeIn] SELECT FROM
record =>
son[2] ← IF attr1
THEN Rhs[son[2], t.typeIn]
ELSE MatchFields[LOOPHOLE[t.typeIn], son[2], FALSE, mode=program];
ENDCASE => {
Log.ErrorTree[typeClash, son[1]];
son[2] ← MatchFields[RecordSENull, son[2], FALSE, FALSE]};
name ← OpName[mode];
attr ← And[RAttr[], attr]; phraseNP ← MergeNP[leftNP][phraseNP];
RPop[];
IF P3S.safety = checked THEN
IF ~(t.safe OR mode = error) OR mode = port OR mode = process THEN
Log.ErrorNode[unsafeOperation, node];
IF mode = proc THEN attr ← CheckInline[node, attr]
ELSE {attr.noXfer ← attr.noAssign ← FALSE; phraseNP ← SetNP[phraseNP]};
attr.const ← FALSE; RPush[t.typeOut, attr];
EXIT};
array => {
ForceDirect[];
IF UniOperand[node] THEN
tb[node].son[2] ← Rhs[tb[node].son[2], TargetType[UnderType[t.indexType]]];
attr ← And[RAttr[], attr]; phraseNP ← MergeNP[leftNP][phraseNP]; RPop[];
RPush[t.componentType, attr];
name ← SELECT TRUE FROM string => seqindex, desc => dindex, ENDCASE => index;
attr2 ← long;
IF mustXfer THEN {opType ← ForceXfer[node]; mustXfer ← FALSE} -- to avoid looping
ELSE EXIT};
sequence => {
ForceDirect[];
IF UniOperand[node] THEN
tb[node].son[2] ← Rhs[tb[node].son[2], TargetType[UnderType[seb[t.tagSei].idType]]];
attr ← And[RAttr[], attr]; phraseNP ← MergeNP[leftNP][phraseNP]; RPop[];
RPush[t.componentType, attr];
name ← seqindex; attr2 ← long;
IF mustXfer THEN {opType ← ForceXfer[node]; mustXfer ← FALSE} -- to avoid looping
ELSE EXIT};
arraydesc => {
ForceDirect[];
long ← seb[opType].typeTag = long;
opType ← UnderType[t.describedType]; attr.const ← FALSE; desc ← TRUE;
IF P3S.safety = checked THEN Log.ErrorNode[unsafeOperation, node]};
ref => {
subType: CSEIndex;
SELECT TRUE FROM
t.basing => {
ForceDirect[];
IF UniOperand[node] THEN tb[node].son[2] ← Rhs[tb[node].son[2], typeANY];
attr ← And[RAttr[], attr]; phraseNP ← MergeNP[leftNP][phraseNP];
subType ← CanonicalType[RType[]]; RPop[];
WITH r: seb[subType] SELECT FROM
relative => {
IF ~Types.Assignable[[own, UnderType[r.baseType]], [own, opType]] THEN
Log.ErrorTree[typeClash, son[1]];
type ← UnderType[r.resultType]};
ENDCASE => {
type ← typeANY;
IF subType # typeANY THEN Log.ErrorTree[typeClash, son[2]]};
subType ← NormalType[type];
attr1 ← TypeForm[subType] = arraydesc;
attr2 ← TypeForm[opType] = long OR TypeForm[type] = long;
attr.const ← FALSE;
RPush[
WITH r: seb[subType] SELECT FROM
ref => r.refType,
arraydesc => r.describedType,
ENDCASE => ERROR,
attr];
name ← reloc;
IF P3S.safety = checked THEN Log.ErrorNode[unsafeOperation, node];
IF mustXfer THEN {opType ← ForceXfer[node]; mustXfer ← FALSE} -- to avoid looping
ELSE EXIT};
ENDCASE => {
subType ← UnderType[t.refType]; attr.const ← FALSE;
WITH r: seb[subType] SELECT FROM
record =>
IF ctxb[r.fieldCtx].level = lG THEN {
ForceDirect[];
opType ← XferForFrame[r.fieldCtx];
IF opType = CSENull THEN GO TO fail;
son[1] ← ForceType[son[1], opType]}
ELSE GO TO deRef;
ENDCASE => GO TO deRef;
EXITS
deRef => {
IF (nDerefs ← nDerefs+1) > 63 THEN GO TO fail;
IF indirect THEN ForceDirect[];
IF P3S.safety = checked AND ~(t.counted OR PermanentType[t.refType]) THEN
Log.ErrorNode[unsafeOperation, node];
indirect ← TRUE; long ← seb[opType].typeTag = long;
opType ← subType}}};
record => {
rSei: RecordSEIndex = LOOPHOLE[nType];
sei: ISEIndex = SequenceField[rSei];
SELECT TRUE FROM
(sei # ISENull) => {
PushSe[sei];
opType ← UnderType[seb[sei].idType];
PushTree[son[1]];
PushNode[IF indirect THEN dot ELSE dollar, -2];
SetInfo[opType]; SetAttr[2, long];
son[1] ← PopTree[]; indirect ← FALSE};
(rSei = dataPtr.typeStringBody) => {
textSei: ISEIndex = NextSe[NextSe[FirstVisibleSe[seb[rSei].fieldCtx]]];
PushSe[textSei];
attr.const ← FALSE; string ← TRUE; opType ← UnderType[seb[textSei].idType];
PushTree[son[1]];
PushNode[IF indirect THEN dot ELSE dollar, -2]; SetInfo[opType]; SetAttr[2, long];
son[1] ← PopTree[]; indirect ← FALSE};
(rSei = dataPtr.typeCONDITION) => {
ForceDirect[];
IF son[2] # Tree.Null THEN Log.ErrorN[listLong, ListLength[son[2]]];
RPush[nullType, attr];
name ← wait; phraseNP ← SetNP[phraseNP];
EXIT};
(Wrappings[rSei] # 0) => {
ForceDirect[]; opType ← Unwrap[rSei]; son[1] ← ForceType[son[1], opType]};
ENDCASE => GO TO fail};
ENDCASE => GO TO fail;
REPEAT
fail => ApplyError[node, opType#typeANY OR nDerefs#0];
ENDLOOP;
IF tb[node].nSons > 2 THEN {
saveNP: NPUse = phraseNP;
SELECT tb[node].name FROM
callx, portcallx, signalx, errorx, startx, fork, joinx, wait, apply => NULL;
ENDCASE => Log.Error[misplacedCatch];
[] ← CatchPhrase[tb[node].son[3]]; phraseNP ← MergeNP[saveNP][phraseNP]};
IF tb[node].attr1 THEN
SELECT tb[node].name FROM
callx, portcallx, signalx, errorx, startx, fork, joinx, apply => NULL;
reloc => NULL;
ENDCASE => Log.ErrorTree[typeClash, tb[node].son[1]];
IF RType[] = CSENull THEN
tb[node].name ← SELECT tb[node].name FROM
callx => call,
portcallx => portcall,
signalx => signal,
errorx => error,
startx => start,
joinx => join,
ENDCASE => tb[node].name;
self ← saveSelf;
RETURN [node]};
UniOperand: PROC [node: Tree.Index] RETURNS [unit: BOOL] = {
unit ← (ListLength[tb[node].son[2]] = 1);
IF ~unit THEN {
CheckLength[tb[node].son[2], 1];
tb[node].son[2] ← UpdateList[tb[node].son[2], VoidExp];
RPush[typeANY, emptyAttr]}
ELSE IF KeyedList[tb[node].son[2]] THEN Log.Error[keys]};
ApplyError: PROC [node: Tree.Index, warn: BOOL] = {
IF warn THEN Log.ErrorTree[noApplication, tb[node].son[1]];
tb[node].son[2] ← UpdateList[tb[node].son[2], VoidExp];
RPush[typeANY, emptyAttr]};
ForceXfer: PROC [node: Tree.Index] RETURNS [opType: CSEIndex] = {
opType ← RType[]; RPop[];
IF tb[node].nSons > 2 THEN Log.Error[misplacedCatch];
PushTree[tb[node].son[1]]; PushTree[tb[node].son[2]];
PushNode[tb[node].name, 2]; SetInfo[opType]; SetAttr[2, tb[node].attr2];
SetAttr[1, tb[node].attr1]; tb[node].attr1 ← FALSE;
tb[node].son[1] ← PopTree[]; tb[node].son[2] ← Tree.Null;
tb[node].name ← apply; RETURN};
DotApply: PROC [node: Tree.Index] RETURNS [Tree.Index] = {
subNode: Tree.Index = GetNode[tb[node].son[1]];
IF DotExpr[subNode].selfAppl THEN {
op: Tree.Link = tb[subNode].son[2];
args: Tree.Link = tb[node].son[2];
catch: Tree.Link;
tb[node].son[2] ← Tree.Null;
IF tb[node].nSons > 2 THEN {catch ← tb[node].son[3]; tb[node].son[3] ← Tree.Null}
ELSE catch ← Tree.Null;
self ← [tree:tb[subNode].son[1], type:RType[], attr:RAttr[], np:phraseNP];
tb[subNode].son[1] ← tb[subNode].son[2] ← Tree.Null;
RPop[]; FreeNode[node];
node ← GetNode[ApplyToSelf[op, args, catch]];
tb[node].son[1] ← Exp[tb[node].son[1], typeANY]};
RETURN [node]};
ApplyToSelf: PROC [op, args, catch: Tree.Link] RETURNS [Tree.Link] = {
n: CARDINAL ← 1;
PushArg: Tree.Map = {PushTree[t]; n ← n+1; RETURN [Tree.Null]};
PushTree[op];
IF KeyedList[args] THEN {
sei: ISEIndex = FirstCtxSe[ArgCtx[TransferTypes[OperandType[op]].typeIn]];
PushHash[IF sei # ISENull THEN seb[sei].hash ELSE nullName];
PushNode[self, 0]; PushNode[item, 2]}
ELSE PushNode[self, 0];
args ← FreeTree[UpdateList[args, PushArg]];
PushList[n];
IF catch = Tree.Null THEN PushNode[apply, 2]
ELSE {PushTree[catch]; PushNode[apply, 3]};
SetInfo[dataPtr.textIndex]; SetAttr[1, FALSE];
RETURN [PopTree[]]};
Construct: PROC [node: Tree.Index, type: RecordSEIndex, init: BOOL←FALSE] = {
OPEN tb[node];
cType: CSEIndex ← type;
attr: Attr;
t: Tree.Link;
son[2] ← MatchFields[type, son[2], init]; attr ← RAttr[]; RPop[];
WITH r: seb[type] SELECT FROM
linked => {name ← union; cType ← VariantUnionType[r.linkType]};
ENDCASE => {
name ← construct;
IF r.hints.variant AND (t←ListTail[son[2]]) # Tree.Null THEN
cType ← DiscriminatedType[type, t]};
info ← cType; RPush[cType, attr]};
RowCons: PROC [node: Tree.Index, aType: ArraySEIndex] = {
OPEN tb[node];
componentType: Type = seb[aType].componentType;
iType: CSEIndex = UnderType[seb[aType].indexType];
cType: CSEIndex = TargetType[UnderType[componentType]];
attr: Attr ← fullAttr;
exitNP: NPUse ← none;
MapValue: Tree.Map = {
type: Type;
subAttr: Attr;
v ← SELECT TRUE FROM
(t = Tree.Null) => DefaultInit[componentType],
(OpName[t] = void) => FieldVoid[t],
ENDCASE => Rhs[t, cType];
subAttr ← RAttr[]; type ← RType[]; RPop[];
IF v = Tree.Null THEN VoidComponent[componentType];
IF P3S.safety = checked AND TypeForm[type] = transfer THEN
v ← CheckScope[v, type];
exitNP ← MergeNP[exitNP][phraseNP]; attr ← And[attr, subAttr]; RETURN};
IF KeyedList[son[2]] OR (son[2] = Tree.Null AND TypeForm[TargetType[iType]] = enumerated)
THEN {
keyType: CSEIndex = TargetType[iType];
vCtx: CTXIndex;
first, last, i: Copier.SEToken;
name: Name;
NextKey: PROC RETURNS [Name] = {
IF i = last THEN name ← nullName
ELSE {
i ← IF i = Copier.nullSEToken THEN first ELSE Copier.CtxNext[vCtx, i];
name ← KeyForHash[Copier.TokenName[vCtx, i]]};
RETURN [name]};
OmittedValue: PROC RETURNS [t: Tree.Link] = {
IF Default[componentType] # none THEN t ← Tree.Null
ELSE {Log.ErrorHti[omittedKey, name]; t ← [symbol[dataPtr.seAnon]]};
RETURN};
WITH t: seb[keyType] SELECT FROM
enumerated => {
vCtx ← t.valueCtx;
[first, last] ← Span[iType];
IF first # Copier.nullSEToken AND last # Copier.nullSEToken
AND Copier.TokenValue[vCtx, first] <= Copier.TokenValue[vCtx, last] THEN {
i ← Copier.nullSEToken;
son[2] ← PopKeyList[ArrangeKeys[son[2], NextKey, OmittedValue]]}
ELSE Log.Error[keys]};
ENDCASE => Log.Error[keys]};
son[2] ← UpdateList[son[2], MapValue];
name ← rowcons; info ← aType; RPush[aType, attr]; phraseNP ← exitNP};
All: PUBLIC PROC [node: Tree.Index, target: CSEIndex, init: BOOL←FALSE] = {
OPEN tb[node];
t: Tree.Link = son[1];
l: CARDINAL = ListLength[t];
attr: Attr;
SELECT l FROM
0, 1 => {
WITH seb[target] SELECT FROM
array => {
cType: CSEIndex = TargetType[UnderType[componentType]];
type: Type;
son[1] ← SELECT TRUE FROM
(t = Tree.Null) => --IF init THEN-- DefaultInit[componentType],
(OpName[t] = void) => FieldVoid[t],
ENDCASE => Rhs[t, cType];
type ← RType[]; attr ← RAttr[]; RPop[];
IF son[1] = Tree.Null THEN VoidComponent[componentType];
IF P3S.safety = checked AND TypeForm[type] = transfer THEN
son[1] ← CheckScope[son[1], type];
attr.const ← FALSE};
ENDCASE => {
Log.ErrorNode[noTarget, node]; son[1] ← VoidExp[son[1]]; attr ← emptyAttr}};
ENDCASE => {
Log.ErrorN[listLong, l-1]; son[1] ← UpdateList[son[1], VoidExp]; attr ← emptyAttr};
info ← target; RPush[target, attr]};
VoidComponent: PROC [type: Type] = {
IF ~Voidable[type] THEN
Log.ErrorSei[elision, IF seb[type].seTag = id THEN LOOPHOLE[type] ELSE dataPtr.seAnon]};
CheckInline: PROC [node: Tree.Index, attr: Attr] RETURNS [Attr] = {
bti: CBTIndex = BodyForTree[tb[node].son[1]];
IF bti = CBTNull THEN {
P3S.currentBody.noXfers ← attr.noXfer ← FALSE;
attr.noAssign ← FALSE; phraseNP ← SetNP[phraseNP]}
ELSE {
IF ~bb[bti].inline THEN P3S.currentBody.noXfers ← attr.noXfer ← FALSE
ELSE
WITH body: bb[bti].info SELECT FROM
Internal => {
SELECT OpName[tb[node].son[1]] FROM
dot, dollar => Log.ErrorTree[misusedInline, tb[node].son[1]];
ENDCASE;
PushTree[tb[node].son[1]];
PushTree[[subtree[index: body.thread]]];
PushNode[thread, 2]; SetAttr[1, FALSE]; SetInfo[P3S.currentScope];
tb[node].son[1] ← PopTree[];
body.thread ← node; MarkShared[[subtree[node]], TRUE];
tb[node].attr3 ← --attr.noXfer AND-- attr.noAssign;
IF ~bb[bti].noXfers THEN
P3S.currentBody.noXfers ← attr.noXfer ← FALSE};
ENDCASE => ERROR;
IF ~bb[bti].hints.safe THEN {
attr.noAssign ← FALSE; phraseNP ← SetNP[phraseNP]}};
RETURN [attr]};
InterfaceCtx: PUBLIC PROC [type: CSEIndex, v: Tree.Link] RETURNS [ctx: CTXIndex] = {
WITH t: seb[type] SELECT FROM
definition => ctx ← t.defCtx;
transfer => {
bti: CBTIndex = BodyForTree[v];
ctx ← IF bti = CBTNull OR t.mode # program
THEN CTXNull ELSE bb[bti].localCtx};
ENDCASE => ctx ← CTXNull;
RETURN};
}.