{-# LANGUAGE CPP #-}

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

#include "HsVersions.h"
#include "nativeGen/NCG.h"

module PPC.Instr (
    archWordFormat,
    RI(..),
    Instr(..),
    stackFrameHeaderSize,
    maxSpillSlots,
    allocMoreStack,
    makeFarBranches
)

where

import GhcPrelude

import PPC.Regs
import PPC.Cond
import Instruction
import Format
import TargetReg
import RegClass
import Reg

import CodeGen.Platform
import BlockId
import Hoopl.Collections
import Hoopl.Label
import DynFlags
import Cmm
import CmmInfo
import FastString
import CLabel
import Outputable
import Platform
import UniqFM (listToUFM, lookupUFM)
import UniqSupply

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

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


-- | Instruction instance for powerpc
instance Instruction Instr where
        regUsageOfInstr :: Platform -> Instr -> RegUsage
regUsageOfInstr         = Platform -> Instr -> RegUsage
ppc_regUsageOfInstr
        patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
patchRegsOfInstr        = Instr -> (Reg -> Reg) -> Instr
ppc_patchRegsOfInstr
        isJumpishInstr :: Instr -> Bool
isJumpishInstr          = Instr -> Bool
ppc_isJumpishInstr
        jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr        = Instr -> [BlockId]
ppc_jumpDestsOfInstr
        patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
patchJumpInstr          = Instr -> (BlockId -> BlockId) -> Instr
ppc_patchJumpInstr
        mkSpillInstr :: DynFlags -> Reg -> Int -> Int -> Instr
mkSpillInstr            = DynFlags -> Reg -> Int -> Int -> Instr
ppc_mkSpillInstr
        mkLoadInstr :: DynFlags -> Reg -> Int -> Int -> Instr
mkLoadInstr             = DynFlags -> Reg -> Int -> Int -> Instr
ppc_mkLoadInstr
        takeDeltaInstr :: Instr -> Maybe Int
takeDeltaInstr          = Instr -> Maybe Int
ppc_takeDeltaInstr
        isMetaInstr :: Instr -> Bool
isMetaInstr             = Instr -> Bool
ppc_isMetaInstr
        mkRegRegMoveInstr :: Platform -> Reg -> Reg -> Instr
mkRegRegMoveInstr _     = Reg -> Reg -> Instr
ppc_mkRegRegMoveInstr
        takeRegRegMoveInstr :: Instr -> Maybe (Reg, Reg)
takeRegRegMoveInstr     = Instr -> Maybe (Reg, Reg)
ppc_takeRegRegMoveInstr
        mkJumpInstr :: BlockId -> [Instr]
mkJumpInstr             = BlockId -> [Instr]
ppc_mkJumpInstr
        mkStackAllocInstr :: Platform -> Int -> [Instr]
mkStackAllocInstr       = Platform -> Int -> [Instr]
ppc_mkStackAllocInstr
        mkStackDeallocInstr :: Platform -> Int -> [Instr]
mkStackDeallocInstr     = Platform -> Int -> [Instr]
ppc_mkStackDeallocInstr


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

ppc_mkStackDeallocInstr :: Platform -> Int -> [Instr]
ppc_mkStackDeallocInstr :: Platform -> Int -> [Instr]
ppc_mkStackDeallocInstr platform :: Platform
platform amount :: Int
amount
  = Platform -> Int -> [Instr]
ppc_mkStackAllocInstr' Platform
platform Int
amount

ppc_mkStackAllocInstr' :: Platform -> Int -> [Instr]
ppc_mkStackAllocInstr' :: Platform -> Int -> [Instr]
ppc_mkStackAllocInstr' platform :: Platform
platform amount :: Int
amount
  | Int -> Bool
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 (Width -> Format) -> Width -> Format
forall a b. (a -> b) -> a -> b
$ Int -> Width
widthFromBytes (Platform -> Int
platformWordSize Platform
platform)
    zero :: Imm
zero = Int -> Imm
ImmInt 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 PPC.Instr.Instr
  -> UniqSM (NatCmmDecl statics PPC.Instr.Instr, [(BlockId,BlockId)])

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

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

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

        alloc :: [Instr]
alloc   = Platform -> Int -> [Instr]
forall instr. Instruction instr => Platform -> Int -> [instr]
mkStackAllocInstr   Platform
platform Int
delta
        dealloc :: [Instr]
dealloc = Platform -> Int -> [Instr]
forall instr. Instruction instr => Platform -> Int -> [instr]
mkStackDeallocInstr Platform
platform Int
delta

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

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

        insert_stack_insns :: GenBasicBlock Instr -> [GenBasicBlock Instr]
insert_stack_insns (BasicBlock id :: BlockId
id insns :: [Instr]
insns)
            | Just new_blockid :: BlockId
new_blockid <- KeyOf LabelMap -> LabelMap BlockId -> Maybe BlockId
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup KeyOf LabelMap
BlockId
id LabelMap BlockId
new_blockmap
                = [ BlockId -> [Instr] -> GenBasicBlock Instr
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
id ([Instr] -> GenBasicBlock Instr) -> [Instr] -> GenBasicBlock Instr
forall a b. (a -> b) -> a -> b
$ [Instr]
alloc [Instr] -> [Instr] -> [Instr]
forall a. [a] -> [a] -> [a]
++ [Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
new_blockid Maybe Bool
forall a. Maybe a
Nothing]
                  , BlockId -> [Instr] -> GenBasicBlock Instr
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
new_blockid [Instr]
block'
                  ]
            | Bool
otherwise
                = [ BlockId -> [Instr] -> GenBasicBlock Instr
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
id [Instr]
block' ]
            where
              block' :: [Instr]
block' = (Instr -> [Instr] -> [Instr]) -> [Instr] -> [Instr] -> [Instr]
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 insn :: Instr
insn r :: [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 _           -> [Instr]
dealloc [Instr] -> [Instr] -> [Instr]
forall a. [a] -> [a] -> [a]
++ (Instr
insn Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: [Instr]
r)
                BCTR [] Nothing -> [Instr]
dealloc [Instr] -> [Instr] -> [Instr]
forall a. [a] -> [a] -> [a]
++ (Instr
insn Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: [Instr]
r)
                BCTR ids :: [Maybe BlockId]
ids label :: Maybe CLabel
label  -> [Maybe BlockId] -> Maybe CLabel -> Instr
BCTR ((Maybe BlockId -> Maybe BlockId)
-> [Maybe BlockId] -> [Maybe BlockId]
forall a b. (a -> b) -> [a] -> [b]
map ((BlockId -> BlockId) -> Maybe BlockId -> Maybe BlockId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BlockId -> BlockId
retarget) [Maybe BlockId]
ids) Maybe CLabel
label Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: [Instr]
r
                BCCFAR cond :: Cond
cond b :: BlockId
b p :: Maybe Bool
p -> Cond -> BlockId -> Maybe Bool -> Instr
BCCFAR Cond
cond (BlockId -> BlockId
retarget BlockId
b) Maybe Bool
p Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: [Instr]
r
                BCC    cond :: Cond
cond b :: BlockId
b p :: Maybe Bool
p -> Cond -> BlockId -> Maybe Bool -> Instr
BCC    Cond
cond (BlockId -> BlockId
retarget BlockId
b) Maybe Bool
p Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: [Instr]
r
                _               -> Instr
insn Instr -> [Instr] -> [Instr]
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 b :: BlockId
b
            = BlockId -> Maybe BlockId -> BlockId
forall a. a -> Maybe a -> a
fromMaybe BlockId
b (KeyOf LabelMap -> LabelMap BlockId -> Maybe BlockId
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup KeyOf LabelMap
BlockId
b LabelMap BlockId
new_blockmap)

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

    -- in
    (NatCmmDecl statics Instr, [(BlockId, BlockId)])
-> UniqSM (NatCmmDecl statics Instr, [(BlockId, BlockId)])
forall (m :: * -> *) a. Monad m => a -> m a
return (LabelMap CmmStatics
-> CLabel
-> [GlobalReg]
-> ListGraph Instr
-> NatCmmDecl statics Instr
forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc LabelMap CmmStatics
info CLabel
lbl [GlobalReg]
live ([GenBasicBlock Instr] -> ListGraph Instr
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

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

    -- 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                -- same as branch,
                                    -- but with CLabel instead of block ID
    | MTCTR   Reg
    | BCTR    [Maybe BlockId] (Maybe CLabel) -- 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.
--
ppc_regUsageOfInstr :: Platform -> Instr -> RegUsage
ppc_regUsageOfInstr :: Platform -> Instr -> RegUsage
ppc_regUsageOfInstr platform :: Platform
platform instr :: Instr
instr
 = case Instr
instr of
    LD      _ reg :: Reg
reg addr :: AddrMode
addr       -> ([Reg], [Reg]) -> RegUsage
usage (AddrMode -> [Reg]
regAddr AddrMode
addr, [Reg
reg])
    LDFAR   _ reg :: Reg
reg addr :: AddrMode
addr       -> ([Reg], [Reg]) -> RegUsage
usage (AddrMode -> [Reg]
regAddr AddrMode
addr, [Reg
reg])
    LDR     _ reg :: Reg
reg addr :: AddrMode
addr       -> ([Reg], [Reg]) -> RegUsage
usage (AddrMode -> [Reg]
regAddr AddrMode
addr, [Reg
reg])
    LA      _ reg :: Reg
reg addr :: AddrMode
addr       -> ([Reg], [Reg]) -> RegUsage
usage (AddrMode -> [Reg]
regAddr AddrMode
addr, [Reg
reg])
    ST      _ reg :: Reg
reg addr :: AddrMode
addr       -> ([Reg], [Reg]) -> RegUsage
usage (Reg
reg Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: AddrMode -> [Reg]
regAddr AddrMode
addr, [])
    STFAR   _ reg :: Reg
reg addr :: AddrMode
addr       -> ([Reg], [Reg]) -> RegUsage
usage (Reg
reg Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: AddrMode -> [Reg]
regAddr AddrMode
addr, [])
    STU     _ reg :: Reg
reg addr :: AddrMode
addr       -> ([Reg], [Reg]) -> RegUsage
usage (Reg
reg Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: AddrMode -> [Reg]
regAddr AddrMode
addr, [])
    STC     _ reg :: Reg
reg addr :: AddrMode
addr       -> ([Reg], [Reg]) -> RegUsage
usage (Reg
reg Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: AddrMode -> [Reg]
regAddr AddrMode
addr, [])
    LIS     reg :: Reg
reg _            -> ([Reg], [Reg]) -> RegUsage
usage ([], [Reg
reg])
    LI      reg :: Reg
reg _            -> ([Reg], [Reg]) -> RegUsage
usage ([], [Reg
reg])
    MR      reg1 :: Reg
reg1 reg2 :: Reg
reg2        -> ([Reg], [Reg]) -> RegUsage
usage ([Reg
reg2], [Reg
reg1])
    CMP     _ reg :: Reg
reg ri :: RI
ri         -> ([Reg], [Reg]) -> RegUsage
usage (Reg
reg Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: RI -> [Reg]
regRI RI
ri,[])
    CMPL    _ reg :: Reg
reg ri :: RI
ri         -> ([Reg], [Reg]) -> RegUsage
usage (Reg
reg Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: RI -> [Reg]
regRI RI
ri,[])
    BCC     _ _ _            -> RegUsage
noUsage
    BCCFAR  _ _ _            -> RegUsage
noUsage
    MTCTR   reg :: Reg
reg              -> ([Reg], [Reg]) -> RegUsage
usage ([Reg
reg],[])
    BCTR    _ _              -> RegUsage
noUsage
    BL      _ params :: [Reg]
params         -> ([Reg], [Reg]) -> RegUsage
usage ([Reg]
params, Platform -> [Reg]
callClobberedRegs Platform
platform)
    BCTRL   params :: [Reg]
params           -> ([Reg], [Reg]) -> RegUsage
usage ([Reg]
params, Platform -> [Reg]
callClobberedRegs Platform
platform)

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

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

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

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

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



-- | Apply a given mapping to all the register references in this
-- instruction.
ppc_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
ppc_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
ppc_patchRegsOfInstr instr :: Instr
instr env :: Reg -> Reg
env
 = case Instr
instr of
    LD      fmt :: Format
fmt reg :: Reg
reg addr :: AddrMode
addr    -> Format -> Reg -> AddrMode -> Instr
LD Format
fmt (Reg -> Reg
env Reg
reg) (AddrMode -> AddrMode
fixAddr AddrMode
addr)
    LDFAR   fmt :: Format
fmt reg :: Reg
reg addr :: AddrMode
addr    -> Format -> Reg -> AddrMode -> Instr
LDFAR Format
fmt (Reg -> Reg
env Reg
reg) (AddrMode -> AddrMode
fixAddr AddrMode
addr)
    LDR     fmt :: Format
fmt reg :: Reg
reg addr :: AddrMode
addr    -> Format -> Reg -> AddrMode -> Instr
LDR Format
fmt (Reg -> Reg
env Reg
reg) (AddrMode -> AddrMode
fixAddr AddrMode
addr)
    LA      fmt :: Format
fmt reg :: Reg
reg addr :: AddrMode
addr    -> Format -> Reg -> AddrMode -> Instr
LA Format
fmt (Reg -> Reg
env Reg
reg) (AddrMode -> AddrMode
fixAddr AddrMode
addr)
    ST      fmt :: Format
fmt reg :: Reg
reg addr :: AddrMode
addr    -> Format -> Reg -> AddrMode -> Instr
ST Format
fmt (Reg -> Reg
env Reg
reg) (AddrMode -> AddrMode
fixAddr AddrMode
addr)
    STFAR   fmt :: Format
fmt reg :: Reg
reg addr :: AddrMode
addr    -> Format -> Reg -> AddrMode -> Instr
STFAR Format
fmt (Reg -> Reg
env Reg
reg) (AddrMode -> AddrMode
fixAddr AddrMode
addr)
    STU     fmt :: Format
fmt reg :: Reg
reg addr :: AddrMode
addr    -> Format -> Reg -> AddrMode -> Instr
STU Format
fmt (Reg -> Reg
env Reg
reg) (AddrMode -> AddrMode
fixAddr AddrMode
addr)
    STC     fmt :: Format
fmt reg :: Reg
reg addr :: AddrMode
addr    -> Format -> Reg -> AddrMode -> Instr
STC Format
fmt (Reg -> Reg
env Reg
reg) (AddrMode -> AddrMode
fixAddr AddrMode
addr)
    LIS     reg :: Reg
reg imm :: Imm
imm         -> Reg -> Imm -> Instr
LIS (Reg -> Reg
env Reg
reg) Imm
imm
    LI      reg :: Reg
reg imm :: Imm
imm         -> Reg -> Imm -> Instr
LI (Reg -> Reg
env Reg
reg) Imm
imm
    MR      reg1 :: Reg
reg1 reg2 :: Reg
reg2       -> Reg -> Reg -> Instr
MR (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2)
    CMP     fmt :: Format
fmt reg :: Reg
reg ri :: RI
ri      -> Format -> Reg -> RI -> Instr
CMP Format
fmt (Reg -> Reg
env Reg
reg) (RI -> RI
fixRI RI
ri)
    CMPL    fmt :: Format
fmt reg :: Reg
reg ri :: RI
ri      -> Format -> Reg -> RI -> Instr
CMPL Format
fmt (Reg -> Reg
env Reg
reg) (RI -> RI
fixRI RI
ri)
    BCC     cond :: Cond
cond lbl :: BlockId
lbl p :: Maybe Bool
p      -> Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
cond BlockId
lbl Maybe Bool
p
    BCCFAR  cond :: Cond
cond lbl :: BlockId
lbl p :: Maybe Bool
p      -> Cond -> BlockId -> Maybe Bool -> Instr
BCCFAR Cond
cond BlockId
lbl Maybe Bool
p
    MTCTR   reg :: Reg
reg             -> Reg -> Instr
MTCTR (Reg -> Reg
env Reg
reg)
    BCTR    targets :: [Maybe BlockId]
targets lbl :: Maybe CLabel
lbl     -> [Maybe BlockId] -> Maybe CLabel -> Instr
BCTR [Maybe BlockId]
targets Maybe CLabel
lbl
    BL      imm :: CLabel
imm argRegs :: [Reg]
argRegs     -> CLabel -> [Reg] -> Instr
BL CLabel
imm [Reg]
argRegs    -- argument regs
    BCTRL   argRegs :: [Reg]
argRegs         -> [Reg] -> Instr
BCTRL [Reg]
argRegs     -- cannot be remapped
    ADD     reg1 :: Reg
reg1 reg2 :: Reg
reg2 ri :: RI
ri    -> Reg -> Reg -> RI -> Instr
ADD (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2) (RI -> RI
fixRI RI
ri)
    ADDO    reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3  -> Reg -> Reg -> Reg -> Instr
ADDO (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2) (Reg -> Reg
env Reg
reg3)
    ADDC    reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3  -> Reg -> Reg -> Reg -> Instr
ADDC (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2) (Reg -> Reg
env Reg
reg3)
    ADDE    reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3  -> Reg -> Reg -> Reg -> Instr
ADDE (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2) (Reg -> Reg
env Reg
reg3)
    ADDZE   reg1 :: Reg
reg1 reg2 :: Reg
reg2       -> Reg -> Reg -> Instr
ADDZE (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2)
    ADDIS   reg1 :: Reg
reg1 reg2 :: Reg
reg2 imm :: Imm
imm   -> Reg -> Reg -> Imm -> Instr
ADDIS (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2) Imm
imm
    SUBF    reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3  -> Reg -> Reg -> Reg -> Instr
SUBF (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2) (Reg -> Reg
env Reg
reg3)
    SUBFO   reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3  -> Reg -> Reg -> Reg -> Instr
SUBFO (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2) (Reg -> Reg
env Reg
reg3)
    SUBFC   reg1 :: Reg
reg1 reg2 :: Reg
reg2 ri :: RI
ri    -> Reg -> Reg -> RI -> Instr
SUBFC (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2) (RI -> RI
fixRI RI
ri)
    SUBFE   reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3  -> Reg -> Reg -> Reg -> Instr
SUBFE (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2) (Reg -> Reg
env Reg
reg3)
    MULL    fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 ri :: 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   fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: 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    fmt :: Format
fmt reg :: Reg
reg         -> Format -> Reg -> Instr
MFOV Format
fmt (Reg -> Reg
env Reg
reg)
    MULHU   fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: 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     fmt :: Format
fmt sgn :: Bool
sgn reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: 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     reg1 :: Reg
reg1 reg2 :: Reg
reg2 ri :: RI
ri    -> Reg -> Reg -> RI -> Instr
AND (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2) (RI -> RI
fixRI RI
ri)
    ANDC    reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3  -> Reg -> Reg -> Reg -> Instr
ANDC (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2) (Reg -> Reg
env Reg
reg3)
    NAND    reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3  -> Reg -> Reg -> Reg -> Instr
NAND (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2) (Reg -> Reg
env Reg
reg3)
    OR      reg1 :: Reg
reg1 reg2 :: Reg
reg2 ri :: RI
ri    -> Reg -> Reg -> RI -> Instr
OR  (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2) (RI -> RI
fixRI RI
ri)
    ORIS    reg1 :: Reg
reg1 reg2 :: Reg
reg2 imm :: Imm
imm   -> Reg -> Reg -> Imm -> Instr
ORIS (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2) Imm
imm
    XOR     reg1 :: Reg
reg1 reg2 :: Reg
reg2 ri :: RI
ri    -> Reg -> Reg -> RI -> Instr
XOR (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2) (RI -> RI
fixRI RI
ri)
    XORIS   reg1 :: Reg
reg1 reg2 :: Reg
reg2 imm :: Imm
imm   -> Reg -> Reg -> Imm -> Instr
XORIS (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2) Imm
imm
    EXTS    fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2   -> Format -> Reg -> Reg -> Instr
EXTS Format
fmt (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2)
    CNTLZ   fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2   -> Format -> Reg -> Reg -> Instr
CNTLZ Format
fmt (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2)
    NEG     reg1 :: Reg
reg1 reg2 :: Reg
reg2       -> Reg -> Reg -> Instr
NEG (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2)
    NOT     reg1 :: Reg
reg1 reg2 :: Reg
reg2       -> Reg -> Reg -> Instr
NOT (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2)
    SL      fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 ri :: 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      fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 ri :: 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     fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 ri :: 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  reg1 :: Reg
reg1 reg2 :: Reg
reg2 sh :: Int
sh mb :: Int
mb me :: 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   fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 n :: Int
n -> Format -> Reg -> Reg -> Int -> Instr
CLRLI Format
fmt (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2) Int
n
    CLRRI   fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 n :: Int
n -> Format -> Reg -> Reg -> Int -> Instr
CLRRI Format
fmt (Reg -> Reg
env Reg
reg1) (Reg -> Reg
env Reg
reg2) Int
n
    FADD    fmt :: Format
fmt r1 :: Reg
r1 r2 :: Reg
r2 r3 :: 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    fmt :: Format
fmt r1 :: Reg
r1 r2 :: Reg
r2 r3 :: 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    fmt :: Format
fmt r1 :: Reg
r1 r2 :: Reg
r2 r3 :: 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    fmt :: Format
fmt r1 :: Reg
r1 r2 :: Reg
r2 r3 :: 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    r1 :: Reg
r1 r2 :: Reg
r2           -> Reg -> Reg -> Instr
FABS (Reg -> Reg
env Reg
r1) (Reg -> Reg
env Reg
r2)
    FNEG    r1 :: Reg
r1 r2 :: Reg
r2           -> Reg -> Reg -> Instr
FNEG (Reg -> Reg
env Reg
r1) (Reg -> Reg
env Reg
r2)
    FCMP    r1 :: Reg
r1 r2 :: Reg
r2           -> Reg -> Reg -> Instr
FCMP (Reg -> Reg
env Reg
r1) (Reg -> Reg
env Reg
r2)
    FCTIWZ  r1 :: Reg
r1 r2 :: Reg
r2           -> Reg -> Reg -> Instr
FCTIWZ (Reg -> Reg
env Reg
r1) (Reg -> Reg
env Reg
r2)
    FCTIDZ  r1 :: Reg
r1 r2 :: Reg
r2           -> Reg -> Reg -> Instr
FCTIDZ (Reg -> Reg
env Reg
r1) (Reg -> Reg
env Reg
r2)
    FCFID   r1 :: Reg
r1 r2 :: Reg
r2           -> Reg -> Reg -> Instr
FCFID (Reg -> Reg
env Reg
r1) (Reg -> Reg
env Reg
r2)
    FRSP    r1 :: Reg
r1 r2 :: Reg
r2           -> Reg -> Reg -> Instr
FRSP (Reg -> Reg
env Reg
r1) (Reg -> Reg
env Reg
r2)
    MFCR    reg :: Reg
reg             -> Reg -> Instr
MFCR (Reg -> Reg
env Reg
reg)
    MFLR    reg :: Reg
reg             -> Reg -> Instr
MFLR (Reg -> Reg
env Reg
reg)
    FETCHPC reg :: Reg
reg             -> Reg -> Instr
FETCHPC (Reg -> Reg
env Reg
reg)
    _                       -> Instr
instr
  where
    fixAddr :: AddrMode -> AddrMode
fixAddr (AddrRegReg r1 :: Reg
r1 r2 :: Reg
r2) = Reg -> Reg -> AddrMode
AddrRegReg (Reg -> Reg
env Reg
r1) (Reg -> Reg
env Reg
r2)
    fixAddr (AddrRegImm r1 :: Reg
r1 i :: Imm
i)  = Reg -> Imm -> AddrMode
AddrRegImm (Reg -> Reg
env Reg
r1) Imm
i

    fixRI :: RI -> RI
fixRI (RIReg r :: Reg
r) = Reg -> RI
RIReg (Reg -> Reg
env Reg
r)
    fixRI other :: 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.
ppc_isJumpishInstr :: Instr -> Bool
ppc_isJumpishInstr :: Instr -> Bool
ppc_isJumpishInstr instr :: Instr
instr
 = case Instr
instr of
    BCC{}       -> Bool
True
    BCCFAR{}    -> Bool
True
    BCTR{}      -> Bool
True
    BCTRL{}     -> Bool
True
    BL{}        -> Bool
True
    JMP{}       -> Bool
True
    _           -> 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.
ppc_jumpDestsOfInstr :: Instr -> [BlockId]
ppc_jumpDestsOfInstr :: Instr -> [BlockId]
ppc_jumpDestsOfInstr insn :: Instr
insn
  = case Instr
insn of
        BCC _ id :: BlockId
id _      -> [BlockId
id]
        BCCFAR _ id :: BlockId
id _   -> [BlockId
id]
        BCTR targets :: [Maybe BlockId]
targets _  -> [BlockId
id | Just id :: BlockId
id <- [Maybe BlockId]
targets]
        _               -> []


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


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

-- | An instruction to spill a register into a spill slot.
ppc_mkSpillInstr
   :: DynFlags
   -> Reg       -- register to spill
   -> Int       -- current stack delta
   -> Int       -- spill slot to use
   -> Instr

ppc_mkSpillInstr :: DynFlags -> Reg -> Int -> Int -> Instr
ppc_mkSpillInstr dflags :: DynFlags
dflags reg :: Reg
reg delta :: Int
delta slot :: Int
slot
  = let platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
        off :: Int
off      = DynFlags -> Int -> Int
spillSlotToOffset DynFlags
dflags 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
                RcInteger -> case Arch
arch of
                                ArchPPC -> Format
II32
                                _       -> Format
II64
                RcDouble  -> Format
FF64
                _         -> String -> Format
forall a. String -> a
panic "PPC.Instr.mkSpillInstr: no match"
        instr :: Format -> Reg -> AddrMode -> Instr
instr = case Width -> Bool -> Int -> Maybe Imm
forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
W32 Bool
True (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
delta) of
                Just _  -> Format -> Reg -> AddrMode -> Instr
ST
                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
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
delta)))


ppc_mkLoadInstr
   :: DynFlags
   -> Reg       -- register to load
   -> Int       -- current stack delta
   -> Int       -- spill slot to use
   -> Instr

ppc_mkLoadInstr :: DynFlags -> Reg -> Int -> Int -> Instr
ppc_mkLoadInstr dflags :: DynFlags
dflags reg :: Reg
reg delta :: Int
delta slot :: Int
slot
  = let platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
        off :: Int
off      = DynFlags -> Int -> Int
spillSlotToOffset DynFlags
dflags 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
                RcInteger ->  case Arch
arch of
                                 ArchPPC -> Format
II32
                                 _       -> Format
II64
                RcDouble  -> Format
FF64
                _         -> String -> Format
forall a. String -> a
panic "PPC.Instr.mkLoadInstr: no match"
        instr :: Format -> Reg -> AddrMode -> Instr
instr = case Width -> Bool -> Int -> Maybe Imm
forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
W32 Bool
True (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
delta) of
                Just _  -> Format -> Reg -> AddrMode -> Instr
LD
                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
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
delta)))


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

