DIRECTORY
Alloc USING [Notifier],
Basics USING [BITAND, BITSHIFT, bitsPerWord],
BcdDefs USING [Link],
Code USING [caseCVState, CodeNotImplemented, mwCaseCV, tailJumpOK, xtracting, xtractlex],
CodeDefs USING [Base, Byte, codeType, Lexeme, NullLex, OpWordCount, StoreOptions, VarComponent, VarIndex],
ComData USING [bodyIndex, switches],
FOpCodes USING [qADD, qAND, qBNDCK, qDADD, qDDIV, qDESCB, qDESCBS, qDIV, qDMOD, qDMUL,  qDSUB, qDUDIV, qDUMOD, qEXCH, qFADD, qFDIV, qFLOAT, qFMUL, qFREE, qFSUB, qFSC, qLI, qMUL, qNEG, qNILCK, qNILCKL, qPOP, qPUSH, qSDIV, qSHIFT, qSUB],
Literals USING [Base, LTIndex, ltType],
LiteralOps USING [WordIndex],
OpCodeParams USING [GlobalHB, LocalHB],
P5 USING [All, BindStmtExp, CaseStmtExp, Construct, FlowExp, GenTempLex, GetCanonicalType, ListCons, LogHeapFree, MoveToCodeWord, NarrowExp, New, P5Error, PushLex, RowCons, TTAssign, WriteCodeWord],
P5L USING [AddrForVar, AdjustComponent, ComponentForLex, ComponentForSE, CopyLex,  CopyToTemp, EasilyLoadable, FieldOfVarOnly, GenVarItem, LoadBoth, LoadComponent, LoadVar, MakeComponent, OVarItem, TOSComponent, TOSLex, VarAlignment, VarForLex, Words],
P5S USING [AssignExp, BodyInit, CallExp, Create, DIndex, ErrExp, ExtractExp, ForkExp, Index, JoinExp, ProcCheck, SeqIndex, SigExp, StartExp, StringInit, SubstExp, SysErrExp],
P5U USING [OperandType, Out0, Out1, PushLitVal, RecordConstant, TreeLiteral, TreeLiteralValue, WordsForOperand, WordsForSei],
PrincOps USING [EPRange, wordsPerPage],
Real: TYPE USING [Extended, RealToExtended],
Stack USING [Dump, RoomFor],
SymbolOps USING [FnField, NormalType, UnderType, WordsForType, XferMode],
Symbols USING [Base, BitAddress, bodyType, CBTIndex, CBTNull, ContextLevel, CSEIndex, ISEIndex, lZ, RecordSEIndex, seType],
Tree USING [Base, Index, Link, Null, treeType],
TreeOps USING [GetNode, GetSe, NthSon, OpName];

Expression: PROGRAM
IMPORTS Basics, CPtr: Code, MPtr: ComData, LiteralOps, P5, P5L, P5S, P5U, Real, Stack, SymbolOps, TreeOps 
EXPORTS CodeDefs, P5 = BEGIN OPEN FOpCodes, CodeDefs;


wordlength: CARDINAL = Basics.bitsPerWord;
firstMappedAddress: CARDINAL = PrincOps.wordsPerPage;
LocalHB: TYPE = OpCodeParams.LocalHB;
GlobalHB: TYPE = OpCodeParams.GlobalHB;

ExprOptions: CodeDefs.StoreOptions = [expr: TRUE, init: TRUE];

BitAddress: TYPE = Symbols.BitAddress;
CBTIndex: TYPE = Symbols.CBTIndex;
CBTNull: CBTIndex = Symbols.CBTNull;
ContextLevel: TYPE = Symbols.ContextLevel;
CSEIndex: TYPE = Symbols.CSEIndex;
RecordSEIndex: TYPE = Symbols.RecordSEIndex;
ISEIndex: TYPE = Symbols.ISEIndex;
lZ: ContextLevel = Symbols.lZ;
LTIndex: TYPE = Literals.LTIndex;


tb: Tree.Base;		-- tree base (local copy)
seb: Symbols.Base;		-- semantic entry base (local copy)
bb: Symbols.Base;		-- body entry base (local copy)
cb: CodeDefs.Base;		-- code base (local copy)
ltb: Literals.Base;		-- literal base (local copy)

ExpressionNotify: PUBLIC Alloc.Notifier =
BEGIN  -- called by allocator whenever table area is repacked
seb _ base[Symbols.seType];
bb _ base[Symbols.bodyType];
tb _ base[Tree.treeType];
cb _ base[codeType];
ltb _ base[Literals.ltType];
END;

recentExp: PUBLIC Tree.Link; -- for debugging

