
DIRECTORY
Alloc USING [Notifier],
Basics USING [BITAND, LowHalf],
ConstArith USING [Add, Compare, Const, FromInt, Sub, ToCard, ToInt],
Host: TYPE MachineParms USING [bitsPerLongWord],
LiteralOps USING [Find],
MimData USING [checks, idCARD, idNAT, interface, switches, typeStringBody],
MimosaLog USING [Error, ErrorTree, WarningTree],
MimP4 USING [Attr, Bias, BiasForType, BitsForType, Bounds, CatchNest, checked, ClearType, CommonAttr, CommonProp, Exp, ForceType, LiteralAttr, MakeArgRecord, MakeTreeLiteralCard, MakeTreeLiteralInt, nullBias, OperandStruct, OperandType, Prop, RelTest, RepForType, Repr, Rhs, RValue, SetType, TreeLiteral, TreeLiteralConst, TypeExp, TypeForTree, VAttr, voidAttr, VPop, VProp, VPush, VRep, VSetTop],
Symbols USING [Base, BitAddress, BitCount, codeCHAR, CSEIndex, ctxType, ISEIndex, ISENull, lZ, seType, Type, UNSPEC],
SymbolOps USING [ArgRecord, BitsPerElement, Cardinality, CtxLevel, DecodeBitAddr, DecodeCard, EncodeCard, FirstCtxSe, FromType, NextSe, NormalType, own, PackedSize, ToType, UnderType, VariantField],
SymLiteralOps USING [TypeRef],
Target: TYPE MachineParms USING [bitsPerAU, bitsPerChar, bitsPerLongWord, bitsPerWord, maxWord],
Tree USING [Base, Index, Link, NodeName, NodePtr, Null, treeType],
TreeOps USING [FreeNode, FreeTree, GetNode, GetTag, IdentityMap, OpName, PopTree, PushLit, PushNode, PushSe, PushTree, SetAttr, SetAttrs, SetSubInfo];
Pass4Xc: PROGRAM
IMPORTS Basics, ConstArith, LiteralOps, MimData, MimosaLog, MimP4, SymbolOps, SymLiteralOps, TreeOps
EXPORTS MimP4 = {
OPEN MimP4, TreeOps;


warnNewProg: BOOL Ź TRUE;


Bias: TYPE = MimP4.Bias;

Type: TYPE = Symbols.Type;
BitCount: TYPE = Symbols.BitCount;
CSEIndex: TYPE = Symbols.CSEIndex;
bitsPerAU: CARDINAL = Target.bitsPerAU;
bitsPerWord: CARDINAL = Target.bitsPerWord;

tb: Tree.Base;	-- tree base address (local copy)
seb: Symbols.Base;	-- se table base address (local copy)
ctxb: Symbols.Base;	-- context table base address (local copy)

ExpCNotify: PUBLIC Alloc.Notifier = {
tb Ź base[Tree.treeType];
seb Ź base[Symbols.seType];
ctxb Ź base[Symbols.ctxType];
};


NormalizeRange: PUBLIC PROC [t: Tree.Link] RETURNS [Tree.Link] = {
val: Tree.Link Ź t;
DO
WITH v: val SELECT GetTag[val] FROM
symbol => {
type: Type = v.index;
ut: CSEIndex = ClearType[type];
rep: Repr Ź RepForType[ut];
lb, ub: ConstArith.Const;
empty: BOOL Ź FALSE;
intervalKind: Tree.NodeName Ź intCC;
[lb, ub] Ź MimP4.Bounds[ut, rep];
IF ConstArith.Compare[lb, ub] = greater THEN {
intervalKind Ź intCO;
ub Ź lb;
};
SELECT rep FROM
unsigned => {
PushTree[ForceType[MakeTreeLiteralCard[ConstArith.ToCard[lb]], type]];
PushTree[ForceType[MakeTreeLiteralCard[ConstArith.ToCard[ub]], type]];
}
ENDCASE => {
PushTree[ForceType[MakeTreeLiteralInt[ConstArith.ToInt[lb]], type]];
PushTree[ForceType[MakeTreeLiteralInt[ConstArith.ToInt[ub]], type]];
};
PushNode[intervalKind, 2];
SetType[type];
val Ź PopTree[];
EXIT;
};
subtree => {
node: Tree.Index = v.index;
SELECT tb[node].name FROM
subrangeTC, cdot => {
val Ź tb[node].son[2];
tb[node].son[2] Ź Tree.Null;
FreeNode[node];
};
IN [intOO .. intCC] => EXIT;
ENDCASE => ERROR;
};
ENDCASE => ERROR;
ENDLOOP;
RETURN [val];
};

Interval: PUBLIC PROC [t: Tree.Link, bias: Bias, target: Repr]
RETURNS [BOOL] = {
attr: Attr;
const: BOOL Ź TRUE;
WITH e: t SELECT GetTag[t] FROM
symbol => {
attr Ź LiteralAttr[RepForType[TypeTree[t]]];
VSetTop[nullBias, attr, 1];
};
subtree => {
node: Tree.Index = e.index;
son1: Tree.Link Ź tb[node].son[1] Ź RValue[tb[node].son[1], bias, target];
attr1: Attr Ź VAttr[];
son2: Tree.Link Ź tb[node].son[2] Ź RValue[tb[node].son[2], bias, target];
attr2: Attr Ź VAttr[];
const Ź ~tb[node].attr1 AND TreeLiteral[son1] AND TreeLiteral[son2];
IF attr1.rep = signed AND attr2.rep = unsigned AND const THEN {
con: Bias Ź TreeLiteralConst[son2];
IF ConstArith.Compare[con, ConstArith.FromInt[LAST[INT]]] # greater THEN
attr2.rep Ź either;
};
IF attr2.rep = signed AND attr1.rep = unsigned AND const THEN {
con: Bias Ź TreeLiteralConst[son1];
IF ConstArith.Compare[con, ConstArith.FromInt[LAST[INT]]] # greater THEN
attr1.rep Ź either;
};
attr Ź CommonAttr[attr1, attr2];
VSetTop[bias, attr, 2];
};
ENDCASE => ERROR;
IF const THEN
SELECT attr.rep FROM
signed, unsigned => {
origin, range: Bias;
[origin, range] Ź ConstantInterval[t ! EmptyInterval => RESUME];
IF origin.sign # negative THEN {
ub: Bias Ź ConstArith.Add[range, origin];
IF ConstArith.Compare[ub, ConstArith.FromInt[INT.LAST]] # greater THEN {
attr.rep Ź either;
VSetTop[bias, attr, 1];
};
};
};
either => {};
ENDCASE => const Ź FALSE;
RETURN [const];
};

