DIRECTORY
Alloc USING [Notifier],
Basics USING [bitsPerWord],
Code USING [fileLoc, tailJumpOK, xtracting, xtractlex, xtractsei],
CodeDefs USING [Base, BoVarIndex, codeType, Lexeme, NullLex, StoreOptions, VarComponent, VarIndex, VarNull],
ComData USING [switches],
Counting USING [VarVarAssignCounted],
FOpCodes USING [qBLZL, qDESCB, qFREE, qLP, qSL],
P5 USING [All, Construct, Exp, GenTempLex, LogHeapFree, MultiZero, PushLProcDesc, RowCons, VariantConstruct],
P5L USING [AdjustComponent, ComponentForSE, CopyToTemp, EasilyLoadable, EasyToLoad, FieldOfComponent, FieldOfVar, GenVarItem, LoadAddress, LoadComponent, LoadVar, MakeBo, ModComponent, OVarItem, ReleaseVarItem, ReusableCopies, StoreComponent, TOSAddrLex, TOSComponent, TOSLex, VarForLex, VarVarAssign, Words],
P5S USING [],
P5U USING [BitsForOperand, LongTreeAddress, NextVar, OperandType, Out0, Out1, PushLitVal, PrevVar, WordAligned],
SourceMap USING [Up],
Stack USING [Clear, Dup, Pop],
SymbolOps USING [FirstCtxSe, FnField, NextSe, RecField],
Symbols USING [Base, BitAddress, bodyType, CBTIndex, ContextLevel, ISEIndex, ISENull, lG, RecordSEIndex, seType],
Tree USING [Base, Index, Link, Null, treeType],
TreeOps
USING [GetNode, OpName, ListLength, NthSon, ReverseUpdateList, ScanList];
Store:
PROGRAM
IMPORTS CPtr: Code, MPtr: ComData, Counting, P5U, P5L, P5, SourceMap, Stack, SymbolOps, TreeOps
EXPORTS CodeDefs, P5, P5S = BEGIN OPEN CodeDefs, SymbolOps;
imported definitions
wordlength: CARDINAL = Basics.bitsPerWord;
BitAddress: TYPE = Symbols.BitAddress;
CBTIndex: TYPE = Symbols.CBTIndex;
ISEIndex: TYPE = Symbols.ISEIndex;
ISENull: ISEIndex = Symbols.ISENull;
lG: Symbols.ContextLevel = Symbols.lG;
RecordSEIndex: TYPE = Symbols.RecordSEIndex;
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)
StoreNotify:
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];
END;
Assign:
PUBLIC
PROC [node: Tree.Index] =
BEGIN -- generates code for assignment statement (RRA)
[] ← ComAssign[
t1: tb[node].son[1], t2: tb[node].son[2],
options: [expr:
FALSE, init: tb[node].attr1,
counted: tb[node].attr2, composite: tb[node].attr3]];
END;
AssignExp:
PUBLIC
PROC [node: Tree.Index]
RETURNS [l: Lexeme] =
BEGIN -- generates code for assignment expression (RRA)
l ← ComAssign[
t1: tb[node].son[1], t2: tb[node].son[2],
options: [expr:
TRUE, init: tb[node].attr1,
counted: tb[node].attr2, composite: tb[node].attr3]];
RETURN
END;
ComAssign:
PROC [t1, t2: Tree.Link, options: StoreOptions]
RETURNS [l: Lexeme] =
BEGIN -- can support counted assignments (RRA)
nbits: CARDINAL;
longAddressLhs: BOOL ← P5U.LongTreeAddress[t1];
aligned: BOOL ← FALSE;
lv, rv: VarIndex;
l ← NullLex;
nbits ← P5U.BitsForOperand[t1];
DO
-- until we get to something interesting
SELECT TreeOps.OpName[t2]
FROM
pad =>
BEGIN
t2 ← TreeOps.NthSon[t2, 1];
aligned ← TRUE; nbits ← P5U.BitsForOperand[t2];
END;
cast, safen => t2 ← TreeOps.NthSon[t2, 1];
ENDCASE => EXIT;
ENDLOOP;
SELECT TreeOps.OpName[t2]
FROM
construct =>
IF options.counted
OR ((
-- some heuristics
~longAddressLhs OR nbits > 20*wordlength OR
TreeOps.ListLength[TreeOps.NthSon[t2, 2]] <= 4) AND ~ManySafens[t2, nbits]) THEN
BEGIN
l ← P5.Construct[t1, TreeOps.GetNode[t2], options];
RETURN
END
ELSE
IF nbits > 2*wordlength
THEN
BEGIN --otherwise fall through into building on stack
tlex: Lexeme.se = P5.GenTempLex[(nbits+wordlength-1) / wordlength];
[] ← P5.Construct[[symbol[tlex.lexsei]], TreeOps.GetNode[t2], TempOptions[options]];
t2 ← [symbol[tlex.lexsei]];
END;
union => IF ~options.expr THEN {P5.VariantConstruct[t1, t2, options]; RETURN};
rowcons =>
IF options.counted
OR (~longAddressLhs
AND ~ManySafens[t2, nbits])
THEN
BEGIN
l ← P5.RowCons[t1, TreeOps.GetNode[t2], options];
RETURN
END
ELSE
IF nbits > 2*wordlength
THEN
BEGIN
tlex: Lexeme.se = P5.GenTempLex[(nbits+wordlength-1) / wordlength];
[] ← P5.RowCons[[symbol[tlex.lexsei]], TreeOps.GetNode[t2], TempOptions[options]];
t2 ← [symbol[tlex.lexsei]];
END;
all =>
BEGIN
l ← P5.All[t1, TreeOps.GetNode[t2], options];
RETURN
END;
mwconst =>
IF MPtr.switches['m]
AND P5.MultiZero[t2]
AND (options.init
OR ~options.counted)
THEN
BEGIN
nw: CARDINAL = P5L.Words[w: 0, b: nbits];
lv ← P5L.VarForLex[P5.Exp[t1]];
IF ~P5L.LoadAddress[lv] THEN P5U.Out0[FOpCodes.qLP];
P5U.PushLitVal[nw];
P5U.Out0[FOpCodes.qBLZL];
IF options.expr THEN l ← P5L.TOSAddrLex[nw, TRUE]
ELSE Stack.Pop[2];
RETURN
END;
ENDCASE;
rv ← P5L.VarForLex[P5.Exp[t2]];
IF nbits <= 2*wordlength
AND ~ProbablyDumpStack[t1]
THEN {
P5L.LoadVar[rv];
rv ← P5L.VarForLex[P5L.TOSLex[(nbits+ wordlength-1)/wordlength]]};
lv ← P5L.VarForLex[P5.Exp[t1]];
IF aligned
THEN
P5L.FieldOfVar[r: lv, wSize: nbits/wordlength, bSize: nbits MOD wordlength];
IF options.counted
THEN
l ← Counting.VarVarAssignCounted[lv, rv, options, P5U.OperandType[t1]]
ELSE l ← P5L.VarVarAssign[lv, rv, options.expr];
RETURN
END;
TempOptions:
PROC [options: StoreOptions]
RETURNS [StoreOptions] = {
options.init ← TRUE; options.expr ← options.counted ← FALSE;
RETURN [options]};
ManySafens:
PROC [t: Tree.Link, nbits:
CARDINAL]
RETURNS [
BOOL] =
BEGIN
nFields, nSafens: CARDINAL ← 0;
noAll: BOOL ← TRUE;
CountSafens:
PROC [t: Tree.Link] =
BEGIN
SELECT TreeOps.OpName[t]
FROM
rowcons, construct, union => TreeOps.ScanList[TreeOps.NthSon[t, 2], CountSafens];
all => BEGIN noAll ← FALSE; CountSafens[TreeOps.NthSon[t, 1]] END;
cast, pad => CountSafens[TreeOps.NthSon[t, 1]];
safen => BEGIN nSafens ← nSafens+1; nFields ← nFields+1 END;
ENDCASE => nFields ← nFields+1;
END;
CountSafens[t];
RETURN [
IF nbits<16*wordlength
THEN (nSafens >= 2)
ELSE (noAll AND 2*nSafens > nFields)]
END;
Extract:
PUBLIC
PROC [node: Tree.Index] =
BEGIN
SExtract[node];
Stack.Clear[];
END;
SExtract:
PROC [node: Tree.Index] =
BEGIN
t1: Tree.Link = tb[node].son[1];
tsei: RecordSEIndex = LOOPHOLE[P5U.OperandType[t1]];
r: VarIndex;
transferrec: BOOL ← FALSE;
r ← P5L.VarForLex[P5.Exp[tb[node].son[2]
! P5.LogHeapFree =>
IF calltree = tb[node].son[2]
THEN
{transferrec ← TRUE; RESUME[TRUE, NullLex]}]];
ExtractFrom[t1, tsei, r, transferrec];
END;
ExtractExp:
PUBLIC
PROC [node: Tree.Index]
RETURNS [Lexeme] =
BEGIN
t1: Tree.Link = tb[node].son[1];
tsei: RecordSEIndex = LOOPHOLE[P5U.OperandType[t1]];
r, rret: VarIndex;
r ← P5L.VarForLex[P5.Exp[tb[node].son[2]
! P5.LogHeapFree => IF calltree = tb[node].son[2] THEN RESUME[FALSE, NullLex]]];
[first: r, next: rret] ← P5L.ReusableCopies[r, store, FALSE];
ExtractFrom[t1, tsei, r, FALSE];
RETURN [[bdo[rret]]]
END;
ExtractFrom:
PUBLIC
PROC [
t1: Tree.Link, tsei: RecordSEIndex, r: VarIndex, transferrec: BOOL] =
BEGIN
saveExtractState:
RECORD [
xtracting:
BOOL, xtractlex: Lexeme, xtractsei: Symbols.ISEIndex] =
[CPtr.xtracting, CPtr.xtractlex, CPtr.xtractsei];
fa:
PROC [ISEIndex]
RETURNS [BitAddress,
CARDINAL] =
IF seb[tsei].argument THEN FnField ELSE RecField;
startsei: ISEIndex = FirstCtxSe[seb[tsei].fieldCtx];
sei: ISEIndex ← startsei;
isei: ISEIndex ← startsei;
node: Tree.Index = TreeOps.GetNode[t1];
soncount: CARDINAL ← 0;
tbase, toffset: VarComponent;
onStack, useDup: BOOL ← FALSE;
totalBits: CARDINAL;
trashOnStack: CARDINAL ← 0;
XCount:
PROC [t: Tree.Link] =
BEGIN
IF t # Tree.Null THEN soncount ← soncount+1;
END;
ExtractItem:
PROC [t: Tree.Link]
RETURNS [v: Tree.Link] =
BEGIN
posn: BitAddress;
size: CARDINAL;
v ← t;
[posn, size] ← fa[sei];
IF t # Tree.Null
THEN
BEGIN
subNode: Tree.Index = TreeOps.GetNode[t];
rr: VarIndex;
offset, base: VarComponent;
soncount ← soncount-1;
IF onStack THEN offset ← toffset -- original record on stack
ELSE
BEGIN
IF useDup
THEN
BEGIN
IF (transferrec OR soncount > 0) THEN Stack.Dup[load: FALSE];
base ← P5L.TOSComponent[1];
END
ELSE base ← tbase;
offset ← toffset;
END;
P5L.FieldOfComponent[
var: @offset, wd: posn.wd, bd: posn.bd,
wSize: size/wordlength, bSize: size MOD wordlength];
IF fa # FnField
AND totalBits <= wordlength
THEN
P5L.AdjustComponent[var: @offset, rSei: tsei, fSei: sei, tBits: totalBits];
IF onStack THEN rr ← P5L.OVarItem[offset]
ELSE
BEGIN
rr ← P5L.GenVarItem[bo];
cb[rr] ← [body: bo[base: base, offset: offset]];
END;
CPtr.xtractlex ← [bdo[rr]];
CPtr.xtractsei ← sei;
SELECT tb[subNode].name
FROM
assign => Assign[subNode];
extract => SExtract[subNode];
ENDCASE => ERROR;
END
ELSE IF onStack THEN Stack.Pop[size/wordlength];
sei ← P5U.PrevVar[startsei, sei];
RETURN
END; -- of ExtractItem
xlist: Tree.Link ← tb[node].son[1];
UNTIL (isei ← NextSe[sei]) = ISENull
DO
isei ← P5U.NextVar[isei];
IF isei = ISENull THEN EXIT;
sei ← isei;
ENDLOOP;
WITH cc: cb[r]
SELECT
FROM
o =>
WITH vv: cc.var
SELECT
FROM
stack =>
IF P5U.WordAligned[tsei]
THEN
BEGIN
trashOnStack ← vv.wd;
vv.wd ← 0;
toffset ← cc.var;
IF trashOnStack # 0
THEN
P5L.ModComponent[var: @toffset, wd: trashOnStack];
P5L.ReleaseVarItem[r];
onStack ← TRUE;
END
ELSE
BEGIN -- copy whole thing to temp
var: VarComponent ← P5L.CopyToTemp[r].var;
r ← P5L.OVarItem[var];
END;
ENDCASE;
ENDCASE;
IF ~onStack
THEN
BEGIN
bor: BoVarIndex ← P5L.MakeBo[r];
IF bor = VarNull
THEN
-- not addressable
BEGIN -- r was not freed in this case
var: VarComponent ← P5L.CopyToTemp[r].var;
r ← P5L.OVarItem[var];
bor ← P5L.MakeBo[r]; -- it will work this time
END;
tbase ← cb[bor].base; toffset ← cb[bor].offset;
P5L.ReleaseVarItem[bor];
IF tbase.wSize > 1 THEN tbase ← P5L.EasilyLoadable[tbase, store]
ELSE
IF ~P5L.EasyToLoad[tbase, store]
THEN
BEGIN
P5L.LoadComponent[tbase];
useDup ← TRUE;
END;
END;
totalBits ← toffset.wSize * wordlength + toffset.bSize;
TreeOps.ScanList[xlist, XCount];
IF soncount = 0
THEN
BEGIN
IF onStack
THEN
trashOnStack ← trashOnStack + (totalBits+(wordlength-1))/wordlength;
END
ELSE
BEGIN
CPtr.xtracting ← TRUE;
tb[node].son[1] ← TreeOps.ReverseUpdateList[xlist, ExtractItem];
END;
IF transferrec
THEN
BEGIN
IF ~useDup THEN P5L.LoadComponent[tbase];
P5U.Out0[FOpCodes.qFREE];
END;
THROUGH [0..trashOnStack) DO Stack.Pop[] ENDLOOP;
[CPtr.xtracting, CPtr.xtractlex, CPtr.xtractsei] ← saveExtractState;
END;
ProbablyDumpStack:
PUBLIC
PROC [t: Tree.Link]
RETURNS [
BOOL] =
BEGIN -- only a hint
node: Tree.Index;
WITH t
SELECT
FROM
subtree => node ← index;
ENDCASE => RETURN [FALSE];
RETURN [
SELECT tb[node].name
FROM
loophole, pad, chop, uparrow, dot, dollar, not =>
ProbablyDumpStack[tb[node].son[1]],
and, or, plus, minus, times, div, mod,
index, dindex, seqindex =>
ProbablyDumpStack[tb[node].son[2]]
OR
ProbablyDumpStack[tb[node].son[1]],
ifx =>
ProbablyDumpStack[tb[node].son[3]]
OR
ProbablyDumpStack[tb[node].son[2]] OR
ProbablyDumpStack[tb[node].son[1]],
IN [relE..notin] =>
ProbablyDumpStack[tb[node].son[2]]
OR
ProbablyDumpStack[tb[node].son[1]],
IN [callx..joinx] => TRUE,
ENDCASE => FALSE]
END;
ReleaseLex:
PROC [l: Lexeme] =
BEGIN
WITH l
SELECT
FROM
bdo => P5L.ReleaseVarItem[lexbdoi];
ENDCASE;
END;
SAssign:
PUBLIC
PROC [sei: ISEIndex] =
BEGIN -- assigns to a simple variable from the stack
var: VarComponent = P5L.ComponentForSE[sei];
P5L.StoreComponent[var];
END;
SLAssign:
PUBLIC
PROC [sei: ISEIndex, l: Lexeme, exp:
BOOL, nwords:
CARDINAL] =
BEGIN -- obsolete?
TLLAssign[Tree.Null, [se[sei]], l, exp, nwords*wordlength];
END;
TTAssign:
PUBLIC
PROC [t1, t2: Tree.Link] =
BEGIN -- not called for counted assignments (RRA)
[] ← ComAssign[t1: t1, t2: t2, options: [expr: FALSE]];
END;
TLLAssign:
PUBLIC
PROC [
leftson: Tree.Link, leftlex, l: Lexeme, exp: BOOL, nbits: CARDINAL] =
BEGIN -- obsolete?
rightr, leftr: VarIndex;
rightr ← P5L.VarForLex[l];
IF leftson # Tree.Null THEN leftlex ← P5.Exp[leftson];
leftr ← P5L.VarForLex[leftlex];
[] ← P5L.VarVarAssign[leftr, rightr, exp];
END;
BodyInit:
PUBLIC
PROC [node: Tree.Index]
RETURNS [Lexeme] =
BEGIN -- assigns proc. desc for proc. variable
bti: CBTIndex = tb[node].info;
CPtr.fileLoc ← SourceMap.Up[bb[bti].sourceIndex];
P5.PushLProcDesc[bti];
RETURN [P5L.TOSLex[1]]
END;
ProcInit:
PUBLIC
PROC [node: Tree.Index] =
BEGIN
bti: CBTIndex = tb[node].info;
WITH body: bb[bti]
SELECT
FROM
Inner =>
BEGIN
CPtr.tailJumpOK ← FALSE; -- conservative
P5U.Out1[FOpCodes.qDESCB, body.entryIndex];
P5U.Out1[FOpCodes.qSL, body.frameOffset];
END;
ENDCASE;
END;
END.