DIRECTORY
A3:
TYPE
USING [
CanonicalType, LongPath, OperandLhs, OperandType, OrderedType, TargetType,
TypeForTree],
Alloc: TYPE USING [Notifier],
ComData: TYPE USING [idCARDINAL, typeCHAR, typeINT, typeStringBody],
Copier: TYPE USING [SEToken, nullSEToken, CtxFirst, CtxNext, CtxValue],
Log: TYPE USING [Error, ErrorN, ErrorNode, ErrorTree],
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, SEIndex, ISEIndex, CSEIndex, CTXIndex,
SENull, ISENull, typeANY, seType],
SymbolOps:
TYPE
USING [
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]};
ranges
Range:
PUBLIC
PROC [t: Tree.Link, type: CSEIndex]
RETURNS [val: Tree.Link] = {
subType: CSEIndex;
SELECT OpName[t]
FROM
subrangeTC => {
val ← RewriteSubrange[GetNode[t]];
Interval[val, IF type # typeANY THEN type ELSE dataPtr.typeINT, FALSE]};
IN [intOO .. intCC] => {
val ← t;
Interval[val, IF type # typeANY THEN type ELSE dataPtr.typeINT, FALSE]};
ENDCASE =>
IF TypeForm[type] # long
THEN {
val ← TypeExp[t];
RPush[TargetType[UnderType[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[]]};
operations on enumerated types
SEToken: TYPE = Copier.SEToken;
Span:
PUBLIC
PROC [type: CSEIndex]
RETURNS [first, last: SEToken] = {
subType: CSEIndex = TargetType[type];
vCtx: CTXIndex =
WITH seb[subType]
SELECT
FROM
enumerated => 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: CSEIndex] = {
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: CSEIndex] = {
OPEN tb[node];
type: CSEIndex;
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 THEN Log.ErrorNode[unsafeOperation, node];
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: CSEIndex]
RETURNS [type: CSEIndex, bType: SEIndex] = {
WITH seb[rType]
SELECT
FROM
relative => {type ← UnderType[offsetType]; bType ← baseType};
ENDCASE => {type ← rType; bType ← SENull};
RETURN};
MakeRelativeType:
PROC [type: CSEIndex, bType: SEIndex, hint: CSEIndex]
RETURNS [CSEIndex] = {
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[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: CSEIndex] = {
OPEN tb[node];
type, aType, nType, subTarget: CSEIndex;
bType: SEIndex;
attr: Attr;
long: BOOL;
IF P3S.safety = checked THEN Log.ErrorNode[unsafeOperation, node];
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 seb[nType]
SELECT
FROM
array => {
name ← addr;
IF OperandLhs[son[1]] = none THEN Log.ErrorTree[nonAddressable, son[1]];
long ← LongPath[son[1]]};
arraydesc => {long ← seb[aType].typeTag = long; nType ← UnderType[describedType]};
ENDCASE => IF nType # typeANY THEN Log.ErrorTree[typeClash, son[1]]}
ELSE {
Log.ErrorN[listLong, ListLength[son[1]]-1];
son[1] ← UpdateList[son[1], VoidExp]; long ← FALSE};
type ← MakeRefType[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};
Length:
PROC [node: Tree.Index] = {
OPEN tb[node];
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 subType # type THEN son[1] ← ForceType[son[1], subType];
attr.const ← TRUE};
arraydesc => attr.const ← FALSE;
ENDCASE => {
attr.const ← TRUE;
IF type # typeANY THEN Log.ErrorTree[typeClash, son[1]]}}
ELSE {
attr.const ← TRUE;
Log.ErrorN[listLong, ListLength[son[1]]-1];
son[1] ← UpdateList[son[1], VoidExp]};
RPush[dataPtr.typeINT, attr]; RETURN};
Desc:
PROC [node: Tree.Index, target: CSEIndex] = {
OPEN tb[node];
type, subType: CSEIndex;
attr: Attr;
saveNP: NPUse;
aType, bType: SEIndex ← SENull;
cType, iType: SEIndex;
fixed: {none, range, both} ← none;
packed: BOOL ← FALSE;
long: BOOL;
subTarget: CSEIndex = StripRelative[target].type;
nTarget: CSEIndex = NormalType[subTarget];
IF P3S.safety = checked THEN Log.ErrorNode[unsafeOperation, node];
SELECT ListLength[son[1]]
FROM
1 => {
rType: SEIndex;
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]];
subType ← CanonicalType[RType[]]; attr ← RAttr[];
IF subType # RType[] THEN son[1] ← ForceType[son[1], subType]; RPop[];
nType ← NormalType[subType];
WHILE seb[nType].typeTag = ref
AND (nDerefs ← nDerefs+1) < 64
DO
long ← seb[subType].typeTag = long;
subType ← CanonicalType[ReferentType[nType]];
PushTree[son[1]]; PushNode[uparrow, 1];
SetInfo[subType]; SetAttr[2, long]; SetAttr[3, FALSE];
son[1] ← PopTree[];
nType ← NormalType[subType];
ENDLOOP;
PushTree[son[1]];
IF seb[subType].typeTag = record
THEN {
sei: ISEIndex = SequenceField[LOOPHOLE[subType]];
SELECT
TRUE
FROM
(sei # ISENull) => {
subType ← UnderType[seb[sei].idType];
WITH s: seb[subType]
SELECT
FROM
sequence => {
PushSe[sei]; PushNode[dollar, 2]; SetInfo[subType]; SetAttr[2, long]};
ENDCASE => ERROR};
(subType = dataPtr.typeStringBody) => NULL; -- fake sequence
ENDCASE => {Log.ErrorTree[typeClash, son[1]]; subType ← typeANY}};
WITH t: seb[subType]
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.ErrorTree[typeClash, son[1]]};
record => {
-- StringBody
rType ← cType ← dataPtr.typeCHAR; packed ← TRUE;
iType ← dataPtr.idCARDINAL; fixed ← both};
ENDCASE => {
rType ← cType ← typeANY;
IF subType # typeANY THEN Log.ErrorTree[typeClash, son[1]]};
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 seb[NormalType[subType]].typeTag
FROM
basic, ref => NULL;
ENDCASE => Log.ErrorTree[typeClash, tb[subNode].son[1]];
long ← seb[subType].typeTag = long;
tb[subNode].son[2] ← Rhs[tb[subNode].son[2], dataPtr.typeINT];
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 = SENull
THEN {
WITH seb[nTarget]
SELECT
FROM
arraydesc => {
subType ← UnderType[describedType];
WITH t: seb[subType]
SELECT
FROM
array =>
IF fixed = none
OR (fixed = range
AND UnderType[t.componentType] = UnderType[cType])
THEN {
aType ← 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 UnderType[t.describedType] = UnderType[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].typeInfo ← arraydesc[
readOnly:FALSE, var: FALSE, describedType:aType];
seb[type].mark3 ← seb[type].mark4 ← TRUE};
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};
}.