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;
imported definitions
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
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 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.