-- | 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 = 8

-- | The number of spill slots available without allocating more.
maxSpillSlots :: DynFlags -> Int
maxSpillSlots :: DynFlags -> Int
maxSpillSlots dflags :: DynFlags
dflags
    = ((DynFlags -> Int
rESERVED_C_STACK_BYTES DynFlags
dflags Int -> Int -> Int
forall a. Num a => a -> a -> a
- DynFlags -> Int
stackFrameHeaderSize DynFlags
dflags)
       Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
spillSlotSize) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
--     = 0 -- useful for testing allocMoreStack

-- | 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 = 16

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


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

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


ppc_isMetaInstr
    :: Instr
    -> Bool

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


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

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


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

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


-- | Take the source and destination from this reg -> reg move instruction
-- or Nothing if it's not one
ppc_takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg)
ppc_takeRegRegMoveInstr :: Instr -> Maybe (Reg, Reg)
ppc_takeRegRegMoveInstr (MR dst :: Reg
dst src :: Reg
src) = (Reg, Reg) -> Maybe (Reg, Reg)
forall a. a -> Maybe a
Just (Reg
src,Reg
dst)
ppc_takeRegRegMoveInstr _  = Maybe (Reg, Reg)
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 CmmStatics
        -> [NatBasicBlock Instr]
        -> [NatBasicBlock Instr]
