-- Driver.mesa, last modified by Sweet, January 15, 1980 3:18 PM

DIRECTORY
AltoDefs: FROM "altodefs" USING [BYTE, wordlength],
Code: FROM "code" USING [
actenable, bodyComRetLabel, bodyInRecord, bodyOutRecord, bodyRetLabel,
caseCVState, catchcount, catchoutrecord, codeptr, curctxlvl, dStar,
fileindex, framesz, inlineFileIndex, mainBody, StackNotEmptyAtStatement,
tempcontext, tempstart, xtracting],
CodeDefs: FROM "codedefs" USING [
AddressNotify, AJumpsNotify, CallsNotify, CCIndex, CCNull, CgenUtilNotify,
ConstructorNotify, CrossJumpNotify, DJumpsNotify, ExpressionNotify,
FinalNotify, FlowExpressionNotify, FlowNotify, JumpCCNull, LabelCCIndex,
LabelCCNull, Lexeme, MaxParmsInStack, NULLfileindex, NullLex,
OutCodeNotify, PeepholeNotify, StackImplNotify, StatementNotify,
StatementStateRecord, StoreNotify, TempNotify, VarBasicsNotify, VarIndex,
VarMoveNotify, VarUtilsNotify],
ComData: FROM "comdata" USING [
bodyIndex, bodyRoot, mainBody, nErrors, objectBytes, objectFrameSize,
stopping, switches, textIndex],
ControlDefs: FROM "controldefs" USING [globalbase, localbase],
FOpCodes: FROM "fopcodes" USING [
qLADRB, qLI, qLINKB, qLL, qME, qMEL, qMXD, qMXDL, qRET, qSG],
P5: FROM "p5" USING [
BuildArgRecord, EndCodeFile, Exp, ExtractFrom, Fixup, LogHeapFree,
OutBinary, PopStatementState, PRetLex, ProcessGlobalStrings,
ProcessLocalStrings, PurgePendTempList, PushStatementState, StartCodeFile,
StatementTree, SysError, TempInit],
P5L: FROM "p5l" USING [
LoadAddress, TOSAddrLex, TOSLex, VarFinal, VarForLex],
P5S: FROM "p5s",
P5U: FROM "p5u" USING [
CgenUtilInit, CreateLabel, DeleteCell, InsertLabel, LabelAlloc, NextVar,
OperandType, Out0, Out1, OutJump, PushLitVal, SetCodeIndex, WordsForSei],
Stack: FROM "stack" USING [
Decr, Depth, Dump, Incr, Init, Load, Off, On, Reset, Top],
SymbolOps: FROM "symbolops" USING [NextSe, TransferTypes],
Symbols: FROM "symbols" USING [
BitAddress, bodyType, BTIndex, BTNull, CBTIndex, ContextLevel, CSEIndex,
CSENull, CTXIndex, ctxType, HTIndex, HTNull, ISEIndex, ISENull, lG, lL,
MDIndex, RecordSEIndex, RecordSENull, SEIndex, SENull, seType, typeTYPE],
Table: FROM "table" USING [Base, Notifier],
Tree: FROM "tree" USING [Index, Link, Null, treeType],
TreeOps: FROM "treeops" USING [
FreeNode, MakeList, MakeNode, PushList, PushNode, PushSe, PushTree,
ScanList];

Driver: PROGRAM
IMPORTS MPtr: ComData, LCPtr: Code, P5U, CodeDefs, P5L, P5, Stack,
SymbolOps, TreeOps
EXPORTS CodeDefs, P5, P5S =
BEGIN
OPEN CodeDefs;
CPtr: POINTER TO FRAME[Code] = LCPtr;

-- imported definitions

BYTE: TYPE = AltoDefs.BYTE;
wordlength: CARDINAL = AltoDefs.wordlength;

localbase: CARDINAL = ControlDefs.localbase;
globalbase: CARDINAL = ControlDefs.globalbase;

BitAddress: TYPE = Symbols.BitAddress;
BTIndex: TYPE = Symbols.BTIndex;
CBTIndex: TYPE = Symbols.CBTIndex;
BTNull: BTIndex = Symbols.BTNull;
ContextLevel: TYPE = Symbols.ContextLevel;
CSEIndex: TYPE = Symbols.CSEIndex;
CSENull: CSEIndex = Symbols.CSENull;
CTXIndex: TYPE = Symbols.CTXIndex;
HTIndex: TYPE = Symbols.HTIndex;
HTNull: HTIndex = Symbols.HTNull;
ISEIndex: TYPE = Symbols.ISEIndex;
ISENull: ISEIndex = Symbols.ISENull;
lG: ContextLevel = Symbols.lG;
lL: ContextLevel = Symbols.lL;
MDIndex: TYPE = Symbols.MDIndex;
RecordSEIndex: TYPE = Symbols.RecordSEIndex;
RecordSENull: RecordSEIndex = Symbols.RecordSENull;
SEIndex: TYPE = Symbols.SEIndex;
SENull: SEIndex = Symbols.SENull;
typeTYPE: CSEIndex = Symbols.typeTYPE;


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)

