566cc337b77dffd6cdcecd1018d5f19339281a0b
[ghc.git] / compiler / nativeGen / SPARC / CodeGen / Gen32.hs
1 -- | Evaluation of 32 bit values.
2 module SPARC.CodeGen.Gen32 (
3 getSomeReg,
4 getRegister
5 )
6
7 where
8
9 import SPARC.CodeGen.CondCode
10 import SPARC.CodeGen.Amode
11 import SPARC.CodeGen.Gen64
12 import SPARC.CodeGen.Base
13 import SPARC.Stack
14 import SPARC.Instr
15 import SPARC.Cond
16 import SPARC.AddrMode
17 import SPARC.Imm
18 import SPARC.Regs
19 import SPARC.Base
20 import NCGMonad
21 import Format
22 import Reg
23
24 import Cmm
25
26 import Control.Monad (liftM)
27 import DynFlags
28 import OrdList
29 import Outputable
30
31 -- | The dual to getAnyReg: compute an expression into a register, but
32 -- we don't mind which one it is.
33 getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)
34 getSomeReg expr = do
35 r <- getRegister expr
36 case r of
37 Any rep code -> do
38 tmp <- getNewRegNat rep
39 return (tmp, code tmp)
40 Fixed _ reg code ->
41 return (reg, code)
42
43
44
45 -- | Make code to evaluate a 32 bit expression.
46 --
47 getRegister :: CmmExpr -> NatM Register
48
49 getRegister (CmmReg reg)
50 = do dflags <- getDynFlags
51 let platform = targetPlatform dflags
52 return (Fixed (cmmTypeFormat (cmmRegType dflags reg))
53 (getRegisterReg platform reg) nilOL)
54
55 getRegister tree@(CmmRegOff _ _)
56 = do dflags <- getDynFlags
57 getRegister (mangleIndexTree dflags tree)
58
59 getRegister (CmmMachOp (MO_UU_Conv W64 W32)
60 [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) = do
61 ChildCode64 code rlo <- iselExpr64 x
62 return $ Fixed II32 (getHiVRegFromLo rlo) code
63
64 getRegister (CmmMachOp (MO_SS_Conv W64 W32)
65 [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) = do
66 ChildCode64 code rlo <- iselExpr64 x
67 return $ Fixed II32 (getHiVRegFromLo rlo) code
68
69 getRegister (CmmMachOp (MO_UU_Conv W64 W32) [x]) = do
70 ChildCode64 code rlo <- iselExpr64 x
71 return $ Fixed II32 rlo code
72
73 getRegister (CmmMachOp (MO_SS_Conv W64 W32) [x]) = do
74 ChildCode64 code rlo <- iselExpr64 x
75 return $ Fixed II32 rlo code
76
77
78 -- Load a literal float into a float register.
79 -- The actual literal is stored in a new data area, and we load it
80 -- at runtime.
81 getRegister (CmmLit (CmmFloat f W32)) = do
82
83 -- a label for the new data area
84 lbl <- getNewLabelNat
85 tmp <- getNewRegNat II32
86
87 let code dst = toOL [
88 -- the data area
89 LDATA ReadOnlyData $ Statics lbl
90 [CmmStaticLit (CmmFloat f W32)],
91
92 -- load the literal
93 SETHI (HI (ImmCLbl lbl)) tmp,
94 LD II32 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
95
96 return (Any FF32 code)
97
98 getRegister (CmmLit (CmmFloat d W64)) = do
99 lbl <- getNewLabelNat
100 tmp <- getNewRegNat II32
101 let code dst = toOL [
102 LDATA ReadOnlyData $ Statics lbl
103 [CmmStaticLit (CmmFloat d W64)],
104 SETHI (HI (ImmCLbl lbl)) tmp,
105 LD II64 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
106 return (Any FF64 code)
107
108
109 -- Unary machine ops
110 getRegister (CmmMachOp mop [x])
111 = case mop of
112 -- Floating point negation -------------------------
113 MO_F_Neg W32 -> trivialUFCode FF32 (FNEG FF32) x
114 MO_F_Neg W64 -> trivialUFCode FF64 (FNEG FF64) x
115
116
117 -- Integer negation --------------------------------
118 MO_S_Neg rep -> trivialUCode (intFormat rep) (SUB False False g0) x
119 MO_Not rep -> trivialUCode (intFormat rep) (XNOR False g0) x
120
121
122 -- Float word size conversion ----------------------
123 MO_FF_Conv W64 W32 -> coerceDbl2Flt x
124 MO_FF_Conv W32 W64 -> coerceFlt2Dbl x
125
126
127 -- Float <-> Signed Int conversion -----------------
128 MO_FS_Conv from to -> coerceFP2Int from to x
129 MO_SF_Conv from to -> coerceInt2FP from to x
130
131
132 -- Unsigned integer word size conversions ----------
133
134 -- If it's the same size, then nothing needs to be done.
135 MO_UU_Conv from to
136 | from == to -> conversionNop (intFormat to) x
137
138 -- To narrow an unsigned word, mask out the high bits to simulate what would
139 -- happen if we copied the value into a smaller register.
140 MO_UU_Conv W16 W8 -> trivialCode W8 (AND False) x (CmmLit (CmmInt 255 W8))
141 MO_UU_Conv W32 W8 -> trivialCode W8 (AND False) x (CmmLit (CmmInt 255 W8))
142
143 -- for narrowing 32 bit to 16 bit, don't use a literal mask value like the W16->W8
144 -- case because the only way we can load it is via SETHI, which needs 2 ops.
145 -- Do some shifts to chop out the high bits instead.
146 MO_UU_Conv W32 W16
147 -> do tmpReg <- getNewRegNat II32
148 (xReg, xCode) <- getSomeReg x
149 let code dst
150 = xCode
151 `appOL` toOL
152 [ SLL xReg (RIImm $ ImmInt 16) tmpReg
153 , SRL tmpReg (RIImm $ ImmInt 16) dst]
154
155 return $ Any II32 code
156
157 -- trivialCode W16 (AND False) x (CmmLit (CmmInt 65535 W16))
158
159 -- To widen an unsigned word we don't have to do anything.
160 -- Just leave it in the same register and mark the result as the new size.
161 MO_UU_Conv W8 W16 -> conversionNop (intFormat W16) x
162 MO_UU_Conv W8 W32 -> conversionNop (intFormat W32) x
163 MO_UU_Conv W16 W32 -> conversionNop (intFormat W32) x
164
165
166 -- Signed integer word size conversions ------------
167
168 -- Mask out high bits when narrowing them
169 MO_SS_Conv W16 W8 -> trivialCode W8 (AND False) x (CmmLit (CmmInt 255 W8))
170 MO_SS_Conv W32 W8 -> trivialCode W8 (AND False) x (CmmLit (CmmInt 255 W8))
171 MO_SS_Conv W32 W16 -> trivialCode W16 (AND False) x (CmmLit (CmmInt 65535 W16))
172
173 -- Sign extend signed words when widening them.
174 MO_SS_Conv W8 W16 -> integerExtend W8 W16 x
175 MO_SS_Conv W8 W32 -> integerExtend W8 W32 x
176 MO_SS_Conv W16 W32 -> integerExtend W16 W32 x
177
178 _ -> panic ("Unknown unary mach op: " ++ show mop)
179
180
181 -- Binary machine ops
182 getRegister (CmmMachOp mop [x, y])
183 = case mop of
184 MO_Eq _ -> condIntReg EQQ x y
185 MO_Ne _ -> condIntReg NE x y
186
187 MO_S_Gt _ -> condIntReg GTT x y
188 MO_S_Ge _ -> condIntReg GE x y
189 MO_S_Lt _ -> condIntReg LTT x y
190 MO_S_Le _ -> condIntReg LE x y
191
192 MO_U_Gt W32 -> condIntReg GU x y
193 MO_U_Ge W32 -> condIntReg GEU x y
194 MO_U_Lt W32 -> condIntReg LU x y
195 MO_U_Le W32 -> condIntReg LEU x y
196
197 MO_U_Gt W16 -> condIntReg GU x y
198 MO_U_Ge W16 -> condIntReg GEU x y
199 MO_U_Lt W16 -> condIntReg LU x y
200 MO_U_Le W16 -> condIntReg LEU x y
201
202 MO_Add W32 -> trivialCode W32 (ADD False False) x y
203 MO_Sub W32 -> trivialCode W32 (SUB False False) x y
204
205 MO_S_MulMayOflo rep -> imulMayOflo rep x y
206
207 MO_S_Quot W32 -> idiv True False x y
208 MO_U_Quot W32 -> idiv False False x y
209
210 MO_S_Rem W32 -> irem True x y
211 MO_U_Rem W32 -> irem False x y
212
213 MO_F_Eq _ -> condFltReg EQQ x y
214 MO_F_Ne _ -> condFltReg NE x y
215
216 MO_F_Gt _ -> condFltReg GTT x y
217 MO_F_Ge _ -> condFltReg GE x y
218 MO_F_Lt _ -> condFltReg LTT x y
219 MO_F_Le _ -> condFltReg LE x y
220
221 MO_F_Add w -> trivialFCode w FADD x y
222 MO_F_Sub w -> trivialFCode w FSUB x y
223 MO_F_Mul w -> trivialFCode w FMUL x y
224 MO_F_Quot w -> trivialFCode w FDIV x y
225
226 MO_And rep -> trivialCode rep (AND False) x y
227 MO_Or rep -> trivialCode rep (OR False) x y
228 MO_Xor rep -> trivialCode rep (XOR False) x y
229
230 MO_Mul rep -> trivialCode rep (SMUL False) x y
231
232 MO_Shl rep -> trivialCode rep SLL x y
233 MO_U_Shr rep -> trivialCode rep SRL x y
234 MO_S_Shr rep -> trivialCode rep SRA x y
235
236 _ -> pprPanic "getRegister(sparc) - binary CmmMachOp (1)" (pprMachOp mop)
237 where
238
239
240 getRegister (CmmLoad mem pk) = do
241 Amode src code <- getAmode mem
242 let
243 code__2 dst = code `snocOL` LD (cmmTypeFormat pk) src dst
244 return (Any (cmmTypeFormat pk) code__2)
245
246 getRegister (CmmLit (CmmInt i _))
247 | fits13Bits i
248 = let
249 src = ImmInt (fromInteger i)
250 code dst = unitOL (OR False g0 (RIImm src) dst)
251 in
252 return (Any II32 code)
253
254 getRegister (CmmLit lit)
255 = let imm = litToImm lit
256 code dst = toOL [
257 SETHI (HI imm) dst,
258 OR False dst (RIImm (LO imm)) dst]
259 in return (Any II32 code)
260
261
262 getRegister _
263 = panic "SPARC.CodeGen.Gen32.getRegister: no match"
264
265
266 -- | sign extend and widen
267 integerExtend
268 :: Width -- ^ width of source expression
269 -> Width -- ^ width of result
270 -> CmmExpr -- ^ source expression
271 -> NatM Register
272
273 integerExtend from to expr
274 = do -- load the expr into some register
275 (reg, e_code) <- getSomeReg expr
276 tmp <- getNewRegNat II32
277 let bitCount
278 = case (from, to) of
279 (W8, W32) -> 24
280 (W16, W32) -> 16
281 (W8, W16) -> 24
282 _ -> panic "SPARC.CodeGen.Gen32: no match"
283 let code dst
284 = e_code
285
286 -- local shift word left to load the sign bit
287 `snocOL` SLL reg (RIImm (ImmInt bitCount)) tmp
288
289 -- arithmetic shift right to sign extend
290 `snocOL` SRA tmp (RIImm (ImmInt bitCount)) dst
291
292 return (Any (intFormat to) code)
293
294
295 -- | For nop word format conversions we set the resulting value to have the
296 -- required size, but don't need to generate any actual code.
297 --
298 conversionNop
299 :: Format -> CmmExpr -> NatM Register
300
301 conversionNop new_rep expr
302 = do e_code <- getRegister expr
303 return (setFormatOfRegister e_code new_rep)
304
305
306
307 -- | Generate an integer division instruction.
308 idiv :: Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
309
310 -- For unsigned division with a 32 bit numerator,
311 -- we can just clear the Y register.
312 idiv False cc x y
313 = do
314 (a_reg, a_code) <- getSomeReg x
315 (b_reg, b_code) <- getSomeReg y
316
317 let code dst
318 = a_code
319 `appOL` b_code
320 `appOL` toOL
321 [ WRY g0 g0
322 , UDIV cc a_reg (RIReg b_reg) dst]
323
324 return (Any II32 code)
325
326
327 -- For _signed_ division with a 32 bit numerator,
328 -- we have to sign extend the numerator into the Y register.
329 idiv True cc x y
330 = do
331 (a_reg, a_code) <- getSomeReg x
332 (b_reg, b_code) <- getSomeReg y
333
334 tmp <- getNewRegNat II32
335
336 let code dst
337 = a_code
338 `appOL` b_code
339 `appOL` toOL
340 [ SRA a_reg (RIImm (ImmInt 16)) tmp -- sign extend
341 , SRA tmp (RIImm (ImmInt 16)) tmp
342
343 , WRY tmp g0
344 , SDIV cc a_reg (RIReg b_reg) dst]
345
346 return (Any II32 code)
347
348
349 -- | Do an integer remainder.
350 --
351 -- NOTE: The SPARC v8 architecture manual says that integer division
352 -- instructions _may_ generate a remainder, depending on the implementation.
353 -- If so it is _recommended_ that the remainder is placed in the Y register.
354 --
355 -- The UltraSparc 2007 manual says Y is _undefined_ after division.
356 --
357 -- The SPARC T2 doesn't store the remainder, not sure about the others.
358 -- It's probably best not to worry about it, and just generate our own
359 -- remainders.
360 --
361 irem :: Bool -> CmmExpr -> CmmExpr -> NatM Register
362
363 -- For unsigned operands:
364 -- Division is between a 64 bit numerator and a 32 bit denominator,
365 -- so we still have to clear the Y register.
366 irem False x y
367 = do
368 (a_reg, a_code) <- getSomeReg x
369 (b_reg, b_code) <- getSomeReg y
370
371 tmp_reg <- getNewRegNat II32
372
373 let code dst
374 = a_code
375 `appOL` b_code
376 `appOL` toOL
377 [ WRY g0 g0
378 , UDIV False a_reg (RIReg b_reg) tmp_reg
379 , UMUL False tmp_reg (RIReg b_reg) tmp_reg
380 , SUB False False a_reg (RIReg tmp_reg) dst]
381
382 return (Any II32 code)
383
384
385
386 -- For signed operands:
387 -- Make sure to sign extend into the Y register, or the remainder
388 -- will have the wrong sign when the numerator is negative.
389 --
390 -- TODO: When sign extending, GCC only shifts the a_reg right by 17 bits,
391 -- not the full 32. Not sure why this is, something to do with overflow?
392 -- If anyone cares enough about the speed of signed remainder they
393 -- can work it out themselves (then tell me). -- BL 2009/01/20
394 irem True x y
395 = do
396 (a_reg, a_code) <- getSomeReg x
397 (b_reg, b_code) <- getSomeReg y
398
399 tmp1_reg <- getNewRegNat II32
400 tmp2_reg <- getNewRegNat II32
401
402 let code dst
403 = a_code
404 `appOL` b_code
405 `appOL` toOL
406 [ SRA a_reg (RIImm (ImmInt 16)) tmp1_reg -- sign extend
407 , SRA tmp1_reg (RIImm (ImmInt 16)) tmp1_reg -- sign extend
408 , WRY tmp1_reg g0
409
410 , SDIV False a_reg (RIReg b_reg) tmp2_reg
411 , SMUL False tmp2_reg (RIReg b_reg) tmp2_reg
412 , SUB False False a_reg (RIReg tmp2_reg) dst]
413
414 return (Any II32 code)
415
416
417 imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register
418 imulMayOflo rep a b
419 = do
420 (a_reg, a_code) <- getSomeReg a
421 (b_reg, b_code) <- getSomeReg b
422 res_lo <- getNewRegNat II32
423 res_hi <- getNewRegNat II32
424
425 let shift_amt = case rep of
426 W32 -> 31
427 W64 -> 63
428 _ -> panic "shift_amt"
429
430 let code dst = a_code `appOL` b_code `appOL`
431 toOL [
432 SMUL False a_reg (RIReg b_reg) res_lo,
433 RDY res_hi,
434 SRA res_lo (RIImm (ImmInt shift_amt)) res_lo,
435 SUB False False res_lo (RIReg res_hi) dst
436 ]
437 return (Any II32 code)
438
439
440 -- -----------------------------------------------------------------------------
441 -- 'trivial*Code': deal with trivial instructions
442
443 -- Trivial (dyadic: 'trivialCode', floating-point: 'trivialFCode',
444 -- unary: 'trivialUCode', unary fl-pt:'trivialUFCode') instructions.
445 -- Only look for constants on the right hand side, because that's
446 -- where the generic optimizer will have put them.
447
448 -- Similarly, for unary instructions, we don't have to worry about
449 -- matching an StInt as the argument, because genericOpt will already
450 -- have handled the constant-folding.
451
452 trivialCode
453 :: Width
454 -> (Reg -> RI -> Reg -> Instr)
455 -> CmmExpr
456 -> CmmExpr
457 -> NatM Register
458
459 trivialCode _ instr x (CmmLit (CmmInt y _))
460 | fits13Bits y
461 = do
462 (src1, code) <- getSomeReg x
463 let
464 src2 = ImmInt (fromInteger y)
465 code__2 dst = code `snocOL` instr src1 (RIImm src2) dst
466 return (Any II32 code__2)
467
468
469 trivialCode _ instr x y = do
470 (src1, code1) <- getSomeReg x
471 (src2, code2) <- getSomeReg y
472 let
473 code__2 dst = code1 `appOL` code2 `snocOL`
474 instr src1 (RIReg src2) dst
475 return (Any II32 code__2)
476
477
478 trivialFCode
479 :: Width
480 -> (Format -> Reg -> Reg -> Reg -> Instr)
481 -> CmmExpr
482 -> CmmExpr
483 -> NatM Register
484
485 trivialFCode pk instr x y = do
486 dflags <- getDynFlags
487 (src1, code1) <- getSomeReg x
488 (src2, code2) <- getSomeReg y
489 tmp <- getNewRegNat FF64
490 let
491 promote x = FxTOy FF32 FF64 x tmp
492
493 pk1 = cmmExprType dflags x
494 pk2 = cmmExprType dflags y
495
496 code__2 dst =
497 if pk1 `cmmEqType` pk2 then
498 code1 `appOL` code2 `snocOL`
499 instr (floatFormat pk) src1 src2 dst
500 else if typeWidth pk1 == W32 then
501 code1 `snocOL` promote src1 `appOL` code2 `snocOL`
502 instr FF64 tmp src2 dst
503 else
504 code1 `appOL` code2 `snocOL` promote src2 `snocOL`
505 instr FF64 src1 tmp dst
506 return (Any (cmmTypeFormat $ if pk1 `cmmEqType` pk2 then pk1 else cmmFloat W64)
507 code__2)
508
509
510
511 trivialUCode
512 :: Format
513 -> (RI -> Reg -> Instr)
514 -> CmmExpr
515 -> NatM Register
516
517 trivialUCode format instr x = do
518 (src, code) <- getSomeReg x
519 let
520 code__2 dst = code `snocOL` instr (RIReg src) dst
521 return (Any format code__2)
522
523
524 trivialUFCode
525 :: Format
526 -> (Reg -> Reg -> Instr)
527 -> CmmExpr
528 -> NatM Register
529
530 trivialUFCode pk instr x = do
531 (src, code) <- getSomeReg x
532 let
533 code__2 dst = code `snocOL` instr src dst
534 return (Any pk code__2)
535
536
537
538
539 -- Coercions -------------------------------------------------------------------
540
541 -- | Coerce a integer value to floating point
542 coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register
543 coerceInt2FP width1 width2 x = do
544 (src, code) <- getSomeReg x
545 let
546 code__2 dst = code `appOL` toOL [
547 ST (intFormat width1) src (spRel (-2)),
548 LD (intFormat width1) (spRel (-2)) dst,
549 FxTOy (intFormat width1) (floatFormat width2) dst dst]
550 return (Any (floatFormat $ width2) code__2)
551
552
553
554 -- | Coerce a floating point value to integer
555 --
556 -- NOTE: On sparc v9 there are no instructions to move a value from an
557 -- FP register directly to an int register, so we have to use a load/store.
558 --
559 coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register
560 coerceFP2Int width1 width2 x
561 = do let fformat1 = floatFormat width1
562 fformat2 = floatFormat width2
563
564 iformat2 = intFormat width2
565
566 (fsrc, code) <- getSomeReg x
567 fdst <- getNewRegNat fformat2
568
569 let code2 dst
570 = code
571 `appOL` toOL
572 -- convert float to int format, leaving it in a float reg.
573 [ FxTOy fformat1 iformat2 fsrc fdst
574
575 -- store the int into mem, then load it back to move
576 -- it into an actual int reg.
577 , ST fformat2 fdst (spRel (-2))
578 , LD iformat2 (spRel (-2)) dst]
579
580 return (Any iformat2 code2)
581
582
583 -- | Coerce a double precision floating point value to single precision.
584 coerceDbl2Flt :: CmmExpr -> NatM Register
585 coerceDbl2Flt x = do
586 (src, code) <- getSomeReg x
587 return (Any FF32 (\dst -> code `snocOL` FxTOy FF64 FF32 src dst))
588
589
590 -- | Coerce a single precision floating point value to double precision
591 coerceFlt2Dbl :: CmmExpr -> NatM Register
592 coerceFlt2Dbl x = do
593 (src, code) <- getSomeReg x
594 return (Any FF64 (\dst -> code `snocOL` FxTOy FF32 FF64 src dst))
595
596
597
598
599 -- Condition Codes -------------------------------------------------------------
600 --
601 -- Evaluate a comparison, and get the result into a register.
602 --
603 -- Do not fill the delay slots here. you will confuse the register allocator.
604 --
605 condIntReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
606 condIntReg EQQ x (CmmLit (CmmInt 0 _)) = do
607 (src, code) <- getSomeReg x
608 let
609 code__2 dst = code `appOL` toOL [
610 SUB False True g0 (RIReg src) g0,
611 SUB True False g0 (RIImm (ImmInt (-1))) dst]
612 return (Any II32 code__2)
613
614 condIntReg EQQ x y = do
615 (src1, code1) <- getSomeReg x
616 (src2, code2) <- getSomeReg y
617 let
618 code__2 dst = code1 `appOL` code2 `appOL` toOL [
619 XOR False src1 (RIReg src2) dst,
620 SUB False True g0 (RIReg dst) g0,
621 SUB True False g0 (RIImm (ImmInt (-1))) dst]
622 return (Any II32 code__2)
623
624 condIntReg NE x (CmmLit (CmmInt 0 _)) = do
625 (src, code) <- getSomeReg x
626 let
627 code__2 dst = code `appOL` toOL [
628 SUB False True g0 (RIReg src) g0,
629 ADD True False g0 (RIImm (ImmInt 0)) dst]
630 return (Any II32 code__2)
631
632 condIntReg NE x y = do
633 (src1, code1) <- getSomeReg x
634 (src2, code2) <- getSomeReg y
635 let
636 code__2 dst = code1 `appOL` code2 `appOL` toOL [
637 XOR False src1 (RIReg src2) dst,
638 SUB False True g0 (RIReg dst) g0,
639 ADD True False g0 (RIImm (ImmInt 0)) dst]
640 return (Any II32 code__2)
641
642 condIntReg cond x y = do
643 bid1 <- liftM (\a -> seq a a) getBlockIdNat
644 bid2 <- liftM (\a -> seq a a) getBlockIdNat
645 CondCode _ cond cond_code <- condIntCode cond x y
646 let
647 code__2 dst
648 = cond_code
649 `appOL` toOL
650 [ BI cond False bid1
651 , NOP
652
653 , OR False g0 (RIImm (ImmInt 0)) dst
654 , BI ALWAYS False bid2
655 , NOP
656
657 , NEWBLOCK bid1
658 , OR False g0 (RIImm (ImmInt 1)) dst
659 , BI ALWAYS False bid2
660 , NOP
661
662 , NEWBLOCK bid2]
663
664 return (Any II32 code__2)
665
666
667 condFltReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
668 condFltReg cond x y = do
669 bid1 <- liftM (\a -> seq a a) getBlockIdNat
670 bid2 <- liftM (\a -> seq a a) getBlockIdNat
671
672 CondCode _ cond cond_code <- condFltCode cond x y
673 let
674 code__2 dst
675 = cond_code
676 `appOL` toOL
677 [ NOP
678 , BF cond False bid1
679 , NOP
680
681 , OR False g0 (RIImm (ImmInt 0)) dst
682 , BI ALWAYS False bid2
683 , NOP
684
685 , NEWBLOCK bid1
686 , OR False g0 (RIImm (ImmInt 1)) dst
687 , BI ALWAYS False bid2
688 , NOP
689
690 , NEWBLOCK bid2 ]
691
692 return (Any II32 code__2)