Expression.mesa
last modified by Sweet, September 18, 1980 7:53 PM
last modified by Satterthwaite, April 18, 1986 2:52:51 pm PST
DIRECTORY
Alloc: TYPE USING [Notifier],
Basics: TYPE USING [BITAND, BITSHIFT],
BcdDefs: TYPE USING [Link],
Code: TYPE USING [
caseCVState, CodeNotImplemented, mwCaseCV, tailJumpOK, warnStackOverflow,
xtracting, xtractlex],
CodeDefs: TYPE USING [
Base, BYTE, codeType, Lexeme, NullLex, OpWordCount, StoreOptions,
VarComponent, VarIndex, wordlength],
ComData: TYPE USING [bodyIndex, switches],
FOpCodes: TYPE USING [
qADD, qAND, qBNDCK, qDADD, qDB, qDBS, qDDIV, qDIS, qDMOD, qDMUL,
qDSUB, qDUDIV, qDUMOD, qEXDIS, qFADD, qFDIV, qFF, qFLOAT, qFMUL, qFSC,
qFSUB, qLI, qMUL, qNEG, qNILCK, qNILCKL, qREC, qSDIV, qSUB, qUDIV],
Literals: TYPE USING [Base, LTIndex, ltType],
LiteralOps: TYPE USING [WordIndex],
Log: TYPE USING [Warning],
OpCodeParams: TYPE USING [GlobalHB, LocalHB],
P5: TYPE USING [
All, BindStmtExp, CaseStmtExp, Construct, FlowExp, GenTempLex,
GetCanonicalType, ListCons, LogHeapFree, MoveToCodeWord, NarrowExp, New, P5Error,
PushLex, RowCons, TTAssign, WriteCodeWord],
P5L: TYPE USING [
AddrForVar, AdjustComponent, ComponentForLex, ComponentForSE, CopyLex,
CopyToTemp, EasilyLoadable, FieldOfVarOnly, GenVarItem, LoadBoth,
LoadComponent, LoadVar, MakeComponent, OVarItem, TOSComponent, TOSLex,
VarAlignment, VarForLex, Words],
P5S: TYPE USING [
AssignExp, BodyInit, CallExp, Create, DIndex, ErrExp, ExtractExp, ForkExp, Index,
JoinExp, ProcCheck, SeqIndex, SigExp, StartExp, StringInit, SubstExp, SysErrExp],
P5U: TYPE USING [
OperandType, Out0, Out1, PushLitVal, RecordConstant,
TreeLiteral, TreeLiteralValue, WordsForOperand, WordsForSei],
PrincOps: TYPE USING [EPRange, wordsPerPage],
Real: TYPE USING [Extended, RealToExtended],
Stack: TYPE USING [Dump, RoomFor],
SymbolOps: TYPE USING [FnField, NormalType, UnderType, WordsForType, XferMode],
Symbols: TYPE USING [
Base, BitAddress, bodyType, CBTIndex, CBTNull, ContextLevel,
CSEIndex, ISEIndex, lZ, RecordSEIndex, seType],
Tree: TYPE USING [Base, Index, Link, Null, treeType],
TreeOps: TYPE USING [GetNode, GetSe, NthSon, OpName];
Expression: PROGRAM
IMPORTS CPtr: Code, MPtr: ComData,
Basics, LiteralOps, Log, P5, P5L, P5S, P5U, Real, Stack, SymbolOps, TreeOps
EXPORTS CodeDefs, P5 =
BEGIN
OPEN FOpCodes, CodeDefs;
imported definitions
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[qREC];
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;
mergecons =>
BEGIN
psei: CSEIndex = tb[node].info;
tlex: se Lexeme = P5.GenTempLex[SymbolOps.WordsForType[psei]];
P5.TTAssign[[symbol[tlex.lexsei]], tb[node].son[1]];
WITH tb[node].son[2] SELECT FROM
subtree =>
BEGIN
node2: Tree.Index = index;
SELECT tb[node2].name FROM
construct => P5.Construct[[symbol[tlex.lexsei]], node2, ExprOptions];
rowcons => [] ← P5.RowCons[[symbol[tlex.lexsei]], node2, ExprOptions];
ENDCASE => ERROR;
END;
ENDCASE => ERROR;
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
PushRhs[tb[node].son[1]]; PushRhs[tb[node].son[2]];
P5U.Out0[qBNDCK];
l ← P5L.TOSLex[1];
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, INTEGER] =
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 => {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 => {nw ← 2; op ← qFSUB};
tb[node].attr2 => {nw ← 2; op ← qDSUB};
ENDCASE => {nw ← 1; op ← qSUB};
IF ~Stack.RoomFor[2*nw] THEN {
Stack.Dump[];
IF CPtr.warnStackOverflow THEN Log.Warning[other--awfulCode--]};
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
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 => {nw ← 2; op ← qFMUL};
tb[node].attr2 => {nw ← 2; op ← qDMUL};
ENDCASE => {nw ← 1; op ← qMUL};
IF op = qFMUL 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;
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 => {nw ← 2; op ← qFDIV};
tb[node].attr2 => {nw ← 2; op ← IF signed THEN qDDIV ELSE qDUDIV};
ENDCASE => {nw ← 1; op ← IF signed THEN qSDIV ELSE qUDIV};
IF ~Stack.RoomFor[2*nw] THEN {
Stack.Dump[];
IF CPtr.warnStackOverflow THEN Log.Warning[other--awfulCode--]};
PushRhs[tb[node].son[1]];
IF op = qFDIV 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;
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;
rand2lit: BOOL;
powerof2: BOOL ← FALSE;
rand2val: CARDINAL;
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, rand2val] ← ConstOperand[tb[node].son[2]];
IF rand2lit AND rand2val > 0 THEN
BEGIN
[powerof2, ] ← Log2[rand2val];
IF powerof2 THEN
BEGIN
P5U.PushLitVal[rand2val-1]; P5U.Out0[qAND];
RETURN [P5L.TOSLex[1]];
END;
END;
END;
IF double THEN
BEGIN
IF ~signed THEN
BEGIN
yes: BOOL;
[yes, rand2val] ← SmallConst[tb[node].son[2]];
IF yes THEN [powerof2,] ← Log2[rand2val] ELSE powerof2 ← FALSE;
END;
IF powerof2 THEN
BEGIN
P5U.Out0[qDIS];
P5U.PushLitVal[rand2val-1]; P5U.Out0[qAND];
P5U.PushLitVal[0];
END
ELSE {PushRhs[tb[node].son[2]]; P5U.Out0[IF signed THEN qDMOD ELSE qDUMOD]};
RETURN [P5L.TOSLex[2]];
END;
PushRhs[tb[node].son[2]];
P5U.Out0[IF signed THEN qSDIV ELSE qUDIV];
P5U.Out0[qREC];
P5U.Out0[qEXDIS];
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 P5U.TreeLiteral[t2] THEN [powerof2, log] ← Log2[P5U.TreeLiteralValue[t2]];
RETURN [IF ~tb[node].attr3 AND powerof2 AND log = bSize
THEN tb[node].son[1]
ELSE t]
END;
END;
Float: PROC [node: Tree.Index] RETURNS [Lexeme] =
BEGIN
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
relocs need not apply
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
relocs get converted to addr
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
generate code for "exp.field"
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];
if we point to a type, it fills a number of full words
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 qNILCKL ELSE 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];
WITH bb[bti] SELECT FROM
Inner =>
BEGIN -- could happen with pointer to procedure frame
IF nilCheck THEN P5U.Out0[qNILCK];
P5U.Out1[qLI, frameOffset];
P5U.Out0[qADD];
END;
Outer => P5U.Out1[qDBS, entryIndex];
ENDCASE;
END;
signal, error =>
BEGIN
lnk: BcdDefs.Link = seb[sei].idValue;
IF long THEN SIGNAL CPtr.CodeNotImplemented;
PushRhs[t];
P5U.Out1[qDBS, (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[qFF];
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];
lti: LTIndex = LiteralOps.WordIndex[NARROW[s, Tree.Link.literal].index];
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
ELSE IF minWords <= 1 AND P5U.TreeLiteral[t] THEN
RETURN [P5U.TreeLiteralValue[t] = 0];
RETURN [FALSE]
END;
SmallConst: PUBLIC PROC [t: Tree.Link] RETURNS [BOOL, CARDINAL] =
BEGIN
IF TreeOps.OpName[t] = mwconst THEN
BEGIN
s: Tree.Link = TreeOps.NthSon[t, 1];
lti: LTIndex = LiteralOps.WordIndex[NARROW[s, Tree.Link.literal].index];
WITH ll: ltb[lti] SELECT FROM
long =>
SELECT ll.length FROM
2 => IF ll.value[0] = 0 THEN RETURN [TRUE, ll.value[1]];
ENDCASE;
ENDCASE;
END;
RETURN [FALSE, 0]
END;
RealConst: 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[qDB, 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[qDB, tb[node].info]; -- no sense making a VarItem to push
RETURN [P5L.TOSLex[1]]
END;
END.