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 106 - (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 : monnier 106 structure HppaProps =
21 :     HppaProps(structure HppaInstr = I
22 :     structure Shuffle = HppaShuffle)
23 : monnier 16
24 :    
25 :     (* Label backpatching and basic block scheduling *)
26 :     structure BBSched =
27 :     BBSched2(structure Flowgraph = HppaFlowGraph
28 :     structure Jumps =
29 :     HppaJumps(structure Instr=HppaInstr
30 :     structure Shuffle=HppaShuffle)
31 :     structure Emitter = Emitter)
32 :    
33 :     (* flow graph pretty printing routine *)
34 :     structure PrintFlowGraph =
35 :     PrintFlowGraphFn (structure FlowGraph = HppaFlowGraph
36 :     structure Emitter = HppaAsmEmitter)
37 :    
38 :     (* register allocation *)
39 :     structure RegAllocation :
40 :     sig
41 :     val ra : HppaFlowGraph.cluster -> HppaFlowGraph.cluster
42 :     val cp : HppaFlowGraph.cluster -> HppaFlowGraph.cluster
43 :     end =
44 :     struct
45 :     (* spill area management *)
46 :     val itow = Word.fromInt
47 :     val wtoi = Word.toIntX
48 :     val stack = Region.stack
49 :    
50 :     fun fromto(n, m) = if n>m then [] else n :: fromto(n+1, m)
51 :    
52 :     fun low11(n) = wtoi(Word.andb(itow n, 0wx7ff))
53 :     fun high21(n) = wtoi(Word.~>>(itow n, 0w11))
54 :    
55 :     val initialSpillOffset = 116 (* from runtime system *)
56 :     val spillOffset = ref initialSpillOffset
57 :     fun newOffset n =
58 :     if n > 4096 then error "incOffset - spill area too small"
59 :     else spillOffset := n
60 :     exception RegSpills and FregSpills
61 :     val regSpills : int Intmap.intmap ref = ref(Intmap.new(0, RegSpills))
62 :     val fregSpills : int Intmap.intmap ref = ref(Intmap.new(0, FregSpills))
63 :    
64 :     (* get spill location for register *)
65 :     fun getRegLoc reg = Intmap.map (!regSpills) reg
66 :     handle RegSpills => let
67 :     val offset = !spillOffset
68 :     in
69 :     newOffset(offset+4);
70 :     Intmap.add (!regSpills) (reg, offset);
71 :     offset
72 :     end
73 :    
74 :     (* get spill location for floating register *)
75 :     fun getFregLoc freg = Intmap.map (!fregSpills) freg
76 :     handle FregSpills => let
77 :     val spillLoc = !spillOffset
78 :     val aligned = Word.toIntX (Word.andb(itow (spillLoc+7), itow ~8))
79 :     in
80 :     newOffset(aligned+8);
81 :     Intmap.add (!fregSpills) (freg, aligned);
82 :     aligned
83 :     end
84 :    
85 :     fun mvInstr(rd,rs) = I.ARITH{a=I.OR, r1=rs, r2=0, t=rd}
86 :     fun fmvInstr(fd,fs) = I.FUNARY{fu=I.FCPY, f=fs, t=fd}
87 :    
88 :     fun spillInit () =
89 :     (spillOffset := initialSpillOffset;
90 :     regSpills := Intmap.new(8, RegSpills);
91 :     fregSpills := Intmap.new(8, FregSpills))
92 :    
93 :     (* spill general register *)
94 :     fun spillR {regmap, instr, reg} = let
95 :     val loc = getRegLoc reg
96 :     fun spillInstr(r) =
97 :     [I.STORE{st=I.STW, b=C.stackptrR, d=I.IMMED(~loc), r=r, mem=stack}]
98 :     in
99 :     Control.MLRISC.int_spills := !Control.MLRISC.int_spills + 1;
100 :     case instr
101 :     of I.COPY{dst as [rd], src as [rs], tmp, impl} =>
102 :     if reg=rd then
103 :     {code=spillInstr(rs), instr=NONE, proh=[]}
104 :     else (case tmp
105 :     of SOME(I.Direct r) => let
106 :     val loc=I.Displace{base=C.stackptrR, disp= ~loc}
107 :     val instr=I.COPY{dst=dst, src=src, tmp=SOME(loc), impl=impl}
108 :     in {code=[], instr=SOME instr, proh=[]}
109 :     end
110 :     | _ => error "spill: MOVE"
111 :     (*esac*))
112 :     | _ => let
113 :     val newR = C.newReg()
114 :     val instr' = HppaRewrite.rewriteDef(regmap, instr, reg, newR)
115 :     in {code=spillInstr newR, instr=SOME instr', proh=[newR]}
116 :     end
117 :     end
118 :    
119 :     (* reload general register *)
120 :     fun reloadR {regmap, instr, reg} = let
121 :     val loc = getRegLoc(reg)
122 :     fun reloadInstr(r) =
123 :     I.LOADI{li=I.LDW, i=I.IMMED(~loc), r=C.stackptrR, t=r, mem=stack}
124 :     in
125 :     Control.MLRISC.int_reloads := !Control.MLRISC.int_reloads + 1;
126 :     case instr
127 :     of I.COPY{dst=[rd], src=[rs], ...} => {code=[reloadInstr(rd)], proh=[]}
128 :     | _ => let
129 :     val newR = C.newReg()
130 :     val instr' = HppaRewrite.rewriteUse(regmap, instr, reg, newR)
131 :     in {code=[reloadInstr(newR), instr'], proh=[newR]}
132 :     end
133 :     end
134 :    
135 :     fun spillF {regmap, instr, reg} = let
136 :     val disp = getFregLoc reg
137 :     val tmpR = C.asmTmpR
138 :     fun spillInstrs(reg) =
139 :     [I.LDIL{i=I.IMMED(high21(~disp)), t=tmpR},
140 :     I.LDO{i=I.IMMED(low11(~disp)), b=tmpR, t=tmpR},
141 :     I.FSTOREX{fstx=I.FSTDX, b=C.stackptrR, x=tmpR, r=reg, mem=stack}]
142 :     in
143 :     Control.MLRISC.float_spills := !Control.MLRISC.float_spills + 1;
144 :     case instr
145 :     of I.FCOPY{dst as [fd], src as [fs], tmp, impl} =>
146 :     if fd=reg then
147 :     {code=spillInstrs(fs), instr=NONE, proh=[]}
148 :     else (case tmp
149 :     of SOME(I.FDirect f) => let
150 :     val loc=I.Displace{base=C.stackptrR, disp= ~disp}
151 :     val instr=I.FCOPY{dst=dst, src=src, tmp=SOME(loc), impl=impl}
152 :     in {code=[], instr=SOME instr, proh=[]}
153 :     end
154 :     | _ => error "spillF: FCOPY"
155 :     (*esac*))
156 :     | _ => let
157 :     val newF = C.newFreg()
158 :     val instr' = HppaRewrite.frewriteDef(regmap, instr, reg, newF)
159 :     in {code=spillInstrs(newF), instr=SOME instr', proh=[newF]}
160 :     end
161 :     end
162 :    
163 :     fun reloadF {regmap, instr, reg} = let
164 :     val disp = getFregLoc reg
165 :     val tmpR = C.asmTmpR
166 :     fun reloadInstrs(reg, rest) =
167 :     I.LDIL{i=I.IMMED(high21(~disp)), t=tmpR} ::
168 :     I.LDO{i=I.IMMED(low11(~disp)), b=tmpR, t=tmpR} ::
169 :     I.FLOADX{flx=I.FLDDX, b=C.stackptrR, x=tmpR, t=reg, mem=stack} :: rest
170 :     in
171 :     Control.MLRISC.float_reloads := !Control.MLRISC.float_reloads + 1;
172 :     case instr
173 :     of I.FCOPY{dst=[fd], src=[fs], ...} => {code=reloadInstrs(fd, []), proh=[]}
174 :     | _ => let
175 :     val newF = C.newFreg()
176 :     val instr' = HppaRewrite.frewriteUse(regmap, instr, reg, newF)
177 :     in {code=reloadInstrs(newF, [instr']), proh=[newF]}
178 :     end
179 :     end
180 :    
181 :     structure GR = GetReg(val nRegs = 32 val available = R.availR)
182 :     structure FR = GetReg(val nRegs = 32 val available = R.availF)
183 :    
184 :     structure HppaRa =
185 :     HppaRegAlloc(structure P = HppaProps
186 :     structure I = HppaInstr
187 :     structure F = HppaFlowGraph
188 :     structure Asm = HppaAsmEmitter)
189 :    
190 :     (* register allocation for general purpose registers *)
191 :     structure IntRa =
192 :     HppaRa.IntRa
193 :     (structure RaUser = struct
194 :     structure I = HppaInstr
195 :    
196 :     val getreg = GR.getreg
197 :     val spill = spillR
198 :     val reload = reloadR
199 :     val nFreeRegs = length R.availR
200 :     val dedicated = R.dedicatedR
201 :     fun copyInstr((rds, rss), I.COPY{tmp, ...}) =
202 :     I.COPY{dst=rds, src=rss, impl=ref NONE, tmp=tmp}
203 :     end)
204 :    
205 :    
206 :     (* register allocation for floating point registers *)
207 :     structure FloatRa =
208 :     HppaRa.FloatRa
209 :     (structure RaUser = struct
210 :     structure I = HppaInstr
211 :    
212 :     val getreg = FR.getreg
213 :     val spill = spillF
214 :     val reload = reloadF
215 :     val nFreeRegs = length R.availF
216 :     val dedicated = R.dedicatedF
217 :     fun copyInstr((fds, fss), I.FCOPY{tmp, ...}) =
218 :     I.FCOPY{dst=fds, src=fss, impl=ref NONE, tmp=tmp}
219 :     end)
220 :    
221 :     val iRegAlloc = IntRa.ra IntRa.REGISTER_ALLOCATION
222 :     val fRegAlloc = FloatRa.ra FloatRa.REGISTER_ALLOCATION
223 :     val icp = IntRa.ra IntRa.COPY_PROPAGATION
224 :     val fcp = FloatRa.ra FloatRa.COPY_PROPAGATION
225 :     val cp = fcp o icp
226 :    
227 :     fun ra cluster = let
228 :     fun intRa cluster = (GR.reset(); iRegAlloc cluster)
229 :     fun floatRa cluster = (FR.reset(); fRegAlloc cluster)
230 :     in
231 :     spillInit();
232 :     (floatRa o intRa) cluster
233 :     end
234 :     end
235 :    
236 :     fun codegen cluster = let
237 :     fun phaseToMsg(CG.AFTER_INSTR_SEL) = "After instruction selection"
238 :     | phaseToMsg(CG.AFTER_RA) = "After register allocation"
239 :     | phaseToMsg(CG.AFTER_SCHED) = "After instruction scheduling"
240 :     | phaseToMsg _ = error "phaseToMsg"
241 :     val printGraph = PrintFlowGraph.printCluster (!CG.printFlowgraphStream)
242 :     fun doPhase (phase, f) cluster = let
243 :     fun show(CG.PHASES(ph1, ph2)) = show ph1 orelse show ph2
244 :     | show(ph) = (ph = phase)
245 :     val newCluster = f cluster
246 :     in
247 :     if show (!CG.printFlowgraph) then
248 :     printGraph (phaseToMsg phase) newCluster
249 :     else ();
250 :     newCluster
251 :     end
252 :     val instrSel = doPhase (CG.AFTER_INSTR_SEL, fn x => x)
253 :     val regAlloc = doPhase (CG.AFTER_RA, RegAllocation.ra)
254 :     in
255 :     case !CG.printFlowgraph
256 :     of CG.NO_PHASE => (BBSched.bbsched o RegAllocation.ra) cluster
257 :     | phase => (BBSched.bbsched o regAlloc o instrSel) cluster
258 :     end
259 :    
260 :     (* primitives for generation of HPPA instruction flowgraphs *)
261 :     structure FlowGraphGen =
262 :     FlowGraphGen(structure Flowgraph = HppaFlowGraph
263 :     structure InsnProps = HppaProps
264 :     structure MLTree = HppaMLTree
265 :     val codegen = codegen)
266 :    
267 :     structure HppaMillicode =
268 :     HppaMillicode(structure MLTree=HppaMLTree
269 :     structure Instr=HppaInstr)
270 :    
271 :     structure HppaLabelComp =
272 :     HppaLabelComp(structure MLTree=HppaMLTree
273 :     structure Instr=HppaInstr)
274 :    
275 :     (* compilation of CPS to MLRISC *)
276 :     structure MLTreeGen =
277 :     MLRiscGen(structure MachineSpec=HppaSpec
278 :     structure MLTreeComp=
279 :     Hppa(structure Flowgen=FlowGraphGen
280 :     structure HppaInstr = HppaInstr
281 :     structure HppaMLTree = HppaMLTree
282 :     structure MilliCode=HppaMillicode
283 :     structure LabelComp=HppaLabelComp)
284 :     structure Cells=HppaCells
285 :     structure C=HppaCpsRegs
286 :     structure ConstType=HppaConst
287 :     structure PseudoOp=HppaPseudoOps)
288 :    
289 :     val finish = BBSched.finish
290 :     end
291 :    
292 :     (*
293 :     * $Log: hppaCG.sml,v $
294 : monnier 106 * Revision 1.2 1998/05/19 15:33:14 george
295 :     * instruction properties is no longer parameterized over the exnptrR
296 :     *
297 : monnier 93 * Revision 1.1.1.1 1998/04/08 18:39:55 george
298 :     * Version 110.5
299 : monnier 16 *
300 :     *)

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