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