EmptyInterval: PUBLIC SIGNAL = CODE;

ConstantInterval: PUBLIC PROC [t: Tree.Link] RETURNS [origin, range: Bias] = {
WITH e: t SELECT GetTag[t] FROM
symbol => {
ut: Type = ClearType[e.index];
rep: Repr Ź RepForType[ut];
uBound: Bias;
[origin, uBound] Ź MimP4.Bounds[ut, rep];
range Ź ConstArith.Sub[uBound, origin];
IF range.sign = negative THEN SIGNAL EmptyInterval;
RETURN [origin, range];
};
subtree => {
node: Tree.Index = e.index;
name: Tree.NodeName Ź tb[node].name;
rep: Repr Ź VRep[];
empty: BOOL Ź FALSE;
son1: Tree.Link Ź tb[node].son[1];
son2: Tree.Link Ź tb[node].son[2];
uBound: Bias Ź TreeLiteralConst[son2];
origin Ź TreeLiteralConst[son1];
SELECT name FROM
intOO, intOC => {
IF RelTest[son1, son2, relGE, rep] THEN empty Ź TRUE;
origin Ź ConstArith.Add[origin, ConstArith.FromInt[1]];
name Ź IF name = intOO THEN intCO ELSE intCC;
};
ENDCASE;
SELECT name FROM
intCC =>
IF RelTest[son1, son2, relG, rep] THEN empty Ź TRUE;
intCO => {
IF RelTest[son1, son2, relGE, rep] THEN empty Ź TRUE;
uBound Ź ConstArith.Sub[uBound, ConstArith.FromInt[1]];
};
ENDCASE => ERROR;
IF ~empty
THEN range Ź ConstArith.Sub[uBound, origin]
ELSE {SIGNAL EmptyInterval; range Ź ConstArith.FromInt[-1]};
};
ENDCASE => ERROR;
};


IsSize: PUBLIC PROC [t: Tree.Link] RETURNS [BOOL] = {
WITH e: t SELECT TreeOps.GetTag[t] FROM
symbol =>
IF seb[e.index].flags.sized THEN RETURN [TRUE];
subtree => {
tp: Tree.NodePtr = @tb[e.index];
SELECT tp.name FROM
plus => RETURN [IsSize[tp.son[1]] AND IsSize[tp.son[1]]];
times => {
c: NAT Ź 0;
FOR i: NAT IN [1..tp.nSons] DO IF IsSize[tp.son[i]] THEN c Ź c + 1; ENDLOOP;
IF c = 1 THEN RETURN [TRUE];
};
size =>
SELECT tp.subInfo FROM
3, 5 => RETURN [TRUE];
ENDCASE;
ENDCASE;
};
ENDCASE;
RETURN [FALSE];
};

