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/branches/SMLNJ/src/compiler/CodeGen/sparc/sparcCG.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/compiler/CodeGen/sparc/sparcCG.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 167 - (view) (download)

1 : monnier 134 functor SparcCG(structure Emitter : EMITTER_NEW
2 : monnier 167 where I = SparcInstr and P = SparcPseudoOps) :
3 : monnier 134 sig
4 :     structure MLTreeGen : CPSGEN
5 :     val finish : unit -> unit
6 :     end =
7 :     struct
8 :     structure I = SparcInstr
9 :     structure C = SparcCells
10 :     structure R = SparcCpsRegs
11 :     structure CG = Control.CG
12 :     structure B = SparcMLTree.BNames
13 :     structure Region = I.Region
14 :    
15 :     fun error msg = ErrorMsg.impossible ("SparcCG." ^ msg)
16 :    
17 :     structure SparcRewrite = SparcRewrite(SparcInstr)
18 :    
19 :     (* properties of instruction set *)
20 :     structure SparcProps =
21 :     SparcProps(structure SparcInstr = I
22 :     structure Shuffle = SparcShuffle)
23 :    
24 :    
25 :     (* Label backpatching and basic block scheduling *)
26 :     structure SparcJumps =
27 :     SparcJumps(structure Instr=SparcInstr
28 :     structure Shuffle=SparcShuffle)
29 :     structure BBSched =
30 :     SpanDependencyResolution(
31 :     structure Flowgraph = SparcFlowGraph
32 :     structure Jumps = SparcJumps
33 :     structure Emitter = Emitter
34 :     structure DelaySlot = SparcDelaySlotProps(structure I=SparcInstr
35 :     structure P=SparcProps)
36 :     structure Props = SparcProps
37 :     )
38 :    
39 :     (* flow graph pretty printing routine *)
40 :     structure PrintFlowGraph =
41 :     PrintFlowGraphFn (structure FlowGraph = SparcFlowGraph
42 :     structure Emitter = SparcAsmEmitter)
43 :    
44 :     (* register allocation *)
45 :     structure RegAllocation :
46 :     sig
47 :     val ra : SparcFlowGraph.cluster -> SparcFlowGraph.cluster
48 :     val cp : SparcFlowGraph.cluster -> SparcFlowGraph.cluster
49 :     end =
50 :     struct
51 :     (* spill area management *)
52 :     val itow = Word.fromInt
53 :     val stack = Region.stack
54 :    
55 :     fun fromto(n, m) = if n>m then [] else n :: fromto(n+1, m)
56 :    
57 :     val initialSpillOffset = 116 (* from runtime system *)
58 :     val spillOffset = ref initialSpillOffset
59 :     fun newOffset n =
60 :     if n > 3800 then error "incOffset - spill area too small"
61 :     else spillOffset := n
62 :     exception RegSpills and FregSpills
63 :     val regSpills : int Intmap.intmap ref = ref(Intmap.new(0, RegSpills))
64 :     val fregSpills : int Intmap.intmap ref = ref(Intmap.new(0, FregSpills))
65 :    
66 :     (* get spill location for register *)
67 :     fun getRegLoc reg = Intmap.map (!regSpills) reg
68 :     handle RegSpills => let
69 :     val offset = !spillOffset
70 :     in
71 :     newOffset(offset+4);
72 :     Intmap.add (!regSpills) (reg, offset);
73 :     offset
74 :     end
75 :    
76 :     (* get spill location for floating register *)
77 :     fun getFregLoc freg = Intmap.map (!fregSpills) freg
78 :     handle FregSpills => let
79 :     val spillLoc = !spillOffset
80 :     val aligned = Word.toIntX (Word.andb(itow (spillLoc+7), itow ~8))
81 :     in
82 :     newOffset(aligned+8);
83 :     Intmap.add (!fregSpills) (freg, aligned);
84 :     aligned
85 :     end
86 :    
87 :     fun mvInstr(rd,rs) = I.ARITH{a=I.OR, r=0, i=I.REG rs, d=rd, cc=false}
88 :     fun fmvInstr(fd,fs) = I.FPop1{a=I.FMOVd, r=fs, d=fd}
89 :    
90 :     fun spillInit () =
91 :     (spillOffset := initialSpillOffset;
92 :     regSpills := Intmap.new(8, RegSpills);
93 :     fregSpills := Intmap.new(8, FregSpills))
94 :    
95 :     (* spill general register *)
96 :     fun spillR {regmap, instr, reg, id} = let
97 :     val loc = getRegLoc reg
98 :     fun spillInstr(r) =
99 :     [I.STORE{s=I.ST, r=C.stackptrR, i=I.IMMED(loc), d=r, mem=stack}]
100 :     in
101 :     Control.MLRISC.int_spills := !Control.MLRISC.int_spills + 1;
102 :     case instr
103 :     of I.COPY{dst as [rd], src as [rs], tmp, impl} =>
104 :     if reg=rd then
105 :     {code=spillInstr(rs), instr=NONE, proh=[]}
106 :     else (case tmp
107 :     of SOME(I.Direct r) => let
108 :     val loc=I.Displace{base=C.stackptrR, disp=loc}
109 :     val instr=I.COPY{dst=dst, src=src, tmp=SOME(loc), impl=impl}
110 :     in {code=[], instr=SOME instr, proh=[]}
111 :     end
112 :     | _ => error "spill: MOVE"
113 :     (*esac*))
114 :     | _ => let
115 :     val newR = C.newReg()
116 :     val instr' = SparcRewrite.rewriteDef(regmap, instr, reg, newR)
117 :     in {code=spillInstr newR, instr=SOME instr', proh=[newR]}
118 :     end
119 :     end
120 :    
121 :     (* reload general register *)
122 :     fun reloadR {regmap, instr, reg, id} = let
123 :     val loc = getRegLoc(reg)
124 :     fun reloadInstr(r) =
125 :     I.LOAD{l=I.LD, i=I.IMMED(loc), r=C.stackptrR, d=r, mem=stack}
126 :     in
127 :     Control.MLRISC.int_reloads := !Control.MLRISC.int_reloads + 1;
128 :     case instr
129 :     of I.COPY{dst=[rd], src=[rs], ...} => {code=[reloadInstr(rd)], proh=[]}
130 :     | _ => let
131 :     val newR = C.newReg()
132 :     val instr' = SparcRewrite.rewriteUse(regmap, instr, reg, newR)
133 :     in {code=[reloadInstr(newR), instr'], proh=[newR]}
134 :     end
135 :     end
136 :    
137 :     fun spillF {regmap, instr, reg, id} = let
138 :     val disp = getFregLoc reg
139 :     fun spillInstrs(reg) =
140 :     [I.FSTORE{s=I.STDF, r=C.stackptrR, i=I.IMMED(disp), d=reg, mem=stack}]
141 :     in
142 :     Control.MLRISC.float_spills := !Control.MLRISC.float_spills + 1;
143 :     case instr
144 :     of I.FCOPY{dst as [fd], src as [fs], tmp, impl} =>
145 :     if fd=reg then
146 :     {code=spillInstrs(fs), instr=NONE, proh=[]}
147 :     else (case tmp
148 :     of SOME(I.FDirect f) => let
149 :     val loc=I.Displace{base=C.stackptrR, disp=disp}
150 :     val instr=I.FCOPY{dst=dst, src=src, tmp=SOME(loc), impl=impl}
151 :     in {code=[], instr=SOME instr, proh=[]}
152 :     end
153 :     | _ => error "spillF: FCOPY"
154 :     (*esac*))
155 :     | _ => let
156 :     val newF = C.newFreg()
157 :     val instr' = SparcRewrite.frewriteDef(regmap, instr, reg, newF)
158 :     in {code=spillInstrs(newF), instr=SOME instr', proh=[newF]}
159 :     end
160 :     end
161 :    
162 :     fun reloadF {regmap, instr, reg, id} = let
163 :     val disp = getFregLoc reg
164 :     fun reloadInstrs(reg, rest) =
165 :     I.FLOAD{l=I.LDDF, r=C.stackptrR, i=I.IMMED(disp), d=reg, mem=stack}
166 :     :: rest
167 :     in
168 :     Control.MLRISC.float_reloads := !Control.MLRISC.float_reloads + 1;
169 :     case instr
170 :     of I.FCOPY{dst=[fd], src=[fs], ...} => {code=reloadInstrs(fd, []), proh=[]}
171 :     | _ => let
172 :     val newF = C.newFreg()
173 :     val instr' = SparcRewrite.frewriteUse(regmap, instr, reg, newF)
174 :     in {code=reloadInstrs(newF, [instr']), proh=[newF]}
175 :     end
176 :     end
177 :    
178 :     structure GR = GetReg(val nRegs = 32 val available = R.availR)
179 :     structure FR = GetReg(val nRegs = 32 val available = R.availF)
180 :    
181 :     structure SparcRa =
182 :     SparcRegAlloc(structure P = SparcProps
183 :     structure I = SparcInstr
184 :     structure F = SparcFlowGraph
185 :     structure Asm = SparcAsmEmitter)
186 :    
187 :     (* register allocation for general purpose registers *)
188 :     structure IntRa =
189 :     SparcRa.IntRa
190 :     (structure RaUser = struct
191 :     structure I = SparcInstr
192 :     structure B = B
193 :    
194 :     val getreg = GR.getreg
195 :     val spill = spillR
196 :     val reload = reloadR
197 :     val nFreeRegs = length R.availR
198 :     val dedicated = R.dedicatedR
199 :     fun copyInstr((rds, rss), I.COPY{tmp, ...}) =
200 :     I.COPY{dst=rds, src=rss, impl=ref NONE, tmp=tmp}
201 :     end)
202 :    
203 :    
204 :     (* register allocation for floating point registers *)
205 :     structure FloatRa =
206 :     SparcRa.FloatRa
207 :     (structure RaUser = struct
208 :     structure I = SparcInstr
209 :     structure B = B
210 :    
211 :     val getreg = FR.getreg
212 :     val spill = spillF
213 :     val reload = reloadF
214 :     val nFreeRegs = length R.availF
215 :     val dedicated = R.dedicatedF
216 :     fun copyInstr((fds, fss), I.FCOPY{tmp, ...}) =
217 :     I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=tmp}
218 :     end)
219 :    
220 :     val iRegAlloc = IntRa.ra IntRa.REGISTER_ALLOCATION
221 :     val fRegAlloc = FloatRa.ra FloatRa.REGISTER_ALLOCATION
222 :     val icp = IntRa.ra IntRa.COPY_PROPAGATION
223 :     val fcp = FloatRa.ra FloatRa.COPY_PROPAGATION
224 :     val cp = fcp o icp
225 :    
226 :     fun ra cluster = let
227 :     fun intRa cluster = (GR.reset(); iRegAlloc cluster)
228 :     fun floatRa cluster = (FR.reset(); fRegAlloc cluster)
229 :     in
230 :     spillInit();
231 :     (floatRa o intRa) cluster
232 :     end
233 :     end
234 :    
235 :     (*
236 :     structure Opt =
237 :     MLRISC_OptimizerF(structure F = SparcFlowGraph
238 :     structure Asm = SparcAsmEmitter
239 :     structure P = SparcProps
240 :     structure Ctrl = MLRISC_Control
241 :     val copy_propagation = RegAllocation.cp
242 :     val register_allocation = RegAllocation.ra
243 :     val emit_code = BBSched.bbsched
244 :     )
245 :     *)
246 :    
247 :     fun codegen cluster = let
248 :     fun phaseToMsg(CG.AFTER_INSTR_SEL) = "After instruction selection"
249 :     | phaseToMsg(CG.AFTER_RA) = "After register allocation"
250 :     | phaseToMsg(CG.AFTER_SCHED) = "After instruction scheduling"
251 :     | phaseToMsg _ = error "phaseToMsg"
252 :     val printGraph = PrintFlowGraph.printCluster (!CG.printFlowgraphStream)
253 :     fun doPhase (phase, f) cluster = let
254 :     fun show(CG.PHASES(ph1, ph2)) = show ph1 orelse show ph2
255 :     | show(ph) = (ph = phase)
256 :     val newCluster = f cluster
257 :     in
258 :     if show (!CG.printFlowgraph) then
259 :     printGraph (phaseToMsg phase) newCluster
260 :     else ();
261 :     newCluster
262 :     end
263 :     val instrSel = doPhase (CG.AFTER_INSTR_SEL, fn x => x)
264 :     val regAlloc = doPhase (CG.AFTER_RA, RegAllocation.ra)
265 :     in
266 :     case !CG.printFlowgraph
267 :     of CG.NO_PHASE => (BBSched.bbsched o RegAllocation.ra) cluster
268 :     | phase => (BBSched.bbsched o regAlloc o instrSel) cluster
269 :     end
270 :    
271 :     (* primitives for generation of SPARC instruction flowgraphs *)
272 :     structure FlowGraphGen =
273 :     FlowGraphGen(structure Flowgraph = SparcFlowGraph
274 :     structure InsnProps = SparcProps
275 :     structure MLTree = SparcMLTree
276 :     val codegen = codegen)
277 :    
278 :     (* compilation of CPS to MLRISC *)
279 :     structure MLTreeGen =
280 :     MLRiscGen(structure MachineSpec=SparcSpec
281 :     structure MLTreeComp=
282 :     Sparc(structure Flowgen=FlowGraphGen
283 :     structure SparcInstr = SparcInstr
284 :     structure SparcMLTree = SparcMLTree
285 :     structure PseudoInstrs = SparcPseudoInstrs
286 :     val overflowtrap = (* tvs 0x7 *)
287 :     [I.Ticc{t=I.BVS,r=0,i=I.IMMED 7}]
288 :     )
289 :     structure Cells=SparcCells
290 :     structure C=SparcCpsRegs
291 :     structure ConstType=SparcConst
292 :     structure PseudoOp=SparcPseudoOps)
293 :    
294 :     val finish = BBSched.finish
295 :     end
296 :    
297 :     (*
298 : monnier 167 * $Log: sparcCG.sml,v $
299 :     * Revision 1.1.1.1 1998/08/05 19:37:50 george
300 :     * Release 110.7.4
301 :     *
302 : monnier 134 *)

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