CodeGen.hs 100 KB
Newer Older
1
{-# LANGUAGE CPP, GADTs #-}
2 3 4 5 6 7 8 9 10 11

-----------------------------------------------------------------------------
--
-- Generating machine code (instruction selection)
--
-- (c) The University of Glasgow 1996-2004
--
-----------------------------------------------------------------------------

-- This is a big module, but, if you pay attention to
12 13
-- (a) the sectioning, and (b) the type signatures,
-- the structure should not be too overwhelming.
14

Sylvain Henry's avatar
Sylvain Henry committed
15
module GHC.CmmToAsm.PPC.CodeGen (
16 17 18 19
        cmmTopCodeGen,
        generateJumpTableForInstr,
        InstrBlock
)
20 21 22 23 24 25

where

#include "HsVersions.h"

-- NCG stuff:
26 27
import GhcPrelude

28
import GHC.Platform.Regs
Sylvain Henry's avatar
Sylvain Henry committed
29 30 31 32 33 34 35
import GHC.CmmToAsm.PPC.Instr
import GHC.CmmToAsm.PPC.Cond
import GHC.CmmToAsm.PPC.Regs
import GHC.CmmToAsm.CPrim
import GHC.CmmToAsm.Monad
   ( NatM, getNewRegNat, getNewLabelNat
   , getBlockIdNat, getPicBaseNat, getNewRegPairNat
36
   , getPicBaseMaybeNat, getPlatform
Sylvain Henry's avatar
Sylvain Henry committed
37 38 39 40
   )
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.PIC
import GHC.CmmToAsm.Format
41
import GHC.CmmToAsm.Config
Sylvain Henry's avatar
Sylvain Henry committed
42 43 44
import GHC.Platform.Reg.Class
import GHC.Platform.Reg
import GHC.CmmToAsm.Reg.Target
John Ericson's avatar
John Ericson committed
45
import GHC.Platform
46 47

-- Our intermediate code:
48 49 50 51 52 53 54 55
import GHC.Cmm.BlockId
import GHC.Cmm.Ppr           ( pprExpr )
import GHC.Cmm
import GHC.Cmm.Utils
import GHC.Cmm.Switch
import GHC.Cmm.CLabel
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Graph
56 57 58 59

-- The rest:
import OrdList
import Outputable
Sylvain Henry's avatar
Sylvain Henry committed
60
import GHC.Driver.Session
61

62
import Control.Monad    ( mapAndUnzipM, when )
63 64 65
import Data.Bits
import Data.Word

66 67
import BasicTypes
import FastString
68
import Util
69

70 71 72 73 74 75 76 77
-- -----------------------------------------------------------------------------
-- Top-level of the instruction selector

-- | 'InstrBlock's are the insn sequences generated by the insn selectors.
-- They are really trees of insns to facilitate fast appending, where a
-- left-to-right traversal (pre-order?) yields the insns in the correct
-- order.

78
cmmTopCodeGen
Simon Peyton Jones's avatar
Simon Peyton Jones committed
79
        :: RawCmmDecl
80
        -> NatM [NatCmmDecl RawCmmStatics Instr]
81

82 83
cmmTopCodeGen (CmmProc info lab live graph) = do
  let blocks = toBlockListEntryFirst graph
84
  (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
85
  platform <- getPlatform
86
  let proc = CmmProc info lab live (ListGraph $ concat nat_blocks)
87
      tops = proc : concat statics
88 89
      os   = platformOS platform
      arch = platformArch platform
90
  case arch of
91 92
    ArchPPC | os == OSAIX -> return tops
            | otherwise -> do
93 94 95 96
      picBaseMb <- getPicBaseMaybeNat
      case picBaseMb of
           Just picBase -> initializePicBase_ppc arch os picBase tops
           Nothing -> return tops
97
    ArchPPC_64 ELF_V1 -> fixup_entry tops
98 99
                      -- generating function descriptor is handled in
                      -- pretty printer
100
    ArchPPC_64 ELF_V2 -> fixup_entry tops
101 102 103
                      -- generating function prologue is handled in
                      -- pretty printer
    _          -> panic "PPC.cmmTopCodeGen: unknown arch"
104 105 106 107 108 109 110 111 112 113
    where
      fixup_entry (CmmProc info lab live (ListGraph (entry:blocks)) : statics)
        = do
        let BasicBlock bID insns = entry
        bID' <- if lab == (blockLbl bID)
                then newBlockId
                else return bID
        let b' = BasicBlock bID' insns
        return (CmmProc info lab live (ListGraph (b':blocks)) : statics)
      fixup_entry _ = panic "cmmTopCodegen: Broken CmmProc"
114

Ian Lynagh's avatar
Ian Lynagh committed
115
cmmTopCodeGen (CmmData sec dat) = do
116 117
  return [CmmData sec dat]  -- no translation, we just use CmmStatic

118
basicBlockCodeGen
119
        :: Block CmmNode C C
120
        -> NatM ( [NatBasicBlock Instr]
121
                , [NatCmmDecl RawCmmStatics Instr])
122

123
basicBlockCodeGen block = do
Peter Wortmann's avatar
Peter Wortmann committed
124 125
  let (_, nodes, tail)  = blockSplit block
      id = entryLabel block
126 127 128 129
      stmts = blockToList nodes
  mid_instrs <- stmtsToInstrs stmts
  tail_instrs <- stmtToInstrs tail
  let instrs = mid_instrs `appOL` tail_instrs
130 131 132 133 134
  -- code generation may introduce new basic block boundaries, which
  -- are indicated by the NEWBLOCK instruction.  We must split up the
  -- instruction stream into basic blocks again.  Also, we extract
  -- LDATAs here too.
  let
135 136 137 138 139 140 141 142
        (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs

        mkBlocks (NEWBLOCK id) (instrs,blocks,statics)
          = ([], BasicBlock id instrs : blocks, statics)
        mkBlocks (LDATA sec dat) (instrs,blocks,statics)
          = (instrs, blocks, CmmData sec dat:statics)
        mkBlocks instr (instrs,blocks,statics)
          = (instr:instrs, blocks, statics)
143 144
  return (BasicBlock id top : other_blocks, statics)

145
stmtsToInstrs :: [CmmNode e x] -> NatM InstrBlock
146 147 148 149
stmtsToInstrs stmts
   = do instrss <- mapM stmtToInstrs stmts
        return (concatOL instrss)

150
stmtToInstrs :: CmmNode e x -> NatM InstrBlock
151
stmtToInstrs stmt = do
152
  dflags <- getDynFlags
153
  platform <- getPlatform
154
  case stmt of
155
    CmmComment s   -> return (unitOL (COMMENT s))
Peter Wortmann's avatar
Peter Wortmann committed
156
    CmmTick {}     -> return nilOL
157
    CmmUnwind {}   -> return nilOL
158 159

    CmmAssign reg src
160
      | isFloatType ty -> assignReg_FltCode format reg src
161
      | target32Bit platform &&
162
        isWord64 ty    -> assignReg_I64Code      reg src
163
      | otherwise      -> assignReg_IntCode format reg src
164
        where ty = cmmRegType dflags reg
165
              format = cmmTypeFormat ty
166 167

    CmmStore addr src
168
      | isFloatType ty -> assignMem_FltCode format addr src
169
      | target32Bit platform &&
170 171
        isWord64 ty    -> assignMem_I64Code      addr src
      | otherwise      -> assignMem_IntCode format addr src
172
        where ty = cmmExprType dflags src
173
              format = cmmTypeFormat ty
174

175
    CmmUnsafeForeignCall target result_regs args
176 177
       -> genCCall target result_regs args

178
    CmmBranch id          -> genBranch id
179 180
    CmmCondBranch arg true false prediction -> do
      b1 <- genCondJump true arg prediction
181 182
      b2 <- genBranch false
      return (b1 `appOL` b2)
183
    CmmSwitch arg ids -> genSwitch dflags arg ids
184
    CmmCall { cml_target = arg
185
            , cml_args_regs = gregs } -> genJump arg (jumpRegs platform gregs)
186 187
    _ ->
      panic "stmtToInstrs: statement should have been cps'd away"
188

189 190
jumpRegs :: Platform -> [GlobalReg] -> [Reg]
jumpRegs platform gregs = [ RegReal r | Just r <- map (globalRegMaybe platform) gregs ]
191 192 193

--------------------------------------------------------------------------------
-- | 'InstrBlock's are the insn sequences generated by the insn selectors.
194 195
--      They are really trees of insns to facilitate fast appending, where a
--      left-to-right traversal yields the insns in the correct order.
196
--
197 198
type InstrBlock
        = OrdList Instr
199 200 201


-- | Register's passed up the tree.  If the stix code forces the register
202 203 204
--      to live in a pre-decided machine register, it comes out as @Fixed@;
--      otherwise, it comes out as @Any@, and the parent can decide which
--      register to put it in.
205 206
--
data Register
207 208
        = Fixed Format Reg InstrBlock
        | Any   Format (Reg -> InstrBlock)
209 210


211 212 213
swizzleRegisterRep :: Register -> Format -> Register
swizzleRegisterRep (Fixed _ reg code) format = Fixed format reg code
swizzleRegisterRep (Any _ codefn)     format = Any   format codefn
214 215 216


-- | Grab the Reg for a CmmReg
217
getRegisterReg :: Platform -> CmmReg -> Reg
218

219
getRegisterReg _ (CmmLocal (LocalReg u pk))
220
  = RegVirtual $ mkVirtualReg u (cmmTypeFormat pk)
221

222 223
getRegisterReg platform (CmmGlobal mid)
  = case globalRegMaybe platform mid of
224
        Just reg -> RegReal reg
225 226 227 228
        Nothing  -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
        -- By this stage, the only MagicIds remaining should be the
        -- ones which map to a real machine register on this
        -- platform.  Hence ...
229 230

-- | Convert a BlockId to some CmmStatic data
231 232
jumpTableEntry :: NCGConfig -> Maybe BlockId -> CmmStatic
jumpTableEntry config Nothing   = CmmStaticLit (CmmInt 0 (ncgWordWidth config))
233
jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
234
    where blockLabel = blockLbl blockid
235 236 237 238 239 240 241 242



-- -----------------------------------------------------------------------------
-- General things for putting together code sequences

-- Expand CmmRegOff.  ToDo: should we do it this way around, or convert
-- CmmExprs into CmmRegOff?
243 244
mangleIndexTree :: DynFlags -> CmmExpr -> CmmExpr
mangleIndexTree dflags (CmmRegOff reg off)
245
  = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]
246
  where width = typeWidth (cmmRegType dflags reg)
247

248
mangleIndexTree _ _
249
        = panic "PPC.CodeGen.mangleIndexTree: no match"
250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266

-- -----------------------------------------------------------------------------
--  Code gen for 64-bit arithmetic on 32-bit platforms

{-
Simple support for generating 64-bit code (ie, 64 bit values and 64
bit assignments) on 32-bit platforms.  Unlike the main code generator
we merely shoot for generating working code as simply as possible, and
pay little attention to code quality.  Specifically, there is no
attempt to deal cleverly with the fixed-vs-floating register
distinction; all values are generated into (pairs of) floating
registers, even if this would mean some redundant reg-reg moves as a
result.  Only one of the VRegUniques is returned, since it will be
of the VRegUniqueLo form, and the upper-half VReg can be determined
by applying getHiVRegFromLo to it.
-}

267 268 269 270 271 272 273 274
data ChildCode64        -- a.k.a "Register64"
      = ChildCode64
           InstrBlock   -- code
           Reg          -- the lower 32-bit temporary which contains the
                        -- result; use getHiVRegFromLo to find the other
                        -- VRegUnique.  Rules of this simplified insn
                        -- selection game are therefore that the returned
                        -- Reg may be modified
275 276


277
-- | Compute an expression into a register, but
278
--      we don't mind which one it is.
279 280 281 282 283
getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg expr = do
  r <- getRegister expr
  case r of
    Any rep code -> do
284 285 286 287
        tmp <- getNewRegNat rep
        return (tmp, code tmp)
    Fixed _ reg code ->
        return (reg, code)
288 289 290

getI64Amodes :: CmmExpr -> NatM (AddrMode, AddrMode, InstrBlock)
getI64Amodes addrTree = do
291
    Amode hi_addr addr_code <- getAmode D addrTree
292 293 294 295 296 297 298 299 300 301 302
    case addrOffset hi_addr 4 of
        Just lo_addr -> return (hi_addr, lo_addr, addr_code)
        Nothing      -> do (hi_ptr, code) <- getSomeReg addrTree
                           return (AddrRegImm hi_ptr (ImmInt 0),
                                   AddrRegImm hi_ptr (ImmInt 4),
                                   code)


assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_I64Code addrTree valueTree = do
        (hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree
303 304 305
        ChildCode64 vcode rlo <- iselExpr64 valueTree
        let
                rhi = getHiVRegFromLo rlo
306

307 308 309 310
                -- Big-endian store
                mov_hi = ST II32 rhi hi_addr
                mov_lo = ST II32 rlo lo_addr
        return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
311 312 313


assignReg_I64Code :: CmmReg  -> CmmExpr -> NatM InstrBlock
314
assignReg_I64Code (CmmLocal (LocalReg u_dst _)) valueTree = do
315
   ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
316
   let
317
         r_dst_lo = RegVirtual $ mkVirtualReg u_dst II32
318 319 320 321 322 323 324 325
         r_dst_hi = getHiVRegFromLo r_dst_lo
         r_src_hi = getHiVRegFromLo r_src_lo
         mov_lo = MR r_dst_lo r_src_lo
         mov_hi = MR r_dst_hi r_src_hi
   return (
        vcode `snocOL` mov_lo `snocOL` mov_hi
     )

326
assignReg_I64Code _ _
327 328 329 330 331 332 333 334 335
   = panic "assignReg_I64Code(powerpc): invalid lvalue"


iselExpr64        :: CmmExpr -> NatM ChildCode64
iselExpr64 (CmmLoad addrTree ty) | isWord64 ty = do
    (hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree
    (rlo, rhi) <- getNewRegPairNat II32
    let mov_hi = LD II32 rhi hi_addr
        mov_lo = LD II32 rlo lo_addr
336
    return $ ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)
337 338 339
                         rlo

iselExpr64 (CmmReg (CmmLocal (LocalReg vu ty))) | isWord64 ty
340
   = return (ChildCode64 nilOL (RegVirtual $ mkVirtualReg vu II32))
341 342 343 344

iselExpr64 (CmmLit (CmmInt i _)) = do
  (rlo,rhi) <- getNewRegPairNat II32
  let
345
        half0 = fromIntegral (fromIntegral i :: Word16)
346 347 348
        half1 = fromIntegral (fromIntegral (i `shiftR` 16) :: Word16)
        half2 = fromIntegral (fromIntegral (i `shiftR` 32) :: Word16)
        half3 = fromIntegral (fromIntegral (i `shiftR` 48) :: Word16)
349 350 351 352 353

        code = toOL [
                LIS rlo (ImmInt half1),
                OR rlo rlo (RIImm $ ImmInt half0),
                LIS rhi (ImmInt half3),
354
                OR rhi rhi (RIImm $ ImmInt half2)
355
                ]
356 357 358 359 360 361 362
  return (ChildCode64 code rlo)

iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do
   ChildCode64 code1 r1lo <- iselExpr64 e1
   ChildCode64 code2 r2lo <- iselExpr64 e2
   (rlo,rhi) <- getNewRegPairNat II32
   let
363 364 365 366 367 368
        r1hi = getHiVRegFromLo r1lo
        r2hi = getHiVRegFromLo r2lo
        code =  code1 `appOL`
                code2 `appOL`
                toOL [ ADDC rlo r1lo r2lo,
                       ADDE rhi r1hi r2hi ]
369 370
   return (ChildCode64 code rlo)

371 372 373 374 375 376 377 378 379
iselExpr64 (CmmMachOp (MO_Sub _) [e1,e2]) = do
   ChildCode64 code1 r1lo <- iselExpr64 e1
   ChildCode64 code2 r2lo <- iselExpr64 e2
   (rlo,rhi) <- getNewRegPairNat II32
   let
        r1hi = getHiVRegFromLo r1lo
        r2hi = getHiVRegFromLo r2lo
        code =  code1 `appOL`
                code2 `appOL`
380
                toOL [ SUBFC rlo r2lo (RIReg r1lo),
381 382 383
                       SUBFE rhi r2hi r1hi ]
   return (ChildCode64 code rlo)

384 385 386 387 388 389 390
iselExpr64 (CmmMachOp (MO_UU_Conv W32 W64) [expr]) = do
    (expr_reg,expr_code) <- getSomeReg expr
    (rlo, rhi) <- getNewRegPairNat II32
    let mov_hi = LI rhi (ImmInt 0)
        mov_lo = MR rlo expr_reg
    return $ ChildCode64 (expr_code `snocOL` mov_lo `snocOL` mov_hi)
                         rlo
391 392 393 394 395 396 397 398

iselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr]) = do
    (expr_reg,expr_code) <- getSomeReg expr
    (rlo, rhi) <- getNewRegPairNat II32
    let mov_hi = SRA II32 rhi expr_reg (RIImm (ImmInt 31))
        mov_lo = MR rlo expr_reg
    return $ ChildCode64 (expr_code `snocOL` mov_lo `snocOL` mov_hi)
                         rlo
399
iselExpr64 expr
400
   = pprPanic "iselExpr64(powerpc)" (pprExpr expr)
401 402 403 404



getRegister :: CmmExpr -> NatM Register
405
getRegister e = do dflags <- getDynFlags
406 407 408
                   getRegister' dflags e

getRegister' :: DynFlags -> CmmExpr -> NatM Register
409

410
getRegister' dflags (CmmReg (CmmGlobal PicBaseReg))
411 412 413 414
  | OSAIX <- platformOS (targetPlatform dflags) = do
        let code dst = toOL [ LD II32 dst tocAddr ]
            tocAddr = AddrRegImm toc (ImmLit (text "ghc_toc_table[TC]"))
        return (Any II32 code)
415
  | target32Bit (targetPlatform dflags) = do
416 417
      reg <- getPicBaseNat $ archWordFormat (target32Bit (targetPlatform dflags))
      return (Fixed (archWordFormat (target32Bit (targetPlatform dflags)))
418 419
                    reg nilOL)
  | otherwise = return (Fixed II64 toc nilOL)
pho@cielonegro.org's avatar
pho@cielonegro.org committed
420

421
getRegister' dflags (CmmReg reg)
422
  = return (Fixed (cmmTypeFormat (cmmRegType dflags reg))
423
                  (getRegisterReg (targetPlatform dflags) reg) nilOL)
424

425
getRegister' dflags tree@(CmmRegOff _ _)
426
  = getRegister' dflags (mangleIndexTree dflags tree)
427

428
    -- for 32-bit architectures, support some 64 -> 32 bit conversions:
429 430
    -- TO_W_(x), TO_W_(x >> 32)

431 432 433
getRegister' dflags (CmmMachOp (MO_UU_Conv W64 W32)
                     [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]])
 | target32Bit (targetPlatform dflags) = do
434 435 436
  ChildCode64 code rlo <- iselExpr64 x
  return $ Fixed II32 (getHiVRegFromLo rlo) code

437 438 439
getRegister' dflags (CmmMachOp (MO_SS_Conv W64 W32)
                     [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]])
 | target32Bit (targetPlatform dflags) = do