TypeOp: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
SELECT tb[node].name FROM
size => {
ApplyLit: PROC [op: Tree.NodeName, val: INT] = {
SELECT op FROM
plus, minus => IF val = 0 THEN RETURN;
times, div => IF val = 1 THEN RETURN;
ENDCASE;
PushTree[MakeTreeLiteralCard[val]];
ApplyNode[op];
};
ApplyNode: PROC [op: Tree.NodeName] = {
PushNode[op, 2];
SetType[ComputeSizeType[]];
SetAttrs[FALSE, FALSE, FALSE];
IF op = check THEN SetSubInfo[1];
};
RoundUpUnits: PROC [bits: BitCount] RETURNS [BitCount] = INLINE {
mod: CARD16 = Basics.BITAND[Basics.LowHalf[bits],  bitsPerRounding-1];
IF mod # 0 THEN bits Ź bits + (bitsPerRounding - mod);
RETURN [bits];
};
RoundUpWords: PROC [bits: BitCount] RETURNS [BitCount] = INLINE {
mod: CARD16 = Basics.BITAND[Basics.LowHalf[bits],  bitsPerWord-1];
IF mod # 0 THEN bits Ź bits + (bitsPerWord - mod);
RETURN [bits];
};
BitsPerItem: PROC [type: Type] RETURNS [Symbols.BitCount] = {
ut: CSEIndex = LocalUnderType[type];
IF ut # MimData.typeStringBody THEN {
sei: Symbols.ISEIndex Ź SymbolOps.VariantField[SymbolOps.own, ut];
IF sei # Symbols.ISENull THEN {
subType: CSEIndex = LocalUnderType[seb[sei].idType];
WITH t: seb[subType] SELECT FROM
sequence => RETURN [
SymbolOps.BitsPerElement[SymbolOps.own, t.componentType, t.packed]];
ENDCASE;
};
};
RETURN [Target.bitsPerChar];
};
bitsPerUnit: NAT Ź 0;
bitsPerRounding: NAT Ź 0;
son1: Tree.Link Ź tb[node].son[1];
son2: Tree.Link Ź tb[node].son[2];

SELECT tb[node].subInfo FROM
1 => bitsPerRounding Ź bitsPerUnit Ź 1;
2 => bitsPerRounding Ź bitsPerUnit Ź Target.bitsPerChar;
3 => {bitsPerRounding Ź bitsPerWord; bitsPerUnit Ź bitsPerAU};
4 => bitsPerRounding Ź bitsPerUnit Ź bitsPerWord;
5 => bitsPerRounding Ź bitsPerUnit Ź bitsPerAU;
ENDCASE => ERROR;
IF OpName[son1] # apply
THEN {
type: Type Ź TypeTree[son1];
nBits: Symbols.BitCount Ź MimP4.BitsForType[type];
IF son2 # Tree.Null THEN
SELECT nBits FROM
< bitsPerWord => nBits Ź SymbolOps.PackedSize[nBits];
ENDCASE => nBits Ź RoundUpWords[nBits];
IF bitsPerUnit = 1 AND bitsPerRounding = bitsPerUnit
THEN
PushTree[MimP4.MakeTreeLiteralCard[nBits]]
ELSE {
nBits Ź RoundUpUnits[nBits];
PushTree[MimP4.MakeTreeLiteralCard[nBits / bitsPerUnit]];
};
}
ELSE {
subNode: Tree.Index = GetNode[son1];
items: Tree.Link Ź tb[subNode].son[2];
type: Type Ź TypeTree[tb[subNode].son[1]];
perType: Symbols.BitCount Ź MimP4.BitsForType[type];
perItem: Symbols.BitCount Ź BitsPerItem[type];
mayNeedRounding: BOOL Ź perItem IN [1..bitsPerWord)
OR bitsPerRounding # bitsPerUnit
OR (Basics.LowHalf[perType] MOD bitsPerUnit # 0);
maxItems: Symbols.BitCount Ź (Symbols.BitCount.LAST-perType)/perItem;
tb[subNode].son[2] Ź Tree.Null;
PushTree[items];
ApplyLit[check, maxItems];
IF NOT mayNeedRounding THEN {
IF bitsPerUnit # 1 THEN {
perItem Ź (perItem + bitsPerUnit-1) / bitsPerUnit;
perType Ź (perType + bitsPerUnit-1) / bitsPerUnit;
};
ApplyLit[times, perItem];
ApplyLit[plus, perType];
GO TO rounded;
};
ApplyLit[times, perItem];
IF son2 # Tree.Null THEN {
ApplyLit[plus, perType+bitsPerWord-1];
ApplyLit[div, bitsPerWord];
ApplyLit[times, bitsPerWord/bitsPerUnit];
GO TO rounded;
};
IF bitsPerRounding # 1 THEN {
IF bitsPerRounding > bitsPerUnit
THEN {
ApplyLit[plus, perType+bitsPerRounding-1];
ApplyLit[div, bitsPerRounding];
ApplyLit[times, bitsPerRounding/bitsPerUnit];
}
ELSE {
ApplyLit[plus, perType+bitsPerUnit-1];
ApplyLit[div, bitsPerUnit];
};
GO TO rounded;
};
ApplyLit[plus, perType];
EXITS rounded => {};
};