DriverNotify: PUBLIC Table.Notifier =
BEGIN -- called by allocator whenever table area is repacked
seb ← base[Symbols.seType];
ctxb ← base[Symbols.ctxType];
bb ← base[Symbols.bodyType];
cb ← tb ← base[Tree.treeType];
CgenUtilNotify[base];
AddressNotify[base];
ExpressionNotify[base];
FlowExpressionNotify[base];
FlowNotify[base];
StackImplNotify[base];
TempNotify[base];
StatementNotify[base];
ConstructorNotify[base];
StoreNotify[base];
CallsNotify[base];
OutCodeNotify[base];
FinalNotify[base];
CrossJumpNotify[base];
AJumpsNotify[base];
DJumpsNotify[base];
PeepholeNotify[base];
VarUtilsNotify[base];
VarBasicsNotify[base];
VarMoveNotify[base];
RETURN
END;


codestart: CCIndex;
mlock: Tree.Link;
longlock: BOOLEAN;

Module: PUBLIC PROCEDURE =
BEGIN -- main driver for code generation
bti, prev: BTIndex;

CPtr.bodyInRecord ← CPtr.bodyOutRecord ← RecordSENull;
P5U.CgenUtilInit[];
P5.TempInit[];
Stack.Init[];
Stack.Off[];
CPtr.inlineFileIndex ← NULLfileindex;
CPtr.xtracting ← FALSE;
CPtr.caseCVState ← none;
CPtr.catchoutrecord ← RecordSENull;
CPtr.catchcount ← 0;
CPtr.actenable ← LabelCCNull;
CPtr.codeptr← codestart ← CCNull;
CPtr.dStar ← ~MPtr.switches[’a];
P5.StartCodeFile[];
bti ← MPtr.bodyRoot;
DO
WITH bb[bti] SELECT FROM
Callable => IF ~inline THEN Body[LOOPHOLE[bti]];
ENDCASE;
IF bb[bti].firstSon # BTNull
THEN bti ← bb[bti].firstSon
ELSE
DO
prev ← bti; bti ← bb[bti].link.index;
IF bti = BTNull THEN GO TO Done;
IF bb[prev].link.which # parent THEN EXIT;
ENDLOOP;
REPEAT
Done => NULL;
ENDLOOP;
MPtr.objectBytes ← P5.EndCodeFile[];
Stack.Reset[];
P5L.VarFinal[];
RETURN;
END;


Body: PROCEDURE [bti: CBTIndex] =
BEGIN -- produces code for body
psei: CSEIndex ← bb[bti].ioType;
bodynode: Tree.Index;

CPtr.mainBody ← bti = MPtr.mainBody;
MPtr.bodyIndex ← bti;

WITH bi: bb[bti].info SELECT FROM
Internal =>
BEGIN
MPtr.textIndex ← bi.sourceIndex;
bodynode ← bi.bodyTree;
CPtr.curctxlvl ← bb[bti].level;

-- set up input and output contexts
[CPtr.bodyInRecord, CPtr.bodyOutRecord] ← SymbolOps.TransferTypes[psei];

IF CPtr.mainBody THEN
BEGIN
MPtr.objectFrameSize ← bi.frameSize;
bi.frameSize ← localbase;
CPtr.curctxlvl ← lL;
END;
CPtr.tempstart ← CPtr.framesz ← bi.frameSize;
P5U.SetCodeIndex[CPtr.fileindex ← bi.sourceIndex];

-- init the code stream and put down bracketing labels

CPtr.bodyRetLabel ← P5U.LabelAlloc[];
CPtr.bodyComRetLabel ← P5U.LabelAlloc[];
CPtr.codeptr ← CCNull;
codestart ← P5U.CreateLabel[];

-- 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 => BEGIN
P5U.Out1[FOpCodes.qLINKB, frameOffset-localbase];
END;
ENDCASE;
Stack.On[];
PopInVals[CPtr.bodyInRecord, FALSE];
P5.PurgePendTempList[];

-- do string literals

IF CPtr.mainBody THEN
MPtr.objectFrameSize ← P5.ProcessGlobalStrings[MPtr.objectFrameSize];
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
BEGIN OPEN FOpCodes;
P5U.Out1[qLADRB, 0];
P5U.Out1[qSG, globalbase];
END;