440 441 442
  ChildCode64 code rlo <- iselExpr64 x
  return $ Fixed II32 (getHiVRegFromLo rlo) code

443 444
getRegister' dflags (CmmMachOp (MO_UU_Conv W64 W32) [x])
 | target32Bit (targetPlatform dflags) = do
445 446 447
  ChildCode64 code rlo <- iselExpr64 x
  return $ Fixed II32 rlo code

448 449
getRegister' dflags (CmmMachOp (MO_SS_Conv W64 W32) [x])
 | target32Bit (targetPlatform dflags) = do
450
  ChildCode64 code rlo <- iselExpr64 x
451
  return $ Fixed II32 rlo code
452

453
getRegister' dflags (CmmLoad mem pk)
454
 | not (isWord64 pk) = do
455
        let platform = targetPlatform dflags
456
        Amode addr addr_code <- getAmode D mem
457
        let code dst = ASSERT((targetClassOfReg platform dst == RcDouble) == isFloatType pk)
458 459
                       addr_code `snocOL` LD format dst addr
        return (Any format code)
460 461 462 463 464
 | not (target32Bit (targetPlatform dflags)) = do
        Amode addr addr_code <- getAmode DS mem
        let code dst = addr_code `snocOL` LD II64 dst addr
        return (Any II64 code)