Exp: PUBLIC PROC [t: Tree.Link] RETURNS [l: Lexeme] =
BEGIN -- generates code for an expression
node: Tree.Index;
WITH e: t SELECT FROM
literal =>
WITH e.index SELECT FROM
word => RETURN [Lexeme[literal[word[lti]]]];
string => RETURN [Lexeme[literal[string[sti]]]];
ENDCASE;
symbol => RETURN [Lexeme[se[e.index]]];
subtree =>
BEGIN
recentExp _ t;
IF e = Tree.Null THEN
IF CPtr.xtracting THEN RETURN [CPtr.xtractlex]
ELSE
BEGIN
SELECT CPtr.caseCVState FROM
single => P5U.Out0[qPUSH];
singleLoaded => CPtr.caseCVState _ single;
multi => RETURN [P5L.CopyLex[CPtr.mwCaseCV]];
ENDCASE => ERROR;
RETURN [P5L.TOSLex[1]];
END;
node _ e.index;
SELECT tb[node].name FROM
casex => l _ P5.CaseStmtExp[node, TRUE];
bindx => l _ P5.BindStmtExp[node, TRUE];
assignx => l _ P5S.AssignExp[node];
extractx => l _ P5S.ExtractExp[node];
plus => l _ Plus[node];
minus => l _ Minus[node];
div => l _ Div[node];
mod => l _ Mod[node];
times => l _ Times[node];
dot, uparrow => l _ DotOrUparrow[node];
reloc => l _ Reloc[node];
dollar => l _ Dollar[node];
uminus => l _ UMinus[node];
addr => l _ Addr[node];
index => l _ P5S.Index[node];
dindex => l _ P5S.DIndex[node];
construct => l _ P5.Construct[Tree.Null, node, ExprOptions];
arraydesc => l _ ArrayDesc[node];
length => l _ Length[node];
base => l _ Base[node];
body => l _ P5S.BodyInit[node];
rowcons => l _ P5.RowCons[Tree.Null, node, ExprOptions];
stringinit => l _ P5S.StringInit[node];
pad => 
BEGIN
psei: CSEIndex = SymbolOps.UnderType[tb[node].info];
tlex: Lexeme.se = P5.GenTempLex[SymbolOps.WordsForType[psei]];
P5.TTAssign[[symbol[tlex.lexsei]], t];
l _ tlex;
END;
ord, val, cast, loophole => l _ Exp[tb[node].son[1]];
safen => l _ Safen[node];
seqindex => l _ P5S.SeqIndex[node];
item => l _ Exp[tb[node].son[2]];
callx, portcallx => l _ P5S.CallExp[node];
substx => l _ P5S.SubstExp[node];
signalx => l _ P5S.SigExp[node];
errorx => l _ P5S.ErrExp[node];
syserrorx => l _ P5S.SysErrExp[node];
startx => l _ P5S.StartExp[node];
new => l _ P5.New[node];
listcons => l _ P5.ListCons[node];
create => l _ P5S.Create[node];
mwconst => l _ MwConst[node];
signalinit => l _ SignalInit[node];
fork => l _ P5S.ForkExp[node];
joinx => l _ P5S.JoinExp[node];
float => l _ Float[node];
narrow => l _ P5.NarrowExp[node];
check =>
BEGIN
nw: CARDINAL = P5U.WordsForOperand[tb[node].son[1]];
PushRhs[tb[node].son[1]];  PushRhs[tb[node].son[2]];
P5U.Out0[FOpCodes.qBNDCK];
l _ P5L.TOSLex[nw];
END;
proccheck => l _ P5S.ProcCheck[node];
chop =>
BEGIN
len: CARDINAL = P5U.WordsForSei[tb[node].info];
r: VarIndex = P5L.VarForLex[Exp[tb[node].son[1]]];
P5L.FieldOfVarOnly[r: r, wSize: len];
l _ [bdo[r]];
END;
all => l _ P5.All[Tree.Null, node, ExprOptions];
gcrt => l _ P5.GetCanonicalType[node];
ENDCASE => l _ P5.FlowExp[node];
END;
ENDCASE;
RETURN
END;


ConstOperand: PROC [t: Tree.Link] RETURNS [BOOL, CARDINAL] =
BEGIN -- if t is a literal node, return [TRUE,val(t)]
IF P5U.TreeLiteral[t] THEN
RETURN [TRUE, P5U.TreeLiteralValue[t]]
ELSE RETURN [FALSE, 0]
END;

