-- Expression.mesa, modified by Sweet, January 11, 1980 11:59 AM
DIRECTORY
AltoDefs: FROM "altodefs" USING [BYTE, BytesPerWord, wordlength],
Code: FROM "code" USING [
caseCVState, CodeNotImplemented, dStar, mwCaseCV, xtracting, xtractlex],
CodeDefs: FROM "codedefs" USING [Lexeme, VarComponent, VarIndex],
ControlDefs: FROM "controldefs" USING [
ControlLink, EPRange, GFTNull, ProcDesc, SignalDesc],
FOpCodes: FROM "fopcodes" USING [
qADD, qAND, qBNDCK, qDADD, qDDIV, qDESCB, qDESCBS, qDIV, qDMOD, qDMUL,
qDSUB, qDUDIV, qDUMOD, qEXCH, qFADD, qFDIV, qFLOAT, qFMUL, qFSUB, qLI,
qMUL, qNEG, qNILCK, qNILCKL, qPOP, qPUSH, qSDIV, qSHIFT, qSUB],
InlineDefs: FROM "inlinedefs" USING [BITAND, BITSHIFT],
Literals: FROM "literals" USING [LTIndex, ltType, MSTIndex, stType],
OpCodeParams: FROM "opcodeparams" USING [GlobalHB, LocalHB],
P5: FROM "p5" USING [
AllExp, CaseStmtExp, ConstructExp, FlowExp, GenTempLex,
MoveToCodeWord, P5Error, RowConsExp, TTAssign, WriteCodeWord],
P5L: FROM "p5l" USING [
AddrForVar, AdjustComponent, ComponentForLex, ComponentForSE, CopyLex,
FieldOfVarOnly, GenVarItem, LoadBoth, LoadComponent, LoadVar,
MakeComponent, OVarItem, TOSComponent, TOSLex, VarAlignment, VarForLex,
Words],
P5S: FROM "p5s" USING [
AssignExp, BodyInit, CallExp, DIndex, ErrExp, ForkExp, Index, JoinExp,
New, PortInit, SeqIndex, SigExp, StartExp, StringInit, SubstExp,
SysErrExp],
P5U: FROM "p5u" USING [
OperandType, Out0, Out1, PushLitVal, TreeLiteral, TreeLiteralValue,
WordsForOperand, WordsForSei],
SDDefs: FROM "sddefs",
Stack: FROM "stack" USING [Dump, Require],
StringDefs: FROM "stringdefs" USING [StringHeaderSize],
SymbolOps: FROM "symbolops" USING [
FnField, NormalType, UnderType, WordsForType, XferMode],
Symbols: FROM "symbols" USING [
BitAddress, bodyType, BTIndex, BTNull, CBTIndex, ContextLevel,
CSEIndex, CTXIndex, ctxType, HTIndex, ISEIndex, lZ, RecordSEIndex,
SEIndex, seType],
Table: FROM "table" USING [Base, Notifier],
Tree: FROM "tree" USING [Index, Link, Null, treeType];
Expression: PROGRAM
IMPORTS CPtr: Code, InlineDefs, P5, P5L, P5S, P5U, Stack, SymbolOps
EXPORTS CodeDefs, P5
SHARES Literals, StringDefs =
BEGIN
OPEN FOpCodes, CodeDefs;
-- imported definitions
BYTE: TYPE = AltoDefs.BYTE;
wordlength: CARDINAL = AltoDefs.wordlength;
BytesPerWord: CARDINAL = AltoDefs.BytesPerWord;
StringHeaderSize: CARDINAL = StringDefs.StringHeaderSize;
MSTIndex: TYPE = Literals.MSTIndex;
LocalHB: TYPE = OpCodeParams.LocalHB;
GlobalHB: TYPE = OpCodeParams.GlobalHB;
BitAddress: TYPE = Symbols.BitAddress;
BTIndex: TYPE = Symbols.BTIndex;
CBTIndex: TYPE = Symbols.CBTIndex;
BTNull: BTIndex = Symbols.BTNull;
ContextLevel: TYPE = Symbols.ContextLevel;
CSEIndex: TYPE = Symbols.CSEIndex;
RecordSEIndex: TYPE = Symbols.RecordSEIndex;
CTXIndex: TYPE = Symbols.CTXIndex;
HTIndex: TYPE = Symbols.HTIndex;
ISEIndex: TYPE = Symbols.ISEIndex;
lZ: ContextLevel = Symbols.lZ;
SEIndex: TYPE = Symbols.SEIndex;
LTIndex: TYPE = Literals.LTIndex;
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)
ExpressionNotify: PUBLIC Table.Notifier =
BEGIN -- called by allocator whenever table area is repacked
stb ← base[Literals.stType];
seb ← base[Symbols.seType];
ctxb ← base[Symbols.ctxType];
bb ← base[Symbols.bodyType];
cb ← tb ← base[Tree.treeType];
ltb ← base[Literals.ltType];
RETURN
END;
recentExp: PUBLIC Tree.Link; -- for debugging
Exp: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [l: Lexeme] =
BEGIN -- generates code for an expression
node: Tree.Index;
WITH e: t SELECT FROM
literal =>
WITH e.info SELECT FROM
word => RETURN[Lexeme[literal[word[index]]]];
string => RETURN[Lexeme[literal[string[index]]]];
ENDCASE;
symbol =>
BEGIN
RETURN[Lexeme[se[e.index]]];
END;
subtree =>
BEGIN
recentExp ← t;
IF e = Tree.Null THEN
IF CPtr.xtracting THEN RETURN[CPtr.xtractlex]
ELSE
BEGIN
SELECT CPtr.caseCVState FROM
single => P5U.Out0[qPUSH];
singleLoaded => CPtr.caseCVState ← single;
multi => RETURN [P5L.CopyLex[CPtr.mwCaseCV]];
ENDCASE => ERROR;
RETURN [P5L.TOSLex[1]];
END;
node ← e.index;
SELECT tb[node].name FROM
casex =>
BEGIN
l ← P5.CaseStmtExp[node, TRUE];
END;
assignx => l ← P5S.AssignExp[node];
plus => l ← Plus[node];
minus => l ← Minus[node];
div => l ← Div[node];
mod => l ← Mod[node];
times => l ← Times[node];
dot, uparrow => l ← DotOrUparrow[node];
reloc => l ← Reloc[node];
dollar => l ← Dollar[node];
uminus => l ← UMinus[node];
addr => l ← Addr[node];
index => l ← P5S.Index[node];
dindex => l ← P5S.DIndex[node];
construct => l ← P5.ConstructExp[Tree.Null, node];
arraydesc => l ← ArrayDesc[node];
length => l ← Length[node];
base => l ← Base[node];
portinit => l ← P5S.PortInit[node];
body => l ← P5S.BodyInit[node];
rowcons => l ← P5.RowConsExp[Tree.Null, node];
stringinit => l ← P5S.StringInit[node];
pad =>
BEGIN
psei: SEIndex = tb[node].info;
tlex: se Lexeme = P5.GenTempLex[SymbolOps.WordsForType[psei]];
P5.TTAssign[[symbol[tlex.lexsei]], t];
l ← tlex;
END;
cast => l ← Exp[tb[node].son[1]];
seqindex => l ← P5S.SeqIndex[node];
item => l ← Exp[tb[node].son[2]];
callx, portcallx => l ← P5S.CallExp[node];
substx => l ← P5S.SubstExp[node];
signalx => l ← P5S.SigExp[node];
errorx => l ← P5S.ErrExp[node];
syserrorx => l ← P5S.SysErrExp[node];
startx => l ← P5S.StartExp[node];
new => l ← P5S.New[node];
mwconst => l ← MwConst[node];
signalinit => l ← SignalInit[node];
fork => l ← P5S.ForkExp[node];
joinx => l ← P5S.JoinExp[node];
float => l ← Float[node];
check =>
BEGIN
PushRhs[tb[node].son[1]];
PushRhs[tb[node].son[2]];
P5U.Out0[FOpCodes.qBNDCK];
l ← P5L.TOSLex[1];
END;
chop =>
BEGIN
len: CARDINAL ← P5U.WordsForSei[tb[node].info];
r: VarIndex ← P5L.VarForLex[Exp[tb[node].son[1]]];
P5L.FieldOfVarOnly[r: r, wSize: len];
l ← [bdo[r]];
END;
all =>
BEGIN
l ← P5.AllExp[Tree.Null, node];
END;
ENDCASE => l ← P5.FlowExp[node];
END;
ENDCASE;
RETURN
END;
ConstOperand: PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN, INTEGER] =
BEGIN -- if t is a literal node, return [TRUE,val(t)]
IF P5U.TreeLiteral[t] THEN
RETURN [TRUE, P5U.TreeLiteralValue[t]]
ELSE RETURN [FALSE, 0]
END;
Plus: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generate code for +
real: BOOLEAN = tb[node].attr1;
double: BOOLEAN = real OR tb[node].attr2;
op1, op2: VarComponent;
IF double THEN
BEGIN
IF ~CPtr.dStar OR real THEN Stack.Dump[];
END;
op1 ← P5L.ComponentForLex[Exp[tb[node].son[1]]];
op2 ← P5L.ComponentForLex[Exp[tb[node].son[2]]];
P5L.LoadBoth[@op1, @op2, TRUE];
IF double THEN
BEGIN
P5U.Out0[IF real THEN qFADD ELSE qDADD];
RETURN[P5L.TOSLex[2]]
END;
P5U.Out0[qADD];
RETURN[P5L.TOSLex[1]]
END;
Minus: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generate code for -
real: BOOLEAN = tb[node].attr1;
double: BOOLEAN = real OR tb[node].attr2;
IF double THEN
BEGIN
IF ~CPtr.dStar OR real THEN Stack.Dump[];
END;
PushRhs[tb[node].son[1]];
PushRhs[tb[node].son[2]];
IF double THEN
BEGIN
P5U.Out0[IF real THEN qFSUB ELSE qDSUB];
RETURN[P5L.TOSLex[2]]
END;
P5U.Out0[qSUB];
RETURN[P5L.TOSLex[1]]
END;
UMinus: PROCEDURE [node: Tree.Index] RETURNS [l: Lexeme] =
BEGIN -- generate code for unary minus
tt: Tree.Link ← tb[node].son[1];
real: BOOLEAN = tb[node].attr1;
double: BOOLEAN = real OR tb[node].attr2;
WITH tt SELECT FROM
subtree =>
IF tb[index].name = uminus THEN
BEGIN PushRhs[tb[index].son[1]]; RETURN END;
ENDCASE;
IF double THEN
BEGIN
IF ~CPtr.dStar OR real THEN Stack.Dump[];
P5U.PushLitVal[0]; P5U.PushLitVal[0];
IF real THEN P5U.Out0[qFLOAT];
END;
PushRhs[tt];
IF double THEN
P5U.Out0[IF real THEN qFSUB ELSE qDSUB]
ELSE P5U.Out0[qNEG];
RETURN [P5L.TOSLex[IF double THEN 2 ELSE 1]];
END;
Times: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generates code for multiply
real: BOOLEAN = tb[node].attr1;
double: BOOLEAN = real OR tb[node].attr2;
op1, op2: VarComponent;
IF double THEN Stack.Require[0];
op1 ← P5L.ComponentForLex[Exp[tb[node].son[1]]];
op2 ← P5L.ComponentForLex[Exp[tb[node].son[2]]];
P5L.LoadBoth[@op1, @op2, TRUE];
IF double THEN
BEGIN
P5U.Out0[IF real THEN qFMUL ELSE qDMUL];
RETURN[P5L.TOSLex[2]];
END;
P5U.Out0[qMUL];
RETURN[P5L.TOSLex[1]]
END;
Log2: PROCEDURE [i: INTEGER] RETURNS [BOOLEAN, [0..16]] =
BEGIN OPEN InlineDefs;
shift: [0..16];
IF i = 0 THEN RETURN [FALSE, 0];
i ← ABS[i];
IF BITAND[i, i-1] # 0 THEN RETURN [FALSE, 0];
FOR shift IN [0..16) DO
IF BITAND[i,1] = 1 THEN RETURN[TRUE, shift];
i ← BITSHIFT[i, -1];
ENDLOOP;
ERROR; -- can't get here, but it makes the compiler happy
END;
Div: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generate code for divide
real: BOOLEAN = tb[node].attr1;
double: BOOLEAN = real OR tb[node].attr2;
signed: BOOLEAN = tb[node].attr3;
rand2lit, powerof2: BOOLEAN;
rand2val: INTEGER;
shift: [0..16];
IF double THEN Stack.Require[0];
PushRhs[tb[node].son[1]];
IF ~double AND ~signed THEN
BEGIN
[rand2lit, rand2val] ← ConstOperand[tb[node].son[2]];
IF rand2lit AND rand2val > 0 THEN
BEGIN
[powerof2, shift] ← Log2[rand2val];
IF powerof2 THEN
BEGIN
P5U.PushLitVal[-shift]; P5U.Out0[qSHIFT];
RETURN [P5L.TOSLex[1]]
END;
END;
END;
PushRhs[tb[node].son[2]];
IF double THEN
BEGIN
P5U.Out0[IF real THEN qFDIV ELSE
IF signed THEN qDDIV ELSE qDUDIV];
RETURN [P5L.TOSLex[2]];
END;
IF signed THEN P5U.Out0[qSDIV]
ELSE P5U.Out0[qDIV];
RETURN [P5L.TOSLex[1]];
END;
Mod: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generate code for MOD
real: BOOLEAN = tb[node].attr1;
double: BOOLEAN = real OR tb[node].attr2;
signed: BOOLEAN = tb[node].attr3;
rand2lit, powerof2: BOOLEAN;
rand2val: INTEGER;
IF double THEN
BEGIN
IF real THEN SIGNAL CPtr.CodeNotImplemented;
Stack.Dump[];
END;
PushRhs[tb[node].son[1]];
IF ~double AND ~signed THEN
BEGIN
[rand2lit, rand2val] ← ConstOperand[tb[node].son[2]];
IF rand2lit AND rand2val > 0 THEN
BEGIN
[powerof2, ] ← Log2[rand2val];
IF powerof2 THEN
BEGIN
P5U.PushLitVal[rand2val-1]; P5U.Out0[qAND];
RETURN [P5L.TOSLex[1]];
END;
END;
END;
PushRhs[tb[node].son[2]];
IF double THEN
BEGIN
P5U.Out0[IF signed THEN qDMOD ELSE qDUMOD];
RETURN [P5L.TOSLex[2]];
END;
P5U.Out0[IF signed THEN qSDIV ELSE qDIV];
P5U.Out0[qPUSH];
P5U.Out0[qEXCH];
P5U.Out0[qPOP];
RETURN [P5L.TOSLex[1]];
END;
Float: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
BEGIN
Stack.Dump[];
PushRhs[tb[node].son[1]];
P5U.Out0[qFLOAT];
RETURN[P5L.TOSLex[2]];
END;
Addr: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generates code for "@"
r: VarIndex;
avar: VarComponent;
r ← P5L.VarForLex[Exp[tb[node].son[1]]];
avar ← P5L.AddrForVar[r];
RETURN[[bdo[P5L.OVarItem[avar]]]]
END;
ArrayDesc: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- pushes two components of an array descriptor onto stack
size: CARDINAL;
WITH tb[node].son[1] SELECT FROM
subtree =>
BEGIN
size ← SPushRhs[tb[index].son[1]];
size ← SPushRhs[tb[index].son[2]] + size;
END;
ENDCASE;
RETURN[P5L.TOSLex[size]]
END;
Length: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generates code to extract length from array descriptor
-- relocs need not apply
t1: Tree.Link = tb[node].son[1];
pW: CARDINAL = P5U.WordsForOperand[t1] - 1;
r: VarIndex ← P5L.VarForLex[Exp[t1]];
P5L.FieldOfVarOnly[r: r, wd: pW, wSize: 1];
RETURN [[bdo[r]]];
END;
Base: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generates code to extract base from array descriptor
-- relocs get converted to addr
t1: Tree.Link = tb[node].son[1];
pW: CARDINAL = P5U.WordsForOperand[t1] - 1;
r: VarIndex ← P5L.VarForLex[Exp[t1]];
P5L.FieldOfVarOnly[r: r, wSize: pW];
RETURN [[bdo[r]]];
END;
DotOrUparrow: PROCEDURE [mainnode: Tree.Index] RETURNS [Lexeme] =
BEGIN
-- generate code for "exp.field"
t1: Tree.Link ← tb[mainnode].son[1];
sei: ISEIndex;
r: VarIndex;
long: BOOLEAN = tb[mainnode].attr2;
nilCheck: BOOLEAN = tb[mainnode].attr1;
base: VarComponent;
offset: VarComponent; -- fields of code data are dollar nodes
IF tb[mainnode].name = uparrow THEN sei ← tb[mainnode].info
ELSE
WITH tb[mainnode].son[2] SELECT FROM
symbol => sei ← index;
ENDCASE;
BEGIN -- to set up useBdo label
IF nilCheck THEN
BEGIN
PushRhs[t1];
P5U.Out0[IF long THEN FOpCodes.qNILCKL ELSE
FOpCodes.qNILCK];
base ← P5L.TOSComponent[IF long THEN 2 ELSE 1];
END
ELSE WITH t1 SELECT FROM
subtree =>
BEGIN
stnode: Tree.Index = index;
SELECT tb[stnode].name FROM
plus =>
BEGIN
disp: VarComponent;
base ← P5L.ComponentForLex[Exp[tb[stnode].son[1]]];
disp ← P5L.ComponentForLex[Exp[tb[stnode].son[2]]];
r ← P5L.GenVarItem[bdo];
cb[r] ← [body: bdo[base: base, disp: disp, offset: NULL]];
GO TO useBdo;
END;
ENDCASE;
END;
ENDCASE;
base ← P5L.ComponentForLex[Exp[t1]];
r ← P5L.GenVarItem[bo];
cb[r] ← [body: bo[base: base, offset: NULL]];
EXITS
useBdo => NULL;
END;
IF tb[mainnode].name = uparrow THEN
offset ← [wSize: P5U.WordsForSei[sei], space: frame[wd: 0]]
ELSE IF seb[sei].constant THEN
BEGIN -- procedure or signal from pointer to frame
RETURN[ConstantField[@base, sei]]
END
ELSE
BEGIN
psei: CSEIndex =
SymbolOps.NormalType[P5U.OperandType[tb[mainnode].son[1]]];
offset ← P5L.ComponentForSE[sei];
WITH offset SELECT FROM
frame => level ← lZ; -- to take care of pointer to frame
ENDCASE => ERROR;
WITH seb[psei] SELECT FROM
pointer =>
BEGIN OPEN SymbolOps;
rcsei: CSEIndex ← UnderType[refType];
-- if we point to a type, it fills a number of full words
WITH seb[rcsei] SELECT FROM
record =>
P5L.AdjustComponent[var: @offset, rSei: LOOPHOLE[rcsei],
fSei: sei, tBits: WordsForType[rcsei]*wordlength];
ENDCASE;
END;
ENDCASE => P5.P5Error[642];
END;
WITH cc: cb[r] SELECT FROM
bo => cc.offset ← offset;
bdo => cc.offset ← offset;
ENDCASE => ERROR;
RETURN[[bdo[r]]]
END;
Reloc: PUBLIC PROCEDURE [node: Tree.Index]
RETURNS [Lexeme] =
BEGIN -- generates code for "baseptr[relptr]"
rd, rr: VarIndex;
base, disp: VarComponent;
base ← P5L.ComponentForLex[Exp[tb[node].son[1]]];
rd ← P5L.VarForLex[Exp[tb[node].son[2]]];
IF tb[node].attr1 THEN
BEGIN -- reloc of an array descriptor
dsize: CARDINAL = P5U.WordsForOperand[tb[node].son[2]] - 1;
P5L.FieldOfVarOnly[r: rd, wSize: dsize];
END;
disp ← P5L.MakeComponent[rd];
rr ← P5L.GenVarItem[bdo];
cb[rr] ← [body: bdo[base: base, disp: disp, offset:
[wSize: SymbolOps.WordsForType[tb[node].info], space: frame[]]]];
RETURN[[bdo[rr]]];
END;
ConstantField: PROCEDURE [
var: POINTER TO VarComponent, sei: ISEIndex] RETURNS [Lexeme] =
BEGIN
p: ControlDefs.ProcDesc;
bti: CBTIndex;
SELECT SymbolOps.XferMode[seb[sei].idType] FROM
procedure =>
BEGIN
IF seb[sei].extended THEN SIGNAL CPtr.CodeNotImplemented;
bti ← seb[sei].idInfo;
IF bti = BTNull THEN
BEGIN
RETURN [[bdo[
P5L.OVarItem[ [wSize: 1, space: const[d1: seb[sei].idValue]]]]]];
END;
IF var.wSize > 1 THEN SIGNAL CPtr.CodeNotImplemented;
P5L.LoadComponent[var↑];
WITH bb[bti] SELECT FROM
Inner =>
BEGIN -- could happen with pointer to procedure frame
P5U.Out1[FOpCodes.qLI, frameOffset];
P5U.Out0[FOpCodes.qADD];
END;
Outer =>
BEGIN OPEN ControlDefs;
p.gfi ← entryIndex/EPRange;
p.ep ← entryIndex MOD EPRange;
p.tag ← procedure;
P5U.Out1[qDESCBS, LOOPHOLE[p]];
END;
ENDCASE;
END;
signal, error =>
BEGIN
p ← seb[sei].idValue;
p.gfi ← p.gfi-1;
IF var.wSize > 1 THEN SIGNAL CPtr.CodeNotImplemented;
P5L.LoadComponent[var↑];
P5U.Out1[qDESCBS, LOOPHOLE[p]];
END;
ENDCASE => P5.P5Error[643];
RETURN [P5L.TOSLex[1]];
END;
Dollar: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
BEGIN -- generates code for "exp$field"
sei: ISEIndex;
r: VarIndex;
recsei: RecordSEIndex ← LOOPHOLE[P5U.OperandType[tb[node].son[1]]];
functionCall: BOOLEAN;
tBits, twSize: CARDINAL;
tbSize: [0..wordlength);
foffset: frame VarComponent;
functionCall ← seb[recsei].argument;
r ← P5L.VarForLex[Exp[tb[node].son[1]]];
[wSize: twSize, bSize: tbSize] ← P5L.VarAlignment[r, load];
tBits ← twSize*wordlength + tbSize;
WITH tb[node].son[2] SELECT FROM
symbol =>
BEGIN
sei ← index;
IF seb[sei].constant THEN
BEGIN
fpvar: VarComponent;
WITH tb[node].son[1] SELECT FROM
subtree =>
BEGIN
node: Tree.Index = index;
IF tb[node].name # uparrow THEN P5.P5Error[645];
fpvar ← P5L.ComponentForLex[Exp[tb[node].son[1]]];
END;
ENDCASE => P5.P5Error[646];
RETURN [ConstantField[@fpvar, sei]];
END;
IF functionCall THEN
BEGIN
fSize: CARDINAL;
fAddr: BitAddress;
[fAddr,fSize] ← SymbolOps.FnField[sei];
foffset ← [wSize: fSize / wordlength, bSize: fSize MOD wordlength,
space: frame[wd: fAddr.wd, bd: fAddr.bd]];
END
ELSE foffset ← LOOPHOLE[P5L.ComponentForSE[sei]];
IF tBits <= wordlength THEN
P5L.AdjustComponent[var: @foffset,
rSei: recsei, fSei: sei, tBits: tBits];
P5L.FieldOfVarOnly[r: r, wSize: foffset.wSize,
bSize: foffset.bSize, wd: foffset.wd, bd: foffset.bd];
RETURN [[bdo[r]]];
END;
ENDCASE => ERROR;
END;
MwConst: PROCEDURE [node: Tree.Index] RETURNS [l: Lexeme] =
BEGIN -- puts multi-word constant out to code stream
lti: LTIndex;
WITH tb[node].son[1] SELECT FROM
literal => WITH info SELECT FROM
word => lti ← index;
ENDCASE => P5.P5Error[647];
ENDCASE => P5.P5Error[648];
WITH ll:ltb[lti] SELECT FROM
short => RETURN [[literal[word[lti]]]];
long =>
BEGIN
var: VarComponent;
SELECT ll.length FROM
0 => P5.P5Error[649];
1 => var ← [wSize: 1, space: const[d1: ll.value[0]]];
2 =>var ←
[wSize: 2, space: const[d1: ll.value[0], d2: ll.value[1]]];
ENDCASE =>
BEGIN
nwords: CARDINAL ← ll.length;
i: CARDINAL;
IF ll.codeIndex = 0 THEN
BEGIN
ll.codeIndex ← P5.MoveToCodeWord[];
FOR i IN [0..nwords) DO P5.WriteCodeWord[ll.value[i]]; ENDLOOP;
END;
var ← [wSize: nwords, space: code[wd: ll.codeIndex]];
END;
RETURN[[bdo[P5L.OVarItem[var]]]];
END;
ENDCASE => ERROR; -- to keep the compiler happy
END;
DoubleZero: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] =
BEGIN
node: Tree.Index;
lti: LTIndex;
WITH t SELECT FROM
subtree => node ← index;
ENDCASE => GO TO retFalse;
IF tb[node].name # mwconst THEN GO TO retFalse;
WITH tb[node].son[1] SELECT FROM
literal => WITH info SELECT FROM
word => lti ← index;
ENDCASE => GO TO retFalse;
ENDCASE => GO TO retFalse;
WITH ll:ltb[lti] SELECT FROM
long =>
SELECT ll.length FROM
2 => IF ll.value[0] = 0 AND ll.value[1] = 0 THEN RETURN[TRUE];
ENDCASE;
ENDCASE;
GO TO retFalse;
EXITS
retFalse => RETURN[FALSE];
END;
LPushRhs: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [Lexeme] =
BEGIN -- forces a value onto the stack
wSize: CARDINAL ← SPushRhs[t];
RETURN [P5L.TOSLex[wSize]];
END;
PushRhs: PUBLIC PROCEDURE [t: Tree.Link] =
BEGIN -- forces a value onto the stack
[] ← SPushRhs[t];
RETURN
END;
SPushRhs: PROCEDURE [t: Tree.Link] RETURNS [wSize: CARDINAL] =
BEGIN -- forces a value onto the stack
RETURN[SPushLex[Exp[t]]];
END;
SPushLex: PROCEDURE [l: Lexeme] RETURNS [wSize: CARDINAL] =
BEGIN -- forces a lexeme onto the stack
r: VarIndex = P5L.VarForLex[l];
ws, bs: CARDINAL;
[wSize: ws, bSize: bs] ← P5L.VarAlignment[r,load];
wSize ← P5L.Words[ws, bs];
P5L.LoadVar[r];
END;
PushLex: PUBLIC PROCEDURE [l: Lexeme] =
BEGIN
[] ← SPushLex[l];
END;
LPushLex: PUBLIC PROCEDURE [l: Lexeme] RETURNS [Lexeme] =
BEGIN
wSize: CARDINAL ← SPushLex[l];
RETURN [P5L.TOSLex[wSize]];
END;
PushLProcDesc: PUBLIC PROCEDURE [bti: CBTIndex] =
BEGIN -- pushes a descriptor for local procedure on stack
WITH bb[bti] SELECT FROM
Inner => PushNestedProcDesc[bti];
Outer => PushNonnestedProcDesc[entryIndex];
ENDCASE;
RETURN
END;
PushNestedProcDesc: PUBLIC PROCEDURE [bti: CBTIndex] =
BEGIN -- pushes a descriptor for nested local procedure on stack
v: ContextLevel ← bb[bti].level - 1;
WITH bb[bti] SELECT FROM
Inner =>
BEGIN
avar: VarComponent = [wSize: 1, space:
faddr[wd: frameOffset, level: v]];
P5L.LoadComponent[avar];
RETURN
END;
ENDCASE
END;
PushNonnestedProcDesc: PUBLIC PROCEDURE [n: CARDINAL] =
BEGIN -- pushes a descriptor for local procedure n on stack
OPEN ControlDefs;
p: ProcDesc;
p.gfi ← n/EPRange;
p.ep ← n MOD EPRange;
p.tag ← procedure;
P5U.Out1[qDESCB, LOOPHOLE[p]];
RETURN
END;
PushLSigDesc: PROCEDURE [desc: ControlDefs.SignalDesc] =
BEGIN
IF desc.gfi # ControlDefs.GFTNull THEN
BEGIN
desc.gfi ← desc.gfi-1;
P5U.Out1[qDESCB, LOOPHOLE[desc]];
END
ELSE P5U.PushLitVal[desc];
RETURN
END;
SignalInit: PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
BEGIN OPEN ControlDefs;
v: CARDINAL ← tb[node].info;
P5U.Out1[qDESCB, LOOPHOLE[ControlLink[procedure[
gfi: v/EPRange,
ep: v MOD EPRange,
tag: procedure]]]];
RETURN [P5L.TOSLex[1]]
END;
END...