-- file Pass3Xc.Mesa
-- last modified by Satterthwaite, November 16, 1979 10:23 AM

DIRECTORY
ComData: FROM "comdata" USING [idCARDINAL, typeINTEGER],
InlineDefs: FROM "inlinedefs" USING [BITAND],
Log: FROM "log" USING [ErrorN, ErrorNode, ErrorTree],
P3: FROM "p3"
USING [
Attr, NPUse, MergeNP,
phraseNP,
--And,-- CanonicalType, Exp, LongPath, MakeLongType,
MakePointerType, OperandLhs, OperandType, RAttr, Rhs,
RPop, RPush, RType, TargetType, TypeExp, TypeForTree, VoidExp],
Symbols: FROM "symbols"
USING [seType,
SERecord, SEIndex, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex,
SENull, ISENull, typeANY],
SymbolOps: FROM "symbolops"
USING [
FirstCtxSe, MakeNonCtxSe, NextSe, NormalType, TypeForm, UnderType],
Table: FROM "table" USING [Base, Notifier, AddNotify, DropNotify],
Tree: FROM "tree" USING [Index, Link, Null, treeType],
TreeOps: FROM "treeops"
USING [
GetNode, IdentityMap, ListLength, MakeList,
PushTree, PushNode, SetAttr, SetInfo, UpdateList];

Pass3Xc: PROGRAM
IMPORTS
InlineDefs, Log, P3, SymbolOps, Table, TreeOps,
dataPtr: ComData
EXPORTS P3 =
BEGIN
OPEN SymbolOps, TreeOps, P3;

And: PROCEDURE [Attr, Attr] RETURNS [Attr] = LOOPHOLE[InlineDefs.BITAND];

-- pervasive definitions from Symbols

SEIndex: TYPE = Symbols.SEIndex;
ISEIndex: TYPE = Symbols.ISEIndex;
CSEIndex: TYPE = Symbols.CSEIndex;
RecordSEIndex: TYPE = Symbols.RecordSEIndex;
SENull: SEIndex = Symbols.SENull;
ISENull: ISEIndex = Symbols.ISENull;
typeANY: CSEIndex = Symbols.typeANY;

CTXIndex: TYPE = Symbols.CTXIndex;


tb: Table.Base;-- tree base address (local copy)
seb: Table.Base;-- se table base address (local copy)

ExpCNotify: Table.Notifier =
BEGIN -- called by allocator whenever table area is repacked
seb ← base[Symbols.seType]; tb ← base[Tree.treeType];
END;


-- operations on enumerated types

Span: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [first, last: ISEIndex] =
BEGIN
Table.AddNotify[ExpCNotify];
[first, last] ← EnumeratedSpan[type];
Table.DropNotify[ExpCNotify]; RETURN
END;

EnumeratedSpan: PROCEDURE [type: CSEIndex] RETURNS [first, last: ISEIndex] =
BEGIN
subType: CSEIndex = TargetType[type];
vCtx: CTXIndex = WITH seb[subType] SELECT FROM
enumerated => valueCtx,
ENDCASE => ERROR;
WITH t:seb[type] SELECT FROM
enumerated =>
BEGIN first ← FirstCtxSe[vCtx]; last ← LastCtxSe[vCtx] END;
subrange =>
BEGIN
IF t.mark4
THEN
BEGIN
first ← FindElement[vCtx, t.origin];
last ← FindElement[vCtx, t.origin + t.range];
END
ELSE
BEGIN
node: Tree.Index = LOOPHOLE[t.range];
subNode: Tree.Index = GetNode[tb[node].son[2]];
first ← EnumeratedValue[tb[subNode].son[1], vCtx];
last ← EnumeratedValue[tb[subNode].son[2], vCtx];
SELECT tb[subNode].name FROM
intOO, intOC => first ← NextSe[first];
ENDCASE;
SELECT tb[subNode].name FROM
intOO, intCO => last ← PrevSe[last];
ENDCASE;
END;
END;
ENDCASE => first ← last ← ISENull;
RETURN
END;

EnumeratedValue: PROCEDURE [t: Tree.Link, vCtx: CTXIndex] RETURNS [ISEIndex] =
BEGIN
WITH t SELECT FROM
symbol =>
BEGIN
sei: ISEIndex = index;
RETURN [SELECT TRUE FROM
~seb[sei].constant => ISENull,
(seb[sei].idCtx = vCtx) => sei,
seb[sei].mark4 => FindElement[vCtx, seb[sei].idValue],
ENDCASE => EnumeratedValue[InitTree[sei], vCtx]]
END;
subtree =>
BEGIN
node: Tree.Index = index;
RETURN [SELECT tb[node].name FROM
first =>
EnumeratedSpan[UnderType[TypeForTree[tb[node].son[1]]]].first,
last =>
EnumeratedSpan[UnderType[TypeForTree[tb[node].son[1]]]].last,
ENDCASE => ISENull]
END;
ENDCASE => RETURN [ISENull]
END;