465
          where format = cmmTypeFormat pk
466 467

-- catch simple cases of zero- or sign-extended load
468
getRegister' _ (CmmMachOp (MO_UU_Conv W8 W32) [CmmLoad mem _]) = do
469
    Amode addr addr_code <- getAmode D mem
470 471
    return (Any II32 (\dst -> addr_code `snocOL` LD II8 dst addr))

472 473 474 475
getRegister' _ (CmmMachOp (MO_XX_Conv W8 W32) [CmmLoad mem _]) = do
    Amode addr addr_code <- getAmode D mem
    return (Any II32 (\dst -> addr_code `snocOL` LD II8 dst addr))

476 477 478 479
getRegister' _ (CmmMachOp (MO_UU_Conv W8 W64) [CmmLoad mem _]) = do
    Amode addr addr_code <- getAmode D mem
    return (Any II64 (\dst -> addr_code `snocOL` LD II8 dst addr))

480 481 482 483
getRegister' _ (CmmMachOp (MO_XX_Conv W8 W64) [CmmLoad mem _]) = do
    Amode addr addr_code <- getAmode D mem
    return (Any II64 (\dst -> addr_code `snocOL` LD II8 dst addr))

484 485
-- Note: there is no Load Byte Arithmetic instruction, so no signed case here

