<<>> <> <> <> <> DIRECTORY C2CBasics, C2CCodeUtils, C2CEmit, C2CGlobalFrame, C2CNames, C2CTarget, IntCodeDefs, IntCodeUtils, IO, PriorityQueue, Rope; C2CGlobalFrameImpl: CEDAR MONITOR IMPORTS C2CBasics, C2CCodeUtils, C2CEmit, C2CNames, C2CTarget, IntCodeUtils, IO, PriorityQueue EXPORTS C2CGlobalFrame = BEGIN OPEN C2CBasics, IntCodeDefs; ROPE: TYPE = Rope.ROPE; myKeyForNameOfGlobalFrame: ATOM ¬ $GlobalFrameName; FindInstallLabel: PROC [moduleNode: IntCodeDefs.ModuleNode] RETURNS [labelNode: LabelNode] = { FOR list: NodeList ¬ moduleNode.procs, list.rest WHILE list#NIL DO WITH list.first SELECT FROM commentNode: CommentNode => {LOOP}; labelNode: LabelNode => { WITH labelNode.label.node SELECT FROM lambdaNode: LambdaNode => IF lambdaNode.kind=install THEN RETURN [labelNode] ELSE CantHappen; ENDCASE => CantHappen; }; ENDCASE => ERROR CantHappen; ENDLOOP; ERROR CantHappen; }; FindInstallProc: PROC [moduleNode: IntCodeDefs.ModuleNode] RETURNS [lambdaNode: LambdaNode] = { labelNode: LabelNode ~ FindInstallLabel[moduleNode]; RETURN [NARROW[labelNode.label.node]] }; GlobalFrameName: PUBLIC PROC [] RETURNS [name: Rope.ROPE] = { <<--returns name of global frame [must already have been generated]>> <<--type of global frame is NOT canonical; it must never be accessed directly>> x: REF ¬ GetProp[myKeyForNameOfGlobalFrame]; WITH x SELECT FROM r: ROPE => RETURN [r]; ENDCASE => CantHappen; --not yet generated }; MakeupNameForGlobalFrame: PROC [] RETURNS [name: Rope.ROPE] = { x: REF ¬ GetProp[myKeyForNameOfGlobalFrame]; IF x#NIL THEN CantHappen; --multiple global frames name ¬ C2CNames.TryName["globalframe"]; PutProp[myKeyForNameOfGlobalFrame, name]; }; GlobalFrameSize: PROC [moduleNode: IntCodeDefs.ModuleNode] RETURNS [frameSize: INT ¬ 0] = { frameMax: INT ¬ 0; FOR list: VarList ¬ moduleNode.vars, list.rest WHILE list#NIL DO var: Var ¬ list.first; bits: INT ¬ C2CTarget.TemporaryBits[var.bits]; --needs to be in synch with front end !!! WITH var.location SELECT FROM globLoc: GlobalVarLocation => { offset: INT ¬ MAX[0, globLoc.id]; --WOW frameMax ¬ MAX[frameMax, offset+bits] }; ENDCASE => CantHappenCedar; frameSize ¬ frameSize+bits; ENDLOOP; frameSize ¬ MAX[frameSize, frameMax]; }; GFPtrOrNil: PROC [node: Node] RETURNS [var: Var¬NIL] = { <<--returns pointer to globalframe in case node is an appropriate declaration >> <<--returns NIL otherwise>> WITH node SELECT FROM decl: DeclNode => { WITH decl.init SELECT FROM oper: OperNode => WITH oper.oper SELECT FROM mesaOp: MesaOper => {IF mesaOp.mesa=globalFrame THEN RETURN [decl.var]}; ENDCASE => {} ENDCASE => {} }; ENDCASE => {} }; IsConstGFAssignment: PROC [node: Node, gfPtr: Var] RETURNS [BOOL ¬ FALSE] = { <<--returns whether node is an assignment of a constant into the global frame>> <<--and also checks whether all the alignments are proper>> <<--Note: We restrict ourself to bitsPerWord assignments only!>> IsQualifyingConst: PUBLIC PROC [node: IntCodeDefs.Node] RETURNS [BOOL ¬ FALSE] = { WITH node SELECT FROM constNode: WordConstNode => RETURN [TRUE]; oper: OperNode => WITH oper.oper SELECT FROM codeOper: CodeOper => { WITH codeOper.label.node SELECT FROM lambda: LambdaNode => RETURN [codeOper.offset=0 AND ~codeOper.direct]; ENDCASE => NULL; }; ENDCASE => NULL; ENDCASE => NULL; }; <<>> WITH node SELECT FROM assign: AssignNode => IF assign.bits=0 AND assign.lhs.bits=C2CTarget.bitsPerWord AND IsQualifyingConst[assign.rhs] THEN { WITH assign.lhs.location SELECT FROM field: FieldLocation => { IF (field.start MOD C2CTarget.bitsPerWord)#0 THEN RETURN [FALSE]; WITH field.base SELECT FROM var: Var => WITH var.location SELECT FROM deref: DerefLocation => WITH deref.addr SELECT FROM pvar: Var => IF pvar.id=gfPtr.id THEN { IF deref.align>=C2CTarget.bestAlignment THEN RETURN [TRUE] }; ENDCASE => {}; ENDCASE => {}; ENDCASE => {}; }; ENDCASE => {} }; ENDCASE => {}; }; PreMunchConstAssign: PROC [on: OrderedNode] RETURNS [size: INT, offset: INT] = { assign: AssignNode ~ NARROW[on.node]; field: FieldLocation ~ NARROW[assign.lhs.location]; size ¬ assign.lhs.bits; offset ¬ field.start; }; MunchConstAssign: PROC [on: OrderedNode] RETURNS [size: INT, offset: INT, value: C2CEmit.Code] = { assign: AssignNode ~ NARROW[on.node]; field: FieldLocation ~ NARROW[assign.lhs.location]; size ¬ assign.lhs.bits; offset ¬ field.start; WITH assign.rhs SELECT FROM const: WordConstNode => value ¬ C2CEmit.CastWord[C2CCodeUtils.ConstC[IntCodeUtils.WordToCard[const.word]]]; oper: OperNode => WITH oper.oper SELECT FROM codeOper: CodeOper => { WITH codeOper.label.node SELECT FROM lambda: LambdaNode => { procName: ROPE ¬ C2CNames.LabName[id: codeOper.label.id, class: "Proc"]; value ¬ C2CEmit.Cat["(word) ", procName]; }; ENDCASE => ERROR; }; ENDCASE => ERROR; ENDCASE => ERROR; }; OffsetSortPred: PriorityQueue.SortPred = { xon: OrderedNode ¬ NARROW[x]; yon: OrderedNode ¬ NARROW[y]; xassign: AssignNode ¬ NARROW[xon.node]; yassign: AssignNode ¬ NARROW[yon.node]; xfield: FieldLocation ¬ NARROW[xassign.lhs.location]; yfield: FieldLocation ¬ NARROW[yassign.lhs.location]; SELECT TRUE FROM xfield.start { IF xfield.start+xassign.lhs.bits>yfield.start THEN CantHappen; --single word consts! RETURN [TRUE]; }; yfield.start { IF yfield.start+yassign.lhs.bits>xfield.start THEN CantHappen; --single word consts! RETURN [FALSE]; }; ENDCASE => { <<--conflict; make sort anti-stable [last one returned first]>> RETURN [xon.count>yon.count]; }; }; OrderedNode: TYPE = REF OrderedNodeRec; OrderedNodeRec: TYPE = RECORD [node: Node, count: INT]; <<--we want an anti-stable sort; therefore we add a count to the nodes...>> GetAndRemoveConstantInits: PROC [lambdaNode: LambdaNode] RETURNS [pqRef: PriorityQueue.Ref] = { <<--removes constant initialization nodes from procedure>> <<--and returns priority queue containing the removed nodes>> count: INT ¬ 0; on: OrderedNode; body: NodeList ¬ lambdaNode.body; gfPtr: Var ¬ GFPtrOrNil[body.first]; pqRef ¬ PriorityQueue.Create[OffsetSortPred]; IF gfPtr=NIL THEN RETURN; DO IF body.rest=NIL THEN EXIT; IF ~IsConstGFAssignment[body.rest.first, gfPtr] THEN EXIT; on ¬ NEW[OrderedNodeRec ¬ [node: body.rest.first, count: (count¬count+1)]]; PriorityQueue.Insert[pqRef, on]; body.rest ¬ body.rest.rest; ENDLOOP; }; <> <<--a simple version without side effects>> <> <> <> <<};>> <<>> GlobalFrameDeclarationCode: PUBLIC PROC [moduleNode: IntCodeDefs.ModuleNode] RETURNS [code: C2CEmit.Code] = { lambdaNode: LambdaNode ~ FindInstallProc[moduleNode]; pqRef: PriorityQueue.Ref ¬ GetAndRemoveConstantInits[lambdaNode]; gfName: ROPE ¬ MakeupNameForGlobalFrame[]; c1, c2: C2CEmit.Code; --c1 represents declaration; c2 initial value nextPos: INT ¬ 0; cnt: INT ¬ 0; warning: C2CEmit.Code ¬ NIL; Separator: PROC [] = { IF cnt#0 THEN { c2 ¬ C2CEmit.Cat[c2, ", "]; IF cnt MOD 4 = 0 THEN { c1 ¬ C2CEmit.Cat[c1, "\n"]; c2 ¬ C2CEmit.Cat[c2, "\n"] }; }; }; NextField: PROC [value: C2CEmit.CodeOrRope] = { IF value=NIL THEN value ¬ C2CEmit.IdentCode["0"]; Separator[]; c1 ¬ C2CEmit.Cat[c1, IO.PutFR1["word f%g; ", IO.int[nextPos/C2CTarget.bitsPerWord]]]; IF value#NIL THEN c2 ¬ C2CEmit.Cat[c2, value] ELSE c2 ¬ C2CEmit.Cat[c2, "0"]; cnt ¬ cnt + 1; nextPos ¬ nextPos + C2CTarget.bitsPerWord; }; Advance: PROC [nextOffset: INT] = { missing: INT ¬ nextOffset-nextPos; SELECT missing FROM 0 => {}; >0 => { fidx: INT ¬ nextPos / C2CTarget.bitsPerWord; sz: INT ¬ missing / C2CTarget.bitsPerWord; IF missing MOD C2CTarget.bitsPerWord # 0 THEN CantHappen; Separator[]; IF sz=1 THEN { c1 ¬ C2CEmit.Cat[c1, IO.PutFR1["word f%g; ", IO.int[fidx]]]; c2 ¬ C2CEmit.Cat[c2, "0"]; } ELSE { c1 ¬ C2CEmit.Cat[c1, IO.PutFR["word f%g[%g]; ", IO.int[fidx], IO.int[sz]]]; c2 ¬ C2CEmit.Cat[c2, "{0}"]; }; cnt ¬ cnt + 1; nextPos ¬ nextOffset; }; ENDCASE => ERROR CantHappen; }; WHILE ~PriorityQueue.Empty[pqRef] DO size, offset: INT; value: C2CEmit.Code; on: OrderedNode ¬ NARROW[PriorityQueue.Remove[pqRef]]; [size, offset, value] ¬ MunchConstAssign[on]; IF size#C2CTarget.bitsPerWord THEN ERROR CantHappen; IF offset> warning ¬ C2CEmit.Cat[warning, C2CEmit.line, C2CEmit.CComment[IO.PutFR1["assignment at word %g removed by C2C", IO.int[offset / C2CTarget.bitsPerWord]]] ]; LOOP }; ERROR CantHappen; }; Advance[offset]; NextField[value]; ENDLOOP; Advance[GlobalFrameSize[moduleNode]]; code ¬ C2CEmit.Cat["static struct {", C2CEmit.nestNLine, c1, "\n} ", gfName]; code ¬ C2CEmit.Cat[code, " = {\n", c2, "\n};\n", warning]; code ¬ C2CEmit.Cat[code, C2CEmit.unNestNLine]; }; END.