FindElement: PROCEDURE [vCtx: CTXIndex, value: CARDINAL] RETURNS [ISEIndex] =
BEGIN
sei: ISEIndex;
FOR sei ← FirstCtxSe[vCtx], NextSe[sei] UNTIL sei = ISENull
DO
IF seb[sei].idValue = value THEN RETURN [sei];
ENDLOOP;
RETURN [ISENull]
END;

LastCtxSe: PROCEDURE [ctx: CTXIndex] RETURNS [last: ISEIndex] =
BEGIN
sei: ISEIndex;
last ← ISENull;
FOR sei ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull
DO last ← sei ENDLOOP;
RETURN
END;

PrevSe: PROCEDURE [sei: ISEIndex] RETURNS [prev: ISEIndex] =
BEGIN
next: ISEIndex;
prev ← ISENull;
IF sei # ISENull
THEN
BEGIN
next ← FirstCtxSe[seb[sei].idCtx];
UNTIL next = sei OR next = ISENull
DO prev ← next; next ← NextSe[next] ENDLOOP;
END;
RETURN
END;

InitTree: PROCEDURE [sei: ISEIndex] RETURNS [Tree.Link] = INLINE
BEGIN RETURN [tb[LOOPHOLE[seb[sei].idValue, Tree.Index]].son[3]] END;

-- operations on addresses

Addr: PUBLIC PROCEDURE [node: Tree.Index, target: CSEIndex] =
BEGIN OPEN tb[node];
type: CSEIndex;
attr: Attr;
Table.AddNotify[ExpCNotify];
son[1] ← Exp[son[1], typeANY];
IF ~OperandLhs[son[1]] THEN Log.ErrorTree[nonAddressable, son[1]];
type ← MakePointerType[RType[], NormalType[target]];
IF (attr2 ← LongPath[son[1]]) THEN type ← MakeLongType[type, target];
attr ← RAttr[]; RPop[]; RPush[type, attr];
Table.DropNotify[ExpCNotify]; RETURN
END;


DescOp: PUBLIC PROCEDURE [node: Tree.Index, target: CSEIndex] =
BEGIN
Table.AddNotify[ExpCNotify];
SELECT tb[node].name FROM
base => Base[node, target];
length => Length[node];
arraydesc => Desc[node, target];
ENDCASE => ERROR;
Table.DropNotify[ExpCNotify]; RETURN
END;


StripRelative: PROCEDURE [rType: CSEIndex] RETURNS [type: CSEIndex, bType: SEIndex] =
BEGIN
WITH seb[rType] SELECT FROM
relative => BEGIN type ← UnderType[offsetType]; bType ← baseType END;
ENDCASE => BEGIN type ← rType; bType ← SENull END;
RETURN
END;

MakeRelativeType: PROCEDURE [type: CSEIndex, bType: SEIndex, hint: CSEIndex]
RETURNS [CSEIndex] =
BEGIN
rType, tType: CSEIndex;
WITH seb[hint] SELECT FROM
relative =>
IF offsetType = type AND UnderType[baseType] = UnderType[bType]
THEN RETURN [hint];
ENDCASE;
tType ← IF TypeForm[bType] = long OR TypeForm[type] = long
THEN MakeLongType[NormalType[type], type]
ELSE type;
rType ← MakeNonCtxSe[SIZE[relative cons Symbols.SERecord]];
seb[rType].typeInfo ← relative[
baseType: bType,
offsetType: type,
resultType: tType];
seb[rType].mark3 ← seb[rType].mark4 ← TRUE;
RETURN [rType]
END;


Base: PROCEDURE [node: Tree.Index, target: CSEIndex] =
BEGIN OPEN tb[node];
type, aType, nType, subTarget: CSEIndex;
bType: SEIndex;
attr: Attr;
long: BOOLEAN;
IF ListLength[son[1]] = 1
THEN
BEGIN
son[1] ← Exp[son[1], typeANY];
[aType, bType] ← StripRelative[CanonicalType[RType[]]];
attr ← RAttr[]; RPop[];
nType ← NormalType[aType]; [subTarget, ] ← StripRelative[target];
WITH seb[nType] SELECT FROM
array =>
BEGIN name ← addr;
IF ~OperandLhs[son[1]] THEN Log.ErrorTree[nonAddressable, son[1]];
long ← LongPath[son[1]];
END;
arraydesc =>
BEGIN
long ← seb[aType].typeTag = long;
nType ← UnderType[describedType];
END;
ENDCASE =>
IF nType # typeANY THEN Log.ErrorTree[typeClash, son[1]];
END
ELSE
BEGIN
Log.ErrorN[listLong, ListLength[son[1]]-1];
son[1] ← UpdateList[son[1], VoidExp]; long ← FALSE;
END;
type ← MakePointerType[nType, NormalType[subTarget]];
IF (attr2 ← long) THEN type ← MakeLongType[type, subTarget];
IF bType # SENull THEN type ← MakeRelativeType[type, bType, target];
attr.const ← FALSE; RPush[type, attr]; RETURN
END;

