compiler/nativeGen/PPC/CodeGen.hs

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