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

Annotation of /sml/branches/SMLNJ/src/MLRISC/hppa/mltree/hppa.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 469 - (view) (download)

1 : monnier 245 (* hppa.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 AT&T Bell Laboratories.
4 :     *
5 :     * generates machine code from the mltree.
6 :     *
7 : monnier 411 * This new version has been completely rewritten to take (more) advantage
8 :     * of the new improved instruction set.
9 :     *
10 :     * Please see the README.hppa file for details.
11 :     *
12 :     * -- Allen
13 : monnier 245 *)
14 : monnier 411
15 : monnier 245 functor Hppa
16 :     (structure HppaInstr : HPPAINSTR
17 : monnier 411 structure HppaMLTree : MLTREE
18 :     where Region = HppaInstr.Region
19 :     and Constant = HppaInstr.Constant
20 :     where type cond = MLTreeBasis.cond
21 :     and type fcond = MLTreeBasis.fcond
22 :     and type rounding_mode = MLTreeBasis.rounding_mode
23 :     structure MilliCode : HPPA_MILLICODE
24 :     where I = HppaInstr
25 :     structure LabelComp : LABEL_COMP
26 :     where I = HppaInstr
27 :     and T = HppaMLTree
28 :     val costOfMultiply : int ref
29 :     val costOfDivision : int ref
30 :     ) : MLTREECOMP =
31 : monnier 245 struct
32 : monnier 411 structure I = HppaInstr
33 :     structure T = HppaMLTree
34 : monnier 429 structure S = T.Stream
35 : monnier 411 structure C = HppaCells
36 :     structure MC = MilliCode
37 :     structure LC = LabelComp
38 :     structure LE = LabelExp
39 :     structure Region = I.Region
40 :     structure Gen = MLTreeGen(structure T = T
41 :     val intTy = 32
42 :     val naturalWidths = [32]
43 : monnier 429 datatype rep = SE | ZE | NEITHER
44 :     val rep = NEITHER
45 : monnier 411 )
46 : monnier 245
47 : monnier 411 structure W = Word32
48 :     functor Multiply32 = MLTreeMult
49 :     (structure I = I
50 :     structure T = T
51 :     val intTy = 32
52 : monnier 429 type arg = {r1:C.cell,r2:C.cell,d:C.cell}
53 :     type argi = {r:C.cell,i:int,d:C.cell}
54 : monnier 245
55 : monnier 411 fun mov{r,d} = I.COPY{dst=[d],src=[r],tmp=NONE,impl=ref NONE}
56 :     fun add{r1,r2,d} = I.ARITH{a=I.ADD,r1=r1,r2=r2,t=d}
57 :     fun slli{r,i,d} = [I.SHIFT{s=I.ZDEP,r=r,p=31-i,len=32-i,t=d}]
58 :     fun srli{r,i,d} = [I.SHIFT{s=I.EXTRU,r=r,p=31-i,len=32-i,t=d}]
59 :     fun srai{r,i,d} = [I.SHIFT{s=I.EXTRS,r=r,p=31-i,len=32-i,t=d}]
60 :     )
61 : monnier 245
62 : monnier 411 (* signed, trapping version of multiply and divide *)
63 :     structure Mult32 = Multiply32
64 :     (val trapping = true
65 :     val multCost = costOfMultiply
66 :     val divCost = costOfDivision
67 :     fun addv{r1,r2,d} = [I.ARITH{a=I.ADDO,r1=r1,r2=r2,t=d}]
68 :     fun subv{r1,r2,d} = [I.ARITH{a=I.SUBO,r1=r1,r2=r2,t=d}]
69 :     val sh1addv = SOME(fn{r1,r2,d} => [I.ARITH{a=I.SH1ADDO,r1=r1,r2=r2,t=d}])
70 :     val sh2addv = SOME(fn{r1,r2,d} => [I.ARITH{a=I.SH2ADDO,r1=r1,r2=r2,t=d}])
71 :     val sh3addv = SOME(fn{r1,r2,d} => [I.ARITH{a=I.SH3ADDO,r1=r1,r2=r2,t=d}])
72 :     )
73 : monnier 429 (val signed = true)
74 : monnier 245
75 : monnier 411 (* unsigned, non-trapping version of multiply and divide *)
76 :     structure Mulu32 = Multiply32
77 :     (val trapping = false
78 :     val signed = false
79 :     val multCost = costOfMultiply
80 :     val divCost = costOfDivision
81 :     fun addv{r1,r2,d} = [I.ARITH{a=I.ADD,r1=r1,r2=r2,t=d}]
82 :     fun subv{r1,r2,d} = [I.ARITH{a=I.SUB,r1=r1,r2=r2,t=d}]
83 :     val sh1addv = SOME(fn{r1,r2,d} => [I.ARITH{a=I.SH1ADDL,r1=r1,r2=r2,t=d}])
84 :     val sh2addv = SOME(fn{r1,r2,d} => [I.ARITH{a=I.SH2ADDL,r1=r1,r2=r2,t=d}])
85 :     val sh3addv = SOME(fn{r1,r2,d} => [I.ARITH{a=I.SH3ADDL,r1=r1,r2=r2,t=d}])
86 :     )
87 : monnier 429 (val signed = false)
88 : monnier 245
89 : monnier 411 fun error msg = MLRiscErrorMsg.error("Hppa",msg)
90 : monnier 245
91 : monnier 411 datatype ea =
92 : monnier 429 DISPea of C.cell * I.operand (* displacement *)
93 :     | INDXea of C.cell * C.cell (* indexed *)
94 :     | INDXSCALEDea of C.cell * C.cell (* indexed with scaling (b,x) *)
95 : monnier 245
96 : monnier 411 datatype opnd = datatype LC.lab_opnd
97 :     datatype times248 = TIMES1
98 :     | TIMES2
99 :     | TIMES4
100 :     | TIMES8
101 : monnier 245
102 : monnier 411 val itow = W.fromInt
103 : monnier 245
104 : monnier 411 fun selectInstructions
105 : monnier 429 (S.STREAM{emit, defineLabel, entryLabel,
106 :     beginCluster, endCluster, annotation,
107 : monnier 469 exitBlock, pseudoOp, phi, alias, comment, ...}) =
108 : monnier 411 let
109 :     (* operand type and effective addresss *)
110 :    
111 :     val newReg = C.newReg
112 :     val newFreg = C.newFreg
113 :     val CRReg = C.Reg C.CR
114 :     val zeroR = 0
115 :     val zeroF = C.FPReg 0
116 :     val zeroEA = I.Direct zeroR
117 :     val zeroT = T.REG(32,zeroR)
118 :     val zeroImmed = I.IMMED 0
119 :     val zeroOpn = OPND(zeroImmed)
120 : monnier 245
121 : monnier 411 fun mark(i,an) =
122 :     let fun f(i,[]) = i
123 :     | f(i,a::an) = f(I.ANNOTATION{i=i,a=a},an)
124 :     in emit(f(i,an)) end
125 :    
126 :     val ldLabelEA = LC.ldLabelEA emit
127 :     val ldLabelOpnd = LC.ldLabelOpnd emit
128 : monnier 245
129 : monnier 411 (* Check whether an expression is being multiplied by 2, 4, or 8 *)
130 :     fun times(T.MULU(_,e,T.LI 2)) = (TIMES2,e)
131 :     | times(T.MULU(_,e,T.LI32 0w2)) = (TIMES2,e)
132 :     | times(T.MULU(_,e,T.LI 4)) = (TIMES4,e)
133 :     | times(T.MULU(_,e,T.LI32 0w4)) = (TIMES4,e)
134 :     | times(T.MULU(_,e,T.LI 8)) = (TIMES8,e)
135 :     | times(T.MULU(_,e,T.LI32 0w8)) = (TIMES8,e)
136 :     | times(T.MULU(_,T.LI 2,e)) = (TIMES2,e)
137 :     | times(T.MULU(_,T.LI32 0w2,e)) = (TIMES2,e)
138 :     | times(T.MULU(_,T.LI 4,e)) = (TIMES4,e)
139 :     | times(T.MULU(_,T.LI32 0w4,e)) = (TIMES4,e)
140 :     | times(T.MULU(_,T.LI 8,e)) = (TIMES8,e)
141 :     | times(T.MULU(_,T.LI32 0w8,e)) = (TIMES8,e)
142 :     | times(T.SLL(_,e,T.LI 1)) = (TIMES2,e)
143 :     | times(T.SLL(_,e,T.LI32 0w1)) = (TIMES2,e)
144 :     | times(T.SLL(_,e,T.LI 2)) = (TIMES4,e)
145 :     | times(T.SLL(_,e,T.LI32 0w2)) = (TIMES4,e)
146 :     | times(T.SLL(_,e,T.LI 3)) = (TIMES8,e)
147 :     | times(T.SLL(_,e,T.LI32 0w3)) = (TIMES8,e)
148 :     | times e = (TIMES1,e)
149 : monnier 245
150 : monnier 411 (* trapping version of the above *)
151 :     fun timest(T.MULT(_,e,T.LI 2)) = (TIMES2,e)
152 :     | timest(T.MULT(_,e,T.LI 4)) = (TIMES4,e)
153 :     | timest(T.MULT(_,e,T.LI 8)) = (TIMES8,e)
154 :     | timest(T.MULT(_,T.LI 2,e)) = (TIMES2,e)
155 :     | timest(T.MULT(_,T.LI 4,e)) = (TIMES4,e)
156 :     | timest(T.MULT(_,T.LI 8,e)) = (TIMES8,e)
157 :     | timest e = (TIMES1,e)
158 : monnier 245
159 :    
160 : monnier 411 fun im5 n = n < 16 andalso n >= ~16
161 :     fun im11 n = n < 1024 andalso n >= ~1024
162 :     fun im14 n = n < 8192 andalso n >= ~8192
163 :    
164 :     (* Split values into 11 low bits and 21 high bits *)
165 :     fun split11w w =
166 :     {hi = Word32.toIntX(Word32.~>>(w,0w11)),
167 :     lo = Word32.toIntX(Word32.andb(w,0wx7ff))}
168 :     fun split11 n = split11w(Word32.fromInt n)
169 :    
170 :     (* load immediate *)
171 :     fun loadImmed(n,t,an) =
172 :     if im14 n
173 :     then mark(I.LDO{i=I.IMMED n,b=0,t=t},an)
174 :     else let val {hi,lo} = split11 n
175 :     val tmp = newReg()
176 :     in emit(I.LDIL{i=I.IMMED hi,t=tmp});
177 :     mark(I.LDO{i=I.IMMED lo,b=tmp,t=t},an)
178 :     end
179 :    
180 :     (* load word constant into register t *)
181 :     fun loadImmedw(w,t,an) =
182 :     if Word32.<(w,0w8192)
183 :     then mark(I.LDO{i=I.IMMED(Word32.toIntX w),b=0,t=t},an)
184 :     else let val {hi,lo} = split11w w
185 :     val tmp = newReg()
186 :     in emit(I.LDIL{i=I.IMMED hi,t=tmp});
187 :     mark(I.LDO{i=I.IMMED lo,b=tmp,t=t},an)
188 :     end
189 :    
190 :     (* generate code to load a immediate constant *)
191 :     fun immed n = let val t = newReg() in loadImmed(n,t,[]); t end
192 :     fun immedw w = let val t = newReg() in loadImmedw(w,t,[]); t end
193 :    
194 :     (* load constant *)
195 :     fun loadConst(c,t,an) = mark(I.LDO{b=0,i=I.ConstOp c,t=t},an)
196 :    
197 :     (* convert an operand into a register *)
198 :     fun reduceOpn i =
199 :     let val t = newReg()
200 :     in emit(I.LDO{i=i,b=0,t=t}); t end
201 :    
202 :     (* emit parallel copies *)
203 :     fun copy(dst,src,an) =
204 :     mark(I.COPY{dst=dst,src=src,impl=ref NONE,
205 :     tmp=case dst of [_] => NONE
206 :     | _ => SOME(I.Direct(newReg()))},an)
207 :     fun fcopy(dst,src,an) =
208 :     mark(I.FCOPY{dst=dst,src=src,impl=ref NONE,
209 :     tmp=case dst of [_] => NONE
210 :     | _ => SOME(I.FDirect(newFreg()))},an)
211 :    
212 :     (* move register s to register t *)
213 :     fun move(s,t,an) =
214 :     if s = t orelse t = zeroR then ()
215 :     else if s = zeroR then
216 :     mark(I.LDO{i=zeroImmed,b=zeroR,t=t},an)
217 :     else mark(I.COPY{src=[s],dst=[t],impl=ref NONE,tmp=NONE},an)
218 :    
219 :     (* move floating point register s to register t *)
220 :     fun fmove(s,t,an) =
221 :     if s = t then ()
222 :     else mark(I.FCOPY{src=[s],dst=[t],impl=ref NONE,tmp=NONE},an)
223 :    
224 :     (* generate millicode function call *)
225 :     fun milliCall(milliFn, e1, e2, rd) =
226 :     let val rs = expr e1
227 :     val rt = expr e2
228 :     in app emit (milliFn{rs=rs,rt=rt,rd=rd}) end
229 :    
230 :     (* emit an arithmetic op with possible immediate mode
231 :     * The immed operand is the first operand on the HPPA! Arrrrggggghhhh!
232 :     *)
233 :     and immedArith(a,ai,e1,e2,t,an) =
234 :     case (opn e1,expr e2) of
235 :     (REG r1,r2) => mark(I.ARITH{a=a,r1=r1,r2=r2,t=t},an)
236 :     | (OPND i,r) => mark(I.ARITHI{ai=ai,r=r,i=i,t=t},an)
237 :    
238 :     (* emit a commutative arithmetic op with immediate mode *)
239 :     and commImmedArith(a,ai,e1,e2,t,an) =
240 :     case (opn e1,opn e2) of
241 :     (REG r1,REG r2) => mark(I.ARITH{a=a,r1=r1,r2=r2,t=t},an)
242 :     | (REG r,OPND i) => mark(I.ARITHI{ai=ai,r=r,i=i,t=t},an)
243 :     | (OPND i,REG r) => mark(I.ARITHI{ai=ai,r=r,i=i,t=t},an)
244 :     | (OPND i,OPND j) => mark(I.ARITHI{ai=ai,r=reduceOpn i,i=j,t=t},an)
245 :    
246 :     (* emit an arithmetic op *)
247 :     and arith(a,e1,e2,t,an) =
248 :     mark(I.ARITH{a=a,r1=expr e1,r2=expr e2,t=t},an)
249 :    
250 :     (* emit an unary floating point op *)
251 :     and funary(a,e,t,an) = mark(I.FUNARY{fu=a,f=fexpr e,t=t},an)
252 :    
253 :     (* emit an conversion floating point op *)
254 :     and fcnv(a,e,t,an) = mark(I.FCNV{fcnv=a,f=fexpr e,t=t},an)
255 :    
256 :     (* emit a binary floating point op *)
257 :     and farith(a,e1,e2,t,an) =
258 :     mark(I.FARITH{fa=a,r1=fexpr e1,r2=fexpr e2,t=t},an)
259 :    
260 :     (* convert an expression into an addressing mode
261 :     * scale is the size of the data being addressed.
262 :     *)
263 :     and addr(scale,T.ADD(_,e,T.LI n)) = DISPea(expr e,I.IMMED n)
264 :     | addr(scale,T.ADD(_,e,T.CONST c)) = DISPea(expr e,I.ConstOp c)
265 :     | addr(scale,T.ADD(ty,i as T.LI _,e)) = addr(scale,T.ADD(ty,e,i))
266 :     | addr(scale,T.ADD(_,T.CONST c,e)) = DISPea(expr e,I.ConstOp c)
267 :     | addr(scale,T.ADD(_,e,T.LABEL le)) =
268 :     let val rs = expr e
269 :     in case ldLabelEA le of
270 :     (0, opnd) => DISPea(rs,opnd)
271 :     | (rt,I.IMMED 0) => INDXea(rs,rt)
272 :     | (rt,opnd) =>
273 :     let val tmp = newReg()
274 :     in emit(I.ARITH{a=I.ADD,r1=rs,r2=rt,t=tmp});
275 :     DISPea(tmp,opnd)
276 :     end
277 :     end
278 :     | addr(scale,T.ADD(t,e1 as T.LABEL l,e2)) = addr(scale,T.ADD(t,e2,e1))
279 :     | addr(scale,T.ADD(_,e1,e2)) =
280 :     let (* check for special multiply add sequence
281 :     * here, e1 is is scaled
282 :     *)
283 :     fun scaleIndexed(actualScale,opcode,e1,e2) =
284 :     if actualScale = scale then (* can we use scaled indexing mode?*)
285 :     let val x = expr e1
286 :     val b = expr e2
287 :     in INDXSCALEDea(b,x)
288 :     end
289 :     else (* no, use the SHnADD operator, then *)
290 :     let val tmp = newReg()
291 :     in emit(I.ARITH{a=opcode,r1=expr e1,r2=expr e2,t=tmp});
292 :     DISPea(tmp,zeroImmed)
293 :     end
294 :     in case times e1 of
295 :     (TIMES2,e1) => scaleIndexed(16,I.SH1ADD,e1,e2)
296 :     | (TIMES4,e1) => scaleIndexed(32,I.SH2ADD,e1,e2)
297 :     | (TIMES8,e1) => scaleIndexed(64,I.SH3ADD,e1,e2)
298 :     | _ =>
299 :     case times e2 of
300 :     (TIMES2,e2) => scaleIndexed(16,I.SH1ADD,e2,e1)
301 :     | (TIMES4,e2) => scaleIndexed(32,I.SH2ADD,e2,e1)
302 :     | (TIMES8,e2) => scaleIndexed(64,I.SH3ADD,e2,e1)
303 :     | _ => INDXea(expr e1,expr e2)
304 :     end
305 :     | addr(scale,T.SUB(ty,e,T.LI n)) = addr(scale,T.ADD(ty,e,T.LI(~n)))
306 :     | addr(scale,T.LABEL lexp) = DISPea(ldLabelEA(lexp))
307 :     | addr(scale,ea) = DISPea(expr ea,zeroImmed)
308 :    
309 :     (* emit an integer load
310 :     * li - load immediate,
311 :     * l - load indexed
312 :     * ls - load indexed with scaling
313 :     * r1 is base r2 is x
314 :     *)
315 :     and load(scale,li,l,ls,ea,t,mem,an) =
316 :     case addr(scale,ea) of
317 :     DISPea(r,i as I.IMMED off) =>
318 :     if im14 off then
319 :     mark(I.LOADI{li=li,r=r,i=i,t=t,mem=mem},an)
320 :     else
321 :     mark(I.LOAD{l=l,r1=r,r2=immed off,t=t,mem=mem},an)
322 :     | DISPea(r,i) => mark(I.LOADI{li=li,r=r,i=i,t=t,mem=mem},an)
323 :     | INDXea(r1,r2) => mark(I.LOAD{l=l,r1=r1,r2=r2,t=t,mem=mem},an)
324 :     | INDXSCALEDea(b,x) => mark(I.LOAD{l=ls,r1=b,r2=x,t=t,mem=mem},an)
325 :    
326 :     (* emit an integer store *)
327 :     and store(st,ea,r,mem,an) =
328 :     let val (b,d) =
329 :     case addr(0,ea) of
330 :     DISPea(b,d as I.IMMED disp) =>
331 :     if im14 disp then (b,d)
332 :     else let val {hi,lo} = split11 disp
333 :     val tmp1 = newReg()
334 :     val tmp2 = newReg()
335 :     in emit(I.LDIL{i=I.IMMED hi,t=tmp1});
336 :     emit(I.ARITH{a=I.ADD,r1=b,r2=tmp1,t=tmp2});
337 :     (tmp2,I.IMMED lo)
338 :     end
339 :     | DISPea bd => bd
340 :     | INDXea(r1,r2) =>
341 :     let val tmp = newReg()
342 :     in emit(I.ARITH{a=I.ADD,r1=r1,r2=r2,t=tmp});
343 :     (tmp,I.IMMED 0)
344 :     end
345 :     | INDXSCALEDea _ => error "store"
346 :     in mark(I.STORE{st=st,b=b,d=d,r=r,mem=mem},an) end
347 :    
348 :     (* emit a floating point load *)
349 :     and fload(scale,fl,flx,flxs,ea,t,mem,an) =
350 :     case addr(scale,ea) of
351 :     INDXea(b,x) => mark(I.FLOADX{flx=flx,b=b,x=x,t=t,mem=mem},an)
352 :     | INDXSCALEDea(b,x) =>
353 :     mark(I.FLOADX{flx=flxs,b=b,x=x,t=t,mem=mem},an)
354 :     | DISPea(b,I.IMMED d) =>
355 :     if im5 d then
356 :     mark(I.FLOAD{fl=fl,b=b,d=d,t=t,mem=mem},an)
357 :     else
358 :     mark(I.FLOADX{flx=flx,b=b,x=immed d,t=t,mem=mem},an)
359 :     | DISPea(b,d) =>
360 :     let val tmp = newReg()
361 :     in emit(I.ARITHI{ai=I.ADDI,r=b,i=d,t=tmp});
362 :     mark(I.FLOADX{flx=flx,b=tmp,x=zeroR,t=t,mem=mem},an)
363 :     end
364 : monnier 245
365 : monnier 411 (* emit a floating point store *)
366 :     and fstore(scale,fst,fstx,fstxs,ea,data,mem,an) =
367 :     let val r = fexpr data
368 :     in case addr(scale,ea) of
369 :     DISPea(b,I.IMMED d) =>
370 :     if im5 d then mark(I.FSTORE{fst=fst,b=b,d=d,r=r,mem=mem},an)
371 :     else mark(I.FSTOREX{fstx=fstx,b=b,x=immed d,r=r,mem=mem},an)
372 :     | DISPea(b,d) =>
373 :     let val tmp = newReg()
374 :     in emit(I.ARITHI{ai=I.ADDI,r=b,i=d,t=tmp});
375 :     mark(I.FSTORE{fst=I.FSTDS,b=tmp,d=0,r=r,mem=mem},an)
376 :     end
377 :     | INDXea(b,x) =>
378 :     mark(I.FSTOREX{fstx=fstx,b=b,x=x,r=r,mem=mem},an)
379 :     | INDXSCALEDea(b,x) =>
380 :     mark(I.FSTOREX{fstx=fstxs,b=b,x=x,r=r,mem=mem},an)
381 :     end
382 :    
383 :     (* emit an integer branch instruction *)
384 :    
385 :     (* generate a branch *)
386 :     and branch(_,T.CMP(ty,cc,T.LI n,e),lab,an) = (* optimize cmp immed *)
387 :     emitBranchCmpWithImmed(ty,cc,n,e,lab,an)
388 :     | branch(cond,T.CMP(ty,cc,e1,e2 as T.LI _),lab,an) = (* commute *)
389 :     branch(cond,T.CMP(ty,MLTreeUtil.swapCond cc,e2,e1),lab,an)
390 :     | branch(_,T.CMP(ty,cc,a,b),lab,an) = (* do the usual *)
391 :     emitBranch(ty,cc,expr a,expr b,lab,an)
392 :     | branch(cc,e,lab,an) = error "branch: what is the semantics?"
393 : monnier 245
394 : monnier 411 (* generate a branch cmp with immed *)
395 :     and emitBranchCmpWithImmed(ty,cc,n,e2 as T.ANDB(_,e,T.LI mask),t,an) =
396 :     emitBranchOnBit(ty,cc,n,e2,e,itow mask,t,an)
397 :     | emitBranchCmpWithImmed(ty,cc,n,e2 as T.ANDB(_,e,T.LI32 mask),t,an) =
398 :     emitBranchOnBit(ty,cc,n,e2,e,mask,t,an)
399 :     | emitBranchCmpWithImmed(ty,cc,n,e2 as T.ANDB(_,T.LI mask,e),t,an) =
400 :     emitBranchOnBit(ty,cc,n,e2,e,itow mask,t,an)
401 :     | emitBranchCmpWithImmed(ty,cc,n,e2 as T.ANDB(_,T.LI32 mask,e),t,an) =
402 :     emitBranchOnBit(ty,cc,n,e2,e,mask,t,an)
403 :     | emitBranchCmpWithImmed(ty,cc,n,e2,t,an) =
404 :     emitBranchI(ty,cc,n,e2,t,an)
405 :    
406 :     (* generate a branch on bit *)
407 :     and emitBranchOnBit(ty,cc,n,e2,e,mask,t,an) =
408 :     let fun isPowerOf2 w = W.andb(w,w-0w1) = 0w0
409 :     fun log w =
410 :     let fun f(0w1,n) = n
411 :     | f(w,n) = f(W.>>(w,0w1),n+1)
412 :     in f(w,0) end
413 :     val n' = itow n
414 :     in if (n' = 0w0 orelse n' = mask) andalso
415 :     (cc = T.EQ orelse cc = T.NE) andalso
416 :     (mask > 0w0 andalso isPowerOf2 mask) then (* bit test! *)
417 :     let val bc =
418 :     case (cc,n') of
419 :     (T.EQ,0w0) => I.BCLR (* bit is 0 *)
420 :     | (T.EQ,_) => I.BSET (* bit is 1 *)
421 :     | (T.NE,0w0) => I.BSET (* bit is 1 *)
422 :     | (T.NE,_) => I.BCLR (* bit is 0 *)
423 :     | _ => error "emitBranchOnBit"
424 :     val f = Label.newLabel ""
425 :     val bit = 31 - log mask
426 :     in mark(I.BB{bc=bc,r=expr e,p=bit,t=t,f=f,
427 :     n=false, nop=true},an);
428 :     defineLabel f
429 :     end
430 :     else
431 :     emitBranchI(ty,cc,n,e2,t,an)
432 : monnier 245 end
433 : monnier 411
434 :     (* generate a branch cmp with immediate *)
435 :     and emitBranchI(ty,cc,n,e2,t,an) =
436 :     let val r2 = expr e2
437 :     in if im5 n then
438 :     let val f = Label.newLabel ""
439 :     val (cmpi,bc) =
440 :     case cc of
441 :     T.LT => (I.COMIBT, I.LT)
442 :     | T.LE => (I.COMIBT, I.LE)
443 :     | T.GT => (I.COMIBF, I.LE)
444 :     | T.GE => (I.COMIBF, I.LT)
445 :     | T.EQ => (I.COMIBT, I.EQ)
446 :     | T.LTU => (I.COMIBT, I.LTU)
447 :     | T.LEU => (I.COMIBT, I.LEU)
448 :     | T.GEU => (I.COMIBF, I.LTU)
449 :     | T.GTU => (I.COMIBF, I.LEU)
450 :     | T.NE => (I.COMIBF, I.EQ)
451 :     in mark(I.BCONDI{cmpi=cmpi,bc=bc,i=n,r2=r2,t=t,f=f,
452 :     n=false, nop=true},an);
453 :     defineLabel f
454 :     end
455 :     else emitBranch(ty,cc,immed n,r2,t,an)
456 :     end
457 : monnier 245
458 : monnier 411 (* generate a branch *)
459 :     and emitBranch(ty,cond,r1,r2,t,an) =
460 :     let val f = Label.newLabel ""
461 :     val (cmp,bc,r1,r2) =
462 :     case cond of
463 :     T.LT => (I.COMBT, I.LT, r1, r2)
464 :     | T.LE => (I.COMBT, I.LE, r1, r2)
465 :     | T.GT => (I.COMBT, I.LT, r2, r1)
466 :     | T.GE => (I.COMBT, I.LE, r2, r1)
467 :     | T.EQ => (I.COMBT, I.EQ, r1, r2)
468 :     | T.LTU => (I.COMBT, I.LTU, r1, r2)
469 :     | T.LEU => (I.COMBT, I.LEU, r1, r2)
470 :     | T.GEU => (I.COMBT, I.LEU, r2, r1)
471 :     | T.GTU => (I.COMBT, I.LTU, r2, r1)
472 :     | T.NE => (I.COMBF, I.EQ, r1, r2)
473 :     in mark(I.BCOND{cmp=cmp,bc=bc,r1=r1,r2=r2,t=t,f=f,
474 :     n=false,nop=true},an);
475 :     defineLabel f
476 :     end
477 : monnier 245
478 : monnier 411 and getFmt e =
479 :     case Gen.fsize e of
480 :     32 => I.SGL
481 :     | 64 => I.DBL
482 :     | 128 => I.QUAD
483 :     | _ => error "getFmt"
484 : monnier 245
485 : monnier 411 (* emit a floating point branch instruction *)
486 :     and fbranch(c,T.FCMP(fty,cc,a,b),lab,an) =
487 :     let val f1 = fexpr a
488 :     val f2 = fexpr b
489 :     val fallThrough = Label.newLabel ""
490 :     fun fcond T.== = I.!=
491 :     | fcond T.?<> = I.==
492 :     | fcond T.? = I.<=>
493 :     | fcond T.<=> = I.?
494 :     | fcond T.> = I.?<=
495 :     | fcond T.>= = I.?<
496 :     | fcond T.?> = I.<=
497 :     | fcond T.?>= = I.<
498 :     | fcond T.< = I.?>=
499 :     | fcond T.<= = I.?>
500 :     | fcond T.?< = I.>=
501 :     | fcond T.?<= = I.>
502 :     | fcond T.<> = I.?=
503 :     | fcond T.?= = I.<>
504 :     | fcond _ = error "fcond"
505 :     in mark(I.FBRANCH{cc=fcond cc,f1=f1,f2=f2,t=lab,f=fallThrough,
506 :     fmt=getFmt a,n=true,long=false},an);
507 :     defineLabel fallThrough
508 :     end
509 :     | fbranch _ = error "fbranch"
510 :    
511 :     (* generate code for a statement *)
512 :     and stmt(T.MV(32,t,e),an) = doExpr(e,t,an)
513 :     | stmt(T.FMV(64,t,e),an) = doFexpr(e,t,an)
514 :     | stmt(T.CCMV(t,e),an) = doCCexpr(e,t,an)
515 :     | stmt(T.COPY(32,dst,src),an) = copy(dst,src,an)
516 :     | stmt(T.FCOPY(64,dst,src),an) = fcopy(dst,src,an)
517 :     | stmt(T.JMP(T.LABEL(LE.LABEL l),_),an) = mark(I.B{lab=l,n=true},an)
518 :     | stmt(T.JMP(ea,labs),an) = jmp(ea,labs,an)
519 :     | stmt(s as T.CALL _,an) = call(s,an)
520 :     | stmt(T.RET,an) = mark(I.BV{labs=[],x=0,b=C.returnPtr,n=true},an)
521 :     | stmt(T.STORE(8,ea,t,mem),an) = store(I.STB,ea,expr t,mem,an)
522 :     | stmt(T.STORE(16,ea,t,mem),an) = store(I.STH,ea,expr t,mem,an)
523 :     | stmt(T.STORE(32,ea,t,mem),an) = store(I.STW,ea,expr t,mem,an)
524 :     | stmt(T.FSTORE(32,ea,t,mem),an) =
525 :     fstore(32,I.FSTWS,I.FSTWX,I.FSTWX_S,ea,t,mem,an)
526 :     | stmt(T.FSTORE(64,ea,t,mem),an) =
527 :     fstore(64,I.FSTDS,I.FSTDX,I.FSTDX_S,ea,t,mem,an)
528 :     | stmt(T.BCC(cond,cc,lab),an) = branch(cond,cc,lab,an)
529 :     | stmt(T.FBCC(cond,cc,lab),an) = fbranch(cond,cc,lab,an)
530 :     | stmt(T.ANNOTATION(i,a),an) = stmt(i,a::an)
531 :     | stmt _ = error "stmt"
532 : monnier 245
533 : monnier 411 and doStmt s = stmt(s,[])
534 : monnier 245
535 : monnier 411 and jmp(e,labs,an) =
536 :     let val (b,x) =
537 :     case addr(32,e) of
538 :     DISPea(b,I.IMMED 0) => (b,0)
539 :     | DISPea(r,i) => let val b=newReg()
540 :     in emit(I.ARITHI{ai=I.ADDI,i=i,r=r,t=b});
541 :     (b,0)
542 :     end
543 :     | INDXea(r1,r2) => let val b=newReg()
544 :     in emit(I.ARITH{a=I.ADD,r1=r1,r2=r2,t=b});
545 :     (b,0)
546 :     end
547 :     | INDXSCALEDea(b,x) => (b,x)
548 :     in mark(I.BV{b=b,x=x,n=true,labs=labs},an) end
549 : monnier 245
550 : monnier 411 and call(s,an) = let val reduce = {stm=doStmt, rexp=expr, emit=emit}
551 :     in LC.doCall(reduce,s) end
552 : monnier 245
553 : monnier 411 (* Optimize addition *)
554 :     and plus(times,sh1add,sh2add,sh3add,add,addi,a,b,t,an) =
555 :     case times a of
556 :     (TIMES2,a) => arith(sh1add,a,b,t,an)
557 :     | (TIMES4,a) => arith(sh2add,a,b,t,an)
558 :     | (TIMES8,a) => arith(sh3add,a,b,t,an)
559 :     | _ =>
560 :     case times b of
561 :     (TIMES2,b) => arith(sh1add,b,a,t,an)
562 :     | (TIMES4,b) => arith(sh2add,b,a,t,an)
563 :     | (TIMES8,b) => arith(sh3add,b,a,t,an)
564 :     | _ => commImmedArith(add,addi,a,b,t,an)
565 : monnier 245
566 : monnier 411 (* Round to zero for division:
567 :     * d <- r + i
568 :     * d <- if r >= 0 then r else d
569 :     *)
570 :     and roundToZero{ty,r,i,d} =
571 :     (doStmt(T.MV(ty,d,T.ADD(ty,T.REG(ty,r),T.LI i)));
572 :     doStmt(T.MV(ty,d,T.COND(ty,T.CMP(ty,T.GE,T.REG(ty,r),T.LI 0),
573 :     T.REG(ty,r),T.REG(ty,d))))
574 :     )
575 : monnier 245
576 : monnier 411 and divu32 x = Mulu32.divide{mode=T.TO_ZERO,roundToZero=roundToZero} x
577 :     and divt32 x = Mult32.divide{mode=T.TO_ZERO,roundToZero=roundToZero} x
578 :    
579 :     and muldiv(ty,genConst,milliFn,a,b,t,commute,an) =
580 :     let fun const(a,i) =
581 :     let val r = expr a
582 :     in app emit (genConst{r=r,i=i,d=t})
583 :     handle _ => milliCall(milliFn,T.REG(ty,r),T.LI i,t)
584 :     end
585 :     fun constw(a,i) =
586 :     const(a,Word32.toInt i)
587 :     handle Overflow => milliCall(milliFn,a,b,t)
588 :     in case (commute,a,b) of
589 :     (_,a,T.LI i) => const(a,i)
590 :     | (_,a,T.LI32 i) => constw(a,i)
591 :     | (true,T.LI i,a) => const(a,i)
592 :     | (true,T.LI32 i,a) => constw(a,i)
593 :     | (_,a,b) => milliCall(milliFn,a,b,t)
594 :     end
595 : monnier 245
596 : monnier 411 (* compile shift *)
597 :     and shift(immedShift,varShift,e,T.LI n,t,an) =
598 :     if n < 0 orelse n > 31 then error "shift"
599 :     else mark(I.SHIFT{s=immedShift,r=expr e,p=31-n,len=32-n,t=t},an)
600 :     | shift(immedShift,varShift,e1,e2,t,an) =
601 :     let val r1 = expr e1
602 :     val r2 = expr e2
603 :     val tmp = newReg()
604 :     in emit(I.ARITHI{ai=I.SUBI, i=I.IMMED 31, r=r2, t=tmp});
605 :     emit(I.MTCTL{r=tmp, t=CRReg 11});
606 :     mark(I.SHIFTV{sv=varShift,r=r1,len=32, t=t},an)
607 :     end
608 : monnier 245
609 : monnier 411 (* Generate a COMCLR_LDO instruction sequence:
610 :     * COMCLR,cond r1, r2, t1
611 :     * LDO i(b), t2
612 :     *
613 :     * Note:
614 :     * t <- if cond(r1,r2) then i else 0 can be mapped into:
615 :     *
616 :     * COMCLR,cond r1, r2, t
617 :     * LDO i(0), t
618 :     *
619 :     * if cond(r1,r2) then t <- e can be mapped into:
620 :     *
621 :     * t' <- e
622 :     * COMCLR,cond r1, r2, 0
623 :     * LDO 0(t'), t
624 :     *
625 :     * t <- if cond(r1,r2) then e1 else e2 can be mapped into:
626 :     *
627 :     * t <- e2
628 :     * t' <- e1
629 :     * COMCLR,cond r1, r2, 0
630 :     * LDO 0(t'), t
631 :     *)
632 :     and comclr(cond,r1,r2,yes,no,t,an) =
633 :     let val cc = case cond of
634 :     T.LT => I.GE
635 :     | T.LE => I.GT
636 :     | T.GT => I.LE
637 :     | T.GE => I.LT
638 :     | T.EQ => I.NE
639 :     | T.LTU => I.GEU
640 :     | T.LEU => I.GTU
641 :     | T.GEU => I.LTU
642 :     | T.GTU => I.LEU
643 :     | T.NE => I.EQ
644 :     val (b,i) =
645 :     case yes of
646 :     T.LI n => if im14 n then (zeroR,n) else
647 :     let val {hi,lo} = split11 n
648 :     val b = newReg()
649 :     in emit(I.LDIL{i=I.IMMED hi,t=b}); (b,lo) end
650 :     | T.LI32 w => let val {hi,lo} = split11w w
651 :     val b = newReg()
652 :     in emit(I.LDIL{i=I.IMMED hi,t=b}); (b,lo) end
653 :     | e => (expr e,0)
654 :     val t1 =
655 :     case no of
656 :     (T.LI 0 | T.LI32 0w0) => t (* false case is zero *)
657 :     | _ => (doExpr(no,t,[]); zeroR) (* move false case to t *)
658 :     in mark(I.COMCLR_LDO{cc=cc,r1=r1,r2=r2,b=b,i=i,t1=t1,t2=t},an)
659 :     end
660 : monnier 245
661 : monnier 411 (* convert an expression into a register *)
662 :     and expr(T.REG(_,r)) = r
663 :     | expr(T.LI 0) = zeroR
664 :     | expr(T.LI32 0w0) = zeroR
665 :     | expr e = let val t = newReg() in doExpr(e,t,[]); t end
666 :    
667 :     (* compute an integer expression and put the result in register t *)
668 :     and doExpr(e,t,an) =
669 :     case e of
670 :     T.REG(_,r) => move(r,t,an)
671 :     | T.LI n => loadImmed(n,t,an)
672 :     | T.LI32 w => loadImmedw(w,t,an)
673 :     | T.LABEL le =>
674 :     (case ldLabelOpnd{label=le,pref=SOME t} of
675 :     REG r => move(r,t,an)
676 :     | OPND opnd => mark(I.LDO{i=opnd,b=zeroR,t=t},an)
677 :     )
678 :     | T.CONST c => loadConst(c,t,an)
679 :     | T.ADD(_,a,b) => plus(times,
680 :     I.SH1ADDL,I.SH2ADDL,I.SH3ADDL,I.ADD,I.ADDI,
681 :     a,b,t,an)
682 :     | T.SUB(_,a,T.LI 0) => doExpr(a,t,an)
683 :     | T.SUB(_,a,T.LI32 0w0) => doExpr(a,t,an)
684 :     | T.SUB(_,a,T.LI n) => commImmedArith(I.ADD,I.ADDI,a,T.LI(~n),t,an)
685 :     | T.SUB(_,a,b) => immedArith(I.SUB,I.SUBI,a,b,t,an)
686 :     | T.ADDT(_,a,b) => plus(timest,
687 :     I.SH1ADDO,I.SH2ADDO,I.SH3ADDO,I.ADDO,I.ADDIO,
688 :     a,b,t,an)
689 :     | T.SUBT(_,a,T.LI n) => immedArith(I.ADDO,I.ADDIO,a,T.LI(~n),t,an)
690 :     | T.SUBT(_,a,b) => immedArith(I.SUBO,I.SUBIO,a,b,t,an)
691 : monnier 245
692 : monnier 411 | T.ANDB(_,a,T.NOTB(_,b)) => arith(I.ANDCM,a,b,t,an)
693 :     | T.ANDB(_,T.NOTB(_,a),b) => arith(I.ANDCM,b,a,t,an)
694 :     | T.ANDB(_,a,b) => arith(I.AND,a,b,t,an)
695 :     | T.ORB(_,a,b) => arith(I.OR,a,b,t,an)
696 :     | T.XORB(_,a,b) => arith(I.XOR,a,b,t,an)
697 : monnier 245
698 : monnier 411 | T.SLL(_,a,b) => shift(I.ZDEP,I.ZVDEP,a,b,t,an)
699 :     | T.SRL(_,a,b) => shift(I.EXTRU,I.VEXTRU,a,b,t,an)
700 :     | T.SRA(_,a,b) => shift(I.EXTRS,I.VEXTRS,a,b,t,an)
701 :     | T.MULU(32,a,b) => muldiv(32,Mulu32.multiply,MC.mulu,a,b,t,true,an)
702 :     | T.MULT(32,a,b) => muldiv(32,Mult32.multiply,MC.mulo,a,b,t,true,an)
703 :     | T.DIVU(32,a,b) => muldiv(32,divu32,MC.divu,a,b,t,false,an)
704 :     | T.DIVT(32,a,b) => muldiv(32,divt32,MC.divo,a,b,t,false,an)
705 : monnier 245
706 : monnier 411 | T.LOAD(8,ea,mem) => load(8,I.LDB,I.LDBX,I.LDBX,ea,t,mem,an)
707 :     | T.LOAD(16,ea,mem) => load(16,I.LDH,I.LDHX,I.LDHX_S,ea,t,mem,an)
708 :     | T.LOAD(32,ea,mem) => load(32,I.LDW,I.LDWX,I.LDWX_S,ea,t,mem,an)
709 : monnier 245
710 : monnier 411 | T.COND(_,T.CMP(_,cond,x,y),yes,no) =>
711 :     comclr(cond,expr x,expr y,yes,no,t,an)
712 :     | T.SEQ(s,e) => (doStmt s; doExpr(e,t,an))
713 :     | T.MARK(e,a) => doExpr(e,t,a::an)
714 :     | e => doExpr(Gen.compile e,t,an)
715 :    
716 :     (* convert an expression into a floating point register *)
717 :     and fexpr(T.FREG(_,r)) = r
718 :     | fexpr e = let val t = newFreg()
719 :     in doFexpr(e,t,[]); t end
720 : monnier 245
721 : monnier 411 (* compute a floating point expression and put the result in t *)
722 :     and doFexpr(e,t,an) =
723 :     case e of
724 :     (* single precision *)
725 :     T.FREG(32,r) => fmove(r,t,an)
726 :     | T.FLOAD(32,ea,mem) =>
727 :     fload(32,I.FLDWS,I.FLDWX,I.FLDWX_S,ea,t,mem,an)
728 :     | T.FADD(32,a,b) => farith(I.FADD_S,a,b,t,an)
729 :     | T.FSUB(32,a,b) => farith(I.FSUB_S,a,b,t,an)
730 :     | T.FMUL(32,a,b) => farith(I.FMPY_S,a,b,t,an)
731 :     | T.FDIV(32,a,b) => farith(I.FDIV_S,a,b,t,an)
732 :     | T.FABS(32,a) => funary(I.FABS_S,a,t,an)
733 :     | T.FSQRT(32,a) => funary(I.FSQRT_S,a,t,an)
734 :    
735 :     (* double precision *)
736 :     | T.FREG(64,r) => fmove(r,t,an)
737 :     | T.FLOAD(64,ea,mem) =>
738 :     fload(64,I.FLDDS,I.FLDDX,I.FLDDX_S,ea,t,mem,an)
739 :     | T.FADD(64,a,b) => farith(I.FADD_D,a,b,t,an)
740 :     | T.FSUB(64,a,b) => farith(I.FSUB_D,a,b,t,an)
741 :     | T.FMUL(64,a,b) => farith(I.FMPY_D,a,b,t,an)
742 :     | T.FDIV(64,a,b) => farith(I.FDIV_D,a,b,t,an)
743 :     | T.FABS(64,a) => funary(I.FABS_D,a,t,an)
744 :     | T.FSQRT(64,a) => funary(I.FSQRT_D,a,t,an)
745 : monnier 245
746 : monnier 411 (* conversions *)
747 :     | T.CVTF2F(ty,mode,e) =>
748 :     (case (ty,mode,Gen.fsize e) of
749 :     (64,T.TO_NEAREST,32) => fcnv(I.FCNVFF_SD,e,t,an)
750 :     | (32,_,64) => fcnv(I.FCNVFF_DS,e,t,an)
751 :     | (32,_,32) => doFexpr(e,t,an)
752 :     | (64,_,64) => doFexpr(e,t,an)
753 :     | _ => error "CVTF2F"
754 :     )
755 :     | T.CVTI2F(32,_,e) => app emit(MilliCode.cvti2s{rs=expr e,fd=t})
756 :     | T.CVTI2F(64,_,e) => app emit(MilliCode.cvti2d{rs=expr e,fd=t})
757 : monnier 245
758 : monnier 411 (* negation is implemented as subtraction *)
759 :     | T.FNEG(ty,a) => doFexpr(T.FSUB(ty,T.FREG(ty,zeroF),a),t,an)
760 : monnier 245
761 : monnier 411 | T.FSEQ(s,e) => (doStmt s; doFexpr(e,t,an))
762 :     | T.FMARK(e,a) => doFexpr(e,t,a::an)
763 : monnier 245
764 : monnier 411 | _ => error "doFexpr"
765 :    
766 :     and doCCexpr(T.CC r,t,an) = move(r,t,an)
767 :     | doCCexpr(T.CMP(ty,cond,e1,e2),t,an) = error "doCCexpr"
768 :     | doCCexpr(T.CCMARK(e,a),t,an) = doCCexpr(e,t,a::an)
769 :     | doCCexpr e = error "doCCexpr"
770 :    
771 :     and ccExpr(T.CC r) = r
772 :     | ccExpr e = let val t = newReg() in doCCexpr(e,t,[]); t end
773 : monnier 245
774 : monnier 411 (* convert an expression into an operand *)
775 :     and opn(T.CONST c) = OPND(I.ConstOp c)
776 :     | opn(T.LABEL le) = ldLabelOpnd{label=le,pref=NONE}
777 :     | opn(e as T.LI n) = if im11 n then OPND(I.IMMED n)
778 :     else REG(expr e)
779 :     | opn(e as T.LI32 w) = if Word32.<(w,0w1024)
780 :     then OPND(I.IMMED(Word32.toIntX w))
781 :     else REG(expr e)
782 :     | opn e = REG(expr e)
783 :    
784 : monnier 429 (* condition code registers are mapped onto general registers *)
785 :     fun cc (T.CCR(T.CC cc)) = T.GPR(T.REG(32,cc))
786 :     | cc x = x
787 :     in S.STREAM
788 :     { beginCluster= beginCluster,
789 :     endCluster = endCluster,
790 :     emit = doStmt,
791 :     pseudoOp = pseudoOp,
792 :     defineLabel = defineLabel,
793 :     entryLabel = entryLabel,
794 :     comment = comment,
795 :     annotation = annotation,
796 :     exitBlock = fn regs => exitBlock(map cc regs),
797 :     alias = alias,
798 :     phi = phi
799 :     }
800 : monnier 411 end
801 : monnier 429
802 : monnier 411
803 :     end

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