DIRECTORY
A3: TYPE USING [BaseType, CanonicalType, LongPath, OperandLhs, OperandType, OrderedType, TargetType, TypeForTree],
Alloc: TYPE USING [Notifier],
ComData: TYPE USING [idCARDINAL, idCHAR, idINT, typeStringBody],
Copier: TYPE USING [SEToken, nullSEToken, CtxFirst, CtxNext, CtxValue],
Log: TYPE USING [Error, ErrorN, ErrorNode, ErrorNodeOp, ErrorTree, ErrorTreeOp],
P3: TYPE USING [Attr, fullAttr, NPUse, MergeNP, phraseNP, And, Exp, ForceType, Interval, MakeLongType, MakeRefType, RAttr, Rhs, RPop, RPush, RType, SequenceField, TypeExp, VoidExp],
P3S: TYPE USING [safety],
Symbols: TYPE USING [Base, SERecord, Type, ISEIndex, CSEIndex, CTXIndex, nullType, ISENull, typeANY, seType],
SymbolOps: TYPE USING [EqTypes, MakeNonCtxSe, NormalType, RCType, ReferentType, TypeForm, UnderType],
Tree: TYPE USING [Base, Index, Link, Null, treeType],
TreeOps:
TYPE
USING [FreeNode, GetNode, IdentityMap, ListLength, NthSon, OpName, PopTree, PushSe, PushTree, PushNode, SetAttr, SetInfo, UpdateList];
Pass3Xc:
PROGRAM
IMPORTS A3, Copier, Log, P3, P3S, SymbolOps, TreeOps, dataPtr: ComData
EXPORTS P3 = {
OPEN SymbolOps, Symbols, TreeOps, A3, P3;
tb: Tree.Base; -- tree base address (local copy)
seb: Symbols.Base; -- se table base address (local copy)
ExpCNotify:
PUBLIC Alloc.Notifier = {
called by allocator whenever table area is repacked
seb ← base[seType]; tb ← base[Tree.treeType]};
Range:
PUBLIC
PROC[t: Tree.Link, type: Type]
RETURNS[val: Tree.Link] = {
subType: Type;
SELECT OpName[t]
FROM
subrangeTC => {
val ← RewriteSubrange[GetNode[t]];
Interval[val, IF type # typeANY THEN type ELSE dataPtr.idINT, FALSE]};
IN [intOO .. intCC] => {
val ← t;
Interval[val, IF type # typeANY THEN type ELSE dataPtr.idINT, FALSE]};
ENDCASE =>
IF TypeForm[type] # $long
THEN {
val ← TypeExp[t];
RPush[TargetType[TypeForTree[val]], fullAttr]; phraseNP ← none}
ELSE {
val ← MakeEndPoints[t];
Interval[val, type, FALSE]};
subType ← RType[];
IF ~OrderedType[subType] AND subType # typeANY THEN Log.Error[nonOrderedType];
RETURN};
RewriteSubrange:
PROC[node: Tree.Index]
RETURNS[Tree.Link] = {
subNode: Tree.Index = GetNode[tb[node].son[2]];
PushTree[tb[subNode].son[1]]; PushTree[IdentityMap[tb[node].son[1]]];
PushNode[apply, -2]; tb[subNode].son[1] ← PopTree[];
PushTree[tb[subNode].son[2]]; PushTree[tb[node].son[1]];
PushNode[apply, -2]; tb[subNode].son[2] ← PopTree[];
tb[node].son[1] ← tb[node].son[2] ← Tree.Null; FreeNode[node];
RETURN[[subtree[subNode]]]};
MakeEndPoints:
PROC[t: Tree.Link]
RETURNS[Tree.Link] = {
PushTree[t]; PushNode[first, 1];
PushTree[IdentityMap[t]]; PushNode[last, 1];
PushNode[intCC, 2]; RETURN[PopTree[]]};
SEToken: TYPE = Copier.SEToken;
Span:
PUBLIC
PROC[type: CSEIndex]
RETURNS[first, last: SEToken] = {
subType: CSEIndex = UnderType[TargetType[type]];
vCtx: CTXIndex =
WITH s: seb[subType]
SELECT
FROM
enumerated => s.valueCtx,
ENDCASE => ERROR;
WITH t: seb[type]
SELECT
FROM
enumerated => {first ← CtxFirst[vCtx]; last ← CtxLast[vCtx]};
subrange => {
IF t.mark4
THEN {
first ← Copier.CtxValue[vCtx, t.origin];
last ← Copier.CtxValue[vCtx, t.origin + t.range]}
ELSE {
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 ← CtxSucc[vCtx, first];
ENDCASE;
SELECT tb[subNode].name
FROM
intOO, intCO => last ← CtxPred[vCtx, last];
ENDCASE}};
ENDCASE => first ← last ← Copier.nullSEToken;
RETURN};
EnumeratedValue:
PROC[t: Tree.Link, vCtx: CTXIndex]
RETURNS[SEToken] = {
WITH t
SELECT
FROM
symbol => {
sei: ISEIndex = index;
RETURN[
SELECT
TRUE
FROM
~seb[sei].constant => Copier.nullSEToken,
(seb[sei].idCtx = vCtx)
OR seb[sei].mark4 =>
Copier.CtxValue[vCtx, seb[sei].idValue],
ENDCASE => EnumeratedValue[InitTree[sei], vCtx]]};
subtree => {
node: Tree.Index = index;
RETURN[
SELECT tb[node].name
FROM
first => Span[UnderType[TypeForTree[tb[node].son[1]]]].first,
last => Span[UnderType[TypeForTree[tb[node].son[1]]]].last,
pred => CtxPred[vCtx, EnumeratedValue[tb[node].son[1], vCtx]],
succ => CtxSucc[vCtx, EnumeratedValue[tb[node].son[1], vCtx]],
ENDCASE => Copier.nullSEToken]};
ENDCASE => RETURN[Copier.nullSEToken]};
CtxFirst: PROC[ctx: CTXIndex] RETURNS[SEToken] = Copier.CtxFirst;
CtxLast:
PROC[ctx: CTXIndex]
RETURNS[last: SEToken] = {
last ← Copier.nullSEToken;
FOR t: SEToken ← Copier.CtxFirst[ctx], Copier.CtxNext[ctx, t]
UNTIL t = Copier.nullSEToken
DO
last ← t ENDLOOP;
RETURN};
CtxSucc: PROC[ctx: CTXIndex, t: SEToken] RETURNS[SEToken] = Copier.CtxNext;
CtxPred:
PROC[ctx: CTXIndex, t: SEToken]
RETURNS[pred: SEToken] = {
next: SEToken;
pred ← Copier.nullSEToken;
IF t # Copier.nullSEToken
THEN {
next ← Copier.CtxFirst[ctx];
UNTIL next = t
OR next = Copier.nullSEToken
DO
pred ← next; next ← Copier.CtxNext[ctx, next] ENDLOOP};
RETURN};
InitTree:
PROC[sei: ISEIndex]
RETURNS[Tree.Link] =
INLINE {
RETURN[tb[LOOPHOLE[seb[sei].idValue, Tree.Index]].son[3]]};
operations on addresses
AddrOp:
PUBLIC
PROC[node: Tree.Index, target: Type] = {
SELECT tb[node].name
FROM
addr => Addr[node, target];
base => Base[node, target];
length => Length[node];
arraydesc => Desc[node, target];
ENDCASE => ERROR};
Addr:
PROC[node: Tree.Index, target: Type] = {
OPEN tb[node];
type: Type;
attr: Attr;
subType: CSEIndex = NormalType[target];
var:
BOOL =
WITH t: seb[subType]
SELECT
FROM
ref => t.var,
ENDCASE => FALSE;
counted: BOOL ← FALSE;
IF P3S.safety = checked AND ~(var OR attr1) THEN Log.ErrorNodeOp[unsafeOp, node, addr];
son[1] ← Exp[son[1], typeANY];
FOR t: Tree.Link ← son[1], NthSon[t, 1]
DO
SELECT OpName[t]
FROM
uparrow => {
subType: CSEIndex = NormalType[OperandType[NthSon[t, 1]]];
WITH p: seb[subType]
SELECT
FROM
ref => IF p.counted THEN counted ← TRUE;
ENDCASE;
EXIT};
cast, openx => NULL;
ENDCASE => EXIT;
ENDLOOP;
SELECT OperandLhs[son[1]]
FROM
counted =>
IF var
THEN {
son[1] ← SafenRef[son[1]];
IF RCType[RType[]] # none THEN Log.ErrorTree[unimplemented, son[1]]};
none => Log.ErrorTree[nonAddressable, son[1]];
ENDCASE;
type ← MakeRefType[
cType: RType[], hint: subType, counted: counted AND ~var, var: var];
IF var THEN {Log.ErrorNode[unimplemented, node]; attr2 ← FALSE}
ELSE IF (attr2 ← LongPath[son[1]]) THEN type ← MakeLongType[type, target];
attr ← RAttr[]; RPop[]; RPush[type, attr]};
SafenRef:
PROC[t: Tree.Link]
RETURNS[v: Tree.Link] = {
WITH t
SELECT
FROM
subtree => {
node: Tree.Index = index;
SELECT tb[node].name
FROM
dot, uparrow, dindex, reloc => {
PushTree[tb[node].son[1]];
PushNode[safen, 1]; SetInfo[OperandType[tb[node].son[1]]];
tb[node].son[1] ← PopTree[]; v ← t};
dollar, index, seqindex, loophole, cast, openx, pad, chop => {
tb[node].son[1] ← SafenRef[tb[node].son[1]]; v ← t};
cdot => {
tb[node].son[2] ← SafenRef[tb[node].son[2]]; v ← t};
apply, safen => v ← t;
ENDCASE => ERROR};
ENDCASE => v ← t;
RETURN};
StripRelative:
PROC[rType: Type]
RETURNS[type, baseType: Type] = {
rSei: CSEIndex = UnderType[rType];
WITH r: seb[rSei]
SELECT
FROM
relative => {type ← r.offsetType; baseType ← r.baseType};
ENDCASE => {type ← rType; baseType ← nullType};
RETURN};
MakeRelativeType:
PROC[type: Type, bType: Type, hint: Type]
RETURNS[Type] = {
tType: Type;
rType: CSEIndex;
protoType: CSEIndex = UnderType[hint];
WITH p: seb[protoType]
SELECT
FROM
relative =>
IF EqTypes[p.offsetType, type] AND EqTypes[p.baseType, bType] THEN RETURN[hint];
ENDCASE;
tType ←
IF TypeForm[bType] = $long
OR TypeForm[type] = $long
THEN MakeLongType[BaseType[type], type]
ELSE type;
rType ← MakeNonCtxSe[SERecord.cons.relative.SIZE];
seb[rType].typeInfo ← relative[
baseType: bType,
offsetType: type,
resultType: tType];
seb[rType].mark3 ← seb[rType].mark4 ← TRUE;
RETURN[rType]};
Base:
PROC[node: Tree.Index, target: Type] = {
OPEN tb[node];
type, aType, bType, subTarget: Type;
nType: CSEIndex;
attr: Attr;
long: BOOL;
IF P3S.safety = checked THEN Log.ErrorNodeOp[unsafeOp, node, base];
IF ListLength[son[1]] = 1
THEN {
son[1] ← Exp[son[1], typeANY];
[aType, bType] ← StripRelative[CanonicalType[RType[]]];
attr ← RAttr[]; RPop[];
nType ← NormalType[aType]; [subTarget, ] ← StripRelative[target];
WITH n: seb[nType]
SELECT
FROM
array => {
name ← addr;
IF OperandLhs[son[1]] = none THEN Log.ErrorTree[nonAddressable, son[1]];
long ← LongPath[son[1]]};
arraydesc => {
long ← (TypeForm[aType] = $long); nType ← UnderType[n.describedType];
attr1 ← TRUE};
ENDCASE => IF nType # typeANY THEN Log.ErrorTreeOp[missingOp, son[1], base]}
ELSE {
Log.ErrorN[listLong, ListLength[son[1]]-1];
son[1] ← UpdateList[son[1], VoidExp]; long ← FALSE};
type ← MakeRefType[nType, BaseType[subTarget]];
IF (attr2 ← long) THEN type ← MakeLongType[type, subTarget];
IF bType # nullType THEN type ← MakeRelativeType[type, bType, target];
attr.const ← FALSE; RPush[type, attr]; RETURN};
Length:
PROC[node: Tree.Index] = {
OPEN tb[node];
type: Type;
subType: CSEIndex;
attr: Attr;
IF ListLength[son[1]] = 1
THEN {
son[1] ← Exp[son[1], typeANY];
type ← RType[]; attr ← RAttr[]; RPop[];
subType ←
IF seb[type].mark3
THEN NormalType[StripRelative[CanonicalType[type]].type]
ELSE typeANY;
WITH seb[subType]
SELECT
FROM
array => {
IF ~EqTypes[subType, type] THEN son[1] ← ForceType[son[1], subType];
attr.const ← TRUE};
arraydesc => {attr.const ← FALSE; attr1 ← TRUE};
ENDCASE => {
attr.const ← TRUE;
IF type # typeANY THEN Log.ErrorTreeOp[missingOp, son[1], length]}}
ELSE {
attr.const ← TRUE;
Log.ErrorN[listLong, ListLength[son[1]]-1];
son[1] ← UpdateList[son[1], VoidExp]};
RPush[dataPtr.idINT, attr]; RETURN};
Desc:
PROC[node: Tree.Index, target: Type] = {
OPEN tb[node];
type, subType: Type;
attr: Attr;
saveNP: NPUse;
aType, bType: Type ← nullType;
cType, iType: Type;
fixed: {none, range, both} ← none;
packed: BOOL ← FALSE;
long: BOOL;
subTarget: Type = StripRelative[target].type;
cSei: CSEIndex;
nTarget: CSEIndex = NormalType[subTarget];
IF P3S.safety = checked THEN Log.ErrorNodeOp[unsafeOp, node, arraydesc];
SELECT ListLength[son[1]]
FROM
1 => {
rType: Type;
nType: CSEIndex;
nDerefs: CARDINAL ← 0;
son[1] ← Exp[son[1], typeANY];
IF OperandLhs[son[1]] = none THEN Log.ErrorTree[nonAddressable, son[1]];
long ← LongPath[son[1]];
cSei ← UnderType[CanonicalType[RType[]]]; attr ← RAttr[];
IF ~EqTypes[cSei, RType[]] THEN son[1] ← ForceType[son[1], cSei]; RPop[];
nType ← NormalType[cSei];
WHILE seb[nType].typeTag = ref
AND (nDerefs ← nDerefs+1) < 64
DO
long ← seb[cSei].typeTag = long;
cSei ← UnderType[CanonicalType[ReferentType[nType]]];
PushTree[son[1]]; PushNode[uparrow, 1];
SetInfo[cSei]; SetAttr[2, long]; SetAttr[3, FALSE];
son[1] ← PopTree[];
nType ← NormalType[cSei];
ENDLOOP;
PushTree[son[1]];
IF seb[cSei].typeTag = record
THEN {
sei: ISEIndex = SequenceField[LOOPHOLE[cSei]];
SELECT
TRUE
FROM
(sei # ISENull) => {
cSei ← UnderType[seb[sei].idType];
WITH s: seb[cSei]
SELECT
FROM
sequence => {
PushSe[sei]; PushNode[dollar, 2]; SetInfo[cSei]; SetAttr[2, long]};
ENDCASE => ERROR};
(cSei = dataPtr.typeStringBody) => NULL; -- fake sequence
ENDCASE => {
Log.ErrorTreeOp[missingOp, son[1], arraydesc]; cSei ← typeANY}
};
WITH t: seb[cSei]
SELECT
FROM
array => {rType ← aType ← OperandType[son[1]]; fixed ← both};
sequence => {
rType ← cType ← t.componentType; packed ← t.packed;
iType ← seb[t.tagSei].idType; fixed ← both;
IF ~t.controlled THEN Log.ErrorTreeOp[missingOp, son[1], arraydesc]};
record => {
-- StringBody
rType ← cType ← dataPtr.idCHAR; packed ← TRUE;
iType ← dataPtr.idCARDINAL; fixed ← both};
ENDCASE => {
rType ← cType ← typeANY;
IF cSei # typeANY THEN Log.ErrorTreeOp[missingOp, son[1], arraydesc]};
subType ← MakeRefType[rType, typeANY];
IF long THEN subType ← MakeLongType[subType, typeANY];
PushNode[addr, 1]; SetInfo[subType]; SetAttr[2, long]; son[1] ← PopTree[]};
3 => {
subNode: Tree.Index = GetNode[son[1]];
tb[subNode].son[1] ← Exp[tb[subNode].son[1], typeANY];
[subType, bType] ← StripRelative[CanonicalType[RType[]]];
attr ← RAttr[]; RPop[]; saveNP ← phraseNP;
SELECT TypeForm[NormalType[subType]]
FROM
$basic, $ref => NULL;
ENDCASE => Log.ErrorTree[typeClash, tb[subNode].son[1]];
long ← (TypeForm[subType] = $long);
tb[subNode].son[2] ← Rhs[tb[subNode].son[2], dataPtr.idINT];
attr ← And[RAttr[], attr]; RPop[];
phraseNP ← MergeNP[saveNP][phraseNP];
IF tb[subNode].son[3] # Tree.Null
THEN {
tb[subNode].son[3] ← TypeExp[tb[subNode].son[3]];
cType ← TypeForTree[tb[subNode].son[3]]; fixed ← range}};
ENDCASE;
IF aType = nullType
THEN {
WITH n: seb[nTarget]
SELECT
FROM
arraydesc => {
cSei ← UnderType[n.describedType];
WITH t: seb[cSei]
SELECT
FROM
array =>
IF fixed = none
OR (fixed = range
AND EqTypes[t.componentType, cType])
THEN {
aType ← n.describedType; GO TO old};
ENDCASE};
ENDCASE;
GO TO new;
EXITS
old => NULL;
new => {
aType ← MakeNonCtxSe[SERecord.cons.array.SIZE];
seb[aType] ← [mark3:
TRUE, mark4:
TRUE,
body: cons[array[
packed: packed,
indexType: IF fixed < both THEN dataPtr.idCARDINAL ELSE iType,
componentType: IF fixed > none THEN cType ELSE typeANY]]]}};
make type description
BEGIN
WITH t: seb[nTarget]
SELECT
FROM
arraydesc =>
IF EqTypes[t.describedType, aType] THEN GO TO old;
ENDCASE =>
IF fixed = none AND target = typeANY THEN Log.ErrorNode[noTarget, node];
GO TO new;
EXITS
old => type ← nTarget;
new => {
type ← MakeNonCtxSe[SERecord.cons.arraydesc.SIZE];
seb[type] ← [mark3:
TRUE, mark4:
TRUE,
body: cons[arraydesc[readOnly: FALSE, var: FALSE, describedType: aType]]];
};
END;
IF (attr2 ← long) THEN type ← MakeLongType[type, subTarget];
IF bType # nullType THEN type ← MakeRelativeType[type, bType, target];
attr.const ← FALSE; RPush[type, attr]; RETURN};
}.