IF son2 # Tree.Null THEN {
tb[node].son[2] Ź Tree.Null;
PushPositive[son2];
ApplyNode[times];
};

val Ź Rhs[PopTree[], ComputeSizeType[]];
FreeNode[node];
};
first, last => {
son1: Tree.Link = tb[node].son[1];
TypeExp[son1];
{
resType: Type Ź MimP4.TypeForTree[son1];
type: Type Ź resType;
first: BOOL = (tb[node].name=$first);
vc: CARD Ź 0;
vi: INT Ź 0;
const: ConstArith.Const Ź ConstArith.FromInt[0];
useCard: BOOL Ź TRUE;
useConst: BOOL Ź FALSE;
forceType: BOOL Ź FALSE;
DO
ut: CSEIndex = LocalUnderType[type];
WITH se: seb[ut] SELECT FROM
basic => {
forceType Ź TRUE;
SELECT TRUE FROM
first => EXIT;
se.code = Symbols.codeCHAR => {
vc Ź SymbolOps.Cardinality[SymbolOps.own, ut]-1;
forceType Ź TRUE;
};
ENDCASE => vc Ź Target.maxWord;
};
signed => {
last: INT Ź 0;
bits: NAT Ź se.length;
vi Ź 0;
SELECT bits FROM
Host.bitsPerLongWord => vi Ź INT.LAST;
Host.bitsPerLongWord*2 => {
signBitAsCard: CARD = LOOPHOLE[INT.FIRST];
useConst Ź TRUE;
IF first THEN const Ź [sign: negative, high: signBitAsCard, low: 0];
};
> Host.bitsPerLongWord => MimosaLog.Error[unimplemented];
ENDCASE =>
WHILE bits > 1 DO
vi Ź vi + vi + 1;
bits Ź bits - 1;
ENDLOOP;
IF first THEN vi Ź -1-vi;
useCard Ź FALSE;
};
unsigned => {
bits: NAT Ź se.length;
vc Ź 0;
SELECT bits FROM
Host.bitsPerLongWord => IF NOT first THEN vc Ź CARD.LAST;
Host.bitsPerLongWord*2 => {
useConst Ź TRUE;
const Ź [sign: positive, low: CARD.LAST, high: CARD.LAST];
};
> Host.bitsPerLongWord => MimosaLog.Error[unimplemented];
ENDCASE =>
WHILE bits > 0 DO
vc Ź vc + vc + 1;
bits Ź bits - 1;
ENDLOOP;
};
ref => {
bits: NAT Ź se.length;
vc Ź 0;
forceType Ź TRUE;
IF first THEN EXIT;
SELECT bits FROM
Host.bitsPerLongWord => vc Ź CARD.LAST;
> Host.bitsPerLongWord => ERROR;
ENDCASE =>
WHILE bits > 0 DO
vc Ź vc + vc + 1;
bits Ź bits - 1;
ENDLOOP;
};
enumerated => {
forceType Ź TRUE;
IF first OR se.empty THEN EXIT;
vc Ź SymbolOps.Cardinality[SymbolOps.own, ut]-1;
};
relative => {
forceType Ź TRUE;
type Ź se.offsetType;
LOOP;
};
subrange => {
nt: CSEIndex = SymbolOps.NormalType[SymbolOps.own, se.rangeType];
range: CARD Ź se.range;
vi Ź se.origin;
IF NOT se.filled THEN
MimosaLog.ErrorTree[nonConstant, son1];
IF NOT first THEN {
vi Ź LOOPHOLE[LOOPHOLE[vi, CARD]+se.range, INT];
IF se.empty THEN vi Ź vi - 1;
};
WITH nse: seb[nt] SELECT FROM
signed => useCard Ź FALSE;
ENDCASE => vc Ź LOOPHOLE[vi];
};
ENDCASE => ERROR;
EXIT;
ENDLOOP;
SELECT TRUE FROM
useConst => {
val Ź MakeConst[const, resType];
forceType Ź FALSE;
};
useCard => val Ź MakeTreeLiteralCard[vc];
ENDCASE => val Ź MakeTreeLiteralInt[vi];
IF forceType THEN val Ź MimP4.ForceType[val, resType];
FreeNode[node];
VPush[MimP4.nullBias, LiteralAttr[RepForType[type]]];
};
};
typecode => {
TypeExp[tb[node].son[1]];
IF MimData.interface
THEN val Ź [subtree[index: node]]
ELSE {
val Ź SymLiteralOps.TypeRef[TypeForTree[tb[node].son[1]], FALSE];
FreeNode[node];
};
VPush[MimP4.nullBias, LiteralAttr[either]];
};
ENDCASE => {
MimosaLog.Error[unimplemented];
VPush[MimP4.nullBias, voidAttr];
val Ź [subtree[node]];
};
};

