Driver:
PROGRAM
IMPORTS Alloc, MPtr: ComData, CPtr: Code, CodeDefs, CompilerUtil, IntCodeUtils, Log, P5, P5U, ParseIntCode, PrettyIntCode, SafeStorage, SourceMap, SymbolOps, TreeOps
EXPORTS CodeDefs, CompilerUtil, P5, P5S = BEGIN OPEN IntCodeDefs, CodeDefs;
imported definitions
localbase: CARDINAL = PrincOps.localbase;
globalbase: CARDINAL = PrincOps.globalbase;
CBTIndex: TYPE = Symbols.CBTIndex;
CTXIndex: TYPE = Symbols.CTXIndex;
CTXNull: CTXIndex = Symbols.CTXNull;
CSEIndex: TYPE = Symbols.CSEIndex;
CSENull: CSEIndex = Symbols.CSENull;
ISEIndex: TYPE = Symbols.ISEIndex;
ISENull: ISEIndex = Symbols.ISENull;
RecordSEIndex: TYPE = Symbols.RecordSEIndex;
RecordSENull: RecordSEIndex = Symbols.RecordSENull;
BitCount: TYPE = Symbols.BitCount;
CodeOper: TYPE = P5.CodeOper;
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 entry base (local copy)
cb: CodeDefs.Base; -- code base (local copy)
DriverNotify: 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];
P5U.CgenUtilNotify[base];
AddressNotify[base];
ExpressionNotify[base]; FlowNotify[base];
StatementNotify[base]; SelectionNotify[base];
ConstructorNotify[base]; StoreNotify[base]; -- CountingNotify[base];
CallsNotify[base];
END;
CodePassError: PUBLIC ERROR [n: CARDINAL] = CODE;
z: PUBLIC ZONE ← SafeStorage.GetSystemZone[];
P5module:
PUBLIC
PROC =
BEGIN -- starts the code generation pass
modNode: Node ← Module[];
Log.Warning[other];
IF MPtr.switches['q]
THEN
PrettyIntCode.ToStream[CompilerUtil.AcquireStream[$log], P5U.MakeNodeList[modNode]]
ELSE ParseIntCode.ToStream[CompilerUtil.AcquireStream[$log], P5U.MakeNodeList[modNode]];
CompilerUtil.ReleaseStream[$log];
END;
P5Error: PUBLIC PROC [n: CARDINAL] = {ERROR CodePassError[n]};
mLock: Tree.Link;
PLPendingRec: TYPE = RECORD [use: CodeOper, next: REF PLPendingRec ← NIL];
PLabelItem: TYPE = RECORD [lbl: IntCodeDefs.Label, pending: REF PLPendingRec];
PLabelSeq: TYPE = RECORD [SEQUENCE max: CARDINAL OF PLabelItem];
procLabelSeq: REF PLabelSeq ← NIL;
FillProcLabel:
PUBLIC
PROC [op: CodeOper, bti: CBTIndex] = {
ep: CARDINAL = bb[bti].entryIndex;
lbl: Label;
IF (lbl ← procLabelSeq[ep].lbl) # NIL THEN op.label ← lbl
ELSE procLabelSeq[ep].pending ← z.NEW[PLPendingRec ← [use: op, next: procLabelSeq[ep].pending]];
};
DefineProcLabel:
PROC [lbl: Label, bti: CBTIndex] = {
ep: CARDINAL = bb[bti].entryIndex;
pli: PLabelItem ← procLabelSeq[ep];
IF pli.pending #
NIL
THEN
FOR pl:
REF PLPendingRec ← pli.pending, pl.next
UNTIL pl =
NIL
DO
pl.use.label ← lbl;
ENDLOOP;
procLabelSeq[ep] ← [lbl: lbl, pending: NIL];
};
Module:
PUBLIC
PROC
RETURNS [Node] =
BEGIN -- main driver for code generation
bodies: CodeList ← P5U.NewCodeList[];
modNode: ModuleNode;
Body:
PROC [bti: Symbols.BTIndex]
RETURNS [stop:
BOOL ←
FALSE] =
BEGIN
this: Node;
WITH body: bb[bti]
SELECT
FROM
Callable => IF ~body.inline THEN this ← ProcBody[LOOPHOLE[bti]];
ENDCASE;
P5U.MoreCode[bodies, this];
END;
(MPtr.table).AddNotify[DriverNotify];
procLabelSeq ← z.NEW[PLabelSeq[MPtr.nBodies]];
FOR i:
CARDINAL
IN [0..MPtr.nBodies)
DO
-- actually unnecessary, as NEW clears
procLabelSeq[i] ← [NIL, NIL];
ENDLOOP;
modNode ← z.NEW[module NodeRep ← [details: module[vars: VarsForCtx[MPtr.mainCtx], procs: NIL]]]; -- fill in procs below
CPtr.bodyInRecord ← CPtr.bodyOutRecord ← RecordSENull;
P5U.CgenUtilInit[MPtr.table];
CPtr.inlineFileLoc ← SourceMap.nullLoc;
CPtr.nC0 ← P5U.MakeNodeLiteral[0];
CPtr.nC1 ← P5U.MakeNodeLiteral[1];
CPtr.xtracting ← FALSE;
CPtr.caseCV ← NIL;
CPtr.catchoutrecord ← RecordSENull;
P5.StartCodeFile[];
[] ← SymbolOps.EnumerateBodies[Symbols.RootBti, Body];
modNode.procs ← bodies.head;
MPtr.objectBytes ← P5.EndCodeFile[];
do something with the modNode
(MPtr.table).DropNotify[DriverNotify];
RETURN[modNode]
END;
visibleContext:
PUBLIC
ARRAY Symbols.ContextLevel
OF IntCodeDefs.Label;
GetFormals:
PROC [irecord: RecordSEIndex]
RETURNS [vl: VarList] = {
IF irecord = CSENull THEN RETURN [NIL];
RETURN [VarsForCtx[seb[irecord].fieldCtx]];
};
NodesForCtx:
PROC [ctx: CTXIndex]
RETURNS [vl: NodeList ←
NIL] = {
tail: NodeList ← NIL;
sei: ISEIndex;
IF ctx = CTXNull THEN RETURN;
sei ← P5U.NextVar[ctxb[ctx].seList];
UNTIL sei = ISENull
DO
var: Var ← P5.VarForSei[sei];
this: NodeList ← P5U.MakeNodeList[var];
IF tail = NIL THEN vl ← this ELSE tail.rest ← this;
tail ← this;
sei ← P5U.NextVar[SymbolOps.NextSe[sei]];
ENDLOOP;
};
VarsForCtx:
PROC [ctx: CTXIndex]
RETURNS [vl: VarList ←
NIL] = {
tail: VarList ← NIL;
sei: ISEIndex;
IF ctx = CTXNull THEN RETURN;
sei ← P5U.NextVar[ctxb[ctx].seList];
UNTIL sei = ISENull
DO
var: Var ← P5.VarForSei[sei];
this: VarList ← P5U.MakeVarList[var];
IF tail = NIL THEN vl ← this ELSE tail.rest ← this;
tail ← this;
sei ← P5U.NextVar[SymbolOps.NextSe[sei]];
ENDLOOP;
};
ProcBody:
PROC [bti: Symbols.CBTIndex]
RETURNS [l: Node] =
BEGIN -- produces code for body
bodyNode: Tree.Index;
cl: CodeList ← P5U.NewCodeList[];
procLabel: Label ← P5U.AllocLabel[id: LONG[LOOPHOLE[bti, CARDINAL]]];
lambda: LambdaNode;
enclosingContext: Label;
DefineProcLabel[procLabel, bti];
CPtr.mainBody ← (bti = Symbols.RootBti);
MPtr.bodyIndex ← bti;
MPtr.textIndex ← SourceMap.Up[bb[bti].sourceIndex];
WITH bi: bb[bti].info
SELECT
FROM
Internal =>
BEGIN
bodyNode ← bi.bodyTree;
CPtr.curctxlvl ← bb[bti].level;
visibleContext[CPtr.curctxlvl] ← procLabel;
enclosingContext ← IF CPtr.curctxlvl < Symbols.lL THEN NIL ELSE visibleContext[CPtr.curctxlvl - 1];
set up input and output contexts
[CPtr.bodyInRecord, CPtr.bodyOutRecord] ← SymbolOps.TransferTypes[bb[bti].ioType];
CPtr.bodyStartLoc ← CPtr.fileLoc ← SourceMap.Up[bb[bti].sourceIndex];
CPtr.tailJumpOK ← TRUE;
init the code stream and put down bracketing labels
P5U.OutSource[cl, SourceMap.Up[bb[bti].sourceIndex]];
init data for creating temporaries
SymbolOps.SetCtxLevel[CPtr.tempcontext, CPtr.curctxlvl];
tuck parameters away into the frame
WITH bb[bti] SELECT FROM
Inner => P5U.Out1[FOpCodes.qLINKB, frameOffset-localbase];
ENDCASE;
lambda ← z.NEW[NodeRep.lambda ← [details: lambda[parent: enclosingContext, formalArgs: GetFormals[CPtr.bodyInRecord], body: NIL]]]; -- will fill in body field soon
do type table and string literals
get variables declared
IF CPtr.bodyOutRecord# RecordSENull
THEN {
ctx: Symbols.CTXIndex = seb[CPtr.bodyOutRecord].fieldCtx;
sei: ISEIndex ← P5U.NextVar[ctxb[ctx].seList];
UNTIL sei = ISENull
DO
P5U.Declare[cl: cl, var: P5.VarForSei[sei]];
sei ← P5U.NextVar[SymbolOps.NextSe[sei]];
ENDLOOP;
};
P5.EnterBlock[cl, bti];
do initialization code and main body
IF bb[bti].entry THEN SetLock[cl, tb[bodyNode].son[4]]
ELSE mLock ← Tree.Null;
generate code for declaration initializations and statements
P5.DeclList[cl, tb[bodyNode].son[2]];
P5.StatementList[cl, tb[bodyNode].son[3]];
push the return values onto the stack (is this necessary?)
IF mLock # Tree.Null THEN ReleaseLock[cl];
END;
ENDCASE;
lambda.body ← P5U.ExtractList[cl];
procLabel.node ← lambda;
l ← z.NEW[NodeRep.label ← [details: label[procLabel]]];
END;
SSubst:
PROC [node: Tree.Index]
RETURNS [l: Node] =
BEGIN
ss: StatementStateRecord;
tSei: CSEIndex = P5U.OperandType[tb[node].son[1]];
P5.PushStatementState[@ss]; CPtr.substenable ← CPtr.actenable;
CPtr.bodyOutRecord ← SymbolOps.TransferTypes[tSei].typeOut;
tb[node].son[2] ← P5.StatementTree[tb[node].son[2]];
InsertRetLabels[FALSE]; -- if entry procedure, lock already dealt with
nRets ← P5U.WordsForSei[CPtr.bodyOutRecord];
P5.PopStatementState[@ss]; CPtr.substenable ← saveEnable;
RETURN
END;
Subst:
PUBLIC
PROC [node: Tree.Index]
RETURNS [Node] =
BEGIN
RETURN[SSubst[node]];
END;
SubstExp:
PUBLIC
PROC [node: Tree.Index]
RETURNS [Node ← NIL] =
BEGIN
nRets: CARDINAL = SSubst[node];
RETURN [P5.PRetLex[nRets, node, FALSE]]
END;
StandardReturn:
PROC
RETURNS [l: Node] =
BEGIN -- pushes the return vals from a body onto the stack
outCtx: CTXIndex =
IF CPtr.bodyOutRecord = CSENull THEN CTXNull
ELSE seb[CPtr.bodyOutRecord].fieldCtx;
l ← z.NEW [NodeRep.return ← [details: return[rets: NodesForCtx[outCtx]]]];
END;
SetLock:
PROC [cl: CodeList, lock: Tree.Link] =
BEGIN
lockNode: Node = P5.Exp[mLock ← lock];
set: Node = P5U.ApplyOp[oper: P5U.MesaOpNode[monitorEntry], args: P5U.MakeNodeList[lockNode], bits: 0];
P5U.MoreCode[cl, set];
END;
ReleaseLock:
PUBLIC
PROC [cl: CodeList] =
BEGIN
lock: Node = P5.Exp[mLock];
rel: Node = P5U.ApplyOp[oper: P5U.MesaOpNode[monitorExit], args: P5U.MakeNodeList[lock], bits: 0];
P5U.MoreCode[cl, rel];
END;
Return:
PUBLIC PROC [node: Tree.Index]
RETURNS [l: Node] =
BEGIN -- generate code for RETURN
cl: CodeList ← P5U.NewCodeList[];
monitored: BOOL ← tb[node].attr1;
returningNoGlobals: BOOL ← tb[node].attr2;
returnOfAnotherCall: BOOL ← tb[node].attr3;
retvals: NodeList;
t1: Tree.Link ← tb[node].son[1];
totalBits: BitCount ← P5U.BitsForType[CPtr.bodyOutRecord];
IF monitored
THEN {
t1 ← P5U.ProcessSafens[cl: cl, t: t1];
ReleaseLock[cl]};
IF CommonRet[tb[node].son[1]] THEN RETURN [StandardReturn[]];
IF returnOfAnotherCall THEN retvals ← P5U.MakeNodeList[P5.Exp[t1]]
ELSE retvals ← P5.ExpList[t1].head;
l ← z.NEW[NodeRep.return ← [bits: totalBits, details: return[retvals]]];
IF cl.head #
NIL
THEN {
P5U.MoreCode[cl, l];
l ← P5U.MakeBlock[cl]};
END;
Result:
PUBLIC
PROC [node: Tree.Index]
RETURNS [Node ← NIL] = {
};
Resume:
PUBLIC
PROC [node: Tree.Index]
RETURNS [Node ← NIL] =
BEGIN -- produce code for RESUME
SReturn[node, TRUE ! P5.LogHeapFree => RESUME[FALSE, NullLex]];
END;
CommonRet:
PROC [t: Tree.Link]
RETURNS [common:
BOOL ←
TRUE] =
BEGIN -- test if the returns list duplicats the returns declaration
sei: ISEIndex;
Item:
PROC [t: Tree.Link]
RETURNS [
BOOL] =
BEGIN
WITH t
SELECT
FROM
symbol => common ← (sei = index);
literal, subtree => common ← FALSE;
ENDCASE;
IF sei # ISENull THEN sei ← P5U.NextVar[SymbolOps.NextSe[sei]];
RETURN [~common]
END;
IF t = Tree.Null THEN RETURN;
IF CPtr.bodyOutRecord # CSENull
THEN
sei ← P5U.NextVar[ctxb[seb[CPtr.bodyOutRecord].fieldCtx].seList]
ELSE RETURN [FALSE];
TreeOps.SearchList[t, Item];
RETURN
END;
Lock:
PUBLIC
PROC [node: Tree.Index]
RETURNS [Node ←
NIL] =
BEGIN
saveLock: Tree.Link = mLock;
SetLock[tb[node].son[2]];
tb[node].son[1] ← P5.StatementTree[tb[node].son[1]];
InsertRetLabels[TRUE]; -- we are in an INLINE procedure
mLock ← saveLock;
END;
StringInit:
PUBLIC
PROC [node: Tree.Index]
RETURNS [Node ←
NIL] =
BEGIN -- inits string storage and pushes pointer on stack
nchars: CARDINAL = P5U.TreeLiteralValue[tb[node].son[2]];
l: se Lexeme ← 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;
END.