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

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

-- This is a big module, but, if you pay attention to
-- (a) the sectioning, (b) the type signatures, and
-- (c) the #if blah_TARGET_ARCH} things, the
-- structure should not be too overwhelming.

16 17 18 19 20
module PPC.CodeGen (
        cmmTopCodeGen,
        generateJumpTableForInstr,
        InstrBlock
)
21 22 23 24 25

where

#include "HsVersions.h"
#include "nativeGen/NCG.h"
Simon Marlow's avatar
Simon Marlow committed
26
#include "../includes/MachDeps.h"
27 28

-- NCG stuff:
29
import CodeGen.Platform
30 31 32
import PPC.Instr
import PPC.Cond
import PPC.Regs
tibbe's avatar
tibbe committed
33
import CPrim
34 35 36
import NCGMonad
import Instruction
import PIC
37
import Format
38 39
import RegClass
import Reg
40
import TargetReg
41 42 43 44
import Platform

-- Our intermediate code:
import BlockId
45
import PprCmm           ( pprExpr )
46 47
import Cmm
import CmmUtils
48
import CmmSwitch
49
import CLabel
50
import Hoopl
51 52 53 54

-- The rest:
import OrdList
import Outputable
55
import Unique
56 57
import DynFlags

58
import Control.Monad    ( mapAndUnzipM, when )
59 60 61
import Data.Bits
import Data.Word

62 63
import BasicTypes
import FastString
64
import Util
65

66 67 68 69 70 71 72 73
-- -----------------------------------------------------------------------------
-- 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.

74
cmmTopCodeGen
Simon Peyton Jones's avatar
Simon Peyton Jones committed
75 76
        :: RawCmmDecl
        -> NatM [NatCmmDecl CmmStatics Instr]
77

78 79
cmmTopCodeGen (CmmProc info lab live graph) = do
  let blocks = toBlockListEntryFirst graph