ComputeSizeType: PROC RETURNS[Symbols.ISEIndex] ~ INLINE {
RETURN[IF Target.bitsPerWord < Target.bitsPerLongWord
THEN MimData.idCARD
ELSE MimData.idNAT];
};

PushPositive: PROC [link: Tree.Link] = {
PushTree[link];
IF MimP4.checked OR MimData.switches['b] THEN {
PushTree[Tree.Null];
PushNode[check, 2];
SetType[ComputeSizeType[]];
};
};

MakeConst: PROC [const: ConstArith.Const, type: Type] RETURNS [Tree.Link] = {
hiVal: Tree.Link = MakeTreeLiteralCard[const.high];
loVal: Tree.Link = MakeTreeLiteralCard[const.low];
PushTree[hiVal];
PushTree[loVal];
PushNode[mwconst, 2];
SetType[type];
RETURN [PopTree[]];
};


MiscXfer: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = {
attr: Attr;
val: Tree.Link Ź [subtree[index: node]];
SELECT tb[node].name FROM
create => {
IF warnNewProg THEN MimosaLog.ErrorTree[unimplemented, val];
tb[node].son[1] Ź RValue[tb[node].son[1], MimP4.nullBias, none];
attr Ź [prop: VProp[], rep: unsigned];
VPop[];
};
fork => {
son1: Tree.Link = Exp[tb[node].son[1], none];
type: CSEIndex = OperandStruct[son1, TRUE];
tb[node].son[1] Ź son1;
attr.prop Ź VProp[];
VPop[];
WITH t: seb[type] SELECT FROM
transfer => {
tb[node].son[2] Ź MakeArgRecord[
SymbolOps.ArgRecord[SymbolOps.own, t.typeIn], tb[node].son[2]];
attr.prop Ź CommonProp[attr.prop, VProp[]];
attr.rep Ź other;
VPop[];
};
ENDCASE => ERROR;
};
ENDCASE => {MimosaLog.Error[unimplemented]; attr Ź voidAttr};
attr.prop.noXfer Ź attr.prop.noFreeVar Ź FALSE;
VPush[MimP4.nullBias, attr];
IF tb[node].nSons > 2 THEN CatchNest[tb[node].son[3]];
RETURN [val];
};


Nil: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = {
type: Type = SymbolOps.ToType[tb[node].info];
n: BitCount;
IF tb[node].son[1] # Tree.Null THEN TypeExp[tb[node].son[1]];
n Ź MimP4.BitsForType[type];
VPush[BiasForType[type], LiteralAttr[RepForType[type]]];
SELECT n FROM
<= Host.bitsPerLongWord => {
PushLit[LiteralOps.Find[either, SymbolOps.EncodeCard[0]]];
FreeNode[node];
RETURN [ForceType[PopTree[], type]];
};
ENDCASE => RETURN [ [subtree[node]] ];
};


