Statement:
PROGRAM
IMPORTS MPtr: ComData, CPtr: Code, CodeDefs, Log, P5U, P5, P5S, SymbolOps, TreeOps
EXPORTS CodeDefs, P5 = BEGIN OPEN FOpCodes, IntCodeDefs, CodeDefs;
imported definitions
SEIndex: TYPE = Symbols.SEIndex;
ISEIndex: TYPE = Symbols.ISEIndex;
ISENull: ISEIndex = Symbols.ISENull;
CSEIndex: TYPE = Symbols.CSEIndex;
CSENull: CSEIndex = Symbols.CSENull;
RecordSEIndex: TYPE = Symbols.RecordSEIndex;
RecordSENull: RecordSEIndex = Symbols.RecordSENull;
BTIndex: TYPE = Symbols.BTIndex;
BTNull: BTIndex = Symbols.BTNull;
BitAddress: TYPE = Symbols.BitAddress;
BitCount: TYPE = Symbols.BitCount;
tb: Tree.Base; -- tree base (local copy)
seb: Symbols.Base; -- semantic entry base (local copy)
ctxb: Symbols.Base; -- context entry base (local copy)
bb: Symbols.Base; -- body base (local copy)
cb: CodeDefs.Base; -- code base (local copy)
StatementNotify:
PUBLIC Alloc.Notifier =
BEGIN -- called by allocator whenever table area is repacked
seb ← base[Symbols.seType];
ctxb ← base[Symbols.ctxType];
bb ← base[Symbols.bodyType];
tb ← base[Tree.treeType];
cb ← base[codeType];
END;
catchEndLabel: Label ← NIL;
recentStmt: PUBLIC Tree.Link; -- for debugging
DeclList:
PUBLIC
PROC [cl: CodeList, t: Tree.Link] = {
-- maybe some statements, too
OneDecl: Tree.Scan = {
IF t = Tree.Null THEN RETURN;
SELECT TreeOps.OpName[t]
FROM
decl => DeclItem[cl, TreeOps.GetNode[t]];
typedecl => NULL;
ENDCASE => P5U.MoreCode[cl, StatementTree[t]]};
TreeOps.ScanList[t, OneDecl]};
StatementList:
PUBLIC PROC [cl: CodeList, t: Tree.Link] = {
OneStmt: Tree.Scan = {P5U.MoreCode[cl, StatementTree[t]]};
TreeOps.ScanList[t, OneStmt]};
StatementTree:
PUBLIC
PROC [t: Tree.Link]
RETURNS [l: Node] =
BEGIN -- generates code for Mesa statements
node: Tree.Index;
saveIndex: SourceMap.Loc = MPtr.textIndex;
recentStmt ← t;
IF t = Tree.Null THEN RETURN [NIL];
BEGIN
ENABLE
BEGIN
CPtr.CodeNotImplemented =>
IF ~MPtr.switches['d]
THEN
GO TO unimplementedConstruct;
END;
WITH t
SELECT
FROM
subtree =>
BEGIN
fIndex: SourceMap.Loc ← CPtr.inlineFileLoc;
node ← index;
IF fIndex = SourceMap.nullLoc THEN fIndex ← tb[node].info;
IF fIndex # SourceMap.nullLoc
THEN
SELECT tb[node].name
FROM
list, block, null => NULL; -- info is not a valid file index
ENDCASE =>
{CPtr.fileLoc ← MPtr.textIndex ← fIndex;
P5U.OutSource[cl, fIndex];
};
SELECT tb[node].name
FROM
list => l ← Compound[t];
block => l ← Block[node];
start => l ← P5S.Start[node];
restart => l ← P5S.Restart[node];
stop => l ← P5S.Stop[node];
dst => l ← DumpState[node];
lst => GO TO unimplementedConstruct; -- added in Trinity
lste => l ← LoadState[node];
lstf => l ← LoadStateFree[node];
call, portcall => l ← P5S.Call[node];
signal, error => l ← P5S.SigErr[node];
syscall => l ← SysCallStmt[node];
syserror => l ← P5.SysError[];
label => l ← P5S.LabelStmt[node];
assign => l ← P5S.Assign[node];
extract => l ← P5S.Extract[node];
if => l ← IfStmt[node];
case => l← P5.CaseStmtExp[node, FALSE];
bind => l ← P5.BindStmtExp[node, FALSE];
do => l ← DoStmt[node];
exit => l ← P5S.Exit[];
loop => l ← P5S.Loop[];
retry => l ← P5S.Retry[];
continue => l ← P5S.Continue[];
goto => l ← P5S.GoTo[node];
catchmark => l ← P5S.CatchMark[node];
return => l ← P5S.Return[node];
resume => l ← P5S.Resume[node];
reject => l ← Reject[];
result => l ← P5S.Result[node];
open => l ← Open[node];
enable => l ← Enable[node];
checked => l ← StatementTree[tb[node].son[1]];
procinit => l ← P5S.ProcInit[node];
wait => l ← P5S.Wait[node];
notify => l ← Notify[node];
broadcast => l ← Broadcast[node];
join => l ← P5S.Join[node];
unlock => l ← P5S.Unlock[node];
lock => l ← P5S.Lock[node];
subst => l ← P5S.Subst[node];
free => l ← P5S.Free[node];
xerror => l ← P5S.RetWithError[node];
null => NULL;
ENDCASE => GO TO unimplementedConstruct;
END;
ENDCASE;
EXITS
unimplementedConstruct => Log.Error[unimplemented];
END;
MPtr.textIndex ← saveIndex;
RETURN
END;
DeclItem:
PROC [cl: CodeList, node: Tree.Index] = {
initVal: Node ← IF tb[node].son[3] = Tree.Null THEN NIL ELSE P5.Exp[tb[node].son[3]];
first: BOOL ← TRUE;
OneId: Tree.Scan = {
sei: ISEIndex ← TreeOps.GetSe[t];
IF
NOT seb[sei].constant
THEN {
var: Var ← P5.VarForSei[sei];
P5U.Declare[cl: cl, var: var, init: initVal];
IF first
THEN {
first ← FALSE;
IF initVal # NIL AND initVal.kind # const THEN initVal ← var};
};
};
TreeOps.ScanList[tb[node].son[1], OneId];
};
SysCallStmt: PROC [node: Tree.Index] =
BEGIN
TreeOps.ScanList[tb[node].son[2], P5.PushRhs];
P5.SysCall[P5U.TreeLiteralValue[tb[node].son[1]]];
END;
Open:
PROC [node: Tree.Index]
RETURNS [Node] =
BEGIN
OpenItem: PROC [t: Tree.Link] RETURNS [Tree.Link] =
BEGIN
MarkShared[t, FALSE];
RETURN [FreeTree[t]]
END;
RETURN[StatementTree[tb[node].son[2]]];
tb[node].son[1] ← ReverseUpdateList[tb[node].son[1], OpenItem];
END;
DumpState: PROC [node: Tree.Index] = INLINE
BEGIN -- generates dumpstate
DLState[node, qDST];
END;
LoadState: PROC [node: Tree.Index] = INLINE
BEGIN -- generates loadstate
DLState[node, qLST];
P5.CallCatch[Tree.Null];
END;
LoadStateFree: PROC [node: Tree.Index] = INLINE
BEGIN -- generates loadstateandfree
DLState[node, qLSTF];
P5U.OutJump[JumpRet, LabelCCNull];
END;
DLState: PROC [node: Tree.Index, opc: Byte] =
BEGIN -- does state move after checking for small currentcontext address
lowBound: CARDINAL = PrincOps.localbase+2;
var: VarComponent = P5L.MakeComponent[P5L.VarForLex[P5.Exp[tb[node].son[1]]]];
WITH var SELECT FROM
frame =>
BEGIN
IF level # CPtr.curctxlvl THEN {Log.Error[stateVector]; RETURN};
IF wd NOT IN [lowBound..Byte.LAST] THEN Log.Error[stateVector];
P5U.Out1[opc, wd];
END;
ENDCASE => Log.Error[stateVector];
END;
Compound:
PROC [t: Tree.Link]
RETURNS [Node] =
BEGIN
cl: CodeList ← P5U.NewCodeList[];
StatementList[cl, t];
RETURN[P5U.MakeBlock[cl]];
END;
Block:
PROC [node: Tree.Index]
RETURNS [Node] =
BEGIN
cl: CodeList ← P5U.NewCodeList[];
bti: BTIndex = tb[node].info;
EnterBlock[cl, bti];
DeclList[cl, tb[node].son[1]];
StatementList[cl, tb[node].son[2]];
RETURN[P5U.MakeBlock[cl]];
ExitBlock[bti];
END;
IfStmt:
PROC [node: Tree.Index]
RETURNS [l: Node] =
BEGIN -- generates code for an IF statement
test: Node = P5.Exp[tb[node].son[1]];
s1: Node = StatementTree[tb[node].son[2]];
s2: Node = StatementTree[tb[node].son[3]];
else: CaseList = P5U.MakeCaseList[NIL, s2];
then: CaseList = P5U.MakeCaseList[P5U.MakeNodeList[test], s1, else];
l ← z.NEW[cond NodeRep ← [details: cond[then]]];
END;
DoStmt:
PROC [rootNode: Tree.Index]
RETURNS [l: Node] =
BEGIN -- generates code for all the loop statments
stepLoop, tempIndex, tempEnd, upLoop, forSeqLoop, bigForSeq: BOOL ← FALSE;
signed: BOOL ← FALSE;
long: BOOL ← FALSE;
sSon, eSon: Tree.Link;
node, subNode: Tree.Index;
bti: BTIndex ← BTNull;
intType: Tree.NodeName;
deltaOp: Node;
indexVar: Var;
endVal: Node;
topLabel: Label = P5U.AllocLabel[];
startLabel: Label = P5U.AllocLabel[];
finLabel: Label = P5U.AllocLabel[];
endLabel, loopLabel: Label;
labelMark: LabelInfoIndex = P5.GetLabelMark[];
cl: CodeList ← P5U.NewCodeList[];
cvBound: Node;
ati: ArithTypeIndex;
UpdateCV:
PROC =
BEGIN
delta: Node ← P5U.ApplyOp[oper: deltaOp, args: P5U.MakeNodeList2[indexVar, CPtr.nC1], bits: WordSize];
IF cvBound #
NIL
THEN
delta ← P5U.BoundsCheck[delta, cvBound];
P5U.DoAssign[cl, indexVar, delta];
END;
set up for EXIT clause
[exit: endLabel, loop: loopLabel] ← P5.MakeExitLabel[];
TreeOps.ScanList[tb[rootNode].son[5], P5.LabelCreate];
handle initialization node
IF tb[rootNode].son[1] = Tree.Null THEN P5U.InsertLabel[cl, topLabel]
ELSE
BEGIN
node ← TreeOps.GetNode[tb[rootNode].son[1]];
bti ← tb[node].info;
IF bti # BTNull THEN EnterBlock[cl, bti];
SELECT tb[node].name
FROM
forseq =>
BEGIN
t1: Tree.Link = tb[node].son[1];
e2: Node = P5.Exp[tb[node].son[2]];
indexVar ← P5.VarForSei[TreeOps.GetSe[t1]];
IF bti # BTNull
THEN
-- or some better test of locally declared cv
P5U.Declare[cl, indexVar, e2]
ELSE P5U.DoAssign[cl, indexVar, e2];
P5U.InsertLabel[cl, topLabel];
END;
upthru, downthru =>
BEGIN
knownNonEmpty: BOOL = tb[node].attr1;
cvBound ← P5.Exp[tb[node].son[3]];
stepLoop ← TRUE;
upLoop ← tb[node].name = upthru;
subNode ← TreeOps.GetNode[tb[node].son[2]];
intType ← tb[subNode].name;
IF tb[subNode].attr1 THEN SIGNAL CPtr.CodeNotImplemented; -- REAL
ati ← P5U.ArithTypeForTree[subNode];
WITH tb[node].son[1]
SELECT
FROM
subtree =>
-- son1 is empty
{indexVar ← P5U.CreateTemp[WordSize].var; tempIndex ← TRUE};
symbol => indexVar ← P5.VarForSei[index];
ENDCASE;
IF upLoop
THEN {
deltaOp ← P5U.ArithOp[add, ati];
sSon ← tb[subNode].son[1];
eSon ← tb[subNode].son[2]}
ELSE
BEGIN
deltaOp ← P5U.ArithOp[sub, ati];
SELECT intType
FROM
intCO => intType ← intOC;
intOC => intType ← intCO;
ENDCASE;
sSon ← tb[subNode].son[2]; eSon ← tb[subNode].son[1];
END;
WITH e: eSon
SELECT
FROM
literal => endVal ← P5.Exp[eSon];
symbol =>
IF seb[e.index].immutable THEN endVal ← P5.Exp[eSon]
ELSE
BEGIN
tv: Var ← P5U.CreateTemp[WordSize].var;
P5U.Declare[cl, tv, P5.Exp[eSon]];
endVal ← tv;
tempEnd ← TRUE;
END;
ENDCASE =>
BEGIN
endVal ← P5U.MakeTemp[cl: cl, bits: WordSize, init: P5.Exp[eSon]].var;
tempEnd ← TRUE;
END;
IF tempIndex
OR bti # BTNull
THEN
-- or some better test of locally declared cv
P5U.Declare[cl, indexVar, P5.Exp[sSon]]
ELSE P5U.DoAssign[cl, indexVar, P5.Exp[sSon]];
IF (intType = intCC
OR intType = intOO)
AND ~knownNonEmpty
THEN
BEGIN -- earlier passes check for empty intervals
topTest:
ARRAY
BOOL
OF
ARRAY
BOOL
OF Comparator = [
[lt,le], -- down, closed/open
[gt,ge]]; -- up, closed/open
P5U.CJump[
cl: cl, test: topTest[upLoop][intType = intOO], ati: ati,
op1: indexVar, op2: endVal, target: finLabel];
END;
P5U.Jump[cl, startLabel];
P5U.InsertLabel[cl, topLabel];
SELECT intType
FROM
intCC => {UpdateCV[]; P5U.InsertLabel[cl, startLabel]};
intOC => UpdateCV[];
intCO, intOO => NULL;
ENDCASE;
END;
ENDCASE;
END;
now the pre-body test
IF tb[rootNode].son[2] # Tree.Null
THEN {
goto: Node = z.NEW[goto NodeRep ← [details: goto[finLabel]]];
case: CaseList ← P5U.MakeCaseList[P5U.MakeNodeList[P5.Exp[tb[rootNode].son[2]]], NIL, P5U.MakeCaseList[NIL, goto]];
cond: Node ← z.NEW[NodeRep.cond ← [details: cond[case]]];
P5U.MoreCode[cl, cond]};
ignore the opens (tb[rootNode].son3)
now the body
P5U.MoreCode[cl, StatementTree[tb[rootNode].son[4]]];
now (update and) test the control variable
P5U.InsertLabel[cl, loopLabel];
IF stepLoop
THEN
BEGIN
SELECT intType
FROM
intCC => NULL;
intCO => {UpdateCV[]; P5U.InsertLabel[cl, startLabel]};
intOC => P5U.InsertLabel[cl, startLabel];
intOO => {P5U.InsertLabel[cl, startLabel]; UpdateCV[]};
ENDCASE;
P5U.CJump[cl: cl, test: IF upLoop THEN lt ELSE gt, op1: indexVar, op2: endVal, ati: ati, target: topLabel];
P5U.Jump[cl, finLabel];
END
ELSE
BEGIN
IF forSeqLoop THEN P5U.DoAssign[cl, indexVar, P5.Exp[tb[node].son[3]]];
P5U.Jump[cl, topLabel];
END;
now the labelled EXITs
P5.LabelList[cl, tb[rootNode].son[5], endLabel, labelMark];
finally the FINISHED clause
P5U.InsertLabel[cl, finLabel];
P5U.MoreCode[cl, StatementTree[tb[rootNode].son[6]]];
IF bti # BTNull THEN ExitBlock[bti];
P5U.InsertLabel[cl, endLabel];
RETURN[P5U.MakeBlock[cl]];
END;
Enable:
PROC [node: Tree.Index]
RETURNS [l: Node] =
BEGIN -- generate code for an ENABLE
handler: Node ← SCatchPhrase[tb[node].son[1]];
cl: CodeList ← P5U.NewCodeList[];
range: NodeList;
StatementList[cl, tb[node].son[2]];
range ← P5U.ExtractList[cl];
l ← z.NEW[enable NodeRep ← [details: enable[handle: handler, scope: range]]];
END;
SCatchPhrase:
PUBLIC
PROC [t: Tree.Link]
RETURNS [l: Node] =
BEGIN -- main subr for catchphrases and ENABLEs
node: Tree.Index = TreeOps.GetNode[t];
saveCaseCV: Node = CPtr.caseCV;
saveEndLabel: LabelCCIndex = catchEndLabel;
regsPtr, except, rtnPtr, argPtr: Var; -- formal parameters
cl: CodeList ← P5U.NewCodeList[];
catchLabel: Label ← P5U.AllocLabel[]; -- use [bti] when catch phrases have them
armHead, armTail: CaseList ← NIL;
enclosingContext: Label ← P5.visibleContext[CPtr.curctxlvl];
lambda: LambdaNode;
CatchArm:
PROC [t: Tree.Link] =
BEGIN
node: Tree.Index ← TreeOps.GetNode[t]; -- t is an item
tests: NodeList ← P5.ExpList[tb[node].son[1]].head;
body: Node ← CatchItem[node: node, argPtr: argPtr];
arm: CaseList ← z.NEW[CaseListRep ← [tests: tests, body: body, rest: NIL]];
IF armTail = NIL THEN armHead ← arm ELSE armTail.rest ← arm;
armTail ← arm
END;
regsPtr ← P5U.FormalVar[PtrSize];
except ← P5U.FormalVar[SignalSize];
rtnPtr ← P5U.FormalVar[PtrSize];
argPtr ← P5U.FormalVar[PtrSize];
lambda ← z.NEW[lambda NodeRep ← [details: lambda[parent: enclosingContext, formalArgs: P5U.MakeVarList[regsPtr, P5U.MakeVarList[except, P5U.MakeVarList2[rtnPtr, argPtr]]], body: NIL]]]; -- will fill in body field soon
catchEndLabel ← P5U.AllocLabel[];
CPtr.curctxlvl ← CPtr.curctxlvl + 1;
P5.visibleContext[CPtr.curctxlvl] ← catchLabel;
CPtr.caseCV ← except;
TreeOps.ScanList[tb[node].son[1], CatchArm];
IF tb[node].son[2] # Tree.Null
THEN {
ec: Node ← CatchItem[node:TreeOps.GetNode[tb[node].son[2]], argPtr: argPtr];
other: CaseList ← z.NEW[CaseListRep ← [tests: NIL, body: ec, rest: NIL]];
IF armHead = NIL THEN armHead ← other ELSE armTail.rest ← other};
P5U.InsertLabel[cl, catchEndLabel];
lambda.body ← P5U.MakeNodeList[z.NEW[NodeRep.cond ← [details: cond[armHead]]]];
catchLabel.node ← lambda;
l ← z.NEW[NodeRep.label ← [details: label[catchLabel]]];
CPtr.curctxlvl ← CPtr.curctxlvl-1;
CPtr.caseCV ← saveCaseCV;
catchEndLabel ← saveEndLabel;
END;
CatchItem:
PROC [node: Tree.Index, argPtr: Node]
RETURNS [Node] =
BEGIN -- generate code for a CATCH item
saveCatchOutRecord: RecordSEIndex = CPtr.catchoutrecord;
inRecord: RecordSEIndex;
body: Node;
bodyStmts: NodeList;
cl: CodeList ← P5U.NewCodeList[];
tSei: CSEIndex = SymbolOps.UnderType[tb[node].info];
IF tSei = Symbols.CSENull THEN inRecord ← CPtr.catchoutrecord ← RecordSENull
ELSE
BEGIN
[inRecord, CPtr.catchoutrecord] ← SymbolOps.TransferTypes[tSei];
END;
GetSignalParams[cl, argPtr, inRecord];
body ← StatementTree[tb[node].son[2]];
WITH b: body
SELECT
FROM
block => bodyStmts ← b.nodes;
ENDCASE => bodyStmts ← P5U.MakeNodeList[body];
IF cl.tail = NIL THEN cl.head ← bodyStmts ELSE cl.tail.rest ← bodyStmts;
CPtr.catchoutrecord ← saveCatchOutRecord;
RETURN[P5U.MakeBlock[cl]];
END;
Bits: PROC [ba: BitAddress] RETURNS [INT] = {RETURN[LONG[LOOPHOLE[ba, CARDINAL]]]};
GetSignalParams:
PROC [cl: CodeList, argPtr: Node, irecord: RecordSEIndex] =
BEGIN
totalBits: BitCount ← P5U.BitsForType[irecord];
sei: ISEIndex;
np: CARDINAL ← 0;
offset: BitAddress;
size: BitCount;
nParms: CARDINAL;
args: Node;
IF irecord = CSENull THEN RETURN;
nParms ← P5U.WordsForSei[irecord];
IF nParms = 0 THEN RETURN;
args ← P5U.Deref[n: argPtr, bits: totalBits];
sei ← P5U.NextVar[ctxb[seb[irecord].fieldCtx].seList];
UNTIL sei = ISENull
DO
[offset, size] ← SymbolOps.FnField[sei];
P5U.Declare[cl: cl, var: P5.VarForSei[sei], init: P5U.TakeField[n: args, vl: [disp: Bits[offset], size: size]]];
sei ← P5U.NextVar[SymbolOps.NextSe[sei]];
ENDLOOP;
END;
EnterBlock:
PUBLIC
PROC [cl: CodeList, bti: BTIndex] = {
functionality replace by leaving decls in in Pass4s.
ctx: Symbols.CTXIndex = bb[bti].localCtx;
sei: ISEIndex;
IF ctx = Symbols.CTXNull THEN RETURN;
sei ← P5U.NextVar[ctxb[ctx].seList];
UNTIL sei = ISENull DO
P5U.Declare[cl: cl, var: P5.VarForSei[sei]];
sei ← P5U.NextVar[SymbolOps.NextSe[sei]];
ENDLOOP;
};
Reject:
PROC
RETURNS [l: Node] =
BEGIN
l ← z.NEW[goto NodeRep ← [details: goto[catchEndLabel]]];
END;
Notify:
PROC [node: Tree.Index]
RETURNS [l: Node] =
BEGIN
cv: Node ← P5.Exp[tb[node].son[1]];
l ← P5U.ApplyOp[oper: P5U.MesaOpNode[notify], args: P5U.MakeNodeList[cv], bits: 0];
END;
Broadcast:
PROC [node: Tree.Index]
RETURNS [l: Node] =
BEGIN
cv: Node ← P5.Exp[tb[node].son[1]];
l ← P5U.ApplyOp[oper: P5U.MesaOpNode[broadcast], args: P5U.MakeNodeList[cv], bits: 0];
END;
END.