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/hppa/hppaCG.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/compiler/CodeGen/hppa/hppaCG.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 17 - (view) (download)

1 : monnier 16 functor HppaCG(structure Emitter : EMITTER_NEW
2 :     where F = HppaFlowGraph) :
3 :     (* and structure I = HppaInstr -- redundant *)
4 :     sig
5 :     structure MLTreeGen : CPSGEN
6 :     val finish : unit -> unit
7 :     end =
8 :     struct
9 :     structure I = HppaInstr
10 :     structure C = HppaCells
11 :     structure R = HppaCpsRegs
12 :     structure CG = Control.CG
13 :     structure Region = I.Region
14 :    
15 :     fun error msg = ErrorMsg.impossible ("HppaCG." ^ msg)
16 :    
17 :     structure HppaRewrite = HppaRewrite(HppaInstr)
18 :    
19 :     (* properties of instruction set *)
20 :     structure HppaProps = HppaProps(structure HppaInstr = I val exnptrR = [6])
21 :    
22 :    
23 :     (* Label backpatching and basic block scheduling *)
24 :     structure BBSched =
25 :     BBSched2(structure Flowgraph = HppaFlowGraph
26 :     structure Jumps =
27 :     HppaJumps(structure Instr=HppaInstr
28 :     structure Shuffle=HppaShuffle)
29 :     structure Emitter = Emitter)
30 :    
31 :     (* flow graph pretty printing routine *)
32 :     structure PrintFlowGraph =
33 :     PrintFlowGraphFn (structure FlowGraph = HppaFlowGraph
34 :     structure Emitter = HppaAsmEmitter)
35 :    
36 :     (* register allocation *)
37 :     structure RegAllocation :
38 :     sig
39 :     val ra : HppaFlowGraph.cluster -> HppaFlowGraph.cluster
40 :     val cp : HppaFlowGraph.cluster -> HppaFlowGraph.cluster
41 :     end =
42 :     struct
43 :     (* spill area management *)
44 :     val itow = Word.fromInt
45 :     val wtoi = Word.toIntX
46 :     val stack = Region.stack
47 :    
48 :     fun fromto(n, m) = if n>m then [] else n :: fromto(n+1, m)
49 :    
50 :     fun low11(n) = wtoi(Word.andb(itow n, 0wx7ff))
51 :     fun high21(n) = wtoi(Word.~>>(itow n, 0w11))
52 :    
53 :     val initialSpillOffset = 116 (* from runtime system *)
54 :     val spillOffset = ref initialSpillOffset
55 :     fun newOffset n =
56 :     if n > 4096 then error "incOffset - spill area too small"
57 :     else spillOffset := n
58 :     exception RegSpills and FregSpills
59 :     val regSpills : int Intmap.intmap ref = ref(Intmap.new(0, RegSpills))
60 :     val fregSpills : int Intmap.intmap ref = ref(Intmap.new(0, FregSpills))
61 :    
62 :     (* get spill location for register *)
63 :     fun getRegLoc reg = Intmap.map (!regSpills) reg
64 :     handle RegSpills => let
65 :     val offset = !spillOffset
66 :     in
67 :     newOffset(offset+4);
68 :     Intmap.add (!regSpills) (reg, offset);
69 :     offset
70 :     end
71 :    
72 :     (* get spill location for floating register *)
73 :     fun getFregLoc freg = Intmap.map (!fregSpills) freg
74 :     handle FregSpills => let
75 :     val spillLoc = !spillOffset
76 :     val aligned = Word.toIntX (Word.andb(itow (spillLoc+7), itow ~8))
77 :     in
78 :     newOffset(aligned+8);
79 :     Intmap.add (!fregSpills) (freg, aligned);
80 :     aligned
81 :     end
82 :    
83 :     fun mvInstr(rd,rs) = I.ARITH{a=I.OR, r1=rs, r2=0, t=rd}
84 :     fun fmvInstr(fd,fs) = I.FUNARY{fu=I.FCPY, f=fs, t=fd}
85 :    
86 :     fun spillInit () =
87 :     (spillOffset := initialSpillOffset;
88 :     regSpills := Intmap.new(8, RegSpills);
89 :     fregSpills := Intmap.new(8, FregSpills))
90 :    
91 :     (* spill general register *)
92 :     fun spillR {regmap, instr, reg} = let
93 :     val loc = getRegLoc reg
94 :     fun spillInstr(r) =
95 :     [I.STORE{st=I.STW, b=C.stackptrR, d=I.IMMED(~loc), r=r, mem=stack}]
96 :     in
97 :     Control.MLRISC.int_spills := !Control.MLRISC.int_spills + 1;
98 :     case instr
99 :     of I.COPY{dst as [rd], src as [rs], tmp, impl} =>
100 :     if reg=rd then
101 :     {code=spillInstr(rs), instr=NONE, proh=[]}
102 :     else (case tmp
103 :     of SOME(I.Direct r) => let
104 :     val loc=I.Displace{base=C.stackptrR, disp= ~loc}
105 :     val instr=I.COPY{dst=dst, src=src, tmp=SOME(loc), impl=impl}
106 :     in {code=[], instr=SOME instr, proh=[]}
107 :     end
108 :     | _ => error "spill: MOVE"
109 :     (*esac*))
110 :     | _ => let
111 :     val newR = C.newReg()
112 :     val instr' = HppaRewrite.rewriteDef(regmap, instr, reg, newR)
113 :     in {code=spillInstr newR, instr=SOME instr', proh=[newR]}
114 :     end
115 :     end
116 :    
117 :     (* reload general register *)
118 :     fun reloadR {regmap, instr, reg} = let
119 :     val loc = getRegLoc(reg)
120 :     fun reloadInstr(r) =
121 :     I.LOADI{li=I.LDW, i=I.IMMED(~loc), r=C.stackptrR, t=r, mem=stack}
122 :     in
123 :     Control.MLRISC.int_reloads := !Control.MLRISC.int_reloads + 1;
124 :     case instr
125 :     of I.COPY{dst=[rd], src=[rs], ...} => {code=[reloadInstr(rd)], proh=[]}
126 :     | _ => let
127 :     val newR = C.newReg()
128 :     val instr' = HppaRewrite.rewriteUse(regmap, instr, reg, newR)
129 :     in {code=[reloadInstr(newR), instr'], proh=[newR]}
130 :     end
131 :     end
132 :    
133 :     fun spillF {regmap, instr, reg} = let
134 :     val disp = getFregLoc reg
135 :     val tmpR = C.asmTmpR
136 :     fun spillInstrs(reg) =
137 :     [I.LDIL{i=I.IMMED(high21(~disp)), t=tmpR},
138 :     I.LDO{i=I.IMMED(low11(~disp)), b=tmpR, t=tmpR},
139 :     I.FSTOREX{fstx=I.FSTDX, b=C.stackptrR, x=tmpR, r=reg, mem=stack}]
140 :     in
141 :     Control.MLRISC.float_spills := !Control.MLRISC.float_spills + 1;
142 :     case instr
143 :     of I.FCOPY{dst as [fd], src as [fs], tmp, impl} =>
144 :     if fd=reg then
145 :     {code=spillInstrs(fs), instr=NONE, proh=[]}
146 :     else (case tmp
147 :     of SOME(I.FDirect f) => let
148 :     val loc=I.Displace{base=C.stackptrR, disp= ~disp}
149 :     val instr=I.FCOPY{dst=dst, src=src, tmp=SOME(loc), impl=impl}
150 :     in {code=[], instr=SOME instr, proh=[]}
151 :     end
152 :     | _ => error "spillF: FCOPY"
153 :     (*esac*))
154 :     | _ => let
155 :     val newF = C.newFreg()
156 :     val instr' = HppaRewrite.frewriteDef(regmap, instr, reg, newF)
157 :     in {code=spillInstrs(newF), instr=SOME instr', proh=[newF]}
158 :     end
159 :     end
160 :    
161 :     fun reloadF {regmap, instr, reg} = let
162 :     val disp = getFregLoc reg
163 :     val tmpR = C.asmTmpR
164 :     fun reloadInstrs(reg, rest) =
165 :     I.LDIL{i=I.IMMED(high21(~disp)), t=tmpR} ::
166 :     I.LDO{i=I.IMMED(low11(~disp)), b=tmpR, t=tmpR} ::
167 :     I.FLOADX{flx=I.FLDDX, b=C.stackptrR, x=tmpR, t=reg, mem=stack} :: rest
168 :     in
169 :     Control.MLRISC.float_reloads := !Control.MLRISC.float_reloads + 1;
170 :     case instr
171 :     of I.FCOPY{dst=[fd], src=[fs], ...} => {code=reloadInstrs(fd, []), proh=[]}
172 :     | _ => let
173 :     val newF = C.newFreg()
174 :     val instr' = HppaRewrite.frewriteUse(regmap, instr, reg, newF)
175 :     in {code=reloadInstrs(newF, [instr']), proh=[newF]}
176 :     end
177 :     end
178 :    
179 :     structure GR = GetReg(val nRegs = 32 val available = R.availR)
180 :     structure FR = GetReg(val nRegs = 32 val available = R.availF)
181 :    
182 :     structure HppaRa =
183 :     HppaRegAlloc(structure P = HppaProps
184 :     structure I = HppaInstr
185 :     structure F = HppaFlowGraph
186 :     structure Asm = HppaAsmEmitter)
187 :    
188 :     (* register allocation for general purpose registers *)
189 :     structure IntRa =
190 :     HppaRa.IntRa
191 :     (structure RaUser = struct
192 :     structure I = HppaInstr
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 :     HppaRa.FloatRa
207 :     (structure RaUser = struct
208 :     structure I = HppaInstr
209 :    
210 :     val getreg = FR.getreg
211 :     val spill = spillF
212 :     val reload = reloadF
213 :     val nFreeRegs = length R.availF
214 :     val dedicated = R.dedicatedF
215 :     fun copyInstr((fds, fss), I.FCOPY{tmp, ...}) =
216 :     I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=tmp}
217 :     end)
218 :    
219 :     val iRegAlloc = IntRa.ra IntRa.REGISTER_ALLOCATION
220 :     val fRegAlloc = FloatRa.ra FloatRa.REGISTER_ALLOCATION
221 :     val icp = IntRa.ra IntRa.COPY_PROPAGATION
222 :     val fcp = FloatRa.ra FloatRa.COPY_PROPAGATION
223 :     val cp = fcp o icp
224 :    
225 :     fun ra cluster = let
226 :     fun intRa cluster = (GR.reset(); iRegAlloc cluster)
227 :     fun floatRa cluster = (FR.reset(); fRegAlloc cluster)
228 :     in
229 :     spillInit();
230 :     (floatRa o intRa) cluster
231 :     end
232 :     end
233 :    
234 :     fun codegen cluster = let
235 :     fun phaseToMsg(CG.AFTER_INSTR_SEL) = "After instruction selection"
236 :     | phaseToMsg(CG.AFTER_RA) = "After register allocation"
237 :     | phaseToMsg(CG.AFTER_SCHED) = "After instruction scheduling"
238 :     | phaseToMsg _ = error "phaseToMsg"
239 :     val printGraph = PrintFlowGraph.printCluster (!CG.printFlowgraphStream)
240 :     fun doPhase (phase, f) cluster = let
241 :     fun show(CG.PHASES(ph1, ph2)) = show ph1 orelse show ph2
242 :     | show(ph) = (ph = phase)
243 :     val newCluster = f cluster
244 :     in
245 :     if show (!CG.printFlowgraph) then
246 :     printGraph (phaseToMsg phase) newCluster
247 :     else ();
248 :     newCluster
249 :     end
250 :     val instrSel = doPhase (CG.AFTER_INSTR_SEL, fn x => x)
251 :     val regAlloc = doPhase (CG.AFTER_RA, RegAllocation.ra)
252 :     in
253 :     case !CG.printFlowgraph
254 :     of CG.NO_PHASE => (BBSched.bbsched o RegAllocation.ra) cluster
255 :     | phase => (BBSched.bbsched o regAlloc o instrSel) cluster
256 :     end
257 :    
258 :     (* primitives for generation of HPPA instruction flowgraphs *)
259 :     structure FlowGraphGen =
260 :     FlowGraphGen(structure Flowgraph = HppaFlowGraph
261 :     structure InsnProps = HppaProps
262 :     structure MLTree = HppaMLTree
263 :     val codegen = codegen)
264 :    
265 :     structure HppaMillicode =
266 :     HppaMillicode(structure MLTree=HppaMLTree
267 :     structure Instr=HppaInstr)
268 :    
269 :     structure HppaLabelComp =
270 :     HppaLabelComp(structure MLTree=HppaMLTree
271 :     structure Instr=HppaInstr)
272 :    
273 :     (* compilation of CPS to MLRISC *)
274 :     structure MLTreeGen =
275 :     MLRiscGen(structure MachineSpec=HppaSpec
276 :     structure MLTreeComp=
277 :     Hppa(structure Flowgen=FlowGraphGen
278 :     structure HppaInstr = HppaInstr
279 :     structure HppaMLTree = HppaMLTree
280 :     structure MilliCode=HppaMillicode
281 :     structure LabelComp=HppaLabelComp)
282 :     structure Cells=HppaCells
283 :     structure C=HppaCpsRegs
284 :     structure ConstType=HppaConst
285 :     structure PseudoOp=HppaPseudoOps)
286 :    
287 :     val finish = BBSched.finish
288 :     end
289 :    
290 :     (*
291 :     * $Log: hppaCG.sml,v $
292 :     * Revision 1.14 1998/02/17 02:57:55 george
293 :     * The spill and reload functions take a register map, incase
294 :     * the instruction needs to be rewritten to use fresh temps.
295 :     *
296 :     * Revision 1.13 1998/02/16 13:58:29 george
297 :     * A register allocated temp is now associated with parallel COPYs
298 :     * instead of a dedicated register. The temp is used to break cycles.
299 :     *
300 :     * Revision 1.12 1998/02/13 17:21:07 george
301 :     * Functorized pseudoOps over the machine spec to get access to the
302 :     * Tag structure.
303 :     *
304 :     * Revision 1.11 1997/09/29 20:58:45 george
305 :     * Propagate region information through instruction set
306 :     *
307 :     # Revision 1.10 1997/09/17 17:15:34 george
308 :     # dedicated registers are now part of the CPSREGS interface
309 :     #
310 :     # Revision 1.9 1997/08/29 11:05:27 george
311 :     # Spill area now starts at a new offset to account for the
312 :     # new mulu address on the stack.
313 :     #
314 :     # Revision 1.8 1997/07/28 20:05:06 george
315 :     # Added support for regions
316 :     #
317 :     # Revision 1.7 1997/07/17 12:37:33 george
318 :     # The constant type used to specialize MLTrees is now done more compactly.
319 :     #
320 :     # Revision 1.6 1997/07/15 16:08:06 dbm
321 :     # Change in where structure syntax.
322 :     #
323 :     # Revision 1.5 1997/07/03 13:56:49 george
324 :     # Added support for FCOPY.
325 :     #
326 :     # Revision 1.4 1997/07/02 13:25:38 george
327 :     # Generated better spill code, in which a new temporary is introduced
328 :     # to represent the register being spilled.
329 :     #
330 :     # Revision 1.3 1997/06/13 15:29:43 george
331 :     # Modified codegen to print flowgraph at the end of each phase -- leunga
332 :     #
333 :     # Revision 1.2 1997/05/20 12:21:50 dbm
334 :     # SML '97 sharing, where structure.
335 :     #
336 :     # Revision 1.1 1997/04/19 18:17:46 george
337 :     # Version 109.27
338 :     #
339 :     * Revision 1.2 1997/04/16 02:25:57 george
340 :     * Instruction selection is now parameterized over modules that
341 :     * describes how to generate millicalls, and translate trees
342 :     * involving labels.
343 :     *
344 :     * Revision 1.1.1.1 1997/01/14 01:38:34 george
345 :     * Version 109.24
346 :     *
347 :     *)

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