DIRECTORY
Alloc,
Code,
CodeDefs,
ComData,
CompilerUtil,
FOpCodes,
IntCodeDefs,
IntCodeUtils,
Log,
P5,
P5S,
P5U,
ParseIntCode: TYPE USING [ToStream],
PrettyIntCode: TYPE USING [ToStream],
PrincOps,
SafeStorage: TYPE USING [GetSystemZone],
SourceMap,
SymbolOps,
Symbols,
Tree,
TreeOps;

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;


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;
[] _ SymbolOps.EnumerateBodies[Symbols.RootBti, Body];
modNode.procs _ bodies.head;
(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];

[CPtr.bodyInRecord, CPtr.bodyOutRecord] _ SymbolOps.TransferTypes[bb[bti].ioType];

CPtr.bodyStartLoc _ CPtr.fileLoc _ SourceMap.Up[bb[bti].sourceIndex];
CPtr.tailJumpOK _ TRUE;




SymbolOps.SetCtxLevel[CPtr.tempcontext, CPtr.curctxlvl];


lambda _ z.NEW[NodeRep.lambda _ [details: lambda[parent: enclosingContext, formalArgs: GetFormals[CPtr.bodyInRecord], body: NIL]]]; -- will fill in body field soon



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];


IF bb[bti].entry THEN SetLock[cl, tb[bodyNode].son[4]]
ELSE mLock _ Tree.Null;


P5.DeclList[cl, tb[bodyNode].son[2]];
P5.StatementList[cl, tb[bodyNode].son[3]];

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
END;

Subst: PUBLIC PROC [node: Tree.Index] RETURNS [Node] =
BEGIN
RETURN[SSubst[node]];
END;

SubstExp: PUBLIC PROC [node: Tree.Index] RETURNS [Node _ NIL] =
BEGIN
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
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
END;
StringInit: PUBLIC PROC [node: Tree.Index] RETURNS [Node _ NIL] =
BEGIN -- inits string storage and pushes pointer on stack
END;
END.


@Driver.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Sweet, June 2, 1986 11:37:09 am PDT
Satterthwaite, November 26, 1985 1:40:30 pm PST
Russ Atkinson (RRA) March 6, 1985 11:16:23 pm PST
imported definitions
P5.StartCodeFile[];
MPtr.objectBytes _ P5.EndCodeFile[];
do something with the modNode
set up input and output contexts
init the code stream and put down bracketing labels
P5U.OutSource[cl, SourceMap.Up[bb[bti].sourceIndex]];
init data for creating temporaries
tuck parameters away into the frame
WITH bb[bti] SELECT FROM
Inner => P5U.Out1[FOpCodes.qLINKB, frameOffset-localbase];
ENDCASE;
do type table and string literals
get variables declared
do initialization code and main body
generate code for declaration initializations and statements
push the return values onto the stack (is this necessary?)
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
nRets: CARDINAL = SSubst[node];
RETURN [P5.PRetLex[nRets, node, FALSE]]
SReturn[node, TRUE ! P5.LogHeapFree => RESUME[FALSE, NullLex]];
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;

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]]

Κ2˜
codeš
œ™Kšœ
Οm
œ1™<Kš
œ#™#Kš
œ/™/K™1—K˜š
Οk	˜	Kš
œ˜Kš
œ˜Kš
œ	˜	Kš
œ˜K˜
Kš
œ	˜	K˜K˜
K˜Kš
œ˜Kš
œ˜Kš
œ˜Kšœžœ
žœ˜$Kšœžœ
žœ˜%Kš
œ	˜	Kšœ
žœ
žœ˜(Kš
œ
˜
Kš
œ
˜
Kš
œ˜Kš
œ˜š
œ˜K˜——šœž˜KšžœŸ
˜¦
Kšžœ"žœ˜KK˜Kš
œ™K˜Kšœžœ˜)Kšœžœ˜+K˜Kšœ
žœ˜"Kšœ
žœ˜"Kš
œ$˜$Kšœ
žœ˜"K˜$Kšœ
žœ˜"K˜$Kšœžœ˜,K˜3Kšœ
žœ˜"K˜Kšœ
žœ˜K˜K˜KšœΟc˜)KšœŸ#˜7KšœŸ"˜7KšœŸ˜2KšœŸ˜-K˜˜KšžœŸ6˜=K˜K˜K˜K˜K˜K˜K˜K˜*K˜.Kšœ.Ÿ˜FK˜Kšžœ
˜K˜K˜—Kš	œžœ
žœžœžœ
˜1K˜Kšœžœ
žœ˜-K˜šΟnœžœ
žœ˜Kšžœ
Ÿ"˜(Kš
œ˜K˜šžœž˜Kš
œS˜S—KšžœS˜XKš
œ!˜!Kšžœ
˜K˜—Kš
 œžœ
