    {-# LANGUAGE CPP #-}

    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

    -----------------------------------------------------------------------------
    --
    -- Machine-dependent assembly language
    --
    -- (c) The University of Glasgow 1993-2004
    --
    -----------------------------------------------------------------------------

    #include "HsVersions.h"

    module GHC.CmmToAsm.PPC.Instr
       ( Instr(..)
       , RI(..)
       , archWordFormat
       , stackFrameHeaderSize
       , maxSpillSlots
       , allocMoreStack
       , makeFarBranches
       , mkJumpInstr
       , mkLoadInstr
       , mkSpillInstr
       , patchJumpInstr
       , patchRegsOfInstr
       , jumpDestsOfInstr
       , takeRegRegMoveInstr
       , takeDeltaInstr
       , mkRegRegMoveInstr
       , mkStackAllocInstr
       , mkStackDeallocInstr
       , regUsageOfInstr
       , isJumpishInstr
       , isMetaInstr
       )
    where

    import GHC.Prelude

    import GHC.CmmToAsm.PPC.Regs
    import GHC.CmmToAsm.PPC.Cond
    import GHC.CmmToAsm.Types
    import GHC.CmmToAsm.Instr (RegUsage(..), noUsage)
    import GHC.CmmToAsm.Format
    import GHC.CmmToAsm.Reg.Target
    import GHC.CmmToAsm.Config
    import GHC.Platform.Reg.Class
    import GHC.Platform.Reg

    import GHC.Platform.Regs
    import GHC.Cmm.BlockId
    import GHC.Cmm.Dataflow.Collections
    import GHC.Cmm.Dataflow.Label
    import GHC.Cmm
    import GHC.Cmm.Info
    import GHC.Data.FastString
    import GHC.Cmm.CLabel
    import GHC.Utils.Panic
    import GHC.Platform
    import GHC.Types.Unique.FM (listToUFM, lookupUFM)
    import GHC.Types.Unique.Supply

    import Control.Monad (replicateM)
    import Data.Maybe (fromMaybe)

    --------------------------------------------------------------------------------
    -- Format of a PPC memory address.
    --
    archWordFormat :: Bool -> Format
    archWordFormat :: Bool -> Format
    archWordFormat Bool
    is32Bit
     | Bool
    is32Bit   = Format
    II32
     | Bool
    otherwise = Format
    II64

    mkStackAllocInstr :: Platform -> Int -> [Instr]
    mkStackAllocInstr :: Platform -> Int -> [Instr]
    mkStackAllocInstr Platform
    platform Int
    amount
      = Platform -> Int -> [Instr]
    mkStackAllocInstr' Platform
    platform (-Int
    amount)

    mkStackDeallocInstr :: Platform -> Int -> [Instr]
    mkStackDeallocInstr :: Platform -> Int -> [Instr]
    mkStackDeallocInstr Platform
    platform Int
    amount
      = Platform -> Int -> [Instr]
    mkStackAllocInstr' Platform
    platform Int
    amount

    mkStackAllocInstr' :: Platform -> Int -> [Instr]
    mkStackAllocInstr' :: Platform -> Int -> [Instr]
    mkStackAllocInstr' Platform
    platform Int
    amount
      | forall a. Integral a => a -> Bool
    fits16Bits Int
    amount
      = [ Format -> Reg -> AddrMode -> Instr
    LD Format
    fmt Reg
    r0 (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    sp Imm
    zero)
        , Format -> Reg -> AddrMode -> Instr
    STU Format
    fmt Reg
    r0 (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    sp Imm
    immAmount)
        ]
      | Bool
    otherwise
      = [ Format -> Reg -> AddrMode -> Instr
    LD Format
    fmt Reg
    r0 (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    sp Imm
    zero)
        , Reg -> Reg -> Imm -> Instr
    ADDIS Reg
    tmp Reg
    sp (Imm -> Imm
    HA Imm
    immAmount)
        , Reg -> Reg -> RI -> Instr
    ADD Reg
    tmp Reg
    tmp (Imm -> RI
    RIImm (Imm -> Imm
    LO Imm
    immAmount))
        , Format -> Reg -> AddrMode -> Instr
    STU Format
    fmt Reg
    r0 (Reg -> Reg -> AddrMode
    AddrRegReg Reg
    sp Reg
    tmp)
        ]
      where
        fmt :: Format
    fmt = Width -> Format
    intFormat forall a b. (a -> b) -> a -> b
    $ Int -> Width
    widthFromBytes (Platform -> Int
    platformWordSizeInBytes Platform
    platform)
        zero :: Imm
    zero = Int -> Imm
    ImmInt Int
    0
        tmp :: Reg
    tmp = Platform -> Reg
    tmpReg Platform
    platform
        immAmount :: Imm
    immAmount = Int -> Imm
    ImmInt Int
    amount

    --
    -- See note [extra spill slots] in X86/Instr.hs
    --
    allocMoreStack
      :: Platform
      -> Int
      -> NatCmmDecl statics GHC.CmmToAsm.PPC.Instr.Instr
      -> UniqSM (NatCmmDecl statics GHC.CmmToAsm.PPC.Instr.Instr, [(BlockId,BlockId)])

    allocMoreStack :: forall statics.
    Platform
    -> Int
    -> NatCmmDecl statics Instr
    -> UniqSM (NatCmmDecl statics Instr, [(BlockId, BlockId)])
    allocMoreStack Platform
    _ Int
    _ top :: NatCmmDecl statics Instr
    top@(CmmData Section
    _ statics
    _) = forall (m :: * -> *) a. Monad m => a -> m a
    return (NatCmmDecl statics Instr
    top,[])
    allocMoreStack Platform
    platform Int
    slots (CmmProc LabelMap RawCmmStatics
    info CLabel
    lbl [GlobalReg]
    live (ListGraph [GenBasicBlock Instr]
    code)) = do
        let
            infos :: [KeyOf LabelMap]
    infos   = forall (map :: * -> *) a. IsMap map => map a -> [KeyOf map]
    mapKeys LabelMap RawCmmStatics
    info
            entries :: [KeyOf LabelMap]
    entries = case [GenBasicBlock Instr]
    code of
                        [] -> [KeyOf LabelMap]
    infos
                        BasicBlock BlockId
    entry [Instr]
    _ : [GenBasicBlock Instr]
    _ -- first block is the entry point
                            | BlockId
    entry forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KeyOf LabelMap]
    infos -> [KeyOf LabelMap]
    infos
                            | Bool
    otherwise          -> BlockId
    entry forall a. a -> [a] -> [a]
    : [KeyOf LabelMap]
    infos

        [Unique]
    uniqs <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM (forall (t :: * -> *) a. Foldable t => t a -> Int
    length [KeyOf LabelMap]
    entries) forall (m :: * -> *). MonadUnique m => m Unique
    getUniqueM

        let
            delta :: Int
    delta = ((Int
    x forall a. Num a => a -> a -> a
    + Int
    stackAlign forall a. Num a => a -> a -> a
    - Int
    1) forall a. Integral a => a -> a -> a
    `quot` Int
    stackAlign) forall a. Num a => a -> a -> a
    * Int
    stackAlign -- round up
                where x :: Int
    x = Int
    slots forall a. Num a => a -> a -> a
    * Int
    spillSlotSize -- sp delta

            alloc :: [Instr]
    alloc   = Platform -> Int -> [Instr]
    mkStackAllocInstr   Platform
    platform Int
    delta
            dealloc :: [Instr]
    dealloc = Platform -> Int -> [Instr]
    mkStackDeallocInstr Platform
    platform Int
    delta

            retargetList :: [(BlockId, BlockId)]
    retargetList = (forall a b. [a] -> [b] -> [(a, b)]
    zip [KeyOf LabelMap]
    entries (forall a b. (a -> b) -> [a] -> [b]
    map Unique -> BlockId
    mkBlockId [Unique]
    uniqs))

            new_blockmap :: LabelMap BlockId
            new_blockmap :: LabelMap BlockId
    new_blockmap = forall (map :: * -> *) a. IsMap map => [(KeyOf map, a)] -> map a
    mapFromList [(BlockId, BlockId)]
    retargetList

            insert_stack_insns :: GenBasicBlock Instr -> [GenBasicBlock Instr]
    insert_stack_insns (BasicBlock BlockId
    id [Instr]
    insns)
                | Just BlockId
    new_blockid <- forall (map :: * -> *) a.
    IsMap map =>
    KeyOf map -> map a -> Maybe a
    mapLookup BlockId
    id LabelMap BlockId
    new_blockmap
                    = [ forall i. BlockId -> [i] -> GenBasicBlock i
    BasicBlock BlockId
    id forall a b. (a -> b) -> a -> b
    $ [Instr]
    alloc forall a. [a] -> [a] -> [a]
    ++ [Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    new_blockid forall a. Maybe a
    Nothing]
                      , forall i. BlockId -> [i] -> GenBasicBlock i
    BasicBlock BlockId
    new_blockid [Instr]
    block'
                      ]
                | Bool
    otherwise
                    = [ forall i. BlockId -> [i] -> GenBasicBlock i
    BasicBlock BlockId
    id [Instr]
    block' ]
                where
                  block' :: [Instr]
    block' = forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Instr -> [Instr] -> [Instr]
    insert_dealloc [] [Instr]
    insns

            insert_dealloc :: Instr -> [Instr] -> [Instr]
    insert_dealloc Instr
    insn [Instr]
    r
                -- BCTR might or might not be a non-local jump. For
                -- "labeled-goto" we use JMP, and for "computed-goto" we
                -- use MTCTR followed by BCTR. See 'PPC.CodeGen.genJump'.
                = case Instr
    insn of
                    JMP CLabel
    _ [Reg]
    _           -> [Instr]
    dealloc forall a. [a] -> [a] -> [a]
    ++ (Instr
    insn forall a. a -> [a] -> [a]
    : [Instr]
    r)
                    BCTR [] Maybe CLabel
    Nothing [Reg]
    _ -> [Instr]
    dealloc forall a. [a] -> [a] -> [a]
    ++ (Instr
    insn forall a. a -> [a] -> [a]
    : [Instr]
    r)
                    BCTR [Maybe BlockId]
    ids Maybe CLabel
    label [Reg]
    rs -> [Maybe BlockId] -> Maybe CLabel -> [Reg] -> Instr
    BCTR (forall a b. (a -> b) -> [a] -> [b]
    map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap BlockId -> BlockId
    retarget) [Maybe BlockId]
    ids) Maybe CLabel
    label [Reg]
    rs forall a. a -> [a] -> [a]
    : [Instr]
    r
                    BCCFAR Cond
    cond BlockId
    b Maybe Bool
    p   -> Cond -> BlockId -> Maybe Bool -> Instr
    BCCFAR Cond
    cond (BlockId -> BlockId
    retarget BlockId
    b) Maybe Bool
    p forall a. a -> [a] -> [a]
    : [Instr]
    r
                    BCC    Cond
    cond BlockId
    b Maybe Bool
    p   -> Cond -> BlockId -> Maybe Bool -> Instr
    BCC    Cond
    cond (BlockId -> BlockId
    retarget BlockId
    b) Maybe Bool
    p forall a. a -> [a] -> [a]
    : [Instr]
    r
                    Instr
    _                 -> Instr
    insn forall a. a -> [a] -> [a]
    : [Instr]
    r
                -- BL and BCTRL are call-like instructions rather than
                -- jumps, and are used only for C calls.

            retarget :: BlockId -> BlockId
            retarget :: BlockId -> BlockId
    retarget BlockId
    b
                = forall a. a -> Maybe a -> a
    fromMaybe BlockId
    b (forall (map :: * -> *) a.
    IsMap map =>
    KeyOf map -> map a -> Maybe a
    mapLookup BlockId
    b LabelMap BlockId
    new_blockmap)

            new_code :: [GenBasicBlock Instr]
    new_code
                = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap GenBasicBlock Instr -> [GenBasicBlock Instr]
    insert_stack_insns [GenBasicBlock Instr]
    code

        -- in
        forall (m :: * -> *) a. Monad m => a -> m a
    return (forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc LabelMap RawCmmStatics
    info CLabel
    lbl [GlobalReg]
    live (forall i. [GenBasicBlock i] -> ListGraph i
    ListGraph [GenBasicBlock Instr]
    new_code),[(BlockId, BlockId)]
    retargetList)

    -- -----------------------------------------------------------------------------
    -- Machine's assembly language

    -- We have a few common "instructions" (nearly all the pseudo-ops) but
    -- mostly all of 'Instr' is machine-specific.

    -- Register or immediate
    data RI
        = RIReg Reg
        | RIImm Imm

    data Instr
        -- comment pseudo-op
        = COMMENT FastString

        -- location pseudo-op (file, line, col, name)
        | LOCATION Int Int Int String

        -- some static data spat out during code
        -- generation.  Will be extracted before
        -- pretty-printing.
        | LDATA   Section RawCmmStatics

        -- start a new basic block.  Useful during
        -- codegen, removed later.  Preceding
        -- instruction should be a jump, as per the
        -- invariants for a BasicBlock (see Cmm).
        | NEWBLOCK BlockId

        -- specify current stack offset for
        -- benefit of subsequent passes
        | DELTA   Int

        -- Loads and stores.
        | LD      Format Reg AddrMode   -- Load format, dst, src
        | LDFAR   Format Reg AddrMode   -- Load format, dst, src 32 bit offset
        | LDR     Format Reg AddrMode   -- Load and reserve format, dst, src
        | LA      Format Reg AddrMode   -- Load arithmetic format, dst, src
        | ST      Format Reg AddrMode   -- Store format, src, dst
        | STFAR   Format Reg AddrMode   -- Store format, src, dst 32 bit offset
        | STU     Format Reg AddrMode   -- Store with Update format, src, dst
        | STC     Format Reg AddrMode   -- Store conditional format, src, dst
        | LIS     Reg Imm               -- Load Immediate Shifted dst, src
        | LI      Reg Imm               -- Load Immediate dst, src
        | MR      Reg Reg               -- Move Register dst, src -- also for fmr

        | CMP     Format Reg RI         -- format, src1, src2
        | CMPL    Format Reg RI         -- format, src1, src2

        | BCC     Cond BlockId (Maybe Bool) -- cond, block, hint
        | BCCFAR  Cond BlockId (Maybe Bool) -- cond, block, hint
                                        --   hint:
                                        --    Just True:  branch likely taken
                                        --    Just False: branch likely not taken
                                        --    Nothing:    no hint
        | JMP     CLabel [Reg]          -- same as branch,
                                        -- but with CLabel instead of block ID
                                        -- and live global registers
        | MTCTR   Reg
        | BCTR    [Maybe BlockId] (Maybe CLabel) [Reg]
                                        -- with list of local destinations, and
                                        -- jump table location if necessary
        | BL      CLabel [Reg]          -- with list of argument regs
        | BCTRL   [Reg]

        | ADD     Reg Reg RI            -- dst, src1, src2
        | ADDO    Reg Reg Reg           -- add and set overflow
        | ADDC    Reg Reg Reg           -- (carrying) dst, src1, src2
        | ADDE    Reg Reg Reg           -- (extended) dst, src1, src2
        | ADDZE   Reg Reg               -- (to zero extended) dst, src
        | ADDIS   Reg Reg Imm           -- Add Immediate Shifted dst, src1, src2
        | SUBF    Reg Reg Reg           -- dst, src1, src2 ; dst = src2 - src1
        | SUBFO   Reg Reg Reg           -- subtract from and set overflow
        | SUBFC   Reg Reg RI            -- (carrying) dst, src1, src2 ;
                                        -- dst = src2 - src1
        | SUBFE   Reg Reg Reg           -- (extended) dst, src1, src2 ;
                                        -- dst = src2 - src1
        | MULL    Format Reg Reg RI
        | MULLO   Format Reg Reg Reg    -- multiply and set overflow
        | MFOV    Format Reg            -- move overflow bit (1|33) to register
                                        -- pseudo-instruction; pretty printed as
                                        -- mfxer dst
                                        -- extr[w|d]i dst, dst, 1, [1|33]
        | MULHU   Format Reg Reg Reg
        | DIV     Format Bool Reg Reg Reg
        | AND     Reg Reg RI            -- dst, src1, src2
        | ANDC    Reg Reg Reg           -- AND with complement, dst = src1 & ~ src2
        | NAND    Reg Reg Reg           -- dst, src1, src2
        | OR      Reg Reg RI            -- dst, src1, src2
        | ORIS    Reg Reg Imm           -- OR Immediate Shifted dst, src1, src2
        | XOR     Reg Reg RI            -- dst, src1, src2
        | XORIS   Reg Reg Imm           -- XOR Immediate Shifted dst, src1, src2

        | EXTS    Format Reg Reg
        | CNTLZ   Format Reg Reg

        | NEG     Reg Reg
        | NOT     Reg Reg

        | SL      Format Reg Reg RI            -- shift left
        | SR      Format Reg Reg RI            -- shift right
        | SRA     Format Reg Reg RI            -- shift right arithmetic

        | RLWINM  Reg Reg Int Int Int   -- Rotate Left Word Immediate then AND with Mask
        | CLRLI   Format Reg Reg Int    -- clear left immediate (extended mnemonic)
        | CLRRI   Format Reg Reg Int    -- clear right immediate (extended mnemonic)

        | FADD    Format Reg Reg Reg
        | FSUB    Format Reg Reg Reg
        | FMUL    Format Reg Reg Reg
        | FDIV    Format Reg Reg Reg
        | FABS    Reg Reg               -- abs is the same for single and double
        | FNEG    Reg Reg               -- negate is the same for single and double prec.

        | FCMP    Reg Reg

        | FCTIWZ  Reg Reg           -- convert to integer word
        | FCTIDZ  Reg Reg           -- convert to integer double word
        | FCFID   Reg Reg           -- convert from integer double word
        | FRSP    Reg Reg           -- reduce to single precision
                                    -- (but destination is a FP register)

        | CRNOR   Int Int Int       -- condition register nor
        | MFCR    Reg               -- move from condition register

        | MFLR    Reg               -- move from link register
        | FETCHPC Reg               -- pseudo-instruction:
                                    -- bcl to next insn, mflr reg
        | HWSYNC                    -- heavy weight sync
        | ISYNC                     -- instruction synchronize
        | LWSYNC                    -- memory barrier
        | NOP                       -- no operation, PowerPC 64 bit
                                    -- needs this as place holder to
                                    -- reload TOC pointer

    -- | Get the registers that are being used by this instruction.
    -- regUsage doesn't need to do any trickery for jumps and such.
    -- Just state precisely the regs read and written by that insn.
    -- The consequences of control flow transfers, as far as register
    -- allocation goes, are taken care of by the register allocator.
    --
    regUsageOfInstr :: Platform -> Instr -> RegUsage
    regUsageOfInstr :: Platform -> Instr -> RegUsage
    regUsageOfInstr Platform
    platform Instr
    instr
     = case Instr
    instr of
        LD      Format
    _ Reg
    reg AddrMode
    addr       -> ([Reg], [Reg]) -> RegUsage
    usage (AddrMode -> [Reg]
    regAddr AddrMode
    addr, [Reg
    reg])
        LDFAR   Format
    _ Reg
    reg AddrMode
    addr       -> ([Reg], [Reg]) -> RegUsage
    usage (AddrMode -> [Reg]
    regAddr AddrMode
    addr, [Reg
    reg])
        LDR     Format
    _ Reg
    reg AddrMode
    addr       -> ([Reg], [Reg]) -> RegUsage
    usage (AddrMode -> [Reg]
    regAddr AddrMode
    addr, [Reg
    reg])
        LA      Format
    _ Reg
    reg AddrMode
    addr       -> ([Reg], [Reg]) -> RegUsage
    usage (AddrMode -> [Reg]
    regAddr AddrMode
    addr, [Reg
    reg])
        ST      Format
    _ Reg
    reg AddrMode
    addr       -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    reg forall a. a -> [a] -> [a]
    : AddrMode -> [Reg]
    regAddr AddrMode
    addr, [])
        STFAR   Format
    _ Reg
    reg AddrMode
    addr       -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    reg forall a. a -> [a] -> [a]
    : AddrMode -> [Reg]
    regAddr AddrMode
    addr, [])
        STU     Format
    _ Reg
    reg AddrMode
    addr       -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    reg forall a. a -> [a] -> [a]
    : AddrMode -> [Reg]
    regAddr AddrMode
    addr, [])
        STC     Format
    _ Reg
    reg AddrMode
    addr       -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    reg forall a. a -> [a] -> [a]
    : AddrMode -> [Reg]
    regAddr AddrMode
    addr, [])
        LIS     Reg
    reg Imm
    _            -> ([Reg], [Reg]) -> RegUsage
    usage ([], [Reg
    reg])
        LI      Reg
    reg Imm
    _            -> ([Reg], [Reg]) -> RegUsage
    usage ([], [Reg
    reg])
        MR      Reg
    reg1 Reg
    reg2        -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2], [Reg
    reg1])
        CMP     Format
    _ Reg
    reg RI
    ri         -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    reg forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ri,[])
        CMPL    Format
    _ Reg
    reg RI
    ri         -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    reg forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ri,[])
        BCC     Cond
    _ BlockId
    _ Maybe Bool
    _            -> RegUsage
    noUsage
        BCCFAR  Cond
    _ BlockId
    _ Maybe Bool
    _            -> RegUsage
    noUsage
        JMP     CLabel
    _ [Reg]
    regs           -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg]
    regs, [])
        MTCTR   Reg
    reg              -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg],[])
        BCTR    [Maybe BlockId]
    _ Maybe CLabel
    _ [Reg]
    regs         -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg]
    regs, [])
        BL      CLabel
    _ [Reg]
    params         -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg]
    params, Platform -> [Reg]
    callClobberedRegs Platform
    platform)
        BCTRL   [Reg]
    params           -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg]
    params, Platform -> [Reg]
    callClobberedRegs Platform
    platform)

        ADD     Reg
    reg1 Reg
    reg2 RI
    ri     -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    reg2 forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ri, [Reg
    reg1])
        ADDO    Reg
    reg1 Reg
    reg2 Reg
    reg3   -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2,Reg
    reg3], [Reg
    reg1])
        ADDC    Reg
    reg1 Reg
    reg2 Reg
    reg3   -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2,Reg
    reg3], [Reg
    reg1])
        ADDE    Reg
    reg1 Reg
    reg2 Reg
    reg3   -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2,Reg
    reg3], [Reg
    reg1])
        ADDZE   Reg
    reg1 Reg
    reg2        -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2], [Reg
    reg1])
        ADDIS   Reg
    reg1 Reg
    reg2 Imm
    _      -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2], [Reg
    reg1])
        SUBF    Reg
    reg1 Reg
    reg2 Reg
    reg3   -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2,Reg
    reg3], [Reg
    reg1])
        SUBFO   Reg
    reg1 Reg
    reg2 Reg
    reg3   -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2,Reg
    reg3], [Reg
    reg1])
        SUBFC   Reg
    reg1 Reg
    reg2 RI
    ri     -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    reg2 forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ri, [Reg
    reg1])
        SUBFE   Reg
    reg1 Reg
    reg2 Reg
    reg3   -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2,Reg
    reg3], [Reg
    reg1])
        MULL    Format
    _ Reg
    reg1 Reg
    reg2 RI
    ri   -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    reg2 forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ri, [Reg
    reg1])
        MULLO   Format
    _ Reg
    reg1 Reg
    reg2 Reg
    reg3 -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2,Reg
    reg3], [Reg
    reg1])
        MFOV    Format
    _ Reg
    reg            -> ([Reg], [Reg]) -> RegUsage
    usage ([], [Reg
    reg])
        MULHU   Format
    _ Reg
    reg1 Reg
    reg2 Reg
    reg3 -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2,Reg
    reg3], [Reg
    reg1])
        DIV     Format
    _ Bool
    _ Reg
    reg1 Reg
    reg2 Reg
    reg3
                                 -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2,Reg
    reg3], [Reg
    reg1])

        AND     Reg
    reg1 Reg
    reg2 RI
    ri    -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    reg2 forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ri, [Reg
    reg1])
        ANDC    Reg
    reg1 Reg
    reg2 Reg
    reg3  -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2,Reg
    reg3], [Reg
    reg1])
        NAND    Reg
    reg1 Reg
    reg2 Reg
    reg3  -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2,Reg
    reg3], [Reg
    reg1])
        OR      Reg
    reg1 Reg
    reg2 RI
    ri    -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    reg2 forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ri, [Reg
    reg1])
        ORIS    Reg
    reg1 Reg
    reg2 Imm
    _     -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2], [Reg
    reg1])
        XOR     Reg
    reg1 Reg
    reg2 RI
    ri    -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    reg2 forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ri, [Reg
    reg1])
        XORIS   Reg
    reg1 Reg
    reg2 Imm
    _     -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2], [Reg
    reg1])
        EXTS    Format
    _  Reg
    reg1 Reg
    reg2    -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2], [Reg
    reg1])
        CNTLZ   Format
    _  Reg
    reg1 Reg
    reg2    -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2], [Reg
    reg1])
        NEG     Reg
    reg1 Reg
    reg2       -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2], [Reg
    reg1])
        NOT     Reg
    reg1 Reg
    reg2       -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2], [Reg
    reg1])
        SL      Format
    _ Reg
    reg1 Reg
    reg2 RI
    ri  -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    reg2 forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ri, [Reg
    reg1])
        SR      Format
    _ Reg
    reg1 Reg
    reg2 RI
    ri  -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    reg2 forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ri, [Reg
    reg1])
        SRA     Format
    _ Reg
    reg1 Reg
    reg2 RI
    ri  -> ([Reg], [Reg]) -> RegUsage
    usage (Reg
    reg2 forall a. a -> [a] -> [a]
    : RI -> [Reg]
    regRI RI
    ri, [Reg
    reg1])
        RLWINM  Reg
    reg1 Reg
    reg2 Int
    _ Int
    _ Int
    _ -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2], [Reg
    reg1])
        CLRLI   Format
    _ Reg
    reg1 Reg
    reg2 Int
    _   -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2], [Reg
    reg1])
        CLRRI   Format
    _ Reg
    reg1 Reg
    reg2 Int
    _   -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    reg2], [Reg
    reg1])

        FADD    Format
    _ Reg
    r1 Reg
    r2 Reg
    r3      -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r2,Reg
    r3], [Reg
    r1])
        FSUB    Format
    _ Reg
    r1 Reg
    r2 Reg
    r3      -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r2,Reg
    r3], [Reg
    r1])
        FMUL    Format
    _ Reg
    r1 Reg
    r2 Reg
    r3      -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r2,Reg
    r3], [Reg
    r1])
        FDIV    Format
    _ Reg
    r1 Reg
    r2 Reg
    r3      -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r2,Reg
    r3], [Reg
    r1])
        FABS    Reg
    r1 Reg
    r2           -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r2], [Reg
    r1])
        FNEG    Reg
    r1 Reg
    r2           -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r2], [Reg
    r1])
        FCMP    Reg
    r1 Reg
    r2           -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r1,Reg
    r2], [])
        FCTIWZ  Reg
    r1 Reg
    r2           -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r2], [Reg
    r1])
        FCTIDZ  Reg
    r1 Reg
    r2           -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r2], [Reg
    r1])
        FCFID   Reg
    r1 Reg
    r2           -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r2], [Reg
    r1])
        FRSP    Reg
    r1 Reg
    r2           -> ([Reg], [Reg]) -> RegUsage
    usage ([Reg
    r2], [Reg
    r1])
        MFCR    Reg
    reg             -> ([Reg], [Reg]) -> RegUsage
    usage ([], [Reg
    reg])
        MFLR    Reg
    reg             -> ([Reg], [Reg]) -> RegUsage
    usage ([], [Reg
    reg])
        FETCHPC Reg
    reg             -> ([Reg], [Reg]) -> RegUsage
    usage ([], [Reg
    reg])
        Instr
    _                       -> RegUsage
    noUsage
      where
        usage :: ([Reg], [Reg]) -> RegUsage
    usage ([Reg]
    src, [Reg]
    dst) = [Reg] -> [Reg] -> RegUsage
    RU (forall a. (a -> Bool) -> [a] -> [a]
    filter (Platform -> Reg -> Bool
    interesting Platform
    platform) [Reg]
    src)
                              (forall a. (a -> Bool) -> [a] -> [a]
    filter (Platform -> Reg -> Bool
    interesting Platform
    platform) [Reg]
    dst)
        regAddr :: AddrMode -> [Reg]
    regAddr (AddrRegReg Reg
    r1 Reg
    r2) = [Reg
    r1, Reg
    r2]
        regAddr (AddrRegImm Reg
    r1 Imm
    _)  = [Reg
    r1]

        regRI :: RI -> [Reg]
    regRI (RIReg Reg
    r) = [Reg
    r]
        regRI  RI
    _        = []

    interesting :: Platform -> Reg -> Bool
    interesting :: Platform -> Reg -> Bool
    interesting Platform
    _        (RegVirtual VirtualReg
    _)              = Bool
    True
    interesting Platform
    platform (RegReal (RealRegSingle Int
    i)) = Platform -> Int -> Bool
    freeReg Platform
    platform Int
    i
    interesting Platform
    _        (RegReal (RealRegPair{}))
        = forall a. String -> a
    panic String
    "PPC.Instr.interesting: no reg pairs on this arch"

    -- | Apply a given mapping to all the register references in this
    -- instruction.
    patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
    patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
    patchRegsOfInstr Instr
    instr Reg -> Reg
    env
     = case Instr
    instr of
        LD      Format
    fmt Reg
    reg AddrMode
    addr    -> Format -> Reg -> AddrMode -> Instr
    LD Format
    fmt (Reg -> Reg
    env Reg
    reg) (AddrMode -> AddrMode
    fixAddr AddrMode
    addr)
        LDFAR   Format
    fmt Reg
    reg AddrMode
    addr    -> Format -> Reg -> AddrMode -> Instr
    LDFAR Format
    fmt (Reg -> Reg
    env Reg
    reg) (AddrMode -> AddrMode
    fixAddr AddrMode
    addr)
        LDR     Format
    fmt Reg
    reg AddrMode
    addr    -> Format -> Reg -> AddrMode -> Instr
    LDR Format
    fmt (Reg -> Reg
    env Reg
    reg) (AddrMode -> AddrMode
    fixAddr AddrMode
    addr)
        LA      Format
    fmt Reg
    reg AddrMode
    addr    -> Format -> Reg -> AddrMode -> Instr
    LA Format
    fmt (Reg -> Reg
    env Reg
    reg) (AddrMode -> AddrMode
    fixAddr AddrMode
    addr)
        ST      Format
    fmt Reg
    reg AddrMode
    addr    -> Format -> Reg -> AddrMode -> Instr
    ST Format
    fmt (Reg -> Reg
    env Reg
    reg) (AddrMode -> AddrMode
    fixAddr AddrMode
    addr)
        STFAR   Format
    fmt Reg
    reg AddrMode
    addr    -> Format -> Reg -> AddrMode -> Instr
    STFAR Format
    fmt (Reg -> Reg
    env Reg
    reg) (AddrMode -> AddrMode
    fixAddr AddrMode
    addr)
        STU     Format
    fmt Reg
    reg AddrMode
    addr    -> Format -> Reg -> AddrMode -> Instr
    STU Format
    fmt (Reg -> Reg
    env Reg
    reg) (AddrMode -> AddrMode
    fixAddr AddrMode
    addr)
        STC     Format
    fmt Reg
    reg AddrMode
    addr    -> Format -> Reg -> AddrMode -> Instr
    STC Format
    fmt (Reg -> Reg
    env Reg
    reg) (AddrMode -> AddrMode
    fixAddr AddrMode
    addr)
        LIS     Reg
    reg Imm
    imm         -> Reg -> Imm -> Instr
    LIS (Reg -> Reg
    env Reg
    reg) Imm
    imm
        LI      Reg
    reg Imm
    imm         -> Reg -> Imm -> Instr
    LI (Reg -> Reg
    env Reg
    reg) Imm
    imm
        MR      Reg
    reg1 Reg
    reg2       -> Reg -> Reg -> Instr
    MR (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2)
        CMP     Format
    fmt Reg
    reg RI
    ri      -> Format -> Reg -> RI -> Instr
    CMP Format
    fmt (Reg -> Reg
    env Reg
    reg) (RI -> RI
    fixRI RI
    ri)
        CMPL    Format
    fmt Reg
    reg RI
    ri      -> Format -> Reg -> RI -> Instr
    CMPL Format
    fmt (Reg -> Reg
    env Reg
    reg) (RI -> RI
    fixRI RI
    ri)
        BCC     Cond
    cond BlockId
    lbl Maybe Bool
    p      -> Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    cond BlockId
    lbl Maybe Bool
    p
        BCCFAR  Cond
    cond BlockId
    lbl Maybe Bool
    p      -> Cond -> BlockId -> Maybe Bool -> Instr
    BCCFAR Cond
    cond BlockId
    lbl Maybe Bool
    p
        JMP     CLabel
    l [Reg]
    regs          -> CLabel -> [Reg] -> Instr
    JMP CLabel
    l [Reg]
    regs -- global regs will not be remapped
        MTCTR   Reg
    reg             -> Reg -> Instr
    MTCTR (Reg -> Reg
    env Reg
    reg)
        BCTR    [Maybe BlockId]
    targets Maybe CLabel
    lbl [Reg]
    rs  -> [Maybe BlockId] -> Maybe CLabel -> [Reg] -> Instr
    BCTR [Maybe BlockId]
    targets Maybe CLabel
    lbl [Reg]
    rs
        BL      CLabel
    imm [Reg]
    argRegs     -> CLabel -> [Reg] -> Instr
    BL CLabel
    imm [Reg]
    argRegs    -- argument regs
        BCTRL   [Reg]
    argRegs         -> [Reg] -> Instr
    BCTRL [Reg]
    argRegs     -- cannot be remapped
        ADD     Reg
    reg1 Reg
    reg2 RI
    ri    -> Reg -> Reg -> RI -> Instr
    ADD (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) (RI -> RI
    fixRI RI
    ri)
        ADDO    Reg
    reg1 Reg
    reg2 Reg
    reg3  -> Reg -> Reg -> Reg -> Instr
    ADDO (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) (Reg -> Reg
    env Reg
    reg3)
        ADDC    Reg
    reg1 Reg
    reg2 Reg
    reg3  -> Reg -> Reg -> Reg -> Instr
    ADDC (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) (Reg -> Reg
    env Reg
    reg3)
        ADDE    Reg
    reg1 Reg
    reg2 Reg
    reg3  -> Reg -> Reg -> Reg -> Instr
    ADDE (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) (Reg -> Reg
    env Reg
    reg3)
        ADDZE   Reg
    reg1 Reg
    reg2       -> Reg -> Reg -> Instr
    ADDZE (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2)
        ADDIS   Reg
    reg1 Reg
    reg2 Imm
    imm   -> Reg -> Reg -> Imm -> Instr
    ADDIS (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) Imm
    imm
        SUBF    Reg
    reg1 Reg
    reg2 Reg
    reg3  -> Reg -> Reg -> Reg -> Instr
    SUBF (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) (Reg -> Reg
    env Reg
    reg3)
        SUBFO   Reg
    reg1 Reg
    reg2 Reg
    reg3  -> Reg -> Reg -> Reg -> Instr
    SUBFO (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) (Reg -> Reg
    env Reg
    reg3)
        SUBFC   Reg
    reg1 Reg
    reg2 RI
    ri    -> Reg -> Reg -> RI -> Instr
    SUBFC (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) (RI -> RI
    fixRI RI
    ri)
        SUBFE   Reg
    reg1 Reg
    reg2 Reg
    reg3  -> Reg -> Reg -> Reg -> Instr
    SUBFE (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) (Reg -> Reg
    env Reg
    reg3)
        MULL    Format
    fmt Reg
    reg1 Reg
    reg2 RI
    ri
                                -> Format -> Reg -> Reg -> RI -> Instr
    MULL Format
    fmt (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) (RI -> RI
    fixRI RI
    ri)
        MULLO   Format
    fmt Reg
    reg1 Reg
    reg2 Reg
    reg3
                                -> Format -> Reg -> Reg -> Reg -> Instr
    MULLO Format
    fmt (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) (Reg -> Reg
    env Reg
    reg3)
        MFOV    Format
    fmt Reg
    reg         -> Format -> Reg -> Instr
    MFOV Format
    fmt (Reg -> Reg
    env Reg
    reg)
        MULHU   Format
    fmt Reg
    reg1 Reg
    reg2 Reg
    reg3
                                -> Format -> Reg -> Reg -> Reg -> Instr
    MULHU Format
    fmt (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) (Reg -> Reg
    env Reg
    reg3)
        DIV     Format
    fmt Bool
    sgn Reg
    reg1 Reg
    reg2 Reg
    reg3
                                -> Format -> Bool -> Reg -> Reg -> Reg -> Instr
    DIV Format
    fmt Bool
    sgn (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) (Reg -> Reg
    env Reg
    reg3)

        AND     Reg
    reg1 Reg
    reg2 RI
    ri    -> Reg -> Reg -> RI -> Instr
    AND (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) (RI -> RI
    fixRI RI
    ri)
        ANDC    Reg
    reg1 Reg
    reg2 Reg
    reg3  -> Reg -> Reg -> Reg -> Instr
    ANDC (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) (Reg -> Reg
    env Reg
    reg3)
        NAND    Reg
    reg1 Reg
    reg2 Reg
    reg3  -> Reg -> Reg -> Reg -> Instr
    NAND (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) (Reg -> Reg
    env Reg
    reg3)
        OR      Reg
    reg1 Reg
    reg2 RI
    ri    -> Reg -> Reg -> RI -> Instr
    OR  (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) (RI -> RI
    fixRI RI
    ri)
        ORIS    Reg
    reg1 Reg
    reg2 Imm
    imm   -> Reg -> Reg -> Imm -> Instr
    ORIS (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) Imm
    imm
        XOR     Reg
    reg1 Reg
    reg2 RI
    ri    -> Reg -> Reg -> RI -> Instr
    XOR (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) (RI -> RI
    fixRI RI
    ri)
        XORIS   Reg
    reg1 Reg
    reg2 Imm
    imm   -> Reg -> Reg -> Imm -> Instr
    XORIS (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) Imm
    imm
        EXTS    Format
    fmt Reg
    reg1 Reg
    reg2   -> Format -> Reg -> Reg -> Instr
    EXTS Format
    fmt (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2)
        CNTLZ   Format
    fmt Reg
    reg1 Reg
    reg2   -> Format -> Reg -> Reg -> Instr
    CNTLZ Format
    fmt (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2)
        NEG     Reg
    reg1 Reg
    reg2       -> Reg -> Reg -> Instr
    NEG (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2)
        NOT     Reg
    reg1 Reg
    reg2       -> Reg -> Reg -> Instr
    NOT (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2)
        SL      Format
    fmt Reg
    reg1 Reg
    reg2 RI
    ri
                                -> Format -> Reg -> Reg -> RI -> Instr
    SL Format
    fmt (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) (RI -> RI
    fixRI RI
    ri)
        SR      Format
    fmt Reg
    reg1 Reg
    reg2 RI
    ri
                                -> Format -> Reg -> Reg -> RI -> Instr
    SR Format
    fmt (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) (RI -> RI
    fixRI RI
    ri)
        SRA     Format
    fmt Reg
    reg1 Reg
    reg2 RI
    ri
                                -> Format -> Reg -> Reg -> RI -> Instr
    SRA Format
    fmt (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) (RI -> RI
    fixRI RI
    ri)
        RLWINM  Reg
    reg1 Reg
    reg2 Int
    sh Int
    mb Int
    me
                                -> Reg -> Reg -> Int -> Int -> Int -> Instr
    RLWINM (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) Int
    sh Int
    mb Int
    me
        CLRLI   Format
    fmt Reg
    reg1 Reg
    reg2 Int
    n -> Format -> Reg -> Reg -> Int -> Instr
    CLRLI Format
    fmt (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) Int
    n
        CLRRI   Format
    fmt Reg
    reg1 Reg
    reg2 Int
    n -> Format -> Reg -> Reg -> Int -> Instr
    CLRRI Format
    fmt (Reg -> Reg
    env Reg
    reg1) (Reg -> Reg
    env Reg
    reg2) Int
    n
        FADD    Format
    fmt Reg
    r1 Reg
    r2 Reg
    r3    -> Format -> Reg -> Reg -> Reg -> Instr
    FADD Format
    fmt (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2) (Reg -> Reg
    env Reg
    r3)
        FSUB    Format
    fmt Reg
    r1 Reg
    r2 Reg
    r3    -> Format -> Reg -> Reg -> Reg -> Instr
    FSUB Format
    fmt (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2) (Reg -> Reg
    env Reg
    r3)
        FMUL    Format
    fmt Reg
    r1 Reg
    r2 Reg
    r3    -> Format -> Reg -> Reg -> Reg -> Instr
    FMUL Format
    fmt (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2) (Reg -> Reg
    env Reg
    r3)
        FDIV    Format
    fmt Reg
    r1 Reg
    r2 Reg
    r3    -> Format -> Reg -> Reg -> Reg -> Instr
    FDIV Format
    fmt (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2) (Reg -> Reg
    env Reg
    r3)
        FABS    Reg
    r1 Reg
    r2           -> Reg -> Reg -> Instr
    FABS (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2)
        FNEG    Reg
    r1 Reg
    r2           -> Reg -> Reg -> Instr
    FNEG (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2)
        FCMP    Reg
    r1 Reg
    r2           -> Reg -> Reg -> Instr
    FCMP (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2)
        FCTIWZ  Reg
    r1 Reg
    r2           -> Reg -> Reg -> Instr
    FCTIWZ (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2)
        FCTIDZ  Reg
    r1 Reg
    r2           -> Reg -> Reg -> Instr
    FCTIDZ (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2)
        FCFID   Reg
    r1 Reg
    r2           -> Reg -> Reg -> Instr
    FCFID (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2)
        FRSP    Reg
    r1 Reg
    r2           -> Reg -> Reg -> Instr
    FRSP (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2)
        MFCR    Reg
    reg             -> Reg -> Instr
    MFCR (Reg -> Reg
    env Reg
    reg)
        MFLR    Reg
    reg             -> Reg -> Instr
    MFLR (Reg -> Reg
    env Reg
    reg)
        FETCHPC Reg
    reg             -> Reg -> Instr
    FETCHPC (Reg -> Reg
    env Reg
    reg)
        Instr
    _                       -> Instr
    instr
      where
        fixAddr :: AddrMode -> AddrMode
    fixAddr (AddrRegReg Reg
    r1 Reg
    r2) = Reg -> Reg -> AddrMode
    AddrRegReg (Reg -> Reg
    env Reg
    r1) (Reg -> Reg
    env Reg
    r2)
        fixAddr (AddrRegImm Reg
    r1 Imm
    i)  = Reg -> Imm -> AddrMode
    AddrRegImm (Reg -> Reg
    env Reg
    r1) Imm
    i

        fixRI :: RI -> RI
    fixRI (RIReg Reg
    r) = Reg -> RI
    RIReg (Reg -> Reg
    env Reg
    r)
        fixRI RI
    other     = RI
    other

    --------------------------------------------------------------------------------
    -- | Checks whether this instruction is a jump/branch instruction.
    -- One that can change the flow of control in a way that the
    -- register allocator needs to worry about.
    isJumpishInstr :: Instr -> Bool
    isJumpishInstr :: Instr -> Bool
    isJumpishInstr Instr
    instr
     = case Instr
    instr of
        BCC{}       -> Bool
    True
        BCCFAR{}    -> Bool
    True
        BCTR{}      -> Bool
    True
        BCTRL{}     -> Bool
    True
        BL{}        -> Bool
    True
        JMP{}       -> Bool
    True
        Instr
    _           -> Bool
    False

    -- | Checks whether this instruction is a jump/branch instruction.
    -- One that can change the flow of control in a way that the
    -- register allocator needs to worry about.
    jumpDestsOfInstr :: Instr -> [BlockId]
    jumpDestsOfInstr :: Instr -> [BlockId]
    jumpDestsOfInstr Instr
    insn
      = case Instr
    insn of
            BCC Cond
    _ BlockId
    id Maybe Bool
    _       -> [BlockId
    id]
            BCCFAR Cond
    _ BlockId
    id Maybe Bool
    _    -> [BlockId
    id]
            BCTR [Maybe BlockId]
    targets Maybe CLabel
    _ [Reg]
    _ -> [BlockId
    id | Just BlockId
    id <- [Maybe BlockId]
    targets]
            Instr
    _                -> []

    -- | Change the destination of this jump instruction.
    -- Used in the linear allocator when adding fixup blocks for join
    -- points.
    patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
    patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
    patchJumpInstr Instr
    insn BlockId -> BlockId
    patchF
      = case Instr
    insn of
            BCC Cond
    cc BlockId
    id Maybe Bool
    p     -> Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    cc (BlockId -> BlockId
    patchF BlockId
    id) Maybe Bool
    p
            BCCFAR Cond
    cc BlockId
    id Maybe Bool
    p  -> Cond -> BlockId -> Maybe Bool -> Instr
    BCCFAR Cond
    cc (BlockId -> BlockId
    patchF BlockId
    id) Maybe Bool
    p
            BCTR [Maybe BlockId]
    ids Maybe CLabel
    lbl [Reg]
    rs -> [Maybe BlockId] -> Maybe CLabel -> [Reg] -> Instr
    BCTR (forall a b. (a -> b) -> [a] -> [b]
    map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap BlockId -> BlockId
    patchF) [Maybe BlockId]
    ids) Maybe CLabel
    lbl [Reg]
    rs
            Instr
    _               -> Instr
    insn

    -- -----------------------------------------------------------------------------

    -- | An instruction to spill a register into a spill slot.
    mkSpillInstr
       :: NCGConfig
       -> Reg       -- register to spill
       -> Int       -- current stack delta
       -> Int       -- spill slot to use
       -> [Instr]

    mkSpillInstr :: NCGConfig -> Reg -> Int -> Int -> [Instr]
    mkSpillInstr NCGConfig
    config Reg
    reg Int
    delta Int
    slot
      = let platform :: Platform
    platform = NCGConfig -> Platform
    ncgPlatform NCGConfig
    config
            off :: Int
    off      = Platform -> Int -> Int
    spillSlotToOffset Platform
    platform Int
    slot
            arch :: Arch
    arch     = Platform -> Arch
    platformArch Platform
    platform
        in
        let fmt :: Format
    fmt = case Platform -> Reg -> RegClass
    targetClassOfReg Platform
    platform Reg
    reg of
                    RegClass
    RcInteger -> case Arch
    arch of
                                    Arch
    ArchPPC -> Format
    II32
                                    Arch
    _       -> Format
    II64
                    RegClass
    RcDouble  -> Format
    FF64
                    RegClass
    _         -> forall a. String -> a
    panic String
    "PPC.Instr.mkSpillInstr: no match"
            instr :: Format -> Reg -> AddrMode -> Instr
    instr = case forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    W32 Bool
    True (Int
    offforall a. Num a => a -> a -> a
    -Int
    delta) of
                    Just Imm
    _  -> Format -> Reg -> AddrMode -> Instr
    ST
                    Maybe Imm
    Nothing -> Format -> Reg -> AddrMode -> Instr
    STFAR -- pseudo instruction: 32 bit offsets

        in [Format -> Reg -> AddrMode -> Instr
    instr Format
    fmt Reg
    reg (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    sp (Int -> Imm
    ImmInt (Int
    offforall a. Num a => a -> a -> a
    -Int
    delta)))]

    mkLoadInstr
       :: NCGConfig
       -> Reg       -- register to load
       -> Int       -- current stack delta
       -> Int       -- spill slot to use
       -> [Instr]

    mkLoadInstr :: NCGConfig -> Reg -> Int -> Int -> [Instr]
    mkLoadInstr NCGConfig
    config Reg
    reg Int
    delta Int
    slot
      = let platform :: Platform
    platform = NCGConfig -> Platform
    ncgPlatform NCGConfig
    config
            off :: Int
    off      = Platform -> Int -> Int
    spillSlotToOffset Platform
    platform Int
    slot
            arch :: Arch
    arch     = Platform -> Arch
    platformArch Platform
    platform
        in
        let fmt :: Format
    fmt = case Platform -> Reg -> RegClass
    targetClassOfReg Platform
    platform Reg
    reg of
                    RegClass
    RcInteger ->  case Arch
    arch of
                                     Arch
    ArchPPC -> Format
    II32
                                     Arch
    _       -> Format
    II64
                    RegClass
    RcDouble  -> Format
    FF64
                    RegClass
    _         -> forall a. String -> a
    panic String
    "PPC.Instr.mkLoadInstr: no match"
            instr :: Format -> Reg -> AddrMode -> Instr
    instr = case forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    W32 Bool
    True (Int
    offforall a. Num a => a -> a -> a
    -Int
    delta) of
                    Just Imm
    _  -> Format -> Reg -> AddrMode -> Instr
    LD
                    Maybe Imm
    Nothing -> Format -> Reg -> AddrMode -> Instr
    LDFAR -- pseudo instruction: 32 bit offsets

        in [Format -> Reg -> AddrMode -> Instr
    instr Format
    fmt Reg
    reg (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    sp (Int -> Imm
    ImmInt (Int
    offforall a. Num a => a -> a -> a
    -Int
    delta)))]

    -- | The size of a minimal stackframe header including minimal
    -- parameter save area.
    stackFrameHeaderSize :: Platform -> Int
    stackFrameHeaderSize :: Platform -> Int
    stackFrameHeaderSize Platform
    platform
      = case Platform -> OS
    platformOS Platform
    platform of
          OS
    OSAIX    -> Int
    24 forall a. Num a => a -> a -> a
    + Int
    8 forall a. Num a => a -> a -> a
    * Int
    4
          OS
    _ -> case Platform -> Arch
    platformArch Platform
    platform of
                                 -- header + parameter save area
                 Arch
    ArchPPC           -> Int
    64 -- TODO: check ABI spec
                 ArchPPC_64 PPC_64ABI
    ELF_V1 -> Int
    48 forall a. Num a => a -> a -> a
    + Int
    8 forall a. Num a => a -> a -> a
    * Int
    8
                 ArchPPC_64 PPC_64ABI
    ELF_V2 -> Int
    32 forall a. Num a => a -> a -> a
    + Int
    8 forall a. Num a => a -> a -> a
    * Int
    8
                 Arch
    _ -> forall a. String -> a
    panic String
    "PPC.stackFrameHeaderSize: not defined for this OS"

    -- | The maximum number of bytes required to spill a register. PPC32
    -- has 32-bit GPRs and 64-bit FPRs, while PPC64 has 64-bit GPRs and
    -- 64-bit FPRs. So the maximum is 8 regardless of platforms unlike
    -- x86. Note that AltiVec's vector registers are 128-bit wide so we
    -- must not use this to spill them.
    spillSlotSize :: Int
    spillSlotSize :: Int
    spillSlotSize = Int
    8

    -- | The number of spill slots available without allocating more.
    maxSpillSlots :: NCGConfig -> Int
    maxSpillSlots :: NCGConfig -> Int
    maxSpillSlots NCGConfig
    config
    --  = 0 -- useful for testing allocMoreStack
        = let platform :: Platform
    platform = NCGConfig -> Platform
    ncgPlatform NCGConfig
    config
          in ((NCGConfig -> Int
    ncgSpillPreallocSize NCGConfig
    config forall a. Num a => a -> a -> a
    - Platform -> Int
    stackFrameHeaderSize Platform
    platform)
             forall a. Integral a => a -> a -> a
    `div` Int
    spillSlotSize) forall a. Num a => a -> a -> a
    - Int
    1

    -- | The number of bytes that the stack pointer should be aligned
    -- to. This is 16 both on PPC32 and PPC64 ELF (see ELF processor
    -- specific supplements).
    stackAlign :: Int
    stackAlign :: Int
    stackAlign = Int
    16

    -- | Convert a spill slot number to a *byte* offset, with no sign.
    spillSlotToOffset :: Platform -> Int -> Int
    spillSlotToOffset :: Platform -> Int -> Int
    spillSlotToOffset Platform
    platform Int
    slot
       = Platform -> Int
    stackFrameHeaderSize Platform
    platform forall a. Num a => a -> a -> a
    + Int
    spillSlotSize forall a. Num a => a -> a -> a
    * Int
    slot

    --------------------------------------------------------------------------------
    -- | See if this instruction is telling us the current C stack delta
    takeDeltaInstr
        :: Instr
        -> Maybe Int

    takeDeltaInstr :: Instr -> Maybe Int
    takeDeltaInstr Instr
    instr
     = case Instr
    instr of
         DELTA Int
    i  -> forall a. a -> Maybe a
    Just Int
    i
         Instr
    _        -> forall a. Maybe a
    Nothing

    isMetaInstr
        :: Instr
        -> Bool

    isMetaInstr :: Instr -> Bool
    isMetaInstr Instr
    instr
     = case Instr
    instr of
        COMMENT{}   -> Bool
    True
        LOCATION{}  -> Bool
    True
        LDATA{}     -> Bool
    True
        NEWBLOCK{}  -> Bool
    True
        DELTA{}     -> Bool
    True
        Instr
    _           -> Bool
    False

    -- | Copy the value in a register to another one.
    -- Must work for all register classes.
    mkRegRegMoveInstr
        :: Reg
        -> Reg
        -> Instr

    mkRegRegMoveInstr :: Reg -> Reg -> Instr
    mkRegRegMoveInstr Reg
    src Reg
    dst
        = Reg -> Reg -> Instr
    MR Reg
    dst Reg
    src

    -- | Make an unconditional jump instruction.
    mkJumpInstr
        :: BlockId
        -> [Instr]

    mkJumpInstr :: BlockId -> [Instr]
    mkJumpInstr BlockId
    id
        = [Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    id forall a. Maybe a
    Nothing]

    -- | Take the source and destination from this reg -> reg move instruction
    -- or Nothing if it's not one
    takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg)
    takeRegRegMoveInstr :: Instr -> Maybe (Reg, Reg)
    takeRegRegMoveInstr (MR Reg
    dst Reg
    src) = forall a. a -> Maybe a
    Just (Reg
    src,Reg
    dst)
    takeRegRegMoveInstr Instr
    _  = forall a. Maybe a
    Nothing

    -- -----------------------------------------------------------------------------
    -- Making far branches

    -- Conditional branches on PowerPC are limited to +-32KB; if our Procs get too
    -- big, we have to work around this limitation.

    makeFarBranches
            :: LabelMap RawCmmStatics
            -> [NatBasicBlock Instr]
            -> [NatBasicBlock Instr]
    makeFarBranches :: LabelMap RawCmmStatics
    -> [GenBasicBlock Instr] -> [GenBasicBlock Instr]
    makeFarBranches LabelMap RawCmmStatics
    info_env [GenBasicBlock Instr]
    blocks
        | forall a. [a] -> a
    last [Int]
    blockAddresses forall a. Ord a => a -> a -> Bool
    < Int
    nearLimit = [GenBasicBlock Instr]
    blocks
        | Bool
    otherwise = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> GenBasicBlock Instr -> GenBasicBlock Instr
    handleBlock [Int]
    blockAddresses [GenBasicBlock Instr]
    blocks
        where
            blockAddresses :: [Int]
    blockAddresses = forall b a. (b -> a -> b) -> b -> [a] -> [b]
    scanl forall a. Num a => a -> a -> a
    (+) Int
    0 forall a b. (a -> b) -> a -> b
    $ forall a b. (a -> b) -> [a] -> [b]
    map forall {a}. GenBasicBlock a -> Int
    blockLen [GenBasicBlock Instr]
    blocks
            blockLen :: GenBasicBlock a -> Int
    blockLen (BasicBlock BlockId
    _ [a]
    instrs) = forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    instrs

            handleBlock :: Int -> GenBasicBlock Instr -> GenBasicBlock Instr
    handleBlock Int
    addr (BasicBlock BlockId
    id [Instr]
    instrs)
                    = forall i. BlockId -> [i] -> GenBasicBlock i
    BasicBlock BlockId
    id (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> Instr -> Instr
    makeFar [Int
    addr..] [Instr]
    instrs)

            makeFar :: Int -> Instr -> Instr
    makeFar Int
    _ (BCC Cond
    ALWAYS BlockId
    tgt Maybe Bool
    _) = Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    ALWAYS BlockId
    tgt forall a. Maybe a
    Nothing
            makeFar Int
    addr (BCC Cond
    cond BlockId
    tgt Maybe Bool
    p)
                | forall a. Num a => a -> a
    abs (Int
    addr forall a. Num a => a -> a -> a
    - Int
    targetAddr) forall a. Ord a => a -> a -> Bool
    >= Int
    nearLimit
                = Cond -> BlockId -> Maybe Bool -> Instr
    BCCFAR Cond
    cond BlockId
    tgt Maybe Bool
    p
                | Bool
    otherwise
                = Cond -> BlockId -> Maybe Bool -> Instr
    BCC Cond
    cond BlockId
    tgt Maybe Bool
    p
                where Just Int
    targetAddr = forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM UniqFM BlockId Int
    blockAddressMap BlockId
    tgt
            makeFar Int
    _ Instr
    other            = Instr
    other

            -- 8192 instructions are allowed; let's keep some distance, as
            -- we have a few pseudo-insns that are pretty-printed as
            -- multiple instructions, and it's just not worth the effort
            -- to calculate things exactly
            nearLimit :: Int
    nearLimit = Int
    7000 forall a. Num a => a -> a -> a
    - forall (map :: * -> *) a. IsMap map => map a -> Int
    mapSize LabelMap RawCmmStatics
    info_env forall a. Num a => a -> a -> a
    * Int
    maxRetInfoTableSizeW

            blockAddressMap :: UniqFM BlockId Int
    blockAddressMap = forall key elt. Uniquable key => [(key, elt)] -> UniqFM key elt
    listToUFM forall a b. (a -> b) -> a -> b
    $ forall a b. [a] -> [b] -> [(a, b)]
    zip (forall a b. (a -> b) -> [a] -> [b]
    map forall i. GenBasicBlock i -> BlockId
    blockId [GenBasicBlock Instr]
    blocks) [Int]
    blockAddresses