[_CDCSL_93-16_]<1>Cedar>release>MimosaOnly>Pass3Xc.mesa

Pass3Xc.mesa

Satterthwaite, June 17, 1986 3:18:13 pm PDT

Russ Atkinson (RRA) January 3, 1991 1:33 pm PST

DIRECTORY

Alloc USING [Notifier],

MimData USING [bitsToAlignment, idCARDINAL, idCHAR, idINTEGER, typeStringBody],

MimosaCopier USING [CtxFirst, CtxNext, CtxValue, nullSEToken, SEToken],

MimosaLog USING [Error, ErrorN, ErrorNode, ErrorNodeOp, ErrorTree, ErrorTreeOp],

MimP3 USING [And, Attr, ClearType, emptyAttr, Exp, ForceType, fullAttr, Interval, MakeLongType, MakeRefType, MergeNP, NPUse, phraseNP, RAttrPop, Rhs, RPush, RType, SequenceField, SetType, TypeExp, VoidExp],

MimP3S USING [safety],

Pass3Attributes USING [BaseType, CanonicalType, LongPath, LongType, OperandLhs, OperandType, OrderedType, TargetType, TypeForTree],

SymbolOps USING [DecodeCard, DecodeTreeIndex, EqTypes, MakeNonCtxSe, NormalType, own, RCType, ReferentType, TypeForm, UnderType],

Symbols USING [Base, CSEIndex, CTXIndex, ISEIndex, ISENull, nullType, SERecord, seType, Type, typeANY],

Target: TYPE MachineParms USING [bitOrder, bitsPerLongPtr, bitsPerPtr, bitsPerWord],

Tree USING [Base, Index, Link, NodeName, Null, treeType],

TreeOps USING [FreeNode, GetNode, GetTag, IdentityMap, ListLength, NthSon, OpName, PopTree, PushNode, PushSe, PushTree, SetAttr, UpdateList];

Pass3Xc: PROGRAM

IMPORTS MimData, MimosaCopier, MimosaLog, MimP3, MimP3S, Pass3Attributes, SymbolOps, TreeOps

EXPORTS MimP3 = {

OPEN MimP3, Pass3Attributes, Symbols, TreeOps;

SEToken: TYPE = MimosaCopier.SEToken;

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];

};

Local Utilites

NormType: PROC [type: Type] RETURNS [CSEIndex] = {

RETURN [SymbolOps.NormalType[SymbolOps.own, type]];

};

Ranges

Range: PUBLIC PROC [t: Tree.Link, type: Type] RETURNS [val: Tree.Link] = {

subType: Type;

SELECT OpName[t] FROM

subrangeTC => {

node: Tree.Index = GetNode[t];

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];

val ¬ [subtree[subNode]];

Interval[val, type, FALSE];

};

intOO, intOC, intCO, intCC => {

val ¬ t;

Interval[val, type, FALSE];

};

ENDCASE => {

val ¬ TypeExp[t];

RPush[TargetType[TypeForTree[val]], MimP3.fullAttr];

phraseNP ¬ none;

};

subType ¬ RType[];

IF ~OrderedType[subType] AND subType # typeANY THEN

MimosaLog.Error[nonOrderedType];

};

Operations on enumerated types