AddrOp: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = {
attr: Attr Ź voidAttr;
val: Tree.Link Ź [subtree[node]];
SELECT tb[node].name FROM
addr => {
extraCheck: BOOL Ź MimData.checks['w];
subNode: Tree.Index;
type, next: CSEIndex;
son1: Tree.Link Ź tb[node].son[1] Ź Exp[tb[node].son[1], none];
v: Tree.Link Ź son1;
prop: Prop Ź VProp[];
prop.noFreeVar Ź FALSE;
FOR t: Tree.Link Ź v, v DO
WITH t SELECT GetTag[t] FROM
symbol => {
sei: Symbols.ISEIndex = index;
IF seb[sei].constant THEN GO TO fail;
IF SymbolOps.CtxLevel[SymbolOps.own, seb[sei].idCtx] = Symbols.lZ AND
(SymbolOps.DecodeBitAddr[seb[sei].idValue].bd MOD bitsPerWord # 0 OR
SymbolOps.DecodeCard[seb[sei].idInfo] MOD bitsPerWord # 0) THEN GO TO fail;
GO TO pass;
};
subtree => {
subNode Ź index;
SELECT tb[subNode].name FROM
dot, dollar => v Ź tb[subNode].son[2];
index, dindex, seqindex =>
FOR type Ź SymbolOps.NormalType[SymbolOps.own, OperandType[tb[subNode].son[1]]], next DO
et: Type;
WITH t: seb[type] SELECT FROM
array => {
IF NOT t.packed THEN GO TO pass;
et Ź t.componentType;
};
sequence => {
IF NOT t.packed THEN GO TO pass;
et Ź t.componentType;
};
arraydesc => {
next Ź LocalUnderType[t.describedType];
LOOP;
};
ENDCASE => ERROR;
IF MimP4.BitsForType[et] <= bitsPerWord/2 THEN GO TO fail;
GO TO pass;
ENDLOOP;
apply => GO TO fail;
uparrow, reloc => GO TO pass;
cast, chop => v Ź tb[subNode].son[1];
base, length => GO TO pass;
ENDCASE => ERROR;
};
ENDCASE => ERROR;
REPEAT
pass => NULL;
fail => {MimosaLog.ErrorTree[nonAddressable, son1]; extraCheck Ź FALSE};
ENDLOOP;
IF extraCheck AND v # Tree.Null THEN {
vType: Type = MimP4.OperandType[v];
vBits: BitCount = MimP4.BitsForType[vType];
IF vBits MOD bitsPerWord # 0 THEN
MimosaLog.WarningTree[notPortable, val];
};
VSetTop[MimP4.nullBias, [prop: prop, rep: unsigned], 1];
};
base => {
tb[node].son[1] Ź Exp[tb[node].son[1], none];
attr Ź [prop: VProp[], rep: unsigned];
VSetTop[MimP4.nullBias, attr, 1];
};
length => {
son1: Tree.Link Ź tb[node].son[1] Ź Exp[tb[node].son[1], none];
type: CSEIndex Ź OperandStruct[son1, TRUE];
WITH seb[type] SELECT FROM
array => {
val Ź MakeTreeLiteralCard[SymbolOps.Cardinality[SymbolOps.own, indexType]];
FreeNode[node];
attr Ź LiteralAttr[either];
};
ENDCASE => {
attr Ź [prop: VProp[], rep: either];
};
VSetTop[MimP4.nullBias, attr, 1];
};
arraydesc =>
val Ź IF OpName[tb[node].son[1]] # list THEN Desc[node] ELSE DescList[node];
ENDCASE => {
MimosaLog.Error[unimplemented];
VPush[MimP4.nullBias, voidAttr];
};
RETURN [val];
};

Desc: PROC [node: Tree.Index] RETURNS [Tree.Link] = {
subNode: Tree.Index = GetNode[tb[node].son[1]];
long: BOOL = tb[subNode].attr2;
sub1: Tree.Link Ź tb[subNode].son[1] Ź Exp[tb[subNode].son[1], none];
prop: Prop = VProp[];
subType: CSEIndex Ź OperandStruct[sub1, TRUE];
VPop[];
WITH t: seb[subType] SELECT FROM
array => {
n: CARD = SymbolOps.Cardinality[SymbolOps.own, t.indexType];
IF n = 0 THEN MimosaLog.WarningTree[emptyArray, sub1];
IF t.packed AND (BitsForType[subType] MOD bitsPerWord # 0) THEN
MimosaLog.ErrorTree[nonAddressable, sub1];
PushTree[[subtree[subNode]]];
PushTree[MakeTreeLiteralCard[n]];
};
sequence => {
copy: Tree.Link = IdentityMap[sub1];
cNode: Tree.Index = GetNode[copy];
PushTree[sub1];
PushTree[MakeTreeLiteralCard[0]];
PushNode[seqindex, 2];  SetType[t.componentType];
SetAttr[2, long];  SetAttr[3, FALSE];
tb[subNode].son[1] Ź sub1 Ź PopTree[];
PushTree[[subtree[subNode]]];
tb[cNode].son[2] Ź FreeTree[tb[cNode].son[2]];
tb[cNode].son[2] Ź [symbol[index: t.tagSei]];
tb[cNode].info Ź SymbolOps.FromType[ComputeSizeType[]];
PushTree[copy];
};
record => {
copy: Tree.Link = IdentityMap[sub1];
sei: Symbols.ISEIndex = SymbolOps.NextSe[SymbolOps.own, SymbolOps.NextSe[SymbolOps.own, SymbolOps.FirstCtxSe[SymbolOps.own, t.fieldCtx]]];
PushTree[sub1];
PushSe[sei];
PushNode[dollar, 2];
SetType[seb[sei].idType];
SetAttr[2, long];
tb[subNode].son[1] Ź sub1 Ź PopTree[];
PushTree[[subtree[subNode]]];
PushTree[copy];
PushSe[SymbolOps.NextSe[SymbolOps.own,
SymbolOps.FirstCtxSe[SymbolOps.own, t.fieldCtx]]];
PushNode[dollar, 2];
SetType[ComputeSizeType[]]; SetAttr[2, long];
};
ENDCASE => {
PushTree[[subtree[subNode]]];
PushTree[Tree.Null];
};
PushTree[Tree.Null];
PushNode[list, 3];
tb[node].son[1] Ź PopTree[];
VPush[MimP4.nullBias, [prop: prop, rep: other]];
RETURN [[subtree[index: node]]];
};

DescList: PROC [node: Tree.Index] RETURNS [Tree.Link] = {
subNode: Tree.Index = GetNode[tb[node].son[1]];
type: Type = SymbolOps.ToType[tb[node].info];
son1: Tree.Link = RValue[tb[subNode].son[1], MimP4.nullBias, unsigned];
prop: Prop Ź VProp[];
subType: CSEIndex = OperandStruct[son1, TRUE];
tb[subNode].son[1] Ź son1;
WITH se: seb[subType] SELECT FROM
ref => {
refElemType: CSEIndex = LocalUnderType[se.refType];
bits: CARD = BitsForType[refElemType];
IF bits < bitsPerWord AND NAT[bits] MOD bitsPerWord # 0 THEN {
descType: CSEIndex = LocalUnderType[type];
WITH dt: seb[descType] SELECT FROM
arraydesc => {
descArrayType: CSEIndex = LocalUnderType[dt.describedType];
WITH dat: seb[descArrayType] SELECT FROM
array => {
descElemType: CSEIndex = LocalUnderType[dat.componentType];
IF refElemType = descElemType THEN
IF NOT dat.packed OR bits > bitsPerWord/2 THEN GO TO ok;
};
ENDCASE;
};
ENDCASE;
MimosaLog.WarningTree[nonAddressable, son1];
EXITS ok => {};
};
};
ENDCASE;
tb[subNode].son[2] Ź RValue[tb[subNode].son[2], MimP4.nullBias, none];
prop Ź CommonProp[VProp[], prop];
IF tb[subNode].son[3] # Tree.Null THEN TypeExp[tb[subNode].son[3]];
VSetTop[MimP4.nullBias, [prop: prop, rep: other], 2];
RETURN [[subtree[index: node]]];
};

LocalUnderType: PROC [type: Type] RETURNS [CSEIndex] = {
RETURN [SymbolOps.UnderType[SymbolOps.own, type]];
};

TypeTree: PROC [tree: Tree.Link] RETURNS [Type] = {
TypeExp[tree];
RETURN [MimP4.TypeForTree[tree]];
};

}.

  
â  
Pass4Xc.mesa
Copyright Ó 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993 by Xerox Corporation.  All rights reserved.
Satterthwaite, June 18, 1986 5:10:56 pm PDT
Russ Atkinson (RRA) January 18, 1991 12:36 pm PST
Willie-s, March 12, 1993 2:17 pm PST
Options
if true, then warn when "NEW program" is attempted
Defs
sizeType: Symbols.ISEIndex = IF Target.bitsPerWord < Target.bitsPerLongWord
THEN MimData.idCARD
ELSE MimData.idNAT;
RRA: how do we make this really OK for 16-bit machines?  Do we really care?  We do want arithmetic where we can get adequate checking...
Table notification