makeFarBranches :: LabelMap CmmStatics
-> [GenBasicBlock Instr] -> [GenBasicBlock Instr]
makeFarBranches info_env :: LabelMap CmmStatics
info_env blocks :: [GenBasicBlock Instr]
blocks
    | [Int] -> Int
forall a. [a] -> a
last [Int]
blockAddresses Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
nearLimit = [GenBasicBlock Instr]
blocks
    | Bool
otherwise = (Int -> GenBasicBlock Instr -> GenBasicBlock Instr)
-> [Int] -> [GenBasicBlock Instr] -> [GenBasicBlock Instr]
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 = (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) 0 ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (GenBasicBlock Instr -> Int) -> [GenBasicBlock Instr] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map GenBasicBlock Instr -> Int
forall a. GenBasicBlock a -> Int
blockLen [GenBasicBlock Instr]
blocks
        blockLen :: GenBasicBlock a -> Int
blockLen (BasicBlock _ instrs :: [a]
instrs) = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
instrs

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

        makeFar :: Int -> Instr -> Instr
makeFar _ (BCC ALWAYS tgt :: BlockId
tgt _) = Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
tgt Maybe Bool
forall a. Maybe a
Nothing
        makeFar addr :: Int
addr (BCC cond :: Cond
cond tgt :: BlockId
tgt p :: Maybe Bool
p)
            | Int -> Int
forall a. Num a => a -> a
abs (Int
addr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
targetAddr) Int -> Int -> Bool
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 targetAddr :: Int
targetAddr = UniqFM Int -> BlockId -> Maybe Int
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM UniqFM Int
blockAddressMap BlockId
tgt
        makeFar _ other :: 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 = 7000 Int -> Int -> Int
forall a. Num a => a -> a -> a
- LabelMap CmmStatics -> Int
forall (map :: * -> *) a. IsMap map => map a -> Int
mapSize LabelMap CmmStatics
info_env Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
maxRetInfoTableSizeW

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