486
getRegister' _ (CmmMachOp (MO_UU_Conv W16 W32) [CmmLoad mem _]) = do
487
    Amode addr addr_code <- getAmode D mem
488 489
    return (Any II32 (\dst -> addr_code `snocOL` LD II16 dst addr))

490
getRegister' _ (CmmMachOp (MO_SS_Conv W16 W32) [CmmLoad mem _]) = do
491
    Amode addr addr_code <- getAmode D mem
492 493
    return (Any II32 (\dst -> addr_code `snocOL` LA II16 dst addr))

494 495 496 497 498 499 500 501 502 503 504 505 506
getRegister' _ (CmmMachOp (MO_UU_Conv W16 W64) [CmmLoad mem _]) = do
    Amode addr addr_code <- getAmode D mem
    return (Any II64 (\dst -> addr_code `snocOL` LD II16 dst addr))

getRegister' _ (CmmMachOp (MO_SS_Conv W16 W64) [CmmLoad mem _]) = do
    Amode addr addr_code <- getAmode D mem
    return (Any II64 (\dst -> addr_code `snocOL` LA II16 dst addr))

getRegister' _ (CmmMachOp (MO_UU_Conv W32 W64) [CmmLoad mem _]) = do
    Amode addr addr_code <- getAmode D mem
    return (Any II64 (\dst -> addr_code `snocOL` LD II32 dst addr))

getRegister' _ (CmmMachOp (MO_SS_Conv W32 W64) [CmmLoad mem _]) = do
507 508
    -- lwa is DS-form. See Note [Power instruction format]
    Amode addr addr_code <- getAmode DS mem
509 510
    return (Any II64 (\dst -> addr_code `snocOL` LA II32 dst addr))

511
getRegister' dflags (CmmMachOp mop [x]) -- unary MachOps
512 513 514 515 516 517 518 519 520 521 522 523 524
  = case mop of
      MO_Not rep   -> triv_ucode_int rep NOT

      MO_F_Neg w   -> triv_ucode_float w FNEG
      MO_S_Neg w   -> triv_ucode_int   w NEG

      MO_FF_Conv W64 W32 -> trivialUCode  FF32 FRSP x
      MO_FF_Conv W32 W64 -> conversionNop FF64 x

      MO_FS_Conv from to -> coerceFP2Int from to x
      MO_SF_Conv from to -> coerceInt2FP from to x

      MO_SS_Conv from to
525 526
        | from >= to -> conversionNop (intFormat to) x
        | otherwise  -> triv_ucode_int to (EXTS (intFormat from))
527 528

      MO_UU_Conv from to
529 530 531 532 533
        | from >= to -> conversionNop (intFormat to) x
        | otherwise  -> clearLeft from to

      MO_XX_Conv _ to -> conversionNop (intFormat to) x

534
      _ -> panic "PPC.CodeGen.getRegister: no match"
535 536

    where
537 538
        triv_ucode_int   width instr = trivialUCode (intFormat    width) instr x
        triv_ucode_float width instr = trivialUCode (floatFormat  width) instr x
539

540
        conversionNop new_format expr
541
            = do e_code <- getRegister' dflags expr
542
                 return (swizzleRegisterRep e_code new_format)
543

544 545 546 547 548 549 550 551 552 553
        clearLeft from to
            = do (src1, code1) <- getSomeReg x
                 let arch_fmt  = intFormat (wordWidth dflags)
                     arch_bits = widthInBits (wordWidth dflags)
                     size      = widthInBits from
                     code dst  = code1 `snocOL`
                                 CLRLI arch_fmt dst src1 (arch_bits - size)
                 return (Any (intFormat to) code)

getRegister' _ (CmmMachOp mop [x, y]) -- dyadic PrimOps
554
  = case mop of
555 556 557 558 559 560
      MO_F_Eq _ -> condFltReg EQQ x y
      MO_F_Ne _ -> condFltReg NE  x y
      MO_F_Gt _ -> condFltReg GTT x y
      MO_F_Ge _ -> condFltReg GE  x y
      MO_F_Lt _ -> condFltReg LTT x y
      MO_F_Le _ -> condFltReg LE  x y
561

562 563 564 565 566 567 568 569 570 571 572 573
      MO_Eq rep -> condIntReg EQQ rep x y
      MO_Ne rep -> condIntReg NE  rep x y

      MO_S_Gt rep -> condIntReg GTT rep x y
      MO_S_Ge rep -> condIntReg GE  rep x y
      MO_S_Lt rep -> condIntReg LTT rep x y
      MO_S_Le rep -> condIntReg LE  rep x y

      MO_U_Gt rep -> condIntReg GU  rep x y
      MO_U_Ge rep -> condIntReg GEU rep x y
      MO_U_Lt rep -> condIntReg LU  rep x y
      MO_U_Le rep -> condIntReg LEU rep x y