called by allocator whenever table area is repacked
interval utilities
A symbolic type definition
This interval is really neither signed nor unsigned.
A symbolic type definition
operators on types
Must be invoked before Exp processing is done
Eventually do better than this?
See Pass4Xc.TypeOp for details
Note: like all varieties of TypeOp, this is performed before constant folding.
To inhibit treating the check node as a type check!
the type
# of repetitions
for BITS[T]
for BYTES[T]
for SIZE[T] (rounding to words), maybe UNITS[T]
for WORDS[T]
for UNITS[T] (if no rounding desired)
Should NEVER happen!
Not a sequence, just a static # of bits.
Round up to the packed size when a repetition is present.
push the number of bits (exactly)
Push the literal # of units (rounded up, of course)
Using a sequence type, so will have to calculate dynamically.
A conservative bound on the maximum # of elements.
No need to do the expensive rounding code.
At this point we calculate in bits first.
With a repetition factor we round up to some number of units.
Units other than bits.
The rounding differs from the units
For now, possibly forever, implemented by simple multiplication
DINT
DCARD
Note: we can get here from a relative pointer
forceType _ TRUE;  <<RRA: this can confuse things later>>
We want the last value, but be careful about potential overflow!
this can't be done in the start start - it might change, and MimData might not be initiailized
misc transfer operators
NIL
Don't convert this to a literal right now
Misc addressing operators
We get to this point for a packed sequence or array, but we check to make sure that the elements are really less than a word.
An extra check is made here to make sure that the item being addressed is an integral number of words long.  Obviously, this is overkill, but it's not a bad idea, either.
StringBody only (compatibility glitch)
In some cases the addressing assumed by the descriptor is not compatible with the address given.  This is because variables less than a word are padded on the left.
If the element type described by the desc is padded the same way that the referent type of the pointer is padded then we need not issue a warning.
Ęw  NewlineDelimiter
(cedarcode) style headIcode
Ďe[fLĎy++L1L$ Ďk		LLL4DL0LL>KL
!0LL`uL
ˇĆLLA`L8BLĎnL]dL
LL L L2L L LL LL
"L
"L'L+-sLL L LĎc!0LĄ%8LĄ*>L  
%L3LLLLL L  BL#LLLLLL$L!!&.LLLLFFLFFLLDDLDDLLLLLLLLLLLLLLLLLLL 
 *QLLLL,,LLLLJJLLJJLLD?L##,HLL?L##,HLLL LLL
