compiler/nativeGen/SPARC/CodeGen/Gen32.hs

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