574 575 576 577 578

      MO_F_Add w  -> triv_float w FADD
      MO_F_Sub w  -> triv_float w FSUB
      MO_F_Mul w  -> triv_float w FMUL
      MO_F_Quot w -> triv_float w FDIV
579

580 581 582 583
         -- optimize addition with 32-bit immediate
         -- (needed for PIC)
      MO_Add W32 ->
        case y of
584
          CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate W32 True imm
585 586 587 588 589 590 591 592 593 594 595 596 597 598
            -> trivialCode W32 True ADD x (CmmLit $ CmmInt imm immrep)
          CmmLit lit
            -> do
                (src, srcCode) <- getSomeReg x
                let imm = litToImm lit
                    code dst = srcCode `appOL` toOL [
                                    ADDIS dst src (HA imm),
                                    ADD dst dst (RIImm (LO imm))
                                ]
                return (Any II32 code)
          _ -> trivialCode W32 True ADD x y

      MO_Add rep -> trivialCode rep True ADD x y
      MO_Sub rep ->
599
        case y of
600 601
          CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate rep True (-imm)
            -> trivialCode rep True ADD x (CmmLit $ CmmInt (-imm) immrep)
602 603 604
          _ -> case x of
                 CmmLit (CmmInt imm _)
                   | Just _ <- makeImmediate rep True imm
Brian Wignall's avatar
Brian Wignall committed
605
                   -- subfi ('subtract from' with immediate) doesn't exist
606 607 608 609 610 611 612 613 614 615 616 617 618 619
                   -> trivialCode rep True SUBFC y x
                 _ -> trivialCodeNoImm' (intFormat rep) SUBF y x

      MO_Mul rep -> shiftMulCode rep True MULL x y
      MO_S_MulMayOflo rep -> do
        (src1, code1) <- getSomeReg x
        (src2, code2) <- getSomeReg y
        let
          format = intFormat rep
          code dst = code1 `appOL` code2
                       `appOL` toOL [ MULLO format dst src1 src2
                                    , MFOV  format dst
                                    ]
        return (Any format code)
620

621 622
      MO_S_Quot rep -> divCode rep True x y
      MO_U_Quot rep -> divCode rep False x y
623

624 625
      MO_S_Rem rep -> remainder rep True x y
      MO_U_Rem rep -> remainder rep False x y
626

627 628 629 630 631 632 633 634 635 636
      MO_And rep   -> case y of
        (CmmLit (CmmInt imm _)) | imm == -8 || imm == -4
            -> do
                (src, srcCode) <- getSomeReg x
                let clear_mask = if imm == -4 then 2 else 3
                    fmt = intFormat rep
                    code dst = srcCode
                               `appOL` unitOL (CLRRI fmt dst src clear_mask)
                return (Any fmt code)
        _ -> trivialCode rep False AND x y
637 638 639
      MO_Or rep    -> trivialCode rep False OR x y
      MO_Xor rep   -> trivialCode rep False XOR x y

640
      MO_Shl rep   -> shiftMulCode rep False SL x y
641 642
      MO_S_Shr rep -> srCode rep True SRA x y
      MO_U_Shr rep -> srCode rep False SR x y
643
      _         -> panic "PPC.CodeGen.getRegister: no match"
644 645

  where
646 647
    triv_float :: Width -> (Format -> Reg -> Reg -> Reg -> Instr) -> NatM Register
    triv_float width instr = trivialCodeNoImm (floatFormat width) instr x y
648

649 650 651 652 653 654 655 656
    remainder :: Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register
    remainder rep sgn x y = do
      let fmt = intFormat rep
      tmp <- getNewRegNat fmt
      code <- remainderCode rep sgn tmp x y
      return (Any fmt code)


657
getRegister' _ (CmmLit (CmmInt i rep))
658 659
  | Just imm <- makeImmediate rep True i
  = let
660
        code dst = unitOL (LI dst imm)
661
    in
662
        return (Any (intFormat rep) code)
663

664
getRegister' _ (CmmLit (CmmFloat f frep)) = do
665
    lbl <- getNewLabelNat
666
    dflags <- getDynFlags
667
    dynRef <- cmmMakeDynamicReference dflags DataReference lbl
668
    Amode addr addr_code <- getAmode D dynRef
669
    let format = floatFormat frep
670
        code dst =
671
            LDATA (Section ReadOnlyData lbl)
672
                  (RawCmmStatics lbl [CmmStaticLit (CmmFloat f frep)])
673 674
            `consOL` (addr_code `snocOL` LD format dst addr)
    return (Any format code)
675

676
getRegister' dflags (CmmLit lit)
677
  | target32Bit (targetPlatform dflags)
678
  = let rep = cmmLitType dflags lit
679 680 681 682 683
        imm = litToImm lit
        code dst = toOL [
              LIS dst (HA imm),
              ADD dst dst (RIImm (LO imm))
          ]
684
    in return (Any (cmmTypeFormat rep) code)
685 686 687 688 689 690
  | otherwise
  = do lbl <- getNewLabelNat
       dflags <- getDynFlags
       dynRef <- cmmMakeDynamicReference dflags DataReference lbl
       Amode addr addr_code <- getAmode D dynRef
       let rep = cmmLitType dflags lit
691
           format = cmmTypeFormat rep
692
           code dst =
693
            LDATA (Section ReadOnlyData lbl) (RawCmmStatics lbl [CmmStaticLit lit])
694 695
            `consOL` (addr_code `snocOL` LD format dst addr)
       return (Any format code)
696

697
getRegister' _ other = pprPanic "getRegister(ppc)" (pprExpr other)
698

699 700 701 702 703 704 705
    -- extend?Rep: wrap integer expression of type `from`
    -- in a conversion to `to`
extendSExpr :: Width -> Width -> CmmExpr -> CmmExpr
extendSExpr from to x = CmmMachOp (MO_SS_Conv from to) [x]

extendUExpr :: Width -> Width -> CmmExpr -> CmmExpr
extendUExpr from to x = CmmMachOp (MO_UU_Conv from to) [x]
706 707 708 709

-- -----------------------------------------------------------------------------
--  The 'Amode' type: Memory addressing modes passed up the tree.

710 711
data Amode
        = Amode AddrMode InstrBlock
712 713

{-
Gabor Greif's avatar
Gabor Greif committed
714
Now, given a tree (the argument to a CmmLoad) that references memory,
715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730
produce a suitable addressing mode.

A Rule of the Game (tm) for Amodes: use of the addr bit must
immediately follow use of the code part, since the code part puts
values in registers which the addr then refers to.  So you can't put
anything in between, lest it overwrite some of those registers.  If
you need to do some other computation between the code part and use of
the addr bit, first store the effective address from the amode in a
temporary, then do the other computation, and then use the temporary:

    code
    LEA amode, tmp
    ... other computation ...
    ... (tmp) ...
-}

