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