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 411 - (view) (download)
Original Path: sml/branches/SMLNJ/src/compiler/CodeGen/hppa/hppaCG.sml

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

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