731 732
{- Note [Power instruction format]
In some instructions the 16 bit offset must be a multiple of 4, i.e.
Gabor Greif's avatar
Gabor Greif committed
733
the two least significant bits must be zero. The "Power ISA" specification
734 735 736 737 738
calls these instruction formats "DS-FORM" and the instructions with
arbitrary 16 bit offsets are "D-FORM".

The Power ISA specification document can be obtained from www.power.org.
-}
739
data InstrForm = D | DS
740

741 742 743 744 745 746
getAmode :: InstrForm -> CmmExpr -> NatM Amode
getAmode inf tree@(CmmRegOff _ _)
  = do dflags <- getDynFlags
       getAmode inf (mangleIndexTree dflags tree)

getAmode _ (CmmMachOp (MO_Sub W32) [x, CmmLit (CmmInt i _)])
747 748 749 750 751 752
  | Just off <- makeImmediate W32 True (-i)
  = do
        (reg, code) <- getSomeReg x
        return (Amode (AddrRegImm reg off) code)


753
getAmode _ (CmmMachOp (MO_Add W32) [x, CmmLit (CmmInt i _)])
754 755 756 757 758
  | Just off <- makeImmediate W32 True i
  = do
        (reg, code) <- getSomeReg x
        return (Amode (AddrRegImm reg off) code)

759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797
getAmode D (CmmMachOp (MO_Sub W64) [x, CmmLit (CmmInt i _)])
  | Just off <- makeImmediate W64 True (-i)
  = do
        (reg, code) <- getSomeReg x
        return (Amode (AddrRegImm reg off) code)


getAmode D (CmmMachOp (MO_Add W64) [x, CmmLit (CmmInt i _)])
  | Just off <- makeImmediate W64 True i
  = do
        (reg, code) <- getSomeReg x
        return (Amode (AddrRegImm reg off) code)

