<> <> <> <> <> 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]; <> <> < P5U.Out1[FOpCodes.qLINKB, frameOffset-localbase];>> <> 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 < 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 <> <> <> <> <> END; <<>> StringInit: PUBLIC PROC [node: Tree.Index] RETURNS [Node _ NIL] = BEGIN -- inits string storage and pushes pointer on stack <> <> <<[] _ P5L.LoadAddress[P5L.VarForLex[l]];>> <> <> <> <> <> END; <<>> END.