-- file Store.mesa
-- last modified by Sweet, February 25, 1981 1:49 PM
-- last modified by Satterthwaite, November 23, 1982 5:17 pm
DIRECTORY
Alloc: TYPE USING [Notifier],
Code: TYPE USING [fileindex, tailJumpOK, xtracting, xtractlex, xtractsei],
CodeDefs: TYPE USING [
Base, BoVarIndex, codeType, Lexeme, NullLex, StoreOptions,
VarComponent, VarIndex, VarNull],
ComData: TYPE USING [switches],
Counting: TYPE USING [VarVarAssignCounted],
Environment: TYPE USING [bitsPerWord],
FOpCodes: TYPE USING [qBLZL, qDESCB, qFREE, 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, PushLitVal,
PrevVar, WordAligned],
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, ListLength, NthSon, ReverseUpdateList, ScanList];
Store: PROGRAM
IMPORTS
CPtr: Code, MPtr: ComData, Counting, P5U, P5L, P5, Stack, SymbolOps, TreeOps
EXPORTS CodeDefs, P5, P5S =
BEGIN
OPEN CodeDefs, SymbolOps;
-- imported definitions
wordlength: CARDINAL = Environment.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.fileindex ← 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.