getAmode DS (CmmMachOp (MO_Sub W64) [x, CmmLit (CmmInt i _)])
  | Just off <- makeImmediate W64 True (-i)
  = do
        (reg, code) <- getSomeReg x
        (reg', off', code')  <-
                     if i `mod` 4 == 0
                      then do return (reg, off, code)
                      else do
                           tmp <- getNewRegNat II64
                           return (tmp, ImmInt 0,
                                  code `snocOL` ADD tmp reg (RIImm off))
        return (Amode (AddrRegImm reg' off') code')

getAmode DS (CmmMachOp (MO_Add W64) [x, CmmLit (CmmInt i _)])
  | Just off <- makeImmediate W64 True i
  = do
        (reg, code) <- getSomeReg x
        (reg', off', code')  <-
                     if i `mod` 4 == 0
                      then do return (reg, off, code)
                      else do
                           tmp <- getNewRegNat II64
                           return (tmp, ImmInt 0,
                                  code `snocOL` ADD tmp reg (RIImm off))
        return (Amode (AddrRegImm reg' off') code')

798 799
   -- optimize addition with 32-bit immediate
   -- (needed for PIC)
800
getAmode _ (CmmMachOp (MO_Add W32) [x, CmmLit lit])
801
  = do
802
        platform <- getPlatform
803 804
        (src, srcCode) <- getSomeReg x
        let imm = litToImm lit
805
        case () of
806
            _ | OSAIX <- platformOS platform
807 808 809 810 811 812 813 814 815 816 817 818
              , isCmmLabelType lit ->
                    -- HA16/LO16 relocations on labels not supported on AIX
                    return (Amode (AddrRegImm src imm) srcCode)
              | otherwise -> do
                    tmp <- getNewRegNat II32
                    let code = srcCode `snocOL` ADDIS tmp src (HA imm)
                    return (Amode (AddrRegImm tmp (LO imm)) code)
  where
      isCmmLabelType (CmmLabel {})        = True
      isCmmLabelType (CmmLabelOff {})     = True
      isCmmLabelType (CmmLabelDiffOff {}) = True
      isCmmLabelType _                    = False
819

820
getAmode _ (CmmLit lit)
821
  = do
822 823
        platform <- getPlatform
        case platformArch platform of
824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845
             ArchPPC -> do
                 tmp <- getNewRegNat II32
                 let imm = litToImm lit
                     code = unitOL (LIS tmp (HA imm))
                 return (Amode (AddrRegImm tmp (LO imm)) code)
             _        -> do -- TODO: Load from TOC,
                            -- see getRegister' _ (CmmLit lit)
                 tmp <- getNewRegNat II64
                 let imm = litToImm lit
                     code =  toOL [
                          LIS tmp (HIGHESTA imm),
                          OR tmp tmp (RIImm (HIGHERA imm)),
                          SL  II64 tmp tmp (RIImm (ImmInt 32)),
                          ORIS tmp tmp (HA imm)
                          ]
                 return (Amode (AddrRegImm tmp (LO imm)) code)

getAmode _ (CmmMachOp (MO_Add W32) [x, y])
  = do
        (regX, codeX) <- getSomeReg x
        (regY, codeY) <- getSomeReg y
        return (Amode (AddrRegReg regX regY) (codeX `appOL` codeY))
846

847
getAmode _ (CmmMachOp (MO_Add W64) [x, y])
848 849 850 851
  = do
        (regX, codeX) <- getSomeReg x
        (regY, codeY) <- getSomeReg y
        return (Amode (AddrRegReg regX regY) (codeX `appOL` codeY))
852

853
getAmode _ other
854 855 856 857 858 859 860 861
  = do
        (reg, code) <- getSomeReg other
        let
            off  = ImmInt 0
        return (Amode (AddrRegImm reg off) code)


--  The 'CondCode' type:  Condition codes passed up the tree.
862 863
data CondCode
        = CondCode Bool Cond InstrBlock
864 865 866 867 868 869

-- Set up a condition code for a conditional branch.

getCondCode :: CmmExpr -> NatM CondCode

-- almost the same as everywhere else - but we need to
870
-- extend small integers to 32 bit or 64 bit first
871 872

getCondCode (CmmMachOp mop [x, y])
873 874
  = do
    case mop of
875 876 877 878 879 880 881 882 883 884 885 886 887 888
      MO_F_Eq W32 -> condFltCode EQQ x y
      MO_F_Ne W32 -> condFltCode NE  x y
      MO_F_Gt W32 -> condFltCode GTT x y
      MO_F_Ge W32 -> condFltCode GE  x y
      MO_F_Lt W32 -> condFltCode LTT x y
      MO_F_Le W32 -> condFltCode LE  x y

      MO_F_Eq W64 -> condFltCode EQQ x y
      MO_F_Ne W64 -> condFltCode NE  x y
      MO_F_Gt W64 -> condFltCode GTT x y
      MO_F_Ge W64 -> condFltCode GE  x y
      MO_F_Lt W64 -> condFltCode LTT x y
      MO_F_Le W64 -> condFltCode LE  x y

889 890 891 892 893 894 895 896 897 898 899 900
      MO_Eq rep -> condIntCode EQQ rep x y
      MO_Ne rep -> condIntCode NE  rep x y

      MO_S_Gt rep -> condIntCode GTT rep x y
      MO_S_Ge rep -> condIntCode GE  rep x y
      MO_S_Lt rep -> condIntCode LTT rep x y
      MO_S_Le rep -> condIntCode LE  rep x y

      MO_U_Gt rep -> condIntCode GU  rep x y
      MO_U_Ge rep -> condIntCode GEU rep x y
      MO_U_Lt rep -> condIntCode LU  rep x y
      MO_U_Le rep -> condIntCode LEU rep x y
901

902
      _ -> pprPanic "getCondCode(powerpc)" (pprMachOp mop)
903

904
getCondCode _ = panic "getCondCode(2)(powerpc)"
905 906 907 908 909


-- @cond(Int|Flt)Code@: Turn a boolean expression into a condition, to be
-- passed back up the tree.

910
condIntCode :: Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
911
condIntCode cond width x y = do
912 913
  platform <- getPlatform
  condIntCode' (target32Bit platform) cond width x y
914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949

condIntCode' :: Bool -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode

-- simple code for 64-bit on 32-bit platforms
condIntCode' True cond W64 x y
  | condUnsigned cond
  = do
      ChildCode64 code_x x_lo <- iselExpr64 x
      ChildCode64 code_y y_lo <- iselExpr64 y
      let x_hi = getHiVRegFromLo x_lo
          y_hi = getHiVRegFromLo y_lo
      end_lbl <- getBlockIdNat
      let code = code_x `appOL` code_y `appOL` toOL
                 [ CMPL II32 x_hi (RIReg y_hi)
                 , BCC NE end_lbl Nothing
                 , CMPL II32 x_lo (RIReg y_lo)
                 , BCC ALWAYS end_lbl Nothing

                 , NEWBLOCK end_lbl
                 ]
      return (CondCode False cond code)
  | otherwise
  = do
      ChildCode64 code_x x_lo <- iselExpr64 x
      ChildCode64 code_y y_lo <- iselExpr64 y
      let x_hi = getHiVRegFromLo x_lo
          y_hi = getHiVRegFromLo y_lo
      end_lbl <- getBlockIdNat
      cmp_lo  <- getBlockIdNat
      let code = code_x `appOL` code_y `appOL` toOL
                 [ CMP II32 x_hi (RIReg y_hi)
                 , BCC NE end_lbl Nothing
                 , CMP II32 x_hi (RIImm (ImmInt 0))
                 , BCC LE cmp_lo Nothing
                 , CMPL II32 x_lo (RIReg y_lo)
                 , BCC ALWAYS end_lbl Nothing
950
                 , NEWBLOCK cmp_lo
951 952 953 954 955 956
                 , CMPL II32 y_lo (RIReg x_lo)
                 , BCC ALWAYS end_lbl Nothing

                 , NEWBLOCK end_lbl
                 ]
      return (CondCode False cond code)
957

958 959
-- optimize pointer tag checks. Operation andi. sets condition register
-- so cmpi ..., 0 is redundant.
960
condIntCode' _ cond _ (CmmMachOp (MO_And _) [x, CmmLit (CmmInt imm rep)])
961 962 963 964 965 966 967 968
                 (CmmLit (CmmInt 0 _))
  | not $ condUnsigned cond,
    Just src2 <- makeImmediate rep False imm
  = do
      (src1, code) <- getSomeReg x
      let code' = code `snocOL` AND r0 src1 (RIImm src2)
      return (CondCode False cond code')

969
condIntCode' _ cond width x (CmmLit (CmmInt y rep))
970 971
  | Just src2 <- makeImmediate rep (not $ condUnsigned cond) y
  = do
972 973 974 975 976 977 978
      let op_len = max W32 width
      let extend = extendSExpr width op_len
      (src1, code) <- getSomeReg (extend x)
      let format = intFormat op_len
          code' = code `snocOL`
            (if condUnsigned cond then CMPL else CMP) format src1 (RIImm src2)
      return (CondCode False cond code')
979

980
condIntCode' _ cond width x y = do
981 982 983 984 985 986 987 988 989 990 991
  let op_len = max W32 width
  let extend = if condUnsigned cond then extendUExpr width op_len
               else extendSExpr width op_len
  (src1, code1) <- getSomeReg (extend x)
  (src2, code2) <- getSomeReg (extend y)
  let format = intFormat op_len
      code' = code1 `appOL` code2 `snocOL`
        (if condUnsigned cond then CMPL else CMP) format src1 (RIReg src2)
  return (CondCode False cond code')

condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
992 993 994 995
condFltCode cond x y = do
    (src1, code1) <- getSomeReg x
    (src2, code2) <- getSomeReg y
    let
996 997
        code'  = code1 `appOL` code2 `snocOL` FCMP src1 src2
        code'' = case cond of -- twiddle CR to handle unordered case
998
                    GE -> code' `snocOL` CRNOR ltbit eqbit gtbit
999 1000
                    LE -> code' `snocOL` CRNOR gtbit eqbit ltbit
                    _ -> code'
1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018
                 where
                    ltbit = 0 ; eqbit = 2 ; gtbit = 1
    return (CondCode True cond code'')



-- -----------------------------------------------------------------------------
-- Generating assignments

-- Assignments are really at the heart of the whole code generation
-- business.  Almost all top-level nodes of any real importance are
-- assignments, which correspond to loads, stores, or register
-- transfers.  If we're really lucky, some of the register transfers
-- will go away, because we can use the destination register to
-- complete the code generation for the right hand side.  This only
-- fails when the right hand side is forced into a fixed register
-- (e.g. the result of a call).

1019 1020
assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignReg_IntCode :: Format -> CmmReg  -> CmmExpr -> NatM InstrBlock
1021

1022 1023
assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignReg_FltCode :: Format -> CmmReg  -> CmmExpr -> NatM InstrBlock
1024 1025 1026

assignMem_IntCode pk addr src = do
    (srcReg, code) <- getSomeReg src
1027 1028 1029
    Amode dstAddr addr_code <- case pk of
                                II64 -> getAmode DS addr
                                _    -> getAmode D  addr
1030 1031 1032 1033 1034
    return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr

-- dst is a reg, but src could be anything
assignReg_IntCode _ reg src
    = do
1035 1036
        dflags <- getDynFlags
        let dst = getRegisterReg (targetPlatform dflags) reg
1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049
        r <- getRegister src
        return $ case r of
            Any _ code         -> code dst
            Fixed _ freg fcode -> fcode `snocOL` MR dst freg



-- Easy, isn't it?
assignMem_FltCode = assignMem_IntCode
assignReg_FltCode = assignReg_IntCode



1050
genJump :: CmmExpr{-the branch target-} -> [Reg] -> NatM InstrBlock
1051

1052 1053
genJump (CmmLit (CmmLabel lbl)) regs
  = return (unitOL $ JMP lbl regs)
1054

1055
genJump tree gregs
1056 1057
  = do
        dflags <- getDynFlags
1058
        genJump' tree (platformToGCP (targetPlatform dflags)) gregs
1059

1060
genJump' :: CmmExpr -> GenCCallPlatform -> [Reg] -> NatM InstrBlock
1061

1062
genJump' tree (GCP64ELF 1) regs
1063 1064
  = do
        (target,code) <- getSomeReg tree
1065 1066 1067 1068 1069
        return (code
               `snocOL` LD II64 r11 (AddrRegImm target (ImmInt 0))
               `snocOL` LD II64 toc (AddrRegImm target (ImmInt 8))
               `snocOL` MTCTR r11
               `snocOL` LD II64 r11 (AddrRegImm target (ImmInt 16))
1070
               `snocOL` BCTR [] Nothing regs)
1071

1072
genJump' tree (GCP64ELF 2) regs
1073 1074 1075 1076 1077
  = do
        (target,code) <- getSomeReg tree
        return (code
               `snocOL` MR r12 target
               `snocOL` MTCTR r12
1078
               `snocOL` BCTR [] Nothing regs)
1079

1080
genJump' tree _ regs
1081 1082
  = do
        (target,code) <- getSomeReg tree
1083
        return (code `snocOL` MTCTR target `snocOL` BCTR [] Nothing regs)
1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101

-- -----------------------------------------------------------------------------
--  Unconditional branches
genBranch :: BlockId -> NatM InstrBlock
genBranch = return . toOL . mkJumpInstr


-- -----------------------------------------------------------------------------
--  Conditional jumps

{-
Conditional jumps are always to local labels, so we can use branch
instructions.  We peek at the arguments to decide what kind of
comparison to do.
-}


genCondJump
1102
    :: BlockId      -- the branch target
1103
    -> CmmExpr      -- the condition on which to branch
1104
    -> Maybe Bool
1105 1106
    -> NatM InstrBlock

1107
genCondJump id bool prediction = do
1108
  CondCode _ cond code <- getCondCode bool
1109
  return (code `snocOL` BCC cond id prediction)
1110 1111 1112 1113 1114 1115 1116 1117 1118 1119



-- -----------------------------------------------------------------------------
--  Generating C calls

-- Now the biggest nightmare---calls.  Most of the nastiness is buried in
-- @get_arg@, which moves the arguments to the correct registers/stack
-- locations.  Apart from that, the code is easy.

1120
genCCall :: ForeignTarget      -- function to call
1121 1122
         -> [CmmFormal]        -- where to put the result
         -> [CmmActual]        -- arguments (of mixed type)
1123
         -> NatM InstrBlock
1124 1125
genCCall (PrimTarget MO_ReadBarrier) _ _
 = return $ unitOL LWSYNC
1126 1127 1128 1129 1130 1131 1132 1133 1134
genCCall (PrimTarget MO_WriteBarrier) _ _
 = return $ unitOL LWSYNC

genCCall (PrimTarget MO_Touch) _ _
 = return $ nilOL

genCCall (PrimTarget (MO_Prefetch_Data _)) _ _
 = return $ nilOL

1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218
genCCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n]
 = do dflags <- getDynFlags
      let platform = targetPlatform dflags
          fmt      = intFormat width
          reg_dst  = getRegisterReg platform (CmmLocal dst)
      (instr, n_code) <- case amop of
            AMO_Add  -> getSomeRegOrImm ADD True reg_dst
            AMO_Sub  -> case n of
                CmmLit (CmmInt i _)
                  | Just imm <- makeImmediate width True (-i)
                   -> return (ADD reg_dst reg_dst (RIImm imm), nilOL)
                _
                   -> do
                         (n_reg, n_code) <- getSomeReg n
                         return  (SUBF reg_dst n_reg reg_dst, n_code)
            AMO_And  -> getSomeRegOrImm AND False reg_dst
            AMO_Nand -> do (n_reg, n_code) <- getSomeReg n
                           return (NAND reg_dst reg_dst n_reg, n_code)
            AMO_Or   -> getSomeRegOrImm OR False reg_dst
            AMO_Xor  -> getSomeRegOrImm XOR False reg_dst
      Amode addr_reg addr_code <- getAmodeIndex addr
      lbl_retry <- getBlockIdNat
      return $ n_code `appOL` addr_code
        `appOL` toOL [ HWSYNC
                     , BCC ALWAYS lbl_retry Nothing

                     , NEWBLOCK lbl_retry
                     , LDR fmt reg_dst addr_reg
                     , instr
                     , STC fmt reg_dst addr_reg
                     , BCC NE lbl_retry (Just False)
                     , ISYNC
                     ]
         where
           getAmodeIndex (CmmMachOp (MO_Add _) [x, y])
             = do
                 (regX, codeX) <- getSomeReg x
                 (regY, codeY) <- getSomeReg y
                 return (Amode (AddrRegReg regX regY) (codeX `appOL` codeY))
           getAmodeIndex other
             = do
                 (reg, code) <- getSomeReg other
                 return (Amode (AddrRegReg r0 reg) code) -- NB: r0 is 0 here!
           getSomeRegOrImm op sign dst
             = case n of
                 CmmLit (CmmInt i _) | Just imm <- makeImmediate width sign i
                    -> return (op dst dst (RIImm imm), nilOL)
                 _
                    -> do
                          (n_reg, n_code) <- getSomeReg n
                          return  (op dst dst (RIReg n_reg), n_code)

genCCall (PrimTarget (MO_AtomicRead width)) [dst] [addr]
 = do dflags <- getDynFlags
      let platform = targetPlatform dflags
          fmt      = intFormat width
          reg_dst  = getRegisterReg platform (CmmLocal dst)
          form     = if widthInBits width == 64 then DS else D
      Amode addr_reg addr_code <- getAmode form addr
      lbl_end <- getBlockIdNat
      return $ addr_code `appOL` toOL [ HWSYNC
                                      , LD fmt reg_dst addr_reg
                                      , CMP fmt reg_dst (RIReg reg_dst)
                                      , BCC NE lbl_end (Just False)
                                      , BCC ALWAYS lbl_end Nothing
                            -- See Note [Seemingly useless cmp and bne]