{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
#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)
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
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]
_
| 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
where x :: Int
x = Int
slots forall a. Num a => a -> a -> a
* Int
spillSlotSize
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
= 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
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
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)
data RI
= RIReg Reg
| RIImm Imm
data Instr
= FastString
| LOCATION Int Int Int String
| LDATA Section RawCmmStatics
| NEWBLOCK BlockId
| DELTA Int
| LD Format Reg AddrMode
| LDFAR Format Reg AddrMode
| LDR Format Reg AddrMode
| LA Format Reg AddrMode
| ST Format Reg AddrMode
| STFAR Format Reg AddrMode
| STU Format Reg AddrMode
| STC Format Reg AddrMode
| LIS Reg Imm
| LI Reg Imm
| MR Reg Reg
| CMP Format Reg RI
| CMPL Format Reg RI
| BCC Cond BlockId (Maybe Bool)
| BCCFAR Cond BlockId (Maybe Bool)
| JMP CLabel [Reg]
| MTCTR Reg
| BCTR [Maybe BlockId] (Maybe CLabel) [Reg]
| BL CLabel [Reg]
| BCTRL [Reg]
| ADD Reg Reg RI
| ADDO Reg Reg Reg
| ADDC Reg Reg Reg
| ADDE Reg Reg Reg
| ADDZE Reg Reg
| ADDIS Reg Reg Imm
| SUBF Reg Reg Reg
| SUBFO Reg Reg Reg
| SUBFC Reg Reg RI
| SUBFE Reg Reg Reg
| MULL Format Reg Reg RI
| MULLO Format Reg Reg Reg
| MFOV Format Reg
| MULHU Format Reg Reg Reg
| DIV Format Bool Reg Reg Reg
| AND Reg Reg RI
| ANDC Reg Reg Reg
| NAND Reg Reg Reg
| OR Reg Reg RI
| ORIS Reg Reg Imm
| XOR Reg Reg RI
| XORIS Reg Reg Imm
| EXTS Format Reg Reg
| CNTLZ Format Reg Reg
| NEG Reg Reg
| NOT Reg Reg
| SL Format Reg Reg RI
| SR Format Reg Reg RI
| SRA Format Reg Reg RI
| RLWINM Reg Reg Int Int Int
| CLRLI Format Reg Reg Int
| CLRRI Format Reg Reg Int
| FADD Format Reg Reg Reg
| FSUB Format Reg Reg Reg
| FMUL Format Reg Reg Reg
| FDIV Format Reg Reg Reg
| FABS Reg Reg
| FNEG Reg Reg
| FCMP Reg Reg
| FCTIWZ Reg Reg
| FCTIDZ Reg Reg
| FCFID Reg Reg
| FRSP Reg Reg
| CRNOR Int Int Int
| MFCR Reg
| MFLR Reg
| FETCHPC Reg
| HWSYNC
| ISYNC
| LWSYNC
| NOP
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"
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
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
BCTRL [Reg]
argRegs -> [Reg] -> Instr
BCTRL [Reg]
argRegs
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
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
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
_ -> []
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
mkSpillInstr
:: NCGConfig
-> Reg
-> Int
-> Int
-> [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
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
-> Int
-> Int
-> [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
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)))]
stackFrameHeaderSize :: Platform -> Int
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
Arch
ArchPPC -> Int
64
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"
spillSlotSize :: Int
spillSlotSize :: Int
spillSlotSize = Int
8
maxSpillSlots :: NCGConfig -> Int
maxSpillSlots :: NCGConfig -> Int
maxSpillSlots NCGConfig
config
= 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
stackAlign :: Int
stackAlign :: Int
stackAlign = Int
16
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
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
mkRegRegMoveInstr
:: Reg
-> Reg
-> Instr
mkRegRegMoveInstr :: Reg -> Reg -> Instr
mkRegRegMoveInstr Reg
src Reg
dst
= Reg -> Reg -> Instr
MR Reg
dst Reg
src
mkJumpInstr
:: BlockId
-> [Instr]
mkJumpInstr :: BlockId -> [Instr]
mkJumpInstr BlockId
id
= [Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
id forall a. Maybe a
Nothing]
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
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
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