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

Annotation of /sml/trunk/src/compiler/CodeGen/hppa/hppaCG.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 127 - (view) (download)
Original Path: sml/branches/SMLNJ/src/compiler/CodeGen/hppa/hppaCG.sml

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

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