Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/CodeGen/main/machine-gen.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/CodeGen/main/machine-gen.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1173 - (view) (download)

1 : monnier 427 (*
2 :     * This is a generic functor that hooks everything together
3 :     * into an MLRISC backend.
4 :     *)
5 :    
6 :     functor MachineGen
7 :     (structure MachSpec : MACH_SPEC (* machine specifications *)
8 : blume 773 structure Ext : SMLNJ_MLTREE_EXT
9 : george 909 structure InsnProps : INSN_PROPERTIES (* instruction properties *)
10 : monnier 427 structure CpsRegs : CPSREGS (* CPS registers *)
11 : george 909 where T.Region=CPSRegions
12 :     and T.Constant=SMLNJConstant
13 :     and T.Extension=Ext
14 : george 984 structure ClientPseudoOps : SMLNJ_PSEUDO_OPS
15 :     structure PseudoOps : PSEUDO_OPS (* pseudo ops *)
16 :     where T = CpsRegs.T
17 :     and Client = ClientPseudoOps
18 : monnier 427 structure MLTreeComp : MLTREECOMP (* instruction selection *)
19 : george 984 where I = InsnProps.I
20 :     and TS.T = CpsRegs.T
21 :     and TS.S.P = PseudoOps
22 : monnier 427 structure Asm : INSTRUCTION_EMITTER (* assembly *)
23 : george 984 where S.P = PseudoOps
24 : george 909 and I = MLTreeComp.I
25 : george 555 structure Shuffle : SHUFFLE (* shuffling copies *)
26 : george 909 where I = Asm.I
27 : monnier 427 structure BackPatch : BBSCHED (* machine code emitter *)
28 : george 909 where CFG = MLTreeComp.CFG
29 :     structure RA : CFG_OPTIMIZATION (* register allocator *)
30 :     where CFG = BackPatch.CFG
31 : blume 773 structure CCalls : C_CALLS (* native C call generator *)
32 : george 909 where T = CpsRegs.T
33 :     structure OmitFramePtr : OMIT_FRAME_POINTER
34 :     where CFG=RA.CFG
35 : monnier 427 ) : MACHINE_GEN =
36 :     struct
37 :    
38 : george 909 structure G = Graph
39 :     structure CFG = BackPatch.CFG
40 :     structure P = InsnProps
41 :     structure I = CFG.I
42 :     structure Cells = I.C
43 : george 984 structure T = MLTreeComp.TS.T
44 :     structure Stream = MLTreeComp.TS
45 : george 909 structure Asm = Asm
46 :     structure Shuffle = Shuffle
47 :     structure MachSpec = MachSpec
48 :     structure MLTreeComp = MLTreeComp
49 : monnier 427
50 : george 1168
51 :     structure CFGViewer =
52 :     CFGViewer
53 :     (structure CFG = CFG
54 :     structure GraphViewer = GraphViewer(AllDisplays)
55 :     structure Asm = Asm)
56 :    
57 : george 1009 (* expand copies into their primitive moves.
58 :     * Copies are no longer treated as span dependent, which was a hack.
59 :     *)
60 :     structure ExpandCpys =
61 : george 1016 CFGExpandCopies
62 :     (structure CFG = CFG
63 :     structure Shuffle = Shuffle)
64 : george 1009
65 : george 1168 structure LoopProbs =
66 :     EstimateLoopProbsFn(structure CFG=CFG)
67 :    
68 : george 1136 structure ComputeFreqs =
69 :     ComputeFreqsFn(structure CFG=CFG)
70 :    
71 : george 1133 structure BlockPlacement =
72 :     BlockPlacement
73 :     (structure CFG = CFG
74 :     structure Props = InsnProps)
75 :    
76 : george 1168 structure CheckPlacement =
77 :     CheckPlacementFn
78 :     (structure CFG = CFG
79 :     structure InsnProps = InsnProps)
80 :    
81 : george 1141 (* After experimentation, some architecture specific control
82 :     * may be needed for chainEscapes.
83 :     *)
84 : george 1133 structure JumpChaining =
85 :     JumpChainElimFn
86 :     (structure CFG = CFG
87 : george 1141 structure InsnProps = InsnProps
88 :     val chainEscapes = ref false
89 :     val reverseDirection = ref false)
90 : george 1133
91 :     structure InvokeGC =
92 :     InvokeGC
93 :     (structure C = CpsRegs
94 :     structure MS = MachSpec
95 :     structure CFG = CFG
96 :     structure TS = MLTreeComp.TS
97 :     )
98 :    
99 : george 1168 val graphical_view =
100 :     MLRiscControl.mkFlag
101 :     ("cfg-graphical-view",
102 :     "graphical view of cfg after block placement")
103 :    
104 :     val graphical_view_size =
105 :     MLRiscControl.mkInt
106 : george 1173 ("cfg-graphical-view-size",
107 : george 1168 "minimium threshold for size of graphical view")
108 :    
109 : george 909 fun omitFramePointer(cfg as G.GRAPH graph) = let
110 :     val CFG.INFO{annotations, ...} = #graph_info graph
111 :     in
112 : george 823 if #contains MLRiscAnnotations.USES_VIRTUAL_FRAME_POINTER (!annotations) then
113 : blume 838 (OmitFramePtr.omitframeptr
114 : george 909 {vfp=CpsRegs.vfp, cfg=cfg, idelta=SOME 0:Int32.int option};
115 :     cfg)
116 :     else cfg
117 :     end
118 : george 823
119 : george 1168 fun computeFreqs cfg =
120 :     (LoopProbs.estimate cfg; ComputeFreqs.compute cfg; cfg)
121 : george 1136
122 : george 909 type mlriscPhase = string * (CFG.cfg -> CFG.cfg)
123 : monnier 427
124 :     fun phase x = Stats.doPhase (Stats.makePhase x)
125 : george 555 fun makePhase(name,f) = (name, phase name f)
126 : monnier 427
127 : george 1009 val mc = phase "MLRISC BackPatch.bbsched" BackPatch.bbsched
128 : george 1133 val placement = phase "MLRISC Block placement" BlockPlacement.blockPlacement
129 :     val chainJumps = phase "MLRISC Jump chaining" JumpChaining.run
130 :     val finish = phase "MLRISC BackPatch.finish" BackPatch.finish
131 : george 1136 val compFreqs = phase "MLRISC Compute frequencies" computeFreqs
132 : george 1009 val ra = phase "MLRISC ra" RA.run
133 :     val omitfp = phase "MLRISC omit frame pointer" omitFramePointer
134 :     val expandCpys = phase "MLRISC expand copies" ExpandCpys.run
135 : george 1133
136 : george 555 val raPhase = ("ra",ra)
137 :    
138 : george 823 val optimizerHook =
139 : george 1136 ref [("compFreqs", compFreqs),
140 :     ("ra", ra),
141 : george 1009 ("omitfp", omitfp),
142 :     ("expand copies", expandCpys)
143 : george 823 ]
144 :    
145 : george 1133 fun compile cluster = let
146 : george 1168 fun runPhases([],cluster) = cluster
147 :     | runPhases((_,f)::phases,cluster) = runPhases(phases,f cluster)
148 : monnier 427
149 : george 1168 fun dumpBlocks cfg = let
150 :     val cbp as (cfg, blks) = chainJumps (placement cfg)
151 :     fun view () =
152 :     if !graphical_view andalso length blks >= !graphical_view_size
153 :     then CFGViewer.view cfg
154 :     else ()
155 :     in
156 :     CheckPlacement.check cbp;
157 :     view ();
158 :     mc cbp
159 :     end
160 : george 1133 in
161 : george 1168 dumpBlocks (runPhases(!optimizerHook,cluster))
162 : george 823 end
163 : monnier 498
164 : monnier 427 (* compilation of CPS to MLRISC *)
165 :     structure MLTreeGen =
166 : george 1133 MLRiscGen
167 :     (structure MachineSpec=MachSpec
168 :     structure MLTreeComp=MLTreeComp
169 :     structure Ext = Ext
170 :     structure C=CpsRegs
171 :     structure ClientPseudoOps =ClientPseudoOps
172 :     structure PseudoOp=PseudoOps
173 :     structure InvokeGC=InvokeGC
174 :     structure Flowgen=
175 :     BuildFlowgraph
176 :     (structure CFG = CFG
177 :     structure Props = InsnProps
178 :     structure Stream = MLTreeComp.TS.S
179 :     )
180 :     structure CCalls = CCalls
181 :     structure Cells = Cells
182 :     val compile = compile
183 :     )
184 : george 823
185 : monnier 498
186 : monnier 427 val gen = phase "MLRISC MLTreeGen.codegen" MLTreeGen.codegen
187 :    
188 :     fun codegen x =
189 :     (* initialize all hidden states first *)
190 :     (Label.reset();
191 :     InvokeGC.init();
192 :     BackPatch.cleanUp();
193 :     gen x
194 :     )
195 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0