-- file Pass3Xc.mesa
-- last modified by Satterthwaite, February 24, 1983 3:30 pm
DIRECTORY
A3: TYPE USING [
CanonicalType, LongPath, OperandLhs, OperandType, OrderedType, TargetType,
TypeForTree],
Alloc: TYPE USING [Notifier],
ComData: TYPE USING [idCARDINAL, idCHAR, typeINTEGER, 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, Type, ISEIndex, CSEIndex, CTXIndex,
nullType, 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: Type;
SELECT OpName[t] FROM
subrangeTC => {
val ← RewriteSubrange[GetNode[t]];
Interval[val, IF type # typeANY THEN type ELSE dataPtr.typeINTEGER, FALSE]};
IN [intOO .. intCC] => {
val ← t;
Interval[val, IF type # typeANY THEN type ELSE dataPtr.typeINTEGER, 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: Type] = {
WITH seb[rType] SELECT FROM
relative => {type ← UnderType[offsetType]; bType ← baseType};
ENDCASE => {type ← rType; bType ← nullType};
RETURN};
MakeRelativeType: PROC [type: CSEIndex, bType: Type, 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: Type;
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 # nullType 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 ← UnderType[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.typeINTEGER, attr]; RETURN};
Desc: PROC [node: Tree.Index, target: CSEIndex] = {
OPEN tb[node];
type, subType: CSEIndex;
attr: Attr;
saveNP: NPUse;
aType, bType: Type ← nullType;
cType, iType: Type;
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: 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]];
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.idCHAR; 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.typeINTEGER];
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 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 # nullType THEN type ← MakeRelativeType[type, bType, target];
attr.const ← FALSE; RPush[type, attr]; RETURN};
}.