
<<file Store.mesa>>
<<last modified by Sweet, 14-Dec-81 10:38:19>>
<<last modified by Satterthwaite, December 2, 1985 9:34:17 am PST>>

DIRECTORY
Alloc: TYPE USING [Notifier],
Code: TYPE USING [fileLoc, tailJumpOK, xtracting, xtractlex, xtractsei],
CodeDefs: TYPE USING [
Base, BoVarIndex, codeType, Lexeme, NullLex, StoreOptions,
VarComponent, VarIndex, VarNull, wordlength],
Counting: TYPE USING [VarVarAssignCounted],
FOpCodes: TYPE USING [qBLZL, qDB, qFF, qLP, qSL],
P5: TYPE USING [
All, Construct, Exp, GenTempLex, LogHeapFree, MultiZero, PushLProcDesc,
RowCons, VariantConstruct],
P5L: TYPE 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: TYPE USING [],
P5U: TYPE USING [
BitsForOperand, LongTreeAddress, NextVar, OperandType, Out0, Out1,
PrevVar, PushLitVal, WordAligned],
SourceMap: TYPE USING [Up],
Stack: TYPE USING [Clear, Dup, Pop],
SymbolOps: TYPE USING [FirstCtxSe, FnField, NextSe, RecField],
Symbols: TYPE USING [
Base, BitAddress, bodyType, CBTIndex, ContextLevel, ISEIndex, ISENull, lG,
RecordSEIndex, seType],
Tree: TYPE USING [Base, Index, Link, Null, treeType],
TreeOps: TYPE USING [GetNode, OpName, NthSon, ReverseUpdateList, ScanList];

Store: PROGRAM
IMPORTS
CPtr: Code, Counting, P5U, P5L, P5, Stack, SourceMap, SymbolOps, TreeOps
EXPORTS CodeDefs, P5, P5S =
BEGIN
OPEN CodeDefs, SymbolOps;

<<imported definitions>>

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 ~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 ~ManySafens[t2, nbits] THEN
BEGIN
l _ P5.RowCons[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.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 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.counted _ options.expr _ 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 => noAll _ FALSE;
cast, pad => TreeOps.ScanList[TreeOps.NthSon[t, 1], CountSafens];
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.qFF];
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.qDB, body.entryIndex];
P5U.Out1[FOpCodes.qSL, body.frameOffset];
END;
ENDCASE;
END;

END.