Length: PROCEDURE [node: Tree.Index] =
BEGIN OPEN tb[node];
type: CSEIndex;
attr: Attr;
IF ListLength[son[1]] = 1
THEN
BEGIN
son[1] ← Exp[son[1], typeANY];
type ← RType[]; attr ← RAttr[]; RPop[];
type ← IF seb[type].mark3
THEN NormalType[StripRelative[CanonicalType[type]].type]
ELSE typeANY;
WITH seb[type] SELECT FROM
array => attr.const ← TRUE;
arraydesc => attr.const ← FALSE;
ENDCASE =>
BEGIN attr.const ← TRUE;
IF type # typeANY THEN Log.ErrorTree[typeClash, son[1]];
END;
END
ELSE
BEGIN attr.const ← TRUE;
Log.ErrorN[listLong, ListLength[son[1]]-1];
son[1] ← UpdateList[son[1], VoidExp];
END;
RPush[dataPtr.typeINTEGER, attr]; RETURN
END;

Desc: PROCEDURE [node: Tree.Index, target: CSEIndex] =
BEGIN OPEN tb[node];
type, subType: CSEIndex;
attr: Attr;
saveNP: NPUse;
aType, bType, cType: SEIndex;
fixed, long: BOOLEAN;
subNode: Tree.Index;
subTarget: CSEIndex = StripRelative[target].type;
nTarget: CSEIndex = NormalType[subTarget];
aType ← bType ← SENull;
SELECT ListLength[son[1]] FROM
1 =>
BEGIN
son[1] ← Exp[son[1], typeANY];
IF ~OperandLhs[son[1]] THEN Log.ErrorTree[nonAddressable, son[1]];
long ← LongPath[son[1]];
subType ← CanonicalType[RType[]]; attr ← RAttr[]; RPop[];
IF seb[subType].typeTag = array
THEN BEGIN aType ← OperandType[son[1]]; fixed ← TRUE END
ELSE
BEGIN fixed ← FALSE;
IF subType # typeANY THEN Log.ErrorTree[typeClash, son[1]];
END;
PushTree[son[1]];
PushNode[addr, 1];
SetInfo[MakePointerType[subType, typeANY]]; SetAttr[2, long];
PushTree[IdentityMap[son[1]]];
PushNode[length, 1]; SetInfo[dataPtr.typeINTEGER];
PushTree[Tree.Null];
son[1] ← MakeList[3];
END;
3 =>
BEGIN subNode ← GetNode[son[1]];
tb[subNode].son[1] ← Exp[tb[subNode].son[1], typeANY];
[subType,bType] ← StripRelative[CanonicalType[RType[]]];
attr ← RAttr[]; RPop[]; saveNP ← phraseNP;
SELECT seb[NormalType[subType]].typeTag FROM
basic, pointer => NULL;
ENDCASE => Log.ErrorTree[typeClash, tb[subNode].son[1]];
long ← seb[subType].typeTag = long;
tb[subNode].son[2] ← Rhs[tb[subNode].son[2], dataPtr.typeINTEGER];
attr ← And[RAttr[], attr]; RPop[];
phraseNP ← MergeNP[saveNP][phraseNP];
IF (fixed ← tb[subNode].son[3] # Tree.Null)
THEN
BEGIN
tb[subNode].son[3] ← TypeExp[tb[subNode].son[3]];
cType ← TypeForTree[tb[subNode].son[3]];
END;
END;
ENDCASE;
IF aType = SENull
THEN
BEGIN
WITH seb[nTarget] SELECT FROM
arraydesc =>
BEGIN subType ← UnderType[describedType];
WITH t: seb[subType] SELECT FROM
array =>
IF ~fixed OR UnderType[t.componentType] = UnderType[cType]
THEN BEGIN aType ← describedType; GO TO old END;
ENDCASE;
END;
ENDCASE;
GO TO new;
EXITS
old => NULL;
new =>
BEGIN
subType ← MakeNonCtxSe[SIZE[array cons Symbols.SERecord]];
seb[subType].typeInfo ← array[
oldPacked: FALSE,
lengthUsed: FALSE,
comparable: FALSE,
indexType: dataPtr.idCARDINAL,
componentType: IF fixed THEN cType ELSE typeANY];
seb[subType].mark3 ← seb[subType].mark4 ← TRUE;
aType ← subType;
END;
END;
-- make type description
BEGIN
WITH t: seb[nTarget] SELECT FROM
arraydesc =>
IF UnderType[t.describedType] = UnderType[aType] THEN GO TO old;
ENDCASE =>
IF ~fixed AND target = typeANY THEN Log.ErrorNode[noTarget, node];
GO TO new;
EXITS
old => type ← nTarget;
new =>
BEGIN
type ← MakeNonCtxSe[SIZE[arraydesc cons Symbols.SERecord]];
seb[type].typeInfo ← arraydesc[readOnly:FALSE, describedType:aType];
seb[type].mark3 ← seb[type].mark4 ← TRUE;
END;
END;
IF (attr2 ← long) THEN type ← MakeLongType[type, subTarget];
IF bType # SENull THEN type ← MakeRelativeType[type, bType, target];
attr.const ← FALSE; RPush[type, attr]; RETURN
END;

END.