DIRECTORY
Alloc: TYPE USING [Notifier],
Code: TYPE USING [CodeNotImplemented, ZEROlexeme, warnStackOverflow],
CodeDefs:
TYPE
USING [
Base, codeType, JumpType, LabelCCIndex, Lexeme, NullLex, VarComponent, VarIndex],
FOpCodes:
TYPE
USING [
qAND, qBNDCK, qDADD, qDCMP, qDIS, qDSUB, qDUP, qEXDIS, qFCOMP, qLI,
qLINT, qLP, qNEG, qREC, qREC2, qUDCMP, qXOR],
Log: TYPE USING [Warning],
P5:
TYPE
USING [
Exp, FlowTree, GenTempLex, LogHeapFree, PushLex, PushRhs,
ReleaseTempLex, SAssign],
P5L:
TYPE
USING [
AllLoaded, ComponentForLex, CopyToTemp, EasilyLoadable, FieldOfVar,
LoadBoth, LoadComponent, LoadVar, MakeComponent, NormalizeExp,
NormalLex, OVarItem, ReusableCopies, TOSLex, VarAlignment, VarForLex],
P5U:
TYPE
USING [
InsertLabel, LabelAlloc, LongTreeAddress, Out0, Out1, OutJump,
PushLitVal, TreeLiteral],
Stack:
TYPE
USING [
Also, Decr, DeleteToMark, Dump, Mark, Off, On, ResetToMark, RoomFor,
TempStore, UnMark],
Symbols: TYPE USING [ISEIndex, ISENull],
Tree: TYPE USING [Base, Index, Link, NodeName, treeType],
TreeOps: TYPE USING [GetNode, ListLength, ScanList];
Abs:
PROC [node: Tree.Index]
RETURNS [Lexeme] =
BEGIN -- generate code for ABS
nw: [1..2];
real: BOOL;
poslabel: LabelCCIndex = P5U.LabelAlloc[];
donelabel: LabelCCIndex;
SELECT
TRUE
FROM
tb[node].attr1 => {nw ← 2; real ← TRUE};
tb[node].attr2 => {nw ← 2; real ← FALSE};
ENDCASE => {nw ← 1; real ← FALSE};
IF real
THEN
-- delete for strict IEEE floating point
BEGIN
IF ~Stack.RoomFor[3]
THEN {
Stack.Dump[];
IF CPtr.warnStackOverflow THEN Log.Warning[other--awfulCode--]};
P5.PushRhs[tb[node].son[1]];
P5U.PushLitVal[77777b];
P5U.Out0[qAND];
END
ELSE
IF nw = 2
THEN
BEGIN
var: VarComponent;
zero: VarComponent = [wSize: 2, space: const[d1: 0, d2: 0]];
IF real THEN Stack.Dump[];
Stack.Mark[];
var ← P5L.MakeComponent[P5L.VarForLex[P5.Exp[tb[node].son[1]]]];
var ← P5L.EasilyLoadable[var, load];
P5L.LoadComponent[var]; P5L.LoadComponent[zero];
P5U.Out0[--IF real THEN qFCOMP ELSE-- qDCMP];
P5U.PushLitVal[0];
P5U.OutJump[JumpGE, poslabel];
P5L.LoadComponent[zero]; P5L.LoadComponent[var];
P5U.Out0[--IF real THEN qFSUB ELSE-- qDSUB];
Stack.ResetToMark[];
P5U.OutJump[Jump, donelabel ← P5U.LabelAlloc[]];
P5U.InsertLabel[poslabel];
P5L.LoadComponent[var];
Stack.Also[n: 2, place: [none[]]];
Stack.UnMark[];
P5U.InsertLabel[donelabel];
END
ELSE
-- nw = 1
BEGIN
IF ~Stack.RoomFor[3]
THEN {
Stack.Dump[];
IF CPtr.warnStackOverflow THEN Log.Warning[other--awfulCode--]};
P5.PushRhs[tb[node].son[1]];
P5U.Out0[qDUP]; -- don't use Stack.Dup since Neg will clear info
P5U.PushLitVal[0];
P5U.OutJump[JumpGE, poslabel];
P5U.Out0[qNEG];
P5U.InsertLabel[poslabel];
END;
RETURN [P5L.TOSLex[nw]]
END;
IfExp:
PROC [node: Tree.Index]
RETURNS [l: Lexeme] =
BEGIN -- generates code for an IF expression
ilabel, elabel: LabelCCIndex;
t3: Tree.Link = tb[node].son[3];
t2: Tree.Link = tb[node].son[2];
nwords: CARDINAL;
tsei: ISEIndex ← ISENull;
bothConst: BOOL = P5U.TreeLiteral[t2] AND P5U.TreeLiteral[t3];
thenLong, elseLong: BOOL;
elabel ← P5U.LabelAlloc[];
Stack.Mark[];
P5.FlowTree[tb[node].son[1],
FALSE, elabel];
BEGIN
ENABLE P5.LogHeapFree => RESUME[FALSE, NullLex];
[nwords: nwords, long: thenLong, tsei: tsei] ← P5L.NormalizeExp[
P5L.VarForLex[P5.Exp[t2]], tsei, bothConst];
elseLong ← nwords > 2 AND P5U.LongTreeAddress[t3];
IF elseLong AND ~thenLong THEN P5U.Out0[FOpCodes.qLP];
Stack.ResetToMark[];
P5U.OutJump[Jump, ilabel ← P5U.LabelAlloc[]];
P5U.InsertLabel[elabel];
[] ← P5L.NormalizeExp[P5L.VarForLex[P5.Exp[t3]], tsei, bothConst];
Stack.UnMark[];
IF thenLong AND ~elseLong THEN {P5U.Out0[qLP]; elseLong ← TRUE};
P5U.InsertLabel[ilabel];
END;
IF tsei # ISENull THEN P5.ReleaseTempLex[[se[tsei]]];
l ← P5L.NormalLex[nwords, elseLong, bothConst]; -- either stack or bo with stack base
SELECT
TRUE
FROM
(nwords <= 2) => Stack.Also[n: nwords, place: [none[]]];
bothConst => Stack.Also[n: 1, place: [none[]]];
ENDCASE => Stack.Also[n: IF elseLong THEN 2 ELSE 1, place: [none[]]];
END;