80
  (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
81
  dflags <- getDynFlags
82
  let proc = CmmProc info lab live (ListGraph $ concat nat_blocks)
83 84
      tops = proc : concat statics
      os   = platformOS $ targetPlatform dflags
85 86
      arch = platformArch $ targetPlatform dflags
  case arch of
87 88
    ArchPPC | os == OSAIX -> return tops
            | otherwise -> do
89 90 91 92 93 94 95 96 97 98 99
      picBaseMb <- getPicBaseMaybeNat
      case picBaseMb of
           Just picBase -> initializePicBase_ppc arch os picBase tops
           Nothing -> return tops
    ArchPPC_64 ELF_V1 -> return tops
                      -- generating function descriptor is handled in
                      -- pretty printer
    ArchPPC_64 ELF_V2 -> return tops
                      -- generating function prologue is handled in
                      -- pretty printer
    _          -> panic "PPC.cmmTopCodeGen: unknown arch"
100

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

104
basicBlockCodeGen
105
        :: Block CmmNode C C
106
        -> NatM ( [NatBasicBlock Instr]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
107
                , [NatCmmDecl CmmStatics Instr])
108

109
basicBlockCodeGen block = do
Peter Wortmann's avatar
Peter Wortmann committed
110 111
  let (_, nodes, tail)  = blockSplit block
      id = entryLabel block
112 113 114 115
      stmts = blockToList nodes
  mid_instrs <- stmtsToInstrs stmts
  tail_instrs <- stmtToInstrs tail
  let instrs = mid_instrs `appOL` tail_instrs
116 117 118 119 120
  -- 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
121 122 123 124 125 126 127 128
        (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)
129 130
  return (BasicBlock id top : other_blocks, statics)

131
stmtsToInstrs :: [CmmNode e x] -> NatM InstrBlock
132 133 134 135
stmtsToInstrs stmts
   = do instrss <- mapM stmtToInstrs stmts
        return (concatOL instrss)

136
stmtToInstrs :: CmmNode e x -> NatM InstrBlock
137
stmtToInstrs stmt = do
138
  dflags <- getDynFlags
139
  case stmt of
140
    CmmComment s   -> return (unitOL (COMMENT s))
Peter Wortmann's avatar
Peter Wortmann committed
141
    CmmTick {}     -> return nilOL
Peter Wortmann's avatar
Peter Wortmann committed
142
    CmmUnwind {}   -> return nilOL
143 144

    CmmAssign reg src
145
      | isFloatType ty -> assignReg_FltCode format reg src
146 147
      | target32Bit (targetPlatform dflags) &&
        isWord64 ty    -> assignReg_I64Code      reg src
148
      | otherwise        -> assignReg_IntCode format reg src
149
        where ty = cmmRegType dflags reg
150
              format = cmmTypeFormat ty
151 152

    CmmStore addr src
153
      | isFloatType ty -> assignMem_FltCode format addr src
154 155
      | target32Bit (targetPlatform dflags) &&
        isWord64 ty      -> assignMem_I64Code      addr src
156
      | otherwise        -> assignMem_IntCode format addr src
157
        where ty = cmmExprType dflags src
158
              format = cmmTypeFormat ty
159

160
    CmmUnsafeForeignCall target result_regs args
161 162
       -> genCCall target result_regs args

163
    CmmBranch id          -> genBranch id
164 165 166 167
    CmmCondBranch arg true false _ -> do
      b1 <- genCondJump true arg
      b2 <- genBranch false
      return (b1 `appOL` b2)
168 169
    CmmSwitch arg ids -> do dflags <- getDynFlags
                            genSwitch dflags arg ids
170 171 172
    CmmCall { cml_target = arg } -> genJump arg
    _ ->
      panic "stmtToInstrs: statement should have been cps'd away"
173 174 175 176


--------------------------------------------------------------------------------
-- | 'InstrBlock's are the insn sequences generated by the insn selectors.
177 178
--      They are really trees of insns to facilitate fast appending, where a
--      left-to-right traversal yields the insns in the correct order.
179
--
180 181
type InstrBlock
        = OrdList Instr
182 183 184


-- | Register's passed up the tree.  If the stix code forces the register
185 186 187
--      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.
188 189
--
data Register
190 191
        = Fixed Format Reg InstrBlock
        | Any   Format (Reg -> InstrBlock)
192 193


194 195 196
swizzleRegisterRep :: Register -> Format -> Register
swizzleRegisterRep (Fixed _ reg code) format = Fixed format reg code
swizzleRegisterRep (Any _ codefn)     format = Any   format codefn
197 198 199


-- | Grab the Reg for a CmmReg
200
getRegisterReg :: Platform -> CmmReg -> Reg
201

202
getRegisterReg _ (CmmLocal (LocalReg u pk))
203
  = RegVirtual $ mkVirtualReg u (cmmTypeFormat pk)
204

205 206
getRegisterReg platform (CmmGlobal mid)
  = case globalRegMaybe platform mid of
207
        Just reg -> RegReal reg
208 209 210 211
        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 ...
212 213

-- | Convert a BlockId to some CmmStatic data
214 215 216
jumpTableEntry :: DynFlags -> Maybe BlockId -> CmmStatic
jumpTableEntry dflags Nothing = CmmStaticLit (CmmInt 0 (wordWidth dflags))
jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
217
    where blockLabel = mkAsmTempLabel (getUnique blockid)
218 219 220 221 222 223 224 225



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

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

231
mangleIndexTree _ _
232
        = panic "PPC.CodeGen.mangleIndexTree: no match"
233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249

-- -----------------------------------------------------------------------------
--  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.
-}

250 251 252 253 254 255 256 257
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
258 259


260
-- | Compute an expression into a register, but
261
--      we don't mind which one it is.
262 263 264 265 266
getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg expr = do
  r <- getRegister expr
  case r of
    Any rep code -> do
267 268 269 270
        tmp <- getNewRegNat rep
        return (tmp, code tmp)
    Fixed _ reg code ->
        return (reg, code)