Span: PUBLIC PROC [type: CSEIndex] RETURNS [first, last: SEToken] = {

subType: CSEIndex = SymbolOps.UnderType[SymbolOps.own, 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 {

org: INT ¬ IF t.biased THEN t.origin ELSE 0;

first ¬ MimosaCopier.CtxValue[vCtx, org];

last ¬ MimosaCopier.CtxValue[vCtx, org + 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 ¬ MimosaCopier.nullSEToken;

};

EnumeratedValue: PROC [t: Tree.Link, vCtx: CTXIndex] RETURNS [SEToken] = {

ret: SEToken ¬ MimosaCopier.nullSEToken;

WITH t SELECT GetTag[t] FROM

symbol => {

sei: ISEIndex = index;

SELECT TRUE FROM

NOT seb[sei].constant => {};

(seb[sei].idCtx = vCtx) OR seb[sei].mark4 =>

ret ¬ MimosaCopier.CtxValue[vCtx, SymbolOps.DecodeCard[seb[sei].idValue]];

ENDCASE => ret ¬ EnumeratedValue[InitTree[sei], vCtx];

};

subtree => {

node: Tree.Index = index;

IF tb[node].nSons >= 1 THEN {

son1: Tree.Link = tb[node].son[1];

name: Tree.NodeName = tb[index].name;

SELECT tb[node].name FROM

first, last => {

ut: CSEIndex = SymbolOps.UnderType[SymbolOps.own, TypeForTree[son1]];

firstToken, lastToken: SEToken;

[firstToken, lastToken] ¬ Span[ut];

IF name = first THEN ret ¬ firstToken ELSE ret ¬ lastToken;

};

pred, succ => {

token: SEToken = EnumeratedValue[son1, vCtx];

IF name = pred

THEN ret ¬ CtxPred[vCtx, token]

ELSE ret ¬ CtxSucc[vCtx, token];

};

ENDCASE;

};

ENDCASE;

RETURN [ret];

};

CtxFirst: PROC [ctx: CTXIndex] RETURNS [SEToken] = MimosaCopier.CtxFirst;

CtxLast: PROC [ctx: CTXIndex] RETURNS [SEToken] = {

last: SEToken ¬ MimosaCopier.nullSEToken;

FOR t: SEToken ¬ MimosaCopier.CtxFirst[ctx], MimosaCopier.CtxNext[ctx, t]
UNTIL t = MimosaCopier.nullSEToken DO

last ¬ t;

ENDLOOP;

RETURN [last];

};

CtxSucc: PROC [ctx: CTXIndex, t: SEToken] RETURNS [SEToken] = MimosaCopier.CtxNext;

CtxPred: PROC [ctx: CTXIndex, t: SEToken] RETURNS [SEToken] = {

pred: SEToken ¬ MimosaCopier.nullSEToken;

IF t # MimosaCopier.nullSEToken THEN {

next: SEToken ¬ MimosaCopier.CtxFirst[ctx];

UNTIL next = t OR next = MimosaCopier.nullSEToken DO

pred ¬ next;

next ¬ MimosaCopier.CtxNext[ctx, next];

ENDLOOP;

};

RETURN [pred];

};

InitTree: PROC [sei: ISEIndex] RETURNS [Tree.Link] = INLINE {

RETURN [tb[SymbolOps.DecodeTreeIndex[seb[sei].idValue]].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] = {

type: Type;

subType: CSEIndex = NormType[target];

var: BOOL ¬ FALSE;

readonly: BOOL ¬ FALSE;

counted: BOOL ¬ FALSE;

son1: Tree.Link ¬ tb[node].son[1] ¬ Exp[tb[node].son[1], typeANY];

each: Tree.Link ¬ son1;

WITH t: seb[subType] SELECT FROM

ref => {

readonly ¬ t.readOnly;

var ¬ t.var;

IF t.counted THEN

SELECT OpName[each] FROM

uparrow => {

next: Tree.Link ¬ NthSon[each, 1];

nType: CSEIndex = NormType[OperandType[next]];

WITH p: seb[nType] SELECT FROM

ref => IF p.counted THEN counted ¬ TRUE;

ENDCASE;

EXIT;

};

cast, openx => each ¬ NthSon[each, 1];

ENDCASE => EXIT;

ENDLOOP;

};

ENDCASE;

IF MimP3S.safety = checked AND ~(var OR tb[node].attr1) THEN

MimosaLog.ErrorNodeOp[unsafeOp, node, addr];

SELECT OperandLhs[son1, readonly] FROM

counted =>

IF var THEN {

son1 ¬ tb[node].son[1] ¬ SafenRef[son1];

IF SymbolOps.RCType[SymbolOps.own, RType[]] # none THEN

MimosaLog.ErrorTree[unimplemented, son1];

};

none => MimosaLog.ErrorTree[nonAddressable, son1];

ENDCASE;

type ¬ MakeRefType[

cType: RType[], hint: subType, bits: Target.bitsPerPtr,

counted: counted AND ~var, var: var, readOnly: readonly];

SELECT TRUE FROM

var => {MimosaLog.ErrorNode[unimplemented, node]; tb[node].attr2 ¬ FALSE};

(tb[node].attr2 ¬ LongPath[son1]) => type ¬ MakeLongType[type, target];

ENDCASE;

RPush[type, RAttrPop[]];

};

SafenRef: PROC [t: Tree.Link] RETURNS [Tree.Link] = {

v: Tree.Link ¬ t;

WITH t SELECT GetTag[t] FROM

subtree => {

node: Tree.Index = index;

SELECT tb[node].name FROM

dot, uparrow, dindex, reloc => {

PushTree[tb[node].son[1]];

PushNode[safen, 1];

SetType[OperandType[tb[node].son[1]]];

tb[node].son[1] ¬ PopTree[];

};

dollar, index, seqindex, loophole, cast, openx, pad, chop =>

tb[node].son[1] ¬ SafenRef[tb[node].son[1]];

cdot =>

tb[node].son[2] ¬ SafenRef[tb[node].son[2]];

apply, safen => {};

ENDCASE => ERROR;

};

ENDCASE => {};

RETURN [v];

};

StripRelative: PROC [rType: Type] RETURNS [type: Type, baseType: Type] = {

rSei: CSEIndex = SymbolOps.UnderType[SymbolOps.own, rType];

WITH r: seb[rSei] SELECT FROM

relative => {type ¬ r.offsetType; baseType ¬ r.baseType};

ENDCASE => {type ¬ rType; baseType ¬ nullType};

};

MakeRelativeType: PROC [type: Type, bType: Type, hint: Type] RETURNS [Type] = {

protoType: CSEIndex = SymbolOps.UnderType[SymbolOps.own, hint];

WITH p: seb[protoType] SELECT FROM

relative =>

IF SymbolOps.EqTypes[SymbolOps.own, p.offsetType, type] AND SymbolOps.EqTypes[SymbolOps.own, p.baseType, bType] THEN RETURN [hint];

ENDCASE;

{

RRA: is all of this still necessary? still correct?

rType: CSEIndex ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.relative.SIZE];

seb[rType].typeInfo ¬ relative[

baseType: bType,

offsetType: type,

resultType: type];

seb[rType].mark3 ¬ seb[rType].mark4 ¬ TRUE;

RETURN [rType];

};

Base: PROC [node: Tree.Index, target: Type] = {

type, aType, bType, subTarget: Type;

nType: CSEIndex;

attr: Attr;

long: BOOL;

son1: Tree.Link ¬ tb[node].son[1];

IF MimP3S.safety = checked THEN MimosaLog.ErrorNodeOp[unsafeOp, node, base];

IF ListLength[son1] = 1

THEN {

son1 ¬ tb[node].son[1] ¬ Exp[son1, typeANY];

[aType, bType] ¬ StripRelative[CanonicalType[RType[]]];

attr ¬ RAttrPop[];

nType ¬ MimP3.ClearType[aType];

subTarget ¬ StripRelative[target].type;

WITH n: seb[nType] SELECT FROM

array => {

tb[node].name ¬ addr;

IF OperandLhs[son1] = none THEN

MimosaLog.ErrorTree[nonAddressable, son1];

long ¬ LongPath[son1];

};

arraydesc => {

long ¬ LongType[aType];

nType ¬ SymbolOps.UnderType[SymbolOps.own, n.describedType];

tb[node].attr1 ¬ TRUE;

};

ENDCASE => IF nType # typeANY THEN

MimosaLog.ErrorTreeOp[missingOp, son1, base];

}

ELSE {

MimosaLog.ErrorN[listLong, ListLength[son1]-1];

son1 ¬ tb[node].son[1] ¬ UpdateList[son1, VoidExp];

long ¬ FALSE;

};

type ¬ MakeRefType[nType, BaseType[subTarget], Target.bitsPerPtr];

IF (tb[node].attr2 ¬ long) THEN type ¬ MakeLongType[type, subTarget];

IF bType # nullType THEN type ¬ MakeRelativeType[type, bType, target];

attr.const ¬ FALSE;

RPush[type, attr];

};

Length: PROC [node: Tree.Index] = {

son1: Tree.Link ¬ tb[node].son[1];

attr: Attr ¬ MimP3.emptyAttr;

IF ListLength[son1] = 1

THEN {

type: Type;

subType: CSEIndex ¬ typeANY;

son1 ¬ tb[node].son[1] ¬ Exp[son1, typeANY];

type ¬ RType[];

attr ¬ RAttrPop[];

subType ¬ MimP3.ClearType[StripRelative[CanonicalType[type]].type];

WITH seb[subType] SELECT FROM

array => {

IF ~SymbolOps.EqTypes[SymbolOps.own, subType, type] THEN

son1 ¬ tb[node].son[1] ¬ ForceType[son1, subType];

attr.const ¬ TRUE;

};

arraydesc => {

attr.const ¬ FALSE;

tb[node].attr1 ¬ TRUE;

};

ENDCASE => {

attr.const ¬ TRUE;

IF type # typeANY THEN MimosaLog.ErrorTreeOp[missingOp, son1, length];

};

}

ELSE {

attr.const ¬ TRUE;

MimosaLog.ErrorN[listLong, ListLength[son1]-1];

son1 ¬ tb[node].son[1] ¬ UpdateList[son1, VoidExp];

};

RPush[MimData.idINTEGER, attr];

};

Desc: PROC [node: Tree.Index, target: Type] = {

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 = NormType[subTarget];

nType: CSEIndex;

son1: Tree.Link ¬ tb[node].son[1];

IF MimP3S.safety = checked THEN MimosaLog.ErrorNodeOp[unsafeOp, node, arraydesc];

SELECT ListLength[son1] FROM

1 => {

rType: Type;

nDerefs: CARDINAL ¬ 0;

son1 ¬ tb[node].son[1] ¬ Exp[son1, typeANY];

IF OperandLhs[son1] = none THEN MimosaLog.ErrorTree[nonAddressable, son1];

long ¬ LongPath[son1];

rType ¬ RType[];

cSei ¬ SymbolOps.UnderType[SymbolOps.own, CanonicalType[rType]];

IF ~SymbolOps.EqTypes[SymbolOps.own, cSei, rType] THEN

son1 ¬ tb[node].son[1] ¬ ForceType[son1, cSei];

attr ¬ RAttrPop[];

nType ¬ NormType[cSei];

WHILE seb[nType].typeTag = ref AND (nDerefs ¬ nDerefs+1) < 64 DO

long ¬ LongType[cSei];

cSei ¬ SymbolOps.UnderType[SymbolOps.own, CanonicalType[SymbolOps.ReferentType[SymbolOps.own, nType]]];

PushTree[son1]; PushNode[uparrow, 1];

SetType[cSei]; SetAttr[2, long]; SetAttr[3, FALSE];

son1 ¬ tb[node].son[1] ¬ PopTree[];

nType ¬ NormType[cSei];

ENDLOOP;

PushTree[son1];

IF seb[cSei].typeTag = record THEN {

sei: ISEIndex = SequenceField[LOOPHOLE[cSei]];

SELECT TRUE FROM

(sei # ISENull) => {

cSei ¬ SymbolOps.UnderType[SymbolOps.own, seb[sei].idType];

WITH s: seb[cSei] SELECT FROM

sequence => {

PushSe[sei]; PushNode[dollar, 2];

SetType[cSei];

SetAttr[2, long];

};

ENDCASE => ERROR};

(cSei = MimData.typeStringBody) => NULL; -- fake sequence

ENDCASE => {

MimosaLog.ErrorTreeOp[missingOp, son1, arraydesc]; cSei ¬ typeANY}

};

WITH t: seb[cSei] SELECT FROM

array => {rType ¬ aType ¬ OperandType[son1]; fixed ¬ both};

sequence => {

rType ¬ cType ¬ t.componentType; packed ¬ t.packed;

iType ¬ seb[t.tagSei].idType; fixed ¬ both;

IF ~t.controlled THEN MimosaLog.ErrorTreeOp[missingOp, son1, arraydesc];

};

record => { -- StringBody

rType ¬ cType ¬ MimData.idCHAR;

packed ¬ TRUE;

iType ¬ MimData.idCARDINAL;

fixed ¬ both;

};

ENDCASE => {

rType ¬ cType ¬ typeANY;

IF cSei # typeANY THEN MimosaLog.ErrorTreeOp[missingOp, son1, arraydesc];

};

subType ¬ MakeRefType[rType, typeANY, Target.bitsPerPtr];

IF long THEN subType ¬ MakeLongType[subType, typeANY];

PushNode[addr, 1]; SetType[subType]; SetAttr[2, long];

son1 ¬ tb[node].son[1] ¬ PopTree[];

};

3 => {

subNode: Tree.Index = GetNode[son1];

tb[subNode].son[1] ¬ Exp[tb[subNode].son[1], typeANY];

[subType, bType] ¬ StripRelative[CanonicalType[RType[]]];

nType ¬ NormType[subType];

attr ¬ RAttrPop[];

saveNP ¬ phraseNP;

SELECT SymbolOps.TypeForm[SymbolOps.own, nType] FROM

$basic, $ref, $signed, $unsigned => NULL;

ENDCASE => MimosaLog.ErrorTree[typeClash, tb[subNode].son[1]];

long ¬ LongType[subType];

tb[subNode].son[2] ¬ Rhs[tb[subNode].son[2], MimData.idINTEGER];

attr ¬ And[RAttrPop[], attr];

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 ¬ SymbolOps.UnderType[SymbolOps.own, n.describedType];

WITH t: seb[cSei] SELECT FROM

array =>

IF fixed = none

OR (fixed = range
AND SymbolOps.EqTypes[SymbolOps.own, t.componentType, cType]) THEN {

aType ¬ n.describedType; GO TO old};

ENDCASE};

ENDCASE;

GO TO new;

EXITS

old => {};

new => {

aType ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.array.SIZE];

seb[aType] ¬ [mark3: TRUE, mark4: TRUE, body: cons[

align: unknown,

typeInfo: array[

packed: packed,

bitOrder: IF Target.bitOrder = msBit THEN msBit ELSE lsBit,

indexType: IF fixed < both THEN MimData.idCARDINAL ELSE iType,

componentType: IF fixed > none THEN cType ELSE typeANY]]];

};

{

make type description

WITH t: seb[nTarget] SELECT FROM

arraydesc =>

IF SymbolOps.EqTypes[SymbolOps.own, t.describedType, aType] THEN GO TO old;

ENDCASE =>

IF fixed = none AND target = typeANY THEN MimosaLog.ErrorNode[noTarget, node];

GO TO new;

EXITS

old => type ¬ nTarget;

new => {

bits: NAT = Target.bitsPerWord
+ (IF long THEN Target.bitsPerLongPtr ELSE Target.bitsPerPtr);

type ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.arraydesc.SIZE];

seb[type] ¬ [mark3: TRUE, mark4: TRUE, body: cons[

align: MimData.bitsToAlignment[bits],

typeInfo: arraydesc[
length: bits,
readOnly: FALSE,
var: FALSE,
bitOrder: IF Target.bitOrder = msBit THEN msBit ELSE lsBit,
describedType: aType]]];

};

IF (tb[node].attr2 ¬ long) THEN type ¬ MakeLongType[type, subTarget];

IF bType # nullType THEN type ¬ MakeRelativeType[type, bType, target];

attr.const ¬ FALSE;

RPush[type, attr];

};