-- Store.mesa, modified by Sweet, January 9, 1980 9:34 PM
DIRECTORY
AltoDefs: FROM "altodefs" USING [BYTE, charlength, wordlength],
Code: FROM "code" USING [fileindex, xtracting, xtractlex, xtractsei],
CodeDefs: FROM "codedefs" USING [
BoVarIndex, Lexeme, NullLex, VarComponent, VarIndex, VarNull],
FOpCodes: FROM "fopcodes" USING [qFREE, qLI, qPSD, qSL],
Literals: FROM "literals" USING [ltType, MSTIndex, stType],
P5: FROM "p5" USING [
All, AllExp, Construct, ConstructExp, Exp, FreeTempSei, GenStringBodyLex,
LogHeapFree, PushLProcDesc, PushNonnestedProcDesc, RowCons, RowConsExp,
VariantConstruct],
P5L: FROM "p5l" USING [
AdjustComponent, ComponentForSE, CopyToTemp, EasilyLoadable, EasyToLoad,
FieldOfComponent, FieldOfVar, GenVarItem, LoadAddress, LoadComponent,
MakeBo, ModComponent, OVarItem, ReleaseVarItem, StoreComponent,
TOSComponent, TOSLex, VarForLex, VarVarAssign],
P5S: FROM "p5s",
P5U: FROM "p5u" USING [
BitsForOperand, FieldAddress, LongTreeAddress, NextVar, OperandType, Out0,
Out1, PrevVar, PushLitVal, TreeLiteralValue, WordAligned],
Stack: FROM "stack" USING [Dup, Pop],
SymbolOps: FROM "symbolops" USING [FnField, NextSe],
Symbols: FROM "symbols" USING [
BitAddress, bodyType, BTIndex, CBTIndex, ContextLevel, CSEIndex, CTXIndex,
ctxType, HTIndex, ISEIndex, ISENull, lG, lZ, RecordSEIndex, SEIndex,
seType, TypeClass],
Table: FROM "table" USING [Base, Notifier],
Tree: FROM "tree" USING [Index, Link, Null, treeType],
TreeOps: FROM "treeops" USING [ReverseUpdateList, ScanList, TestTree];
Store: PROGRAM
IMPORTS CPtr: Code, P5U, P5L, P5, Stack, SymbolOps, TreeOps
EXPORTS CodeDefs, P5, P5S
SHARES Literals =
BEGIN
OPEN CodeDefs, SymbolOps;
-- imported definitions
BYTE: TYPE = AltoDefs.BYTE;
wordlength: CARDINAL = AltoDefs.wordlength;
charlength: CARDINAL = AltoDefs.charlength;
BitAddress: TYPE = Symbols.BitAddress;
BTIndex: TYPE = Symbols.BTIndex;
CBTIndex: TYPE = Symbols.CBTIndex;
ContextLevel: TYPE = Symbols.ContextLevel;
CSEIndex: TYPE = Symbols.CSEIndex;
CTXIndex: TYPE = Symbols.CTXIndex;
HTIndex: TYPE = Symbols.HTIndex;
ISEIndex: TYPE = Symbols.ISEIndex;
ISENull: ISEIndex = Symbols.ISENull;
lZ: ContextLevel = Symbols.lZ;
lG: ContextLevel = Symbols.lG;
RecordSEIndex: TYPE = Symbols.RecordSEIndex;
SEIndex: TYPE = Symbols.SEIndex;
TypeClass: TYPE = Symbols.TypeClass;
MSTIndex: TYPE = Literals.MSTIndex;
tb: Table.Base; -- tree base (local copy)
seb: Table.Base; -- semantic entry base (local copy)
ctxb: Table.Base; -- context entry base (local copy)
bb: Table.Base; -- body entry base (local copy)
cb: Table.Base; -- code base (local copy)
stb: Table.Base; -- string base (local copy)
ltb: Table.Base; -- literal base (local copy)
StoreNotify: PUBLIC Table.Notifier =
BEGIN -- called by allocator whenever table area is repacked
seb ← base[Symbols.seType];
ctxb ← base[Symbols.ctxType];
bb ← base[Symbols.bodyType];
stb ← base[Literals.stType];
tb ← base[Tree.treeType];
cb ← LOOPHOLE[tb];
ltb ← base[Literals.ltType];
RETURN
END;
Extract: PUBLIC PROCEDURE [node: Tree.Index] =
BEGIN
t1: Tree.Link = tb[node].son[1];
tsei: RecordSEIndex ← LOOPHOLE[P5U.OperandType[t1]];
r: VarIndex;
transferrec: BOOLEAN ← FALSE;
r ← P5L.VarForLex[P5.Exp[tb[node].son[2]
!P5.LogHeapFree =>
IF calltree = tb[node].son[2] THEN
BEGIN transferrec ← TRUE; RESUME[TRUE, NullLex] END]];
ExtractFrom[t1, tsei, r, transferrec];
RETURN
END;
ExtractFrom: PUBLIC PROCEDURE [
t1: Tree.Link, tsei: RecordSEIndex, r: VarIndex, transferrec: BOOLEAN] =
BEGIN
saveExtractState: RECORD [
xtracting: BOOLEAN, xtractlex: Lexeme, xtractsei: Symbols.ISEIndex] ←
[CPtr.xtracting, CPtr.xtractlex, CPtr.xtractsei];
fa: PROCEDURE[ISEIndex] RETURNS [BitAddress, CARDINAL] ←
IF seb[tsei].argument THEN FnField ELSE P5U.FieldAddress;
startsei: ISEIndex ← ctxb[seb[tsei].fieldCtx].seList;
sei: ISEIndex ← startsei;
isei: ISEIndex ← startsei;
soncount: CARDINAL ← 0;
tbase, toffset: VarComponent;
onStack, useDup: BOOLEAN ← FALSE;
xlist: Tree.Link;
node: Tree.Index;
totalBits: CARDINAL;
trashOnStack: CARDINAL ← 0;
xcount: PROCEDURE [t: Tree.Link] =
BEGIN
IF t # Tree.Null THEN
soncount ← soncount+1;
RETURN
END;
sextract: PROCEDURE [t: Tree.Link] RETURNS [v: Tree.Link] =
BEGIN
posn: BitAddress;
size: CARDINAL;
rr: VarIndex;
offset, base: VarComponent;
v ← t;
[posn, size] ← fa[sei];
IF t # Tree.Null THEN
BEGIN
soncount ← soncount-1;
IF onStack THEN
BEGIN
offset ← toffset; -- original record on stack
END
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;
WITH t SELECT FROM
subtree =>
BEGIN
node: Tree.Index = index;
SELECT tb[node].name FROM
assign => Assign[node];
extract => Extract[node];
ENDCASE => ERROR;
END;
ENDCASE => ERROR;
END
ELSE IF onStack THEN Stack.Pop[size/wordlength];
sei ← P5U.PrevVar[startsei, sei];
RETURN
END; -- of sextract
WITH t1 SELECT FROM
subtree =>
BEGIN
node ← index;
xlist ← tb[node].son[1];
END;
ENDCASE => ERROR;
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, sextract];
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;
RETURN
END;
SAssign: PUBLIC PROCEDURE [sei: ISEIndex] =
BEGIN -- assigns to a simple variable from the stack
var: VarComponent = P5L.ComponentForSE[sei];
P5L.StoreComponent[var];
RETURN
END;
Assign: PUBLIC PROCEDURE [node: Tree.Index] =
BEGIN -- generates code for assignment statement
IF tb[node].attr1 AND TreeOps.TestTree[tb[node].son[2], union] THEN
BEGIN
P5.VariantConstruct[node];
RETURN
END;
[] ← ComAssign[tb[node].son[1], tb[node].son[2], FALSE];
RETURN
END;
AssignExp: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [l: Lexeme] =
BEGIN -- generates code for assignment expression
l ← ComAssign[tb[node].son[1], tb[node].son[2], TRUE];
END;
TTAssign: PUBLIC PROCEDURE [t1, t2: Tree.Link] =
BEGIN
[] ← ComAssign[t1, t2, FALSE];
END;
ComAssign: PROCEDURE [t1,t2: Tree.Link, isexp: BOOLEAN] RETURNS [l: Lexeme] =
BEGIN
nbits: CARDINAL;
node: Tree.Index;
longAddressLhs: BOOLEAN ← P5U.LongTreeAddress[t1];
aligned: BOOLEAN ← FALSE;
lv, rv: VarIndex;
l ← NullLex;
nbits ← P5U.BitsForOperand[t1];
IF t2 # Tree.Null THEN WITH t2 SELECT FROM
subtree =>
BEGIN
node ← index;
SELECT tb[node].name FROM
pad =>
BEGIN
t2 ← tb[node].son[1];
nbits ← P5U.BitsForOperand[t2];
aligned ← TRUE;
END;
ENDCASE;
END;
ENDCASE;
IF t2 # Tree.Null THEN
WITH t2 SELECT FROM
subtree =>
BEGIN
node ← index;
SELECT tb[node].name FROM
construct => IF ~longAddressLhs THEN
BEGIN
IF isexp THEN l ← P5.ConstructExp[t1, node]
ELSE P5.Construct[t1, node];
RETURN
END;
rowcons => IF ~longAddressLhs THEN
BEGIN
IF isexp THEN l ← P5.RowConsExp[t1, node]
ELSE P5.RowCons[t1, node];
RETURN
END;
all =>
BEGIN
IF isexp THEN l ← P5.AllExp[t1, node]
ELSE P5.All[t1, node];
RETURN
END;
ENDCASE;
END;
ENDCASE;
rv ← P5L.VarForLex[P5.Exp[t2]];
lv ← P5L.VarForLex[P5.Exp[t1]];
IF aligned THEN
P5L.FieldOfVar[r: lv,
wSize: nbits/wordlength,
bSize: nbits MOD wordlength];
l ← P5L.VarVarAssign[lv, rv, isexp];
RETURN
END;
ReleaseLex: PROCEDURE[l: Lexeme] =
BEGIN
WITH l SELECT FROM
bdo => P5L.ReleaseVarItem[lexbdoi];
ENDCASE;
RETURN
END;
TLLAssign: PUBLIC PROCEDURE [leftson: Tree.Link, leftlex, l: Lexeme, exp: BOOLEAN, nbits: CARDINAL] =
BEGIN -- main subroutine for doing assignment statements and expressions
OPEN FOpCodes;
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];
RETURN
END;
SLAssign: PUBLIC PROCEDURE [sei: ISEIndex, l: Lexeme, exp: BOOLEAN, nwords: CARDINAL] =
BEGIN -- sei-lexeme interface to tllCassign
TLLAssign[Tree.Null, [se[sei]], l, exp, nwords*wordlength];
RETURN
END;
PortInit: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
BEGIN
P5U.Out1[FOpCodes.qLI, 0];
P5U.Out1[FOpCodes.qLI, 0];
RETURN[P5L.TOSLex[2]]
END;
BodyInit: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- assigns proc. desc for proc. variable
bti: CBTIndex ← tb[node].info;
WITH bb[bti].info SELECT FROM
Internal => CPtr.fileindex ← sourceIndex;
ENDCASE;
P5.PushLProcDesc[bti];
RETURN [P5L.TOSLex[1]]
END;
StringInit: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- inits string storage and pushes pointer on stack
nchars: CARDINAL;
l: se Lexeme;
nchars ← P5U.TreeLiteralValue[tb[node].son[2]];
l ← P5.GenStringBodyLex[nchars];
[] ← P5L.LoadAddress[P5L.VarForLex[l]];
P5.FreeTempSei[l.lexsei];
P5U.PushLitVal[0];
P5U.PushLitVal[nchars];
P5U.Out1[FOpCodes.qPSD, 0];
RETURN [P5L.TOSLex[1]]
END;
ProcInit: PUBLIC PROCEDURE [node: Tree.Index] =
BEGIN
bti: CBTIndex ← tb[node].info;
WITH bb[bti] SELECT FROM
Inner =>
BEGIN
P5.PushNonnestedProcDesc[entryIndex];
P5U.Out1[FOpCodes.qSL, frameOffset];
END;
ENDCASE;
RETURN
END;
END...