271 272 273

getI64Amodes :: CmmExpr -> NatM (AddrMode, AddrMode, InstrBlock)
getI64Amodes addrTree = do
274
    Amode hi_addr addr_code <- getAmode D addrTree
275 276 277 278 279 280 281 282 283 284 285
    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
286 287 288
        ChildCode64 vcode rlo <- iselExpr64 valueTree
        let
                rhi = getHiVRegFromLo rlo
289

290 291 292 293
                -- 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)
294 295 296


assignReg_I64Code :: CmmReg  -> CmmExpr -> NatM InstrBlock
297
assignReg_I64Code (CmmLocal (LocalReg u_dst _)) valueTree = do
298
   ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
299
   let
300
         r_dst_lo = RegVirtual $ mkVirtualReg u_dst II32
301 302 303 304 305 306 307 308
         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
     )

309
assignReg_I64Code _ _
310 311 312 313 314 315 316 317 318
   = 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
319
    return $ ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)
320 321 322
                         rlo

iselExpr64 (CmmReg (CmmLocal (LocalReg vu ty))) | isWord64 ty
323
   = return (ChildCode64 nilOL (RegVirtual $ mkVirtualReg vu II32))
324 325 326 327

iselExpr64 (CmmLit (CmmInt i _)) = do
  (rlo,rhi) <- getNewRegPairNat II32
  let
328
        half0 = fromIntegral (fromIntegral i :: Word16)
329 330 331
        half1 = fromIntegral (fromIntegral (i `shiftR` 16) :: Word16)
        half2 = fromIntegral (fromIntegral (i `shiftR` 32) :: Word16)
        half3 = fromIntegral (fromIntegral (i `shiftR` 48) :: Word16)
332 333 334 335 336

        code = toOL [
                LIS rlo (ImmInt half1),
                OR rlo rlo (RIImm $ ImmInt half0),
                LIS rhi (ImmInt half3),
337
                OR rhi rhi (RIImm $ ImmInt half2)
338
                ]
339 340 341 342 343 344 345
  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
346 347 348 349 350 351
        r1hi = getHiVRegFromLo r1lo
        r2hi = getHiVRegFromLo r2lo
        code =  code1 `appOL`
                code2 `appOL`
                toOL [ ADDC rlo r1lo r2lo,
                       ADDE rhi r1hi r2hi ]
352 353
   return (ChildCode64 code rlo)