žœžœžœ˜>K˜K˜K˜K˜Kš	œžœžœžœžœ˜JKšœžœžœ#žœ˜NKšœžœžœžœžœ
žœ
˜@Kšœžœ
žœ
˜"K˜š 
œžœ
žœ"˜<Kšœžœ˜"K˜Kšžœ žœ
žœ˜9Kšžœžœ;˜`K˜K˜—š œžœ ˜5Kšœžœ˜"Kš
œ#˜#šžœžœ
žœ
˜š	žœžœ%žœžœ
ž˜AK˜Kšžœ
˜——Kšœ'žœ˜,K˜K˜—K˜š œžœ
žœ
žœ	˜$Kšžœ
Ÿ"˜(Kš
œ%˜%K˜š
 œžœžœžœžœ˜@Kš
ž˜K˜šžœžœ
ž˜Kšœžœžœžœ˜@Kšžœ
˜—Kš
œ˜Kšžœ
˜K˜—K˜%Kšœžœ˜.š	žœžœ
žœžœ
Ÿ&˜NKšœžœžœ˜Kšžœ
˜—KšœžœJžœŸ˜xK˜6K˜K˜'K˜"K˜"Kšœžœ
˜Kšœžœ
˜K˜#K™K˜6K˜K™$Kš
Ÿ™K˜&Kšžœ	˜Kšžœ
˜K˜K˜—šœžœ
žœžœ˜GK˜—š 
œžœžœ˜CKšžœžœ
žœžœ˜'Kšžœ%˜+K˜—K˜š œžœžœžœ˜BKšœžœ
˜K˜Kšžœžœ
žœ
˜K˜$šžœž˜K˜Kš
œ'˜'Kšžœžœ
žœžœ˜3K˜K˜)Kšžœ
˜—K˜K˜—š 
œžœžœžœ˜@Kšœžœ
˜K˜Kšžœžœ
žœ
˜K˜$šžœž˜K˜Kš
œ%˜%Kšžœžœ
žœžœ˜3K˜K˜)Kšžœ
˜—K˜K˜—š œžœžœ˜:Kšžœ
Ÿ˜K˜K˜!Kšœ&žœ
žœžœ˜EK˜Kš
œ˜K˜K˜ K˜(K˜K˜3šžœžœ
ž˜!˜Kš
ž˜K˜K˜Kš
œ+˜+Kš	œžœžœ
žœ
žœ$˜cK˜Kš
œ ™ K˜RK˜Kš
œE˜EKšœžœ
˜K˜Kš
œ3™3K˜K™5K˜Kš
œ"™"K˜K˜8K˜Kš
œ#™#K˜šžœ	žœ
ž™K™:Kšžœ
™—KšœžœnžœŸ˜£
K˜Kš
œ!™!K˜K™K˜šžœ"žœ˜*Kš
œ9˜9K˜.šžœž˜K˜,K˜)Kšžœ
˜—K˜K˜—K˜K˜Kš
œ$™$K˜Kšžœžœ!˜6Kšžœ˜K˜Kš
œ<™<K˜K˜%K˜*K˜Kš
œ:™:Kšžœžœ˜*Kšžœ
˜—Kšžœ
˜K˜—Kš
œ"˜"K˜Kšœžœ.˜7Kšžœ
˜K˜K˜—š œžœžœ˜3Kš
ž˜K™K™2K™?K™;K™4KšœžœŸ.™FK™,K™:Kš
ž™Kšžœ
˜K˜—š œžœ
žœžœ	˜6Kš
ž˜Kšžœ˜Kšžœ
˜K˜—š œžœ
žœžœ˜?Kš
ž˜Kšœžœ™Kšžœžœ™'Kšžœ
˜K˜—š œžœ
žœ˜(Kšžœ
Ÿ4˜:š
œ˜Kšžœžœ	˜-Kšžœ"˜&—KšœžœA˜JKšžœ
˜K˜—š œžœ"˜/Kš
ž˜Kš
œ&˜&Kš
œg˜gKš
œ˜Kšžœ
˜K˜K˜—š œžœ
žœ˜)Kš
ž˜K˜Kš
œb˜bK˜Kšžœ
˜K˜K˜—š œžœžœ˜:Kšžœ
Ÿ˜!K˜!Kšœžœ˜!Kšœžœ˜*Kšœžœ˜+K˜Kš
œ ˜ Kš
œ:˜:K˜šžœžœ˜Kš
œ&˜&K˜—Kšžœžœ˜=Kšžœžœ'˜BKšžœ˜#Kšœžœ?˜Hšžœžœ
žœ˜K˜K˜—Kšžœ
˜K˜—š œžœ
žœžœ˜?K˜—K˜š œžœ
žœžœ˜=Kšžœ
Ÿ˜ Kšœžœžœ
žœ™?Kšžœ
˜K˜K˜—š
 	œžœžœ
žœžœ˜>Kšžœ
Ÿ=˜CK˜K˜š œžœžœžœ˜*Kš
ž˜šžœžœ
ž˜K˜!Kšœžœ
˜#Kšžœ
˜—Kšžœžœ*˜?Kšžœ
˜Kšžœ
˜K˜—Kšžœžœ
žœ
˜šžœž˜$K˜@—Kšžœ
žœžœ˜K˜Kš
ž˜Kšžœ
˜K˜—š
 œžœ
žœžœ	žœ˜;Kš
ž˜K™K™K™4KšœžœŸ ™7K™Kšžœ
˜K™—š
 
œžœ
žœžœ	žœ˜AKšžœ
Ÿ3˜9Kšœžœ)™9K™+K™'K™K™K™K™Kšžœ™Kšžœ
˜K™—Kšžœ
˜K˜K˜——…—%f8Ψ