Plus: PROC [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generate code for +
op: Byte;
nw: [1..2];
op1, op2: VarComponent;
SELECT TRUE FROM
tb[node].attr1 =>
{IF ~MPtr.switches['f] THEN Stack.Dump[]; nw _ 2; op _ qFADD};
tb[node].attr2 => {nw _ 2; op _ qDADD};
ENDCASE => {nw _ 1; op _ qADD};
op1 _ P5L.ComponentForLex[Exp[tb[node].son[1]]];
op2 _ P5L.ComponentForLex[Exp[tb[node].son[2]]];
P5L.LoadBoth[@op1, @op2, TRUE];
P5U.Out0[op];
RETURN [P5L.TOSLex[nw]]
END;


Minus: PROC [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generate code for (binary) -
op: Byte;
nw: [1..2];
SELECT TRUE FROM
tb[node].attr1 =>
{IF ~MPtr.switches['f] THEN Stack.Dump[]; nw _ 2; op _ qFSUB};
tb[node].attr2 => {nw _ 2; op _ qDSUB};
ENDCASE => {nw _ 1; op _ qSUB};
IF ~Stack.RoomFor[2*nw] THEN Stack.Dump[];
PushRhs[tb[node].son[1]];
PushRhs[tb[node].son[2]];
P5U.Out0[op];
RETURN [P5L.TOSLex[nw]]
END;


UMinus: PROC [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generate code for (unary) -
tt: Tree.Link = tb[node].son[1];
real: BOOL = tb[node].attr1;
nw: [1..2] =  IF real OR tb[node].attr2 THEN 2 ELSE 1;
IF TreeOps.OpName[tt] = uminus THEN
BEGIN
subNode: Tree.Index = TreeOps.GetNode[tt];
PushRhs[tb[subNode].son[1]];
END
ELSE
BEGIN
IF nw = 2 THEN
BEGIN
IF real AND ~MPtr.switches['f] THEN Stack.Dump[]; 
P5U.PushLitVal[0]; P5U.PushLitVal[0];
END;
PushRhs[tt];
P5U.Out0[IF nw = 2 THEN (IF real THEN qFSUB ELSE qDSUB) ELSE qNEG];
END;
RETURN [P5L.TOSLex[nw]]
END;


Times: PROC [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generates code for *
op: Byte;
nw: [1..2];
op1, op2: VarComponent;
SELECT TRUE FROM
tb[node].attr1 =>
{IF ~MPtr.switches['f] THEN Stack.Dump[]; nw _ 2; op _ qFMUL};
tb[node].attr2 => {Stack.Dump[]; nw _ 2; op _ qDMUL};
ENDCASE => {nw _ 1; op _ qMUL};
SELECT op FROM
qFMUL =>
IF MPtr.switches['f] THEN
BEGIN
rand2lit: BOOL;
rand2val: Real.Extended;
[rand2lit, rand2val] _ RealConst[tb[node].son[2]];
IF rand2lit AND Power2[rand2val]
AND rand2val.exp IN [-200b..200b] THEN
BEGIN
PushRhs[tb[node].son[1]];
P5U.PushLitVal[rand2val.exp]; P5U.Out0[qFSC];
RETURN [P5L.TOSLex[nw]]
END;
END;
ENDCASE;
op1 _ P5L.ComponentForLex[Exp[tb[node].son[1]]];
op2 _ P5L.ComponentForLex[Exp[tb[node].son[2]]];
P5L.LoadBoth[@op1, @op2, TRUE];
P5U.Out0[op];
RETURN [P5L.TOSLex[nw]]
END;


Log2: PROC [i: CARDINAL] RETURNS [BOOL, [0..16]] =
BEGIN OPEN Basics;
IF i = 0 THEN RETURN [FALSE, 0];
IF BITAND[i, i-1] # 0 THEN RETURN [FALSE, 0];
FOR shift: [0..16) IN [0..16) DO
IF BITAND[i,1] = 1 THEN RETURN [TRUE, shift];
i _ BITSHIFT[i, -1];
ENDLOOP;
ERROR; -- can't get here, but it makes the compiler happy
END;


Power2: PROC [v: Real.Extended] RETURNS [BOOL] =
BEGIN
FractionOne: LONG CARDINAL = 20000000000b;
RETURN [v.type = normal AND ~v.sign AND v.frac = FractionOne]
END;

Div: PROC [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generate code for /
signed: BOOL = tb[node].attr3;
op: Byte;
nw: [1..2];
SELECT TRUE FROM
tb[node].attr1 =>
{IF ~MPtr.switches['f] THEN Stack.Dump[]; nw _ 2; op _ qFDIV};
tb[node].attr2 =>
{Stack.Dump[]; nw _ 2; op _ IF signed THEN qDDIV ELSE qDUDIV};
ENDCASE => {nw _ 1; op _ IF signed THEN qSDIV ELSE qDIV};
IF ~Stack.RoomFor[2*nw] THEN Stack.Dump[];
PushRhs[tb[node].son[1]];
SELECT op FROM
qDIV =>
BEGIN
rand2lit: BOOL;
rand2val: CARDINAL;
[rand2lit, rand2val] _ ConstOperand[tb[node].son[2]];
IF rand2lit THEN
BEGIN
powerof2: BOOL;
shift: [0..16];
[powerof2, shift] _ Log2[rand2val];
IF powerof2 THEN
BEGIN
P5U.PushLitVal[-shift]; P5U.Out0[qSHIFT];
RETURN [P5L.TOSLex[nw]]
END;
END;
END;
qFDIV =>
IF MPtr.switches['f] THEN
BEGIN
rand2lit: BOOL;
rand2val: Real.Extended;
[rand2lit, rand2val] _ RealConst[tb[node].son[2]];
IF rand2lit AND Power2[rand2val]
AND rand2val.exp IN [-200b..200b] THEN
BEGIN
P5U.PushLitVal[-rand2val.exp]; P5U.Out0[qFSC];
RETURN [P5L.TOSLex[nw]]
END;
END;
ENDCASE;
PushRhs[tb[node].son[2]];
P5U.Out0[op];
RETURN [P5L.TOSLex[nw]];
END;


Mod: PROC [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generate code for MOD
real: BOOL = tb[node].attr1;
double: BOOL =  real OR tb[node].attr2;
signed: BOOL = tb[node].attr3;
IF double THEN 
BEGIN 
IF real THEN SIGNAL CPtr.CodeNotImplemented;
Stack.Dump[];
END;
PushRhs[tb[node].son[1]];
IF ~double AND ~signed THEN
BEGIN
rand2lit, powerof2: BOOL;
rand2val: CARDINAL;
[rand2lit, rand2val] _ ConstOperand[tb[node].son[2]];
IF rand2lit THEN
BEGIN
[powerof2, ] _ Log2[rand2val];
IF powerof2 THEN
BEGIN
P5U.PushLitVal[rand2val-1]; P5U.Out0[qAND];
RETURN [P5L.TOSLex[1]];
END;
END;
END;
PushRhs[tb[node].son[2]];
IF double THEN
BEGIN 
P5U.Out0[IF signed THEN qDMOD ELSE qDUMOD];
RETURN [P5L.TOSLex[2]];
END;
P5U.Out0[IF signed THEN qSDIV ELSE qDIV];
P5U.Out0[qPUSH];
P5U.Out0[qEXCH];
P5U.Out0[qPOP];
RETURN [P5L.TOSLex[1]];
END;

StoreMod: PUBLIC PROC [t: Tree.Link, bSize: [0..wordlength)] RETURNS [Tree.Link] =
BEGIN  -- see if store into field with width bSize performs the MOD operation
IF TreeOps.OpName[t] # mod THEN RETURN [t]
ELSE
BEGIN
node: Tree.Index = TreeOps.GetNode[t];
t2: Tree.Link = tb[node].son[2];
powerof2: BOOL _ FALSE;
log: [0..16];
IF tb[node].attr3 THEN RETURN [t];
IF P5U.TreeLiteral[t2] THEN [powerof2, log] _ Log2[P5U.TreeLiteralValue[t2]];
RETURN [IF powerof2 AND log = bSize
THEN tb[node].son[1]
ELSE t]
END;
END;


Float: PROC [node: Tree.Index] RETURNS [Lexeme] =
BEGIN
IF ~MPtr.switches['f] THEN Stack.Dump[];
PushRhs[tb[node].son[1]];
P5U.Out0[qFLOAT];
RETURN [P5L.TOSLex[2]]
END;

Safen: PROC [node: Tree.Index] RETURNS [Lexeme] =
BEGIN
var: VarComponent = P5L.ComponentForLex[Exp[tb[node].son[1]]];
RETURN [[bdo[P5L.OVarItem[P5L.EasilyLoadable[var, store]]]]]
END;

Addr: PROC [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generates code for "@"
r: VarIndex = P5L.VarForLex[Exp[tb[node].son[1]]];
avar: VarComponent = P5L.AddrForVar[r];
WITH vv: avar SELECT FROM
frame, caddr, link => NULL;
faddr =>
IF vv.level = bb[MPtr.bodyIndex].level THEN CPtr.tailJumpOK _ FALSE;
ENDCASE => CPtr.tailJumpOK _ FALSE;	-- conservative
RETURN [[bdo[P5L.OVarItem[avar]]]]
END;

ArrayDesc: PROC [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- pushes two components of an array descriptor onto stack
subNode: Tree.Index = TreeOps.GetNode[tb[node].son[1]];
size: CARDINAL;
size _ SPushRhs[tb[subNode].son[1]];
size _ SPushRhs[tb[subNode].son[2]] + size;
RETURN [P5L.TOSLex[size]]
END;

Length: PROC [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generates code to extract length from array descriptor
t1: Tree.Link = tb[node].son[1];
pW: CARDINAL = P5U.WordsForOperand[t1] - 1;
r: VarIndex = P5L.VarForLex[Exp[t1]];
P5L.FieldOfVarOnly[r: r, wd: pW, wSize: 1];
RETURN [[bdo[r]]]
END;


Base: PROC [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generates code to extract base from array descriptor
t1: Tree.Link = tb[node].son[1];
pW: CARDINAL = P5U.WordsForOperand[t1] - 1;
r: VarIndex = P5L.VarForLex[Exp[t1]];
P5L.FieldOfVarOnly[r: r, wSize: pW];
RETURN [[bdo[r]]]
END;


DotOrUparrow: PROC [mainnode: Tree.Index]  RETURNS [Lexeme] =
BEGIN
t1: Tree.Link = tb[mainnode].son[1];
r: VarIndex;
long: BOOL = tb[mainnode].attr2;
nilCheck: BOOL;
base: VarComponent;
offset: VarComponent;
w, b: CARDINAL;
IF tb[mainnode].name = uparrow THEN
BEGIN
w _ P5U.WordsForSei[tb[mainnode].info];  b _ 0;
offset _ [wSize: w, space: frame[wd: 0]];
END
ELSE
BEGIN
sei: ISEIndex = TreeOps.GetSe[tb[mainnode].son[2]];
IF seb[sei].constant THEN -- procedure or signal from pointer to frame
RETURN [ConstantField[t1, sei, tb[mainnode].attr1, long]]
ELSE
BEGIN
psei: CSEIndex = SymbolOps.NormalType[P5U.OperandType[t1]];
offset _ P5L.ComponentForSE[sei];
WITH o: offset SELECT FROM
frame =>
BEGIN
o.level _ lZ; -- to take care of pointer to frame
w _ o.wd + o.wSize;  b _ o.bd + o.bSize;
END;
ENDCASE => ERROR; -- fields of code data are dollar nodes
WITH seb[psei] SELECT FROM
ref =>
BEGIN OPEN SymbolOps;
rcsei: CSEIndex = UnderType[refType];
WITH seb[rcsei] SELECT FROM
record =>
P5L.AdjustComponent[var: @offset, rSei: LOOPHOLE[rcsei],
fSei: sei, tBits: WordsForType[rcsei]*wordlength];
ENDCASE;
END;
ENDCASE => P5.P5Error[642];
END;
END;
IF tb[mainnode].attr1 THEN
BEGIN	-- nil checking, see if hardware will do it
tsei: CSEIndex = SymbolOps.UnderType[tb[mainnode].info];
nilCheck _ ~MPtr.switches['a] OR
P5L.Words[w+b/wordlength, b MOD wordlength] > firstMappedAddress
OR (WITH t: seb[tsei] SELECT FROM
sequence => TRUE,
array => SymbolOps.WordsForType[tsei] NOT IN (0..OpWordCount.LAST],
record, union => tb[mainnode].name = uparrow,
ENDCASE => FALSE);
END
ELSE nilCheck _ FALSE;
SELECT TRUE FROM
nilCheck =>
BEGIN
PushRhs[t1];
P5U.Out0[IF long THEN FOpCodes.qNILCKL ELSE FOpCodes.qNILCK];
base _ P5L.TOSComponent[IF long THEN 2 ELSE 1];
r _ P5L.GenVarItem[bo];
cb[r] _ [body: bo[base: base, offset: offset]];
END;
(TreeOps.OpName[t1] = plus) =>
BEGIN
subNode: Tree.Index = TreeOps.GetNode[t1];
disp: VarComponent;
base _ P5L.ComponentForLex[Exp[tb[subNode].son[1]]];
disp _ P5L.ComponentForLex[Exp[tb[subNode].son[2]]];
r _ P5L.GenVarItem[bdo];
cb[r] _ [body: bdo[base: base, disp: disp, offset: offset]];
END;
ENDCASE =>
BEGIN
base _ P5L.ComponentForLex[Exp[t1]];
r _ P5L.GenVarItem[bo];
cb[r] _ [body: bo[base: base, offset: offset]];
END;
RETURN [[bdo[r]]]
END;


AdjustNilCheck: PUBLIC PROC [t: Tree.Link, wordOffset: CARDINAL] =
BEGIN  -- used by SeqIndex to suppress nil check if bound (at offset) is checked
SELECT TreeOps.OpName[t] FROM
dollar => AdjustNilCheck[TreeOps.NthSon[t, 1], wordOffset];
dot, uparrow =>
IF MPtr.switches['a] AND wordOffset < firstMappedAddress THEN
BEGIN
subNode: Tree.Index = TreeOps.GetNode[t];
tb[subNode].attr1 _ FALSE;
END;
ENDCASE;
END;


Reloc: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generates code for "baseptr[relptr]"
rd, rr: VarIndex;
base: VarComponent _ P5L.ComponentForLex[Exp[tb[node].son[1]]];
disp: VarComponent;
rd _ P5L.VarForLex[Exp[tb[node].son[2]]];
IF tb[node].attr1 THEN
BEGIN -- reloc of an array descriptor
dsize: CARDINAL = P5U.WordsForOperand[tb[node].son[2]] - 1;
P5L.FieldOfVarOnly[r: rd, wSize: dsize];
END;
disp _ P5L.MakeComponent[rd];
rr _ P5L.GenVarItem[bdo];
cb[rr] _ [body: bdo[base: base, disp: disp, offset:
[wSize: SymbolOps.WordsForType[tb[node].info], space: frame[]]]];
RETURN [[bdo[rr]]]
END;


ConstantField: PROC [t: Tree.Link, sei: ISEIndex, nilCheck, long: BOOL]
RETURNS [Lexeme] =
BEGIN
SELECT SymbolOps.XferMode[seb[sei].idType] FROM
proc =>
BEGIN
bti: CBTIndex = seb[sei].idInfo;
IF seb[sei].extended THEN SIGNAL CPtr.CodeNotImplemented;
IF bti = CBTNull THEN
RETURN [[bdo[P5L.OVarItem[ [wSize: 1, space: const[d1: seb[sei].idValue]]]]]];
IF long THEN SIGNAL CPtr.CodeNotImplemented;
PushRhs[t];
IF nilCheck THEN P5U.Out0[FOpCodes.qNILCK];
WITH bb[bti] SELECT FROM
Inner =>
BEGIN -- could happen with pointer to procedure frame
P5U.Out1[FOpCodes.qLI, frameOffset];
P5U.Out0[FOpCodes.qADD];
END;
Outer => P5U.Out1[qDESCBS, entryIndex];
ENDCASE;
END;
signal, error =>
BEGIN
lnk: BcdDefs.Link = seb[sei].idValue;
IF long THEN SIGNAL CPtr.CodeNotImplemented;
PushRhs[t];
IF nilCheck THEN P5U.Out0[FOpCodes.qNILCK];
P5U.Out1[qDESCBS, (lnk.gfi-1)*PrincOps.EPRange + lnk.ep];
END;
ENDCASE => P5.P5Error[643];
RETURN [P5L.TOSLex[1]]
END;

Dollar: PROC [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generates code for "exp$field"
sei: ISEIndex = TreeOps.GetSe[tb[node].son[2]];
r: VarIndex;
l: Lexeme;
recsei: RecordSEIndex = LOOPHOLE[P5U.OperandType[tb[node].son[1]]];
functionCall: BOOL = seb[recsei].argument;
tBits, twSize: CARDINAL;
tbSize: [0..wordlength);
foffset: VarComponent.frame;
hlex: Lexeme.se _ NullLex;
IF seb[sei].constant THEN
BEGIN
subNode: Tree.Index = TreeOps.GetNode[tb[node].son[1]];
IF tb[subNode].name # uparrow THEN P5.P5Error[645];
RETURN [ConstantField[
tb[subNode].son[1], sei, tb[subNode].attr1, tb[subNode].attr2]]
END;
l _ Exp[tb[node].son[1] ! P5.LogHeapFree =>
IF calltree = tb[node].son[1] THEN
BEGIN
logged: BOOL; lex: Lexeme.se;
[logged, lex] _ SIGNAL P5.LogHeapFree[calltree];
IF logged THEN RESUME [TRUE, lex];
hlex _ P5.GenTempLex[1];
RESUME [TRUE, hlex]
END];
r _ P5L.VarForLex[l];
[wSize: twSize, bSize: tbSize] _ P5L.VarAlignment[r, load];
tBits _ twSize*wordlength + tbSize;
IF functionCall THEN
BEGIN
fSize: CARDINAL;
fAddr: BitAddress;
[fAddr,fSize] _ SymbolOps.FnField[sei];
foffset _ [wSize: fSize / wordlength, bSize: fSize MOD wordlength,
space: frame[wd: fAddr.wd, bd: fAddr.bd]];
END
ELSE foffset _ LOOPHOLE[P5L.ComponentForSE[sei]];
IF tBits <= wordlength THEN
P5L.AdjustComponent[var: @foffset,
rSei: recsei, fSei: sei, tBits: tBits];
P5L.FieldOfVarOnly[r: r, wSize: foffset.wSize,
bSize: foffset.bSize, wd: foffset.wd, bd: foffset.bd];
IF hlex # NullLex THEN
BEGIN
r _ P5L.OVarItem[P5L.CopyToTemp[r].var];
P5.PushLex[hlex];  P5U.Out0[FOpCodes.qFREE];
END;
RETURN [[bdo[r]]]
END;



MwConst: PROC [node: Tree.Index] RETURNS [l: Lexeme] =
BEGIN -- puts multi-word constant out to code stream
lti: LTIndex = LiteralOps.WordIndex[NARROW[tb[node].son[1], Tree.Link.literal].index];
WITH ll: ltb[lti] SELECT FROM
short => RETURN [[literal[word[lti]]]];
long => 
BEGIN
var: VarComponent;
SELECT ll.length FROM
0 => P5.P5Error[649];
1 => var _ [wSize: 1, space: const[d1: ll.value[0]]];
2 => var _ [wSize: 2, space: const[d1: ll.value[0], d2: ll.value[1]]];
ENDCASE =>
BEGIN
nwords: CARDINAL = ll.length;
IF ll.codeIndex = 0 THEN 
BEGIN
ll.codeIndex _ P5.MoveToCodeWord[];
FOR i: CARDINAL IN [0..nwords) DO P5.WriteCodeWord[ll.value[i]] ENDLOOP;
P5U.RecordConstant[ll.codeIndex, nwords];
END;
var _ [wSize: nwords, space: code[wd: ll.codeIndex, lti: lti]];
END;
RETURN [[bdo[P5L.OVarItem[var]]]];
END;
ENDCASE => ERROR; -- to keep the compiler happy
END;


MultiZero: PUBLIC PROC [t: Tree.Link, minWords: CARDINAL] RETURNS [BOOL] =
BEGIN
IF TreeOps.OpName[t] = mwconst THEN
BEGIN
s: Tree.Link = TreeOps.NthSon[t, 1];
WITH s SELECT FROM
literal =>
WITH l: index SELECT FROM
word =>
BEGIN
lti: LTIndex = l.lti;
WITH ll: ltb[lti] SELECT FROM
long => 
FOR i: CARDINAL IN [0 .. ll.length) DO
IF ll.value[i] # 0 THEN EXIT;
REPEAT
FINISHED => RETURN [ll.length >= minWords]
ENDLOOP;
ENDCASE;
END;
ENDCASE;
ENDCASE;
END
ELSE IF minWords <= 1 AND P5U.TreeLiteral[t] THEN
RETURN [P5U.TreeLiteralValue[t] = 0];
RETURN [FALSE]
END;

RealConst: PUBLIC PROC [t: Tree.Link] RETURNS [BOOL, Real.Extended] =
BEGIN
IF TreeOps.OpName[t] = mwconst THEN
BEGIN
s: Tree.Link = TreeOps.NthSon[t, 1];
v: ARRAY [0..2) OF WORD;
lti: LTIndex = LiteralOps.WordIndex[NARROW[s, Tree.Link.literal].index];
WITH ll:ltb[lti] SELECT FROM
long => 
SELECT ll.length FROM
2 => {v[0] _ ll.value[0]; v[1] _ ll.value[1]};
ENDCASE => ERROR;
ENDCASE => ERROR;
RETURN [TRUE, Real.RealToExtended[LOOPHOLE[v]]]
END;
RETURN [FALSE, [nan, FALSE, 0, 0]]
END;



LPushRhs: PUBLIC PROC [t: Tree.Link] RETURNS [Lexeme] =
BEGIN -- forces a value onto the stack
wSize: CARDINAL = SPushRhs[t];
RETURN [P5L.TOSLex[wSize]]
END;


PushRhs: PUBLIC PROC [t: Tree.Link] =
BEGIN -- forces a value onto the stack
[] _ SPushRhs[t];
END;


SPushRhs: PROC [t: Tree.Link] RETURNS [wSize: CARDINAL] =
BEGIN -- forces a value onto the stack
RETURN [SPushLex[Exp[t]]]
END;


SPushLex: PROC [l: Lexeme] RETURNS [wSize: CARDINAL] =
BEGIN -- forces a lexeme onto the stack
r: VarIndex = P5L.VarForLex[l];
ws, bs: CARDINAL;
[wSize: ws, bSize: bs] _ P5L.VarAlignment[r,load];
wSize _ P5L.Words[ws, bs];
P5L.LoadVar[r];
RETURN
END;


PushLex: PUBLIC PROC [l: Lexeme] =
{[] _ SPushLex[l]};


LPushLex: PUBLIC PROC [l: Lexeme] RETURNS [Lexeme] =
BEGIN
wSize: CARDINAL = SPushLex[l];
RETURN [P5L.TOSLex[wSize]];
END;


PushLProcDesc: PUBLIC PROC [bti: CBTIndex] =
BEGIN -- pushes a descriptor for local procedure on stack
WITH body: bb[bti] SELECT FROM
Inner => PushNestedProcDesc[bti];
Outer => P5U.Out1[qDESCB, body.entryIndex];
ENDCASE;
END;

PushNestedProcDesc: PUBLIC PROC [bti: CBTIndex] =
BEGIN -- pushes a descriptor for nested local procedure on stack
WITH body: bb[bti] SELECT FROM
Inner =>
BEGIN
avar: VarComponent = [
wSize: 1, space: faddr[wd: body.frameOffset, level: body.level-1]];
P5L.LoadComponent[avar];
END;
ENDCASE
END;

SignalInit: PROC [node: Tree.Index] RETURNS [Lexeme] =
BEGIN
P5U.Out1[qDESCB, tb[node].info]; -- no sense making a VarItem to push
RETURN [P5L.TOSLex[1]]
END;

END.


”Expression.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Sweet, September 18, 1980  7:53 PM
Satterthwaite, April 16, 1986 3:15:33 pm PST
Maxwell, August 11, 1983 9:12 am
Russ Atkinson (RRA) March 6, 1985 11:17:23 pm PST
imported definitions
relocs need not apply
relocs get converted to addr
generate code for "exp.field"
if we point to a type, it fills a number of full words
�Êû˜
codeš
œ™Kšœ
Ïm
œ1™<Kš
œ"™"Kš
œ,™,K™ K™1—K˜š
Ïk	˜	Kšœžœ˜Kšœžœžœžœ˜-Kšœžœ˜KšœžœO˜YKšœ	žœ\˜jKšœžœ˜$Kšœ	žœÝ
˜ë
Kšœ	žœ˜'Kšœžœ
˜Kšœ
žœ˜'Kšœžœ¾
˜Æ
Kšœžœó
˜ü
Kšœžœ¥
˜®
Kšœžœt˜}Kšœ	žœ˜'Kšœžœ
žœ˜,Kšœžœ˜Kšœ
žœ:˜IKšœžœn˜{Kšœžœ%˜/Kšœžœ"˜/K˜—šœž˜Kšžœc˜jKšžœžœ˜5K˜Kš
œ™K˜Kšœžœ˜*Kšœžœ˜5Kšœ	žœ˜%Kšœ
žœ˜'K˜Kšœ,žœžœ˜>K˜Kšœžœ˜&Kšœ
žœ˜"K˜$Kšœžœ˜*Kšœ
žœ˜"Kšœžœ˜,Kšœ
žœ˜"K˜Kšœ	žœ˜!K˜K˜KšœÏc˜)KšœŸ#˜7KšœŸ˜2KšœŸ˜-KšœŸ˜1K˜šœžœ˜)KšžœŸ6˜=K˜K˜K˜K˜K˜Kšžœ
˜K˜—KšœžœŸ˜-K˜šÏnœžœ
žœžœ˜5Kšžœ
Ÿ#˜)K˜šžœžœ
ž˜˜
šžœ	žœ
ž˜Kšœžœ˜,Kšœ
žœ ˜0Kšžœ
˜——Kšœ
žœ˜'˜
Kš
ž˜K˜šžœž˜Kšžœžœ
žœ˜.š
ž˜Kš
ž˜šžœž˜K˜K˜*Kšœ	žœ˜-Kšžœžœ
˜—Kšžœ˜Kšžœ
˜——K˜šžœž˜Kšœ"žœ˜(Kšœ"žœ˜(K˜#K˜%K˜K˜K˜K˜K˜K˜'K˜K˜K˜K˜K˜K˜K˜<K˜!K˜K˜K˜K˜8K˜'˜Kš
ž˜K˜4K˜>K˜&K˜	Kšžœ
˜—K˜5K˜K˜#K˜!K˜*K˜!K˜ K˜K˜%K˜!K˜K˜"K˜K˜K˜#K˜K˜K˜K˜!˜Kš
ž˜Kšœžœ(˜4K˜4K˜K˜Kšžœ
˜—K˜%˜Kš
ž˜Kšœžœ"˜/K˜2K˜%K˜
Kšžœ
˜—K˜0K˜&Kšžœ˜ —Kšžœ
˜—Kšžœ
˜—Kš
ž˜Kšžœ
˜K˜K˜—š
 œžœžœžœžœ˜<Kšžœ
Ÿ/˜5šžœž˜Kšžœžœ˜&—Kšžœ
žœžœ˜Kšžœ
˜K˜—š œžœžœ˜0Kšžœ
Ÿ˜K˜	K˜K˜šžœ
žœ
ž˜˜Kšœ
žœžœ#˜>—K˜'Kšžœ˜—K˜0K˜0Kšœžœ˜K˜
Kšžœ˜Kšžœ
˜K˜K˜—š œžœžœ˜1Kšžœ
Ÿ˜%K˜	K˜šžœ
žœ
ž˜˜Kšœ
žœžœ#˜>—K˜'Kšžœ˜—Kšžœžœ˜*K˜K˜K˜
Kšžœ˜Kšžœ
˜K˜K˜—š œžœžœ˜2Kšžœ
Ÿ˜$K˜ Kšœžœ˜Kš	œžœžœžœžœ˜6šžœž˜#Kš
ž˜K˜*K˜Kš
ž˜—š
ž˜Kš
ž˜šžœž˜Kš
ž˜Kšžœžœžœ˜2K˜%Kšžœ
˜—K˜Kš
œ	žœžœžœžœžœžœ˜CKšžœ
˜—Kšžœ˜Kšžœ
˜K˜K˜—š œžœžœ˜1Kšžœ
Ÿ˜K˜	K˜K˜šžœ
žœ
ž˜˜Kšœ
žœžœ#˜>—K˜5Kšžœ˜—šžœž˜˜šžœž˜Kš
ž˜Kšœ
žœ
˜K˜K˜2šžœ
žœ˜ šžœžœž˜&Kš
ž˜K˜K˜-Kšžœ˜Kšžœ
˜——Kšžœ
˜——Kšžœ
˜—K˜0K˜0Kšœžœ˜K˜
Kšžœ˜Kšžœ
˜K˜K˜—š
 œžœžœžœžœ˜2Kšžœ
žœ˜Kšžœžœ
žœžœ˜ Kš
žœ
žœ
žœ
žœžœ˜-šžœžœ	ž˜ Kš
žœ
žœ
žœ
žœžœ	˜-Kšœžœ˜Kšžœ
˜—KšžœŸ2˜9Kšžœ
˜K˜K˜—š œžœžœžœ˜0Kš
ž˜Kšœ
žœ
žœ˜*Kšžœžœ	žœ˜=Kšžœ
˜K˜—š œžœžœ˜/Kšžœ
Ÿ˜Kšœžœ˜K˜	K˜šžœ
žœ
ž˜˜Kšœ
žœžœ#˜>—˜Kšœžœžœžœ	˜>—Kšžœžœžœžœ˜9—Kšžœžœ˜*K˜šžœž˜˜Kš
ž˜Kšœ
žœ
˜Kšœ
žœ
˜K˜5šžœ
ž˜Kš
ž˜Kšœ
žœ
˜K˜K˜#šžœ
ž˜Kš
ž˜K˜)Kšžœ˜Kšžœ
˜—Kšžœ
˜—Kšžœ
˜—˜šžœž˜Kš
ž˜Kšœ
žœ
˜K˜K˜2šžœ
žœ˜ šžœžœž˜&Kš
ž˜K˜.Kšžœ˜Kšžœ
˜——Kšžœ
˜——Kšžœ
˜—K˜K˜
Kšžœ˜Kšžœ
˜K˜K˜—š œžœžœ˜/Kšžœ
Ÿ˜Kšœžœ˜Kšœžœ	žœ˜'Kšœžœ˜šžœžœ
˜Kšžœ
˜Kšžœžœ
žœ˜,K˜
Kšžœ
˜—K˜šžœ	žœ	ž˜Kš
ž˜Kšœžœ
˜Kšœ
žœ
˜K˜5šžœ
ž˜Kš
ž˜K˜šžœ
ž˜Kš
ž˜K˜+Kšžœ˜Kšžœ
˜—Kšžœ
˜—Kšžœ
˜—K˜šžœž˜Kšžœ
˜Kšœ	žœžœžœ	˜+Kšžœ˜Kšžœ
˜—Kšœ	žœžœžœ˜)K˜K˜K˜Kšžœ˜Kšžœ
˜K˜—š œžœ
žœ(žœ˜RKšžœŸF˜MKšžœžœ
žœ˜*š
ž˜Kš
ž˜K˜&K˜ Kšœ
žœžœ
˜K˜
Kšžœžœ
žœ˜"Kšžœžœ2˜Mšžœžœ
žœ˜#Kšžœ˜Kšžœ˜—Kšžœ
˜—Kšžœ
˜K˜K˜—š œžœžœ˜1Kš
ž˜Kšžœžœ˜(K˜K˜Kšžœ˜Kšžœ
˜K˜—š œžœžœ˜1Kš
ž˜K˜>Kšžœ6˜<Kšžœ
˜K˜—š œžœžœ˜0Kšžœ
Ÿ˜K˜2K˜'šžœ
žœ
ž˜Kšœžœ
˜˜Kšžœ%žœžœ
˜D—KšžœžœŸ˜3—Kšžœ˜"Kšžœ
˜K˜—š 	œžœžœ˜5Kšžœ
Ÿ:˜@K˜7Kšœžœ
˜K˜$K˜+Kšžœ˜Kšžœ
˜K˜—š œžœžœ˜2Kšžœ
Ÿ9˜?Kš
œ™K˜ Kšœžœ˜+K˜%K˜+Kšžœ˜Kšžœ
˜K˜K˜—š œžœžœ˜0Kšžœ
Ÿ7˜=Kš
œ™K˜ Kšœžœ˜+K˜%K˜$Kšžœ˜Kšžœ
˜K˜K˜—š œžœžœ˜=Kš
ž˜Kš
œ™K˜$K˜Kšœžœ˜ Kšœ
žœ
˜K˜K˜Kšœžœ
˜šžœž˜#Kš
ž˜K˜/K˜)Kš
ž˜—š
ž˜Kš
ž˜K˜3šžœžœ
Ÿ,˜FKšžœ3˜9—š
ž˜Kš
ž˜K˜;K˜!šžœžœ
ž˜˜Kš
ž˜KšœŸ#˜1K˜(Kšžœ
˜—KšžœžœŸ'˜9—šžœžœ
ž˜˜Kšžœ
žœ˜K˜%Kš
œ6™6šžœžœ
ž˜˜	šœ(žœ˜8K˜2——Kšžœ
˜—Kšžœ
˜—Kšžœ˜—Kšžœ
˜—Kšžœ
˜—šžœž˜Kšžœ
Ÿ+˜1K˜8šœž˜ šœžœ!˜@šžœžœžœ
ž˜!Kšœžœ
˜Kšœ&žœ
žœžœ˜CK˜-Kšžœžœ˜———Kš
ž˜—Kšžœžœ
˜šžœ
žœ
ž˜˜Kš
ž˜K˜Kšœ	žœžœžœ˜=Kšœžœžœžœ˜/K˜K˜/Kšžœ
˜—˜Kš
ž˜K˜*K˜K˜4K˜4K˜K˜<Kšžœ
˜—šžœ˜
Kš
ž˜K˜$K˜K˜/Kšžœ
˜——Kšžœ˜Kšžœ
˜K˜K˜—š œžœ
žœžœ˜BKšžœŸI˜Pšžœž˜K˜;˜šžœžœ!ž˜=Kš
ž˜K˜)Kšœžœ
˜Kšžœ
˜——Kšžœ
˜—Kšžœ
˜K˜K˜—š œžœ
žœžœ˜8Kšžœ
Ÿ'˜-K˜K˜?K˜K˜)šžœž˜Kšžœ
Ÿ˜%Kšœžœ,˜;K˜(Kšžœ
˜—K˜K˜˜3K˜A—Kšžœ˜Kšžœ
˜K˜K˜—š 
œžœ/žœ
˜GKšžœ˜Kš
ž˜šžœ%ž˜/˜Kš
ž˜K˜ Kšžœžœ
žœ˜9šžœž˜KšžœH˜N—Kšžœžœ
žœ˜,K˜Kšžœ
žœ˜+šžœ	žœ
ž˜˜Kšžœ
Ÿ/˜5K˜$K˜Kšžœ
˜—K˜'Kšžœ
˜—Kšžœ
˜—˜Kš
ž˜K˜%Kšžœžœ
žœ˜,K˜Kšžœ
žœ˜+K˜9Kšžœ
˜—Kšžœ˜—Kšžœ˜Kšžœ
˜K˜—š œžœžœ˜2Kšžœ
Ÿ!˜'K˜/K˜K˜
Kšœžœ#˜CKšœžœ˜*Kšœžœ
˜K˜K˜K˜šžœž˜Kš
ž˜K˜7Kšžœžœ˜3šžœ˜K˜?—Kšžœ
˜—˜+šžœž˜"Kš
ž˜Kšœžœ˜Kšœžœ˜0Kšžœžœ
žœžœ˜"K˜Kšžœžœ˜Kšžœ˜——K˜K˜;K˜#šžœž˜Kš
ž˜Kšœžœ
˜K˜K˜'šœ3žœ˜BK˜*—Kš
ž˜—Kšžœžœ˜1šžœž˜˜"K˜'——˜.K˜6—šžœž˜Kš
ž˜K˜(K˜-Kšžœ
˜—Kšžœ˜Kšžœ
˜K˜K˜K˜—š œžœžœ˜6Kšžœ
Ÿ.˜4Kšœ$žœ,˜Všžœžœ
ž˜Kšœ	žœ˜'˜Kš
ž˜K˜šžœž˜K˜K˜5K˜Fšžœ˜
Kš
ž˜Kšœžœ
˜šžœžœ
˜Kš
ž˜K˜#Kš
žœžœ
žœ
žœžœ
˜HK˜)Kšžœ
˜—K˜?Kšžœ
˜——Kšžœ˜"Kšžœ
˜—KšžœžœŸ˜/—Kšžœ
˜K˜K˜—š 	œžœ
žœžœžœžœ˜JKš
ž˜šžœž˜#Kš
ž˜K˜$šžœžœ
ž˜˜
šžœ
žœ
ž˜˜Kš
ž˜K˜šžœžœ
ž˜˜šžœžœ
žœž˜&Kšžœžœ
žœ
˜—š
ž˜Kšžœžœ˜*—Kšžœ
˜—Kšžœ
˜—Kšžœ
˜—Kšžœ
˜——Kšžœ
˜—Kš
ž˜—šžœ
žœžœž˜1Kšžœ˜%—Kšžœžœ
˜Kšžœ
˜K˜—š
 	œžœ
žœžœžœ˜EKš
ž˜šžœž˜#Kš
ž˜K˜$Kšœžœžœ
žœ
˜Kšœ$žœ˜Hšžœ
žœ
ž˜˜šžœž˜K˜.Kšžœžœ
˜——Kšžœžœ
˜—Kšžœžœžœ˜/Kšžœ
˜—Kšžœžœžœ˜"Kšžœ
˜K˜K˜K˜—š œžœ
žœžœ˜7Kšžœ
Ÿ ˜&Kšœžœ˜Kšžœ˜Kšžœ
˜K˜K˜—š œžœ
žœ˜%Kšžœ
Ÿ ˜&K˜Kšžœ
˜K˜K˜—š œžœžœ	žœ˜9Kšžœ
Ÿ ˜&Kšžœ˜Kšžœ
˜K˜K˜—š œžœ
žœ	žœ˜6Kšžœ
Ÿ!˜'K˜Kšœžœ
˜K˜2K˜K˜Kš
ž˜Kšžœ
˜K˜K˜—š œžœ
žœ˜"K˜K˜K˜—š œžœ
žœ
žœ˜4Kš
ž˜Kšœžœ˜Kšžœ˜Kšžœ
˜K˜K˜—š 
œžœ
žœ˜,Kšžœ
Ÿ3˜9šžœžœ
ž˜K˜!K˜+Kšžœ
˜—Kšžœ
˜K˜—š œžœ
žœ˜1Kšžœ
Ÿ:˜@šžœžœ
ž˜˜Kš
ž˜˜K˜C—K˜Kšžœ
˜—Kš
ž˜—Kšžœ
˜K˜—š 
œžœžœ˜6Kš
ž˜Kšœ!Ÿ$˜EKšžœ˜Kšžœ
˜K˜—Kšžœ
˜K˜——…—Wr©