DIRECTORY
Alloc: TYPE USING [Notifier, AddNotify, DropNotify],
Code:
TYPE
USING [
actenable, bodyComRetLabel, bodyFileIndex, bodyInRecord, bodyOutRecord,
bodyRetLabel, caseCVState, catchcount, catchoutrecord, cfSize, codeptr,
curctxlvl, fileindex, firstTemp, framesz, inlineFileIndex, mainBody,
reentryLabel, StackNotEmptyAtStatement, substenable, tailJumpOK,
tempcontext, tempstart, xtracting],
CodeDefs:
TYPE
USING [
AddressNotify, Base, CallsNotify, CCIndex, CCNull, codeType,
ConstructorNotify, CountingNotify, CrossJumpNotify, DJumpsNotify,
ExpressionNotify, FinalNotify, FlowExpressionNotify, FlowNotify, JumpCCNull,
LabelCCIndex, LabelCCNull, Lexeme, MaxParmsInStack, NULLfileindex, NullLex,
OutCodeNotify, PeepholeNotify, SelectionNotify, StatementNotify,
StatementStateRecord, StoreNotify, TempNotify, VarBasicsNotify, VarIndex,
VarMoveNotify, VarUtilsNotify],
ComData:
TYPE
USING [
bodyIndex, globalFrameSize, nErrors, objectBytes, stopping, table, textIndex],
FOpCodes:
TYPE
USING [
qLADRB, qLI, qLINKB, qLL, qME, qMEL, qMXD, qMXDL, qPSD, qRET, qSG],
P5:
TYPE
USING [
BuildArgRecord, EndCodeFile, Exp, ExtractFrom, Fixup, FreeTempSei,
GenStringBodyLex, LogHeapFree, OutBinary, PopStatementState, PRetLex,
ProcessGlobalStrings, ProcessLocalStrings, PurgePendTempList,
PushArgRecord, PushStatementState, StartCodeFile, StatementTree, TempInit],
P5L: TYPE USING [LoadAddress, TOSAddrLex, TOSLex, VarFinal, VarForLex],
P5S: TYPE USING [],
P5U:
TYPE
USING [
CgenUtilInit, CgenUtilNotify, CreateLabel, DeleteCell, InsertLabel, LabelAlloc,
NextVar, OperandType, Out0, Out1, OutJump, OutSource, PushLitVal, TreeLiteralValue,
WordsForSei],
PrincOps: TYPE USING [globalbase, localbase],
Stack:
TYPE
USING [
Decr, Depth, Dump, Incr, Init, Load, Off, On, Reset, StackImplNotify, Top],
SymbolOps: TYPE USING [EnumerateBodies, NextSe, TransferTypes],
Symbols:
TYPE
USING [
Base, bodyType, BTIndex, CBTIndex, CSEIndex, CSENull, ctxType,
ISEIndex, ISENull, RecordSEIndex, RecordSENull, RootBti, seType],
Tree: TYPE USING [Base, Index, Link, Null, treeType],
TreeOps:
TYPE
USING [
FreeNode, FreeTree, MakeList, MakeNode, PushList, PushNode, PushSe, PushTree,
SearchList];
Driver:
PROGRAM
IMPORTS Alloc, MPtr: ComData, CPtr: Code, CodeDefs, P5, P5L, P5U, Stack, SymbolOps, TreeOps
EXPORTS P5, P5S =
BEGIN
OPEN CodeDefs;
imported definitions
localbase: CARDINAL = PrincOps.localbase;
globalbase: CARDINAL = PrincOps.globalbase;
CSEIndex: TYPE = Symbols.CSEIndex;
CSENull: CSEIndex = Symbols.CSENull;
ISEIndex: TYPE = Symbols.ISEIndex;
ISENull: ISEIndex = Symbols.ISENull;
RecordSEIndex: TYPE = Symbols.RecordSEIndex;
RecordSENull: RecordSEIndex = Symbols.RecordSENull;
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]; FlowExpressionNotify[base]; FlowNotify[base];
Stack.StackImplNotify[base];
TempNotify[base];
StatementNotify[base]; SelectionNotify[base];
ConstructorNotify[base]; StoreNotify[base]; CountingNotify[base];
CallsNotify[base];
OutCodeNotify[base]; FinalNotify[base];
CrossJumpNotify[base]; DJumpsNotify[base];
PeepholeNotify[base];
VarUtilsNotify[base]; VarBasicsNotify[base]; VarMoveNotify[base];
END;
CodePassError: PUBLIC ERROR [n: CARDINAL] = CODE;
P5Error: PUBLIC PROC [n: CARDINAL] = {ERROR CodePassError[n]};
codeStart: LabelCCIndex;
mLock: Tree.Link;
longLock: BOOL;
Module:
PUBLIC
PROC =
BEGIN -- main driver for code generation
(MPtr.table).AddNotify[DriverNotify];
CPtr.bodyInRecord ← CPtr.bodyOutRecord ← RecordSENull;
P5U.CgenUtilInit[MPtr.table];
P5.TempInit[];
Stack.Init[]; Stack.Off[];
CPtr.inlineFileIndex ← NULLfileindex;
CPtr.xtracting ← FALSE;
CPtr.caseCVState ← none;
CPtr.catchoutrecord ← RecordSENull;
CPtr.catchcount ← 0;
CPtr.actenable ← CPtr.substenable ← LabelCCNull;
CPtr.codeptr ← codeStart ← LabelCCNull;
P5.StartCodeFile[];
[] ← SymbolOps.EnumerateBodies[Symbols.RootBti, Body];
MPtr.objectBytes ← P5.EndCodeFile[];
Stack.Reset[];
P5L.VarFinal[];
(MPtr.table).DropNotify[DriverNotify]
END;
Body:
PROC [bti: Symbols.BTIndex]
RETURNS [stop:
BOOL ←
FALSE] =
BEGIN
WITH body: bb[bti]
SELECT
FROM
Callable => IF ~body.inline THEN ProcBody[LOOPHOLE[bti]];
ENDCASE;
END;
ProcBody:
PROC [bti: Symbols.CBTIndex] =
BEGIN -- produces code for body
bodyNode: Tree.Index;
CPtr.mainBody ← (bti = Symbols.RootBti);
MPtr.bodyIndex ← bti;
MPtr.textIndex ← bb[bti].sourceIndex;
WITH bi: bb[bti].info
SELECT
FROM
Internal =>
BEGIN
bodyNode ← bi.bodyTree;
CPtr.curctxlvl ← bb[bti].level;
set up input and output contexts
[CPtr.bodyInRecord, CPtr.bodyOutRecord] ← SymbolOps.TransferTypes[bb[bti].ioType];
CPtr.firstTemp ← CPtr.tempstart ← CPtr.framesz ← bi.frameSize;
CPtr.cfSize ← 0;
CPtr.bodyFileIndex ← CPtr.fileindex ← bb[bti].sourceIndex;
CPtr.tailJumpOK ← TRUE;
init the code stream and put down bracketing labels
CPtr.bodyRetLabel ← P5U.LabelAlloc[];
CPtr.bodyComRetLabel ← P5U.LabelAlloc[];
CPtr.codeptr ← CCNull;
codeStart ← P5U.CreateLabel[];
P5U.OutSource[bb[bti].sourceIndex];
init data for creating temporaries
ctxb[CPtr.tempcontext].level ← CPtr.curctxlvl;
tuck parameters away into the frame
IF Stack.Depth[] # 0 THEN SIGNAL CPtr.StackNotEmptyAtStatement;
WITH bb[bti]
SELECT
FROM
Inner => P5U.Out1[FOpCodes.qLINKB, frameOffset-localbase];
ENDCASE;
Stack.On[];
CPtr.reentryLabel ← P5U.CreateLabel[]; -- for reentry on tail recursion
PopInVals[CPtr.bodyInRecord, FALSE];
P5.PurgePendTempList[];
do type table and string literals
IF CPtr.mainBody
THEN
MPtr.globalFrameSize ← P5.ProcessGlobalStrings[MPtr.globalFrameSize];
CPtr.firstTemp ← CPtr.tempstart ← P5.ProcessLocalStrings[CPtr.tempstart, bi.thread];
bi.frameSize ← CPtr.framesz ← MAX [CPtr.framesz, CPtr.tempstart];
do initialization code and main body
IF CPtr.mainBody
AND MPtr.stopping
THEN
{P5U.Out1[FOpCodes.qLADRB, 0]; P5U.Out1[FOpCodes.qSG, globalbase]};
IF bb[bti].entry THEN SetLock[tb[bodyNode].son[4]]
ELSE mLock ← Tree.Null;
generate code for declaration initializations and statements
tb[bodyNode].son[2] ← P5.StatementTree[tb[bodyNode].son[2]];
tb[bodyNode].son[3] ← P5.StatementTree[tb[bodyNode].son[3]];
tb[bodyNode].son[1] ← Tree.Null;
IF Stack.Depth[] # 0 THEN SIGNAL CPtr.StackNotEmptyAtStatement;
push the return values onto the stack
InsertRetLabels[mLock # Tree.Null];
Stack.Reset[];
IF CPtr.mainBody
AND MPtr.stopping
THEN
{P5U.Out1[FOpCodes.qLI, 0]; P5U.Out1[FOpCodes.qSG, globalbase]};
Stack.Off[];
P5U.Out0[FOpCodes.qRET];
P5.PurgePendTempList[];
write frame size into bodyitem
bi.frameSize ← CPtr.framesz;
fixup jumps
IF MPtr.nErrors = 0 THEN P5.Fixup[codeStart, bb[bti].entryIndex];
END;
ENDCASE;
TreeOps.FreeNode[bodyNode];
IF MPtr.nErrors = 0 THEN P5.OutBinary[bti, codeStart]
ELSE
BEGIN
c, next: CCIndex;
FOR c ← codeStart, next
WHILE c # CCNull
DO
next ← cb[c].flink;
P5U.DeleteCell[c];
ENDLOOP;
END;
END;
SSubst:
PROC [node: Tree.Index]
RETURNS [nRets:
CARDINAL] =
BEGIN
saveEnable: LabelCCIndex = CPtr.substenable;
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]];
IF Stack.Depth[] # 0 THEN SIGNAL CPtr.StackNotEmptyAtStatement;
InsertRetLabels[FALSE]; -- if entry procedure, lock already dealt with
Stack.Reset[];
nRets ← P5U.WordsForSei[CPtr.bodyOutRecord];
P5.PopStatementState[@ss]; CPtr.substenable ← saveEnable;
RETURN
END;
InsertRetLabels:
PROC [monitored:
BOOL] =
BEGIN
IF CPtr.bodyComRetLabel # LabelCCNull
THEN
BEGIN
P5U.InsertLabel[CPtr.bodyComRetLabel];
IF monitored THEN ReleaseLock[];
IF cb[CPtr.bodyComRetLabel].jumplist # JumpCCNull THEN PushRetVals[];
P5U.InsertLabel[CPtr.bodyRetLabel];
CPtr.bodyComRetLabel ← LabelCCNull;
CPtr.bodyRetLabel ← LabelCCNull;
END;
END;
Subst:
PUBLIC
PROC [node: Tree.Index] =
BEGIN
[] ← SSubst[node];
END;
SubstExp:
PUBLIC
PROC [node: Tree.Index]
RETURNS [Lexeme] =
BEGIN
nRets: CARDINAL = SSubst[node];
RETURN [P5.PRetLex[nRets, node, FALSE]]
END;
PopInVals:
PUBLIC
PROC [irecord: RecordSEIndex, isenable:
BOOL] =
BEGIN
nParms: CARDINAL;
r: VarIndex;
t: Tree.Link;
sei: ISEIndex;
np: CARDINAL ← 0;
IF irecord = CSENull THEN RETURN;
nParms ← P5U.WordsForSei[irecord];
IF nParms = 0 THEN RETURN;
IF isenable
THEN
IF nParms <= 1 THEN RETURN
ELSE P5U.Out1[FOpCodes.qLL,localbase+1];
sei ← P5U.NextVar[ctxb[seb[irecord].fieldCtx].seList];
UNTIL sei = ISENull
DO
TreeOps.PushSe[sei]; TreeOps.PushTree[Tree.Null]; TreeOps.PushNode[assign, 2];
np ← np+1;
sei ← P5U.NextVar[SymbolOps.NextSe[sei]];
ENDLOOP;
TreeOps.PushList[np];
t ← TreeOps.MakeNode[exlist, 1];
IF nParms > MaxParmsInStack
OR (isenable
AND nParms > 1)
THEN
BEGIN
IF ~isenable THEN Stack.Incr[1];
r ← P5L.TOSAddrLex[nParms].lexbdoi;
END
ELSE
BEGIN
Stack.Incr[nParms];
r ← P5L.VarForLex[P5L.TOSLex[nParms]];
END;
P5.ExtractFrom[t, irecord, r, (nParms > MaxParmsInStack AND ~isenable)];
t ← TreeOps.FreeTree[t];
END;
PushRetVals:
PROC =
BEGIN -- pushes the return vals from a body onto the stack
sei: ISEIndex;
nRetVals: CARDINAL;
np: CARDINAL ← 0;
t: Tree.Link;
IF CPtr.bodyOutRecord = CSENull THEN RETURN;
nRetVals ← P5U.WordsForSei[CPtr.bodyOutRecord];
sei ← ctxb[seb[CPtr.bodyOutRecord].fieldCtx].seList;
UNTIL sei = ISENull
DO
TreeOps.PushSe[sei];
np ← np+1;
sei ← P5U.NextVar[SymbolOps.NextSe[sei]];
ENDLOOP;
t ← TreeOps.MakeList[np];
[] ← P5.BuildArgRecord[t, CPtr.bodyOutRecord, FALSE, FALSE, FALSE];
t ← TreeOps.FreeTree[t];
END;
SetLock:
PROC [lock: Tree.Link] =
BEGIN
retryEntry: LabelCCIndex = P5U.CreateLabel[];
longLock ← P5L.LoadAddress[P5L.VarForLex[P5.Exp[(mLock ← lock)]]];
P5U.Out0[IF longLock THEN FOpCodes.qMEL ELSE FOpCodes.qME];
P5U.Out1[FOpCodes.qLI, 0];
P5U.OutJump[JumpE, retryEntry];
END;
ReleaseLock:
PUBLIC
PROC =
BEGIN
Stack.Dump[];
[] ← P5L.LoadAddress[P5L.VarForLex[P5.Exp[mLock]]];
P5U.Out0[IF longLock THEN FOpCodes.qMXDL ELSE FOpCodes.qMXD];
END;
SReturn:
PROC [node: Tree.Index, isResume:
BOOL] =
BEGIN -- generate code for RETURN and RESUME
nRetVals: CARDINAL;
nStack: CARDINAL;
rSei: RecordSEIndex;
monitored: BOOL;
IF ~isResume
AND CommonRet[tb[node].son[1]]
THEN
BEGIN
P5U.OutJump[Jump, CPtr.bodyComRetLabel];
RETURN
END;
monitored ← ~isResume AND tb[node].attr1;
IF monitored
AND tb[node].attr2
THEN
{ReleaseLock[]; monitored ← FALSE};
rSei ← IF isResume THEN CPtr.catchoutrecord ELSE CPtr.bodyOutRecord;
nRetVals ←
IF tb[node].attr3
THEN P5.PushArgRecord[tb[node].son[1], rSei, isResume, isResume, FALSE]
ELSE P5.BuildArgRecord[tb[node].son[1], rSei, isResume, isResume, FALSE];
nStack ←
IF nRetVals > MaxParmsInStack OR isResume AND nRetVals # 0 THEN 1
ELSE nRetVals;
IF monitored
THEN
{Stack.Dump[]; ReleaseLock[]};
IF nStack # 0
THEN
BEGIN
Stack.Load[Stack.Top[nStack], nStack];
Stack.Decr[nStack]; -- remove from model
END;
IF isResume
THEN
BEGIN
P5U.PushLitVal[1]; Stack.Decr[1];
P5U.Out0[FOpCodes.qRET];
P5U.OutJump[JumpRet, LabelCCNull];
END
ELSE P5U.OutJump[Jump, CPtr.bodyRetLabel];
END;
Result: PUBLIC PROC [node: Tree.Index] = Return;
Return:
PUBLIC
PROC [node: Tree.Index] =
BEGIN -- produce code for RETURN
SReturn[node, FALSE ! P5.LogHeapFree => RESUME[FALSE, NullLex]];
END;
Resume:
PUBLIC
PROC [node: Tree.Index] =
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] =
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 [Lexeme] =
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.