IF tb[bodynode].attr1 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
BEGIN P5U.Out1[FOpCodes.qLI, 0]; P5U.Out1[FOpCodes.qSG, globalbase]; END;
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];

-- output the object code

P5U.SetCodeIndex[NULLfileindex];
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;
ENDCASE;
RETURN
END;

SSubst: PROCEDURE [node: Tree.Index] RETURNS [nrets: CARDINAL] =
BEGIN
ss: StatementStateRecord;
tsei: CSEIndex ← P5U.OperandType[tb[node].son[1]];
P5.PushStatementState[@ss];
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];
END;

InsertRetLabels: PROCEDURE [monitored: BOOLEAN] =
BEGIN
IF CPtr.bodyComRetLabel = LabelCCNull THEN RETURN;
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;


Subst: PUBLIC PROCEDURE [node: Tree.Index] =
BEGIN
[] ← SSubst[node];
END;

SubstExp: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
BEGIN
nrets: CARDINAL ← SSubst[node];
RETURN [P5.PRetLex[nrets, node, FALSE]];
END;

PopInVals: PUBLIC PROCEDURE [irecord: RecordSEIndex, isenable: BOOLEAN] =
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
OPEN TreeOps;
PushSe[sei]; PushTree[Tree.Null]; 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)];
RETURN
END;


PushRetVals: PROCEDURE =
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
OPEN TreeOps;
PushSe[sei];
np ← np+1;
sei ← P5U.NextVar[SymbolOps.NextSe[sei]];
ENDLOOP;
t ← TreeOps.MakeList[np];
sei ← ctxb[seb[CPtr.bodyOutRecord].fieldCtx].seList;
IF seb[P5U.NextVar[sei]].hash = HTNull THEN -- anonymous RETURNS list
BEGIN
P5.SysError[];
RETURN
END;
[] ← P5.BuildArgRecord[t, CPtr.bodyOutRecord, FALSE];
RETURN
END;

SetLock: PROCEDURE [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 PROCEDURE =
BEGIN
Stack.Dump[];
[] ← P5L.LoadAddress[P5L.VarForLex[P5.Exp[mlock]]];
P5U.Out0[IF longlock THEN FOpCodes.qMXDL ELSE FOpCodes.qMXD];
RETURN
END;


SReturn: PROCEDURE [node: Tree.Index, isresume: BOOLEAN] =
BEGIN -- generate code for RETURN and RESUME
nretvals: CARDINAL;
nstack: CARDINAL;
rsei: RecordSEIndex;
monitored: BOOLEAN;

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
BEGIN ReleaseLock[]; monitored ← FALSE; END;
rsei ← IF isresume THEN CPtr.catchoutrecord ELSE CPtr.bodyOutRecord;
nretvals ← P5.BuildArgRecord[tb[node].son[1], rsei, isresume, isresume];
nstack ←
IF nretvals > MaxParmsInStack OR isresume AND nretvals # 0 THEN 1
ELSE nretvals;

IF monitored THEN
BEGIN
Stack.Dump[]; ReleaseLock[];
END;
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];
RETURN
END;


Result: PUBLIC PROCEDURE [node: Tree.Index] =
BEGIN -- produce code for RETURN
SReturn[node, FALSE]; -- let outer statement catch LogHeapFree
RETURN
END;

Return: PUBLIC PROCEDURE [node: Tree.Index] =
BEGIN -- produce code for RETURN
SReturn[node, FALSE !P5.LogHeapFree => RESUME[FALSE, NullLex]]; RETURN
END;


Resume: PUBLIC PROCEDURE [node: Tree.Index] =
BEGIN -- produce code for RESUME
SReturn[node, TRUE !P5.LogHeapFree => RESUME[FALSE, NullLex]]; RETURN
END;


CommonRet: PROCEDURE [t: Tree.Link] RETURNS [common: BOOLEAN] =
BEGIN -- test if the returns list duplicats the returns declaration
sei: ISEIndex;
scr: PROCEDURE [t: Tree.Link] =
BEGIN
IF ~common THEN RETURN;
WITH t SELECT FROM
literal => common ← FALSE;
symbol => common ← sei = index;
subtree => common ← FALSE;
ENDCASE;
IF sei # SENull THEN sei ← P5U.NextVar[SymbolOps.NextSe[sei]];
RETURN
END;

common ← TRUE;
IF t = Tree.Null THEN RETURN;
IF CPtr.bodyOutRecord # CSENull THEN
sei ← P5U.NextVar[ctxb[seb[CPtr.bodyOutRecord].fieldCtx].seList]
ELSE RETURN [FALSE];
TreeOps.ScanList[t, scr];
RETURN
END;

Lock: PUBLIC PROCEDURE [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;



END...