354 355 356 357 358 359 360 361 362 363 364 365 366
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`
                toOL [ SUBFC rlo r2lo r1lo,
                       SUBFE rhi r2hi r1hi ]
   return (ChildCode64 code rlo)

367 368 369 370 371 372 373 374
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
iselExpr64 expr
375
   = pprPanic "iselExpr64(powerpc)" (pprExpr expr)
376 377 378 379



getRegister :: CmmExpr -> NatM Register
380
getRegister e = do dflags <- getDynFlags
381 382 383
                   getRegister' dflags e

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

385
getRegister' dflags (CmmReg (CmmGlobal PicBaseReg))
386 387 388 389
  | 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)
390
  | target32Bit (targetPlatform dflags) = do
391 392
      reg <- getPicBaseNat $ archWordFormat (target32Bit (targetPlatform dflags))
      return (Fixed (archWordFormat (target32Bit (targetPlatform dflags)))
393 394
                    reg nilOL)
  | otherwise = return (Fixed II64 toc nilOL)
pho@cielonegro.org's avatar
pho@cielonegro.org committed
395

396
getRegister' dflags (CmmReg reg)
397
  = return (Fixed (cmmTypeFormat (cmmRegType dflags reg))
398
                  (getRegisterReg (targetPlatform dflags) reg) nilOL)
399

400
getRegister' dflags tree@(CmmRegOff _ _)
401
  = getRegister' dflags (mangleIndexTree dflags tree)
402 403 404 405

    -- for 32-bit architectuers, support some 64 -> 32 bit conversions:
    -- TO_W_(x), TO_W_(x >> 32)

406 407 408
getRegister' dflags (CmmMachOp (MO_UU_Conv W64 W32)
                     [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]])
 | target32Bit (targetPlatform dflags) = do
409 410 411
  ChildCode64 code rlo <- iselExpr64 x
  return $ Fixed II32 (getHiVRegFromLo rlo) code

412 413 414
getRegister' dflags (CmmMachOp (MO_SS_Conv W64 W32)
                     [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]])
 | target32Bit (targetPlatform dflags) = do
415 416 417
  ChildCode64 code rlo <- iselExpr64 x
  return $ Fixed II32 (getHiVRegFromLo rlo) code

418 419
getRegister' dflags (CmmMachOp (MO_UU_Conv W64 W32) [x])
 | target32Bit (targetPlatform dflags) = do
420 421 422
  ChildCode64 code rlo <- iselExpr64 x
  return $ Fixed II32 rlo code

423 424
getRegister' dflags (CmmMachOp (MO_SS_Conv W64 W32) [x])
 | target32Bit (targetPlatform dflags) = do
425
  ChildCode64 code rlo <- iselExpr64 x
426
  return $ Fixed II32 rlo code
427

428
getRegister' dflags (CmmLoad mem pk)
429
 | not (isWord64 pk) = do
430
        let platform = targetPlatform dflags
431
        Amode addr addr_code <- getAmode D mem
432
        let code dst = ASSERT((targetClassOfReg platform dst == RcDouble) == isFloatType pk)
433 434
                       addr_code `snocOL` LD format dst addr
        return (Any format code)
435 436 437 438 439
 | 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)

440
          where format = cmmTypeFormat pk
441 442

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

447 448 449 450
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))

451 452
-- Note: there is no Load Byte Arithmetic instruction, so no signed case here

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

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

461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476
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
    Amode addr addr_code <- getAmode D mem
    return (Any II64 (\dst -> addr_code `snocOL` LA II32 dst addr))

477
getRegister' dflags (CmmMachOp mop [x]) -- unary MachOps
478 479 480 481 482 483 484 485 486 487 488 489 490
  = 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
491
        | from == to    -> conversionNop (intFormat to) x
492 493

        -- narrowing is a nop: we treat the high bits as undefined
494 495
      MO_SS_Conv W64 to
        | arch32    -> panic "PPC.CodeGen.getRegister no 64 bit int register"
496
        | otherwise -> conversionNop (intFormat to) x
497
      MO_SS_Conv W32 to
498
        | arch32    -> conversionNop (intFormat to) x
499 500 501 502 503
        | otherwise -> case to of
            W64 -> triv_ucode_int to (EXTS II32)
            W16 -> conversionNop II16 x
            W8  -> conversionNop II8 x
            _   -> panic "PPC.CodeGen.getRegister: no match"
504 505 506 507 508
      MO_SS_Conv W16 W8 -> conversionNop II8 x
      MO_SS_Conv W8  to -> triv_ucode_int to (EXTS II8)
      MO_SS_Conv W16 to -> triv_ucode_int to (EXTS II16)

      MO_UU_Conv from to
509
        | from == to -> conversionNop (intFormat to) x
510
        -- narrowing is a nop: we treat the high bits as undefined
511 512
      MO_UU_Conv W64 to
        | arch32    -> panic "PPC.CodeGen.getRegister no 64 bit target"
513
        | otherwise -> conversionNop (intFormat to) x
514
      MO_UU_Conv W32 to
515
        | arch32    -> conversionNop (intFormat to) x
516 517 518 519 520 521
        | otherwise ->
          case to of
           W64 -> trivialCode to False AND x (CmmLit (CmmInt 4294967295 W64))
           W16 -> conversionNop II16 x
           W8  -> conversionNop II8 x
           _   -> panic "PPC.CodeGen.getRegister: no match"
522 523
      MO_UU_Conv W16 W8 -> conversionNop II8 x
      MO_UU_Conv W8 to  -> trivialCode to False AND x (CmmLit (CmmInt 255 W32))
524 525
      MO_UU_Conv W16 to -> trivialCode to False AND x (CmmLit (CmmInt 65535 W32))
      _ -> panic "PPC.CodeGen.getRegister: no match"
526 527

    where
528 529
        triv_ucode_int   width instr = trivialUCode (intFormat    width) instr x
        triv_ucode_float width instr = trivialUCode (floatFormat  width) instr x
530

531
        conversionNop new_format expr
532
            = do e_code <- getRegister' dflags expr
533
                 return (swizzleRegisterRep e_code new_format)
534
        arch32 = target32Bit $ targetPlatform dflags
535

536
getRegister' dflags (CmmMachOp mop [x, y]) -- dyadic PrimOps
537
  = case mop of
538 539 540 541 542 543
      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
544

545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566
      MO_Eq rep -> condIntReg EQQ  (extendUExpr dflags rep x)
                                   (extendUExpr dflags rep y)
      MO_Ne rep -> condIntReg NE   (extendUExpr dflags rep x)
                                   (extendUExpr dflags rep y)

      MO_S_Gt rep -> condIntReg GTT  (extendSExpr dflags rep x)
                                     (extendSExpr dflags rep y)
      MO_S_Ge rep -> condIntReg GE   (extendSExpr dflags rep x)
                                     (extendSExpr dflags rep y)
      MO_S_Lt rep -> condIntReg LTT  (extendSExpr dflags rep x)
                                     (extendSExpr dflags rep y)
      MO_S_Le rep -> condIntReg LE   (extendSExpr dflags rep x)
                                     (extendSExpr dflags rep y)

      MO_U_Gt rep -> condIntReg GU   (extendUExpr dflags rep x)
                                     (extendUExpr dflags rep y)
      MO_U_Ge rep -> condIntReg GEU  (extendUExpr dflags rep x)
                                     (extendUExpr dflags rep y)
      MO_U_Lt rep -> condIntReg LU   (extendUExpr dflags rep x)
                                     (extendUExpr dflags rep y)
      MO_U_Le rep -> condIntReg LEU  (extendUExpr dflags rep x)
                                     (extendUExpr dflags rep y)
567 568 569 570 571

      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
572

573 574 575 576
         -- optimize addition with 32-bit immediate
         -- (needed for PIC)
      MO_Add W32 ->
        case y of
577
          CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate W32 True imm
578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594
            -> 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 ->
        case y of    -- subfi ('substract from' with immediate) doesn't exist
          CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate rep True (-imm)
            -> trivialCode rep True ADD x (CmmLit $ CmmInt (-imm) immrep)
595
          _ -> trivialCodeNoImm' (intFormat rep) SUBF y x
596

597 598 599
      MO_Mul rep
       | arch32    -> trivialCode rep True MULLW x y
       | otherwise -> trivialCode rep True MULLD x y
600 601

      MO_S_MulMayOflo W32 -> trivialCodeNoImm' II32 MULLW_MayOflo x y
602
      MO_S_MulMayOflo W64 -> trivialCodeNoImm' II64 MULLD_MayOflo x y
603

604
      MO_S_MulMayOflo _ -> panic "S_MulMayOflo: (II8/16) not implemented"
605
      MO_U_MulMayOflo _ -> panic "U_MulMayOflo: not implemented"
606

607
      MO_S_Quot rep
608
       | arch32     -> trivialCodeNoImm' (intFormat rep) DIVW
609
                (extendSExpr dflags rep x) (extendSExpr dflags rep y)
610
       | otherwise  -> trivialCodeNoImm' (intFormat rep) DIVD
611 612
                (extendSExpr dflags rep x) (extendSExpr dflags rep y)
      MO_U_Quot rep
613
       | arch32     -> trivialCodeNoImm' (intFormat rep) DIVWU
614
                (extendUExpr dflags rep x) (extendUExpr dflags rep y)
615
       | otherwise  -> trivialCodeNoImm' (intFormat rep) DIVDU
616 617 618 619 620 621 622 623 624 625 626 627
                (extendUExpr dflags rep x) (extendUExpr dflags rep y)

      MO_S_Rem rep
       | arch32    -> remainderCode rep DIVW (extendSExpr dflags rep x)
                                             (extendSExpr dflags rep y)
       | otherwise -> remainderCode rep DIVD (extendSExpr dflags rep x)
                                             (extendSExpr dflags rep y)
      MO_U_Rem rep
       | arch32    -> remainderCode rep DIVWU (extendSExpr dflags rep x)
                                              (extendSExpr dflags rep y)
       | otherwise -> remainderCode rep DIVDU (extendSExpr dflags rep x)
                                              (extendSExpr dflags rep y)
628

629 630 631 632 633 634 635 636 637 638
      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
639 640 641
      MO_Or rep    -> trivialCode rep False OR x y
      MO_Xor rep   -> trivialCode rep False XOR x y

642 643 644
      MO_Shl rep   -> shiftCode rep SL x y
      MO_S_Shr rep -> shiftCode rep SRA (extendSExpr dflags rep x) y
      MO_U_Shr rep -> shiftCode rep SR (extendUExpr dflags rep x) y
645
      _         -> panic "PPC.CodeGen.getRegister: no match"
646 647

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

651 652
    arch32 = target32Bit $ targetPlatform dflags

653
getRegister' _ (CmmLit (CmmInt i rep))
654 655
  | Just imm <- makeImmediate rep True i
  = let
656
        code dst = unitOL (LI dst imm)
657
    in
658
        return (Any (intFormat rep) code)
659

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

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

693
getRegister' _ other = pprPanic "getRegister(ppc)" (pprExpr other)
694

695
    -- extend?Rep: wrap integer expression of type rep
696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719
    -- in a conversion to II32 or II64 resp.
extendSExpr :: DynFlags -> Width -> CmmExpr -> CmmExpr
extendSExpr dflags W32 x
 | target32Bit (targetPlatform dflags) = x

extendSExpr dflags W64 x
 | not (target32Bit (targetPlatform dflags)) = x

extendSExpr dflags rep x =
    let size = if target32Bit $ targetPlatform dflags
               then W32
               else W64
    in CmmMachOp (MO_SS_Conv rep size) [x]

extendUExpr :: DynFlags -> Width -> CmmExpr -> CmmExpr
extendUExpr dflags W32 x
 | target32Bit (targetPlatform dflags) = x
extendUExpr dflags W64 x
 | not (target32Bit (targetPlatform dflags)) = x
extendUExpr dflags rep x =
    let size = if target32Bit $ targetPlatform dflags
               then W32
               else W64
    in CmmMachOp (MO_UU_Conv rep size) [x]
720 721 722 723

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

724 725
data Amode
        = Amode AddrMode InstrBlock
726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744

{-
Now, given a tree (the argument to an CmmLoad) that references memory,
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) ...
-}

745
data InstrForm = D | DS
746

747 748 749 750 751 752
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 _)])
753 754 755 756 757 758
  | Just off <- makeImmediate W32 True (-i)
  = do
        (reg, code) <- getSomeReg x
        return (Amode (AddrRegImm reg off) code)


759
getAmode _ (CmmMachOp (MO_Add W32) [x, CmmLit (CmmInt i _)])
760 761 762 763 764
  | Just off <- makeImmediate W32 True i
  = do
        (reg, code) <- getSomeReg x
        return (Amode (AddrRegImm reg off) code)

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 798 799 800 801 802 803
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')

804 805
   -- optimize addition with 32-bit immediate
   -- (needed for PIC)
806
getAmode _ (CmmMachOp (MO_Add W32) [x, CmmLit lit])
807
  = do
808
        dflags <- getDynFlags
809 810
        (src, srcCode) <- getSomeReg x
        let imm = litToImm lit
811 812 813 814 815 816 817 818 819 820 821 822 823 824
        case () of
            _ | OSAIX <- platformOS (targetPlatform dflags)
              , 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
825

826
getAmode _ (CmmLit lit)
827
  = do
828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851
        dflags <- getDynFlags
        case platformArch $ targetPlatform dflags of
             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))
852

853
getAmode _ (CmmMachOp (MO_Add W64) [x, y])
854 855 856 857
  = do
        (regX, codeX) <- getSomeReg x
        (regY, codeY) <- getSomeReg y
        return (Amode (AddrRegReg regX regY) (codeX `appOL` codeY))
858

859
getAmode _ other
860 861 862 863 864 865 866 867
  = do
        (reg, code) <- getSomeReg other
        let
            off  = ImmInt 0
        return (Amode (AddrRegImm reg off) code)


--  The 'CondCode' type:  Condition codes passed up the tree.
868 869
data CondCode
        = CondCode Bool Cond InstrBlock
870 871 872 873 874 875

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

getCondCode :: CmmExpr -> NatM CondCode

-- almost the same as everywhere else - but we need to
876
-- extend small integers to 32 bit or 64 bit first
877 878

getCondCode (CmmMachOp mop [x, y])
879 880 881
  = do
    dflags <- getDynFlags
    case mop of
882 883 884 885 886 887 888 889 890 891 892 893 894 895
      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

896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917
      MO_Eq rep -> condIntCode EQQ  (extendUExpr dflags rep x)
                                    (extendUExpr dflags rep y)
      MO_Ne rep -> condIntCode NE   (extendUExpr dflags rep x)
                                    (extendUExpr dflags rep y)

      MO_S_Gt rep -> condIntCode GTT  (extendSExpr dflags rep x)
                                      (extendSExpr dflags rep y)
      MO_S_Ge rep -> condIntCode GE   (extendSExpr dflags rep x)
                                      (extendSExpr dflags rep y)
      MO_S_Lt rep -> condIntCode LTT  (extendSExpr dflags rep x)
                                      (extendSExpr dflags rep y)
      MO_S_Le rep -> condIntCode LE   (extendSExpr dflags rep x)
                                      (extendSExpr dflags rep y)

      MO_U_Gt rep -> condIntCode GU   (extendSExpr dflags rep x)
                                      (extendSExpr dflags rep y)
      MO_U_Ge rep -> condIntCode GEU  (extendSExpr dflags rep x)
                                      (extendSExpr dflags rep y)
      MO_U_Lt rep -> condIntCode LU   (extendSExpr dflags rep x)
                                      (extendSExpr dflags rep y)
      MO_U_Le rep -> condIntCode LEU  (extendSExpr dflags rep x)
                                      (extendSExpr dflags rep y)
918

919
      _ -> pprPanic "getCondCode(powerpc)" (pprMachOp mop)
920

921
getCondCode _ = panic "getCondCode(2)(powerpc)"
922 923 924 925 926 927 928


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

condIntCode, condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode

929 930 931 932 933 934 935 936 937 938 939
-- optimize pointer tag checks. Operation andi. sets condition register
-- so cmpi ..., 0 is redundant.
condIntCode cond (CmmMachOp (MO_And _) [x, CmmLit (CmmInt imm rep)])
                 (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')

940 941 942 943
condIntCode cond x (CmmLit (CmmInt y rep))
  | Just src2 <- makeImmediate rep (not $ condUnsigned cond) y
  = do
        (src1, code) <- getSomeReg x
944
        dflags <- getDynFlags
945
        let format = archWordFormat $ target32Bit $ targetPlatform dflags
946
            code' = code `snocOL`
947
              (if condUnsigned cond then CMPL else CMP) format src1 (RIImm src2)
948 949 950 951