LL8@ L))+HL4LLLLLLLL	LL L$L  NLLLLL))L''L3LLLL$$LLL""L""L&&L  L!	5L77L-LLL 	4
L!	5L77LL	L'+L0<LLLL L 
 5L-'		L/LL 	L9

LLLLLLLLLLLLLL  C	LN 0L	&L	%LL#LL 	'LLL	!L3L AL
+FL	'6LL AL
'BL	#2LL =L$$%LBBL44 LGYLLLLLLL"L"LL ''L88L>>L/11L//L%LL(LL2L9L5L '4**L!L99L3LLL=L$L&L**L4L.L/EL2LLLL*L22L22LLLL	LL)LL=L&&LL))L	LL L#L**LL--LL&&LLL	LLLLL L?LLLLL L(LLL""LL((LL%LLL00L	L
LL$$
LL	L00LLLLLLLL&LL	*LL7DLL99

LLLLL
LLLL9LLL	:LL99

LLLLL-LLLLL'L 

LLLLLL
L00LLLLLLAALLL)9L''L@L	0L
LLL	LLLLL  LLL))L!(L%6LL55LLLL!L:ALLL++LLL  LLLL L^	 :L
-^LL  (L/LLLLLL  	'ML33L22LLLLLLL L  @LL((L)<L@@L&LL	L--L%+LLLL``L+LLLLLL6=L)/LL6LLL L  ;L-LL=LL8L::LL$L&L)LL L  >LL!!	L&LLL??LLLLL%@E.DL	&KLLLL&SXL	

L

 LLL

 LLL''LLLL}L(:LLL	LL%LLLLLLAHL&LŞL##L++!L((LL78L	L-L&L!!LL?L%+
LKLLLL$LL!!LL LLL  LLLL  5L/LLELL(.L 
L5<L)6
?L**LL!LL$$L"LL!L1L%L&LL.L-L7LLL&L$$LLLLLLL&&LLLYLL-LLLLLLLL00L LL  9L/L-LGGLL(.L!L33L&
>L¤L**"L;;(
L;;"L8LLLLLL,,L
LLLLFFL!L CL55L LL  8L,2LL  3LL!LL LL      Pr  sË  