compiler/nativeGen/PPC/CodeGen.hs

   1 {-# OPTIONS -w #-}
   2
   3 -----------------------------------------------------------------------------
   4 --
   5 -- Generating machine code (instruction selection)
   6 --
   7 -- (c) The University of Glasgow 1996-2004
   8 --
   9 -----------------------------------------------------------------------------
  10
  11 -- This is a big module, but, if you pay attention to
  12 -- (a) the sectioning, (b) the type signatures, and
  13 -- (c) the #if blah_TARGET_ARCH} things, the
  14 -- structure should not be too overwhelming.
  15
  16 module PPC.CodeGen (
  17         cmmTopCodeGen,
  18         InstrBlock
  19 )
  20
  21 where
  22
  23 #include "HsVersions.h"
  24 #include "nativeGen/NCG.h"
  25 #include "MachDeps.h"
  26
  27 -- NCG stuff:
  28 import PPC.Instr
  29 import PPC.Cond
  30 import PPC.Regs
  31 import PPC.RegInfo
  32 import NCGMonad
  33 import Instruction
  34 import PIC
  35 import Size
  36 import RegClass
  37 import Reg
  38 import Platform
  39
  40 -- Our intermediate code:
  41 import BlockId
  42 import PprCmm           ( pprExpr )
  43 import Cmm
  44 import CLabel
  45
  46 -- The rest:
  47 import StaticFlags      ( opt_PIC )
  48 import OrdList
  49 import qualified Outputable as O
  50 import Outputable
  51 import DynFlags
  52
  53 import Control.Monad    ( mapAndUnzipM )
  54 import Data.Bits
  55 import Data.Int
  56 import Data.Word
  57
  58 -- -----------------------------------------------------------------------------
  59 -- Top-level of the instruction selector
  60
  61 -- | 'InstrBlock's are the insn sequences generated by the insn selectors.
  62 -- They are really trees of insns to facilitate fast appending, where a
  63 -- left-to-right traversal (pre-order?) yields the insns in the correct
  64 -- order.
  65
  66 cmmTopCodeGen
  67         :: DynFlags
  68         -> RawCmmTop
  69         -> NatM [NatCmmTop Instr]
  70
  71 cmmTopCodeGen dflags (CmmProc info lab params (ListGraph blocks)) = do
  72   (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
  73   picBaseMb <- getPicBaseMaybeNat
  74   let proc = CmmProc info lab params (ListGraph $ concat nat_blocks)
  75       tops = proc : concat statics
  76       os   = platformOS $ targetPlatform dflags
  77   case picBaseMb of
  78       Just picBase -> initializePicBase_ppc ArchPPC os picBase tops
  79       Nothing -> return tops
  80
  81 cmmTopCodeGen dflags (CmmData sec dat) = do
  82   return [CmmData sec dat]  -- no translation, we just use CmmStatic
  83
  84 basicBlockCodeGen
  85         :: CmmBasicBlock
  86         -> NatM ( [NatBasicBlock Instr]
  87                 , [NatCmmTop Instr])
  88
  89 basicBlockCodeGen (BasicBlock id stmts) = do
  90   instrs <- stmtsToInstrs stmts
  91   -- code generation may introduce new basic block boundaries, which
  92   -- are indicated by the NEWBLOCK instruction.  We must split up the
  93   -- instruction stream into basic blocks again.  Also, we extract
  94   -- LDATAs here too.
  95   let
  96         (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs
  97
  98         mkBlocks (NEWBLOCK id) (instrs,blocks,statics)
  99           = ([], BasicBlock id instrs : blocks, statics)
 100         mkBlocks (LDATA sec dat) (instrs,blocks,statics)
 101           = (instrs, blocks, CmmData sec dat:statics)
 102         mkBlocks instr (instrs,blocks,statics)
 103           = (instr:instrs, blocks, statics)
 104   -- in
 105   return (BasicBlock id top : other_blocks, statics)
 106
 107 stmtsToInstrs :: [CmmStmt] -> NatM InstrBlock
 108 stmtsToInstrs stmts
 109    = do instrss <- mapM stmtToInstrs stmts
 110         return (concatOL instrss)
 111
 112 stmtToInstrs :: CmmStmt -> NatM InstrBlock
 113 stmtToInstrs stmt = case stmt of
 114     CmmNop         -> return nilOL
 115     CmmComment s   -> return (unitOL (COMMENT s))
 116
 117     CmmAssign reg src
 118       | isFloatType ty -> assignReg_FltCode size reg src
 119 #if WORD_SIZE_IN_BITS==32
 120       | isWord64 ty    -> assignReg_I64Code      reg src
 121 #endif
 122       | otherwise        -> assignReg_IntCode size reg src
 123         where ty = cmmRegType reg
 124               size = cmmTypeSize ty
 125
 126     CmmStore addr src
 127       | isFloatType ty -> assignMem_FltCode size addr src
 128 #if WORD_SIZE_IN_BITS==32
 129       | isWord64 ty      -> assignMem_I64Code      addr src
 130 #endif
 131       | otherwise        -> assignMem_IntCode size addr src
 132         where ty = cmmExprType src
 133               size = cmmTypeSize ty
 134
 135     CmmCall target result_regs args _ _
 136        -> genCCall target result_regs args
 137
 138     CmmBranch id          -> genBranch id
 139     CmmCondBranch arg id  -> genCondJump id arg
 140     CmmSwitch arg ids     -> genSwitch arg ids
 141     CmmJump arg params    -> genJump arg
 142     CmmReturn params      ->
 143       panic "stmtToInstrs: return statement should have been cps'd away"
 144
 145
 146 --------------------------------------------------------------------------------
 147 -- | 'InstrBlock's are the insn sequences generated by the insn selectors.
 148 --      They are really trees of insns to facilitate fast appending, where a
 149 --      left-to-right traversal yields the insns in the correct order.
 150 --
 151 type InstrBlock
 152         = OrdList Instr
 153
 154
 155 -- | Register's passed up the tree.  If the stix code forces the register
 156 --      to live in a pre-decided machine register, it comes out as @Fixed@;
 157 --      otherwise, it comes out as @Any@, and the parent can decide which
 158 --      register to put it in.
 159 --
 160 data Register
 161         = Fixed Size Reg InstrBlock
 162         | Any   Size (Reg -> InstrBlock)
 163
 164
 165 swizzleRegisterRep :: Register -> Size -> Register
 166 swizzleRegisterRep (Fixed _ reg code) size = Fixed size reg code
 167 swizzleRegisterRep (Any _ codefn)     size = Any   size codefn
 168
 169
 170 -- | Grab the Reg for a CmmReg
 171 getRegisterReg :: CmmReg -> Reg
 172
 173 getRegisterReg (CmmLocal (LocalReg u pk))
 174   = mkVReg u (cmmTypeSize pk)
 175
 176 getRegisterReg (CmmGlobal mid)
 177   = case get_GlobalReg_reg_or_addr mid of
 178        Left (RealReg rrno) -> RealReg rrno
 179        _other -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
 180           -- By this stage, the only MagicIds remaining should be the
 181           -- ones which map to a real machine register on this
 182           -- platform.  Hence ...
 183
 184
 185 {-
 186 Now, given a tree (the argument to an CmmLoad) that references memory,
 187 produce a suitable addressing mode.
 188
 189 A Rule of the Game (tm) for Amodes: use of the addr bit must
 190 immediately follow use of the code part, since the code part puts
 191 values in registers which the addr then refers to.  So you can't put
 192 anything in between, lest it overwrite some of those registers.  If
 193 you need to do some other computation between the code part and use of
 194 the addr bit, first store the effective address from the amode in a
 195 temporary, then do the other computation, and then use the temporary:
 196
 197     code
 198     LEA amode, tmp
 199     ... other computation ...
 200     ... (tmp) ...
 201 -}
 202
 203
 204 -- | Check whether an integer will fit in 32 bits.
 205 --      A CmmInt is intended to be truncated to the appropriate
 206 --      number of bits, so here we truncate it to Int64.  This is
 207 --      important because e.g. -1 as a CmmInt might be either
 208 --      -1 or 18446744073709551615.
 209 --
 210 is32BitInteger :: Integer -> Bool
 211 is32BitInteger i = i64 <= 0x7fffffff && i64 >= -0x80000000
 212   where i64 = fromIntegral i :: Int64
 213
 214
 215 -- | Convert a BlockId to some CmmStatic data
 216 jumpTableEntry :: Maybe BlockId -> CmmStatic
 217 jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordWidth)
 218 jumpTableEntry (Just (BlockId id)) = CmmStaticLit (CmmLabel blockLabel)
 219     where blockLabel = mkAsmTempLabel id
 220
 221
 222
 223 -- -----------------------------------------------------------------------------
 224 -- General things for putting together code sequences
 225
 226 -- Expand CmmRegOff.  ToDo: should we do it this way around, or convert
 227 -- CmmExprs into CmmRegOff?
 228 mangleIndexTree :: CmmExpr -> CmmExpr
 229 mangleIndexTree (CmmRegOff reg off)
 230   = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]
 231   where width = typeWidth (cmmRegType reg)
 232
 233 mangleIndexTree _
 234         = panic "PPC.CodeGen.mangleIndexTree: no match"
 235
 236 -- -----------------------------------------------------------------------------
 237 --  Code gen for 64-bit arithmetic on 32-bit platforms
 238
 239 {-
 240 Simple support for generating 64-bit code (ie, 64 bit values and 64
 241 bit assignments) on 32-bit platforms.  Unlike the main code generator
 242 we merely shoot for generating working code as simply as possible, and
 243 pay little attention to code quality.  Specifically, there is no
 244 attempt to deal cleverly with the fixed-vs-floating register
 245 distinction; all values are generated into (pairs of) floating
 246 registers, even if this would mean some redundant reg-reg moves as a
 247 result.  Only one of the VRegUniques is returned, since it will be
 248 of the VRegUniqueLo form, and the upper-half VReg can be determined
 249 by applying getHiVRegFromLo to it.
 250 -}
 251
 252 data ChildCode64        -- a.k.a "Register64"
 253       = ChildCode64
 254            InstrBlock   -- code
 255            Reg          -- the lower 32-bit temporary which contains the
 256                         -- result; use getHiVRegFromLo to find the other
 257                         -- VRegUnique.  Rules of this simplified insn
 258                         -- selection game are therefore that the returned
 259                         -- Reg may be modified
 260
 261
 262 -- | The dual to getAnyReg: compute an expression into a register, but
 263 --      we don't mind which one it is.
 264 getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)
 265 getSomeReg expr = do
 266   r <- getRegister expr
 267   case r of
 268     Any rep code -> do
 269         tmp <- getNewRegNat rep
 270         return (tmp, code tmp)
 271     Fixed _ reg code ->
 272         return (reg, code)
 273
 274 getI64Amodes :: CmmExpr -> NatM (AddrMode, AddrMode, InstrBlock)
 275 getI64Amodes addrTree = do
 276     Amode hi_addr addr_code <- getAmode addrTree
 277     case addrOffset hi_addr 4 of
 278         Just lo_addr -> return (hi_addr, lo_addr, addr_code)
 279         Nothing      -> do (hi_ptr, code) <- getSomeReg addrTree
 280                            return (AddrRegImm hi_ptr (ImmInt 0),
 281                                    AddrRegImm hi_ptr (ImmInt 4),
 282                                    code)
 283
 284
 285 assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
 286 assignMem_I64Code addrTree valueTree = do
 287         (hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree
 288         ChildCode64 vcode rlo <- iselExpr64 valueTree
 289         let
 290                 rhi = getHiVRegFromLo rlo
 291
 292                 -- Big-endian store
 293                 mov_hi = ST II32 rhi hi_addr
 294                 mov_lo = ST II32 rlo lo_addr
 295         -- in
 296         return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
 297
 298
 299 assignReg_I64Code :: CmmReg  -> CmmExpr -> NatM InstrBlock
 300 assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
 301    ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
 302    let
 303          r_dst_lo = mkVReg u_dst II32
 304          r_dst_hi = getHiVRegFromLo r_dst_lo
 305          r_src_hi = getHiVRegFromLo r_src_lo
 306          mov_lo = MR r_dst_lo r_src_lo
 307          mov_hi = MR r_dst_hi r_src_hi
 308    -- in
 309    return (
 310         vcode `snocOL` mov_lo `snocOL` mov_hi
 311      )
 312
 313 assignReg_I64Code lvalue valueTree
 314    = panic "assignReg_I64Code(powerpc): invalid lvalue"
 315
 316
 317 iselExpr64        :: CmmExpr -> NatM ChildCode64
 318 iselExpr64 (CmmLoad addrTree ty) | isWord64 ty = do
 319     (hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree
 320     (rlo, rhi) <- getNewRegPairNat II32
 321     let mov_hi = LD II32 rhi hi_addr
 322         mov_lo = LD II32 rlo lo_addr
 323     return $ ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)
 324                          rlo
 325
 326 iselExpr64 (CmmReg (CmmLocal (LocalReg vu ty))) | isWord64 ty
 327    = return (ChildCode64 nilOL (mkVReg vu II32))
 328
 329 iselExpr64 (CmmLit (CmmInt i _)) = do
 330   (rlo,rhi) <- getNewRegPairNat II32
 331   let
 332         half0 = fromIntegral (fromIntegral i :: Word16)
 333         half1 = fromIntegral ((fromIntegral i `shiftR` 16) :: Word16)
 334         half2 = fromIntegral ((fromIntegral i `shiftR` 32) :: Word16)
 335         half3 = fromIntegral ((fromIntegral i `shiftR` 48) :: Word16)
 336
 337         code = toOL [
 338                 LIS rlo (ImmInt half1),
 339                 OR rlo rlo (RIImm $ ImmInt half0),
 340                 LIS rhi (ImmInt half3),
 341                 OR rlo rlo (RIImm $ ImmInt half2)
 342                 ]
 343   -- in
 344   return (ChildCode64 code rlo)
 345
 346 iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do
 347    ChildCode64 code1 r1lo <- iselExpr64 e1
 348    ChildCode64 code2 r2lo <- iselExpr64 e2
 349    (rlo,rhi) <- getNewRegPairNat II32
 350    let
 351         r1hi = getHiVRegFromLo r1lo
 352         r2hi = getHiVRegFromLo r2lo
 353         code =  code1 `appOL`
 354                 code2 `appOL`
 355                 toOL [ ADDC rlo r1lo r2lo,
 356                        ADDE rhi r1hi r2hi ]
 357    -- in
 358    return (ChildCode64 code rlo)
 359
 360 iselExpr64 (CmmMachOp (MO_UU_Conv W32 W64) [expr]) = do
 361     (expr_reg,expr_code) <- getSomeReg expr
 362     (rlo, rhi) <- getNewRegPairNat II32
 363     let mov_hi = LI rhi (ImmInt 0)
 364         mov_lo = MR rlo expr_reg
 365     return $ ChildCode64 (expr_code `snocOL` mov_lo `snocOL` mov_hi)
 366                          rlo
 367 iselExpr64 expr
 368    = pprPanic "iselExpr64(powerpc)" (ppr expr)
 369
 370
 371
 372 getRegister :: CmmExpr -> NatM Register
 373
 374 getRegister (CmmReg reg)
 375   = return (Fixed (cmmTypeSize (cmmRegType reg))
 376                   (getRegisterReg reg) nilOL)
 377
 378 getRegister tree@(CmmRegOff _ _)
 379   = getRegister (mangleIndexTree tree)
 380
 381
 382 #if WORD_SIZE_IN_BITS==32
 383     -- for 32-bit architectuers, support some 64 -> 32 bit conversions:
 384     -- TO_W_(x), TO_W_(x >> 32)
 385
 386 getRegister (CmmMachOp (MO_UU_Conv W64 W32)
 387              [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) = do
 388   ChildCode64 code rlo <- iselExpr64 x
 389   return $ Fixed II32 (getHiVRegFromLo rlo) code
 390
 391 getRegister (CmmMachOp (MO_SS_Conv W64 W32)
 392              [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) = do
 393   ChildCode64 code rlo <- iselExpr64 x
 394   return $ Fixed II32 (getHiVRegFromLo rlo) code
 395
 396 getRegister (CmmMachOp (MO_UU_Conv W64 W32) [x]) = do
 397   ChildCode64 code rlo <- iselExpr64 x
 398   return $ Fixed II32 rlo code
 399
 400 getRegister (CmmMachOp (MO_SS_Conv W64 W32) [x]) = do
 401   ChildCode64 code rlo <- iselExpr64 x
 402   return $ Fixed II32 rlo code
 403
 404 #endif
 405
 406
 407 getRegister (CmmLoad mem pk)
 408   | not (isWord64 pk)
 409   = do
 410         Amode addr addr_code <- getAmode mem
 411         let code dst = ASSERT((regClass dst == RcDouble) == isFloatType pk)
 412                        addr_code `snocOL` LD size dst addr
 413         return (Any size code)
 414           where size = cmmTypeSize pk
 415
 416 -- catch simple cases of zero- or sign-extended load
 417 getRegister (CmmMachOp (MO_UU_Conv W8 W32) [CmmLoad mem _]) = do
 418     Amode addr addr_code <- getAmode mem
 419     return (Any II32 (\dst -> addr_code `snocOL` LD II8 dst addr))
 420
 421 -- Note: there is no Load Byte Arithmetic instruction, so no signed case here
 422
 423 getRegister (CmmMachOp (MO_UU_Conv W16 W32) [CmmLoad mem _]) = do
 424     Amode addr addr_code <- getAmode mem
 425     return (Any II32 (\dst -> addr_code `snocOL` LD II16 dst addr))
 426
 427 getRegister (CmmMachOp (MO_SS_Conv W16 W32) [CmmLoad mem _]) = do
 428     Amode addr addr_code <- getAmode mem
 429     return (Any II32 (\dst -> addr_code `snocOL` LA II16 dst addr))
 430
 431 getRegister (CmmMachOp mop [x]) -- unary MachOps
 432   = case mop of
 433       MO_Not rep   -> triv_ucode_int rep NOT
 434
 435       MO_F_Neg w   -> triv_ucode_float w FNEG
 436       MO_S_Neg w   -> triv_ucode_int   w NEG
 437
 438       MO_FF_Conv W64 W32 -> trivialUCode  FF32 FRSP x
 439       MO_FF_Conv W32 W64 -> conversionNop FF64 x
 440
 441       MO_FS_Conv from to -> coerceFP2Int from to x
 442       MO_SF_Conv from to -> coerceInt2FP from to x
 443
 444       MO_SS_Conv from to
 445         | from == to    -> conversionNop (intSize to) x
 446
 447         -- narrowing is a nop: we treat the high bits as undefined
 448       MO_SS_Conv W32 to -> conversionNop (intSize to) x
 449       MO_SS_Conv W16 W8 -> conversionNop II8 x
 450       MO_SS_Conv W8  to -> triv_ucode_int to (EXTS II8)
 451       MO_SS_Conv W16 to -> triv_ucode_int to (EXTS II16)
 452
 453       MO_UU_Conv from to
 454         | from == to -> conversionNop (intSize to) x
 455         -- narrowing is a nop: we treat the high bits as undefined
 456       MO_UU_Conv W32 to -> conversionNop (intSize to) x
 457       MO_UU_Conv W16 W8 -> conversionNop II8 x
 458       MO_UU_Conv W8 to  -> trivialCode to False AND x (CmmLit (CmmInt 255 W32))
 459       MO_UU_Conv W16 to -> trivialCode to False AND x (CmmLit (CmmInt 65535 W32))
 460       _ -> panic "PPC.CodeGen.getRegister: no match"
 461
 462     where
 463         triv_ucode_int   width instr = trivialUCode (intSize   width) instr x
 464         triv_ucode_float width instr = trivialUCode (floatSize width) instr x
 465
 466         conversionNop new_size expr
 467             = do e_code <- getRegister expr
 468                  return (swizzleRegisterRep e_code new_size)
 469
 470 getRegister (CmmMachOp mop [x, y]) -- dyadic PrimOps
 471   = case mop of
 472       MO_F_Eq w -> condFltReg EQQ x y
 473       MO_F_Ne w -> condFltReg NE  x y
 474       MO_F_Gt w -> condFltReg GTT x y
 475       MO_F_Ge w -> condFltReg GE  x y
 476       MO_F_Lt w -> condFltReg LTT x y
 477       MO_F_Le w -> condFltReg LE  x y
 478
 479       MO_Eq rep -> condIntReg EQQ  (extendUExpr rep x) (extendUExpr rep y)
 480       MO_Ne rep -> condIntReg NE   (extendUExpr rep x) (extendUExpr rep y)
 481
 482       MO_S_Gt rep -> condIntReg GTT  (extendSExpr rep x) (extendSExpr rep y)
 483       MO_S_Ge rep -> condIntReg GE   (extendSExpr rep x) (extendSExpr rep y)
 484       MO_S_Lt rep -> condIntReg LTT  (extendSExpr rep x) (extendSExpr rep y)
 485       MO_S_Le rep -> condIntReg LE   (extendSExpr rep x) (extendSExpr rep y)
 486
 487       MO_U_Gt rep -> condIntReg GU   (extendUExpr rep x) (extendUExpr rep y)
 488       MO_U_Ge rep -> condIntReg GEU  (extendUExpr rep x) (extendUExpr rep y)
 489       MO_U_Lt rep -> condIntReg LU   (extendUExpr rep x) (extendUExpr rep y)
 490       MO_U_Le rep -> condIntReg LEU  (extendUExpr rep x) (extendUExpr rep y)
 491
 492       MO_F_Add w  -> triv_float w FADD
 493       MO_F_Sub w  -> triv_float w FSUB
 494       MO_F_Mul w  -> triv_float w FMUL
 495       MO_F_Quot w -> triv_float w FDIV
 496
 497          -- optimize addition with 32-bit immediate
 498          -- (needed for PIC)
 499       MO_Add W32 ->
 500         case y of
 501           CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate W32 True (-imm)
 502             -> trivialCode W32 True ADD x (CmmLit $ CmmInt imm immrep)
 503           CmmLit lit
 504             -> do
 505                 (src, srcCode) <- getSomeReg x
 506                 let imm = litToImm lit
 507                     code dst = srcCode `appOL` toOL [
 508                                     ADDIS dst src (HA imm),
 509                                     ADD dst dst (RIImm (LO imm))
 510                                 ]
 511                 return (Any II32 code)
 512           _ -> trivialCode W32 True ADD x y
 513
 514       MO_Add rep -> trivialCode rep True ADD x y
 515       MO_Sub rep ->
 516         case y of    -- subfi ('substract from' with immediate) doesn't exist
 517           CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate rep True (-imm)
 518             -> trivialCode rep True ADD x (CmmLit $ CmmInt (-imm) immrep)
 519           _ -> trivialCodeNoImm' (intSize rep) SUBF y x
 520
 521       MO_Mul rep -> trivialCode rep True MULLW x y
 522
 523       MO_S_MulMayOflo W32 -> trivialCodeNoImm' II32 MULLW_MayOflo x y
 524
 525       MO_S_MulMayOflo rep -> panic "S_MulMayOflo (rep /= II32): not implemented"
 526       MO_U_MulMayOflo rep -> panic "U_MulMayOflo: not implemented"
 527
 528       MO_S_Quot rep -> trivialCodeNoImm' (intSize rep) DIVW (extendSExpr rep x) (extendSExpr rep y)
 529       MO_U_Quot rep -> trivialCodeNoImm' (intSize rep) DIVWU (extendUExpr rep x) (extendUExpr rep y)
 530
 531       MO_S_Rem rep -> remainderCode rep DIVW (extendSExpr rep x) (extendSExpr rep y)
 532       MO_U_Rem rep -> remainderCode rep DIVWU (extendUExpr rep x) (extendUExpr rep y)
 533
 534       MO_And rep   -> trivialCode rep False AND x y
 535       MO_Or rep    -> trivialCode rep False OR x y
 536       MO_Xor rep   -> trivialCode rep False XOR x y
 537
 538       MO_Shl rep   -> trivialCode rep False SLW x y
 539       MO_S_Shr rep -> trivialCode rep False SRAW (extendSExpr rep x) y
 540       MO_U_Shr rep -> trivialCode rep False SRW (extendUExpr rep x) y
 541       _         -> panic "PPC.CodeGen.getRegister: no match"
 542
 543   where
 544     triv_float :: Width -> (Size -> Reg -> Reg -> Reg -> Instr) -> NatM Register
 545     triv_float width instr = trivialCodeNoImm (floatSize width) instr x y
 546
 547 getRegister (CmmLit (CmmInt i rep))
 548   | Just imm <- makeImmediate rep True i
 549   = let
 550         code dst = unitOL (LI dst imm)
 551     in
 552         return (Any (intSize rep) code)
 553
 554 getRegister (CmmLit (CmmFloat f frep)) = do
 555     lbl <- getNewLabelNat
 556     dflags <- getDynFlagsNat
 557     dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
 558     Amode addr addr_code <- getAmode dynRef
 559     let size = floatSize frep
 560         code dst =
 561             LDATA ReadOnlyData  [CmmDataLabel lbl,
 562                                  CmmStaticLit (CmmFloat f frep)]
 563             `consOL` (addr_code `snocOL` LD size dst addr)
 564     return (Any size code)
 565
 566 getRegister (CmmLit lit)
 567   = let rep = cmmLitType lit
 568         imm = litToImm lit
 569         code dst = toOL [
 570               LIS dst (HA imm),
 571               ADD dst dst (RIImm (LO imm))
 572           ]
 573     in return (Any (cmmTypeSize rep) code)
 574
 575 getRegister other = pprPanic "getRegister(ppc)" (pprExpr other)
 576
 577     -- extend?Rep: wrap integer expression of type rep
 578     -- in a conversion to II32
 579 extendSExpr W32 x = x
 580 extendSExpr rep x = CmmMachOp (MO_SS_Conv rep W32) [x]
 581 extendUExpr W32 x = x
 582 extendUExpr rep x = CmmMachOp (MO_UU_Conv rep W32) [x]
 583
 584 -- -----------------------------------------------------------------------------
 585 --  The 'Amode' type: Memory addressing modes passed up the tree.
 586
 587 data Amode
 588         = Amode AddrMode InstrBlock
 589
 590 {-
 591 Now, given a tree (the argument to an CmmLoad) that references memory,
 592 produce a suitable addressing mode.
 593
 594 A Rule of the Game (tm) for Amodes: use of the addr bit must
 595 immediately follow use of the code part, since the code part puts
 596 values in registers which the addr then refers to.  So you can't put
 597 anything in between, lest it overwrite some of those registers.  If
 598 you need to do some other computation between the code part and use of
 599 the addr bit, first store the effective address from the amode in a
 600 temporary, then do the other computation, and then use the temporary:
 601
 602     code
 603     LEA amode, tmp
 604     ... other computation ...
 605     ... (tmp) ...
 606 -}
 607
 608 getAmode :: CmmExpr -> NatM Amode
 609 getAmode tree@(CmmRegOff _ _) = getAmode (mangleIndexTree tree)
 610
 611 getAmode (CmmMachOp (MO_Sub W32) [x, CmmLit (CmmInt i _)])
 612   | Just off <- makeImmediate W32 True (-i)
 613   = do
 614         (reg, code) <- getSomeReg x
 615         return (Amode (AddrRegImm reg off) code)
 616
 617
 618 getAmode (CmmMachOp (MO_Add W32) [x, CmmLit (CmmInt i _)])
 619   | Just off <- makeImmediate W32 True i
 620   = do
 621         (reg, code) <- getSomeReg x
 622         return (Amode (AddrRegImm reg off) code)
 623
 624    -- optimize addition with 32-bit immediate
 625    -- (needed for PIC)
 626 getAmode (CmmMachOp (MO_Add W32) [x, CmmLit lit])
 627   = do
 628         tmp <- getNewRegNat II32
 629         (src, srcCode) <- getSomeReg x
 630         let imm = litToImm lit
 631             code = srcCode `snocOL` ADDIS tmp src (HA imm)
 632         return (Amode (AddrRegImm tmp (LO imm)) code)
 633
 634 getAmode (CmmLit lit)
 635   = do
 636         tmp <- getNewRegNat II32
 637         let imm = litToImm lit
 638             code = unitOL (LIS tmp (HA imm))
 639         return (Amode (AddrRegImm tmp (LO imm)) code)
 640
 641 getAmode (CmmMachOp (MO_Add W32) [x, y])
 642   = do
 643         (regX, codeX) <- getSomeReg x
 644         (regY, codeY) <- getSomeReg y
 645         return (Amode (AddrRegReg regX regY) (codeX `appOL` codeY))
 646
 647 getAmode other
 648   = do
 649         (reg, code) <- getSomeReg other
 650         let
 651             off  = ImmInt 0
 652         return (Amode (AddrRegImm reg off) code)
 653
 654
 655
 656 --  The 'CondCode' type:  Condition codes passed up the tree.
 657 data CondCode
 658         = CondCode Bool Cond InstrBlock
 659
 660 -- Set up a condition code for a conditional branch.
 661
 662 getCondCode :: CmmExpr -> NatM CondCode
 663
 664 -- almost the same as everywhere else - but we need to
 665 -- extend small integers to 32 bit first
 666
 667 getCondCode (CmmMachOp mop [x, y])
 668   = case mop of
 669       MO_F_Eq W32 -> condFltCode EQQ x y
 670       MO_F_Ne W32 -> condFltCode NE  x y
 671       MO_F_Gt W32 -> condFltCode GTT x y
 672       MO_F_Ge W32 -> condFltCode GE  x y
 673       MO_F_Lt W32 -> condFltCode LTT x y
 674       MO_F_Le W32 -> condFltCode LE  x y
 675
 676       MO_F_Eq W64 -> condFltCode EQQ x y
 677       MO_F_Ne W64 -> condFltCode NE  x y
 678       MO_F_Gt W64 -> condFltCode GTT x y
 679       MO_F_Ge W64 -> condFltCode GE  x y
 680       MO_F_Lt W64 -> condFltCode LTT x y
 681       MO_F_Le W64 -> condFltCode LE  x y
 682
 683       MO_Eq rep -> condIntCode EQQ  (extendUExpr rep x) (extendUExpr rep y)
 684       MO_Ne rep -> condIntCode NE   (extendUExpr rep x) (extendUExpr rep y)
 685
 686       MO_S_Gt rep -> condIntCode GTT  (extendSExpr rep x) (extendSExpr rep y)
 687       MO_S_Ge rep -> condIntCode GE   (extendSExpr rep x) (extendSExpr rep y)
 688       MO_S_Lt rep -> condIntCode LTT  (extendSExpr rep x) (extendSExpr rep y)
 689       MO_S_Le rep -> condIntCode LE   (extendSExpr rep x) (extendSExpr rep y)
 690
 691       MO_U_Gt rep -> condIntCode GU   (extendUExpr rep x) (extendUExpr rep y)
 692       MO_U_Ge rep -> condIntCode GEU  (extendUExpr rep x) (extendUExpr rep y)
 693       MO_U_Lt rep -> condIntCode LU   (extendUExpr rep x) (extendUExpr rep y)
 694       MO_U_Le rep -> condIntCode LEU  (extendUExpr rep x) (extendUExpr rep y)
 695
 696       other -> pprPanic "getCondCode(powerpc)" (pprMachOp mop)
 697
 698 getCondCode other =  panic "getCondCode(2)(powerpc)"
 699
 700
 701
 702 -- @cond(Int|Flt)Code@: Turn a boolean expression into a condition, to be
 703 -- passed back up the tree.
 704
 705 condIntCode, condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
 706
 707 --  ###FIXME: I16 and I8!
 708 condIntCode cond x (CmmLit (CmmInt y rep))
 709   | Just src2 <- makeImmediate rep (not $ condUnsigned cond) y
 710   = do
 711         (src1, code) <- getSomeReg x
 712         let
 713             code' = code `snocOL`
 714                 (if condUnsigned cond then CMPL else CMP) II32 src1 (RIImm src2)
 715         return (CondCode False cond code')
 716
 717 condIntCode cond x y = do
 718     (src1, code1) <- getSomeReg x
 719     (src2, code2) <- getSomeReg y
 720     let
 721         code' = code1 `appOL` code2 `snocOL`
 722                   (if condUnsigned cond then CMPL else CMP) II32 src1 (RIReg src2)
 723     return (CondCode False cond code')
 724
 725 condFltCode cond x y = do
 726     (src1, code1) <- getSomeReg x
 727     (src2, code2) <- getSomeReg y
 728     let
 729         code'  = code1 `appOL` code2 `snocOL` FCMP src1 src2
 730         code'' = case cond of -- twiddle CR to handle unordered case
 731                     GE -> code' `snocOL` CRNOR ltbit eqbit gtbit
 732                     LE -> code' `snocOL` CRNOR gtbit eqbit ltbit
 733                     _ -> code'
 734                  where
 735                     ltbit = 0 ; eqbit = 2 ; gtbit = 1
 736     return (CondCode True cond code'')
 737
 738
 739
 740 -- -----------------------------------------------------------------------------
 741 -- Generating assignments
 742
 743 -- Assignments are really at the heart of the whole code generation
 744 -- business.  Almost all top-level nodes of any real importance are
 745 -- assignments, which correspond to loads, stores, or register
 746 -- transfers.  If we're really lucky, some of the register transfers
 747 -- will go away, because we can use the destination register to
 748 -- complete the code generation for the right hand side.  This only
 749 -- fails when the right hand side is forced into a fixed register
 750 -- (e.g. the result of a call).
 751
 752 assignMem_IntCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock
 753 assignReg_IntCode :: Size -> CmmReg  -> CmmExpr -> NatM InstrBlock
 754
 755 assignMem_FltCode :: Size -> CmmExpr -> CmmExpr -> NatM InstrBlock
 756 assignReg_FltCode :: Size -> CmmReg  -> CmmExpr -> NatM InstrBlock
 757
 758 assignMem_IntCode pk addr src = do
 759     (srcReg, code) <- getSomeReg src
 760     Amode dstAddr addr_code <- getAmode addr
 761     return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr
 762
 763 -- dst is a reg, but src could be anything
 764 assignReg_IntCode _ reg src
 765     = do
 766         r <- getRegister src
 767         return $ case r of
 768             Any _ code         -> code dst
 769             Fixed _ freg fcode -> fcode `snocOL` MR dst freg
 770     where
 771         dst = getRegisterReg reg
 772
 773
 774
 775 -- Easy, isn't it?
 776 assignMem_FltCode = assignMem_IntCode
 777 assignReg_FltCode = assignReg_IntCode
 778
 779
 780
 781 genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock
 782
 783 genJump (CmmLit (CmmLabel lbl))
 784   = return (unitOL $ JMP lbl)
 785
 786 genJump tree
 787   = do
 788         (target,code) <- getSomeReg tree
 789         return (code `snocOL` MTCTR target `snocOL` BCTR [])
 790
 791
 792 -- -----------------------------------------------------------------------------
 793 --  Unconditional branches
 794 genBranch :: BlockId -> NatM InstrBlock
 795 genBranch = return . toOL . mkJumpInstr
 796
 797
 798 -- -----------------------------------------------------------------------------
 799 --  Conditional jumps
 800
 801 {-
 802 Conditional jumps are always to local labels, so we can use branch
 803 instructions.  We peek at the arguments to decide what kind of
 804 comparison to do.
 805
 806 SPARC: First, we have to ensure that the condition codes are set
 807 according to the supplied comparison operation.  We generate slightly
 808 different code for floating point comparisons, because a floating
 809 point operation cannot directly precede a @BF@.  We assume the worst
 810 and fill that slot with a @NOP@.
 811
 812 SPARC: Do not fill the delay slots here; you will confuse the register
 813 allocator.
 814 -}
 815
 816
 817 genCondJump
 818     :: BlockId      -- the branch target
 819     -> CmmExpr      -- the condition on which to branch
 820     -> NatM InstrBlock
 821
 822 genCondJump id bool = do
 823   CondCode _ cond code <- getCondCode bool
 824   return (code `snocOL` BCC cond id)
 825
 826
 827
 828 -- -----------------------------------------------------------------------------
 829 --  Generating C calls
 830
 831 -- Now the biggest nightmare---calls.  Most of the nastiness is buried in
 832 -- @get_arg@, which moves the arguments to the correct registers/stack
 833 -- locations.  Apart from that, the code is easy.
 834 --
 835 -- (If applicable) Do not fill the delay slots here; you will confuse the
 836 -- register allocator.
 837
 838 genCCall
 839     :: CmmCallTarget            -- function to call
 840     -> HintedCmmFormals         -- where to put the result
 841     -> HintedCmmActuals         -- arguments (of mixed type)
 842     -> NatM InstrBlock
 843
 844
 845 #if darwin_TARGET_OS || linux_TARGET_OS
 846 {-
 847     The PowerPC calling convention for Darwin/Mac OS X
 848     is described in Apple's document
 849     "Inside Mac OS X - Mach-O Runtime Architecture".
 850
 851     PowerPC Linux uses the System V Release 4 Calling Convention
 852     for PowerPC. It is described in the
 853     "System V Application Binary Interface PowerPC Processor Supplement".
 854
 855     Both conventions are similar:
 856     Parameters may be passed in general-purpose registers starting at r3, in
 857     floating point registers starting at f1, or on the stack.
 858
 859     But there are substantial differences:
 860     * The number of registers used for parameter passing and the exact set of
 861       nonvolatile registers differs (see MachRegs.lhs).
 862     * On Darwin, stack space is always reserved for parameters, even if they are
 863       passed in registers. The called routine may choose to save parameters from
 864       registers to the corresponding space on the stack.
 865     * On Darwin, a corresponding amount of GPRs is skipped when a floating point
 866       parameter is passed in an FPR.
 867     * SysV insists on either passing I64 arguments on the stack, or in two GPRs,
 868       starting with an odd-numbered GPR. It may skip a GPR to achieve this.
 869       Darwin just treats an I64 like two separate II32s (high word first).
 870     * I64 and FF64 arguments are 8-byte aligned on the stack for SysV, but only
 871       4-byte aligned like everything else on Darwin.
 872     * The SysV spec claims that FF32 is represented as FF64 on the stack. GCC on
 873       PowerPC Linux does not agree, so neither do we.
 874
 875     According to both conventions, The parameter area should be part of the
 876     caller's stack frame, allocated in the caller's prologue code (large enough
 877     to hold the parameter lists for all called routines). The NCG already
 878     uses the stack for register spilling, leaving 64 bytes free at the top.
 879     If we need a larger parameter area than that, we just allocate a new stack
 880     frame just before ccalling.
 881 -}
 882
 883
 884 genCCall (CmmPrim MO_WriteBarrier) _ _
 885  = return $ unitOL LWSYNC
 886
 887 genCCall target dest_regs argsAndHints
 888   = ASSERT (not $ any (`elem` [II8,II16]) $ map cmmTypeSize argReps)
 889         -- we rely on argument promotion in the codeGen
 890     do
 891         (finalStack,passArgumentsCode,usedRegs) <- passArguments
 892                                                         (zip args argReps)
 893                                                         allArgRegs allFPArgRegs
 894                                                         initialStackOffset
 895                                                         (toOL []) []
 896
 897         (labelOrExpr, reduceToFF32) <- case target of
 898             CmmCallee (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False)
 899             CmmCallee expr conv -> return  (Right expr, False)
 900             CmmPrim mop -> outOfLineFloatOp mop
 901
 902         let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode
 903             codeAfter = move_sp_up finalStack `appOL` moveResult reduceToFF32
 904
 905         case labelOrExpr of
 906             Left lbl -> do
 907                 return (         codeBefore
 908                         `snocOL` BL lbl usedRegs
 909                         `appOL`  codeAfter)
 910             Right dyn -> do
 911                 (dynReg, dynCode) <- getSomeReg dyn
 912                 return (         dynCode
 913                         `snocOL` MTCTR dynReg
 914                         `appOL`  codeBefore
 915                         `snocOL` BCTRL usedRegs
 916                         `appOL`  codeAfter)
 917     where
 918 #if darwin_TARGET_OS
 919         initialStackOffset = 24
 920             -- size of linkage area + size of arguments, in bytes
 921         stackDelta _finalStack = roundTo 16 $ (24 +) $ max 32 $ sum $
 922                                  map (widthInBytes . typeWidth) argReps
 923 #elif linux_TARGET_OS
 924         initialStackOffset = 8
 925         stackDelta finalStack = roundTo 16 finalStack
 926 #endif
 927         args = map hintlessCmm argsAndHints
 928         argReps = map cmmExprType args
 929
 930         roundTo a x | x `mod` a == 0 = x
 931                     | otherwise = x + a - (x `mod` a)
 932
 933         move_sp_down finalStack
 934                | delta > 64 =
 935                         toOL [STU II32 sp (AddrRegImm sp (ImmInt (-delta))),
 936                               DELTA (-delta)]
 937                | otherwise = nilOL
 938                where delta = stackDelta finalStack
 939         move_sp_up finalStack
 940                | delta > 64 =
 941                         toOL [ADD sp sp (RIImm (ImmInt delta)),
 942                               DELTA 0]
 943                | otherwise = nilOL
 944                where delta = stackDelta finalStack
 945
 946
 947         passArguments [] _ _ stackOffset accumCode accumUsed = return (stackOffset, accumCode, accumUsed)
 948         passArguments ((arg,arg_ty):args) gprs fprs stackOffset
 949                accumCode accumUsed | isWord64 arg_ty =
 950             do
 951                 ChildCode64 code vr_lo <- iselExpr64 arg
 952                 let vr_hi = getHiVRegFromLo vr_lo
 953
 954 #if darwin_TARGET_OS
 955                 passArguments args
 956                               (drop 2 gprs)
 957                               fprs
 958                               (stackOffset+8)
 959                               (accumCode `appOL` code
 960                                     `snocOL` storeWord vr_hi gprs stackOffset
 961                                     `snocOL` storeWord vr_lo (drop 1 gprs) (stackOffset+4))
 962                               ((take 2 gprs) ++ accumUsed)
 963             where
 964                 storeWord vr (gpr:_) offset = MR gpr vr
 965                 storeWord vr [] offset = ST II32 vr (AddrRegImm sp (ImmInt offset))
 966
 967 #elif linux_TARGET_OS
 968                 let stackOffset' = roundTo 8 stackOffset
 969                     stackCode = accumCode `appOL` code
 970                         `snocOL` ST II32 vr_hi (AddrRegImm sp (ImmInt stackOffset'))
 971                         `snocOL` ST II32 vr_lo (AddrRegImm sp (ImmInt (stackOffset'+4)))
 972                     regCode hireg loreg =
 973                         accumCode `appOL` code
 974                             `snocOL` MR hireg vr_hi
 975                             `snocOL` MR loreg vr_lo
 976
 977                 case gprs of
 978                     hireg : loreg : regs | even (length gprs) ->
 979                         passArguments args regs fprs stackOffset
 980                                       (regCode hireg loreg) (hireg : loreg : accumUsed)
 981                     _skipped : hireg : loreg : regs ->
 982                         passArguments args regs fprs stackOffset
 983                                       (regCode hireg loreg) (hireg : loreg : accumUsed)
 984                     _ -> -- only one or no regs left
 985                         passArguments args [] fprs (stackOffset'+8)
 986                                       stackCode accumUsed
 987 #endif
 988
 989         passArguments ((arg,rep):args) gprs fprs stackOffset accumCode accumUsed
 990             | reg : _ <- regs = do
 991                 register <- getRegister arg
 992                 let code = case register of
 993                             Fixed _ freg fcode -> fcode `snocOL` MR reg freg
 994                             Any _ acode -> acode reg
 995                 passArguments args
 996                               (drop nGprs gprs)
 997                               (drop nFprs fprs)
 998 #if darwin_TARGET_OS
 999         -- The Darwin ABI requires that we reserve stack slots for register parameters
1000                               (stackOffset + stackBytes)
1001 #elif linux_TARGET_OS
1002         -- ... the SysV ABI doesn't.
1003                               stackOffset
1004 #endif
1005                               (accumCode `appOL` code)
1006                               (reg : accumUsed)
1007             | otherwise = do
1008                 (vr, code) <- getSomeReg arg
1009                 passArguments args
1010                               (drop nGprs gprs)
1011                               (drop nFprs fprs)
1012                               (stackOffset' + stackBytes)
1013                               (accumCode `appOL` code `snocOL` ST (cmmTypeSize rep) vr stackSlot)
1014                               accumUsed
1015             where
1016 #if darwin_TARGET_OS
1017         -- stackOffset is at least 4-byte aligned
1018         -- The Darwin ABI is happy with that.
1019                 stackOffset' = stackOffset
1020 #else
1021         -- ... the SysV ABI requires 8-byte alignment for doubles.
1022                 stackOffset' | isFloatType rep && typeWidth rep == W64 =
1023                                  roundTo 8 stackOffset
1024                              | otherwise  =           stackOffset
1025 #endif
1026                 stackSlot = AddrRegImm sp (ImmInt stackOffset')
1027                 (nGprs, nFprs, stackBytes, regs) = case cmmTypeSize rep of
1028                     II32 -> (1, 0, 4, gprs)
1029 #if darwin_TARGET_OS
1030         -- The Darwin ABI requires that we skip a corresponding number of GPRs when
1031         -- we use the FPRs.
1032                     FF32 -> (1, 1, 4, fprs)
1033                     FF64 -> (2, 1, 8, fprs)
1034 #elif linux_TARGET_OS
1035         -- ... the SysV ABI doesn't.
1036                     FF32 -> (0, 1, 4, fprs)
1037                     FF64 -> (0, 1, 8, fprs)
1038 #endif
1039
1040         moveResult reduceToFF32 =
1041             case dest_regs of
1042                 [] -> nilOL
1043                 [CmmHinted dest _hint]
1044                     | reduceToFF32 && isFloat32 rep   -> unitOL (FRSP r_dest f1)
1045                     | isFloat32 rep || isFloat64 rep -> unitOL (MR r_dest f1)
1046                     | isWord64 rep -> toOL [MR (getHiVRegFromLo r_dest) r3,
1047                                           MR r_dest r4]
1048                     | otherwise -> unitOL (MR r_dest r3)
1049                     where rep = cmmRegType (CmmLocal dest)
1050                           r_dest = getRegisterReg (CmmLocal dest)
1051
1052         outOfLineFloatOp mop =
1053             do
1054                 dflags <- getDynFlagsNat
1055                 mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $
1056                               mkForeignLabel functionName Nothing True
1057                 let mopLabelOrExpr = case mopExpr of
1058                         CmmLit (CmmLabel lbl) -> Left lbl
1059                         _ -> Right mopExpr
1060                 return (mopLabelOrExpr, reduce)
1061             where
1062                 (functionName, reduce) = case mop of
1063                     MO_F32_Exp   -> (fsLit "exp", True)
1064                     MO_F32_Log   -> (fsLit "log", True)
1065                     MO_F32_Sqrt  -> (fsLit "sqrt", True)
1066
1067                     MO_F32_Sin   -> (fsLit "sin", True)
1068                     MO_F32_Cos   -> (fsLit "cos", True)
1069                     MO_F32_Tan   -> (fsLit "tan", True)
1070
1071                     MO_F32_Asin  -> (fsLit "asin", True)
1072                     MO_F32_Acos  -> (fsLit "acos", True)
1073                     MO_F32_Atan  -> (fsLit "atan", True)
1074
1075                     MO_F32_Sinh  -> (fsLit "sinh", True)
1076                     MO_F32_Cosh  -> (fsLit "cosh", True)
1077                     MO_F32_Tanh  -> (fsLit "tanh", True)
1078                     MO_F32_Pwr   -> (fsLit "pow", True)
1079
1080                     MO_F64_Exp   -> (fsLit "exp", False)
1081                     MO_F64_Log   -> (fsLit "log", False)
1082                     MO_F64_Sqrt  -> (fsLit "sqrt", False)
1083
1084                     MO_F64_Sin   -> (fsLit "sin", False)
1085                     MO_F64_Cos   -> (fsLit "cos", False)
1086                     MO_F64_Tan   -> (fsLit "tan", False)
1087
1088                     MO_F64_Asin  -> (fsLit "asin", False)
1089                     MO_F64_Acos  -> (fsLit "acos", False)
1090                     MO_F64_Atan  -> (fsLit "atan", False)
1091
1092                     MO_F64_Sinh  -> (fsLit "sinh", False)
1093                     MO_F64_Cosh  -> (fsLit "cosh", False)
1094                     MO_F64_Tanh  -> (fsLit "tanh", False)
1095                     MO_F64_Pwr   -> (fsLit "pow", False)
1096                     other -> pprPanic "genCCall(ppc): unknown callish op"
1097                                     (pprCallishMachOp other)
1098
1099 #else /* darwin_TARGET_OS || linux_TARGET_OS */
1100 genCCall = panic "PPC.CodeGen.genCCall: not defined for this os"
1101 #endif
1102
1103
1104 -- -----------------------------------------------------------------------------
1105 -- Generating a table-branch
1106
1107 genSwitch :: CmmExpr -> [Maybe BlockId] -> NatM InstrBlock
1108 genSwitch expr ids
1109   | opt_PIC
1110   = do
1111         (reg,e_code) <- getSomeReg expr
1112         tmp <- getNewRegNat II32
1113         lbl <- getNewLabelNat
1114         dflags <- getDynFlagsNat
1115         dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
1116         (tableReg,t_code) <- getSomeReg $ dynRef
1117         let
1118             jumpTable = map jumpTableEntryRel ids
1119
1120             jumpTableEntryRel Nothing
1121                 = CmmStaticLit (CmmInt 0 wordWidth)
1122             jumpTableEntryRel (Just (BlockId id))
1123                 = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
1124                 where blockLabel = mkAsmTempLabel id
1125
1126             code = e_code `appOL` t_code `appOL` toOL [
1127                             LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
1128                             SLW tmp reg (RIImm (ImmInt 2)),
1129                             LD II32 tmp (AddrRegReg tableReg tmp),
1130                             ADD tmp tmp (RIReg tableReg),
1131                             MTCTR tmp,
1132                             BCTR [ id | Just id <- ids ]
1133                     ]
1134         return code
1135   | otherwise
1136   = do
1137         (reg,e_code) <- getSomeReg expr
1138         tmp <- getNewRegNat II32
1139         lbl <- getNewLabelNat
1140         let
1141             jumpTable = map jumpTableEntry ids
1142
1143             code = e_code `appOL` toOL [
1144                             LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
1145                             SLW tmp reg (RIImm (ImmInt 2)),
1146                             ADDIS tmp tmp (HA (ImmCLbl lbl)),
1147                             LD II32 tmp (AddrRegImm tmp (LO (ImmCLbl lbl))),
1148                             MTCTR tmp,
1149                             BCTR [ id | Just id <- ids ]
1150                     ]
1151         return code
1152
1153
1154 -- -----------------------------------------------------------------------------
1155 -- 'condIntReg' and 'condFltReg': condition codes into registers
1156
1157 -- Turn those condition codes into integers now (when they appear on
1158 -- the right hand side of an assignment).
1159 --
1160 -- (If applicable) Do not fill the delay slots here; you will confuse the
1161 -- register allocator.
1162
1163 condIntReg, condFltReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
1164
1165 condReg :: NatM CondCode -> NatM Register
1166 condReg getCond = do
1167     CondCode _ cond cond_code <- getCond
1168     let
1169 {-        code dst = cond_code `appOL` toOL [
1170                 BCC cond lbl1,
1171                 LI dst (ImmInt 0),
1172                 BCC ALWAYS lbl2,
1173                 NEWBLOCK lbl1,
1174                 LI dst (ImmInt 1),
1175                 BCC ALWAYS lbl2,
1176                 NEWBLOCK lbl2
1177             ]-}
1178         code dst = cond_code
1179             `appOL` negate_code
1180             `appOL` toOL [
1181                 MFCR dst,
1182                 RLWINM dst dst (bit + 1) 31 31
1183             ]
1184
1185         negate_code | do_negate = unitOL (CRNOR bit bit bit)
1186                     | otherwise = nilOL
1187
1188         (bit, do_negate) = case cond of
1189             LTT -> (0, False)
1190             LE  -> (1, True)
1191             EQQ -> (2, False)
1192             GE  -> (0, True)
1193             GTT -> (1, False)
1194
1195             NE  -> (2, True)
1196
1197             LU  -> (0, False)
1198             LEU -> (1, True)
1199             GEU -> (0, True)
1200             GU  -> (1, False)
1201             _   -> panic "PPC.CodeGen.codeReg: no match"
1202
1203     return (Any II32 code)
1204
1205 condIntReg cond x y = condReg (condIntCode cond x y)
1206 condFltReg cond x y = condReg (condFltCode cond x y)
1207
1208
1209
1210 -- -----------------------------------------------------------------------------
1211 -- 'trivial*Code': deal with trivial instructions
1212
1213 -- Trivial (dyadic: 'trivialCode', floating-point: 'trivialFCode',
1214 -- unary: 'trivialUCode', unary fl-pt:'trivialUFCode') instructions.
1215 -- Only look for constants on the right hand side, because that's
1216 -- where the generic optimizer will have put them.
1217
1218 -- Similarly, for unary instructions, we don't have to worry about
1219 -- matching an StInt as the argument, because genericOpt will already
1220 -- have handled the constant-folding.
1221
1222
1223
1224 {-
1225 Wolfgang's PowerPC version of The Rules:
1226
1227 A slightly modified version of The Rules to take advantage of the fact
1228 that PowerPC instructions work on all registers and don't implicitly
1229 clobber any fixed registers.
1230
1231 * The only expression for which getRegister returns Fixed is (CmmReg reg).
1232
1233 * If getRegister returns Any, then the code it generates may modify only:
1234         (a) fresh temporaries
1235         (b) the destination register
1236   It may *not* modify global registers, unless the global
1237   register happens to be the destination register.
1238   It may not clobber any other registers. In fact, only ccalls clobber any
1239   fixed registers.
1240   Also, it may not modify the counter register (used by genCCall).
1241
1242   Corollary: If a getRegister for a subexpression returns Fixed, you need
1243   not move it to a fresh temporary before evaluating the next subexpression.
1244   The Fixed register won't be modified.
1245   Therefore, we don't need a counterpart for the x86's getStableReg on PPC.
1246
1247 * SDM's First Rule is valid for PowerPC, too: subexpressions can depend on
1248   the value of the destination register.
1249 -}
1250
1251 trivialCode
1252         :: Width
1253         -> Bool
1254         -> (Reg -> Reg -> RI -> Instr)
1255         -> CmmExpr
1256         -> CmmExpr
1257         -> NatM Register
1258
1259 trivialCode rep signed instr x (CmmLit (CmmInt y _))
1260     | Just imm <- makeImmediate rep signed y
1261     = do
1262         (src1, code1) <- getSomeReg x
1263         let code dst = code1 `snocOL` instr dst src1 (RIImm imm)
1264         return (Any (intSize rep) code)
1265
1266 trivialCode rep _ instr x y = do
1267     (src1, code1) <- getSomeReg x
1268     (src2, code2) <- getSomeReg y
1269     let code dst = code1 `appOL` code2 `snocOL` instr dst src1 (RIReg src2)
1270     return (Any (intSize rep) code)
1271
1272 trivialCodeNoImm' :: Size -> (Reg -> Reg -> Reg -> Instr)
1273                  -> CmmExpr -> CmmExpr -> NatM Register
1274 trivialCodeNoImm' size instr x y = do
1275     (src1, code1) <- getSomeReg x
1276     (src2, code2) <- getSomeReg y
1277     let code dst = code1 `appOL` code2 `snocOL` instr dst src1 src2
1278     return (Any size code)
1279
1280 trivialCodeNoImm :: Size -> (Size -> Reg -> Reg -> Reg -> Instr)
1281                  -> CmmExpr -> CmmExpr -> NatM Register
1282 trivialCodeNoImm size instr x y = trivialCodeNoImm' size (instr size) x y
1283
1284
1285 trivialUCode
1286         :: Size
1287         -> (Reg -> Reg -> Instr)
1288         -> CmmExpr
1289         -> NatM Register
1290 trivialUCode rep instr x = do
1291     (src, code) <- getSomeReg x
1292     let code' dst = code `snocOL` instr dst src
1293     return (Any rep code')
1294
1295 -- There is no "remainder" instruction on the PPC, so we have to do
1296 -- it the hard way.
1297 -- The "div" parameter is the division instruction to use (DIVW or DIVWU)
1298
1299 remainderCode :: Width -> (Reg -> Reg -> Reg -> Instr)
1300     -> CmmExpr -> CmmExpr -> NatM Register
1301 remainderCode rep div x y = do
1302     (src1, code1) <- getSomeReg x
1303     (src2, code2) <- getSomeReg y
1304     let code dst = code1 `appOL` code2 `appOL` toOL [
1305                 div dst src1 src2,
1306                 MULLW dst dst (RIReg src2),
1307                 SUBF dst dst src1
1308             ]
1309     return (Any (intSize rep) code)
1310
1311
1312 coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register
1313 coerceInt2FP fromRep toRep x = do
1314     (src, code) <- getSomeReg x
1315     lbl <- getNewLabelNat
1316     itmp <- getNewRegNat II32
1317     ftmp <- getNewRegNat FF64
1318     dflags <- getDynFlagsNat
1319     dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
1320     Amode addr addr_code <- getAmode dynRef
1321     let
1322         code' dst = code `appOL` maybe_exts `appOL` toOL [
1323                 LDATA ReadOnlyData
1324                                 [CmmDataLabel lbl,
1325                                  CmmStaticLit (CmmInt 0x43300000 W32),
1326                                  CmmStaticLit (CmmInt 0x80000000 W32)],
1327                 XORIS itmp src (ImmInt 0x8000),
1328                 ST II32 itmp (spRel 3),
1329                 LIS itmp (ImmInt 0x4330),
1330                 ST II32 itmp (spRel 2),
1331                 LD FF64 ftmp (spRel 2)
1332             ] `appOL` addr_code `appOL` toOL [
1333                 LD FF64 dst addr,
1334                 FSUB FF64 dst ftmp dst
1335             ] `appOL` maybe_frsp dst
1336
1337         maybe_exts = case fromRep of
1338                         W8 ->  unitOL $ EXTS II8 src src
1339                         W16 -> unitOL $ EXTS II16 src src
1340                         W32 -> nilOL
1341                         _       -> panic "PPC.CodeGen.coerceInt2FP: no match"
1342
1343         maybe_frsp dst
1344                 = case toRep of
1345                         W32 -> unitOL $ FRSP dst dst
1346                         W64 -> nilOL
1347                         _       -> panic "PPC.CodeGen.coerceInt2FP: no match"
1348
1349     return (Any (floatSize toRep) code')
1350
1351 coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register
1352 coerceFP2Int _ toRep x = do
1353     -- the reps don't really matter: F*->FF64 and II32->I* are no-ops
1354     (src, code) <- getSomeReg x
1355     tmp <- getNewRegNat FF64
1356     let
1357         code' dst = code `appOL` toOL [
1358                 -- convert to int in FP reg
1359             FCTIWZ tmp src,
1360                 -- store value (64bit) from FP to stack
1361             ST FF64 tmp (spRel 2),
1362                 -- read low word of value (high word is undefined)
1363             LD II32 dst (spRel 3)]
1364     return (Any (intSize toRep) code')