{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NondecreasingIndentation #-}
module GHC.CmmToAsm.X86.CodeGen (
cmmTopCodeGen,
generateJumpTableForInstr,
extractUnwindPoints,
invertCondBranches,
InstrBlock
)
where
import GHC.Prelude
import GHC.CmmToAsm.X86.Instr
import GHC.CmmToAsm.X86.Cond
import GHC.CmmToAsm.X86.Regs
import GHC.CmmToAsm.X86.Ppr
import GHC.CmmToAsm.X86.RegInfo
import GHC.Platform.Regs
import GHC.CmmToAsm.CPrim
import GHC.CmmToAsm.Types
import GHC.Cmm.DebugBlock
( DebugBlock(..), UnwindPoint(..), UnwindTable
, UnwindExpr(UwReg), toUnwindExpr
)
import GHC.CmmToAsm.PIC
import GHC.CmmToAsm.Monad
( NatM, getNewRegNat, getNewLabelNat, setDeltaNat
, getDeltaNat, getBlockIdNat, getPicBaseNat
, Reg64(..), RegCode64(..), getNewReg64, localReg64
, getPicBaseMaybeNat, getDebugBlock, getFileId
, addImmediateSuccessorNat, updateCfgNat, getConfig, getPlatform
, getCfgWeights
)
import GHC.CmmToAsm.CFG
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Config
import GHC.Platform.Reg
import GHC.Platform
import GHC.Types.Basic
import GHC.Cmm.BlockId
import GHC.Unit.Types ( ghcInternalUnitId )
import GHC.Cmm.Utils
import GHC.Cmm.Switch
import GHC.Cmm
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.CLabel
import GHC.Types.Tickish ( GenTickish(..) )
import GHC.Types.SrcLoc ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
import GHC.Data.Maybe ( expectJust )
import GHC.Types.ForeignCall ( CCallConv(..) )
import GHC.Data.OrdList
import GHC.Utils.Outputable
import GHC.Utils.Constants (debugIsOn)
import GHC.Utils.Monad ( foldMapM )
import GHC.Utils.Panic
import GHC.Data.FastString
import GHC.Utils.Misc
import GHC.Types.Unique.DSM ( getUniqueM )
import qualified Data.Semigroup as S
import Control.Monad
import Control.Monad.Trans.State.Strict
( StateT, evalStateT, get, put )
import Control.Monad.Trans.Class (lift)
import Data.Foldable (fold)
import Data.Int
import Data.List (partition)
import Data.Maybe
import Data.Word
import qualified Data.Map as Map
is32BitPlatform :: NatM Bool
is32BitPlatform :: NatM Bool
is32BitPlatform = do
platform <- NatM Platform
getPlatform
return $ target32Bit platform
ssse3Enabled :: NatM Bool
ssse3Enabled :: NatM Bool
ssse3Enabled = do
config <- NatM NCGConfig
getConfig
return (ncgSseVersion config >= Just SSSE3)
sse4_1Enabled :: NatM Bool
sse4_1Enabled :: NatM Bool
sse4_1Enabled = do
config <- NatM NCGConfig
getConfig
return (ncgSseVersion config >= Just SSE4)
sse4_2Enabled :: NatM Bool
sse4_2Enabled :: NatM Bool
sse4_2Enabled = do
config <- NatM NCGConfig
getConfig
return (ncgSseVersion config >= Just SSE42)
avxEnabled :: NatM Bool
avxEnabled :: NatM Bool
avxEnabled = do
config <- NatM NCGConfig
getConfig
return (ncgAvxEnabled config)
avx2Enabled :: NatM Bool
avx2Enabled :: NatM Bool
avx2Enabled = do
config <- NatM NCGConfig
getConfig
return (ncgAvx2Enabled config)
cmmTopCodeGen
:: RawCmmDecl
-> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr]
cmmTopCodeGen :: RawCmmDecl -> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr]
cmmTopCodeGen (CmmProc LabelMap RawCmmStatics
info CLabel
lab [GlobalRegUse]
live CmmGraph
graph) = do
let blocks :: [CmmBlock]
blocks = CmmGraph -> [CmmBlock]
toBlockListEntryFirst CmmGraph
graph
(nat_blocks,statics) <- (CmmBlock
-> NatM
([NatBasicBlock Instr],
[NatCmmDecl (Alignment, RawCmmStatics) Instr]))
-> [CmmBlock]
-> NatM
([[NatBasicBlock Instr]],
[[NatCmmDecl (Alignment, RawCmmStatics) Instr]])
forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM CmmBlock
-> NatM
([NatBasicBlock Instr],
[NatCmmDecl (Alignment, RawCmmStatics) Instr])
basicBlockCodeGen [CmmBlock]
blocks
picBaseMb <- getPicBaseMaybeNat
platform <- getPlatform
let proc = LabelMap RawCmmStatics
-> CLabel
-> [GlobalRegUse]
-> ListGraph Instr
-> NatCmmDecl (Alignment, RawCmmStatics) Instr
forall d h g.
h -> CLabel -> [GlobalRegUse] -> g -> GenCmmDecl d h g
CmmProc LabelMap RawCmmStatics
info CLabel
lab [GlobalRegUse]
live ([NatBasicBlock Instr] -> ListGraph Instr
forall i. [GenBasicBlock i] -> ListGraph i
ListGraph ([NatBasicBlock Instr] -> ListGraph Instr)
-> [NatBasicBlock Instr] -> ListGraph Instr
forall a b. (a -> b) -> a -> b
$ [[NatBasicBlock Instr]] -> [NatBasicBlock Instr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[NatBasicBlock Instr]]
nat_blocks)
tops = NatCmmDecl (Alignment, RawCmmStatics) Instr
proc NatCmmDecl (Alignment, RawCmmStatics) Instr
-> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
-> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
forall a. a -> [a] -> [a]
: [[NatCmmDecl (Alignment, RawCmmStatics) Instr]]
-> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[NatCmmDecl (Alignment, RawCmmStatics) Instr]]
statics
os = Platform -> OS
platformOS Platform
platform
case picBaseMb of
Just Reg
picBase -> OS
-> Reg
-> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
-> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr]
initializePicBase_x86 OS
os Reg
picBase [NatCmmDecl (Alignment, RawCmmStatics) Instr]
tops
Maybe Reg
Nothing -> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
-> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr]
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return [NatCmmDecl (Alignment, RawCmmStatics) Instr]
tops
cmmTopCodeGen (CmmData Section
sec RawCmmStatics
dat) =
[NatCmmDecl (Alignment, RawCmmStatics) Instr]
-> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr]
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return [Section
-> (Alignment, RawCmmStatics)
-> NatCmmDecl (Alignment, RawCmmStatics) Instr
forall d h g. Section -> d -> GenCmmDecl d h g
CmmData Section
sec (Int -> Alignment
mkAlignment Int
1, RawCmmStatics
dat)]
verifyBasicBlock :: Platform -> [Instr] -> ()
verifyBasicBlock :: Platform -> [Instr] -> ()
verifyBasicBlock Platform
platform [Instr]
instrs
| Bool
debugIsOn = Bool -> [Instr] -> ()
go Bool
False [Instr]
instrs
| Bool
otherwise = ()
where
go :: Bool -> [Instr] -> ()
go Bool
_ [] = ()
go Bool
atEnd (Instr
i:[Instr]
instr)
= case Instr
i of
NEWBLOCK {} -> Bool -> [Instr] -> ()
go Bool
False [Instr]
instr
CALL {} | Bool
atEnd -> Instr -> ()
faultyBlockWith Instr
i
| Bool -> Bool
not Bool
atEnd -> Bool -> [Instr] -> ()
go Bool
atEnd [Instr]
instr
Instr
_ | Bool -> Bool
not Bool
atEnd -> Bool -> [Instr] -> ()
go (Instr -> Bool
isJumpishInstr Instr
i) [Instr]
instr
| Bool
otherwise -> if Instr -> Bool
isJumpishInstr Instr
i
then Bool -> [Instr] -> ()
go Bool
True [Instr]
instr
else Instr -> ()
faultyBlockWith Instr
i
faultyBlockWith :: Instr -> ()
faultyBlockWith Instr
i
= String -> SDoc -> ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Non control flow instructions after end of basic block."
(Platform -> Instr -> SDoc
forall doc. IsDoc doc => Platform -> Instr -> doc
pprInstr Platform
platform Instr
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in:" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((Instr -> SDoc) -> [Instr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> Instr -> SDoc
forall doc. IsDoc doc => Platform -> Instr -> doc
pprInstr Platform
platform) [Instr]
instrs))
basicBlockCodeGen
:: CmmBlock
-> NatM ( [NatBasicBlock Instr]
, [NatCmmDecl (Alignment, RawCmmStatics) Instr])
basicBlockCodeGen :: CmmBlock
-> NatM
([NatBasicBlock Instr],
[NatCmmDecl (Alignment, RawCmmStatics) Instr])
basicBlockCodeGen CmmBlock
block = do
let (CmmNode C O
_, Block CmmNode O O
nodes, CmmNode O C
tail) = CmmBlock -> (CmmNode C O, Block CmmNode O O, CmmNode O C)
forall (n :: Extensibility -> Extensibility -> *).
Block n C C -> (n C O, Block n O O, n O C)
blockSplit CmmBlock
block
id :: Label
id = CmmBlock -> Label
forall (x :: Extensibility). Block CmmNode C x -> Label
forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel CmmBlock
block
stmts :: [CmmNode O O]
stmts = Block CmmNode O O -> [CmmNode O O]
forall (n :: Extensibility -> Extensibility -> *).
Block n O O -> [n O O]
blockToList Block CmmNode O O
nodes
dbg <- Label -> NatM (Maybe DebugBlock)
getDebugBlock (CmmBlock -> Label
forall (x :: Extensibility). Block CmmNode C x -> Label
forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel CmmBlock
block)
loc_instrs <- case dblSourceTick =<< dbg of
Just (SourceNote RealSrcSpan
span (LexicalFastString FastString
name))
-> do fileId <- FastString -> NatM Int
getFileId (RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
span)
let line = RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
span; col = RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
span
return $ unitOL $ LOCATION fileId line col (unpackFS name)
Maybe CmmTickish
_ -> InstrBlock -> NatM InstrBlock
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return InstrBlock
forall a. OrdList a
nilOL
(mid_instrs,mid_bid) <- stmtsToInstrs id stmts
(!tail_instrs,_) <- stmtToInstrs mid_bid tail
let instrs = InstrBlock
loc_instrs InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
mid_instrs InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
tail_instrs
platform <- getPlatform
return $! verifyBasicBlock platform (fromOL instrs)
instrs' <- fold <$> traverse addSpUnwindings instrs
let
(top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs'
mkBlocks (NEWBLOCK Label
id) ([Instr]
instrs,[NatBasicBlock Instr]
blocks,[GenCmmDecl (Alignment, RawCmmStatics) h g]
statics)
= ([], Label -> [Instr] -> NatBasicBlock Instr
forall i. Label -> [i] -> GenBasicBlock i
BasicBlock Label
id [Instr]
instrs NatBasicBlock Instr
-> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
forall a. a -> [a] -> [a]
: [NatBasicBlock Instr]
blocks, [GenCmmDecl (Alignment, RawCmmStatics) h g]
statics)
mkBlocks (LDATA Section
sec (Alignment, RawCmmStatics)
dat) ([Instr]
instrs,[NatBasicBlock Instr]
blocks,[GenCmmDecl (Alignment, RawCmmStatics) h g]
statics)
= ([Instr]
instrs, [NatBasicBlock Instr]
blocks, Section
-> (Alignment, RawCmmStatics)
-> GenCmmDecl (Alignment, RawCmmStatics) h g
forall d h g. Section -> d -> GenCmmDecl d h g
CmmData Section
sec (Alignment, RawCmmStatics)
datGenCmmDecl (Alignment, RawCmmStatics) h g
-> [GenCmmDecl (Alignment, RawCmmStatics) h g]
-> [GenCmmDecl (Alignment, RawCmmStatics) h g]
forall a. a -> [a] -> [a]
:[GenCmmDecl (Alignment, RawCmmStatics) h g]
statics)
mkBlocks Instr
instr ([Instr]
instrs,[NatBasicBlock Instr]
blocks,[GenCmmDecl (Alignment, RawCmmStatics) h g]
statics)
= (Instr
instrInstr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
:[Instr]
instrs, [NatBasicBlock Instr]
blocks, [GenCmmDecl (Alignment, RawCmmStatics) h g]
statics)
return (BasicBlock id top : other_blocks, statics)
addSpUnwindings :: Instr -> NatM (OrdList Instr)
addSpUnwindings :: Instr -> NatM InstrBlock
addSpUnwindings instr :: Instr
instr@(DELTA Int
d) = do
config <- NatM NCGConfig
getConfig
let platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
if ncgDwarfUnwindings config
then do lbl <- mkAsmTempLabel <$> getUniqueM
let unwind = GlobalReg -> Maybe UnwindExpr -> Map GlobalReg (Maybe UnwindExpr)
forall k a. k -> a -> Map k a
Map.singleton GlobalReg
MachSp (UnwindExpr -> Maybe UnwindExpr
forall a. a -> Maybe a
Just (UnwindExpr -> Maybe UnwindExpr) -> UnwindExpr -> Maybe UnwindExpr
forall a b. (a -> b) -> a -> b
$ GlobalRegUse -> Int -> UnwindExpr
UwReg (GlobalReg -> CmmType -> GlobalRegUse
GlobalRegUse GlobalReg
MachSp (Platform -> CmmType
bWord Platform
platform)) (Int -> UnwindExpr) -> Int -> UnwindExpr
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
negate Int
d)
return $ toOL [ instr, UNWIND lbl unwind ]
else return (unitOL instr)
addSpUnwindings Instr
instr = InstrBlock -> NatM InstrBlock
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (InstrBlock -> NatM InstrBlock) -> InstrBlock -> NatM InstrBlock
forall a b. (a -> b) -> a -> b
$ Instr -> InstrBlock
forall a. a -> OrdList a
unitOL Instr
instr
stmtsToInstrs :: BlockId
-> [CmmNode O O]
-> NatM (InstrBlock, BlockId)
stmtsToInstrs :: Label -> [CmmNode O O] -> NatM (InstrBlock, Label)
stmtsToInstrs Label
bid [CmmNode O O]
stmts =
Label -> [CmmNode O O] -> InstrBlock -> NatM (InstrBlock, Label)
forall {e :: Extensibility} {x :: Extensibility}.
Label -> [CmmNode e x] -> InstrBlock -> NatM (InstrBlock, Label)
go Label
bid [CmmNode O O]
stmts InstrBlock
forall a. OrdList a
nilOL
where
go :: Label -> [CmmNode e x] -> InstrBlock -> NatM (InstrBlock, Label)
go Label
bid [] InstrBlock
instrs = (InstrBlock, Label) -> NatM (InstrBlock, Label)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (InstrBlock
instrs,Label
bid)
go Label
bid (CmmNode e x
s:[CmmNode e x]
stmts) InstrBlock
instrs = do
(instrs',bid') <- Label -> CmmNode e x -> NatM (InstrBlock, Maybe Label)
forall (e :: Extensibility) (x :: Extensibility).
Label -> CmmNode e x -> NatM (InstrBlock, Maybe Label)
stmtToInstrs Label
bid CmmNode e x
s
let !newBid = Label -> Maybe Label -> Label
forall a. a -> Maybe a -> a
fromMaybe Label
bid Maybe Label
bid'
go newBid stmts (instrs `appOL` instrs')
stmtToInstrs :: BlockId
-> CmmNode e x
-> NatM (InstrBlock, Maybe BlockId)
stmtToInstrs :: forall (e :: Extensibility) (x :: Extensibility).
Label -> CmmNode e x -> NatM (InstrBlock, Maybe Label)
stmtToInstrs Label
bid CmmNode e x
stmt = do
is32Bit <- NatM Bool
is32BitPlatform
platform <- getPlatform
case stmt of
CmmUnsafeForeignCall ForeignTarget
target [LocalReg]
result_regs [CmmExpr]
args
-> ForeignTarget
-> [LocalReg]
-> [CmmExpr]
-> Label
-> NatM (InstrBlock, Maybe Label)
genForeignCall ForeignTarget
target [LocalReg]
result_regs [CmmExpr]
args Label
bid
CmmNode e x
_ -> (,Maybe Label
forall a. Maybe a
Nothing) (InstrBlock -> (InstrBlock, Maybe Label))
-> NatM InstrBlock -> NatM (InstrBlock, Maybe Label)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case CmmNode e x
stmt of
CmmComment FastString
s -> InstrBlock -> NatM InstrBlock
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (FastString -> Instr
COMMENT FastString
s))
CmmTick {} -> InstrBlock -> NatM InstrBlock
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return InstrBlock
forall a. OrdList a
nilOL
CmmUnwind [(GlobalReg, Maybe CmmExpr)]
regs -> do
let to_unwind_entry :: (GlobalReg, Maybe CmmExpr) -> UnwindTable
to_unwind_entry :: (GlobalReg, Maybe CmmExpr) -> Map GlobalReg (Maybe UnwindExpr)
to_unwind_entry (GlobalReg
reg, Maybe CmmExpr
expr) = GlobalReg -> Maybe UnwindExpr -> Map GlobalReg (Maybe UnwindExpr)
forall k a. k -> a -> Map k a
Map.singleton GlobalReg
reg ((CmmExpr -> UnwindExpr) -> Maybe CmmExpr -> Maybe UnwindExpr
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Platform -> CmmExpr -> UnwindExpr
toUnwindExpr Platform
platform) Maybe CmmExpr
expr)
case ((GlobalReg, Maybe CmmExpr) -> Map GlobalReg (Maybe UnwindExpr))
-> [(GlobalReg, Maybe CmmExpr)] -> Map GlobalReg (Maybe UnwindExpr)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (GlobalReg, Maybe CmmExpr) -> Map GlobalReg (Maybe UnwindExpr)
to_unwind_entry [(GlobalReg, Maybe CmmExpr)]
regs of
Map GlobalReg (Maybe UnwindExpr)
tbl | Map GlobalReg (Maybe UnwindExpr) -> Bool
forall k a. Map k a -> Bool
Map.null Map GlobalReg (Maybe UnwindExpr)
tbl -> InstrBlock -> NatM InstrBlock
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return InstrBlock
forall a. OrdList a
nilOL
| Bool
otherwise -> do
lbl <- Unique -> CLabel
forall a. Uniquable a => a -> CLabel
mkAsmTempLabel (Unique -> CLabel) -> NatM Unique -> NatM CLabel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NatM Unique
forall (m :: * -> *). MonadGetUnique m => m Unique
getUniqueM
return $ unitOL $ UNWIND lbl tbl
CmmAssign CmmReg
reg CmmExpr
src
| CmmType -> Bool
isFloatType CmmType
ty -> CmmReg -> CmmExpr -> NatM InstrBlock
assignReg_FltCode CmmReg
reg CmmExpr
src
| Bool
is32Bit Bool -> Bool -> Bool
&& CmmType -> Bool
isWord64 CmmType
ty -> CmmReg -> CmmExpr -> NatM InstrBlock
assignReg_I64Code CmmReg
reg CmmExpr
src
| CmmType -> Bool
isVecType CmmType
ty -> CmmReg -> CmmExpr -> NatM InstrBlock
assignReg_VecCode CmmReg
reg CmmExpr
src
| Bool
otherwise -> CmmReg -> CmmExpr -> NatM InstrBlock
assignReg_IntCode CmmReg
reg CmmExpr
src
where ty :: CmmType
ty = CmmReg -> CmmType
cmmRegType CmmReg
reg
CmmStore CmmExpr
addr CmmExpr
src AlignmentSpec
_alignment
| CmmType -> Bool
isFloatType CmmType
ty -> Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_FltCode Format
format CmmExpr
addr CmmExpr
src
| Bool
is32Bit Bool -> Bool -> Bool
&& CmmType -> Bool
isWord64 CmmType
ty -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_I64Code CmmExpr
addr CmmExpr
src
| CmmType -> Bool
isVecType CmmType
ty -> Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_VecCode Format
format CmmExpr
addr CmmExpr
src
| Bool
otherwise -> Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_IntCode Format
format CmmExpr
addr CmmExpr
src
where ty :: CmmType
ty = Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
src
format :: Format
format = CmmType -> Format
cmmTypeFormat CmmType
ty
CmmBranch Label
id -> InstrBlock -> NatM InstrBlock
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (InstrBlock -> NatM InstrBlock) -> InstrBlock -> NatM InstrBlock
forall a b. (a -> b) -> a -> b
$ Label -> InstrBlock
genBranch Label
id
CmmCondBranch CmmExpr
arg Label
true Label
false Maybe Bool
_ -> Label -> Label -> Label -> CmmExpr -> NatM InstrBlock
genCondBranch Label
bid Label
true Label
false CmmExpr
arg
CmmSwitch CmmExpr
arg SwitchTargets
ids -> CmmExpr -> SwitchTargets -> NatM InstrBlock
genSwitch CmmExpr
arg SwitchTargets
ids
CmmCall { cml_target :: CmmNode O C -> CmmExpr
cml_target = CmmExpr
arg
, cml_args_regs :: CmmNode O C -> [GlobalRegUse]
cml_args_regs = [GlobalRegUse]
gregs } -> CmmExpr -> [RegWithFormat] -> NatM InstrBlock
genJump CmmExpr
arg (Platform -> [GlobalRegUse] -> [RegWithFormat]
jumpRegs Platform
platform [GlobalRegUse]
gregs)
CmmNode e x
_ ->
String -> NatM InstrBlock
forall a. HasCallStack => String -> a
panic String
"stmtToInstrs: statement should have been cps'd away"
jumpRegs :: Platform -> [GlobalRegUse] -> [RegWithFormat]
jumpRegs :: Platform -> [GlobalRegUse] -> [RegWithFormat]
jumpRegs Platform
platform [GlobalRegUse]
gregs =
[ Reg -> Format -> RegWithFormat
RegWithFormat (RealReg -> Reg
RegReal RealReg
r) (CmmType -> Format
cmmTypeFormat CmmType
ty)
| GlobalRegUse GlobalReg
gr CmmType
ty <- [GlobalRegUse]
gregs
, Just RealReg
r <- [Platform -> GlobalReg -> Maybe RealReg
globalRegMaybe Platform
platform GlobalReg
gr] ]
type InstrBlock
= OrdList Instr
data CondCode
= CondCode Bool Cond InstrBlock
data Register
= Fixed Format Reg InstrBlock
| Any Format (Reg -> InstrBlock)
swizzleRegisterRep :: Register -> Format -> Register
swizzleRegisterRep :: Register -> Format -> Register
swizzleRegisterRep (Fixed Format
_ Reg
reg InstrBlock
code) Format
format = Format -> Reg -> InstrBlock -> Register
Fixed Format
format Reg
reg InstrBlock
code
swizzleRegisterRep (Any Format
_ Reg -> InstrBlock
codefn) Format
format = Format -> (Reg -> InstrBlock) -> Register
Any Format
format Reg -> InstrBlock
codefn
getLocalRegReg :: LocalReg -> Reg
getLocalRegReg :: LocalReg -> Reg
getLocalRegReg (LocalReg Unique
u CmmType
ty)
=
VirtualReg -> Reg
RegVirtual (Unique -> Format -> VirtualReg
mkVirtualReg Unique
u (CmmType -> Format
cmmTypeFormat CmmType
ty))
getRegisterReg :: Platform -> CmmReg -> Reg
getRegisterReg :: Platform -> CmmReg -> Reg
getRegisterReg Platform
_ (CmmLocal LocalReg
lreg) = LocalReg -> Reg
getLocalRegReg LocalReg
lreg
getRegisterReg Platform
platform (CmmGlobal GlobalRegUse
mid)
= case Platform -> GlobalReg -> Maybe RealReg
globalRegMaybe Platform
platform (GlobalReg -> Maybe RealReg) -> GlobalReg -> Maybe RealReg
forall a b. (a -> b) -> a -> b
$ GlobalRegUse -> GlobalReg
globalRegUse_reg GlobalRegUse
mid of
Just RealReg
reg -> RealReg -> Reg
RegReal (RealReg -> Reg) -> RealReg -> Reg
forall a b. (a -> b) -> a -> b
$ RealReg
reg
Maybe RealReg
Nothing -> String -> SDoc -> Reg
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegisterReg-memory" (CmmReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CmmReg -> SDoc) -> CmmReg -> SDoc
forall a b. (a -> b) -> a -> b
$ GlobalRegUse -> CmmReg
CmmGlobal GlobalRegUse
mid)
data Amode
= Amode AddrMode InstrBlock
is32BitInteger :: Integer -> Bool
is32BitInteger :: Integer -> Bool
is32BitInteger Integer
i = Int64
i64 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0x7fffffff Bool -> Bool -> Bool
&& Int64
i64 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= -Int64
0x80000000
where i64 :: Int64
i64 = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Int64
jumpTableEntry :: NCGConfig -> Maybe BlockId -> CmmStatic
jumpTableEntry :: NCGConfig -> Maybe Label -> CmmStatic
jumpTableEntry NCGConfig
config Maybe Label
Nothing = CmmLit -> CmmStatic
CmmStaticLit (Integer -> Width -> CmmLit
CmmInt Integer
0 (NCGConfig -> Width
ncgWordWidth NCGConfig
config))
jumpTableEntry NCGConfig
_ (Just Label
blockid) = CmmLit -> CmmStatic
CmmStaticLit (CLabel -> CmmLit
CmmLabel CLabel
blockLabel)
where blockLabel :: CLabel
blockLabel = Label -> CLabel
blockLbl Label
blockid
mangleIndexTree :: CmmReg -> Int -> CmmExpr
mangleIndexTree :: CmmReg -> Int -> CmmExpr
mangleIndexTree CmmReg
reg Int
off
= MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add Width
width) [CmmReg -> CmmExpr
CmmReg CmmReg
reg, CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off) Width
width)]
where width :: Width
width = CmmType -> Width
typeWidth (CmmReg -> CmmType
cmmRegType CmmReg
reg)
getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
expr = do
r <- HasDebugCallStack => CmmExpr -> NatM Register
CmmExpr -> NatM Register
getRegister CmmExpr
expr
case r of
Any Format
rep Reg -> InstrBlock
code -> do
tmp <- Format -> NatM Reg
getNewRegNat Format
rep
return (tmp, code tmp)
Fixed Format
_ Reg
reg InstrBlock
code ->
(Reg, InstrBlock) -> NatM (Reg, InstrBlock)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
reg, InstrBlock
code)
assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_I64Code CmmExpr
addrTree CmmExpr
valueTree = do
Amode addr addr_code <- CmmExpr -> NatM Amode
getAmode CmmExpr
addrTree
RegCode64 vcode rhi rlo <- iselExpr64 valueTree
let
mov_lo = Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
rlo) (AddrMode -> Operand
OpAddr AddrMode
addr)
mov_hi = Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
rhi) (AddrMode -> Operand
OpAddr (Maybe AddrMode -> AddrMode
forall a. HasCallStack => Maybe a -> a
fromJust (AddrMode -> Int -> Maybe AddrMode
addrOffset AddrMode
addr Int
4)))
return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock
assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock
assignReg_I64Code (CmmLocal LocalReg
dst) CmmExpr
valueTree = do
RegCode64 vcode r_src_hi r_src_lo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
valueTree
let
Reg64 r_dst_hi r_dst_lo = localReg64 dst
mov_lo = Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r_src_lo) (Reg -> Operand
OpReg Reg
r_dst_lo)
mov_hi = Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r_src_hi) (Reg -> Operand
OpReg Reg
r_dst_hi)
return (
vcode `snocOL` mov_lo `snocOL` mov_hi
)
assignReg_I64Code CmmReg
_ CmmExpr
_
= String -> NatM InstrBlock
forall a. HasCallStack => String -> a
panic String
"assignReg_I64Code(i386): invalid lvalue"
iselExpr64 :: HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 :: HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 (CmmLit (CmmInt Integer
i Width
_)) = do
Reg64 rhi rlo <- NatM Reg64
getNewReg64
let
r = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Word32)
q = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
32) :: Word32)
code = [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
r)) (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
q)) (Reg -> Operand
OpReg Reg
rhi)
]
return (RegCode64 code rhi rlo)
iselExpr64 (CmmLoad CmmExpr
addrTree CmmType
ty AlignmentSpec
_) | CmmType -> Bool
isWord64 CmmType
ty = do
Amode addr addr_code <- CmmExpr -> NatM Amode
getAmode CmmExpr
addrTree
Reg64 rhi rlo <- getNewReg64
let
mov_lo = Format -> Operand -> Operand -> Instr
MOV Format
II32 (AddrMode -> Operand
OpAddr AddrMode
addr) (Reg -> Operand
OpReg Reg
rlo)
mov_hi = Format -> Operand -> Operand -> Instr
MOV Format
II32 (AddrMode -> Operand
OpAddr (Maybe AddrMode -> AddrMode
forall a. HasCallStack => Maybe a -> a
fromJust (AddrMode -> Int -> Maybe AddrMode
addrOffset AddrMode
addr Int
4))) (Reg -> Operand
OpReg Reg
rhi)
return (
RegCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi) rhi rlo
)
iselExpr64 (CmmReg (CmmLocal LocalReg
local_reg)) = do
let Reg64 Reg
hi Reg
lo = HasDebugCallStack => LocalReg -> Reg64
LocalReg -> Reg64
localReg64 LocalReg
local_reg
RegCode64 InstrBlock -> NatM (RegCode64 InstrBlock)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (InstrBlock -> Reg -> Reg -> RegCode64 InstrBlock
forall code. code -> Reg -> Reg -> RegCode64 code
RegCode64 InstrBlock
forall a. OrdList a
nilOL Reg
hi Reg
lo)
iselExpr64 (CmmMachOp (MO_Add Width
_) [CmmExpr
e1, CmmLit (CmmInt Integer
i Width
_)]) = do
RegCode64 code1 r1hi r1lo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
e1
Reg64 rhi rlo <- getNewReg64
let
r = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Word32)
q = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
32) :: Word32)
code = InstrBlock
code1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1lo) (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Operand -> Instr
ADD Format
II32 (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
r)) (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1hi) (Reg -> Operand
OpReg Reg
rhi),
Format -> Operand -> Operand -> Instr
ADC Format
II32 (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
q)) (Reg -> Operand
OpReg Reg
rhi) ]
return (RegCode64 code rhi rlo)
iselExpr64 (CmmMachOp (MO_Add Width
_) [CmmExpr
e1,CmmExpr
e2]) = do
RegCode64 code1 r1hi r1lo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
e1
RegCode64 code2 r2hi r2lo <- iselExpr64 e2
Reg64 rhi rlo <- getNewReg64
let
code = InstrBlock
code1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
code2 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1lo) (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Operand -> Instr
ADD Format
II32 (Reg -> Operand
OpReg Reg
r2lo) (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1hi) (Reg -> Operand
OpReg Reg
rhi),
Format -> Operand -> Operand -> Instr
ADC Format
II32 (Reg -> Operand
OpReg Reg
r2hi) (Reg -> Operand
OpReg Reg
rhi) ]
return (RegCode64 code rhi rlo)
iselExpr64 (CmmMachOp (MO_Sub Width
_) [CmmExpr
e1,CmmExpr
e2]) = do
RegCode64 code1 r1hi r1lo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
e1
RegCode64 code2 r2hi r2lo <- iselExpr64 e2
Reg64 rhi rlo <- getNewReg64
let
code = InstrBlock
code1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
code2 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1lo) (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Operand -> Instr
SUB Format
II32 (Reg -> Operand
OpReg Reg
r2lo) (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1hi) (Reg -> Operand
OpReg Reg
rhi),
Format -> Operand -> Operand -> Instr
SBB Format
II32 (Reg -> Operand
OpReg Reg
r2hi) (Reg -> Operand
OpReg Reg
rhi) ]
return (RegCode64 code rhi rlo)
iselExpr64 (CmmMachOp (MO_UU_Conv Width
W32 Width
W64) [CmmExpr
expr]) = do
code <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
expr
Reg64 r_dst_hi r_dst_lo <- getNewReg64
return $ RegCode64 (code r_dst_lo `snocOL`
XOR II32 (OpReg r_dst_hi) (OpReg r_dst_hi))
r_dst_hi
r_dst_lo
iselExpr64 (CmmMachOp (MO_UU_Conv Width
W16 Width
W64) [CmmExpr
expr]) = do
(rsrc, code) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getByteReg CmmExpr
expr
Reg64 r_dst_hi r_dst_lo <- getNewReg64
return $ RegCode64 (code `appOL` toOL [
MOVZxL II16 (OpReg rsrc) (OpReg r_dst_lo),
XOR II32 (OpReg r_dst_hi) (OpReg r_dst_hi)
])
r_dst_hi
r_dst_lo
iselExpr64 (CmmMachOp (MO_UU_Conv Width
W8 Width
W64) [CmmExpr
expr]) = do
(rsrc, code) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getByteReg CmmExpr
expr
Reg64 r_dst_hi r_dst_lo <- getNewReg64
return $ RegCode64 (code `appOL` toOL [
MOVZxL II8 (OpReg rsrc) (OpReg r_dst_lo),
XOR II32 (OpReg r_dst_hi) (OpReg r_dst_hi)
])
r_dst_hi
r_dst_lo
iselExpr64 (CmmMachOp (MO_SS_Conv Width
W32 Width
W64) [CmmExpr
expr]) = do
code <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
expr
Reg64 r_dst_hi r_dst_lo <- getNewReg64
return $ RegCode64 (code r_dst_lo `snocOL`
MOV II32 (OpReg r_dst_lo) (OpReg eax) `snocOL`
CLTD II32 `snocOL`
MOV II32 (OpReg eax) (OpReg r_dst_lo) `snocOL`
MOV II32 (OpReg edx) (OpReg r_dst_hi))
r_dst_hi
r_dst_lo
iselExpr64 (CmmMachOp (MO_SS_Conv Width
W16 Width
W64) [CmmExpr
expr]) = do
(r, code) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getByteReg CmmExpr
expr
Reg64 r_dst_hi r_dst_lo <- getNewReg64
return $ RegCode64 (code `appOL` toOL [
MOVSxL II16 (OpReg r) (OpReg eax),
CLTD II32,
MOV II32 (OpReg eax) (OpReg r_dst_lo),
MOV II32 (OpReg edx) (OpReg r_dst_hi)])
r_dst_hi
r_dst_lo
iselExpr64 (CmmMachOp (MO_SS_Conv Width
W8 Width
W64) [CmmExpr
expr]) = do
(r, code) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getByteReg CmmExpr
expr
Reg64 r_dst_hi r_dst_lo <- getNewReg64
return $ RegCode64 (code `appOL` toOL [
MOVSxL II8 (OpReg r) (OpReg eax),
CLTD II32,
MOV II32 (OpReg eax) (OpReg r_dst_lo),
MOV II32 (OpReg edx) (OpReg r_dst_hi)])
r_dst_hi
r_dst_lo
iselExpr64 (CmmMachOp (MO_S_Neg Width
_) [CmmExpr
expr]) = do
RegCode64 code rhi rlo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
expr
Reg64 rohi rolo <- getNewReg64
let
ocode = InstrBlock
code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
rlo) (Reg -> Operand
OpReg Reg
rolo),
Format -> Operand -> Operand -> Instr
XOR Format
II32 (Reg -> Operand
OpReg Reg
rohi) (Reg -> Operand
OpReg Reg
rohi),
Format -> Operand -> Instr
NEGI Format
II32 (Reg -> Operand
OpReg Reg
rolo),
Format -> Operand -> Operand -> Instr
SBB Format
II32 (Reg -> Operand
OpReg Reg
rhi) (Reg -> Operand
OpReg Reg
rohi) ]
return (RegCode64 ocode rohi rolo)
iselExpr64 (CmmMachOp (MO_Mul Width
_) [CmmExpr
e1,CmmExpr
e2]) = do
RegCode64 code1 r1hi r1lo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
e1
RegCode64 code2 r2hi r2lo <- iselExpr64 e2
Reg64 rhi rlo <- getNewReg64
tmp <- getNewRegNat II32
let
code = InstrBlock
code1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
code2 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1lo) (Reg -> Operand
OpReg Reg
eax),
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r2lo) (Reg -> Operand
OpReg Reg
tmp),
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1hi) (Reg -> Operand
OpReg Reg
rhi),
Format -> Operand -> Operand -> Instr
IMUL Format
II32 (Reg -> Operand
OpReg Reg
tmp) (Reg -> Operand
OpReg Reg
rhi),
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r2hi) (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Operand -> Instr
IMUL Format
II32 (Reg -> Operand
OpReg Reg
eax) (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Operand -> Instr
ADD Format
II32 (Reg -> Operand
OpReg Reg
rlo) (Reg -> Operand
OpReg Reg
rhi),
Format -> Operand -> Instr
MUL2 Format
II32 (Reg -> Operand
OpReg Reg
tmp),
Format -> Operand -> Operand -> Instr
ADD Format
II32 (Reg -> Operand
OpReg Reg
edx) (Reg -> Operand
OpReg Reg
rhi),
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
eax) (Reg -> Operand
OpReg Reg
rlo)
]
return (RegCode64 code rhi rlo)
iselExpr64 (CmmMachOp (MO_S_MulMayOflo Width
W64) [CmmExpr]
_) = do
Reg64 rhi rlo <- NatM Reg64
getNewReg64
let code = [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
1)) (Reg -> Operand
OpReg Reg
rhi),
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
1)) (Reg -> Operand
OpReg Reg
rlo)
]
return (RegCode64 code rhi rlo)
iselExpr64 (CmmMachOp (MO_Shl Width
_) [CmmExpr
e1,CmmExpr
e2]) = do
RegCode64 code1 r1hi r1lo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
e1
code2 <- getAnyReg e2
Reg64 rhi rlo <- getNewReg64
lbl1 <- newBlockId
lbl2 <- newBlockId
let
code = InstrBlock
code1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> InstrBlock
code2 Reg
ecx InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1lo) (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1hi) (Reg -> Operand
OpReg Reg
rhi),
Format -> Operand -> Operand -> Operand -> Instr
SHLD Format
II32 (Reg -> Operand
OpReg Reg
ecx) (Reg -> Operand
OpReg Reg
rlo) (Reg -> Operand
OpReg Reg
rhi),
Format -> Operand -> Operand -> Instr
SHL Format
II32 (Reg -> Operand
OpReg Reg
ecx) (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Operand -> Instr
TEST Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
32)) (Reg -> Operand
OpReg Reg
ecx),
Cond -> Label -> Instr
JXX Cond
EQQ Label
lbl2,
Cond -> Label -> Instr
JXX Cond
ALWAYS Label
lbl1,
Label -> Instr
NEWBLOCK Label
lbl1,
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
rlo) (Reg -> Operand
OpReg Reg
rhi),
Format -> Operand -> Operand -> Instr
XOR Format
II32 (Reg -> Operand
OpReg Reg
rlo) (Reg -> Operand
OpReg Reg
rlo),
Cond -> Label -> Instr
JXX Cond
ALWAYS Label
lbl2,
Label -> Instr
NEWBLOCK Label
lbl2
]
return (RegCode64 code rhi rlo)
iselExpr64 (CmmMachOp (MO_S_Shr Width
_) [CmmExpr
e1,CmmExpr
e2]) = do
RegCode64 code1 r1hi r1lo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
e1
(r2, code2) <- getSomeReg e2
Reg64 rhi rlo <- getNewReg64
lbl1 <- newBlockId
lbl2 <- newBlockId
let
code = InstrBlock
code1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
code2 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1lo) (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1hi) (Reg -> Operand
OpReg Reg
rhi),
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r2) (Reg -> Operand
OpReg Reg
ecx),
Format -> Operand -> Operand -> Operand -> Instr
SHRD Format
II32 (Reg -> Operand
OpReg Reg
ecx) (Reg -> Operand
OpReg Reg
rhi) (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Operand -> Instr
SAR Format
II32 (Reg -> Operand
OpReg Reg
ecx) (Reg -> Operand
OpReg Reg
rhi),
Format -> Operand -> Operand -> Instr
TEST Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
32)) (Reg -> Operand
OpReg Reg
ecx),
Cond -> Label -> Instr
JXX Cond
EQQ Label
lbl2,
Cond -> Label -> Instr
JXX Cond
ALWAYS Label
lbl1,
Label -> Instr
NEWBLOCK Label
lbl1,
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
rhi) (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Operand -> Instr
SAR Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
31)) (Reg -> Operand
OpReg Reg
rhi),
Cond -> Label -> Instr
JXX Cond
ALWAYS Label
lbl2,
Label -> Instr
NEWBLOCK Label
lbl2
]
return (RegCode64 code rhi rlo)
iselExpr64 (CmmMachOp (MO_U_Shr Width
_) [CmmExpr
e1,CmmExpr
e2]) = do
RegCode64 code1 r1hi r1lo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
e1
(r2, code2) <- getSomeReg e2
Reg64 rhi rlo <- getNewReg64
lbl1 <- newBlockId
lbl2 <- newBlockId
let
code = InstrBlock
code1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
code2 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1lo) (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1hi) (Reg -> Operand
OpReg Reg
rhi),
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r2) (Reg -> Operand
OpReg Reg
ecx),
Format -> Operand -> Operand -> Operand -> Instr
SHRD Format
II32 (Reg -> Operand
OpReg Reg
ecx) (Reg -> Operand
OpReg Reg
rhi) (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Operand -> Instr
SHR Format
II32 (Reg -> Operand
OpReg Reg
ecx) (Reg -> Operand
OpReg Reg
rhi),
Format -> Operand -> Operand -> Instr
TEST Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
32)) (Reg -> Operand
OpReg Reg
ecx),
Cond -> Label -> Instr
JXX Cond
EQQ Label
lbl2,
Cond -> Label -> Instr
JXX Cond
ALWAYS Label
lbl1,
Label -> Instr
NEWBLOCK Label
lbl1,
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
rhi) (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Operand -> Instr
XOR Format
II32 (Reg -> Operand
OpReg Reg
rhi) (Reg -> Operand
OpReg Reg
rhi),
Cond -> Label -> Instr
JXX Cond
ALWAYS Label
lbl2,
Label -> Instr
NEWBLOCK Label
lbl2
]
return (RegCode64 code rhi rlo)
iselExpr64 (CmmMachOp (MO_And Width
_) [CmmExpr
e1,CmmExpr
e2]) = (Format -> Operand -> Operand -> Instr)
-> CmmExpr -> CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64ParallelBin Format -> Operand -> Operand -> Instr
AND CmmExpr
e1 CmmExpr
e2
iselExpr64 (CmmMachOp (MO_Or Width
_) [CmmExpr
e1,CmmExpr
e2]) = (Format -> Operand -> Operand -> Instr)
-> CmmExpr -> CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64ParallelBin Format -> Operand -> Operand -> Instr
OR CmmExpr
e1 CmmExpr
e2
iselExpr64 (CmmMachOp (MO_Xor Width
_) [CmmExpr
e1,CmmExpr
e2]) = (Format -> Operand -> Operand -> Instr)
-> CmmExpr -> CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64ParallelBin Format -> Operand -> Operand -> Instr
XOR CmmExpr
e1 CmmExpr
e2
iselExpr64 (CmmMachOp (MO_Not Width
_) [CmmExpr
e1]) = do
RegCode64 code1 r1hi r1lo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
e1
Reg64 rhi rlo <- getNewReg64
let
code = InstrBlock
code1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1lo) (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1hi) (Reg -> Operand
OpReg Reg
rhi),
Format -> Operand -> Instr
NOT Format
II32 (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Instr
NOT Format
II32 (Reg -> Operand
OpReg Reg
rhi)
]
return (RegCode64 code rhi rlo)
iselExpr64 (CmmRegOff CmmReg
r Int
i) = HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 (CmmReg -> Int -> CmmExpr
mangleIndexTree CmmReg
r Int
i)
iselExpr64 CmmExpr
expr
= do
platform <- NatM Platform
getPlatform
pprPanic "iselExpr64(i386)" (pdoc platform expr $+$ text (show expr))
iselExpr64ParallelBin :: (Format -> Operand -> Operand -> Instr)
-> CmmExpr -> CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64ParallelBin :: (Format -> Operand -> Operand -> Instr)
-> CmmExpr -> CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64ParallelBin Format -> Operand -> Operand -> Instr
op CmmExpr
e1 CmmExpr
e2 = do
RegCode64 code1 r1hi r1lo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
e1
RegCode64 code2 r2hi r2lo <- iselExpr64 e2
Reg64 rhi rlo <- getNewReg64
let
code = InstrBlock
code1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
code2 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1lo) (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1hi) (Reg -> Operand
OpReg Reg
rhi),
Format -> Operand -> Operand -> Instr
op Format
II32 (Reg -> Operand
OpReg Reg
r2lo) (Reg -> Operand
OpReg Reg
rlo),
Format -> Operand -> Operand -> Instr
op Format
II32 (Reg -> Operand
OpReg Reg
r2hi) (Reg -> Operand
OpReg Reg
rhi)
]
return (RegCode64 code rhi rlo)
getRegister :: HasDebugCallStack => CmmExpr -> NatM Register
getRegister :: HasDebugCallStack => CmmExpr -> NatM Register
getRegister CmmExpr
e = do platform <- NatM Platform
getPlatform
is32Bit <- is32BitPlatform
getRegister' platform is32Bit e
getRegister' :: HasDebugCallStack => Platform -> Bool -> CmmExpr -> NatM Register
getRegister' :: HasDebugCallStack => Platform -> Bool -> CmmExpr -> NatM Register
getRegister' Platform
platform Bool
is32Bit (CmmReg CmmReg
reg)
= case CmmReg
reg of
CmmGlobal (GlobalRegUse GlobalReg
PicBaseReg CmmType
_)
| Bool
is32Bit ->
do reg' <- Format -> NatM Reg
getPicBaseNat (Bool -> Format
archWordFormat Bool
is32Bit)
return (Fixed (archWordFormat is32Bit) reg' nilOL)
CmmReg
_ ->
let ty :: CmmType
ty = CmmReg -> CmmType
cmmRegType CmmReg
reg
reg_fmt :: Format
reg_fmt = CmmType -> Format
cmmTypeFormat CmmType
ty
in Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Register -> NatM Register) -> Register -> NatM Register
forall a b. (a -> b) -> a -> b
$ Format -> Reg -> InstrBlock -> Register
Fixed Format
reg_fmt (Platform -> CmmReg -> Reg
getRegisterReg Platform
platform CmmReg
reg) InstrBlock
forall a. OrdList a
nilOL
getRegister' Platform
platform Bool
is32Bit (CmmRegOff CmmReg
r Int
n)
= HasDebugCallStack => Platform -> Bool -> CmmExpr -> NatM Register
Platform -> Bool -> CmmExpr -> NatM Register
getRegister' Platform
platform Bool
is32Bit (CmmExpr -> NatM Register) -> CmmExpr -> NatM Register
forall a b. (a -> b) -> a -> b
$ CmmReg -> Int -> CmmExpr
mangleIndexTree CmmReg
r Int
n
getRegister' Platform
platform Bool
is32Bit (CmmMachOp (MO_RelaxedRead Width
w) [CmmExpr
e])
= HasDebugCallStack => Platform -> Bool -> CmmExpr -> NatM Register
Platform -> Bool -> CmmExpr -> NatM Register
getRegister' Platform
platform Bool
is32Bit (CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
CmmLoad CmmExpr
e (Width -> CmmType
cmmBits Width
w) AlignmentSpec
NaturallyAligned)
getRegister' Platform
platform Bool
is32Bit (CmmMachOp (MO_AlignmentCheck Int
align Width
_) [CmmExpr
e])
= Int -> Register -> Register
addAlignmentCheck Int
align (Register -> Register) -> NatM Register -> NatM Register
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasDebugCallStack => Platform -> Bool -> CmmExpr -> NatM Register
Platform -> Bool -> CmmExpr -> NatM Register
getRegister' Platform
platform Bool
is32Bit CmmExpr
e
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_UU_Conv Width
W64 Width
W32)
[CmmMachOp (MO_U_Shr Width
W64) [CmmExpr
x,CmmLit (CmmInt Integer
32 Width
_)]])
| Bool
is32Bit = do
RegCode64 code rhi _rlo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
x
return $ Fixed II32 rhi code
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_SS_Conv Width
W64 Width
W32)
[CmmMachOp (MO_U_Shr Width
W64) [CmmExpr
x,CmmLit (CmmInt Integer
32 Width
_)]])
| Bool
is32Bit = do
RegCode64 code rhi _rlo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
x
return $ Fixed II32 rhi code
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_UU_Conv Width
W64 Width
W32) [CmmExpr
x])
| Bool
is32Bit = do
RegCode64 code _rhi rlo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
x
return $ Fixed II32 rlo code
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_SS_Conv Width
W64 Width
W32) [CmmExpr
x])
| Bool
is32Bit = do
RegCode64 code _rhi rlo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
x
return $ Fixed II32 rlo code
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_UU_Conv Width
W64 Width
W8) [CmmExpr
x])
| Bool
is32Bit = do
RegCode64 code _rhi rlo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
x
ro <- getNewRegNat II8
return $ Fixed II8 ro (code `appOL` toOL [ MOVZxL II8 (OpReg rlo) (OpReg ro) ])
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_UU_Conv Width
W64 Width
W16) [CmmExpr
x])
| Bool
is32Bit = do
RegCode64 code _rhi rlo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
x
ro <- getNewRegNat II16
return $ Fixed II16 ro (code `appOL` toOL [ MOVZxL II16 (OpReg rlo) (OpReg ro) ])
getRegister' Platform
_ Bool
_ (CmmMachOp (MO_UU_Conv Width
W8 Width
W32) [CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_]) = do
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> InstrBlock)
intLoadCode (Format -> Operand -> Operand -> Instr
MOVZxL Format
II8) CmmExpr
addr
return (Any II32 code)
getRegister' Platform
_ Bool
_ (CmmMachOp (MO_SS_Conv Width
W8 Width
W32) [CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_]) = do
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> InstrBlock)
intLoadCode (Format -> Operand -> Operand -> Instr
MOVSxL Format
II8) CmmExpr
addr
return (Any II32 code)
getRegister' Platform
_ Bool
_ (CmmMachOp (MO_UU_Conv Width
W16 Width
W32) [CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_]) = do
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> InstrBlock)
intLoadCode (Format -> Operand -> Operand -> Instr
MOVZxL Format
II16) CmmExpr
addr
return (Any II32 code)
getRegister' Platform
_ Bool
_ (CmmMachOp (MO_SS_Conv Width
W16 Width
W32) [CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_]) = do
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> InstrBlock)
intLoadCode (Format -> Operand -> Operand -> Instr
MOVSxL Format
II16) CmmExpr
addr
return (Any II32 code)
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_UU_Conv Width
W8 Width
W64) [CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_])
| Bool -> Bool
not Bool
is32Bit = do
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> InstrBlock)
intLoadCode (Format -> Operand -> Operand -> Instr
MOVZxL Format
II8) CmmExpr
addr
return (Any II64 code)
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_SS_Conv Width
W8 Width
W64) [CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_])
| Bool -> Bool
not Bool
is32Bit = do
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> InstrBlock)
intLoadCode (Format -> Operand -> Operand -> Instr
MOVSxL Format
II8) CmmExpr
addr
return (Any II64 code)
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_UU_Conv Width
W16 Width
W64) [CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_])
| Bool -> Bool
not Bool
is32Bit = do
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> InstrBlock)
intLoadCode (Format -> Operand -> Operand -> Instr
MOVZxL Format
II16) CmmExpr
addr
return (Any II64 code)
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_SS_Conv Width
W16 Width
W64) [CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_])
| Bool -> Bool
not Bool
is32Bit = do
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> InstrBlock)
intLoadCode (Format -> Operand -> Operand -> Instr
MOVSxL Format
II16) CmmExpr
addr
return (Any II64 code)
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_UU_Conv Width
W32 Width
W64) [CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_])
| Bool -> Bool
not Bool
is32Bit = do
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> InstrBlock)
intLoadCode (Format -> Operand -> Operand -> Instr
MOV Format
II32) CmmExpr
addr
return (Any II64 code)
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_SS_Conv Width
W32 Width
W64) [CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_])
| Bool -> Bool
not Bool
is32Bit = do
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> InstrBlock)
intLoadCode (Format -> Operand -> Operand -> Instr
MOVSxL Format
II32) CmmExpr
addr
return (Any II64 code)
getRegister' Platform
_ Bool
is32Bit (CmmMachOp (MO_Add Width
W64) [CmmReg (CmmGlobal (GlobalRegUse GlobalReg
PicBaseReg CmmType
_)),
CmmLit CmmLit
displacement])
| Bool -> Bool
not Bool
is32Bit =
Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Register -> NatM Register) -> Register -> NatM Register
forall a b. (a -> b) -> a -> b
$ Format -> (Reg -> InstrBlock) -> Register
Any Format
II64 (\Reg
dst -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Instr -> InstrBlock) -> Instr -> InstrBlock
forall a b. (a -> b) -> a -> b
$
Format -> Operand -> Operand -> Instr
LEA Format
II64 (AddrMode -> Operand
OpAddr (Imm -> AddrMode
ripRel (CmmLit -> Imm
litToImm CmmLit
displacement))) (Reg -> Operand
OpReg Reg
dst))
getRegister' Platform
_ Bool
_ (CmmMachOp MachOp
mop []) =
String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegister(x86): nullary MachOp" (String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ MachOp -> String
forall a. Show a => a -> String
show MachOp
mop)
getRegister' Platform
platform Bool
is32Bit (CmmMachOp MachOp
mop [CmmExpr
x]) = do
avx <- NatM Bool
avxEnabled
avx2 <- avx2Enabled
case mop of
MO_F_Neg Width
w -> Width -> CmmExpr -> NatM Register
sse2NegCode Width
w CmmExpr
x
MO_S_Neg Width
w -> (Format -> Operand -> Instr) -> Format -> NatM Register
triv_ucode Format -> Operand -> Instr
NEGI (Width -> Format
intFormat Width
w)
MO_Not Width
w -> (Format -> Operand -> Instr) -> Format -> NatM Register
triv_ucode Format -> Operand -> Instr
NOT (Width -> Format
intFormat Width
w)
MO_UU_Conv Width
W32 Width
W8 -> Width -> CmmExpr -> NatM Register
toI8Reg Width
W32 CmmExpr
x
MO_SS_Conv Width
W32 Width
W8 -> Width -> CmmExpr -> NatM Register
toI8Reg Width
W32 CmmExpr
x
MO_XX_Conv Width
W32 Width
W8 -> Width -> CmmExpr -> NatM Register
toI8Reg Width
W32 CmmExpr
x
MO_UU_Conv Width
W16 Width
W8 -> Width -> CmmExpr -> NatM Register
toI8Reg Width
W16 CmmExpr
x
MO_SS_Conv Width
W16 Width
W8 -> Width -> CmmExpr -> NatM Register
toI8Reg Width
W16 CmmExpr
x
MO_XX_Conv Width
W16 Width
W8 -> Width -> CmmExpr -> NatM Register
toI8Reg Width
W16 CmmExpr
x
MO_UU_Conv Width
W32 Width
W16 -> Width -> CmmExpr -> NatM Register
toI16Reg Width
W32 CmmExpr
x
MO_SS_Conv Width
W32 Width
W16 -> Width -> CmmExpr -> NatM Register
toI16Reg Width
W32 CmmExpr
x
MO_XX_Conv Width
W32 Width
W16 -> Width -> CmmExpr -> NatM Register
toI16Reg Width
W32 CmmExpr
x
MO_UU_Conv Width
W64 Width
W32 | Bool -> Bool
not Bool
is32Bit -> Format -> CmmExpr -> NatM Register
conversionNop Format
II64 CmmExpr
x
MO_SS_Conv Width
W64 Width
W32 | Bool -> Bool
not Bool
is32Bit -> Format -> CmmExpr -> NatM Register
conversionNop Format
II64 CmmExpr
x
MO_XX_Conv Width
W64 Width
W32 | Bool -> Bool
not Bool
is32Bit -> Format -> CmmExpr -> NatM Register
conversionNop Format
II64 CmmExpr
x
MO_UU_Conv Width
W64 Width
W16 | Bool -> Bool
not Bool
is32Bit -> Width -> CmmExpr -> NatM Register
toI16Reg Width
W64 CmmExpr
x
MO_SS_Conv Width
W64 Width
W16 | Bool -> Bool
not Bool
is32Bit -> Width -> CmmExpr -> NatM Register
toI16Reg Width
W64 CmmExpr
x
MO_XX_Conv Width
W64 Width
W16 | Bool -> Bool
not Bool
is32Bit -> Width -> CmmExpr -> NatM Register
toI16Reg Width
W64 CmmExpr
x
MO_UU_Conv Width
W64 Width
W8 | Bool -> Bool
not Bool
is32Bit -> Width -> CmmExpr -> NatM Register
toI8Reg Width
W64 CmmExpr
x
MO_SS_Conv Width
W64 Width
W8 | Bool -> Bool
not Bool
is32Bit -> Width -> CmmExpr -> NatM Register
toI8Reg Width
W64 CmmExpr
x
MO_XX_Conv Width
W64 Width
W8 | Bool -> Bool
not Bool
is32Bit -> Width -> CmmExpr -> NatM Register
toI8Reg Width
W64 CmmExpr
x
MO_UU_Conv Width
rep1 Width
rep2 | Width
rep1 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
rep2 -> Format -> CmmExpr -> NatM Register
conversionNop (Width -> Format
intFormat Width
rep1) CmmExpr
x
MO_SS_Conv Width
rep1 Width
rep2 | Width
rep1 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
rep2 -> Format -> CmmExpr -> NatM Register
conversionNop (Width -> Format
intFormat Width
rep1) CmmExpr
x
MO_XX_Conv Width
rep1 Width
rep2 | Width
rep1 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
rep2 -> Format -> CmmExpr -> NatM Register
conversionNop (Width -> Format
intFormat Width
rep1) CmmExpr
x
MO_FW_Bitcast Width
W32 -> Format -> Format -> CmmExpr -> NatM Register
bitcast Format
FF32 Format
II32 CmmExpr
x
MO_WF_Bitcast Width
W32 -> Format -> Format -> CmmExpr -> NatM Register
bitcast Format
II32 Format
FF32 CmmExpr
x
MO_FW_Bitcast Width
W64 -> Format -> Format -> CmmExpr -> NatM Register
bitcast Format
FF64 Format
II64 CmmExpr
x
MO_WF_Bitcast Width
W64 -> Format -> Format -> CmmExpr -> NatM Register
bitcast Format
II64 Format
FF64 CmmExpr
x
MO_WF_Bitcast {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_FW_Bitcast {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_UU_Conv Width
W8 Width
W32 -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8 Width
W32 Format -> Operand -> Operand -> Instr
MOVZxL CmmExpr
x
MO_UU_Conv Width
W16 Width
W32 -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W16 Width
W32 Format -> Operand -> Operand -> Instr
MOVZxL CmmExpr
x
MO_UU_Conv Width
W8 Width
W16 -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8 Width
W16 Format -> Operand -> Operand -> Instr
MOVZxL CmmExpr
x
MO_SS_Conv Width
W8 Width
W32 -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8 Width
W32 Format -> Operand -> Operand -> Instr
MOVSxL CmmExpr
x
MO_SS_Conv Width
W16 Width
W32 -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W16 Width
W32 Format -> Operand -> Operand -> Instr
MOVSxL CmmExpr
x
MO_SS_Conv Width
W8 Width
W16 -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8 Width
W16 Format -> Operand -> Operand -> Instr
MOVSxL CmmExpr
x
MO_XX_Conv Width
W8 Width
W32
| Bool
is32Bit -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8 Width
W32 Format -> Operand -> Operand -> Instr
MOVZxL CmmExpr
x
| Bool
otherwise -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8 Width
W32 Format -> Operand -> Operand -> Instr
MOV CmmExpr
x
MO_XX_Conv Width
W8 Width
W16
| Bool
is32Bit -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8 Width
W16 Format -> Operand -> Operand -> Instr
MOVZxL CmmExpr
x
| Bool
otherwise -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8 Width
W16 Format -> Operand -> Operand -> Instr
MOV CmmExpr
x
MO_XX_Conv Width
W16 Width
W32 -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W16 Width
W32 Format -> Operand -> Operand -> Instr
MOV CmmExpr
x
MO_UU_Conv Width
W8 Width
W64 | Bool -> Bool
not Bool
is32Bit -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8 Width
W64 Format -> Operand -> Operand -> Instr
MOVZxL CmmExpr
x
MO_UU_Conv Width
W16 Width
W64 | Bool -> Bool
not Bool
is32Bit -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W16 Width
W64 Format -> Operand -> Operand -> Instr
MOVZxL CmmExpr
x
MO_UU_Conv Width
W32 Width
W64 | Bool -> Bool
not Bool
is32Bit -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W32 Width
W64 Format -> Operand -> Operand -> Instr
MOVZxL CmmExpr
x
MO_SS_Conv Width
W8 Width
W64 | Bool -> Bool
not Bool
is32Bit -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8 Width
W64 Format -> Operand -> Operand -> Instr
MOVSxL CmmExpr
x
MO_SS_Conv Width
W16 Width
W64 | Bool -> Bool
not Bool
is32Bit -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W16 Width
W64 Format -> Operand -> Operand -> Instr
MOVSxL CmmExpr
x
MO_SS_Conv Width
W32 Width
W64 | Bool -> Bool
not Bool
is32Bit -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W32 Width
W64 Format -> Operand -> Operand -> Instr
MOVSxL CmmExpr
x
MO_XX_Conv Width
W8 Width
W64 | Bool -> Bool
not Bool
is32Bit -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W8 Width
W64 Format -> Operand -> Operand -> Instr
MOV CmmExpr
x
MO_XX_Conv Width
W16 Width
W64 | Bool -> Bool
not Bool
is32Bit -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W16 Width
W64 Format -> Operand -> Operand -> Instr
MOV CmmExpr
x
MO_XX_Conv Width
W32 Width
W64 | Bool -> Bool
not Bool
is32Bit -> Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
W32 Width
W64 Format -> Operand -> Operand -> Instr
MOV CmmExpr
x
MO_FF_Conv Width
W32 Width
W64 -> Width -> CmmExpr -> NatM Register
coerceFP2FP Width
W64 CmmExpr
x
MO_FF_Conv Width
W64 Width
W32 -> Width -> CmmExpr -> NatM Register
coerceFP2FP Width
W32 CmmExpr
x
MO_FF_Conv Width
from Width
to -> Width -> Width -> NatM Register
forall a. Width -> Width -> NatM a
invalidConversion Width
from Width
to
MO_UU_Conv Width
from Width
to -> Width -> Width -> NatM Register
forall a. Width -> Width -> NatM a
invalidConversion Width
from Width
to
MO_SS_Conv Width
from Width
to -> Width -> Width -> NatM Register
forall a. Width -> Width -> NatM a
invalidConversion Width
from Width
to
MO_XX_Conv Width
from Width
to -> Width -> Width -> NatM Register
forall a. Width -> Width -> NatM a
invalidConversion Width
from Width
to
MO_FS_Truncate Width
from Width
to -> Width -> Width -> CmmExpr -> NatM Register
coerceFP2Int Width
from Width
to CmmExpr
x
MO_SF_Round Width
from Width
to -> Width -> Width -> CmmExpr -> NatM Register
coerceInt2FP Width
from Width
to CmmExpr
x
MO_VF_Neg Int
l Width
w | Bool
avx -> Int -> Width -> CmmExpr -> NatM Register
vector_float_negate_avx Int
l Width
w CmmExpr
x
| Bool
otherwise -> Int -> Width -> CmmExpr -> NatM Register
vector_float_negate_sse Int
l Width
w CmmExpr
x
MO_VS_Neg Int
l Width
w -> HasDebugCallStack => Platform -> Bool -> CmmExpr -> NatM Register
Platform -> Bool -> CmmExpr -> NatM Register
getRegister' Platform
platform Bool
is32Bit (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Int -> Width -> MachOp
MO_V_Sub Int
l Width
w) [CmmExpr
zero_vec, CmmExpr
x])
where zero_vec :: CmmExpr
zero_vec = CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ [CmmLit] -> CmmLit
CmmVec ([CmmLit] -> CmmLit) -> [CmmLit] -> CmmLit
forall a b. (a -> b) -> a -> b
$ Int -> CmmLit -> [CmmLit]
forall a. Int -> a -> [a]
replicate Int
l (CmmLit -> [CmmLit]) -> CmmLit -> [CmmLit]
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
0 Width
w
MO_VF_Broadcast Int
l Width
w
| Bool
avx
-> Int -> Width -> CmmExpr -> NatM Register
vector_float_broadcast_avx Int
l Width
w CmmExpr
x
| Bool
otherwise
-> Int -> Width -> CmmExpr -> NatM Register
vector_float_broadcast_sse Int
l Width
w CmmExpr
x
MO_V_Broadcast Int
l Width
w
| Bool
avx2, Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* Width -> Int
widthInBits Width
w Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
128, Int
256]
-> Int -> Width -> CmmExpr -> NatM Register
vector_int_broadcast_avx2 Int
l Width
w CmmExpr
x
MO_V_Broadcast Int
16 Width
W8 -> CmmExpr -> NatM Register
vector_int8x16_broadcast CmmExpr
x
MO_V_Broadcast Int
8 Width
W16 -> CmmExpr -> NatM Register
vector_int16x8_broadcast CmmExpr
x
MO_V_Broadcast Int
4 Width
W32 -> CmmExpr -> NatM Register
vector_int32x4_broadcast CmmExpr
x
MO_V_Broadcast Int
2 Width
W64 -> CmmExpr -> NatM Register
vector_int64x2_broadcast CmmExpr
x
MO_V_Broadcast {}
-> String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Unsupported integer vector broadcast operation for: " (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
x)
MO_Add {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_Sub {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_Eq {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_Ne {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_Mul {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_S_MulMayOflo {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_S_Quot {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_S_Rem {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_U_Quot {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_U_Rem {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_S_Ge {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_S_Le {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_S_Gt {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_S_Lt {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_U_Ge {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_U_Le {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_U_Gt {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_U_Lt {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_F_Add {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_F_Sub {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_F_Mul {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_F_Quot {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_F_Eq {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_F_Ne {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_F_Ge {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_F_Le {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_F_Gt {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_F_Lt {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_F_Min {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_F_Max {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_And {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_Or {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_Xor {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_Shl {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_U_Shr {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_S_Shr {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_V_Extract {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_V_Add {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_V_Sub {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_V_Mul {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_V_Shuffle {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_VF_Shuffle {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_VU_Min {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_VU_Max {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_VS_Min {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_VS_Max {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_VF_Min {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_VF_Max {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_VF_Extract {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_VF_Add {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_VF_Sub {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_VF_Mul {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_VF_Quot {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_FMA {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_VF_Insert {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_V_Insert {} -> NatM Register
forall a. NatM a
incorrectOperands
where
triv_ucode :: (Format -> Operand -> Instr) -> Format -> NatM Register
triv_ucode :: (Format -> Operand -> Instr) -> Format -> NatM Register
triv_ucode Format -> Operand -> Instr
instr Format
format = Format -> (Operand -> Instr) -> CmmExpr -> NatM Register
trivialUCode Format
format (Format -> Operand -> Instr
instr Format
format) CmmExpr
x
integerExtend :: Width -> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr -> NatM Register
integerExtend :: Width
-> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> NatM Register
integerExtend Width
from Width
to Format -> Operand -> Operand -> Instr
instr CmmExpr
expr = do
(reg,e_code) <- if Width
from Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W8 then HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getByteReg CmmExpr
expr
else CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
expr
let
code Reg
dst =
InstrBlock
e_code InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Operand -> Instr
instr (Width -> Format
intFormat Width
from) (Reg -> Operand
OpReg Reg
reg) (Reg -> Operand
OpReg Reg
dst)
return (Any (intFormat to) code)
bitcast :: Format -> Format -> CmmExpr -> NatM Register
bitcast :: Format -> Format -> CmmExpr -> NatM Register
bitcast Format
fmt Format
rfmt CmmExpr
expr =
do (src, e_code) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
expr
let code = \Reg
dst -> InstrBlock
e_code InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL` (Format -> Format -> Operand -> Operand -> Instr
MOVD Format
fmt Format
rfmt (Reg -> Operand
OpReg Reg
src) (Reg -> Operand
OpReg Reg
dst))
return (Any rfmt code)
toI8Reg :: Width -> CmmExpr -> NatM Register
toI8Reg :: Width -> CmmExpr -> NatM Register
toI8Reg Width
new_rep CmmExpr
expr
= do codefn <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
expr
return (Any (intFormat new_rep) codefn)
toI16Reg :: Width -> CmmExpr -> NatM Register
toI16Reg = Width -> CmmExpr -> NatM Register
toI8Reg
conversionNop :: Format -> CmmExpr -> NatM Register
conversionNop :: Format -> CmmExpr -> NatM Register
conversionNop Format
new_format CmmExpr
expr
= do e_code <- HasDebugCallStack => Platform -> Bool -> CmmExpr -> NatM Register
Platform -> Bool -> CmmExpr -> NatM Register
getRegister' Platform
platform Bool
is32Bit CmmExpr
expr
return (swizzleRegisterRep e_code new_format)
vector_float_negate_avx :: Length -> Width -> CmmExpr -> NatM Register
vector_float_negate_avx :: Int -> Width -> CmmExpr -> NatM Register
vector_float_negate_avx Int
l Width
w CmmExpr
expr = do
let fmt :: Format
mask :: CmmLit
(Format
fmt, CmmLit
mask) = case Width
w of
Width
W32 -> (Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtFloat , Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a. (Num a, Bits a) => Int -> a
bit Int
31) Width
w)
Width
W64 -> (Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtDouble, Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a. (Num a, Bits a) => Int -> a
bit Int
63) Width
w)
Width
_ -> String -> (Format, CmmLit)
forall a. HasCallStack => String -> a
panic String
"AVX floating-point negation: elements must be FF32 or FF64"
(maskReg, maskCode) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg (CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ [CmmLit] -> CmmLit
CmmVec ([CmmLit] -> CmmLit) -> [CmmLit] -> CmmLit
forall a b. (a -> b) -> a -> b
$ Int -> CmmLit -> [CmmLit]
forall a. Int -> a -> [a]
replicate Int
l CmmLit
mask)
(reg, exp) <- getSomeReg expr
let code Reg
dst = InstrBlock
maskCode InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
VMOVU Format
fmt (Reg -> Operand
OpReg Reg
reg) (Reg -> Operand
OpReg Reg
dst)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Reg -> Instr
VXOR Format
fmt (Reg -> Operand
OpReg Reg
maskReg) Reg
dst Reg
dst)
return (Any fmt code)
vector_float_negate_sse :: Length -> Width -> CmmExpr -> NatM Register
vector_float_negate_sse :: Int -> Width -> CmmExpr -> NatM Register
vector_float_negate_sse Int
l Width
w CmmExpr
expr = do
let fmt :: Format
mask :: CmmLit
(Format
fmt, CmmLit
mask) = case Width
w of
Width
W32 -> (Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtFloat , Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a. (Num a, Bits a) => Int -> a
bit Int
31) Width
w)
Width
W64 -> (Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtDouble, Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a. (Num a, Bits a) => Int -> a
bit Int
63) Width
w)
Width
_ -> String -> (Format, CmmLit)
forall a. HasCallStack => String -> a
panic String
"SSE floating-point negation: elements must be FF32 or FF64"
(maskReg, maskCode) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg (CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ [CmmLit] -> CmmLit
CmmVec ([CmmLit] -> CmmLit) -> [CmmLit] -> CmmLit
forall a b. (a -> b) -> a -> b
$ Int -> CmmLit -> [CmmLit]
forall a. Int -> a -> [a]
replicate Int
l CmmLit
mask)
(reg, exp) <- getSomeReg expr
let code Reg
dst = InstrBlock
maskCode InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVU Format
fmt (Reg -> Operand
OpReg Reg
reg) (Reg -> Operand
OpReg Reg
dst)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
XOR Format
fmt (Reg -> Operand
OpReg Reg
maskReg) (Reg -> Operand
OpReg Reg
dst))
return (Any fmt code)
vector_float_broadcast_avx :: Length
-> Width
-> CmmExpr
-> NatM Register
vector_float_broadcast_avx :: Int -> Width -> CmmExpr -> NatM Register
vector_float_broadcast_avx Int
len Width
w CmmExpr
expr = do
(dst, exp) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
expr
let fmt = Int -> ScalarFormat -> Format
VecFormat Int
len (Width -> ScalarFormat
floatScalarFormat Width
w)
code = Format -> Imm -> Operand -> Reg -> Reg -> Instr
VSHUF Format
fmt (Int -> Imm
ImmInt Int
0) (Reg -> Operand
OpReg Reg
dst) Reg
dst Reg
dst
return $ Fixed fmt dst (exp `snocOL` code)
vector_float_broadcast_sse :: Length
-> Width
-> CmmExpr
-> NatM Register
vector_float_broadcast_sse :: Int -> Width -> CmmExpr -> NatM Register
vector_float_broadcast_sse Int
len Width
w CmmExpr
expr = do
(dst, exp) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
expr
let fmt = Int -> ScalarFormat -> Format
VecFormat Int
len (Width -> ScalarFormat
floatScalarFormat Width
w)
code = Format -> Imm -> Operand -> Reg -> Instr
SHUF Format
fmt (Int -> Imm
ImmInt Int
0) (Reg -> Operand
OpReg Reg
dst) Reg
dst
return $ Fixed fmt dst (exp `snocOL` code)
vector_int_broadcast_avx2 :: Length
-> Width
-> CmmExpr
-> NatM Register
vector_int_broadcast_avx2 :: Int -> Width -> CmmExpr -> NatM Register
vector_int_broadcast_avx2 Int
len Width
w CmmExpr
expr = do
(reg, exp) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
expr
let (movFormat, fmt) = case w of
Width
W8 -> (Format
II32, Int -> ScalarFormat -> Format
VecFormat Int
len ScalarFormat
FmtInt8)
Width
W16 -> (Format
II32, Int -> ScalarFormat -> Format
VecFormat Int
len ScalarFormat
FmtInt16)
Width
W32 -> (Format
II32, Int -> ScalarFormat -> Format
VecFormat Int
len ScalarFormat
FmtInt32)
Width
W64 -> (Format
II64, Int -> ScalarFormat -> Format
VecFormat Int
len ScalarFormat
FmtInt64)
Width
_ -> String -> SDoc -> (Format, Format)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Broadcast not supported for: " (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
expr)
code Reg
dst = InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Operand -> Instr
MOVD Format
movFormat Format
fmt (Reg -> Operand
OpReg Reg
reg) (Reg -> Operand
OpReg Reg
dst)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Reg -> Instr
VPBROADCAST Format
fmt Format
fmt (Reg -> Operand
OpReg Reg
dst) Reg
dst)
return $ Any fmt code
vector_int8x16_broadcast :: CmmExpr
-> NatM Register
vector_int8x16_broadcast :: CmmExpr -> NatM Register
vector_int8x16_broadcast CmmExpr
expr = do
(reg, exp) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
expr
let fmt = Int -> ScalarFormat -> Format
VecFormat Int
16 ScalarFormat
FmtInt8
return $ Any fmt (\Reg
dst -> InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Operand -> Instr
MOVD Format
II32 Format
fmt (Reg -> Operand
OpReg Reg
reg) (Reg -> Operand
OpReg Reg
dst)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PUNPCKLBW Format
fmt (Reg -> Operand
OpReg Reg
dst) Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PUNPCKLWD (Int -> ScalarFormat -> Format
VecFormat Int
8 ScalarFormat
FmtInt16) (Reg -> Operand
OpReg Reg
dst) Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
PSHUFD Format
fmt (Int -> Imm
ImmInt Int
0x00) (Reg -> Operand
OpReg Reg
dst) Reg
dst)
)
vector_int16x8_broadcast :: CmmExpr
-> NatM Register
vector_int16x8_broadcast :: CmmExpr -> NatM Register
vector_int16x8_broadcast CmmExpr
expr = do
(reg, exp) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
expr
let fmt = Int -> ScalarFormat -> Format
VecFormat Int
8 ScalarFormat
FmtInt16
return $ Any fmt (\Reg
dst -> InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Operand -> Instr
MOVD Format
II32 Format
fmt (Reg -> Operand
OpReg Reg
reg) (Reg -> Operand
OpReg Reg
dst)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PUNPCKLWD Format
fmt (Reg -> Operand
OpReg Reg
dst) Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
PSHUFD Format
fmt (Int -> Imm
ImmInt Int
0x00) (Reg -> Operand
OpReg Reg
dst) Reg
dst)
)
vector_int32x4_broadcast :: CmmExpr
-> NatM Register
vector_int32x4_broadcast :: CmmExpr -> NatM Register
vector_int32x4_broadcast CmmExpr
expr = do
(reg, exp) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
expr
let fmt = Int -> ScalarFormat -> Format
VecFormat Int
4 ScalarFormat
FmtInt32
return $ Any fmt (\Reg
dst -> InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Operand -> Instr
MOVD Format
II32 Format
fmt (Reg -> Operand
OpReg Reg
reg) (Reg -> Operand
OpReg Reg
dst)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
PSHUFD Format
fmt (Int -> Imm
ImmInt Int
0x00) (Reg -> Operand
OpReg Reg
dst) Reg
dst)
)
vector_int64x2_broadcast :: CmmExpr
-> NatM Register
vector_int64x2_broadcast :: CmmExpr -> NatM Register
vector_int64x2_broadcast CmmExpr
expr = do
(reg, exp) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
expr
let fmt = Int -> ScalarFormat -> Format
VecFormat Int
2 ScalarFormat
FmtInt64
return $ Any fmt (\Reg
dst -> InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Operand -> Instr
MOVD Format
II64 Format
fmt (Reg -> Operand
OpReg Reg
reg) (Reg -> Operand
OpReg Reg
dst)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PUNPCKLQDQ Format
fmt (Reg -> Operand
OpReg Reg
dst) Reg
dst)
)
getRegister' Platform
platform Bool
is32Bit (CmmMachOp MachOp
mop [CmmExpr
x, CmmExpr
y]) = do
sse4_1 <- NatM Bool
sse4_1Enabled
sse4_2 <- sse4_2Enabled
avx <- avxEnabled
case mop of
MO_F_Eq Width
_ -> Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Bool
is32Bit Cond
EQQ CmmExpr
x CmmExpr
y
MO_F_Ne Width
_ -> Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Bool
is32Bit Cond
NE CmmExpr
x CmmExpr
y
MO_F_Gt Width
_ -> Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Bool
is32Bit Cond
GTT CmmExpr
x CmmExpr
y
MO_F_Ge Width
_ -> Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Bool
is32Bit Cond
GE CmmExpr
x CmmExpr
y
MO_F_Lt Width
_ -> Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Bool
is32Bit Cond
GTT CmmExpr
y CmmExpr
x
MO_F_Le Width
_ -> Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Bool
is32Bit Cond
GE CmmExpr
y CmmExpr
x
MO_Eq Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
EQQ CmmExpr
x CmmExpr
y
MO_Ne Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
NE CmmExpr
x CmmExpr
y
MO_S_Gt Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
GTT CmmExpr
x CmmExpr
y
MO_S_Ge Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
GE CmmExpr
x CmmExpr
y
MO_S_Lt Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
LTT CmmExpr
x CmmExpr
y
MO_S_Le Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
LE CmmExpr
x CmmExpr
y
MO_U_Gt Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
GU CmmExpr
x CmmExpr
y
MO_U_Ge Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
GEU CmmExpr
x CmmExpr
y
MO_U_Lt Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
LU CmmExpr
x CmmExpr
y
MO_U_Le Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
LEU CmmExpr
x CmmExpr
y
MO_F_Add Width
w -> Width
-> (Format -> Operand -> Reg -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialFCode_sse2 Width
w (\Format
fmt Operand
op2 -> Format -> Operand -> Operand -> Instr
ADD Format
fmt Operand
op2 (Operand -> Instr) -> (Reg -> Operand) -> Reg -> Instr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reg -> Operand
OpReg) CmmExpr
x CmmExpr
y
MO_F_Sub Width
w -> Width
-> (Format -> Operand -> Reg -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialFCode_sse2 Width
w (\Format
fmt Operand
op2 -> Format -> Operand -> Operand -> Instr
SUB Format
fmt Operand
op2 (Operand -> Instr) -> (Reg -> Operand) -> Reg -> Instr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reg -> Operand
OpReg) CmmExpr
x CmmExpr
y
MO_F_Quot Width
w -> Width
-> (Format -> Operand -> Reg -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialFCode_sse2 Width
w Format -> Operand -> Reg -> Instr
FDIV CmmExpr
x CmmExpr
y
MO_F_Mul Width
w -> Width
-> (Format -> Operand -> Reg -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialFCode_sse2 Width
w (\Format
fmt Operand
op2 -> Format -> Operand -> Operand -> Instr
MUL Format
fmt Operand
op2 (Operand -> Instr) -> (Reg -> Operand) -> Reg -> Instr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reg -> Operand
OpReg) CmmExpr
x CmmExpr
y
MO_F_Min Width
w -> Width
-> (Format -> Operand -> Reg -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialFCode_sse2 Width
w (MinOrMax -> MinMaxType -> Format -> Operand -> Reg -> Instr
MINMAX MinOrMax
Min MinMaxType
FloatMinMax) CmmExpr
x CmmExpr
y
MO_F_Max Width
w -> Width
-> (Format -> Operand -> Reg -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialFCode_sse2 Width
w (MinOrMax -> MinMaxType -> Format -> Operand -> Reg -> Instr
MINMAX MinOrMax
Max MinMaxType
FloatMinMax) CmmExpr
x CmmExpr
y
MO_Add Width
rep -> Width -> CmmExpr -> CmmExpr -> NatM Register
add_code Width
rep CmmExpr
x CmmExpr
y
MO_Sub Width
rep -> Width -> CmmExpr -> CmmExpr -> NatM Register
sub_code Width
rep CmmExpr
x CmmExpr
y
MO_S_Quot Width
rep -> Width -> Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
div_code Width
rep Bool
True Bool
True CmmExpr
x CmmExpr
y
MO_S_Rem Width
rep -> Width -> Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
div_code Width
rep Bool
True Bool
False CmmExpr
x CmmExpr
y
MO_U_Quot Width
rep -> Width -> Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
div_code Width
rep Bool
False Bool
True CmmExpr
x CmmExpr
y
MO_U_Rem Width
rep -> Width -> Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
div_code Width
rep Bool
False Bool
False CmmExpr
x CmmExpr
y
MO_S_MulMayOflo Width
rep -> Width -> CmmExpr -> CmmExpr -> NatM Register
imulMayOflo Width
rep CmmExpr
x CmmExpr
y
MO_Mul Width
W8 -> CmmExpr -> CmmExpr -> NatM Register
imulW8 CmmExpr
x CmmExpr
y
MO_Mul Width
rep -> Width -> (Format -> Operand -> Operand -> Instr) -> NatM Register
triv_op Width
rep Format -> Operand -> Operand -> Instr
IMUL
MO_And Width
rep -> Width -> (Format -> Operand -> Operand -> Instr) -> NatM Register
triv_op Width
rep Format -> Operand -> Operand -> Instr
AND
MO_Or Width
rep -> Width -> (Format -> Operand -> Operand -> Instr) -> NatM Register
triv_op Width
rep Format -> Operand -> Operand -> Instr
OR
MO_Xor Width
rep -> Width -> (Format -> Operand -> Operand -> Instr) -> NatM Register
triv_op Width
rep Format -> Operand -> Operand -> Instr
XOR
MO_Shl Width
rep -> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
shift_code Width
rep Format -> Operand -> Operand -> Instr
SHL CmmExpr
x CmmExpr
y
MO_U_Shr Width
rep -> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
shift_code Width
rep Format -> Operand -> Operand -> Instr
SHR CmmExpr
x CmmExpr
y
MO_S_Shr Width
rep -> Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
shift_code Width
rep Format -> Operand -> Operand -> Instr
SAR CmmExpr
x CmmExpr
y
MO_VF_Shuffle Int
l Width
w [Int]
is
| Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* Width -> Int
widthInBits Width
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
128
-> if
| Bool
avx
-> Int -> Width -> CmmExpr -> CmmExpr -> [Int] -> NatM Register
vector_shuffle_float Int
l Width
w CmmExpr
x CmmExpr
y [Int]
is
| Bool
otherwise
-> String -> NatM Register
forall a. HasCallStack => String -> a
sorry String
"Please enable the -mavx flag"
| Bool
otherwise
-> String -> NatM Register
forall a. HasCallStack => String -> a
sorry String
"Please use -fllvm for wide shuffle instructions"
MO_VF_Extract Int
l Width
W32 | Bool
avx -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_float_extract Int
l Width
W32 CmmExpr
x CmmExpr
y
| Bool
otherwise -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_float_extract_sse Int
l Width
W32 CmmExpr
x CmmExpr
y
MO_VF_Extract Int
l Width
W64 -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_float_extract Int
l Width
W64 CmmExpr
x CmmExpr
y
MO_VF_Extract {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_V_Extract Int
16 Width
W8 | Bool
sse4_1 -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_extract_pextr Int
16 Width
W8 CmmExpr
x CmmExpr
y
| Bool
otherwise -> CmmExpr -> CmmExpr -> NatM Register
vector_int8x16_extract_sse2 CmmExpr
x CmmExpr
y
MO_V_Extract Int
8 Width
W16 -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_extract_pextr Int
8 Width
W16 CmmExpr
x CmmExpr
y
MO_V_Extract Int
4 Width
W32 | Bool
sse4_1 -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_extract_pextr Int
4 Width
W32 CmmExpr
x CmmExpr
y
| Bool
otherwise -> CmmExpr -> CmmExpr -> NatM Register
vector_int32x4_extract_sse2 CmmExpr
x CmmExpr
y
MO_V_Extract Int
2 Width
W64 | Bool
sse4_1 -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_extract_pextr Int
2 Width
W64 CmmExpr
x CmmExpr
y
| Bool
otherwise -> CmmExpr -> CmmExpr -> NatM Register
vector_int64x2_extract_sse2 CmmExpr
x CmmExpr
y
MO_V_Extract {} -> MachOp -> NatM Register
forall a. MachOp -> NatM a
needLlvm MachOp
mop
MO_VF_Add Int
l Width
w | Bool
avx -> (Format -> Operand -> Reg -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_float_op_avx Format -> Operand -> Reg -> Reg -> Instr
VADD Int
l Width
w CmmExpr
x CmmExpr
y
| Bool
otherwise -> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_float_op_sse (\Format
fmt Operand
op2 -> Format -> Operand -> Operand -> Instr
ADD Format
fmt Operand
op2 (Operand -> Instr) -> (Reg -> Operand) -> Reg -> Instr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reg -> Operand
OpReg) Int
l Width
w CmmExpr
x CmmExpr
y
MO_VF_Sub Int
l Width
w | Bool
avx -> (Format -> Operand -> Reg -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_float_op_avx Format -> Operand -> Reg -> Reg -> Instr
VSUB Int
l Width
w CmmExpr
x CmmExpr
y
| Bool
otherwise -> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_float_op_sse (\Format
fmt Operand
op2 -> Format -> Operand -> Operand -> Instr
SUB Format
fmt Operand
op2 (Operand -> Instr) -> (Reg -> Operand) -> Reg -> Instr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reg -> Operand
OpReg) Int
l Width
w CmmExpr
x CmmExpr
y
MO_VF_Mul Int
l Width
w | Bool
avx -> (Format -> Operand -> Reg -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_float_op_avx Format -> Operand -> Reg -> Reg -> Instr
VMUL Int
l Width
w CmmExpr
x CmmExpr
y
| Bool
otherwise -> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_float_op_sse (\Format
fmt Operand
op2 -> Format -> Operand -> Operand -> Instr
MUL Format
fmt Operand
op2 (Operand -> Instr) -> (Reg -> Operand) -> Reg -> Instr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reg -> Operand
OpReg) Int
l Width
w CmmExpr
x CmmExpr
y
MO_VF_Quot Int
l Width
w | Bool
avx -> (Format -> Operand -> Reg -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_float_op_avx Format -> Operand -> Reg -> Reg -> Instr
VDIV Int
l Width
w CmmExpr
x CmmExpr
y
| Bool
otherwise -> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_float_op_sse Format -> Operand -> Reg -> Instr
FDIV Int
l Width
w CmmExpr
x CmmExpr
y
MO_VF_Min Int
l Width
w | Bool
avx -> (Format -> Operand -> Reg -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_float_op_avx (MinOrMax -> MinMaxType -> Format -> Operand -> Reg -> Reg -> Instr
VMINMAX MinOrMax
Min MinMaxType
FloatMinMax) Int
l Width
w CmmExpr
x CmmExpr
y
| Bool
otherwise -> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_float_op_sse (MinOrMax -> MinMaxType -> Format -> Operand -> Reg -> Instr
MINMAX MinOrMax
Min MinMaxType
FloatMinMax) Int
l Width
w CmmExpr
x CmmExpr
y
MO_VF_Max Int
l Width
w | Bool
avx -> (Format -> Operand -> Reg -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_float_op_avx (MinOrMax -> MinMaxType -> Format -> Operand -> Reg -> Reg -> Instr
VMINMAX MinOrMax
Max MinMaxType
FloatMinMax) Int
l Width
w CmmExpr
x CmmExpr
y
| Bool
otherwise -> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_float_op_sse (MinOrMax -> MinMaxType -> Format -> Operand -> Reg -> Instr
MINMAX MinOrMax
Max MinMaxType
FloatMinMax) Int
l Width
w CmmExpr
x CmmExpr
y
MO_V_Shuffle Int
16 Width
W8 [Int]
is | Bool -> Bool
not Bool
is32Bit -> Bool -> CmmExpr -> CmmExpr -> [Int] -> NatM Register
vector_shuffle_int8x16 Bool
sse4_1 CmmExpr
x CmmExpr
y [Int]
is
MO_V_Shuffle Int
8 Width
W16 [Int]
is -> Bool -> CmmExpr -> CmmExpr -> [Int] -> NatM Register
vector_shuffle_int16x8 Bool
sse4_1 CmmExpr
x CmmExpr
y [Int]
is
MO_V_Shuffle Int
4 Width
W32 [Int]
is -> Bool -> CmmExpr -> CmmExpr -> [Int] -> NatM Register
vector_shuffle_int32x4 Bool
sse4_1 CmmExpr
x CmmExpr
y [Int]
is
MO_V_Shuffle Int
2 Width
W64 [Int]
is -> Bool -> CmmExpr -> CmmExpr -> [Int] -> NatM Register
vector_shuffle_int64x2 Bool
sse4_1 CmmExpr
x CmmExpr
y [Int]
is
MO_V_Shuffle {} -> MachOp -> NatM Register
forall a. MachOp -> NatM a
needLlvm MachOp
mop
MO_V_Add Int
l Width
w | Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* Width -> Int
widthInBits Width
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
128 -> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_op_sse Format -> Operand -> Reg -> Instr
PADD Int
l Width
w CmmExpr
x CmmExpr
y
| Bool
otherwise -> MachOp -> NatM Register
forall a. MachOp -> NatM a
needLlvm MachOp
mop
MO_V_Sub Int
l Width
w | Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* Width -> Int
widthInBits Width
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
128 -> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_op_sse Format -> Operand -> Reg -> Instr
PSUB Int
l Width
w CmmExpr
x CmmExpr
y
| Bool
otherwise -> MachOp -> NatM Register
forall a. MachOp -> NatM a
needLlvm MachOp
mop
MO_V_Mul Int
16 Width
W8 -> CmmExpr -> CmmExpr -> NatM Register
vector_int8x16_mul_sse2 CmmExpr
x CmmExpr
y
MO_V_Mul l :: Int
l@Int
8 w :: Width
w@Width
W16 -> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_op_sse Format -> Operand -> Reg -> Instr
PMULL Int
l Width
w CmmExpr
x CmmExpr
y
MO_V_Mul l :: Int
l@Int
4 w :: Width
w@Width
W32 | Bool
sse4_1 -> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_op_sse Format -> Operand -> Reg -> Instr
PMULL Int
l Width
w CmmExpr
x CmmExpr
y
| Bool
otherwise -> CmmExpr -> CmmExpr -> NatM Register
vector_int32x4_mul_sse2 CmmExpr
x CmmExpr
y
MO_V_Mul Int
2 Width
W64 -> CmmExpr -> CmmExpr -> NatM Register
vector_int64x2_mul_sse2 CmmExpr
x CmmExpr
y
MO_V_Mul {} -> MachOp -> NatM Register
forall a. MachOp -> NatM a
needLlvm MachOp
mop
MO_VU_Min l :: Int
l@Int
16 w :: Width
w@Width
W8
-> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_op_sse (MinOrMax -> MinMaxType -> Format -> Operand -> Reg -> Instr
MINMAX MinOrMax
Min (Bool -> MinMaxType
IntVecMinMax Bool
False)) Int
l Width
w CmmExpr
x CmmExpr
y
MO_VU_Min l :: Int
l@Int
8 w :: Width
w@Width
W16
| Bool
sse4_1 -> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_op_sse (MinOrMax -> MinMaxType -> Format -> Operand -> Reg -> Instr
MINMAX MinOrMax
Min (Bool -> MinMaxType
IntVecMinMax Bool
False)) Int
l Width
w CmmExpr
x CmmExpr
y
| Bool
otherwise -> MinOrMax -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_word_minmax_sse MinOrMax
Min Int
l Width
w CmmExpr
x CmmExpr
y
MO_VU_Min l :: Int
l@Int
4 w :: Width
w@Width
W32
| Bool
sse4_1 -> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_op_sse (MinOrMax -> MinMaxType -> Format -> Operand -> Reg -> Instr
MINMAX MinOrMax
Min (Bool -> MinMaxType
IntVecMinMax Bool
False)) Int
l Width
w CmmExpr
x CmmExpr
y
| Bool
otherwise -> MinOrMax -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_word_minmax_sse MinOrMax
Min Int
l Width
w CmmExpr
x CmmExpr
y
MO_VU_Min l :: Int
l@Int
2 w :: Width
w@Width
W64
| Bool
sse4_2 -> MinOrMax -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_word_minmax_sse MinOrMax
Min Int
l Width
w CmmExpr
x CmmExpr
y
MO_VU_Min {} -> MachOp -> NatM Register
forall a. MachOp -> NatM a
needLlvm MachOp
mop
MO_VU_Max l :: Int
l@Int
16 w :: Width
w@Width
W8
-> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_op_sse (MinOrMax -> MinMaxType -> Format -> Operand -> Reg -> Instr
MINMAX MinOrMax
Max (Bool -> MinMaxType
IntVecMinMax Bool
False)) Int
l Width
w CmmExpr
x CmmExpr
y
MO_VU_Max l :: Int
l@Int
8 w :: Width
w@Width
W16
| Bool
sse4_1 -> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_op_sse (MinOrMax -> MinMaxType -> Format -> Operand -> Reg -> Instr
MINMAX MinOrMax
Max (Bool -> MinMaxType
IntVecMinMax Bool
False)) Int
l Width
w CmmExpr
x CmmExpr
y
| Bool
otherwise -> MinOrMax -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_word_minmax_sse MinOrMax
Max Int
l Width
w CmmExpr
x CmmExpr
y
MO_VU_Max l :: Int
l@Int
4 w :: Width
w@Width
W32
| Bool
sse4_1 -> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_op_sse (MinOrMax -> MinMaxType -> Format -> Operand -> Reg -> Instr
MINMAX MinOrMax
Max (Bool -> MinMaxType
IntVecMinMax Bool
False)) Int
l Width
w CmmExpr
x CmmExpr
y
| Bool
otherwise -> MinOrMax -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_word_minmax_sse MinOrMax
Max Int
l Width
w CmmExpr
x CmmExpr
y
MO_VU_Max l :: Int
l@Int
2 w :: Width
w@Width
W64
| Bool
sse4_2 -> MinOrMax -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_word_minmax_sse MinOrMax
Max Int
l Width
w CmmExpr
x CmmExpr
y
MO_VU_Max {} -> MachOp -> NatM Register
forall a. MachOp -> NatM a
needLlvm MachOp
mop
MO_VS_Min l :: Int
l@Int
16 w :: Width
w@Width
W8
| Bool
sse4_1 -> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_op_sse (MinOrMax -> MinMaxType -> Format -> Operand -> Reg -> Instr
MINMAX MinOrMax
Min (Bool -> MinMaxType
IntVecMinMax Bool
True)) Int
l Width
w CmmExpr
x CmmExpr
y
| Bool
otherwise -> MinOrMax -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_minmax_sse MinOrMax
Min Int
l Width
w CmmExpr
x CmmExpr
y
MO_VS_Min l :: Int
l@Int
8 w :: Width
w@Width
W16
-> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_op_sse (MinOrMax -> MinMaxType -> Format -> Operand -> Reg -> Instr
MINMAX MinOrMax
Min (Bool -> MinMaxType
IntVecMinMax Bool
True)) Int
l Width
w CmmExpr
x CmmExpr
y
MO_VS_Min l :: Int
l@Int
4 w :: Width
w@Width
W32
| Bool
sse4_1 -> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_op_sse (MinOrMax -> MinMaxType -> Format -> Operand -> Reg -> Instr
MINMAX MinOrMax
Min (Bool -> MinMaxType
IntVecMinMax Bool
True)) Int
l Width
w CmmExpr
x CmmExpr
y
| Bool
otherwise -> MinOrMax -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_minmax_sse MinOrMax
Min Int
l Width
w CmmExpr
x CmmExpr
y
MO_VS_Min l :: Int
l@Int
2 w :: Width
w@Width
W64
| Bool
sse4_2 -> MinOrMax -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_minmax_sse MinOrMax
Min Int
l Width
w CmmExpr
x CmmExpr
y
MO_VS_Min {} -> MachOp -> NatM Register
forall a. MachOp -> NatM a
needLlvm MachOp
mop
MO_VS_Max l :: Int
l@Int
16 w :: Width
w@Width
W8
| Bool
sse4_1 -> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_op_sse (MinOrMax -> MinMaxType -> Format -> Operand -> Reg -> Instr
MINMAX MinOrMax
Max (Bool -> MinMaxType
IntVecMinMax Bool
True)) Int
l Width
w CmmExpr
x CmmExpr
y
| Bool
otherwise -> MinOrMax -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_minmax_sse MinOrMax
Max Int
l Width
w CmmExpr
x CmmExpr
y
MO_VS_Max l :: Int
l@Int
8 w :: Width
w@Width
W16
-> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_op_sse (MinOrMax -> MinMaxType -> Format -> Operand -> Reg -> Instr
MINMAX MinOrMax
Max (Bool -> MinMaxType
IntVecMinMax Bool
True)) Int
l Width
w CmmExpr
x CmmExpr
y
MO_VS_Max l :: Int
l@Int
4 w :: Width
w@Width
W32
| Bool
sse4_1 -> (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_op_sse (MinOrMax -> MinMaxType -> Format -> Operand -> Reg -> Instr
MINMAX MinOrMax
Max (Bool -> MinMaxType
IntVecMinMax Bool
True)) Int
l Width
w CmmExpr
x CmmExpr
y
| Bool
otherwise -> MinOrMax -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_minmax_sse MinOrMax
Max Int
l Width
w CmmExpr
x CmmExpr
y
MO_VS_Max l :: Int
l@Int
2 w :: Width
w@Width
W64
| Bool
sse4_2 -> MinOrMax -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_minmax_sse MinOrMax
Max Int
l Width
w CmmExpr
x CmmExpr
y
MO_VS_Max {} -> MachOp -> NatM Register
forall a. MachOp -> NatM a
needLlvm MachOp
mop
MO_S_Neg {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_F_Neg {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_Not {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_SF_Round {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_FS_Truncate {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_SS_Conv {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_XX_Conv {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_FF_Conv {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_UU_Conv {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_WF_Bitcast {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_FW_Bitcast {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_RelaxedRead {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_AlignmentCheck {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_VS_Neg {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_VF_Neg {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_V_Broadcast {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_VF_Broadcast {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_FMA {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_V_Insert {} -> NatM Register
forall a. NatM a
incorrectOperands
MO_VF_Insert {} -> NatM Register
forall a. NatM a
incorrectOperands
where
triv_op :: Width -> (Format -> Operand -> Operand -> Instr) -> NatM Register
triv_op Width
width Format -> Operand -> Operand -> Instr
instr = Width
-> (Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode Width
width Operand -> Operand -> Instr
op ((Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
forall a. a -> Maybe a
Just Operand -> Operand -> Instr
op) CmmExpr
x CmmExpr
y
where op :: Operand -> Operand -> Instr
op = Format -> Operand -> Operand -> Instr
instr (Width -> Format
intFormat Width
width)
imulW8 :: CmmExpr -> CmmExpr -> NatM Register
imulW8 :: CmmExpr -> CmmExpr -> NatM Register
imulW8 CmmExpr
arg_a CmmExpr
arg_b = do
(a_reg, a_code) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
arg_a
b_code <- getAnyReg arg_b
let code = InstrBlock
a_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> InstrBlock
b_code Reg
eax InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Instr
IMUL2 Format
format (Reg -> Operand
OpReg Reg
a_reg) ]
format = Width -> Format
intFormat Width
W8
return (Fixed format eax code)
imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register
imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register
imulMayOflo Width
W8 CmmExpr
a CmmExpr
b = do
(a_reg, a_code) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
a
(b_reg, b_code) <- getNonClobberedReg b
let
code = InstrBlock
a_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
b_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [
Format -> Operand -> Operand -> Instr
MOVSxL Format
II8 (Reg -> Operand
OpReg Reg
a_reg) (Reg -> Operand
OpReg Reg
a_reg),
Format -> Operand -> Operand -> Instr
MOVSxL Format
II8 (Reg -> Operand
OpReg Reg
b_reg) (Reg -> Operand
OpReg Reg
b_reg),
Format -> Operand -> Operand -> Instr
IMUL Format
II32 (Reg -> Operand
OpReg Reg
b_reg) (Reg -> Operand
OpReg Reg
a_reg),
Format -> Operand -> Operand -> Instr
MOVSxL Format
II8 (Reg -> Operand
OpReg Reg
a_reg) (Reg -> Operand
OpReg Reg
eax),
Format -> Operand -> Operand -> Instr
CMP Format
II16 (Reg -> Operand
OpReg Reg
a_reg) (Reg -> Operand
OpReg Reg
eax),
Cond -> Operand -> Instr
SETCC Cond
NE (Reg -> Operand
OpReg Reg
eax)
]
return (Fixed II8 eax code)
imulMayOflo Width
rep CmmExpr
a CmmExpr
b = do
(a_reg, a_code) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
a
b_code <- getAnyReg b
let
shift_amt = case Width
rep of
Width
W16 -> Int
15
Width
W32 -> Int
31
Width
W64 -> Int
63
Width
w -> String -> Int
forall a. HasCallStack => String -> a
panic (String
"shift_amt: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Width -> String
forall a. Show a => a -> String
show Width
w)
format = Width -> Format
intFormat Width
rep
code = InstrBlock
a_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> InstrBlock
b_code Reg
eax InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [
Format -> Operand -> Instr
IMUL2 Format
format (Reg -> Operand
OpReg Reg
a_reg),
Format -> Operand -> Operand -> Instr
SAR Format
format (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
shift_amt)) (Reg -> Operand
OpReg Reg
eax),
Format -> Operand -> Operand -> Instr
SUB Format
format (Reg -> Operand
OpReg Reg
edx) (Reg -> Operand
OpReg Reg
eax)
]
return (Fixed format eax code)
shift_code :: Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
shift_code :: Width
-> (Format -> Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
shift_code Width
width Format -> Operand -> Operand -> Instr
instr CmmExpr
x (CmmLit CmmLit
lit)
| CmmInt Integer
n Width
_ <- CmmLit
lit
, Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Width -> Int
widthInBits Width
width)
= HasDebugCallStack => CmmExpr -> NatM Register
CmmExpr -> NatM Register
getRegister (CmmExpr -> NatM Register) -> CmmExpr -> NatM Register
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
0 Width
width
| Bool
otherwise = do
x_code <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
x
let
format = Width -> Format
intFormat Width
width
code Reg
dst
= Reg -> InstrBlock
x_code Reg
dst InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Operand -> Instr
instr Format
format (Imm -> Operand
OpImm (CmmLit -> Imm
litToImm CmmLit
lit)) (Reg -> Operand
OpReg Reg
dst)
return (Any format code)
shift_code Width
width Format -> Operand -> Operand -> Instr
instr CmmExpr
x CmmExpr
y = do
x_code <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
x
let format = Width -> Format
intFormat Width
width
tmp <- getNewRegNat format
y_code <- getAnyReg y
let
code = Reg -> InstrBlock
x_code Reg
tmp InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> InstrBlock
y_code Reg
ecx InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Operand -> Instr
instr Format
format (Reg -> Operand
OpReg Reg
ecx) (Reg -> Operand
OpReg Reg
tmp)
return (Fixed format tmp code)
add_code :: Width -> CmmExpr -> CmmExpr -> NatM Register
add_code :: Width -> CmmExpr -> CmmExpr -> NatM Register
add_code Width
rep CmmExpr
x (CmmLit (CmmInt Integer
y Width
_))
| Integer -> Bool
is32BitInteger Integer
y
, Width
rep Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
/= Width
W8
= Width -> CmmExpr -> Integer -> NatM Register
add_int Width
rep CmmExpr
x Integer
y
add_code Width
rep CmmExpr
x CmmExpr
y = Width
-> (Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode Width
rep (Format -> Operand -> Operand -> Instr
ADD Format
format) ((Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
forall a. a -> Maybe a
Just (Format -> Operand -> Operand -> Instr
ADD Format
format)) CmmExpr
x CmmExpr
y
where format :: Format
format = Width -> Format
intFormat Width
rep
sub_code :: Width -> CmmExpr -> CmmExpr -> NatM Register
sub_code :: Width -> CmmExpr -> CmmExpr -> NatM Register
sub_code Width
rep CmmExpr
x (CmmLit (CmmInt Integer
y Width
_))
| Integer -> Bool
is32BitInteger (-Integer
y)
, Width
rep Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
/= Width
W8
= Width -> CmmExpr -> Integer -> NatM Register
add_int Width
rep CmmExpr
x (-Integer
y)
sub_code Width
rep CmmExpr
x CmmExpr
y = Width
-> (Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode Width
rep (Format -> Operand -> Operand -> Instr
SUB (Width -> Format
intFormat Width
rep)) Maybe (Operand -> Operand -> Instr)
forall a. Maybe a
Nothing CmmExpr
x CmmExpr
y
add_int :: Width -> CmmExpr -> Integer -> NatM Register
add_int Width
width CmmExpr
x Integer
y = do
(x_reg, x_code) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
x
let
format = Width -> Format
intFormat Width
width
imm = Int -> Imm
ImmInt (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
y)
code Reg
dst
= InstrBlock
x_code InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Operand -> Instr
LEA Format
format
(AddrMode -> Operand
OpAddr (EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
x_reg) EAIndex
EAIndexNone Imm
imm))
(Reg -> Operand
OpReg Reg
dst)
return (Any format code)
div_code :: Width -> Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
div_code Width
W8 Bool
signed Bool
quotient CmmExpr
x CmmExpr
y = do
let widen :: MachOp
widen | Bool
signed = Width -> Width -> MachOp
MO_SS_Conv Width
W8 Width
W16
| Bool
otherwise = Width -> Width -> MachOp
MO_UU_Conv Width
W8 Width
W16
Width -> Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
div_code
Width
W16
Bool
signed
Bool
quotient
(MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
widen [CmmExpr
x])
(MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
widen [CmmExpr
y])
div_code Width
width Bool
signed Bool
quotient CmmExpr
x CmmExpr
y = do
(y_op, y_code) <- CmmExpr -> NatM (Operand, InstrBlock)
getRegOrMem CmmExpr
y
x_code <- getAnyReg x
let
format = Width -> Format
intFormat Width
width
widen | Bool
signed = Format -> Instr
CLTD Format
format
| Bool
otherwise = Format -> Operand -> Operand -> Instr
XOR Format
format (Reg -> Operand
OpReg Reg
edx) (Reg -> Operand
OpReg Reg
edx)
instr | Bool
signed = Format -> Operand -> Instr
IDIV
| Bool
otherwise = Format -> Operand -> Instr
DIV
code = InstrBlock
y_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> InstrBlock
x_code Reg
eax InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [Instr
widen, Format -> Operand -> Instr
instr Format
format Operand
y_op]
result | Bool
quotient = Reg
eax
| Bool
otherwise = Reg
edx
return (Fixed format result code)
vector_float_op_avx :: (Format -> Operand -> Reg -> Reg -> Instr)
-> Length
-> Width
-> CmmExpr
-> CmmExpr
-> NatM Register
vector_float_op_avx :: (Format -> Operand -> Reg -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_float_op_avx Format -> Operand -> Reg -> Reg -> Instr
instr Int
l Width
w CmmExpr
expr1 CmmExpr
expr2 = do
(reg1, exp1) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
expr1
(reg2, exp2) <- getSomeReg expr2
let format = case Width
w of
Width
W32 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtFloat
Width
W64 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtDouble
Width
_ -> String -> SDoc -> Format
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Floating-point AVX vector operation not supported at this width"
(String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"width:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)
code Reg
dst = InstrBlock
exp1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
exp2 InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Reg -> Instr
instr Format
format (Reg -> Operand
OpReg Reg
reg2) Reg
reg1 Reg
dst)
return (Any format code)
vector_float_op_sse :: (Format -> Operand -> Reg -> Instr)
-> Length -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_float_op_sse :: (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_float_op_sse Format -> Operand -> Reg -> Instr
instr Int
l Width
w = (Format -> Operand -> Reg -> Instr)
-> Format -> CmmExpr -> CmmExpr -> NatM Register
vector_op_sse Format -> Operand -> Reg -> Instr
instr Format
format
where format :: Format
format = case Width
w of
Width
W32 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtFloat
Width
W64 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtDouble
Width
_ -> String -> SDoc -> Format
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Floating-point SSE vector operation not supported at this width"
(String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"width:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)
vector_int_op_sse :: (Format -> Operand -> Reg -> Instr)
-> Length -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_op_sse :: (Format -> Operand -> Reg -> Instr)
-> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_op_sse Format -> Operand -> Reg -> Instr
instr Int
l Width
w = (Format -> Operand -> Reg -> Instr)
-> Format -> CmmExpr -> CmmExpr -> NatM Register
vector_op_sse Format -> Operand -> Reg -> Instr
instr Format
format
where format :: Format
format = case Width
w of
Width
W8 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt8
Width
W16 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt16
Width
W32 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt32
Width
W64 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt64
Width
_ -> String -> SDoc -> Format
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Integer SSE vector operation not supported at this width"
(String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"width:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)
vector_op_sse :: (Format -> Operand -> Reg -> Instr)
-> Format
-> CmmExpr
-> CmmExpr
-> NatM Register
vector_op_sse :: (Format -> Operand -> Reg -> Instr)
-> Format -> CmmExpr -> CmmExpr -> NatM Register
vector_op_sse Format -> Operand -> Reg -> Instr
instr Format
format CmmExpr
expr1 CmmExpr
expr2 = do
config <- NatM NCGConfig
getConfig
exp1_code <- getAnyReg expr1
(reg2, exp2_code) <- getSomeReg expr2
tmp <- getNewRegNat format
let code Reg
dst
| Reg
dst Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
reg2 = InstrBlock
exp2_code InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
HasDebugCallStack =>
NCGConfig -> Format -> Operand -> Operand -> Instr
NCGConfig -> Format -> Operand -> Operand -> Instr
movInstr NCGConfig
config Format
format (Reg -> Operand
OpReg Reg
reg2) (Reg -> Operand
OpReg Reg
tmp) InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> InstrBlock
exp1_code Reg
dst InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Reg -> Instr
instr Format
format (Reg -> Operand
OpReg Reg
tmp) Reg
dst
| Bool
otherwise = InstrBlock
exp2_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> InstrBlock
exp1_code Reg
dst InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Reg -> Instr
instr Format
format (Reg -> Operand
OpReg Reg
reg2) Reg
dst
return (Any format code)
vector_float_extract :: Length
-> Width
-> CmmExpr
-> CmmExpr
-> NatM Register
vector_float_extract :: Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_float_extract Int
l Width
W32 CmmExpr
expr (CmmLit CmmLit
lit) = do
(r, exp) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
expr
let format = Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtFloat
imm = CmmLit -> Imm
litToImm CmmLit
lit
code Reg
dst
= case CmmLit
lit of
CmmInt Integer
0 Width
_ -> InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL` (Format -> Operand -> Operand -> Instr
MOV Format
FF32 (Reg -> Operand
OpReg Reg
r) (Reg -> Operand
OpReg Reg
dst))
CmmInt Integer
_ Width
_ -> InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL` (Format -> Imm -> Operand -> Reg -> Instr
VPSHUFD Format
format Imm
imm (Reg -> Operand
OpReg Reg
r) Reg
dst)
CmmLit
_ -> String -> SDoc -> InstrBlock
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Unsupported AVX floating-point vector extract offset" (CmmLit -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmLit
lit)
return (Any FF32 code)
vector_float_extract Int
l Width
W64 CmmExpr
expr (CmmLit CmmLit
lit) = do
(r, exp) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
expr
let format = Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtDouble
code Reg
dst
= case CmmLit
lit of
CmmInt Integer
0 Width
_ -> InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOV Format
FF64 (Reg -> Operand
OpReg Reg
r) (Reg -> Operand
OpReg Reg
dst))
CmmInt Integer
1 Width
_ -> InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Reg -> Reg -> Instr
MOVHLPS Format
format Reg
r Reg
dst)
CmmLit
_ -> String -> SDoc -> InstrBlock
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Unsupported AVX floating-point vector extract offset" (CmmLit -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmLit
lit)
return (Any FF64 code)
vector_float_extract Int
_ Width
w CmmExpr
c CmmExpr
e =
String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Unsupported AVX floating-point vector extract" (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
c SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
e SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)
vector_float_extract_sse :: Length
-> Width
-> CmmExpr
-> CmmExpr
-> NatM Register
vector_float_extract_sse :: Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_float_extract_sse Int
l Width
W32 CmmExpr
expr (CmmLit CmmLit
lit)
= do
(r,exp) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
expr
let format = Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtFloat
imm = CmmLit -> Imm
litToImm CmmLit
lit
code Reg
dst
= case CmmLit
lit of
CmmInt Integer
0 Width
_ -> InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL` (Format -> Operand -> Operand -> Instr
MOVU Format
format (Reg -> Operand
OpReg Reg
r) (Reg -> Operand
OpReg Reg
dst))
CmmInt Integer
_ Width
_ -> InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL` (Format -> Imm -> Operand -> Reg -> Instr
PSHUFD Format
format Imm
imm (Reg -> Operand
OpReg Reg
r) Reg
dst)
CmmLit
_ -> String -> SDoc -> InstrBlock
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Unsupported SSE floating-point vector extract offset" (CmmLit -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmLit
lit)
return (Any FF32 code)
vector_float_extract_sse Int
_ Width
w CmmExpr
c CmmExpr
e
= String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Unsupported SSE floating-point vector extract" (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
c SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
e SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
w)
vector_int_extract_pextr :: Length
-> Width
-> CmmExpr
-> CmmExpr
-> NatM Register
vector_int_extract_pextr :: Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_extract_pextr Int
l Width
w CmmExpr
expr (CmmLit (CmmInt Integer
i Width
_))
| Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i, Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
l
= do
(r, exp) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
expr
let (scalarFormat, vectorFormat) = case w of
Width
W8 -> (Format
II32, Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt8)
Width
W16 -> (Format
II32, Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt16)
Width
W32 -> (Format
II32, Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt32)
Width
W64 -> (Format
II64, Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt64)
Width
_ -> String -> (Format, Format)
forall a. HasCallStack => String -> a
sorry String
"Unsupported vector format"
code Reg
dst = InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Imm -> Reg -> Operand -> Instr
PEXTR Format
scalarFormat Format
vectorFormat (Integer -> Imm
ImmInteger Integer
i) Reg
r (Reg -> Operand
OpReg Reg
dst))
return (Any scalarFormat code)
vector_int_extract_pextr Int
_ Width
_ CmmExpr
_ CmmExpr
i
= String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Unsupported offset" (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
i)
vector_int8x16_extract_sse2 :: CmmExpr
-> CmmExpr
-> NatM Register
vector_int8x16_extract_sse2 :: CmmExpr -> CmmExpr -> NatM Register
vector_int8x16_extract_sse2 CmmExpr
expr (CmmLit (CmmInt Integer
i Width
_))
| Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i, Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
16
= do
(r, exp) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
expr
let code Reg
dst =
case Integer
i Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
2 of
(Integer
j, Integer
0) -> InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Imm -> Reg -> Operand -> Instr
PEXTR Format
II32 (Int -> ScalarFormat -> Format
VecFormat Int
8 ScalarFormat
FmtInt16) (Integer -> Imm
ImmInteger Integer
j) Reg
r (Reg -> Operand
OpReg Reg
dst))
(Integer
j, Integer
_) -> InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Imm -> Reg -> Operand -> Instr
PEXTR Format
II32 (Int -> ScalarFormat -> Format
VecFormat Int
8 ScalarFormat
FmtInt16) (Integer -> Imm
ImmInteger Integer
j) Reg
r (Reg -> Operand
OpReg Reg
dst)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
SHR Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
8)) (Reg -> Operand
OpReg Reg
dst))
return (Any II8 code)
vector_int8x16_extract_sse2 CmmExpr
_ CmmExpr
offset
= String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Unsupported offset" (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
offset)
vector_int32x4_extract_sse2 :: CmmExpr
-> CmmExpr
-> NatM Register
vector_int32x4_extract_sse2 :: CmmExpr -> CmmExpr -> NatM Register
vector_int32x4_extract_sse2 CmmExpr
expr (CmmLit (CmmInt Integer
i Width
_))
| Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i, Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
4
= do
(r, exp) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
expr
let fmt = Int -> ScalarFormat -> Format
VecFormat Int
4 ScalarFormat
FmtInt32
tmp <- getNewRegNat fmt
let code Reg
dst =
case Integer
i of
Integer
0 -> InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Operand -> Instr
MOVD Format
fmt Format
II32 (Reg -> Operand
OpReg Reg
r) (Reg -> Operand
OpReg Reg
dst))
Integer
1 -> InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
PSHUFD Format
fmt (Int -> Imm
ImmInt Int
0b01_01_01_01) (Reg -> Operand
OpReg Reg
r) Reg
tmp) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Operand -> Instr
MOVD Format
fmt Format
II32 (Reg -> Operand
OpReg Reg
tmp) (Reg -> Operand
OpReg Reg
dst))
Integer
2 -> InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
PSHUFD Format
fmt (Int -> Imm
ImmInt Int
0b11_10_11_10) (Reg -> Operand
OpReg Reg
r) Reg
tmp) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Operand -> Instr
MOVD Format
fmt Format
II32 (Reg -> Operand
OpReg Reg
tmp) (Reg -> Operand
OpReg Reg
dst))
Integer
_ -> InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
PSHUFD Format
fmt (Int -> Imm
ImmInt Int
0b11_11_11_11) (Reg -> Operand
OpReg Reg
r) Reg
tmp) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Operand -> Instr
MOVD Format
fmt Format
II32 (Reg -> Operand
OpReg Reg
tmp) (Reg -> Operand
OpReg Reg
dst))
return (Any II32 code)
vector_int32x4_extract_sse2 CmmExpr
_ CmmExpr
offset
= String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Unsupported offset" (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
offset)
vector_int64x2_extract_sse2 :: CmmExpr
-> CmmExpr
-> NatM Register
vector_int64x2_extract_sse2 :: CmmExpr -> CmmExpr -> NatM Register
vector_int64x2_extract_sse2 CmmExpr
expr (CmmLit CmmLit
lit)
= do
(r, exp) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
expr
let fmt = Int -> ScalarFormat -> Format
VecFormat Int
2 ScalarFormat
FmtInt64
tmp <- getNewRegNat fmt
let code Reg
dst =
case CmmLit
lit of
CmmInt Integer
0 Width
_ -> InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Operand -> Instr
MOVD Format
fmt Format
II64 (Reg -> Operand
OpReg Reg
r) (Reg -> Operand
OpReg Reg
dst))
CmmInt Integer
1 Width
_ -> InstrBlock
exp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Reg -> Reg -> Instr
MOVHLPS Format
fmt Reg
r Reg
tmp) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Operand -> Instr
MOVD Format
fmt Format
II64 (Reg -> Operand
OpReg Reg
tmp) (Reg -> Operand
OpReg Reg
dst))
CmmLit
_ -> String -> InstrBlock
forall a. HasCallStack => String -> a
panic String
"Error in offset while unpacking"
return (Any II64 code)
vector_int64x2_extract_sse2 CmmExpr
_ CmmExpr
offset
= String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Unsupported offset" (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
offset)
vector_int8x16_mul_sse2 :: CmmExpr -> CmmExpr -> NatM Register
vector_int8x16_mul_sse2 :: CmmExpr -> CmmExpr -> NatM Register
vector_int8x16_mul_sse2 CmmExpr
expr1 CmmExpr
expr2 = do
(reg1, exp1) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
expr1
(reg2, exp2) <- getSomeReg expr2
let format = Int -> ScalarFormat -> Format
VecFormat Int
16 ScalarFormat
FmtInt8
format16 = Int -> ScalarFormat -> Format
VecFormat Int
8 ScalarFormat
FmtInt16
tmp1lo <- getNewRegNat format
tmp1hi <- getNewRegNat format
tmp2hi <- getNewRegNat format
tmp2lo <- getNewRegNat format
(maskReg, maskCode) <- getSomeReg (CmmLit $ CmmVec $ replicate 8 (CmmInt 0xff W16))
let code = InstrBlock
exp1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
exp2 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
maskCode InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVDQU Format
format (Reg -> Operand
OpReg Reg
reg1) (Reg -> Operand
OpReg Reg
tmp1lo)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVDQU Format
format (Reg -> Operand
OpReg Reg
reg2) (Reg -> Operand
OpReg Reg
tmp2lo)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PUNPCKLBW Format
format (Reg -> Operand
OpReg Reg
reg1) Reg
tmp1lo) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PUNPCKLBW Format
format (Reg -> Operand
OpReg Reg
reg2) Reg
tmp2lo) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVDQU Format
format (Reg -> Operand
OpReg Reg
reg1) (Reg -> Operand
OpReg Reg
tmp1hi)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVDQU Format
format (Reg -> Operand
OpReg Reg
reg2) (Reg -> Operand
OpReg Reg
tmp2hi)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PUNPCKHBW Format
format (Reg -> Operand
OpReg Reg
reg1) Reg
tmp1hi) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PMULL Format
format16 (Reg -> Operand
OpReg Reg
tmp2lo) Reg
tmp1lo) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PUNPCKHBW Format
format (Reg -> Operand
OpReg Reg
reg2) Reg
tmp2hi) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PMULL Format
format16 (Reg -> Operand
OpReg Reg
tmp2hi) Reg
tmp1hi) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PAND Format
format (Reg -> Operand
OpReg Reg
maskReg) Reg
tmp1lo) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PAND Format
format (Reg -> Operand
OpReg Reg
maskReg) Reg
tmp1hi) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PACKUSWB Format
format (Reg -> Operand
OpReg Reg
tmp1hi) Reg
tmp1lo)
return (Fixed format tmp1lo code)
vector_int32x4_mul_sse2 :: CmmExpr -> CmmExpr -> NatM Register
vector_int32x4_mul_sse2 :: CmmExpr -> CmmExpr -> NatM Register
vector_int32x4_mul_sse2 CmmExpr
expr1 CmmExpr
expr2 = do
(reg1, exp1) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
expr1
(reg2, exp2) <- getSomeReg expr2
let format = Int -> ScalarFormat -> Format
VecFormat Int
4 ScalarFormat
FmtInt32
tmpEven <- getNewRegNat format
tmpOdd1 <- getNewRegNat format
tmpOdd2 <- getNewRegNat format
let code Reg
dst = InstrBlock
exp1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
exp2 InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVDQU Format
format (Reg -> Operand
OpReg Reg
reg1) (Reg -> Operand
OpReg Reg
tmpEven)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
PSHUFD Format
format (Int -> Imm
ImmInt Int
0b11_11_01_01) (Reg -> Operand
OpReg Reg
reg1) Reg
tmpOdd1) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PMULUDQ Format
format (Reg -> Operand
OpReg Reg
reg2) Reg
tmpEven) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
PSHUFD Format
format (Int -> Imm
ImmInt Int
0b11_11_01_01) (Reg -> Operand
OpReg Reg
reg2) Reg
tmpOdd2) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PMULUDQ Format
format (Reg -> Operand
OpReg Reg
tmpOdd2) Reg
tmpOdd1) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
PSHUFD Format
format (Int -> Imm
ImmInt Int
0b00_00_10_00) (Reg -> Operand
OpReg Reg
tmpEven) Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
PSHUFD Format
format (Int -> Imm
ImmInt Int
0b00_00_10_00) (Reg -> Operand
OpReg Reg
tmpOdd1) Reg
tmpOdd1) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PUNPCKLDQ Format
format (Reg -> Operand
OpReg Reg
tmpOdd1) Reg
dst)
return (Any format code)
vector_int64x2_mul_sse2 :: CmmExpr -> CmmExpr -> NatM Register
vector_int64x2_mul_sse2 :: CmmExpr -> CmmExpr -> NatM Register
vector_int64x2_mul_sse2 CmmExpr
expr1 CmmExpr
expr2 = do
exp1 <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
expr1
exp2 <- getAnyReg expr2
let format = Int -> ScalarFormat -> Format
VecFormat Int
2 ScalarFormat
FmtInt64
reg1 <- getNewRegNat format
reg2 <- getNewRegNat format
tmp1Hi <- getNewRegNat format
tmp2Hi <- getNewRegNat format
let code Reg
dst = Reg -> InstrBlock
exp1 Reg
reg1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> InstrBlock
exp2 Reg
reg2 InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVDQU Format
format (Reg -> Operand
OpReg Reg
reg1) (Reg -> Operand
OpReg Reg
dst)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVDQU Format
format (Reg -> Operand
OpReg Reg
reg1) (Reg -> Operand
OpReg Reg
tmp1Hi)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVDQU Format
format (Reg -> Operand
OpReg Reg
reg2) (Reg -> Operand
OpReg Reg
tmp2Hi)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PSRL Format
format (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
32)) Reg
tmp1Hi) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PMULUDQ Format
format (Reg -> Operand
OpReg Reg
reg2) Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PSRL Format
format (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
32)) Reg
tmp2Hi) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PMULUDQ Format
format (Reg -> Operand
OpReg Reg
reg2) Reg
tmp1Hi) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PMULUDQ Format
format (Reg -> Operand
OpReg Reg
reg1) Reg
tmp2Hi) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PADD Format
format (Reg -> Operand
OpReg Reg
tmp2Hi) Reg
tmp1Hi) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PSLL Format
format (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
32)) Reg
tmp1Hi) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PADD Format
format (Reg -> Operand
OpReg Reg
tmp1Hi) Reg
dst)
return (Any format code)
vector_int_minmax_sse :: MinOrMax -> Length -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_minmax_sse :: MinOrMax -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_int_minmax_sse MinOrMax
minmax Int
l Width
w CmmExpr
expr1 CmmExpr
expr2 = do
exp1 <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
expr1
exp2 <- getAnyReg expr2
let format = case Width
w of
Width
W8 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt8
Width
W16 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt16
Width
W32 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt32
Width
W64 -> Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt64
Width
_ -> String -> Format
forall a. HasCallStack => String -> a
panic String
"Unsupported width"
reg1 <- getNewRegNat format
reg2 <- getNewRegNat format
tmp <- getNewRegNat format
let codeMin Reg
dst = Reg -> InstrBlock
exp1 Reg
reg1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> InstrBlock
exp2 Reg
reg2 InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVDQU Format
format (Reg -> Operand
OpReg Reg
reg1) (Reg -> Operand
OpReg Reg
dst)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVDQU Format
format (Reg -> Operand
OpReg Reg
reg2) (Reg -> Operand
OpReg Reg
tmp)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PCMPGT Format
format (Reg -> Operand
OpReg Reg
reg2) Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PAND Format
format (Reg -> Operand
OpReg Reg
dst) Reg
tmp) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PANDN Format
format (Reg -> Operand
OpReg Reg
reg1) Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
POR Format
format (Reg -> Operand
OpReg Reg
tmp) Reg
dst)
codeMax Reg
dst = Reg -> InstrBlock
exp1 Reg
reg1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> InstrBlock
exp2 Reg
reg2 InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVDQU Format
format (Reg -> Operand
OpReg Reg
reg1) (Reg -> Operand
OpReg Reg
dst)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVDQU Format
format (Reg -> Operand
OpReg Reg
reg1) (Reg -> Operand
OpReg Reg
tmp)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PCMPGT Format
format (Reg -> Operand
OpReg Reg
reg2) Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PAND Format
format (Reg -> Operand
OpReg Reg
dst) Reg
tmp) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PANDN Format
format (Reg -> Operand
OpReg Reg
reg2) Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
POR Format
format (Reg -> Operand
OpReg Reg
tmp) Reg
dst)
return $ case minmax of
MinOrMax
Min -> Format -> (Reg -> InstrBlock) -> Register
Any Format
format Reg -> InstrBlock
codeMin
MinOrMax
Max -> Format -> (Reg -> InstrBlock) -> Register
Any Format
format Reg -> InstrBlock
codeMax
vector_word_minmax_sse :: MinOrMax -> Length -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_word_minmax_sse :: MinOrMax -> Int -> Width -> CmmExpr -> CmmExpr -> NatM Register
vector_word_minmax_sse MinOrMax
minmax Int
l Width
w CmmExpr
expr1 CmmExpr
expr2 = do
exp1 <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
expr1
exp2 <- getAnyReg expr2
let (format, sign) = case w of
Width
W8 -> (Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt8, Integer
0x80)
Width
W16 -> (Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt16, Integer
0x8000)
Width
W32 -> (Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt32, Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
31 :: Int))
Width
W64 -> (Int -> ScalarFormat -> Format
VecFormat Int
l ScalarFormat
FmtInt64, Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
63 :: Int))
Width
_ -> String -> (Format, Integer)
forall a. HasCallStack => String -> a
panic String
"Unsupported width"
reg1 <- getNewRegNat format
reg2 <- getNewRegNat format
tmp1 <- getNewRegNat format
tmp2 <- getNewRegNat format
(signReg, signCode) <- getSomeReg (CmmLit $ CmmVec $ replicate l (CmmInt sign w))
let codeMin Reg
dst = Reg -> InstrBlock
exp1 Reg
reg1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> InstrBlock
exp2 Reg
reg2 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
signCode InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVDQU Format
format (Reg -> Operand
OpReg Reg
reg1) (Reg -> Operand
OpReg Reg
dst)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVDQU Format
format (Reg -> Operand
OpReg Reg
reg2) (Reg -> Operand
OpReg Reg
tmp1)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVDQU Format
format (Reg -> Operand
OpReg Reg
reg2) (Reg -> Operand
OpReg Reg
tmp2)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PXOR Format
format (Reg -> Operand
OpReg Reg
signReg) Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PXOR Format
format (Reg -> Operand
OpReg Reg
signReg) Reg
tmp1) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PCMPGT Format
format (Reg -> Operand
OpReg Reg
tmp1) Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PAND Format
format (Reg -> Operand
OpReg Reg
dst) Reg
tmp2) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PANDN Format
format (Reg -> Operand
OpReg Reg
reg1) Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
POR Format
format (Reg -> Operand
OpReg Reg
tmp2) Reg
dst)
codeMax Reg
dst = Reg -> InstrBlock
exp1 Reg
reg1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> InstrBlock
exp2 Reg
reg2 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
signCode InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVDQU Format
format (Reg -> Operand
OpReg Reg
reg1) (Reg -> Operand
OpReg Reg
dst)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVDQU Format
format (Reg -> Operand
OpReg Reg
reg2) (Reg -> Operand
OpReg Reg
tmp1)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVDQU Format
format (Reg -> Operand
OpReg Reg
reg1) (Reg -> Operand
OpReg Reg
tmp2)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PXOR Format
format (Reg -> Operand
OpReg Reg
signReg) Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PXOR Format
format (Reg -> Operand
OpReg Reg
signReg) Reg
tmp1) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PCMPGT Format
format (Reg -> Operand
OpReg Reg
tmp1) Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PAND Format
format (Reg -> Operand
OpReg Reg
dst) Reg
tmp2) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PANDN Format
format (Reg -> Operand
OpReg Reg
reg2) Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
POR Format
format (Reg -> Operand
OpReg Reg
tmp2) Reg
dst)
return $ case minmax of
MinOrMax
Min -> Format -> (Reg -> InstrBlock) -> Register
Any Format
format Reg -> InstrBlock
codeMin
MinOrMax
Max -> Format -> (Reg -> InstrBlock) -> Register
Any Format
format Reg -> InstrBlock
codeMax
vector_shuffle_float :: Length -> Width -> CmmExpr -> CmmExpr -> [Int] -> NatM Register
vector_shuffle_float :: Int -> Width -> CmmExpr -> CmmExpr -> [Int] -> NatM Register
vector_shuffle_float Int
l Width
w CmmExpr
v1 CmmExpr
v2 [Int]
is = do
(r1, exp1) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
v1
(r2, exp2) <- getSomeReg v2
let fmt = Int -> ScalarFormat -> Format
VecFormat Int
l (if Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W32 then ScalarFormat
FmtFloat else ScalarFormat
FmtDouble)
code Reg
dst
= InstrBlock
exp1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` (InstrBlock
exp2 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Format -> Reg -> Reg -> [Int] -> Reg -> InstrBlock
shuffleInstructions Format
fmt Reg
r1 Reg
r2 [Int]
is Reg
dst)
return (Any fmt code)
shuffleInstructions :: Format -> Reg -> Reg -> [Int] -> Reg -> OrdList Instr
shuffleInstructions :: Format -> Reg -> Reg -> [Int] -> Reg -> InstrBlock
shuffleInstructions Format
fmt Reg
v1 Reg
v2 [Int]
is Reg
dst =
case Format
fmt of
VecFormat Int
2 ScalarFormat
FmtDouble ->
case [Int]
is of
[Int
i1, Int
i2] -> case (Int
i1, Int
i2) of
(Int
0,Int
0) -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Reg -> Instr
VSHUF Format
fmt (Int -> Imm
ImmInt Int
0b00) (Reg -> Operand
OpReg Reg
v1) Reg
v1 Reg
dst)
(Int
1,Int
1) -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Reg -> Instr
VSHUF Format
fmt (Int -> Imm
ImmInt Int
0b11) (Reg -> Operand
OpReg Reg
v1) Reg
v1 Reg
dst)
(Int
2,Int
2) -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Reg -> Instr
VSHUF Format
fmt (Int -> Imm
ImmInt Int
0b00) (Reg -> Operand
OpReg Reg
v2) Reg
v2 Reg
dst)
(Int
3,Int
3) -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Reg -> Instr
VSHUF Format
fmt (Int -> Imm
ImmInt Int
0b11) (Reg -> Operand
OpReg Reg
v2) Reg
v2 Reg
dst)
(Int
0,Int
1) -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
VMOVU Format
fmt (Reg -> Operand
OpReg Reg
v1) (Reg -> Operand
OpReg Reg
dst))
(Int
2,Int
3) -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
VMOVU Format
fmt (Reg -> Operand
OpReg Reg
v2) (Reg -> Operand
OpReg Reg
dst))
(Int
1,Int
0) -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Reg -> Instr
VSHUF Format
fmt (Int -> Imm
ImmInt Int
0b01) (Reg -> Operand
OpReg Reg
v1) Reg
v1 Reg
dst)
(Int
3,Int
2) -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Reg -> Instr
VSHUF Format
fmt (Int -> Imm
ImmInt Int
0b01) (Reg -> Operand
OpReg Reg
v2) Reg
v2 Reg
dst)
(Int
0,Int
2) -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Reg -> Instr
VSHUF Format
fmt (Int -> Imm
ImmInt Int
0b00) (Reg -> Operand
OpReg Reg
v2) Reg
v1 Reg
dst)
(Int
2,Int
0) -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Reg -> Instr
VSHUF Format
fmt (Int -> Imm
ImmInt Int
0b00) (Reg -> Operand
OpReg Reg
v1) Reg
v2 Reg
dst)
(Int
0,Int
3) -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Reg -> Instr
VSHUF Format
fmt (Int -> Imm
ImmInt Int
0b10) (Reg -> Operand
OpReg Reg
v2) Reg
v1 Reg
dst)
(Int
3,Int
0) -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Reg -> Instr
VSHUF Format
fmt (Int -> Imm
ImmInt Int
0b01) (Reg -> Operand
OpReg Reg
v1) Reg
v2 Reg
dst)
(Int
1,Int
2) -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Reg -> Instr
VSHUF Format
fmt (Int -> Imm
ImmInt Int
0b01) (Reg -> Operand
OpReg Reg
v2) Reg
v1 Reg
dst)
(Int
2,Int
1) -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Reg -> Instr
VSHUF Format
fmt (Int -> Imm
ImmInt Int
0b10) (Reg -> Operand
OpReg Reg
v1) Reg
v2 Reg
dst)
(Int
1,Int
3) -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Reg -> Instr
VSHUF Format
fmt (Int -> Imm
ImmInt Int
0b11) (Reg -> Operand
OpReg Reg
v2) Reg
v1 Reg
dst)
(Int
3,Int
1) -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Reg -> Instr
VSHUF Format
fmt (Int -> Imm
ImmInt Int
0b11) (Reg -> Operand
OpReg Reg
v1) Reg
v2 Reg
dst)
(Int, Int)
_ -> String -> SDoc -> InstrBlock
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"vector shuffle: indices out of bounds 0 <= i <= 3" ([Int] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Int]
is)
[Int]
_ -> String -> SDoc -> InstrBlock
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"vector shuffle: wrong number of indices (expected 2)" ([Int] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Int]
is)
VecFormat Int
4 ScalarFormat
FmtFloat
| (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ( (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (Int -> Bool) -> (Int -> Bool) -> Int -> Bool
forall (f :: * -> *). Applicative f => f Bool -> f Bool -> f Bool
<&&> (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
7) ) [Int]
is ->
case [(Int
i, Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
4) | Int
i <- [Int]
is] of
[(Int
i1, Int
j1), (Int
i2, Int
j2), (Int
i3, Int
j3), (Int
i4, Int
j4)]
| (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ( Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3 ) [Int]
is
, let imm :: Int
imm = Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i2 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i3 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i4 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
6
-> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Reg -> Instr
VSHUF Format
fmt (Int -> Imm
ImmInt Int
imm) (Reg -> Operand
OpReg Reg
v1) Reg
v1 Reg
dst)
| (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ( Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4 ) [Int]
is
, let imm :: Int
imm = Int
j1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j2 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j3 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j4 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
6
-> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Reg -> Instr
VSHUF Format
fmt (Int -> Imm
ImmInt Int
imm) (Reg -> Operand
OpReg Reg
v2) Reg
v2 Reg
dst)
| Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3, Int
i2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3
, Int
i3 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4, Int
i4 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4
, let imm :: Int
imm = Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i2 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
6
-> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Reg -> Instr
VSHUF Format
fmt (Int -> Imm
ImmInt Int
imm) (Reg -> Operand
OpReg Reg
v2) Reg
v1 Reg
dst)
| Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4, Int
i2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4
, Int
i3 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3, Int
i4 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3
, let imm :: Int
imm = (Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i3 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i4 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
6
-> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Reg -> Instr
VSHUF Format
fmt (Int -> Imm
ImmInt Int
imm) (Reg -> Operand
OpReg Reg
v1) Reg
v2 Reg
dst)
| Bool
otherwise
->
let
insertImm :: a -> a -> a
insertImm a
src a
dst = a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL ( a
src a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
4 ) Int
6
a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
dst Int
4
vec :: Int -> Reg
vec Int
src = if Int
src Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4 then Reg
v2 else Reg
v1
in Instr -> InstrBlock
forall a. a -> OrdList a
unitOL
(Format -> Imm -> Operand -> Reg -> Instr
INSERTPS Format
fmt (Int -> Imm
ImmInt (Int -> Imm) -> Int -> Imm
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall {a}. (Bits a, Integral a) => a -> a -> a
insertImm Int
i1 Int
0 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
0b1110) (Reg -> Operand
OpReg (Reg -> Operand) -> Reg -> Operand
forall a b. (a -> b) -> a -> b
$ Int -> Reg
vec Int
i1) Reg
dst)
InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
INSERTPS Format
fmt (Int -> Imm
ImmInt (Int -> Imm) -> Int -> Imm
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall {a}. (Bits a, Integral a) => a -> a -> a
insertImm Int
i2 Int
1) (Reg -> Operand
OpReg (Reg -> Operand) -> Reg -> Operand
forall a b. (a -> b) -> a -> b
$ Int -> Reg
vec Int
i2) Reg
dst)
InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
INSERTPS Format
fmt (Int -> Imm
ImmInt (Int -> Imm) -> Int -> Imm
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall {a}. (Bits a, Integral a) => a -> a -> a
insertImm Int
i3 Int
2) (Reg -> Operand
OpReg (Reg -> Operand) -> Reg -> Operand
forall a b. (a -> b) -> a -> b
$ Int -> Reg
vec Int
i3) Reg
dst)
InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
INSERTPS Format
fmt (Int -> Imm
ImmInt (Int -> Imm) -> Int -> Imm
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall {a}. (Bits a, Integral a) => a -> a -> a
insertImm Int
i4 Int
3) (Reg -> Operand
OpReg (Reg -> Operand) -> Reg -> Operand
forall a b. (a -> b) -> a -> b
$ Int -> Reg
vec Int
i4) Reg
dst)
[(Int, Int)]
_ -> String -> SDoc -> InstrBlock
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"vector shuffle: wrong number of indices (expected 4)" ([Int] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Int]
is)
| Bool
otherwise
-> String -> SDoc -> InstrBlock
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"vector shuffle: indices out of bounds 0 <= i <= 7" ([Int] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Int]
is)
Format
_ ->
String -> SDoc -> InstrBlock
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"vector shuffle: unsupported format" (Format -> SDoc
forall a. Outputable a => a -> SDoc
ppr Format
fmt)
isZeroVecLit :: CmmExpr -> Bool
isZeroVecLit :: CmmExpr -> Bool
isZeroVecLit (CmmLit (CmmVec [CmmLit]
elems)) = (CmmLit -> Bool) -> [CmmLit] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\CmmLit
lit -> case CmmLit
lit of CmmInt Integer
0 Width
_ -> Bool
True; CmmLit
_ -> Bool
False) [CmmLit]
elems
isZeroVecLit CmmExpr
_ = Bool
False
vector_shuffle_int128_common :: Bool -> Format -> CmmExpr -> CmmExpr -> [Int] -> Maybe (NatM Register)
vector_shuffle_int128_common :: Bool
-> Format -> CmmExpr -> CmmExpr -> [Int] -> Maybe (NatM Register)
vector_shuffle_int128_common Bool
sse4_1 Format
fmt CmmExpr
v1 CmmExpr
v2 [Int]
is
| [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
is Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n, (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
i -> Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) [Int]
is = if
| [Int]
is [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] -> NatM Register -> Maybe (NatM Register)
forall a. a -> Maybe a
Just (NatM Register -> Maybe (NatM Register))
-> NatM Register -> Maybe (NatM Register)
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Platform -> Bool -> CmmExpr -> NatM Register
Platform -> Bool -> CmmExpr -> NatM Register
getRegister' Platform
platform Bool
is32Bit CmmExpr
v1
| [Int]
is [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int
n..Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] -> NatM Register -> Maybe (NatM Register)
forall a. a -> Maybe a
Just (NatM Register -> Maybe (NatM Register))
-> NatM Register -> Maybe (NatM Register)
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Platform -> Bool -> CmmExpr -> NatM Register
Platform -> Bool -> CmmExpr -> NatM Register
getRegister' Platform
platform Bool
is32Bit CmmExpr
v2
| Bool
v1IsZero, (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n) [Int]
is -> NatM Register -> Maybe (NatM Register)
forall a. a -> Maybe a
Just (NatM Register -> Maybe (NatM Register))
-> NatM Register -> Maybe (NatM Register)
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Platform -> Bool -> CmmExpr -> NatM Register
Platform -> Bool -> CmmExpr -> NatM Register
getRegister' Platform
platform Bool
is32Bit CmmExpr
v1
| Bool
v2IsZero, (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n) [Int]
is -> NatM Register -> Maybe (NatM Register)
forall a. a -> Maybe a
Just (NatM Register -> Maybe (NatM Register))
-> NatM Register -> Maybe (NatM Register)
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Platform -> Bool -> CmmExpr -> NatM Register
Platform -> Bool -> CmmExpr -> NatM Register
getRegister' Platform
platform Bool
is32Bit CmmExpr
v2
| Bool
v2IsZero, ([Int]
z, [Int]
js) <- (Int -> Bool) -> [Int] -> ([Int], [Int])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n) [Int]
is, [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) [Int]
js [Int
0..]) -> NatM Register -> Maybe (NatM Register)
forall a. a -> Maybe a
Just (NatM Register -> Maybe (NatM Register))
-> NatM Register -> Maybe (NatM Register)
forall a b. (a -> b) -> a -> b
$ do
exp1 <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
v1
let code Reg
dst = Reg -> InstrBlock
exp1 Reg
dst InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Reg -> Instr
PSLLDQ Format
fmt (Int -> Imm
ImmInt (Int
widthInBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
z)) Reg
dst)
return (Any fmt code)
| Bool
v1IsZero, ([Int]
z, [Int]
js) <- (Int -> Bool) -> [Int] -> ([Int], [Int])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n) [Int]
is, [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) [Int]
js [Int
n..]) -> NatM Register -> Maybe (NatM Register)
forall a. a -> Maybe a
Just (NatM Register -> Maybe (NatM Register))
-> NatM Register -> Maybe (NatM Register)
forall a b. (a -> b) -> a -> b
$ do
exp2 <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
v2
let code Reg
dst = Reg -> InstrBlock
exp2 Reg
dst InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Reg -> Instr
PSLLDQ Format
fmt (Int -> Imm
ImmInt (Int
widthInBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
z)) Reg
dst)
return (Any fmt code)
| Bool
v2IsZero, ([Int]
js, [Int]
z) <- (Int -> Bool) -> [Int] -> ([Int], [Int])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n) [Int]
is, (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n) [Int]
z, [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
js) [Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2..]) -> NatM Register -> Maybe (NatM Register)
forall a. a -> Maybe a
Just (NatM Register -> Maybe (NatM Register))
-> NatM Register -> Maybe (NatM Register)
forall a b. (a -> b) -> a -> b
$ do
exp1 <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
v1
let code Reg
dst = Reg -> InstrBlock
exp1 Reg
dst InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Reg -> Instr
PSRLDQ Format
fmt (Int -> Imm
ImmInt (Int
widthInBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
z)) Reg
dst)
return (Any fmt code)
| Bool
v1IsZero, ([Int]
js, [Int]
z) <- (Int -> Bool) -> [Int] -> ([Int], [Int])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n) [Int]
is, (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n) [Int]
z, [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
js) [Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2..]) -> NatM Register -> Maybe (NatM Register)
forall a. a -> Maybe a
Just (NatM Register -> Maybe (NatM Register))
-> NatM Register -> Maybe (NatM Register)
forall a b. (a -> b) -> a -> b
$ do
exp2 <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
v2
let code Reg
dst = Reg -> InstrBlock
exp2 Reg
dst InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Reg -> Instr
PSRLDQ Format
fmt (Int -> Imm
ImmInt (Int
widthInBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
z)) Reg
dst)
return (Any fmt code)
| ([Int]
js, [Int]
ks) <- (Int -> Bool) -> [Int] -> ([Int], [Int])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n) [Int]
is, [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
js) [Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2..]), [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) [Int]
ks [Int
n..]) -> NatM Register -> Maybe (NatM Register)
forall a. a -> Maybe a
Just (NatM Register -> Maybe (NatM Register))
-> NatM Register -> Maybe (NatM Register)
forall a b. (a -> b) -> a -> b
$ do
ssse3 <- NatM Bool
ssse3Enabled
let amountInBytes = Int
widthInBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ks
if ssse3
then vector_op_sse (`PALIGNR` (ImmInt amountInBytes)) fmt v2 v1
else do
exp1 <- getAnyReg v1
exp2 <- getAnyReg v2
tmp <- getNewRegNat fmt
let code Reg
dst = Reg -> InstrBlock
exp1 Reg
tmp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Reg -> Instr
PSRLDQ Format
fmt (Int -> Imm
ImmInt Int
amountInBytes) Reg
tmp) InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> InstrBlock
exp2 Reg
dst InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Reg -> Instr
PSLLDQ Format
fmt (Int -> Imm
ImmInt (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
amountInBytes)) Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
POR Format
fmt (Reg -> Operand
OpReg Reg
tmp) Reg
dst)
return (Any fmt code)
| ([Int]
js, [Int]
ks) <- (Int -> Bool) -> [Int] -> ([Int], [Int])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n) [Int]
is, [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
js) [Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2..]), [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) [Int]
ks [Int
0..]) -> NatM Register -> Maybe (NatM Register)
forall a. a -> Maybe a
Just (NatM Register -> Maybe (NatM Register))
-> NatM Register -> Maybe (NatM Register)
forall a b. (a -> b) -> a -> b
$ do
ssse3 <- NatM Bool
ssse3Enabled
let amountInBytes = Int
widthInBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ks
if ssse3
then vector_op_sse (`PALIGNR` (ImmInt amountInBytes)) fmt v1 v2
else do
exp1 <- getAnyReg v1
exp2 <- getAnyReg v2
tmp <- getNewRegNat fmt
let code Reg
dst = Reg -> InstrBlock
exp2 Reg
tmp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Reg -> Instr
PSRLDQ Format
fmt (Int -> Imm
ImmInt Int
amountInBytes) Reg
tmp) InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> InstrBlock
exp1 Reg
dst InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Reg -> Instr
PSLLDQ Format
fmt (Int -> Imm
ImmInt (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
amountInBytes)) Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
POR Format
fmt (Reg -> Operand
OpReg Reg
tmp) Reg
dst)
return (Any fmt code)
| Bool
sse4_1, Int
widthInBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2, [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i Int
j -> Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j) [Int]
is [Int
0..]) -> NatM Register -> Maybe (NatM Register)
forall a. a -> Maybe a
Just (NatM Register -> Maybe (NatM Register))
-> NatM Register -> Maybe (NatM Register)
forall a b. (a -> b) -> a -> b
$ do
let k :: Int
k = Int
widthInBytes Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2
m :: Int
m = Int -> Int
forall a. (Num a, Bits a) => Int -> a
bit Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
imm :: Int
imm = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
i Int
acc -> if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n then (Int
acc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
k) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
m else Int
acc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
k) Int
0 [Int]
is
(Format -> Operand -> Reg -> Instr)
-> Format -> CmmExpr -> CmmExpr -> NatM Register
vector_op_sse (Format -> Imm -> Operand -> Reg -> Instr
`PBLENDW` (Int -> Imm
ImmInt Int
imm)) Format
fmt CmmExpr
v1 CmmExpr
v2
| Bool
otherwise -> Maybe (NatM Register)
forall a. Maybe a
Nothing
| Bool
otherwise = String -> SDoc -> Maybe (NatM Register)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"vector shuffle: wrong indices" ([Int] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Int]
is)
where
(Int
n, Int
widthInBytes) = case Format
fmt of
VecFormat Int
16 ScalarFormat
FmtInt8 -> (Int
16, Int
1)
VecFormat Int
8 ScalarFormat
FmtInt16 -> (Int
8, Int
2)
VecFormat Int
4 ScalarFormat
FmtInt32 -> (Int
4, Int
4)
VecFormat Int
2 ScalarFormat
FmtInt64 -> (Int
2, Int
8)
Format
_ -> String -> SDoc -> (Int, Int)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Invalid format" (Format -> SDoc
forall a. Outputable a => a -> SDoc
ppr Format
fmt)
v1IsZero :: Bool
v1IsZero = CmmExpr -> Bool
isZeroVecLit CmmExpr
v1
v2IsZero :: Bool
v2IsZero = CmmExpr -> Bool
isZeroVecLit CmmExpr
v2
vector_shuffle_int8x16 :: Bool -> CmmExpr -> CmmExpr -> [Int] -> NatM Register
vector_shuffle_int8x16 :: Bool -> CmmExpr -> CmmExpr -> [Int] -> NatM Register
vector_shuffle_int8x16 Bool
sse4_1 CmmExpr
v1 CmmExpr
v2 [Int]
is
| Just NatM Register
commonCase <- Bool
-> Format -> CmmExpr -> CmmExpr -> [Int] -> Maybe (NatM Register)
vector_shuffle_int128_common Bool
sse4_1 Format
fmt CmmExpr
v1 CmmExpr
v2 [Int]
is = NatM Register
commonCase
| Bool
otherwise = do
ssse3 <- NatM Bool
ssse3Enabled
let fmtInt16X8 = Int -> ScalarFormat -> Format
VecFormat Int
8 ScalarFormat
FmtInt16
v1IsZero = CmmExpr -> Bool
isZeroVecLit CmmExpr
v1
v2IsZero = CmmExpr -> Bool
isZeroVecLit CmmExpr
v2
tryInt16X8Mask [] = [a] -> Maybe [a]
forall a. a -> Maybe a
Just []
tryInt16X8Mask (a
j0:a
j1:[a]
js)
| a -> Bool
forall a. Integral a => a -> Bool
even a
j0, a
j1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
j0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
1 = (a
j0 a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
2 a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> Maybe [a]
tryInt16X8Mask [a]
js
tryInt16X8Mask [a]
_ = Maybe [a]
forall a. Maybe a
Nothing
if
| [0,16,1,17,2,18,3,19,4,20,5,21,6,22,7,23] <- is -> vector_op_sse PUNPCKLBW fmt v1 v2
| [16,0,17,1,18,2,19,3,20,4,21,5,22,6,23,7] <- is -> vector_op_sse PUNPCKLBW fmt v2 v1
| [8,24,9,25,10,26,11,27,12,28,13,29,14,30,15,31] <- is -> vector_op_sse PUNPCKHBW fmt v1 v2
| [24,8,25,9,26,10,27,11,28,12,29,13,30,14,31,15] <- is -> vector_op_sse PUNPCKHBW fmt v2 v1
| ssse3, all (< 16) is || v2IsZero -> do
exp1 <- getAnyReg v1
let mask1 = [CmmLit] -> CmmLit
CmmVec ([CmmLit] -> CmmLit) -> [CmmLit] -> CmmLit
forall a b. (a -> b) -> a -> b
$ (Int -> CmmLit) -> [Int] -> [CmmLit]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
16 then Int
i else Int
255) Width
W8) [Int]
is
Amode amode1 amode_code1 <- memConstant (mkAlignment 16) mask1
let code Reg
dst = Reg -> InstrBlock
exp1 Reg
dst InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
amode_code1 InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PSHUFB Format
fmt (AddrMode -> Operand
OpAddr AddrMode
amode1) Reg
dst)
return (Any fmt code)
| ssse3, all (>= 16) is || v1IsZero -> do
exp2 <- getAnyReg v2
let mask2 = [CmmLit] -> CmmLit
CmmVec ([CmmLit] -> CmmLit) -> [CmmLit] -> CmmLit
forall a b. (a -> b) -> a -> b
$ (Int -> CmmLit) -> [Int] -> [CmmLit]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
16 then Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
16 else Int
255) Width
W8) [Int]
is
Amode amode2 amode_code2 <- memConstant (mkAlignment 16) mask2
let code Reg
dst = Reg -> InstrBlock
exp2 Reg
dst InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
amode_code2 InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PSHUFB Format
fmt (AddrMode -> Operand
OpAddr AddrMode
amode2) Reg
dst)
return (Any fmt code)
| sse4_1, Just js <- tryInt16X8Mask is, and (zipWith (\Int
i Int
j -> Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
8 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j) js [0..]) -> do
let imm = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
i Int
acc -> if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
8 then (Int
acc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
1 else Int
acc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Int
0 [Int]
js
vector_op_sse (`PBLENDW` (ImmInt imm)) fmt v1 v2
| ssse3 -> do
exp1 <- getAnyReg v1
exp2 <- getAnyReg v2
tmp1 <- getNewRegNat fmt
let mask1 = [CmmLit] -> CmmLit
CmmVec ([CmmLit] -> CmmLit) -> [CmmLit] -> CmmLit
forall a b. (a -> b) -> a -> b
$ (Int -> CmmLit) -> [Int] -> [CmmLit]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
16 then Int
i else Int
255) Width
W8) [Int]
is
mask2 = [CmmLit] -> CmmLit
CmmVec ([CmmLit] -> CmmLit) -> [CmmLit] -> CmmLit
forall a b. (a -> b) -> a -> b
$ (Int -> CmmLit) -> [Int] -> [CmmLit]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
16 then Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
16 else Int
255) Width
W8) [Int]
is
Amode amode1 amode_code1 <- memConstant (mkAlignment 16) mask1
Amode amode2 amode_code2 <- memConstant (mkAlignment 16) mask2
let code Reg
dst = Reg -> InstrBlock
exp1 Reg
tmp1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> InstrBlock
exp2 Reg
dst InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
amode_code1 InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PSHUFB Format
fmt (AddrMode -> Operand
OpAddr AddrMode
amode1) Reg
tmp1) InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
amode_code2 InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PSHUFB Format
fmt (AddrMode -> Operand
OpAddr AddrMode
amode2) Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
POR Format
fmt (Reg -> Operand
OpReg Reg
tmp1) Reg
dst)
return (Any fmt code)
| otherwise -> do
(r1, exp1) <- getSomeReg v1
(r2, exp2) <- getSomeReg v2
tmp <- getNewRegNat II64
tmpLo <- getNewRegNat II64
tmpHi <- getNewRegNat II64
tmpXmm <- getNewRegNat fmt
dst <- getNewRegNat fmt
let place8Bits Int
srcPos Int
dstPos Reg
dst =
let r :: Reg
r = if Int
srcPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
16 then Reg
r1 else Reg
r2
in case (Int
srcPos Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
16) Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
2 of
(Int
k, Int
0) -> [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Format -> Format -> Imm -> Reg -> Operand -> Instr
PEXTR Format
II32 Format
fmtInt16X8 (Int -> Imm
ImmInt Int
k) Reg
r (Reg -> Operand
OpReg Reg
tmp)
, Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
tmp) (Reg -> Operand
OpReg Reg
tmp)
, Format -> Operand -> Operand -> Instr
SHL Format
II64 (Imm -> Operand
OpImm (Int -> Imm
ImmInt (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
dstPos))) (Reg -> Operand
OpReg Reg
tmp)
, Format -> Operand -> Operand -> Instr
OR Format
II64 (Reg -> Operand
OpReg Reg
tmp) (Reg -> Operand
OpReg Reg
dst)
]
(Int
k, Int
_) -> (Format -> Format -> Imm -> Reg -> Operand -> Instr
PEXTR Format
II32 Format
fmtInt16X8 (Int -> Imm
ImmInt Int
k) Reg
r (Reg -> Operand
OpReg Reg
tmp)) Instr -> InstrBlock -> InstrBlock
forall a. a -> OrdList a -> OrdList a
`consOL`
((case Int
dstPos of
Int
0 -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
SHR Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
8)) (Reg -> Operand
OpReg Reg
tmp))
Int
1 -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
AND Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
0xff00)) (Reg -> Operand
OpReg Reg
tmp))
Int
_ -> [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Operand -> Instr
AND Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
0xff00)) (Reg -> Operand
OpReg Reg
tmp)
, Format -> Operand -> Operand -> Instr
SHL Format
II64 (Imm -> Operand
OpImm (Int -> Imm
ImmInt (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
dstPos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))) (Reg -> Operand
OpReg Reg
tmp) ]) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
OR Format
II64 (Reg -> Operand
OpReg Reg
tmp) (Reg -> Operand
OpReg Reg
dst)))
makeInt8x8OnGPR Reg
dst [Int]
js = (Format -> Operand -> Operand -> Instr
XOR Format
II32 (Reg -> Operand
OpReg Reg
dst) (Reg -> Operand
OpReg Reg
dst)) Instr -> InstrBlock -> InstrBlock
forall a. a -> OrdList a -> OrdList a
`consOL`
[InstrBlock] -> InstrBlock
forall a. [OrdList a] -> OrdList a
concatOL [ Int -> Int -> Reg -> InstrBlock
place8Bits Int
srcPos Int
dstPos Reg
dst | (Int
srcPos, Int
dstPos) <- [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
js [Int
0..] ]
code = InstrBlock
exp1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
exp2 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> [Int] -> InstrBlock
makeInt8x8OnGPR Reg
tmpLo (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
8 [Int]
is) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Operand -> Instr
MOVD Format
II64 Format
fmt (Reg -> Operand
OpReg Reg
tmpLo) (Reg -> Operand
OpReg Reg
dst)) InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> [Int] -> InstrBlock
makeInt8x8OnGPR Reg
tmpHi (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
8 [Int]
is) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Operand -> Instr
MOVD Format
II64 Format
fmt (Reg -> Operand
OpReg Reg
tmpHi) (Reg -> Operand
OpReg Reg
tmpXmm)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PUNPCKLQDQ Format
fmt (Reg -> Operand
OpReg Reg
tmpXmm) Reg
dst)
return (Fixed fmt dst code)
where fmt :: Format
fmt = Int -> ScalarFormat -> Format
VecFormat Int
16 ScalarFormat
FmtInt8
vector_shuffle_int16x8 :: Bool -> CmmExpr -> CmmExpr -> [Int] -> NatM Register
vector_shuffle_int16x8 :: Bool -> CmmExpr -> CmmExpr -> [Int] -> NatM Register
vector_shuffle_int16x8 Bool
sse4_1 CmmExpr
v1 CmmExpr
v2 is :: [Int]
is@(Int
i0:Int
i1:Int
i2:Int
i3:i4567 :: [Int]
i4567@[Int
i4,Int
i5,Int
i6,Int
i7])
| Just NatM Register
commonCase <- Bool
-> Format -> CmmExpr -> CmmExpr -> [Int] -> Maybe (NatM Register)
vector_shuffle_int128_common Bool
sse4_1 Format
fmt CmmExpr
v1 CmmExpr
v2 [Int]
is = NatM Register
commonCase
| Bool
otherwise = do
(r1, exp1) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
v1
(r2, exp2) <- getSomeReg v2
let
shufL Reg
src Reg
dst Int
0 Int
1 Int
2 Int
3 | Reg
src Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst = InstrBlock
forall a. OrdList a
nilOL
| Bool
otherwise = Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOVDQU Format
fmt (Reg -> Operand
OpReg Reg
src) (Reg -> Operand
OpReg Reg
dst))
shufL Reg
src Reg
dst Int
k0 Int
k1 Int
k2 Int
k3 = let imm :: Int
imm = Int
k0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
k1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
k2 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
4) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
k3 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
6)
in Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Instr
PSHUFLW Format
fmt (Int -> Imm
ImmInt Int
imm) (Reg -> Operand
OpReg Reg
src) Reg
dst)
shufH Reg
src Reg
dst Int
4 Int
5 Int
6 Int
7 | Reg
src Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst = InstrBlock
forall a. OrdList a
nilOL
| Bool
otherwise = Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOVDQU Format
fmt (Reg -> Operand
OpReg Reg
src) (Reg -> Operand
OpReg Reg
dst))
shufH Reg
src Reg
dst Int
k0 Int
k1 Int
k2 Int
k3 = let imm :: Int
imm = (Int
k0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ((Int
k1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ((Int
k2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
4) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ((Int
k3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
6)
in Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Instr
PSHUFHW Format
fmt (Int -> Imm
ImmInt Int
imm) (Reg -> Operand
OpReg Reg
src) Reg
dst)
shufLHImm Reg
src Reg
dst Int
immLo Int
immHi = case (Int
immLo, Int
immHi) of
(Int
0b11_10_01_00, Int
0b11_10_01_00)
| Reg
src Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst -> InstrBlock
forall a. OrdList a
nilOL
| Bool
otherwise -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOVDQU Format
fmt (Reg -> Operand
OpReg Reg
src) (Reg -> Operand
OpReg Reg
dst))
(Int
0b11_10_01_00, Int
_) -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Instr
PSHUFHW Format
fmt (Int -> Imm
ImmInt Int
immHi) (Reg -> Operand
OpReg Reg
src) Reg
dst)
(Int
_, Int
0b11_10_01_00) -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Instr
PSHUFLW Format
fmt (Int -> Imm
ImmInt Int
immLo) (Reg -> Operand
OpReg Reg
src) Reg
dst)
(Int
_, Int
_) -> [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [Format -> Imm -> Operand -> Reg -> Instr
PSHUFLW Format
fmt (Int -> Imm
ImmInt Int
immLo) (Reg -> Operand
OpReg Reg
src) Reg
dst,
Format -> Imm -> Operand -> Reg -> Instr
PSHUFHW Format
fmt (Int -> Imm
ImmInt Int
immHi) (Reg -> Operand
OpReg Reg
dst) Reg
dst]
shufLH Reg
src Reg
dst [Int]
ks
= let ([Int]
k_lo, [Int]
k_hi) = Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
4 [Int]
ks
immLo :: Int
immLo = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
k Int
acc -> (Int
acc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k) Int
0 [Int]
k_lo
immHi :: Int
immHi = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
k Int
acc -> (Int
acc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)) Int
0 [Int]
k_hi
in Reg -> Reg -> Int -> Int -> InstrBlock
shufLHImm Reg
src Reg
dst Int
immLo Int
immHi
shufRev Reg
src Reg
dst p
_j0 Int
j1 Int
j2 Int
j3 p
_j4 Int
j5 Int
j6 Int
j7
= let immLo :: Int
immLo = (Int
1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
j1)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
2 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
j2)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
3 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
j3))
immHi :: Int
immHi = (Int
1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
j5 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4))) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
2 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
j6 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4))) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
3 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
j7 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)))
in Reg -> Reg -> Int -> Int -> InstrBlock
shufLHImm Reg
src Reg
dst Int
immLo Int
immHi
i0123 = [Int
i0, Int
i1, Int
i2, Int
i3]
if
| all (\Int
i -> Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4) i0123
, all (\Int
i -> Int
4 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8) i4567
-> do
let code Reg
dst = InstrBlock
exp1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> Reg -> [Int] -> InstrBlock
shufLH Reg
r1 Reg
dst [Int]
is
return (Any fmt code)
| all (\Int
i -> Int
8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
12) i0123
, all (\Int
i -> Int
12 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i) i4567
-> do
let code Reg
dst = InstrBlock
exp2 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> Reg -> [Int] -> InstrBlock
shufLH Reg
r2 Reg
dst ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
8) [Int]
is)
return (Any fmt code)
| sse4_1
, all (\Int
i -> Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4) i0123
, all (\Int
i -> Int
4 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
8) i4567
-> do
tmp <- getNewRegNat fmt
let imm = (Int -> (Int, Int) -> Int) -> Int -> [(Int, Int)] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
acc (Int
i,Int
p) -> if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
8 then Int -> Int -> Int
forall a. (Num a, Bits a) => a -> Int -> a
setBit Int
acc Int
p else Int
acc) Int
0 ([Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
is [Int
0..])
js = (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i Int
p -> if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
8 then Int
p else Int
i) [Int]
is [Int
0..]
ks = (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i Int
p -> if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
8 then Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8 else Int
p) [Int]
is [Int
0..]
code Reg
dst = InstrBlock
exp1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
exp2 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> Reg -> [Int] -> InstrBlock
shufLH Reg
r2 Reg
tmp [Int]
ks InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> Reg -> [Int] -> InstrBlock
shufLH Reg
r1 Reg
dst [Int]
js InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
PBLENDW Format
fmt (Int -> Imm
ImmInt Int
imm) (Reg -> Operand
OpReg Reg
tmp) Reg
dst)
return (Any fmt code)
| all (\Int
i -> Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 Bool -> Bool -> Bool
|| (Int
8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
12)) is
, ([(j0, k0), (j1, k1)], [(j2, k2), (j3, k3)]) <- partition (\(Int
_, Int
i) -> Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4) [(0, i0), (1, i1), (2, i2), (3, i3)]
, ([(j4, k4), (j5, k5)], [(j6, k6), (j7, k7)]) <- partition (\(Int
_, Int
i) -> Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4) [(4, i4), (5, i5), (6, i6), (7, i7)]
-> do
tmp1 <- getNewRegNat fmt
tmp2 <- getNewRegNat fmt
let code Reg
dst = InstrBlock
exp1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
exp2 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> Reg -> Int -> Int -> Int -> Int -> InstrBlock
shufL Reg
r1 Reg
tmp1 Int
k0 Int
k1 Int
k4 Int
k5 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> Reg -> Int -> Int -> Int -> Int -> InstrBlock
shufL Reg
r2 Reg
tmp2 (Int
k2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8) (Int
k3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8) (Int
k6 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8) (Int
k7 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PUNPCKLWD Format
fmt (Reg -> Operand
OpReg Reg
tmp2) Reg
tmp1) InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg
-> Reg
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> InstrBlock
forall {p} {p}.
Reg
-> Reg
-> p
-> Int
-> Int
-> Int
-> p
-> Int
-> Int
-> Int
-> InstrBlock
shufRev Reg
tmp1 Reg
dst Int
j0 Int
j2 Int
j1 Int
j3 Int
j4 Int
j6 Int
j5 Int
j7
return (Any fmt code)
| all (\Int
i -> (Int
4 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8) Bool -> Bool -> Bool
|| Int
12 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i) is
, ([(j0, k0), (j1, k1)], [(j2, k2), (j3, k3)]) <- partition (\(Int
_, Int
i) -> Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8) [(0, i0), (1, i1), (2, i2), (3, i3)]
, ([(j4, k4), (j5, k5)], [(j6, k6), (j7, k7)]) <- partition (\(Int
_, Int
i) -> Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8) [(4, i4), (5, i5), (6, i6), (7, i7)]
-> do
tmp1 <- getNewRegNat fmt
tmp2 <- getNewRegNat fmt
let code Reg
dst = InstrBlock
exp1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
exp2 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> Reg -> Int -> Int -> Int -> Int -> InstrBlock
shufH Reg
r1 Reg
tmp1 Int
k0 Int
k1 Int
k4 Int
k5 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> Reg -> Int -> Int -> Int -> Int -> InstrBlock
shufH Reg
r2 Reg
tmp2 (Int
k2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8) (Int
k3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8) (Int
k6 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8) (Int
k7 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PUNPCKHWD Format
fmt (Reg -> Operand
OpReg Reg
tmp2) Reg
tmp1) InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg
-> Reg
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> InstrBlock
forall {p} {p}.
Reg
-> Reg
-> p
-> Int
-> Int
-> Int
-> p
-> Int
-> Int
-> Int
-> InstrBlock
shufRev Reg
tmp1 Reg
dst Int
j0 Int
j2 Int
j1 Int
j3 Int
j4 Int
j6 Int
j5 Int
j7
return (Any fmt code)
| otherwise -> do
tmp0 <- getNewRegNat II32
tmps <- replicateM 7 (getNewRegNat II32)
let code Reg
dst = InstrBlock
exp1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
exp2 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Format -> Format -> Imm -> Reg -> Operand -> Instr
PEXTR Format
II32 Format
fmt (Int -> Imm
ImmInt Int
i') Reg
r (Reg -> Operand
OpReg Reg
tmp)
| (Int
i, Reg
tmp) <- [Int] -> [Reg] -> [(Int, Reg)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
is (Reg
tmp0Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
:[Reg]
tmps)
, let (Int
i', Reg
r) = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8 then (Int
i, Reg
r1) else (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8, Reg
r2)
] InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Operand -> Instr
MOVD Format
II32 Format
fmt (Reg -> Operand
OpReg Reg
tmp0) (Reg -> Operand
OpReg Reg
dst)) InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Format -> Format -> Imm -> Operand -> Reg -> Instr
PINSR Format
II32 Format
fmt (Int -> Imm
ImmInt Int
i) (Reg -> Operand
OpReg Reg
tmp) Reg
dst
| (Int
i, Reg
tmp) <- [Int] -> [Reg] -> [(Int, Reg)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Reg]
tmps
]
return (Any fmt code)
where fmt :: Format
fmt = Int -> ScalarFormat -> Format
VecFormat Int
8 ScalarFormat
FmtInt16
vector_shuffle_int16x8 Bool
_ CmmExpr
_ CmmExpr
_ [Int]
is = String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"vector shuffle: wrong number of indices (expected 8)" ([Int] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Int]
is)
vector_shuffle_int32x4 :: Bool -> CmmExpr -> CmmExpr -> [Int] -> NatM Register
vector_shuffle_int32x4 :: Bool -> CmmExpr -> CmmExpr -> [Int] -> NatM Register
vector_shuffle_int32x4 Bool
sse4_1 CmmExpr
v1 CmmExpr
v2 [Int]
is
| Just NatM Register
commonCase <- Bool
-> Format -> CmmExpr -> CmmExpr -> [Int] -> Maybe (NatM Register)
vector_shuffle_int128_common Bool
sse4_1 Format
fmt CmmExpr
v1 CmmExpr
v2 [Int]
is = NatM Register
commonCase
| Bool
otherwise = do
let
pshufd :: Int -> Reg -> Reg -> InstrBlock
pshufd Int
0b11_10_01_00 Reg
src Reg
dst
| Reg
src Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst = InstrBlock
forall a. OrdList a
nilOL
| Bool
otherwise = Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOVDQU Format
fmt (Reg -> Operand
OpReg Reg
src) (Reg -> Operand
OpReg Reg
dst))
pshufd Int
imm Reg
src Reg
dst = Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Imm -> Operand -> Reg -> Instr
PSHUFD Format
fmt (Int -> Imm
ImmInt Int
imm) (Reg -> Operand
OpReg Reg
src) Reg
dst)
composeMask :: Int -> Int -> Int
composeMask :: Int -> Int -> Int
composeMask Int
imm1 Int
imm2 = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
i Int
acc -> let j :: Int
j = (Int
imm2 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
3
in (Int
imm1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
j) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
3) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
acc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
2)
) Int
0 [Int
0..Int
3]
makeMask :: [(Int, Int)]
-> Int
makeMask :: [(Int, Int)] -> Int
makeMask [(Int, Int)]
m = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.|.) Int
0 [ Int
src Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
dst) | Int
dst <- [Int
0..Int
3], let src :: Int
src = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
dst ((Int -> Bool) -> Maybe Int -> Maybe Int
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (Maybe Int -> Maybe Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
dst [(Int, Int)]
m) ]
twoAndTwo :: (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> Int
-> CmmExpr
-> CmmExpr
-> NatM Register
twoAndTwo p0 :: (Int, Int)
p0@(Int
1,Int
_) p1 :: (Int, Int)
p1@(Int
3,Int
_) q0 :: (Int, Int)
q0@(Int
0,Int
_) q1 :: (Int, Int)
q1@(Int
2,Int
_) Int
imm4 CmmExpr
v1 CmmExpr
v2 = (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> Int
-> CmmExpr
-> CmmExpr
-> NatM Register
twoAndTwo' (Int, Int)
q0 (Int, Int)
q1 (Int, Int)
p0 (Int, Int)
p1 Int
imm4 CmmExpr
v2 CmmExpr
v1
twoAndTwo (Int, Int)
p0 (Int, Int)
p1 (Int, Int)
q0 (Int, Int)
q1 Int
imm4 CmmExpr
v1 CmmExpr
v2 = (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> Int
-> CmmExpr
-> CmmExpr
-> NatM Register
twoAndTwo' (Int, Int)
p0 (Int, Int)
p1 (Int, Int)
q0 (Int, Int)
q1 Int
imm4 CmmExpr
v1 CmmExpr
v2
twoAndTwo' :: (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> Int
-> CmmExpr
-> CmmExpr
-> NatM Register
twoAndTwo' (Int, Int)
p0 (Int, Int)
p1 (Int, Int)
q0 (Int, Int)
q1 Int
imm4 CmmExpr
v1 CmmExpr
v2 = do
(r1, exp1) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
v1
(r2, exp2) <- getSomeReg v2
tmp <- getNewRegNat fmt
let (instr, imm1, imm2) =
if all (\(Int
_,Int
i) -> Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1) [p0,p1,q0,q1] then
(PUNPCKHDQ, makeMask [(2,snd p0),(3,snd p1)], makeMask [(2,snd q0),(3,snd q1)])
else
(PUNPCKLDQ, makeMask [(0,snd p0),(1,snd p1)], makeMask [(0,snd q0),(1,snd q1)])
imm3 = [(Int, Int)] -> Int
makeMask [((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p0,Int
0),((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
q0,Int
1),((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p1,Int
2),((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
q1,Int
3)]
code Reg
dst = InstrBlock
exp1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
exp2 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Int -> Reg -> Reg -> InstrBlock
pshufd Int
imm2 Reg
r2 Reg
tmp InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Int -> Reg -> Reg -> InstrBlock
pshufd Int
imm1 Reg
r1 Reg
dst InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Reg -> Instr
instr Format
fmt (Reg -> Operand
OpReg Reg
tmp) Reg
dst InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Int -> Reg -> Reg -> InstrBlock
pshufd (Int -> Int -> Int
composeMask Int
imm3 Int
imm4) Reg
dst Reg
dst
return $ Any fmt code
threeAndOne :: (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> CmmExpr
-> CmmExpr
-> NatM Register
threeAndOne (Int, Int)
p0 (Int, Int)
p1 (Int, Int)
p2 (Int, Int)
q0
| (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
p0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
p1 = (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> Int
-> CmmExpr
-> CmmExpr
-> NatM Register
twoAndTwo (Int, Int)
p0 (Int, Int)
p2 (Int, Int)
q0 ((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p1,-Int
1) ([(Int, Int)] -> Int
makeMask [((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p0,(Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p0),((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p1,(Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p0),((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p2,(Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p2),((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
q0,(Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
q0)])
| (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
p0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
p2 = (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> Int
-> CmmExpr
-> CmmExpr
-> NatM Register
twoAndTwo (Int, Int)
p0 (Int, Int)
p1 (Int, Int)
q0 ((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p2,-Int
1) ([(Int, Int)] -> Int
makeMask [((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p0,(Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p0),((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p1,(Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p1),((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p2,(Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p0),((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
q0,(Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
q0)])
| (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
p2 = (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> Int
-> CmmExpr
-> CmmExpr
-> NatM Register
twoAndTwo (Int, Int)
p0 (Int, Int)
p1 (Int, Int)
q0 ((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p2,-Int
1) ([(Int, Int)] -> Int
makeMask [((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p0,(Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p0),((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p1,(Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p1),((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p2,(Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p1),((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
q0,(Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
q0)])
| Bool
otherwise = \CmmExpr
v1 CmmExpr
v2 -> do
(r1, exp1) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
v1
(r2, exp2) <- getSomeReg v2
tmp1 <- getNewRegNat fmt
if sse4_1
then do
let imm1 = [(Int, Int)] -> Int
makeMask [(Int, Int)
p0,(Int, Int)
p1,(Int, Int)
p2]
imm2 = [(Int, Int)] -> Int
makeMask [(Int, Int)
q0]
imm3 = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.|.) Int
0 [ (if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
q0 then Int
0 else Int
3) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) | Int
i <- [Int
0..Int
3] ]
let code Reg
dst = InstrBlock
exp1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
exp2 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Int -> Reg -> Reg -> InstrBlock
pshufd Int
imm1 Reg
r1 Reg
tmp1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Int -> Reg -> Reg -> InstrBlock
pshufd Int
imm2 Reg
r2 Reg
dst InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Imm -> Operand -> Reg -> Instr
PBLENDW Format
fmt (Int -> Imm
ImmInt Int
imm3) (Reg -> Operand
OpReg Reg
tmp1) Reg
dst
return $ Any fmt code
else do
tmp2 <- getNewRegNat fmt
tmp3 <- getNewRegNat fmt
let imm1 = (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
q0 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
0b11_10_01_00
imm2 = (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
p1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
0b11_10_01_00
imm3 = (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
p0 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. ((Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
p2 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
2) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
0b11_10_00_00
imm6 = [(Int, Int)] -> Int
makeMask [((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
q0,Int
0),((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p0,Int
1),((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p1,Int
2),((Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
p2,Int
3)]
code Reg
dst = InstrBlock
exp1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
exp2 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Int -> Reg -> Reg -> InstrBlock
pshufd Int
imm1 Reg
r2 Reg
tmp1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Int -> Reg -> Reg -> InstrBlock
pshufd Int
imm2 Reg
r1 Reg
tmp2 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Int -> Reg -> Reg -> InstrBlock
pshufd Int
imm3 Reg
r1 Reg
tmp3 InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Reg -> Instr
PUNPCKLDQ Format
fmt (Reg -> Operand
OpReg Reg
tmp2) Reg
tmp1 InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Reg -> Instr
PUNPCKLDQ Format
fmt (Reg -> Operand
OpReg Reg
tmp3) Reg
tmp1 InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Int -> Reg -> Reg -> InstrBlock
pshufd Int
imm6 Reg
tmp1 Reg
dst
return $ Any fmt code
let ([(Int, Int)]
from_first, [(Int, Int)]
from_second) = ((Int, Int) -> Bool)
-> [(Int, Int)] -> ([(Int, Int)], [(Int, Int)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(Int
_dstPos,Int
srcPos) -> Int
srcPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4) ([Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Int]
is)
case ([(Int, Int)]
from_first, ((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
dstPos,Int
srcPos) -> (Int
dstPos, Int
srcPos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)) [(Int, Int)]
from_second) of
([(Int, Int)
p0,(Int, Int)
p1,(Int, Int)
p2,(Int, Int)
p3], []) -> do
(r, exp) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
v1
let imm = [(Int, Int)] -> Int
makeMask [(Int, Int)
p0,(Int, Int)
p1,(Int, Int)
p2,(Int, Int)
p3]
code Reg
dst = InstrBlock
exp InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Int -> Reg -> Reg -> InstrBlock
pshufd Int
imm Reg
r Reg
dst
return $ Any fmt code
([], [(Int, Int)
q0,(Int, Int)
q1,(Int, Int)
q2,(Int, Int)
q3]) -> do
(r, exp) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
v2
let imm = [(Int, Int)] -> Int
makeMask [(Int, Int)
q0,(Int, Int)
q1,(Int, Int)
q2,(Int, Int)
q3]
code Reg
dst = InstrBlock
exp InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Int -> Reg -> Reg -> InstrBlock
pshufd Int
imm Reg
r Reg
dst
return $ Any fmt code
([(Int, Int)
p0,(Int, Int)
p1], [(Int, Int)
q0,(Int, Int)
q1]) -> (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> Int
-> CmmExpr
-> CmmExpr
-> NatM Register
twoAndTwo (Int, Int)
p0 (Int, Int)
p1 (Int, Int)
q0 (Int, Int)
q1 Int
0b11_10_01_00 CmmExpr
v1 CmmExpr
v2
([(Int, Int)
p0], [(Int, Int)
q0,(Int, Int)
q1,(Int, Int)
q2]) -> (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> CmmExpr
-> CmmExpr
-> NatM Register
threeAndOne (Int, Int)
q0 (Int, Int)
q1 (Int, Int)
q2 (Int, Int)
p0 CmmExpr
v2 CmmExpr
v1
([(Int, Int)
p0,(Int, Int)
p1,(Int, Int)
p2], [(Int, Int)
q0]) -> (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> CmmExpr
-> CmmExpr
-> NatM Register
threeAndOne (Int, Int)
p0 (Int, Int)
p1 (Int, Int)
p2 (Int, Int)
q0 CmmExpr
v1 CmmExpr
v2
([(Int, Int)], [(Int, Int)])
_ -> String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"vector shuffle: cannot occur" ([Int] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Int]
is)
where fmt :: Format
fmt = Int -> ScalarFormat -> Format
VecFormat Int
4 ScalarFormat
FmtInt32
vector_shuffle_int64x2 :: Bool -> CmmExpr -> CmmExpr -> [Int] -> NatM Register
vector_shuffle_int64x2 :: Bool -> CmmExpr -> CmmExpr -> [Int] -> NatM Register
vector_shuffle_int64x2 Bool
sse4_1 CmmExpr
v1 CmmExpr
v2 [Int]
is
| Just NatM Register
commonCase <- Bool
-> Format -> CmmExpr -> CmmExpr -> [Int] -> Maybe (NatM Register)
vector_shuffle_int128_common Bool
sse4_1 Format
fmt CmmExpr
v1 CmmExpr
v2 [Int]
is = NatM Register
commonCase
| Bool
otherwise = case [Int]
is of
[Int
i, Int
i'] | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i' -> do
exp <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg (CmmExpr -> NatM (Reg -> InstrBlock))
-> CmmExpr -> NatM (Reg -> InstrBlock)
forall a b. (a -> b) -> a -> b
$ if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 then CmmExpr
v1 else CmmExpr
v2
let instr = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
then Format -> Operand -> Reg -> Instr
PUNPCKLQDQ
else Format -> Operand -> Reg -> Instr
PUNPCKHQDQ
code Reg
dst = Reg -> InstrBlock
exp Reg
dst InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
instr Format
fmt (Reg -> Operand
OpReg Reg
dst) Reg
dst)
return $ Any fmt code
[Int
0, Int
2] -> (Format -> Operand -> Reg -> Instr)
-> Format -> CmmExpr -> CmmExpr -> NatM Register
vector_op_sse Format -> Operand -> Reg -> Instr
PUNPCKLQDQ Format
fmt CmmExpr
v1 CmmExpr
v2
[Int
2, Int
0] -> (Format -> Operand -> Reg -> Instr)
-> Format -> CmmExpr -> CmmExpr -> NatM Register
vector_op_sse Format -> Operand -> Reg -> Instr
PUNPCKLQDQ Format
fmt CmmExpr
v2 CmmExpr
v1
[Int
1, Int
3] -> (Format -> Operand -> Reg -> Instr)
-> Format -> CmmExpr -> CmmExpr -> NatM Register
vector_op_sse Format -> Operand -> Reg -> Instr
PUNPCKHQDQ Format
fmt CmmExpr
v1 CmmExpr
v2
[Int
3, Int
1] -> (Format -> Operand -> Reg -> Instr)
-> Format -> CmmExpr -> CmmExpr -> NatM Register
vector_op_sse Format -> Operand -> Reg -> Instr
PUNPCKHQDQ Format
fmt CmmExpr
v2 CmmExpr
v1
[Int
1, Int
0] -> do
(r1, exp1) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
v1
let code Reg
dst = InstrBlock
exp1 InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
PSHUFD Format
fmt (Int -> Imm
ImmInt Int
0b01_00_11_10) (Reg -> Operand
OpReg Reg
r1) Reg
dst)
return $ Any fmt code
[Int
3, Int
2] -> do
(r2, exp2) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
v2
let code Reg
dst = InstrBlock
exp2 InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
PSHUFD Format
fmt (Int -> Imm
ImmInt Int
0b01_00_11_10) (Reg -> Operand
OpReg Reg
r2) Reg
dst)
return $ Any fmt code
[Int
0, Int
3] -> (Format -> Operand -> Reg -> Instr)
-> Format -> CmmExpr -> CmmExpr -> NatM Register
vector_op_sse (\Format
_ -> Format -> Imm -> Operand -> Reg -> Instr
SHUF Format
doubleFormat (Int -> Imm
ImmInt Int
2)) Format
fmt CmmExpr
v1 CmmExpr
v2
[Int
2, Int
1] -> (Format -> Operand -> Reg -> Instr)
-> Format -> CmmExpr -> CmmExpr -> NatM Register
vector_op_sse (\Format
_ -> Format -> Imm -> Operand -> Reg -> Instr
SHUF Format
doubleFormat (Int -> Imm
ImmInt Int
2)) Format
fmt CmmExpr
v2 CmmExpr
v1
[Int]
_ -> String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"vector shuffle: wrong number of indices (expected 2)" ([Int] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Int]
is)
where fmt :: Format
fmt = Int -> ScalarFormat -> Format
VecFormat Int
2 ScalarFormat
FmtInt64
doubleFormat :: Format
doubleFormat = Int -> ScalarFormat -> Format
VecFormat Int
2 ScalarFormat
FmtDouble
getRegister' Platform
platform Bool
_is32Bit (CmmMachOp MachOp
mop [CmmExpr
x, CmmExpr
y, CmmExpr
z]) = do
avx <- NatM Bool
avxEnabled
sse4_1 <- sse4_1Enabled
case mop of
MO_FMA FMASign
var Int
l Width
w
| Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* Width -> Int
widthInBits Width
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
256
-> String -> NatM Register
forall a. HasCallStack => String -> a
sorry String
"Please use -fllvm for wide vector FMA support"
| Bool
otherwise
-> Int
-> Width
-> FMASign
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM Register
genFMA3Code Int
l Width
w FMASign
var CmmExpr
x CmmExpr
y CmmExpr
z
MO_VF_Insert Int
l Width
W32 | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 -> Bool -> CmmExpr -> CmmExpr -> CmmExpr -> NatM Register
vector_floatx4_insert_sse Bool
sse4_1 CmmExpr
x CmmExpr
y CmmExpr
z
| Bool
otherwise ->
String -> NatM Register
forall a. HasCallStack => String -> a
sorry (String -> NatM Register) -> String -> NatM Register
forall a b. (a -> b) -> a -> b
$ String
"FloatX" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"# insert operations require -fllvm"
MO_VF_Insert Int
l Width
W64 -> Bool -> Int -> CmmExpr -> CmmExpr -> CmmExpr -> NatM Register
vector_double_insert Bool
avx Int
l CmmExpr
x CmmExpr
y CmmExpr
z
MO_V_Insert Int
16 Width
W8 | Bool
sse4_1 -> HasCallStack =>
Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr -> NatM Register
Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr -> NatM Register
vector_int_insert_pinsr Int
16 Width
W8 CmmExpr
x CmmExpr
y CmmExpr
z
| Bool
otherwise -> CmmExpr -> CmmExpr -> CmmExpr -> NatM Register
vector_int8x16_insert_sse2 CmmExpr
x CmmExpr
y CmmExpr
z
MO_V_Insert Int
8 Width
W16 -> HasCallStack =>
Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr -> NatM Register
Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr -> NatM Register
vector_int_insert_pinsr Int
8 Width
W16 CmmExpr
x CmmExpr
y CmmExpr
z
MO_V_Insert Int
4 Width
W32 | Bool
sse4_1 -> HasCallStack =>
Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr -> NatM Register
Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr -> NatM Register
vector_int_insert_pinsr Int
4 Width
W32 CmmExpr
x CmmExpr
y CmmExpr
z
| Bool
otherwise -> CmmExpr -> CmmExpr -> CmmExpr -> NatM Register
vector_int32x4_insert_sse2 CmmExpr
x CmmExpr
y CmmExpr
z
MO_V_Insert Int
2 Width
W64 | Bool
sse4_1 -> HasCallStack =>
Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr -> NatM Register
Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr -> NatM Register
vector_int_insert_pinsr Int
2 Width
W64 CmmExpr
x CmmExpr
y CmmExpr
z
| Bool
otherwise -> CmmExpr -> CmmExpr -> CmmExpr -> NatM Register
vector_int64x2_insert_sse2 CmmExpr
x CmmExpr
y CmmExpr
z
MO_V_Insert Int
_ Width
_ -> String -> NatM Register
forall a. HasCallStack => String -> a
sorry String
"Unsupported integer vector insert operation; please use -fllvm"
MachOp
_other -> String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegister(x86) - ternary CmmMachOp (1)"
(MachOp -> SDoc
pprMachOp MachOp
mop)
where
vector_floatx4_insert_sse :: Bool
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM Register
vector_floatx4_insert_sse :: Bool -> CmmExpr -> CmmExpr -> CmmExpr -> NatM Register
vector_floatx4_insert_sse Bool
sse4_1 CmmExpr
vecExpr CmmExpr
valExpr (CmmLit (CmmInt Integer
offset Width
_))
| Bool
sse4_1 = do
(r, exp) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
valExpr
fn <- getAnyReg vecExpr
let fmt = Int -> ScalarFormat -> Format
VecFormat Int
4 ScalarFormat
FmtFloat
imm = CmmLit -> Imm
litToImm (Integer -> Width -> CmmLit
CmmInt (Integer
offset Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
4) Width
W32)
code Reg
dst = InstrBlock
exp InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
(Reg -> InstrBlock
fn Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
INSERTPS Format
fmt Imm
imm (Reg -> Operand
OpReg Reg
r) Reg
dst)
in return $ Any fmt code
| Bool
otherwise = do
(r, exp) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
valExpr
fn <- getAnyReg vecExpr
let fmt = Int -> ScalarFormat -> Format
VecFormat Int
4 ScalarFormat
FmtFloat
tmp <- getNewRegNat fmt
let code Reg
dst
= case Integer
offset of
Integer
0 -> InstrBlock
exp InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
(Reg -> InstrBlock
fn Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOV Format
fmt (Reg -> Operand
OpReg Reg
r) (Reg -> Operand
OpReg Reg
dst))
Integer
1 -> InstrBlock
exp InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
(Reg -> InstrBlock
fn Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVU Format
fmt (Reg -> Operand
OpReg Reg
dst) (Reg -> Operand
OpReg Reg
tmp)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
UNPCKL Format
fmt (Reg -> Operand
OpReg Reg
r) Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
SHUF Format
fmt (Int -> Imm
ImmInt Int
0xe4) (Reg -> Operand
OpReg Reg
tmp) Reg
dst)
Integer
2 -> InstrBlock
exp InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
(Reg -> InstrBlock
fn Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVU Format
fmt (Reg -> Operand
OpReg Reg
dst) (Reg -> Operand
OpReg Reg
tmp)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOV Format
fmt (Reg -> Operand
OpReg Reg
r) (Reg -> Operand
OpReg Reg
tmp)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
SHUF Format
fmt (Int -> Imm
ImmInt Int
0xc4) (Reg -> Operand
OpReg Reg
tmp) Reg
dst)
Integer
3 -> InstrBlock
exp InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
(Reg -> InstrBlock
fn Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVU Format
fmt (Reg -> Operand
OpReg Reg
dst) (Reg -> Operand
OpReg Reg
tmp)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOV Format
fmt (Reg -> Operand
OpReg Reg
r) (Reg -> Operand
OpReg Reg
tmp)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
SHUF Format
fmt (Int -> Imm
ImmInt Int
0x24) (Reg -> Operand
OpReg Reg
tmp) Reg
dst)
Integer
_ -> String -> InstrBlock
forall a. HasCallStack => String -> a
panic String
"MO_VF_Insert FloatX4: unsupported offset"
in return $ Any fmt code
vector_floatx4_insert_sse Bool
_ CmmExpr
_ CmmExpr
_ CmmExpr
offset
= String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Unsupported vector insert operation" (SDoc -> NatM Register) -> SDoc -> NatM Register
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
[ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"FloatX4#"
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"offset:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
offset ]
vector_double_insert :: Bool
-> Length
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM Register
vector_double_insert :: Bool -> Int -> CmmExpr -> CmmExpr -> CmmExpr -> NatM Register
vector_double_insert Bool
avx len :: Int
len@Int
2 CmmExpr
vecExpr CmmExpr
valExpr (CmmLit CmmLit
offset)
= do
(valReg, valExp) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
valExpr
(vecReg, vecExp) <- getSomeReg vecExpr
let movu = if Bool
avx then Format -> Operand -> Operand -> Instr
VMOVU else Format -> Operand -> Operand -> Instr
MOVU
fmt = Int -> ScalarFormat -> Format
VecFormat Int
len ScalarFormat
FmtDouble
code Reg
dst
= case CmmLit
offset of
CmmInt Integer
0 Width
_ -> InstrBlock
valExp InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
vecExp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
movu (Int -> ScalarFormat -> Format
VecFormat Int
2 ScalarFormat
FmtDouble) (Reg -> Operand
OpReg Reg
vecReg) (Reg -> Operand
OpReg Reg
dst)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOV (Int -> ScalarFormat -> Format
VecFormat Int
2 ScalarFormat
FmtDouble) (Reg -> Operand
OpReg Reg
valReg) (Reg -> Operand
OpReg Reg
dst))
CmmInt Integer
1 Width
_ -> InstrBlock
valExp InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
vecExp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
movu (Int -> ScalarFormat -> Format
VecFormat Int
2 ScalarFormat
FmtDouble) (Reg -> Operand
OpReg Reg
vecReg) (Reg -> Operand
OpReg Reg
dst)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
SHUF Format
fmt (Int -> Imm
ImmInt Int
0b00) (Reg -> Operand
OpReg Reg
valReg) Reg
dst)
CmmLit
_ -> String -> SDoc -> InstrBlock
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"MO_VF_Insert DoubleX2: unsupported offset" (CmmLit -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmLit
offset)
in return $ Any fmt code
vector_double_insert Bool
_ Int
_ CmmExpr
_ CmmExpr
_ CmmExpr
_ =
String -> NatM Register
forall a. HasCallStack => String -> a
sorry String
"Unsupported floating-point vector insert operation; please use -fllvm"
vector_int_insert_pinsr :: HasCallStack => Length
-> Width
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM Register
vector_int_insert_pinsr :: HasCallStack =>
Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr -> NatM Register
vector_int_insert_pinsr Int
len Width
w CmmExpr
vecExpr CmmExpr
valExpr (CmmLit (CmmInt Integer
offset Width
_))
| Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
offset, Integer
offset Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
len
= do
(valReg, valExp) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
valExpr
vecCode <- getAnyReg vecExpr
let (scalarFormat, vectorFormat) = case w of
Width
W8 -> (Format
II32, Int -> ScalarFormat -> Format
VecFormat Int
len ScalarFormat
FmtInt8)
Width
W16 -> (Format
II32, Int -> ScalarFormat -> Format
VecFormat Int
len ScalarFormat
FmtInt16)
Width
W32 -> (Format
II32, Int -> ScalarFormat -> Format
VecFormat Int
len ScalarFormat
FmtInt32)
Width
W64 -> (Format
II64, Int -> ScalarFormat -> Format
VecFormat Int
len ScalarFormat
FmtInt64)
Width
_ -> String -> (Format, Format)
forall a. HasCallStack => String -> a
sorry String
"Unsupported vector format"
code Reg
dst = InstrBlock
valExp InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
(Reg -> InstrBlock
vecCode Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Imm -> Operand -> Reg -> Instr
PINSR Format
scalarFormat Format
vectorFormat (Integer -> Imm
ImmInteger Integer
offset) (Reg -> Operand
OpReg Reg
valReg) Reg
dst)
return $ Any vectorFormat code
vector_int_insert_pinsr Int
_ Width
_ CmmExpr
_ CmmExpr
_ CmmExpr
offset = String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"MO_V_Insert: unsupported offset" (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
offset)
vector_int8x16_insert_sse2 :: CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM Register
vector_int8x16_insert_sse2 :: CmmExpr -> CmmExpr -> CmmExpr -> NatM Register
vector_int8x16_insert_sse2 CmmExpr
vecExpr CmmExpr
valExpr (CmmLit (CmmInt Integer
offset Width
_))
| Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
offset, Integer
offset Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
16
= do
(valReg, valExp) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
valExpr
vecCode <- getAnyReg vecExpr
tmp <- getNewRegNat II32
let vectorFormat = Int -> ScalarFormat -> Format
VecFormat Int
16 ScalarFormat
FmtInt8
code Reg
dst
= case Integer
offset Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
2 of
(Integer
j, Integer
0) -> InstrBlock
valExp InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
(Reg -> InstrBlock
vecCode Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Imm -> Reg -> Operand -> Instr
PEXTR Format
II32 (Int -> ScalarFormat -> Format
VecFormat Int
8 ScalarFormat
FmtInt16) (Integer -> Imm
ImmInteger Integer
j) Reg
dst (Reg -> Operand
OpReg Reg
tmp)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
AND Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
0xff00)) (Reg -> Operand
OpReg Reg
tmp)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
valReg) (Reg -> Operand
OpReg Reg
valReg)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
OR Format
II32 (Reg -> Operand
OpReg Reg
valReg) (Reg -> Operand
OpReg Reg
tmp)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Imm -> Operand -> Reg -> Instr
PINSR Format
II32 (Int -> ScalarFormat -> Format
VecFormat Int
8 ScalarFormat
FmtInt16) (Integer -> Imm
ImmInteger Integer
j) (Reg -> Operand
OpReg Reg
tmp) Reg
dst)
(Integer
j, Integer
_) -> InstrBlock
valExp InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
(Reg -> InstrBlock
vecCode Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Imm -> Reg -> Operand -> Instr
PEXTR Format
II32 (Int -> ScalarFormat -> Format
VecFormat Int
8 ScalarFormat
FmtInt16) (Integer -> Imm
ImmInteger Integer
j) Reg
dst (Reg -> Operand
OpReg Reg
tmp)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
tmp) (Reg -> Operand
OpReg Reg
tmp)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
SHL Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
8)) (Reg -> Operand
OpReg Reg
valReg)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
OR Format
II32 (Reg -> Operand
OpReg Reg
valReg) (Reg -> Operand
OpReg Reg
tmp)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Imm -> Operand -> Reg -> Instr
PINSR Format
II32 (Int -> ScalarFormat -> Format
VecFormat Int
8 ScalarFormat
FmtInt16) (Integer -> Imm
ImmInteger Integer
j) (Reg -> Operand
OpReg Reg
tmp) Reg
dst)
return $ Any vectorFormat code
vector_int8x16_insert_sse2 CmmExpr
_ CmmExpr
_ CmmExpr
offset = String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"MO_V_Insert: unsupported offset" (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
offset)
vector_int32x4_insert_sse2 :: CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM Register
vector_int32x4_insert_sse2 :: CmmExpr -> CmmExpr -> CmmExpr -> NatM Register
vector_int32x4_insert_sse2 CmmExpr
vecExpr CmmExpr
valExpr (CmmLit (CmmInt Integer
offset Width
_))
| Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
offset, Integer
offset Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
4
= do
(valReg, valExp) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
valExpr
vecCode <- getAnyReg vecExpr
let floatVectorFormat = Int -> ScalarFormat -> Format
VecFormat Int
4 ScalarFormat
FmtFloat
tmp1 <- getNewRegNat floatVectorFormat
tmp2 <- getNewRegNat floatVectorFormat
let vectorFormat = Int -> ScalarFormat -> Format
VecFormat Int
4 ScalarFormat
FmtInt32
code Reg
dst
= case Integer
offset of
Integer
0 -> InstrBlock
valExp InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
(Reg -> InstrBlock
vecCode Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Operand -> Instr
MOVD Format
II32 Format
vectorFormat (Reg -> Operand
OpReg Reg
valReg) (Reg -> Operand
OpReg Reg
tmp1)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOV Format
floatVectorFormat (Reg -> Operand
OpReg Reg
tmp1) (Reg -> Operand
OpReg Reg
dst))
Integer
1 -> InstrBlock
valExp InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
(Reg -> InstrBlock
vecCode Reg
tmp1) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Operand -> Instr
MOVD Format
II32 Format
vectorFormat (Reg -> Operand
OpReg Reg
valReg) (Reg -> Operand
OpReg Reg
dst)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PUNPCKLQDQ Format
vectorFormat (Reg -> Operand
OpReg Reg
tmp1) Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
SHUF Format
floatVectorFormat (Int -> Imm
ImmInt Int
0b11_10_00_10) (Reg -> Operand
OpReg Reg
tmp1) Reg
dst)
Integer
2 -> InstrBlock
valExp InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
(Reg -> InstrBlock
vecCode Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Operand -> Instr
MOVD Format
II32 Format
vectorFormat (Reg -> Operand
OpReg Reg
valReg) (Reg -> Operand
OpReg Reg
tmp1)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVU Format
floatVectorFormat (Reg -> Operand
OpReg Reg
dst) (Reg -> Operand
OpReg Reg
tmp2)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
SHUF Format
floatVectorFormat (Int -> Imm
ImmInt Int
0b01_00_01_11) (Reg -> Operand
OpReg Reg
tmp1) Reg
tmp2) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
SHUF Format
floatVectorFormat (Int -> Imm
ImmInt Int
0b00_10_01_00) (Reg -> Operand
OpReg Reg
tmp2) Reg
dst)
Integer
_ -> InstrBlock
valExp InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
(Reg -> InstrBlock
vecCode Reg
dst) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Operand -> Instr
MOVD Format
II32 Format
vectorFormat (Reg -> Operand
OpReg Reg
valReg) (Reg -> Operand
OpReg Reg
tmp1)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
SHUF Format
floatVectorFormat (Int -> Imm
ImmInt Int
0b11_10_01_00) (Reg -> Operand
OpReg Reg
dst) Reg
tmp1) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Imm -> Operand -> Reg -> Instr
SHUF Format
floatVectorFormat (Int -> Imm
ImmInt Int
0b00_10_01_00) (Reg -> Operand
OpReg Reg
tmp1) Reg
dst)
return $ Any vectorFormat code
vector_int32x4_insert_sse2 CmmExpr
_ CmmExpr
_ CmmExpr
offset = String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"MO_V_Insert: unsupported offset" (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
offset)
vector_int64x2_insert_sse2 :: CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM Register
vector_int64x2_insert_sse2 :: CmmExpr -> CmmExpr -> CmmExpr -> NatM Register
vector_int64x2_insert_sse2 CmmExpr
vecExpr CmmExpr
valExpr (CmmLit CmmLit
offset)
= do
(valReg, valExp) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
valExpr
(vecReg, vecExp) <- getSomeReg vecExpr
let fmt = Int -> ScalarFormat -> Format
VecFormat Int
2 ScalarFormat
FmtInt64
tmp <- getNewRegNat fmt
let code Reg
dst
= case CmmLit
offset of
CmmInt Integer
0 Width
_ -> InstrBlock
valExp InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
vecExp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Reg -> Reg -> Instr
MOVHLPS Format
fmt Reg
vecReg Reg
tmp) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Operand -> Instr
MOVD Format
II64 Format
fmt (Reg -> Operand
OpReg Reg
valReg) (Reg -> Operand
OpReg Reg
dst)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PUNPCKLQDQ Format
fmt (Reg -> Operand
OpReg Reg
tmp) Reg
dst)
CmmInt Integer
1 Width
_ -> InstrBlock
valExp InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
vecExp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Operand -> Instr
MOVDQU Format
fmt (Reg -> Operand
OpReg Reg
vecReg) (Reg -> Operand
OpReg Reg
dst)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Format -> Operand -> Operand -> Instr
MOVD Format
II64 Format
fmt (Reg -> Operand
OpReg Reg
valReg) (Reg -> Operand
OpReg Reg
tmp)) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
(Format -> Operand -> Reg -> Instr
PUNPCKLQDQ Format
fmt (Reg -> Operand
OpReg Reg
tmp) Reg
dst)
CmmLit
_ -> String -> SDoc -> InstrBlock
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"MO_V_Insert Int64X2: unsupported offset" (CmmLit -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmLit
offset)
in return $ Any fmt code
vector_int64x2_insert_sse2 CmmExpr
_ CmmExpr
_ CmmExpr
offset = String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"MO_V_Insert Int64X2: unsupported offset" (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
offset)
getRegister' Platform
_ Bool
_ (CmmMachOp MachOp
mop (CmmExpr
_:CmmExpr
_:CmmExpr
_:CmmExpr
_:[CmmExpr]
_)) =
String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegister(x86): MachOp with >= 4 arguments" (String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ MachOp -> String
forall a. Show a => a -> String
show MachOp
mop)
getRegister' Platform
platform Bool
is32Bit load :: CmmExpr
load@(CmmLoad CmmExpr
mem CmmType
ty AlignmentSpec
_)
| CmmType -> Bool
isVecType CmmType
ty
= do
config <- NatM NCGConfig
getConfig
Amode addr mem_code <- getAmode mem
let code Reg
dst =
InstrBlock
mem_code InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
HasDebugCallStack =>
NCGConfig -> Format -> Operand -> Operand -> Instr
NCGConfig -> Format -> Operand -> Operand -> Instr
movInstr NCGConfig
config Format
format (AddrMode -> Operand
OpAddr AddrMode
addr) (Reg -> Operand
OpReg Reg
dst)
return (Any format code)
| CmmType -> Bool
isFloatType CmmType
ty
= do
Amode addr mem_code <- CmmExpr -> NatM Amode
getAmode CmmExpr
mem
loadAmode (floatFormat width) addr mem_code
| Bool
is32Bit Bool -> Bool -> Bool
&& Bool -> Bool
not (CmmType -> Bool
isWord64 CmmType
ty)
= do
let
instr :: Operand -> Operand -> Instr
instr = case Width
width of
Width
W8 -> Format -> Operand -> Operand -> Instr
MOVZxL Format
II8
Width
_other -> Format -> Operand -> Operand -> Instr
MOV Format
format
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> InstrBlock)
intLoadCode Operand -> Operand -> Instr
instr CmmExpr
mem
return (Any format code)
| Bool -> Bool
not Bool
is32Bit
= do
code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> InstrBlock)
intLoadCode (Format -> Operand -> Operand -> Instr
MOV Format
format) CmmExpr
mem
return (Any format code)
| Bool
otherwise
= String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegister(x86) CmmLoad" (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
load)
where
format :: Format
format = CmmType -> Format
cmmTypeFormat CmmType
ty
width :: Width
width = CmmType -> Width
typeWidth CmmType
ty
getRegister' Platform
platform Bool
is32Bit (CmmLit CmmLit
lit)
| CmmLit -> Bool
is_label CmmLit
lit
, Bool -> Bool
not Bool
is32Bit
= do let format :: Format
format = CmmType -> Format
cmmTypeFormat (Platform -> CmmLit -> CmmType
cmmLitType Platform
platform CmmLit
lit)
imm :: Imm
imm = CmmLit -> Imm
litToImm CmmLit
lit
op :: Operand
op = AddrMode -> Operand
OpAddr (EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex EABase
EABaseRip EAIndex
EAIndexNone Imm
imm)
code :: Reg -> InstrBlock
code Reg
dst = Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
LEA Format
format Operand
op (Reg -> Operand
OpReg Reg
dst))
Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> InstrBlock) -> Register
Any Format
format Reg -> InstrBlock
code)
where
is_label :: CmmLit -> Bool
is_label (CmmLabel {}) = Bool
True
is_label (CmmLabelOff {}) = Bool
True
is_label (CmmLabelDiffOff {}) = Bool
True
is_label CmmLit
_ = Bool
False
getRegister' Platform
platform Bool
is32Bit (CmmLit CmmLit
lit) = do
avx <- NatM Bool
avxEnabled
if
| isZeroLit lit
-> let code Reg
dst
| Format -> Bool
isIntFormat Format
fmt
= let fmt' :: Format
fmt'
| Bool
is32Bit
= Format
fmt
| Bool
otherwise
= case Format
fmt of
Format
II64 -> Format
II32
Format
_ -> Format
fmt
in Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
XOR Format
fmt' (Reg -> Operand
OpReg Reg
dst) (Reg -> Operand
OpReg Reg
dst))
| Bool
avx
= if Bool
float_or_floatvec
then Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Reg -> Reg -> Instr
VXOR Format
fmt (Reg -> Operand
OpReg Reg
dst) Reg
dst Reg
dst)
else Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Reg -> Reg -> Reg -> Instr
VPXOR Format
fmt Reg
dst Reg
dst Reg
dst)
| Bool
otherwise
= if Bool
float_or_floatvec
then Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
XOR Format
fmt (Reg -> Operand
OpReg Reg
dst) (Reg -> Operand
OpReg Reg
dst))
else Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Reg -> Instr
PXOR Format
fmt (Reg -> Operand
OpReg Reg
dst) Reg
dst)
in return $ Any fmt code
| VecFormat l sFmt <- fmt
, CmmVec (f:fs) <- lit
, all (== f) fs
-> do let w = ScalarFormat -> Width
scalarWidth ScalarFormat
sFmt
broadcast = if ScalarFormat -> Bool
isFloatScalarFormat ScalarFormat
sFmt
then Int -> Width -> MachOp
MO_VF_Broadcast Int
l Width
w
else Int -> Width -> MachOp
MO_V_Broadcast Int
l Width
w
valCode <- getAnyReg (CmmMachOp broadcast [CmmLit f])
return $ Any fmt valCode
| not is32Bit, isWord64 cmmTy, not (isBigLit lit)
-> let
imm = CmmLit -> Imm
litToImm CmmLit
lit
code Reg
dst = Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
II32 (Imm -> Operand
OpImm Imm
imm) (Reg -> Operand
OpReg Reg
dst))
in
return (Any II64 code)
| isIntFormat fmt
-> let imm = CmmLit -> Imm
litToImm CmmLit
lit
code Reg
dst = Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
fmt (Imm -> Operand
OpImm Imm
imm) (Reg -> Operand
OpReg Reg
dst))
in return (Any fmt code)
| otherwise
-> do let w = Format -> Width
formatToWidth Format
fmt
Amode addr addr_code <- memConstant (mkAlignment $ widthInBytes w) lit
loadAmode fmt addr addr_code
where
cmmTy :: CmmType
cmmTy = Platform -> CmmLit -> CmmType
cmmLitType Platform
platform CmmLit
lit
fmt :: Format
fmt = CmmType -> Format
cmmTypeFormat CmmType
cmmTy
float_or_floatvec :: Bool
float_or_floatvec = Format -> Bool
isFloatOrFloatVecFormat Format
fmt
isZeroLit :: CmmLit -> Bool
isZeroLit (CmmInt Integer
i Width
_) = Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
isZeroLit (CmmFloat Rational
f Width
_) = Rational
f Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0
isZeroLit (CmmVec [CmmLit]
fs) = (CmmLit -> Bool) -> [CmmLit] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all CmmLit -> Bool
isZeroLit [CmmLit]
fs
isZeroLit CmmLit
_ = Bool
False
isBigLit :: CmmLit -> Bool
isBigLit (CmmInt Integer
i Width
_) = Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0xffffffff
isBigLit CmmLit
_ = Bool
False
getRegister' Platform
platform Bool
_ slot :: CmmExpr
slot@(CmmStackSlot {}) =
String -> SDoc -> NatM Register
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegister(x86) CmmStackSlot" (Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
slot)
intLoadCode :: (Operand -> Operand -> Instr) -> CmmExpr
-> NatM (Reg -> InstrBlock)
intLoadCode :: (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> InstrBlock)
intLoadCode Operand -> Operand -> Instr
instr CmmExpr
mem = do
Amode src mem_code <- CmmExpr -> NatM Amode
getAmode CmmExpr
mem
return (\Reg
dst -> InstrBlock
mem_code InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL` Operand -> Operand -> Instr
instr (AddrMode -> Operand
OpAddr AddrMode
src) (Reg -> Operand
OpReg Reg
dst))
getAnyReg :: HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg :: HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
expr = do
r <- HasDebugCallStack => CmmExpr -> NatM Register
CmmExpr -> NatM Register
getRegister CmmExpr
expr
anyReg r
anyReg :: HasDebugCallStack => Register -> NatM (Reg -> InstrBlock)
anyReg :: HasDebugCallStack => Register -> NatM (Reg -> InstrBlock)
anyReg (Any Format
_ Reg -> InstrBlock
code) = (Reg -> InstrBlock) -> NatM (Reg -> InstrBlock)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return Reg -> InstrBlock
code
anyReg (Fixed Format
rep Reg
reg InstrBlock
fcode) = do
config <- NatM NCGConfig
getConfig
return (\Reg
dst -> InstrBlock
fcode InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL` HasDebugCallStack => NCGConfig -> Format -> Reg -> Reg -> Instr
NCGConfig -> Format -> Reg -> Reg -> Instr
mkRegRegMoveInstr NCGConfig
config Format
rep Reg
reg Reg
dst)
getByteReg :: HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
getByteReg :: HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
getByteReg CmmExpr
expr = do
config <- NatM NCGConfig
getConfig
is32Bit <- is32BitPlatform
if is32Bit
then do r <- getRegister expr
case r of
Any Format
rep Reg -> InstrBlock
code -> do
tmp <- Format -> NatM Reg
getNewRegNat Format
rep
return (tmp, code tmp)
Fixed Format
rep Reg
reg InstrBlock
code
| Reg -> Bool
isVirtualReg Reg
reg -> (Reg, InstrBlock) -> NatM (Reg, InstrBlock)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
reg,InstrBlock
code)
| Bool
otherwise -> do
tmp <- Format -> NatM Reg
getNewRegNat Format
rep
return (tmp, code `snocOL` mkRegRegMoveInstr config rep reg tmp)
else getSomeReg expr
getNonClobberedReg :: HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg :: HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
expr = do
r <- HasDebugCallStack => CmmExpr -> NatM Register
CmmExpr -> NatM Register
getRegister CmmExpr
expr
config <- getConfig
let platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
case r of
Any Format
rep Reg -> InstrBlock
code -> do
tmp <- Format -> NatM Reg
getNewRegNat Format
rep
return (tmp, code tmp)
Fixed Format
rep Reg
reg InstrBlock
code
| Reg
reg Reg -> [Reg] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Platform -> [Reg]
instrClobberedRegs Platform
platform
-> do
tmp <- Format -> NatM Reg
getNewRegNat Format
rep
return (tmp, code `snocOL` mkRegRegMoveInstr config rep reg tmp)
| Bool
otherwise ->
(Reg, InstrBlock) -> NatM (Reg, InstrBlock)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
reg, InstrBlock
code)
getAmode :: CmmExpr -> NatM Amode
getAmode :: CmmExpr -> NatM Amode
getAmode CmmExpr
e = do
platform <- NatM Platform
getPlatform
let is32Bit = Platform -> Bool
target32Bit Platform
platform
case e of
CmmRegOff CmmReg
r Int
n
-> CmmExpr -> NatM Amode
getAmode (CmmExpr -> NatM Amode) -> CmmExpr -> NatM Amode
forall a b. (a -> b) -> a -> b
$ CmmReg -> Int -> CmmExpr
mangleIndexTree CmmReg
r Int
n
CmmMachOp (MO_Add Width
W64) [CmmReg (CmmGlobal (GlobalRegUse GlobalReg
PicBaseReg CmmType
_)), CmmLit CmmLit
displacement]
| Bool -> Bool
not Bool
is32Bit
-> Amode -> NatM Amode
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Amode -> NatM Amode) -> Amode -> NatM Amode
forall a b. (a -> b) -> a -> b
$ AddrMode -> InstrBlock -> Amode
Amode (Imm -> AddrMode
ripRel (CmmLit -> Imm
litToImm CmmLit
displacement)) InstrBlock
forall a. OrdList a
nilOL
CmmMachOp (MO_Sub Width
_rep) [CmmExpr
x, CmmLit lit :: CmmLit
lit@(CmmInt Integer
i Width
_)]
| Platform -> CmmLit -> Bool
is32BitLit Platform
platform CmmLit
lit
-> do
(x_reg, x_code) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
x
let off = Int -> Imm
ImmInt (-(Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i))
return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)
CmmMachOp (MO_Add Width
_rep) [CmmExpr
x, CmmLit CmmLit
lit]
| Platform -> CmmLit -> Bool
is32BitLit Platform
platform CmmLit
lit
-> do
(x_reg, x_code) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
x
let off = CmmLit -> Imm
litToImm CmmLit
lit
return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)
CmmMachOp (MO_Add Width
rep) [a :: CmmExpr
a@(CmmMachOp (MO_Shl Width
_) [CmmExpr]
_), b :: CmmExpr
b@(CmmLit CmmLit
_)]
-> CmmExpr -> NatM Amode
getAmode (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add Width
rep) [CmmExpr
b,CmmExpr
a])
CmmMachOp (MO_Add Width
_) [CmmRegOff CmmReg
x Int
offset, CmmMachOp (MO_Shl Width
_) [CmmExpr
y, CmmLit (CmmInt Integer
shift Width
_)]]
| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
|| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 Bool -> Bool -> Bool
|| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
2 Bool -> Bool -> Bool
|| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
3
-> CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
x86_complex_amode (CmmReg -> CmmExpr
CmmReg CmmReg
x) CmmExpr
y Integer
shift (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset)
CmmMachOp (MO_Add Width
_) [CmmExpr
x, CmmMachOp (MO_Shl Width
_) [CmmExpr
y, CmmLit (CmmInt Integer
shift Width
_)]]
| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
|| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 Bool -> Bool -> Bool
|| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
2 Bool -> Bool -> Bool
|| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
3
-> CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
x86_complex_amode CmmExpr
x CmmExpr
y Integer
shift Integer
0
CmmMachOp (MO_Add Width
_) [CmmExpr
x, CmmMachOp (MO_Add Width
_) [CmmMachOp (MO_Shl Width
_)
[CmmExpr
y, CmmLit (CmmInt Integer
shift Width
_)], CmmLit (CmmInt Integer
offset Width
_)]]
| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
|| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 Bool -> Bool -> Bool
|| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
2 Bool -> Bool -> Bool
|| Integer
shift Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
3
Bool -> Bool -> Bool
&& Integer -> Bool
is32BitInteger Integer
offset
-> CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
x86_complex_amode CmmExpr
x CmmExpr
y Integer
shift Integer
offset
CmmMachOp (MO_Add Width
_) [CmmExpr
x,CmmExpr
y]
| Bool -> Bool
not (CmmExpr -> Bool
isLit CmmExpr
y)
-> CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
x86_complex_amode CmmExpr
x CmmExpr
y Integer
0 Integer
0
CmmLit lit :: CmmLit
lit@(CmmFloat {})
-> String -> SDoc -> NatM Amode
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"X86 CodeGen: attempt to use floating-point value as a memory address"
(CmmLit -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmLit
lit)
CmmLit CmmLit
lit
| Bool -> Bool
not Bool
is32Bit
, CmmLit -> Bool
is_label CmmLit
lit
-> Amode -> NatM Amode
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> InstrBlock -> Amode
Amode (EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex EABase
EABaseRip EAIndex
EAIndexNone (CmmLit -> Imm
litToImm CmmLit
lit)) InstrBlock
forall a. OrdList a
nilOL)
CmmLit CmmLit
lit
| Platform -> CmmLit -> Bool
is32BitLit Platform
platform CmmLit
lit
-> Amode -> NatM Amode
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> InstrBlock -> Amode
Amode (Imm -> Int -> AddrMode
ImmAddr (CmmLit -> Imm
litToImm CmmLit
lit) Int
0) InstrBlock
forall a. OrdList a
nilOL)
CmmLit (CmmLabelOff CLabel
l Int
off)
-> CmmExpr -> NatM Amode
getAmode (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add Width
W64) [ CmmLit -> CmmExpr
CmmLit (CLabel -> CmmLit
CmmLabel CLabel
l)
, CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off) Width
W64)
])
CmmLit (CmmLabelDiffOff CLabel
l1 CLabel
l2 Int
off Width
w)
-> CmmExpr -> NatM Amode
getAmode (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add Width
W64) [ CmmLit -> CmmExpr
CmmLit (CLabel -> CLabel -> Int -> Width -> CmmLit
CmmLabelDiffOff CLabel
l1 CLabel
l2 Int
0 Width
w)
, CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off) Width
W64)
])
CmmExpr
_ -> do
(reg,code) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
e
return (Amode (AddrBaseIndex (EABaseReg reg) EAIndexNone (ImmInt 0)) code)
where
is_label :: CmmLit -> Bool
is_label (CmmLabel{}) = Bool
True
is_label (CmmLabelOff{}) = Bool
True
is_label (CmmLabelDiffOff{}) = Bool
True
is_label CmmLit
_ = Bool
False
getSimpleAmode :: CmmExpr -> NatM Amode
getSimpleAmode :: CmmExpr -> NatM Amode
getSimpleAmode CmmExpr
addr = NatM Bool
is32BitPlatform NatM Bool -> (Bool -> NatM Amode) -> NatM Amode
forall a b. NatM a -> (a -> NatM b) -> NatM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
False -> CmmExpr -> NatM Amode
getAmode CmmExpr
addr
Bool
True -> do
addr_code <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
addr
config <- getConfig
addr_r <- getNewRegNat (intFormat (ncgWordWidth config))
let amode = EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
addr_r) EAIndex
EAIndexNone (Int -> Imm
ImmInt Int
0)
return $! Amode amode (addr_code addr_r)
x86_complex_amode :: CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
x86_complex_amode :: CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
x86_complex_amode CmmExpr
base CmmExpr
index Integer
shift Integer
offset
= do (x_reg, x_code) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
base
(y_reg, y_code) <- getSomeReg index
let
code = InstrBlock
x_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
y_code
base = case Integer
shift of Integer
0 -> Int
1; Integer
1 -> Int
2; Integer
2 -> Int
4; Integer
3 -> Int
8;
Integer
n -> String -> Int
forall a. HasCallStack => String -> a
panic (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"x86_complex_amode: unhandled shift! (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
return (Amode (AddrBaseIndex (EABaseReg x_reg) (EAIndex y_reg base) (ImmInt (fromIntegral offset)))
code)
getNonClobberedOperand :: CmmExpr -> NatM (Operand, InstrBlock)
getNonClobberedOperand :: CmmExpr -> NatM (Operand, InstrBlock)
getNonClobberedOperand (CmmLit CmmLit
lit)
| Just Width
w <- CmmLit -> Maybe Width
isSuitableFloatingPointLit_maybe CmmLit
lit = do
Amode addr code <- Alignment -> CmmLit -> NatM Amode
memConstant (Int -> Alignment
mkAlignment (Int -> Alignment) -> Int -> Alignment
forall a b. (a -> b) -> a -> b
$ Width -> Int
widthInBytes Width
w) CmmLit
lit
return (OpAddr addr, code)
| Bool
otherwise = do
platform <- NatM Platform
getPlatform
if is32BitLit platform lit && isIntFormat (cmmTypeFormat (cmmLitType platform lit))
then return (OpImm (litToImm lit), nilOL)
else getNonClobberedOperand_generic (CmmLit lit)
getNonClobberedOperand (CmmLoad CmmExpr
mem CmmType
ty AlignmentSpec
_) = do
is32Bit <- NatM Bool
is32BitPlatform
if (if is32Bit then not (isWord64 ty) else True)
then do
platform <- ncgPlatform <$> getConfig
Amode src mem_code <- getAmode mem
(src',save_code) <-
if (amodeCouldBeClobbered platform src)
then do
tmp <- getNewRegNat (archWordFormat is32Bit)
return (AddrBaseIndex (EABaseReg tmp) EAIndexNone (ImmInt 0),
unitOL (LEA (archWordFormat is32Bit)
(OpAddr src)
(OpReg tmp)))
else
return (src, nilOL)
return (OpAddr src', mem_code `appOL` save_code)
else
getNonClobberedOperand_generic (CmmLoad mem ty NaturallyAligned)
getNonClobberedOperand CmmExpr
e = CmmExpr -> NatM (Operand, InstrBlock)
getNonClobberedOperand_generic CmmExpr
e
getNonClobberedOperand_generic :: CmmExpr -> NatM (Operand, InstrBlock)
getNonClobberedOperand_generic :: CmmExpr -> NatM (Operand, InstrBlock)
getNonClobberedOperand_generic CmmExpr
e = do
(reg, code) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
e
return (OpReg reg, code)
amodeCouldBeClobbered :: Platform -> AddrMode -> Bool
amodeCouldBeClobbered :: Platform -> AddrMode -> Bool
amodeCouldBeClobbered Platform
platform AddrMode
amode = (Reg -> Bool) -> [Reg] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Platform -> Reg -> Bool
regClobbered Platform
platform) (AddrMode -> [Reg]
addrModeRegs AddrMode
amode)
regClobbered :: Platform -> Reg -> Bool
regClobbered :: Platform -> Reg -> Bool
regClobbered Platform
platform (RegReal (RealRegSingle Int
rr)) = Platform -> Int -> Bool
freeReg Platform
platform Int
rr
regClobbered Platform
_ Reg
_ = Bool
False
getOperand :: CmmExpr -> NatM (Operand, InstrBlock)
getOperand :: CmmExpr -> NatM (Operand, InstrBlock)
getOperand (CmmLit CmmLit
lit) = case CmmLit -> Maybe Width
isSuitableFloatingPointLit_maybe CmmLit
lit of
Just Width
w -> do
Amode addr code <- Alignment -> CmmLit -> NatM Amode
memConstant (Int -> Alignment
mkAlignment (Int -> Alignment) -> Int -> Alignment
forall a b. (a -> b) -> a -> b
$ Width -> Int
widthInBytes Width
w) CmmLit
lit
return (OpAddr addr, code)
Maybe Width
Nothing -> do
platform <- NatM Platform
getPlatform
if is32BitLit platform lit && (isIntFormat $ cmmTypeFormat (cmmLitType platform lit))
then return (OpImm (litToImm lit), nilOL)
else getOperand_generic (CmmLit lit)
getOperand (CmmLoad CmmExpr
mem CmmType
ty AlignmentSpec
_) = do
is32Bit <- NatM Bool
is32BitPlatform
if isIntFormat (cmmTypeFormat ty) && (if is32Bit then not (isWord64 ty) else True)
then do
Amode src mem_code <- getAmode mem
return (OpAddr src, mem_code)
else
getOperand_generic (CmmLoad mem ty NaturallyAligned)
getOperand CmmExpr
e = CmmExpr -> NatM (Operand, InstrBlock)
getOperand_generic CmmExpr
e
getOperand_generic :: CmmExpr -> NatM (Operand, InstrBlock)
getOperand_generic :: CmmExpr -> NatM (Operand, InstrBlock)
getOperand_generic CmmExpr
e = do
(reg, code) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
e
return (OpReg reg, code)
isOperand :: Platform -> CmmExpr -> Bool
isOperand :: Platform -> CmmExpr -> Bool
isOperand Platform
_ (CmmLoad CmmExpr
_ CmmType
_ AlignmentSpec
_) = Bool
True
isOperand Platform
platform (CmmLit CmmLit
lit)
= Platform -> CmmLit -> Bool
is32BitLit Platform
platform CmmLit
lit
Bool -> Bool -> Bool
|| CmmLit -> Bool
isSuitableFloatingPointLit CmmLit
lit
isOperand Platform
_ CmmExpr
_ = Bool
False
addAlignmentCheck :: Int -> Register -> Register
addAlignmentCheck :: Int -> Register -> Register
addAlignmentCheck Int
align Register
reg =
case Register
reg of
Fixed Format
fmt Reg
reg InstrBlock
code -> Format -> Reg -> InstrBlock -> Register
Fixed Format
fmt Reg
reg (InstrBlock
code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Format -> Reg -> InstrBlock
check Format
fmt Reg
reg)
Any Format
fmt Reg -> InstrBlock
f -> Format -> (Reg -> InstrBlock) -> Register
Any Format
fmt (\Reg
reg -> Reg -> InstrBlock
f Reg
reg InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Format -> Reg -> InstrBlock
check Format
fmt Reg
reg)
where
check :: Format -> Reg -> InstrBlock
check :: Format -> Reg -> InstrBlock
check Format
fmt Reg
reg =
Bool -> InstrBlock -> InstrBlock
forall a. HasCallStack => Bool -> a -> a
assert (Format -> Bool
isIntFormat Format
fmt) (InstrBlock -> InstrBlock) -> InstrBlock -> InstrBlock
forall a b. (a -> b) -> a -> b
$
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Operand -> Instr
TEST Format
fmt (Imm -> Operand
OpImm (Imm -> Operand) -> Imm -> Operand
forall a b. (a -> b) -> a -> b
$ Int -> Imm
ImmInt (Int -> Imm) -> Int -> Imm
forall a b. (a -> b) -> a -> b
$ Int
alignInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Reg -> Operand
OpReg Reg
reg)
, Cond -> Imm -> Instr
JXX_GBL Cond
NE (Imm -> Instr) -> Imm -> Instr
forall a b. (a -> b) -> a -> b
$ CLabel -> Imm
ImmCLbl CLabel
mkBadAlignmentLabel
]
memConstant :: Alignment -> CmmLit -> NatM Amode
memConstant :: Alignment -> CmmLit -> NatM Amode
memConstant Alignment
align CmmLit
lit = do
lbl <- NatM CLabel
getNewLabelNat
let rosection = SectionType -> CLabel -> Section
Section SectionType
ReadOnlyData CLabel
lbl
config <- getConfig
platform <- getPlatform
(addr, addr_code) <- if target32Bit platform
then do dynRef <- cmmMakeDynamicReference
config
DataReference
lbl
Amode addr addr_code <- getAmode dynRef
return (addr, addr_code)
else return (ripRel (ImmCLbl lbl), nilOL)
let code =
Section -> (Alignment, RawCmmStatics) -> Instr
LDATA Section
rosection (Alignment
align, CLabel -> [CmmStatic] -> RawCmmStatics
forall (rawOnly :: Bool).
CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
CmmStaticsRaw CLabel
lbl [CmmLit -> CmmStatic
CmmStaticLit CmmLit
lit])
Instr -> InstrBlock -> InstrBlock
forall a. a -> OrdList a -> OrdList a
`consOL` InstrBlock
addr_code
return (Amode addr code)
loadAmode :: Format -> AddrMode -> InstrBlock -> NatM Register
loadAmode :: Format -> AddrMode -> InstrBlock -> NatM Register
loadAmode Format
fmt AddrMode
addr InstrBlock
addr_code = do
config <- NatM NCGConfig
getConfig
let load Reg
dst = HasDebugCallStack =>
NCGConfig -> Format -> Operand -> Operand -> Instr
NCGConfig -> Format -> Operand -> Operand -> Instr
movInstr NCGConfig
config Format
fmt (AddrMode -> Operand
OpAddr AddrMode
addr) (Reg -> Operand
OpReg Reg
dst)
return $ Any fmt (\ Reg
dst -> InstrBlock
addr_code InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Instr
load Reg
dst)
isSuitableFloatingPointLit :: CmmLit -> Bool
isSuitableFloatingPointLit :: CmmLit -> Bool
isSuitableFloatingPointLit = Maybe Width -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Width -> Bool) -> (CmmLit -> Maybe Width) -> CmmLit -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmLit -> Maybe Width
isSuitableFloatingPointLit_maybe
isSuitableFloatingPointLit_maybe :: CmmLit -> Maybe Width
isSuitableFloatingPointLit_maybe :: CmmLit -> Maybe Width
isSuitableFloatingPointLit_maybe (CmmFloat Rational
f Width
w) = Width
w Width -> Maybe () -> Maybe Width
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Rational
f Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
/= Rational
0.0)
isSuitableFloatingPointLit_maybe CmmLit
_ = Maybe Width
forall a. Maybe a
Nothing
getRegOrMem :: CmmExpr -> NatM (Operand, InstrBlock)
getRegOrMem :: CmmExpr -> NatM (Operand, InstrBlock)
getRegOrMem e :: CmmExpr
e@(CmmLoad CmmExpr
mem CmmType
ty AlignmentSpec
_) = do
is32Bit <- NatM Bool
is32BitPlatform
if isIntFormat (cmmTypeFormat ty) && (if is32Bit then not (isWord64 ty) else True)
then do
Amode src mem_code <- getAmode mem
return (OpAddr src, mem_code)
else do
(reg, code) <- getNonClobberedReg e
return (OpReg reg, code)
getRegOrMem CmmExpr
e = do
(reg, code) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
e
return (OpReg reg, code)
is32BitLit :: Platform -> CmmLit -> Bool
is32BitLit :: Platform -> CmmLit -> Bool
is32BitLit Platform
platform CmmLit
_lit
| Platform -> Bool
target32Bit Platform
platform = Bool
True
is32BitLit Platform
platform CmmLit
lit =
case CmmLit
lit of
CmmInt Integer
i Width
W64 -> Integer -> Bool
is32BitInteger Integer
i
CmmLabel CLabel
_ -> Bool
low_image
CmmLabelOff CLabel
_ Int
off -> Bool
low_image Bool -> Bool -> Bool
&& Integer -> Bool
is32BitInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off)
CmmLabelDiffOff CLabel
_ CLabel
_ Int
off Width
_ -> Bool
low_image Bool -> Bool -> Bool
&& Integer -> Bool
is32BitInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off)
CmmLit
_ -> Bool
True
where
low_image :: Bool
low_image =
case Platform -> OS
platformOS Platform
platform of
OS
OSMinGW32 -> Bool
False
OS
_ -> Bool
True
getCondCode :: CmmExpr -> NatM CondCode
getCondCode :: CmmExpr -> NatM CondCode
getCondCode (CmmMachOp MachOp
mop [CmmExpr
x, CmmExpr
y])
=
case MachOp
mop of
MO_F_Eq Width
W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
EQQ CmmExpr
x CmmExpr
y
MO_F_Ne Width
W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
NE CmmExpr
x CmmExpr
y
MO_F_Gt Width
W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
GTT CmmExpr
x CmmExpr
y
MO_F_Ge Width
W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
GE CmmExpr
x CmmExpr
y
MO_F_Lt Width
W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
GTT CmmExpr
y CmmExpr
x
MO_F_Le Width
W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
GE CmmExpr
y CmmExpr
x
MO_F_Eq Width
W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
EQQ CmmExpr
x CmmExpr
y
MO_F_Ne Width
W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
NE CmmExpr
x CmmExpr
y
MO_F_Gt Width
W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
GTT CmmExpr
x CmmExpr
y
MO_F_Ge Width
W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
GE CmmExpr
x CmmExpr
y
MO_F_Lt Width
W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
GTT CmmExpr
y CmmExpr
x
MO_F_Le Width
W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
GE CmmExpr
y CmmExpr
x
MachOp
_ -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode (MachOp -> Cond
machOpToCond MachOp
mop) CmmExpr
x CmmExpr
y
getCondCode CmmExpr
other = do
platform <- NatM Platform
getPlatform
pprPanic "getCondCode(2)(x86,x86_64)" (pdoc platform other)
machOpToCond :: MachOp -> Cond
machOpToCond :: MachOp -> Cond
machOpToCond MachOp
mo = case MachOp
mo of
MO_Eq Width
_ -> Cond
EQQ
MO_Ne Width
_ -> Cond
NE
MO_S_Gt Width
_ -> Cond
GTT
MO_S_Ge Width
_ -> Cond
GE
MO_S_Lt Width
_ -> Cond
LTT
MO_S_Le Width
_ -> Cond
LE
MO_U_Gt Width
_ -> Cond
GU
MO_U_Ge Width
_ -> Cond
GEU
MO_U_Lt Width
_ -> Cond
LU
MO_U_Le Width
_ -> Cond
LEU
MachOp
_other -> String -> SDoc -> Cond
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"machOpToCond" (MachOp -> SDoc
pprMachOp MachOp
mo)
condIntCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
cond CmmExpr
x CmmExpr
y = do platform <- NatM Platform
getPlatform
condIntCode' platform cond x y
condIntCode' :: Platform -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode' :: Platform -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode' Platform
platform Cond
cond CmmExpr
x CmmExpr
y
| Platform -> Bool
target32Bit Platform
platform Bool -> Bool -> Bool
&& CmmType -> Bool
isWord64 (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
x) = do
RegCode64 code1 r1hi r1lo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
x
RegCode64 code2 r2hi r2lo <- iselExpr64 y
tmp1 <- getNewRegNat II32
tmp2 <- getNewRegNat II32
let (cond', cmpCode) = intComparison cond r1hi r1lo r2hi r2lo tmp1 tmp2
return $ CondCode False cond' (code1 `appOL` code2 `appOL` cmpCode)
where
intComparison :: Cond
-> Reg -> Reg -> Reg -> Reg -> Reg -> Reg -> (Cond, InstrBlock)
intComparison Cond
cond Reg
r1_hi Reg
r1_lo Reg
r2_hi Reg
r2_lo Reg
tmp1 Reg
tmp2 =
case Cond
cond of
Cond
ALWAYS -> String -> (Cond, InstrBlock)
forall a. HasCallStack => String -> a
panic String
"impossible"
Cond
NEG -> String -> (Cond, InstrBlock)
forall a. HasCallStack => String -> a
panic String
"impossible"
Cond
POS -> String -> (Cond, InstrBlock)
forall a. HasCallStack => String -> a
panic String
"impossible"
Cond
CARRY -> String -> (Cond, InstrBlock)
forall a. HasCallStack => String -> a
panic String
"impossible"
Cond
OFLO -> String -> (Cond, InstrBlock)
forall a. HasCallStack => String -> a
panic String
"impossible"
Cond
PARITY -> String -> (Cond, InstrBlock)
forall a. HasCallStack => String -> a
panic String
"impossible"
Cond
NOTPARITY -> String -> (Cond, InstrBlock)
forall a. HasCallStack => String -> a
panic String
"impossible"
Cond
EQQ -> (Cond
EQQ, InstrBlock
cmpExact)
Cond
NE -> (Cond
NE, InstrBlock
cmpExact)
Cond
GE -> (Cond
GE, InstrBlock
cmpGE)
Cond
GEU -> (Cond
GEU, InstrBlock
cmpGE)
Cond
GTT -> (Cond
LTT, InstrBlock
cmpLE)
Cond
GU -> (Cond
LU, InstrBlock
cmpLE)
Cond
LE -> (Cond
GE, InstrBlock
cmpLE)
Cond
LEU -> (Cond
GEU, InstrBlock
cmpLE)
Cond
LTT -> (Cond
LTT, InstrBlock
cmpGE)
Cond
LU -> (Cond
LU, InstrBlock
cmpGE)
where
cmpExact :: OrdList Instr
cmpExact :: InstrBlock
cmpExact =
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL
[ Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1_hi) (Reg -> Operand
OpReg Reg
tmp1)
, Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1_lo) (Reg -> Operand
OpReg Reg
tmp2)
, Format -> Operand -> Operand -> Instr
XOR Format
II32 (Reg -> Operand
OpReg Reg
r2_hi) (Reg -> Operand
OpReg Reg
tmp1)
, Format -> Operand -> Operand -> Instr
XOR Format
II32 (Reg -> Operand
OpReg Reg
r2_lo) (Reg -> Operand
OpReg Reg
tmp2)
, Format -> Operand -> Operand -> Instr
OR Format
II32 (Reg -> Operand
OpReg Reg
tmp1) (Reg -> Operand
OpReg Reg
tmp2)
]
cmpGE :: InstrBlock
cmpGE = [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL
[ Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r1_hi) (Reg -> Operand
OpReg Reg
tmp1)
, Format -> Operand -> Operand -> Instr
CMP Format
II32 (Reg -> Operand
OpReg Reg
r2_lo) (Reg -> Operand
OpReg Reg
r1_lo)
, Format -> Operand -> Operand -> Instr
SBB Format
II32 (Reg -> Operand
OpReg Reg
r2_hi) (Reg -> Operand
OpReg Reg
tmp1)
]
cmpLE :: InstrBlock
cmpLE = [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL
[ Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
r2_hi) (Reg -> Operand
OpReg Reg
tmp1)
, Format -> Operand -> Operand -> Instr
CMP Format
II32 (Reg -> Operand
OpReg Reg
r1_lo) (Reg -> Operand
OpReg Reg
r2_lo)
, Format -> Operand -> Operand -> Instr
SBB Format
II32 (Reg -> Operand
OpReg Reg
r1_hi) (Reg -> Operand
OpReg Reg
tmp1)
]
condIntCode' Platform
platform Cond
cond (CmmLoad CmmExpr
x CmmType
ty AlignmentSpec
_) (CmmLit CmmLit
lit)
| Platform -> CmmLit -> Bool
is32BitLit Platform
platform CmmLit
lit = do
Amode x_addr x_code <- CmmExpr -> NatM Amode
getAmode CmmExpr
x
let
imm = CmmLit -> Imm
litToImm CmmLit
lit
code = InstrBlock
x_code InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Operand -> Instr
CMP (CmmType -> Format
cmmTypeFormat CmmType
ty) (Imm -> Operand
OpImm Imm
imm) (AddrMode -> Operand
OpAddr AddrMode
x_addr)
return (CondCode False cond code)
condIntCode' Platform
platform Cond
cond (CmmMachOp (MO_And Width
_) [CmmExpr
x,CmmExpr
o2]) (CmmLit (CmmInt Integer
0 Width
ty))
| (CmmLit lit :: CmmLit
lit@(CmmInt Integer
mask Width
_)) <- CmmExpr
o2, Platform -> CmmLit -> Bool
is32BitLit Platform
platform CmmLit
lit
= do
(x_reg, x_code) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
x
let
code = InstrBlock
x_code InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Operand -> Instr
TEST (Width -> Format
intFormat Width
ty) (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
mask)) (Reg -> Operand
OpReg Reg
x_reg)
return (CondCode False cond code)
condIntCode' Platform
_ Cond
cond CmmExpr
x (CmmLit (CmmInt Integer
0 Width
ty)) = do
(x_reg, x_code) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
x
let
code = InstrBlock
x_code InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Operand -> Instr
TEST (Width -> Format
intFormat Width
ty) (Reg -> Operand
OpReg Reg
x_reg) (Reg -> Operand
OpReg Reg
x_reg)
return (CondCode False cond code)
condIntCode' Platform
platform Cond
cond CmmExpr
x CmmExpr
y
| Platform -> CmmExpr -> Bool
isOperand Platform
platform CmmExpr
y = do
(x_reg, x_code) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
x
(y_op, y_code) <- getOperand y
let
code = InstrBlock
x_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
y_code InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Operand -> Instr
CMP (CmmType -> Format
cmmTypeFormat (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
x)) Operand
y_op (Reg -> Operand
OpReg Reg
x_reg)
return (CondCode False cond code)
| Platform -> CmmExpr -> Bool
isOperand Platform
platform CmmExpr
x
, Just Cond
revcond <- Cond -> Maybe Cond
maybeFlipCond Cond
cond = do
(y_reg, y_code) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
y
(x_op, x_code) <- getOperand x
let
code = InstrBlock
y_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
x_code InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Operand -> Instr
CMP (CmmType -> Format
cmmTypeFormat (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
x)) Operand
x_op (Reg -> Operand
OpReg Reg
y_reg)
return (CondCode False revcond code)
condIntCode' Platform
platform Cond
cond CmmExpr
x CmmExpr
y = do
(y_reg, y_code) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
y
(x_op, x_code) <- getRegOrMem x
let
code = InstrBlock
y_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
x_code InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Operand -> Instr
CMP (CmmType -> Format
cmmTypeFormat (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
x)) (Reg -> Operand
OpReg Reg
y_reg) Operand
x_op
return (CondCode False cond code)
condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
cond CmmExpr
x CmmExpr
y
= NatM CondCode
condFltCode_sse2
where
condFltCode_sse2 :: NatM CondCode
condFltCode_sse2 = do
platform <- NatM Platform
getPlatform
(x_reg, x_code) <- getNonClobberedReg x
(y_op, y_code) <- getOperand y
let
code = InstrBlock
x_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
y_code InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Operand -> Instr
CMP (Width -> Format
floatFormat (Width -> Format) -> Width -> Format
forall a b. (a -> b) -> a -> b
$ Platform -> CmmExpr -> Width
cmmExprWidth Platform
platform CmmExpr
x) Operand
y_op (Reg -> Operand
OpReg Reg
x_reg)
return (CondCode True (condToUnsigned cond) code)
assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignReg_IntCode :: CmmReg -> CmmExpr -> NatM InstrBlock
assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignReg_FltCode :: CmmReg -> CmmExpr -> NatM InstrBlock
assignMem_VecCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignReg_VecCode :: CmmReg -> CmmExpr -> NatM InstrBlock
assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_IntCode Format
ty CmmExpr
addr (CmmMachOp MachOp
op [CmmLoad CmmExpr
addr2 CmmType
_ AlignmentSpec
_,
CmmLit (CmmInt Integer
i Width
_)])
| CmmExpr
addr CmmExpr -> CmmExpr -> Bool
forall a. Eq a => a -> a -> Bool
== CmmExpr
addr2, Format
ty Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
/= Format
II64 Bool -> Bool -> Bool
|| Integer -> Bool
is32BitInteger Integer
i,
Just Format -> Operand -> Operand -> Instr
instr <- MachOp -> Maybe (Format -> Operand -> Operand -> Instr)
check MachOp
op
= do Amode amode code_addr <- CmmExpr -> NatM Amode
getAmode CmmExpr
addr
let code = InstrBlock
code_addr InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Operand -> Instr
instr Format
ty (Imm -> Operand
OpImm (Int -> Imm
ImmInt (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i))) (AddrMode -> Operand
OpAddr AddrMode
amode)
return code
where
check :: MachOp -> Maybe (Format -> Operand -> Operand -> Instr)
check (MO_Add Width
_) = (Format -> Operand -> Operand -> Instr)
-> Maybe (Format -> Operand -> Operand -> Instr)
forall a. a -> Maybe a
Just Format -> Operand -> Operand -> Instr
ADD
check (MO_Sub Width
_) = (Format -> Operand -> Operand -> Instr)
-> Maybe (Format -> Operand -> Operand -> Instr)
forall a. a -> Maybe a
Just Format -> Operand -> Operand -> Instr
SUB
check MachOp
_ = Maybe (Format -> Operand -> Operand -> Instr)
forall a. Maybe a
Nothing
assignMem_IntCode Format
ty CmmExpr
addr CmmExpr
src = do
platform <- NatM Platform
getPlatform
Amode addr code_addr <- getAmode addr
(code_src, op_src) <- get_op_RI platform src
let
code = InstrBlock
code_src InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
code_addr InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Operand -> Instr
MOV Format
ty Operand
op_src (AddrMode -> Operand
OpAddr AddrMode
addr)
return code
where
get_op_RI :: Platform -> CmmExpr -> NatM (InstrBlock,Operand)
get_op_RI :: Platform -> CmmExpr -> NatM (InstrBlock, Operand)
get_op_RI Platform
platform (CmmLit CmmLit
lit) | Platform -> CmmLit -> Bool
is32BitLit Platform
platform CmmLit
lit
= (InstrBlock, Operand) -> NatM (InstrBlock, Operand)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (InstrBlock
forall a. OrdList a
nilOL, Imm -> Operand
OpImm (CmmLit -> Imm
litToImm CmmLit
lit))
get_op_RI Platform
_ CmmExpr
op
= do (reg,code) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
op
return (code, OpReg reg)
assignReg_IntCode :: CmmReg -> CmmExpr -> NatM InstrBlock
assignReg_IntCode CmmReg
reg (CmmLoad CmmExpr
src CmmType
_ AlignmentSpec
_) = do
let ty :: Format
ty = CmmType -> Format
cmmTypeFormat (CmmType -> Format) -> CmmType -> Format
forall a b. (a -> b) -> a -> b
$ CmmReg -> CmmType
cmmRegType CmmReg
reg
load_code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> InstrBlock)
intLoadCode (Format -> Operand -> Operand -> Instr
MOV Format
ty) CmmExpr
src
platform <- ncgPlatform <$> getConfig
return (load_code (getRegisterReg platform reg))
assignReg_IntCode CmmReg
reg CmmExpr
src = do
platform <- NCGConfig -> Platform
ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NatM NCGConfig
getConfig
code <- getAnyReg src
return (code (getRegisterReg platform reg))
assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_FltCode Format
ty CmmExpr
addr CmmExpr
src = do
(src_reg, src_code) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
src
Amode addr addr_code <- getAmode addr
let
code = InstrBlock
src_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
addr_code InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Operand -> Instr
MOV Format
ty (Reg -> Operand
OpReg Reg
src_reg) (AddrMode -> Operand
OpAddr AddrMode
addr)
return code
assignReg_FltCode :: CmmReg -> CmmExpr -> NatM InstrBlock
assignReg_FltCode CmmReg
reg CmmExpr
src = do
src_code <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
src
platform <- ncgPlatform <$> getConfig
return (src_code (getRegisterReg platform reg))
assignMem_VecCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_VecCode Format
ty CmmExpr
addr CmmExpr
src = do
(src_reg, src_code) <- HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock)
CmmExpr -> NatM (Reg, InstrBlock)
getNonClobberedReg CmmExpr
src
Amode addr addr_code <- getAmode addr
config <- getConfig
let
code = InstrBlock
src_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
addr_code InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
HasDebugCallStack =>
NCGConfig -> Format -> Operand -> Operand -> Instr
NCGConfig -> Format -> Operand -> Operand -> Instr
movInstr NCGConfig
config Format
ty (Reg -> Operand
OpReg Reg
src_reg) (AddrMode -> Operand
OpAddr AddrMode
addr)
return code
assignReg_VecCode :: CmmReg -> CmmExpr -> NatM InstrBlock
assignReg_VecCode CmmReg
reg CmmExpr
src = do
platform <- NCGConfig -> Platform
ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NatM NCGConfig
getConfig
src_code <- getAnyReg src
return (src_code (getRegisterReg platform reg))
genJump :: CmmExpr -> [RegWithFormat] -> NatM InstrBlock
genJump :: CmmExpr -> [RegWithFormat] -> NatM InstrBlock
genJump (CmmLoad CmmExpr
mem CmmType
_ AlignmentSpec
_) [RegWithFormat]
regs = do
Amode target code <- CmmExpr -> NatM Amode
getAmode CmmExpr
mem
return (code `snocOL` JMP (OpAddr target) regs)
genJump (CmmLit CmmLit
lit) [RegWithFormat]
regs =
InstrBlock -> NatM InstrBlock
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Operand -> [RegWithFormat] -> Instr
JMP (Imm -> Operand
OpImm (CmmLit -> Imm
litToImm CmmLit
lit)) [RegWithFormat]
regs))
genJump CmmExpr
expr [RegWithFormat]
regs = do
(reg,code) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
expr
return (code `snocOL` JMP (OpReg reg) regs)
genBranch :: BlockId -> InstrBlock
genBranch :: Label -> InstrBlock
genBranch = [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL ([Instr] -> InstrBlock)
-> (Label -> [Instr]) -> Label -> InstrBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> [Instr]
mkJumpInstr
genCondBranch
:: BlockId
-> BlockId
-> BlockId
-> CmmExpr
-> NatM InstrBlock
genCondBranch :: Label -> Label -> Label -> CmmExpr -> NatM InstrBlock
genCondBranch Label
bid Label
id Label
false CmmExpr
expr = do
is32Bit <- NatM Bool
is32BitPlatform
genCondBranch' is32Bit bid id false expr
genCondBranch' :: Bool -> BlockId -> BlockId -> BlockId -> CmmExpr
-> NatM InstrBlock
genCondBranch' :: Bool -> Label -> Label -> Label -> CmmExpr -> NatM InstrBlock
genCondBranch' Bool
_ Label
bid Label
id Label
false CmmExpr
bool = do
CondCode is_float cond cond_code <- CmmExpr -> NatM CondCode
getCondCode CmmExpr
bool
if not is_float
then
return (cond_code `snocOL` JXX cond id `appOL` genBranch false)
else do
let jmpFalse = Label -> InstrBlock
genBranch Label
false
code
= case Cond
cond of
Cond
NE -> InstrBlock
or_unordered
Cond
GU -> InstrBlock
plain_test
Cond
GEU -> InstrBlock
plain_test
Cond
LTT ->
Bool -> SDoc -> InstrBlock -> InstrBlock
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr Bool
False (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Should have been turned into >")
InstrBlock
and_ordered
Cond
LE ->
Bool -> SDoc -> InstrBlock -> InstrBlock
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr Bool
False (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Should have been turned into >=")
InstrBlock
and_ordered
Cond
_ -> InstrBlock
and_ordered
plain_test = Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (
Cond -> Label -> Instr
JXX Cond
cond Label
id
) InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
jmpFalse
or_unordered = [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [
Cond -> Label -> Instr
JXX Cond
cond Label
id,
Cond -> Label -> Instr
JXX Cond
PARITY Label
id
] InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
jmpFalse
and_ordered = [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [
Cond -> Label -> Instr
JXX Cond
PARITY Label
false,
Cond -> Label -> Instr
JXX Cond
cond Label
id,
Cond -> Label -> Instr
JXX Cond
ALWAYS Label
false
]
updateCfgNat (\CFG
cfg -> CFG -> (EdgeWeight -> EdgeWeight) -> Label -> Label -> CFG
adjustEdgeWeight CFG
cfg (EdgeWeight -> EdgeWeight -> EdgeWeight
forall a. Num a => a -> a -> a
+EdgeWeight
3) Label
bid Label
false)
return (cond_code `appOL` code)
genForeignCall
:: ForeignTarget
-> [CmmFormal]
-> [CmmActual]
-> BlockId
-> NatM (InstrBlock, Maybe BlockId)
genForeignCall :: ForeignTarget
-> [LocalReg]
-> [CmmExpr]
-> Label
-> NatM (InstrBlock, Maybe Label)
genForeignCall ForeignTarget
target [LocalReg]
dst [CmmExpr]
args Label
bid = do
case ForeignTarget
target of
PrimTarget CallishMachOp
prim -> Label
-> CallishMachOp
-> [LocalReg]
-> [CmmExpr]
-> NatM (InstrBlock, Maybe Label)
genPrim Label
bid CallishMachOp
prim [LocalReg]
dst [CmmExpr]
args
ForeignTarget CmmExpr
addr ForeignConvention
conv -> (,Maybe Label
forall a. Maybe a
Nothing) (InstrBlock -> (InstrBlock, Maybe Label))
-> NatM InstrBlock -> NatM (InstrBlock, Maybe Label)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Label
-> CmmExpr
-> ForeignConvention
-> [LocalReg]
-> [CmmExpr]
-> NatM InstrBlock
genCCall Label
bid CmmExpr
addr ForeignConvention
conv [LocalReg]
dst [CmmExpr]
args
genPrim
:: BlockId
-> CallishMachOp
-> [CmmFormal]
-> [CmmActual]
-> NatM (InstrBlock, Maybe BlockId)
genPrim :: Label
-> CallishMachOp
-> [LocalReg]
-> [CmmExpr]
-> NatM (InstrBlock, Maybe Label)
genPrim Label
bid (MO_AtomicRMW Width
width AtomicMachOp
amop) [LocalReg
dst] [CmmExpr
addr, CmmExpr
n]
= Label
-> Width
-> AtomicMachOp
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM (InstrBlock, Maybe Label)
genAtomicRMW Label
bid Width
width AtomicMachOp
amop LocalReg
dst CmmExpr
addr CmmExpr
n
genPrim Label
bid (MO_Ctz Width
width) [LocalReg
dst] [CmmExpr
src]
= Label
-> Width -> LocalReg -> CmmExpr -> NatM (InstrBlock, Maybe Label)
genCtz Label
bid Width
width LocalReg
dst CmmExpr
src
genPrim Label
bid CallishMachOp
prim [LocalReg]
dst [CmmExpr]
args
= (,Maybe Label
forall a. Maybe a
Nothing) (InstrBlock -> (InstrBlock, Maybe Label))
-> NatM InstrBlock -> NatM (InstrBlock, Maybe Label)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Label
-> CallishMachOp -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genSimplePrim Label
bid CallishMachOp
prim [LocalReg]
dst [CmmExpr]
args
genSimplePrim
:: BlockId
-> CallishMachOp
-> [CmmFormal]
-> [CmmActual]
-> NatM InstrBlock
genSimplePrim :: Label
-> CallishMachOp -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genSimplePrim Label
bid (MO_Memcpy Int
align) [] [CmmExpr
dst,CmmExpr
src,CmmExpr
n] = Label -> Int -> CmmExpr -> CmmExpr -> CmmExpr -> NatM InstrBlock
genMemCpy Label
bid Int
align CmmExpr
dst CmmExpr
src CmmExpr
n
genSimplePrim Label
bid (MO_Memmove Int
align) [] [CmmExpr
dst,CmmExpr
src,CmmExpr
n] = Label -> Int -> CmmExpr -> CmmExpr -> CmmExpr -> NatM InstrBlock
forall p.
Label -> p -> CmmExpr -> CmmExpr -> CmmExpr -> NatM InstrBlock
genMemMove Label
bid Int
align CmmExpr
dst CmmExpr
src CmmExpr
n
genSimplePrim Label
bid (MO_Memcmp Int
align) [LocalReg
res] [CmmExpr
dst,CmmExpr
src,CmmExpr
n] = Label
-> Int
-> LocalReg
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
forall p.
Label
-> p
-> LocalReg
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genMemCmp Label
bid Int
align LocalReg
res CmmExpr
dst CmmExpr
src CmmExpr
n
genSimplePrim Label
bid (MO_Memset Int
align) [] [CmmExpr
dst,CmmExpr
c,CmmExpr
n] = Label -> Int -> CmmExpr -> CmmExpr -> CmmExpr -> NatM InstrBlock
genMemSet Label
bid Int
align CmmExpr
dst CmmExpr
c CmmExpr
n
genSimplePrim Label
_ CallishMachOp
MO_AcquireFence [] [] = InstrBlock -> NatM InstrBlock
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return InstrBlock
forall a. OrdList a
nilOL
genSimplePrim Label
_ CallishMachOp
MO_ReleaseFence [] [] = InstrBlock -> NatM InstrBlock
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return InstrBlock
forall a. OrdList a
nilOL
genSimplePrim Label
_ CallishMachOp
MO_SeqCstFence [] [] = InstrBlock -> NatM InstrBlock
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (InstrBlock -> NatM InstrBlock) -> InstrBlock -> NatM InstrBlock
forall a b. (a -> b) -> a -> b
$ Instr -> InstrBlock
forall a. a -> OrdList a
unitOL Instr
MFENCE
genSimplePrim Label
_ CallishMachOp
MO_Touch [] [CmmExpr
_] = InstrBlock -> NatM InstrBlock
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return InstrBlock
forall a. OrdList a
nilOL
genSimplePrim Label
_ (MO_Prefetch_Data Int
n) [] [CmmExpr
src] = Int -> CmmExpr -> NatM InstrBlock
genPrefetchData Int
n CmmExpr
src
genSimplePrim Label
_ (MO_BSwap Width
width) [LocalReg
dst] [CmmExpr
src] = Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genByteSwap Width
width LocalReg
dst CmmExpr
src
genSimplePrim Label
bid (MO_BRev Width
width) [LocalReg
dst] [CmmExpr
src] = Label -> Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genBitRev Label
bid Width
width LocalReg
dst CmmExpr
src
genSimplePrim Label
bid (MO_PopCnt Width
width) [LocalReg
dst] [CmmExpr
src] = Label -> Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genPopCnt Label
bid Width
width LocalReg
dst CmmExpr
src
genSimplePrim Label
bid (MO_Pdep Width
width) [LocalReg
dst] [CmmExpr
src,CmmExpr
mask] = Label -> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genPdep Label
bid Width
width LocalReg
dst CmmExpr
src CmmExpr
mask
genSimplePrim Label
bid (MO_Pext Width
width) [LocalReg
dst] [CmmExpr
src,CmmExpr
mask] = Label -> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genPext Label
bid Width
width LocalReg
dst CmmExpr
src CmmExpr
mask
genSimplePrim Label
bid (MO_Clz Width
width) [LocalReg
dst] [CmmExpr
src] = Label -> Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genClz Label
bid Width
width LocalReg
dst CmmExpr
src
genSimplePrim Label
bid (MO_UF_Conv Width
width) [LocalReg
dst] [CmmExpr
src] = Label -> Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genWordToFloat Label
bid Width
width LocalReg
dst CmmExpr
src
genSimplePrim Label
_ (MO_AtomicRead Width
w MemoryOrdering
mo) [LocalReg
dst] [CmmExpr
addr] = Width -> MemoryOrdering -> LocalReg -> CmmExpr -> NatM InstrBlock
genAtomicRead Width
w MemoryOrdering
mo LocalReg
dst CmmExpr
addr
genSimplePrim Label
_ (MO_AtomicWrite Width
w MemoryOrdering
mo) [] [CmmExpr
addr,CmmExpr
val] = Width -> MemoryOrdering -> CmmExpr -> CmmExpr -> NatM InstrBlock
genAtomicWrite Width
w MemoryOrdering
mo CmmExpr
addr CmmExpr
val
genSimplePrim Label
bid (MO_Cmpxchg Width
width) [LocalReg
dst] [CmmExpr
addr,CmmExpr
old,CmmExpr
new] = Label
-> Width
-> LocalReg
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genCmpXchg Label
bid Width
width LocalReg
dst CmmExpr
addr CmmExpr
old CmmExpr
new
genSimplePrim Label
_ (MO_Xchg Width
width) [LocalReg
dst] [CmmExpr
addr, CmmExpr
value] = Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genXchg Width
width LocalReg
dst CmmExpr
addr CmmExpr
value
genSimplePrim Label
_ (MO_AddWordC Width
w) [LocalReg
r,LocalReg
c] [CmmExpr
x,CmmExpr
y] = Width
-> (Format -> Operand -> Operand -> Instr)
-> (Format -> Maybe (Operand -> Operand -> Instr))
-> Cond
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genAddSubRetCarry Width
w Format -> Operand -> Operand -> Instr
ADD_CC (Maybe (Operand -> Operand -> Instr)
-> Format -> Maybe (Operand -> Operand -> Instr)
forall a b. a -> b -> a
const Maybe (Operand -> Operand -> Instr)
forall a. Maybe a
Nothing) Cond
CARRY LocalReg
r LocalReg
c CmmExpr
x CmmExpr
y
genSimplePrim Label
_ (MO_SubWordC Width
w) [LocalReg
r,LocalReg
c] [CmmExpr
x,CmmExpr
y] = Width
-> (Format -> Operand -> Operand -> Instr)
-> (Format -> Maybe (Operand -> Operand -> Instr))
-> Cond
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genAddSubRetCarry Width
w Format -> Operand -> Operand -> Instr
SUB_CC (Maybe (Operand -> Operand -> Instr)
-> Format -> Maybe (Operand -> Operand -> Instr)
forall a b. a -> b -> a
const Maybe (Operand -> Operand -> Instr)
forall a. Maybe a
Nothing) Cond
CARRY LocalReg
r LocalReg
c CmmExpr
x CmmExpr
y
genSimplePrim Label
_ (MO_AddIntC Width
w) [LocalReg
r,LocalReg
c] [CmmExpr
x,CmmExpr
y] = Width
-> (Format -> Operand -> Operand -> Instr)
-> (Format -> Maybe (Operand -> Operand -> Instr))
-> Cond
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genAddSubRetCarry Width
w Format -> Operand -> Operand -> Instr
ADD_CC ((Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
forall a. a -> Maybe a
Just ((Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr))
-> (Format -> Operand -> Operand -> Instr)
-> Format
-> Maybe (Operand -> Operand -> Instr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Operand -> Operand -> Instr
ADD_CC) Cond
OFLO LocalReg
r LocalReg
c CmmExpr
x CmmExpr
y
genSimplePrim Label
_ (MO_SubIntC Width
w) [LocalReg
r,LocalReg
c] [CmmExpr
x,CmmExpr
y] = Width
-> (Format -> Operand -> Operand -> Instr)
-> (Format -> Maybe (Operand -> Operand -> Instr))
-> Cond
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genAddSubRetCarry Width
w Format -> Operand -> Operand -> Instr
SUB_CC (Maybe (Operand -> Operand -> Instr)
-> Format -> Maybe (Operand -> Operand -> Instr)
forall a b. a -> b -> a
const Maybe (Operand -> Operand -> Instr)
forall a. Maybe a
Nothing) Cond
OFLO LocalReg
r LocalReg
c CmmExpr
x CmmExpr
y
genSimplePrim Label
_ (MO_Add2 Width
w) [LocalReg
h,LocalReg
l] [CmmExpr
x,CmmExpr
y] = Width
-> LocalReg -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genAddWithCarry Width
w LocalReg
h LocalReg
l CmmExpr
x CmmExpr
y
genSimplePrim Label
_ (MO_U_Mul2 Width
w) [LocalReg
h,LocalReg
l] [CmmExpr
x,CmmExpr
y] = Width
-> LocalReg -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genUnsignedLargeMul Width
w LocalReg
h LocalReg
l CmmExpr
x CmmExpr
y
genSimplePrim Label
_ (MO_S_Mul2 Width
w) [LocalReg
c,LocalReg
h,LocalReg
l] [CmmExpr
x,CmmExpr
y] = Width
-> LocalReg
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genSignedLargeMul Width
w LocalReg
c LocalReg
h LocalReg
l CmmExpr
x CmmExpr
y
genSimplePrim Label
_ (MO_S_QuotRem Width
w) [LocalReg
q,LocalReg
r] [CmmExpr
x,CmmExpr
y] = Width
-> Bool
-> LocalReg
-> LocalReg
-> Maybe CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genQuotRem Width
w Bool
True LocalReg
q LocalReg
r Maybe CmmExpr
forall a. Maybe a
Nothing CmmExpr
x CmmExpr
y
genSimplePrim Label
_ (MO_U_QuotRem Width
w) [LocalReg
q,LocalReg
r] [CmmExpr
x,CmmExpr
y] = Width
-> Bool
-> LocalReg
-> LocalReg
-> Maybe CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genQuotRem Width
w Bool
False LocalReg
q LocalReg
r Maybe CmmExpr
forall a. Maybe a
Nothing CmmExpr
x CmmExpr
y
genSimplePrim Label
_ (MO_U_QuotRem2 Width
w) [LocalReg
q,LocalReg
r] [CmmExpr
hx,CmmExpr
lx,CmmExpr
y] = Width
-> Bool
-> LocalReg
-> LocalReg
-> Maybe CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genQuotRem Width
w Bool
False LocalReg
q LocalReg
r (CmmExpr -> Maybe CmmExpr
forall a. a -> Maybe a
Just CmmExpr
hx) CmmExpr
lx CmmExpr
y
genSimplePrim Label
_ CallishMachOp
MO_F32_Fabs [LocalReg
dst] [CmmExpr
src] = Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genFloatAbs Width
W32 LocalReg
dst CmmExpr
src
genSimplePrim Label
_ CallishMachOp
MO_F64_Fabs [LocalReg
dst] [CmmExpr
src] = Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genFloatAbs Width
W64 LocalReg
dst CmmExpr
src
genSimplePrim Label
_ CallishMachOp
MO_F32_Sqrt [LocalReg
dst] [CmmExpr
src] = Format -> LocalReg -> CmmExpr -> NatM InstrBlock
genFloatSqrt Format
FF32 LocalReg
dst CmmExpr
src
genSimplePrim Label
_ CallishMachOp
MO_F64_Sqrt [LocalReg
dst] [CmmExpr
src] = Format -> LocalReg -> CmmExpr -> NatM InstrBlock
genFloatSqrt Format
FF64 LocalReg
dst CmmExpr
src
genSimplePrim Label
bid CallishMachOp
MO_F32_Sin [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"sinf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Cos [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"cosf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Tan [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"tanf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Exp [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"expf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_ExpM1 [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"expm1f") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Log [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"logf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Log1P [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"log1pf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Asin [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"asinf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Acos [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"acosf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Atan [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"atanf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Sinh [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"sinhf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Cosh [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"coshf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Tanh [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"tanhf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Pwr [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"powf") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid CallishMachOp
MO_F32_Asinh [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"asinhf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Acosh [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"acoshf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F32_Atanh [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"atanhf") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Sin [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"sin") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Cos [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"cos") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Tan [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"tan") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Exp [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"exp") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_ExpM1 [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"expm1") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Log [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"log") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Log1P [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"log1p") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Asin [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"asin") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Acos [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"acos") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Atan [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"atan") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Sinh [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"sinh") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Cosh [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"cosh") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Tanh [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"tanh") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Pwr [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"pow") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid CallishMachOp
MO_F64_Asinh [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"asinh") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Acosh [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"acosh") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_F64_Atanh [LocalReg
dst] [CmmExpr
src] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"atanh") [LocalReg
dst] [CmmExpr
src]
genSimplePrim Label
bid CallishMachOp
MO_SuspendThread [LocalReg
tok] [CmmExpr
rs,CmmExpr
i] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genRTSCCall Label
bid (String -> FastString
fsLit String
"suspendThread") [LocalReg
tok] [CmmExpr
rs,CmmExpr
i]
genSimplePrim Label
bid CallishMachOp
MO_ResumeThread [LocalReg
rs] [CmmExpr
tok] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genRTSCCall Label
bid (String -> FastString
fsLit String
"resumeThread") [LocalReg
rs] [CmmExpr
tok]
genSimplePrim Label
bid CallishMachOp
MO_I64_Quot [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_quotInt64") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid CallishMachOp
MO_I64_Rem [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_remInt64") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid CallishMachOp
MO_W64_Quot [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_quotWord64") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid CallishMachOp
MO_W64_Rem [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_remWord64") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid (MO_VS_Quot Int
16 Width
W8) [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_quotInt8X16") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid (MO_VS_Quot Int
8 Width
W16) [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_quotInt16X8") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid (MO_VS_Quot Int
4 Width
W32) [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_quotInt32X4") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid (MO_VS_Quot Int
2 Width
W64) [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_quotInt64X2") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
_ op :: CallishMachOp
op@(MO_VS_Quot {}) [LocalReg]
_ [CmmExpr]
_ = String -> SDoc -> NatM InstrBlock
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Unsupported vector instruction for the native code generator:" (CallishMachOp -> SDoc
pprCallishMachOp CallishMachOp
op)
genSimplePrim Label
bid (MO_VS_Rem Int
16 Width
W8) [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_remInt8X16") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid (MO_VS_Rem Int
8 Width
W16) [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_remInt16X8") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid (MO_VS_Rem Int
4 Width
W32) [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_remInt32X4") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid (MO_VS_Rem Int
2 Width
W64) [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_remInt64X2") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
_ op :: CallishMachOp
op@(MO_VS_Rem {}) [LocalReg]
_ [CmmExpr]
_ = String -> SDoc -> NatM InstrBlock
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Unsupported vector instruction for the native code generator:" (CallishMachOp -> SDoc
pprCallishMachOp CallishMachOp
op)
genSimplePrim Label
bid (MO_VU_Quot Int
16 Width
W8) [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_quotWord8X16") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid (MO_VU_Quot Int
8 Width
W16) [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_quotWord16X8") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid (MO_VU_Quot Int
4 Width
W32) [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_quotWord32X4") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid (MO_VU_Quot Int
2 Width
W64) [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_quotWord64X2") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
_ op :: CallishMachOp
op@(MO_VU_Quot {}) [LocalReg]
_ [CmmExpr]
_ = String -> SDoc -> NatM InstrBlock
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Unsupported vector instruction for the native code generator:" (CallishMachOp -> SDoc
pprCallishMachOp CallishMachOp
op)
genSimplePrim Label
bid (MO_VU_Rem Int
16 Width
W8) [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_remWord8X16") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid (MO_VU_Rem Int
8 Width
W16) [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_remWord16X8") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid (MO_VU_Rem Int
4 Width
W32) [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_remWord32X4") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid (MO_VU_Rem Int
2 Width
W64) [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_remWord64X2") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
_ op :: CallishMachOp
op@(MO_VU_Rem {}) [LocalReg]
_ [CmmExpr]
_ = String -> SDoc -> NatM InstrBlock
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Unsupported vector instruction for the native code generator:" (CallishMachOp -> SDoc
pprCallishMachOp CallishMachOp
op)
genSimplePrim Label
bid CallishMachOp
MO_I64X2_Min [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_minInt64X2") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid CallishMachOp
MO_I64X2_Max [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_maxInt64X2") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid CallishMachOp
MO_W64X2_Min [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_minWord64X2") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
bid CallishMachOp
MO_W64X2_Max [LocalReg
dst] [CmmExpr
x,CmmExpr
y] = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (String -> FastString
fsLit String
"hs_maxWord64X2") [LocalReg
dst] [CmmExpr
x,CmmExpr
y]
genSimplePrim Label
_ CallishMachOp
op [LocalReg]
dst [CmmExpr]
args = do
platform <- NCGConfig -> Platform
ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NatM NCGConfig
getConfig
pprPanic "genSimplePrim: unhandled primop" (ppr (pprCallishMachOp op, dst, fmap (pdoc platform) args))
evalArgs :: BlockId -> [CmmActual] -> NatM (InstrBlock, [CmmActual])
evalArgs :: Label -> [CmmExpr] -> NatM (InstrBlock, [CmmExpr])
evalArgs Label
bid [CmmExpr]
actuals
| (CmmExpr -> Bool) -> [CmmExpr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any CmmExpr -> Bool
loadIntoRegMightClobberOtherReg [CmmExpr]
actuals = do
regs_blks <- (CmmExpr -> NatM (InstrBlock, CmmExpr))
-> [CmmExpr] -> NatM [(InstrBlock, CmmExpr)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CmmExpr -> NatM (InstrBlock, CmmExpr)
evalArg [CmmExpr]
actuals
return (concatOL $ map fst regs_blks, map snd regs_blks)
| Bool
otherwise = (InstrBlock, [CmmExpr]) -> NatM (InstrBlock, [CmmExpr])
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (InstrBlock
forall a. OrdList a
nilOL, [CmmExpr]
actuals)
where
evalArg :: CmmActual -> NatM (InstrBlock, CmmExpr)
evalArg :: CmmExpr -> NatM (InstrBlock, CmmExpr)
evalArg CmmExpr
actual = do
platform <- NatM Platform
getPlatform
lreg <- newLocalReg $ cmmExprType platform actual
(instrs, bid1) <- stmtToInstrs bid $ CmmAssign (CmmLocal lreg) actual
massert (isNothing bid1)
return (instrs, CmmReg $ CmmLocal lreg)
newLocalReg :: CmmType -> NatM LocalReg
newLocalReg :: CmmType -> NatM LocalReg
newLocalReg CmmType
ty = Unique -> CmmType -> LocalReg
LocalReg (Unique -> CmmType -> LocalReg)
-> NatM Unique -> NatM (CmmType -> LocalReg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NatM Unique
forall (m :: * -> *). MonadGetUnique m => m Unique
getUniqueM NatM (CmmType -> LocalReg) -> NatM CmmType -> NatM LocalReg
forall a b. NatM (a -> b) -> NatM a -> NatM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CmmType -> NatM CmmType
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CmmType
ty
loadIntoRegMightClobberOtherReg :: CmmExpr -> Bool
loadIntoRegMightClobberOtherReg :: CmmExpr -> Bool
loadIntoRegMightClobberOtherReg (CmmReg CmmReg
_) = Bool
False
loadIntoRegMightClobberOtherReg (CmmRegOff CmmReg
_ Int
_) = Bool
False
loadIntoRegMightClobberOtherReg (CmmLit CmmLit
_) = Bool
False
loadIntoRegMightClobberOtherReg CmmExpr
_ = Bool
True
genPrimCCall
:: BlockId
-> FastString
-> [CmmFormal]
-> [CmmActual]
-> NatM InstrBlock
genPrimCCall :: Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid FastString
lbl_txt [LocalReg]
dsts [CmmExpr]
args = do
config <- NatM NCGConfig
getConfig
let lbl = UnitId -> FastString -> CLabel
mkCmmCodeLabel UnitId
ghcInternalUnitId FastString
lbl_txt
addr <- cmmMakeDynamicReference config CallReference lbl
let conv = CCallConv
-> [ForeignHint]
-> [ForeignHint]
-> CmmReturnInfo
-> ForeignConvention
ForeignConvention CCallConv
CCallConv [] [] CmmReturnInfo
CmmMayReturn
genCCall bid addr conv dsts args
genLibCCall
:: BlockId
-> FastString
-> [CmmFormal]
-> [CmmActual]
-> NatM InstrBlock
genLibCCall :: Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid FastString
lbl_txt [LocalReg]
dsts [CmmExpr]
args = do
config <- NatM NCGConfig
getConfig
let lbl = FastString -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel FastString
lbl_txt ForeignLabelSource
ForeignLabelInThisPackage FunctionOrData
IsFunction
addr <- cmmMakeDynamicReference config CallReference lbl
let conv = CCallConv
-> [ForeignHint]
-> [ForeignHint]
-> CmmReturnInfo
-> ForeignConvention
ForeignConvention CCallConv
CCallConv [] [] CmmReturnInfo
CmmMayReturn
genCCall bid addr conv dsts args
genRTSCCall
:: BlockId
-> FastString
-> [CmmFormal]
-> [CmmActual]
-> NatM InstrBlock
genRTSCCall :: Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genRTSCCall Label
bid FastString
lbl_txt [LocalReg]
dsts [CmmExpr]
args = do
config <- NatM NCGConfig
getConfig
let lbl = FastString -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel FastString
lbl_txt ForeignLabelSource
ForeignLabelInThisPackage FunctionOrData
IsFunction
addr <- cmmMakeDynamicReference config CallReference lbl
let conv = CCallConv
-> [ForeignHint]
-> [ForeignHint]
-> CmmReturnInfo
-> ForeignConvention
ForeignConvention CCallConv
CCallConv [] [] CmmReturnInfo
CmmMayReturn
genCCall bid addr conv dsts args
genCCall
:: BlockId
-> CmmExpr
-> ForeignConvention
-> [CmmFormal]
-> [CmmActual]
-> NatM InstrBlock
genCCall :: Label
-> CmmExpr
-> ForeignConvention
-> [LocalReg]
-> [CmmExpr]
-> NatM InstrBlock
genCCall Label
bid CmmExpr
addr conv :: ForeignConvention
conv@(ForeignConvention CCallConv
_ [ForeignHint]
argHints [ForeignHint]
_ CmmReturnInfo
_) [LocalReg]
dest_regs [CmmExpr]
args = do
platform <- NatM Platform
getPlatform
is32Bit <- is32BitPlatform
let args_hints = [CmmExpr] -> [ForeignHint] -> [(CmmExpr, ForeignHint)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CmmExpr]
args ([ForeignHint]
argHints [ForeignHint] -> [ForeignHint] -> [ForeignHint]
forall a. [a] -> [a] -> [a]
++ ForeignHint -> [ForeignHint]
forall a. a -> [a]
repeat ForeignHint
NoHint)
prom_args = ((CmmExpr, ForeignHint) -> CmmExpr)
-> [(CmmExpr, ForeignHint)] -> [CmmExpr]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> (CmmExpr, ForeignHint) -> CmmExpr
maybePromoteCArgToW32 Platform
platform) [(CmmExpr, ForeignHint)]
args_hints
(instrs0, args') <- evalArgs bid prom_args
instrs1 <- if is32Bit
then genCCall32 addr conv dest_regs args'
else genCCall64 addr conv dest_regs args'
return (instrs0 `appOL` instrs1)
maybePromoteCArgToW32 :: Platform -> (CmmExpr, ForeignHint) -> CmmExpr
maybePromoteCArgToW32 :: Platform -> (CmmExpr, ForeignHint) -> CmmExpr
maybePromoteCArgToW32 Platform
platform (CmmExpr
arg, ForeignHint
hint)
| Width
wfrom Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
< Width
wto =
case ForeignHint
hint of
ForeignHint
SignedHint -> MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> Width -> MachOp
MO_SS_Conv Width
wfrom Width
wto) [CmmExpr
arg]
ForeignHint
_ -> MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> Width -> MachOp
MO_UU_Conv Width
wfrom Width
wto) [CmmExpr
arg]
| Bool
otherwise = CmmExpr
arg
where
ty :: CmmType
ty = Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
arg
wfrom :: Width
wfrom = CmmType -> Width
typeWidth CmmType
ty
wto :: Width
wto = Width
W32
genCCall32 :: CmmExpr
-> ForeignConvention
-> [CmmFormal]
-> [CmmActual]
-> NatM InstrBlock
genCCall32 :: CmmExpr
-> ForeignConvention -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genCCall32 CmmExpr
addr ForeignConvention
_conv [LocalReg]
dest_regs [CmmExpr]
args = do
config <- NatM NCGConfig
getConfig
let platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
arg_size_bytes :: CmmType -> Int
arg_size_bytes CmmType
ty = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Width -> Int
widthInBytes (CmmType -> Width
typeWidth CmmType
ty)) (Width -> Int
widthInBytes (Platform -> Width
wordWidth Platform
platform))
roundTo a
a a
x | a
x a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = a
x
| Bool
otherwise = a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
a a -> a -> a
forall a. Num a => a -> a -> a
- (a
x a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
a)
push_arg :: CmmActual
-> NatM InstrBlock
push_arg CmmExpr
arg
| CmmType -> Bool
isWord64 CmmType
arg_ty = do
RegCode64 code r_hi r_lo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
arg
delta <- getDeltaNat
setDeltaNat (delta - 8)
return ( code `appOL`
toOL [PUSH II32 (OpReg r_hi), DELTA (delta - 4),
PUSH II32 (OpReg r_lo), DELTA (delta - 8),
DELTA (delta-8)]
)
| CmmType -> Bool
isFloatType CmmType
arg_ty Bool -> Bool -> Bool
|| CmmType -> Bool
isVecType CmmType
arg_ty = do
(reg, code) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
arg
delta <- getDeltaNat
setDeltaNat (delta-size)
return (code `appOL`
toOL [SUB II32 (OpImm (ImmInt size)) (OpReg esp),
DELTA (delta-size),
let addr = EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
esp)
EAIndex
EAIndexNone
(Int -> Imm
ImmInt Int
0)
format = CmmType -> Format
cmmTypeFormat CmmType
arg_ty
in
movInstr config format (OpReg reg) (OpAddr addr)
]
)
| Bool
otherwise = do
Bool -> NatM ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert ((CmmType -> Width
typeWidth CmmType
arg_ty) Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
<= Width
W32)
(operand, code) <- CmmExpr -> NatM (Operand, InstrBlock)
getOperand CmmExpr
arg
delta <- getDeltaNat
setDeltaNat (delta-size)
return (code `snocOL`
PUSH II32 operand `snocOL`
DELTA (delta-size))
where
arg_ty :: CmmType
arg_ty = Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
arg
size :: Int
size = CmmType -> Int
arg_size_bytes CmmType
arg_ty
let
sizes = (CmmExpr -> Int) -> [CmmExpr] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (CmmType -> Int
arg_size_bytes (CmmType -> Int) -> (CmmExpr -> CmmType) -> CmmExpr -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform) ([CmmExpr] -> [CmmExpr]
forall a. [a] -> [a]
reverse [CmmExpr]
args)
raw_arg_size = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
sizes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Platform -> Int
platformWordSizeInBytes Platform
platform
arg_pad_size = (Int -> Int -> Int
forall a. Integral a => a -> a -> a
roundTo Int
16 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
raw_arg_size) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
raw_arg_size
tot_arg_size = Int
raw_arg_size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
arg_pad_size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Platform -> Int
platformWordSizeInBytes Platform
platform
delta0 <- getDeltaNat
setDeltaNat (delta0 - arg_pad_size)
push_codes <- mapM push_arg (reverse args)
delta <- getDeltaNat
massert (delta == delta0 - tot_arg_size)
callinsns <-
case addr of
CmmLit (CmmLabel CLabel
lbl)
-> InstrBlock -> NatM InstrBlock
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (InstrBlock -> NatM InstrBlock) -> InstrBlock -> NatM InstrBlock
forall a b. (a -> b) -> a -> b
$ Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Either Imm Reg -> [RegWithFormat] -> Instr
CALL (Imm -> Either Imm Reg
forall a b. a -> Either a b
Left Imm
fn_imm) [])
where fn_imm :: Imm
fn_imm = CLabel -> Imm
ImmCLbl CLabel
lbl
CmmExpr
_
-> do { (dyn_r, dyn_c) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
addr
; massert (isWord32 (cmmExprType platform addr))
; return $ dyn_c `snocOL` CALL (Right dyn_r) [] }
let push_code
| Int
arg_pad_size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
= [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [Format -> Operand -> Operand -> Instr
SUB Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
arg_pad_size)) (Reg -> Operand
OpReg Reg
esp),
Int -> Instr
DELTA (Int
delta0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
arg_pad_size)]
InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [InstrBlock] -> InstrBlock
forall a. [OrdList a] -> OrdList a
concatOL [InstrBlock]
push_codes
| Bool
otherwise
= [InstrBlock] -> InstrBlock
forall a. [OrdList a] -> OrdList a
concatOL [InstrBlock]
push_codes
call = InstrBlock
callinsns InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL (
(if Int
tot_arg_size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then [] else
[Format -> Operand -> Operand -> Instr
ADD Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
tot_arg_size)) (Reg -> Operand
OpReg Reg
esp)])
[Instr] -> [Instr] -> [Instr]
forall a. [a] -> [a] -> [a]
++
[Int -> Instr
DELTA Int
delta0]
)
setDeltaNat delta0
let
assign_code [] = InstrBlock
forall a. OrdList a
nilOL
assign_code [LocalReg
dest]
| CmmType -> Bool
isVecType CmmType
ty
= Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (HasDebugCallStack => NCGConfig -> Format -> Reg -> Reg -> Instr
NCGConfig -> Format -> Reg -> Reg -> Instr
mkRegRegMoveInstr NCGConfig
config (CmmType -> Format
cmmTypeFormat CmmType
ty) Reg
xmm0 Reg
r_dest)
| CmmType -> Bool
isFloatType CmmType
ty =
let tmp_amode :: AddrMode
tmp_amode = EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
esp)
EAIndex
EAIndexNone
(Int -> Imm
ImmInt Int
0)
fmt :: Format
fmt = Width -> Format
floatFormat Width
w
in [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Operand -> Instr
SUB Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
b)) (Reg -> Operand
OpReg Reg
esp),
Int -> Instr
DELTA (Int
delta0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
b),
Format -> AddrMode -> Instr
X87Store Format
fmt AddrMode
tmp_amode,
Format -> Operand -> Operand -> Instr
MOV Format
fmt (AddrMode -> Operand
OpAddr AddrMode
tmp_amode) (Reg -> Operand
OpReg Reg
r_dest),
Format -> Operand -> Operand -> Instr
ADD Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
b)) (Reg -> Operand
OpReg Reg
esp),
Int -> Instr
DELTA Int
delta0]
| CmmType -> Bool
isWord64 CmmType
ty = [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
eax) (Reg -> Operand
OpReg Reg
r_dest),
Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
edx) (Reg -> Operand
OpReg Reg
r_dest_hi)]
| Bool
otherwise = Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV (Width -> Format
intFormat Width
w)
(Reg -> Operand
OpReg Reg
eax)
(Reg -> Operand
OpReg Reg
r_dest))
where
ty :: CmmType
ty = LocalReg -> CmmType
localRegType LocalReg
dest
w :: Width
w = CmmType -> Width
typeWidth CmmType
ty
b :: Int
b = Width -> Int
widthInBytes Width
w
r_dest_hi :: Reg
r_dest_hi = Reg -> Reg
getHiVRegFromLo Reg
r_dest
r_dest :: Reg
r_dest = LocalReg -> Reg
getLocalRegReg LocalReg
dest
assign_code [LocalReg]
many = String -> SDoc -> InstrBlock
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"genForeignCall.assign_code - too many return values:" ([LocalReg] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [LocalReg]
many)
return (push_code `appOL`
call `appOL`
assign_code dest_regs)
genCCall64 :: CmmExpr
-> ForeignConvention
-> [CmmFormal]
-> [CmmActual]
-> NatM InstrBlock
genCCall64 :: CmmExpr
-> ForeignConvention -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genCCall64 CmmExpr
addr ForeignConvention
conv [LocalReg]
dest_regs [CmmExpr]
args = do
config <- NatM NCGConfig
getConfig
let platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
word_size = Platform -> Int
platformWordSizeInBytes Platform
platform
wordFmt = Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)
LoadArgs
{ stackArgs = proper_stack_args
, stackDataArgs = stack_data_args
, usedRegs = arg_regs_used
, assignArgsCode = assign_args_code
}
<- loadArgs config args
let
(stk_args_with_padding, args_aligned_16) =
padStackArgs platform (proper_stack_args, stack_data_args)
need_realign_call = Bool
args_aligned_16
align_call_code <-
if need_realign_call
then addStackPadding word_size
else return nilOL
(load_data_refs, push_code) <-
pushArgs config proper_stack_args stk_args_with_padding
let shadow_space =
if Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32
then Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* [(Reg, Reg)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Platform -> [(Reg, Reg)]
allArgRegs Platform
platform)
else Int
0
shadow_space_code <- addStackPadding shadow_space
let total_args_size
= Int
shadow_space
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((StackArg -> Int) -> [StackArg] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> StackArg -> Int
stackArgSpace Platform
platform) [StackArg]
stk_args_with_padding)
real_size =
Int
total_args_size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Bool
need_realign_call then Int
word_size else Int
0
delta <- getDeltaNat
let
nb_sse_regs_used = (RegWithFormat -> Bool) -> [RegWithFormat] -> Int
forall a. (a -> Bool) -> [a] -> Int
count (Format -> Bool
isFloatFormat (Format -> Bool)
-> (RegWithFormat -> Format) -> RegWithFormat -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegWithFormat -> Format
regWithFormat_format) [RegWithFormat]
arg_regs_used
assign_eax_sse_regs
= Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
nb_sse_regs_used)) (Reg -> Operand
OpReg Reg
eax))
arg_regs = [Reg -> Format -> RegWithFormat
RegWithFormat Reg
eax Format
wordFmt] [RegWithFormat] -> [RegWithFormat] -> [RegWithFormat]
forall a. [a] -> [a] -> [a]
++ [RegWithFormat]
arg_regs_used
(callinsns,_cconv) <- case addr of
CmmLit (CmmLabel CLabel
lbl) ->
(InstrBlock, ForeignConvention)
-> NatM (InstrBlock, ForeignConvention)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Either Imm Reg -> [RegWithFormat] -> Instr
CALL (Imm -> Either Imm Reg
forall a b. a -> Either a b
Left (CLabel -> Imm
ImmCLbl CLabel
lbl)) [RegWithFormat]
arg_regs), ForeignConvention
conv)
CmmExpr
_ -> do
(dyn_r, dyn_c) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
addr
return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv)
let call = InstrBlock
callinsns InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL (
(if Int
real_sizeInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0 then [] else
[Format -> Operand -> Operand -> Instr
ADD (Width -> Format
intFormat (Platform -> Width
platformWordWidth Platform
platform)) (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
real_size)) (Reg -> Operand
OpReg Reg
esp)])
[Instr] -> [Instr] -> [Instr]
forall a. [a] -> [a] -> [a]
++
[Int -> Instr
DELTA (Int
delta Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
real_size)]
)
setDeltaNat (delta + real_size)
let
assign_code [] = InstrBlock
forall a. OrdList a
nilOL
assign_code [LocalReg
dest] =
Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Instr -> InstrBlock) -> Instr -> InstrBlock
forall a b. (a -> b) -> a -> b
$
HasDebugCallStack => NCGConfig -> Format -> Reg -> Reg -> Instr
NCGConfig -> Format -> Reg -> Reg -> Instr
mkRegRegMoveInstr NCGConfig
config Format
fmt Reg
reg Reg
r_dest
where
reg :: Reg
reg = if Format -> Bool
isIntFormat Format
fmt then Reg
rax else Reg
xmm0
fmt :: Format
fmt = CmmType -> Format
cmmTypeFormat CmmType
rep
rep :: CmmType
rep = LocalReg -> CmmType
localRegType LocalReg
dest
r_dest :: Reg
r_dest = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (LocalReg -> CmmReg
CmmLocal LocalReg
dest)
assign_code [LocalReg]
_many = String -> InstrBlock
forall a. HasCallStack => String -> a
panic String
"genForeignCall.assign_code many"
return (align_call_code `appOL`
push_code `appOL`
assign_args_code `appOL`
load_data_refs `appOL`
shadow_space_code `appOL`
assign_eax_sse_regs `appOL`
call `appOL`
assign_code dest_regs)
data LoadArgs
= LoadArgs
{ LoadArgs -> [RawStackArg]
stackArgs :: [RawStackArg]
, LoadArgs -> [CmmExpr]
stackDataArgs :: [CmmExpr]
, LoadArgs -> [RegWithFormat]
usedRegs :: [RegWithFormat]
, LoadArgs -> InstrBlock
assignArgsCode :: InstrBlock
}
instance Semigroup LoadArgs where
LoadArgs [RawStackArg]
a1 [CmmExpr]
d1 [RegWithFormat]
r1 InstrBlock
j1 <> :: LoadArgs -> LoadArgs -> LoadArgs
<> LoadArgs [RawStackArg]
a2 [CmmExpr]
d2 [RegWithFormat]
r2 InstrBlock
j2
= [RawStackArg]
-> [CmmExpr] -> [RegWithFormat] -> InstrBlock -> LoadArgs
LoadArgs ([RawStackArg]
a1 [RawStackArg] -> [RawStackArg] -> [RawStackArg]
forall a. [a] -> [a] -> [a]
++ [RawStackArg]
a2) ([CmmExpr]
d1 [CmmExpr] -> [CmmExpr] -> [CmmExpr]
forall a. [a] -> [a] -> [a]
++ [CmmExpr]
d2) ([RegWithFormat]
r1 [RegWithFormat] -> [RegWithFormat] -> [RegWithFormat]
forall a. [a] -> [a] -> [a]
++ [RegWithFormat]
r2) (InstrBlock
j1 InstrBlock -> InstrBlock -> InstrBlock
forall a. Semigroup a => a -> a -> a
S.<> InstrBlock
j2)
instance Monoid LoadArgs where
mempty :: LoadArgs
mempty = [RawStackArg]
-> [CmmExpr] -> [RegWithFormat] -> InstrBlock -> LoadArgs
LoadArgs [] [] [] InstrBlock
forall a. OrdList a
nilOL
data RawStackArg
= RawStackArg { RawStackArg -> CmmExpr
stackArgExpr :: CmmExpr }
| RawStackArgRef
{ RawStackArg -> StackRef
stackRef :: StackRef
, RawStackArg -> Int
stackRefArgSize :: Int
}
deriving ( Int -> RawStackArg -> String -> String
[RawStackArg] -> String -> String
RawStackArg -> String
(Int -> RawStackArg -> String -> String)
-> (RawStackArg -> String)
-> ([RawStackArg] -> String -> String)
-> Show RawStackArg
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> RawStackArg -> String -> String
showsPrec :: Int -> RawStackArg -> String -> String
$cshow :: RawStackArg -> String
show :: RawStackArg -> String
$cshowList :: [RawStackArg] -> String -> String
showList :: [RawStackArg] -> String -> String
Show )
data StackArg
= StackArg
{ StackArg -> CmmExpr
stackArgExpr :: CmmExpr
, StackArg -> Int
stackArgPadding :: Int
}
| StackArgRef
{ StackArg -> StackRef
stackRef :: StackRef
, StackArg -> Int
stackRefArgSize :: Int
, StackArg -> Int
stackRefArgPadding :: Int
}
deriving ( Int -> StackArg -> String -> String
[StackArg] -> String -> String
StackArg -> String
(Int -> StackArg -> String -> String)
-> (StackArg -> String)
-> ([StackArg] -> String -> String)
-> Show StackArg
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> StackArg -> String -> String
showsPrec :: Int -> StackArg -> String -> String
$cshow :: StackArg -> String
show :: StackArg -> String
$cshowList :: [StackArg] -> String -> String
showList :: [StackArg] -> String -> String
Show )
data StackRef
= InReg Reg
| OnStack
deriving ( StackRef -> StackRef -> Bool
(StackRef -> StackRef -> Bool)
-> (StackRef -> StackRef -> Bool) -> Eq StackRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StackRef -> StackRef -> Bool
== :: StackRef -> StackRef -> Bool
$c/= :: StackRef -> StackRef -> Bool
/= :: StackRef -> StackRef -> Bool
Eq, Eq StackRef
Eq StackRef =>
(StackRef -> StackRef -> Ordering)
-> (StackRef -> StackRef -> Bool)
-> (StackRef -> StackRef -> Bool)
-> (StackRef -> StackRef -> Bool)
-> (StackRef -> StackRef -> Bool)
-> (StackRef -> StackRef -> StackRef)
-> (StackRef -> StackRef -> StackRef)
-> Ord StackRef
StackRef -> StackRef -> Bool
StackRef -> StackRef -> Ordering
StackRef -> StackRef -> StackRef
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StackRef -> StackRef -> Ordering
compare :: StackRef -> StackRef -> Ordering
$c< :: StackRef -> StackRef -> Bool
< :: StackRef -> StackRef -> Bool
$c<= :: StackRef -> StackRef -> Bool
<= :: StackRef -> StackRef -> Bool
$c> :: StackRef -> StackRef -> Bool
> :: StackRef -> StackRef -> Bool
$c>= :: StackRef -> StackRef -> Bool
>= :: StackRef -> StackRef -> Bool
$cmax :: StackRef -> StackRef -> StackRef
max :: StackRef -> StackRef -> StackRef
$cmin :: StackRef -> StackRef -> StackRef
min :: StackRef -> StackRef -> StackRef
Ord, Int -> StackRef -> String -> String
[StackRef] -> String -> String
StackRef -> String
(Int -> StackRef -> String -> String)
-> (StackRef -> String)
-> ([StackRef] -> String -> String)
-> Show StackRef
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> StackRef -> String -> String
showsPrec :: Int -> StackRef -> String -> String
$cshow :: StackRef -> String
show :: StackRef -> String
$cshowList :: [StackRef] -> String -> String
showList :: [StackRef] -> String -> String
Show )
newtype Padding = Padding { Padding -> Int
paddingBytes :: Int }
deriving ( Int -> Padding -> String -> String
[Padding] -> String -> String
Padding -> String
(Int -> Padding -> String -> String)
-> (Padding -> String)
-> ([Padding] -> String -> String)
-> Show Padding
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Padding -> String -> String
showsPrec :: Int -> Padding -> String -> String
$cshow :: Padding -> String
show :: Padding -> String
$cshowList :: [Padding] -> String -> String
showList :: [Padding] -> String -> String
Show, Padding -> Padding -> Bool
(Padding -> Padding -> Bool)
-> (Padding -> Padding -> Bool) -> Eq Padding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Padding -> Padding -> Bool
== :: Padding -> Padding -> Bool
$c/= :: Padding -> Padding -> Bool
/= :: Padding -> Padding -> Bool
Eq, Eq Padding
Eq Padding =>
(Padding -> Padding -> Ordering)
-> (Padding -> Padding -> Bool)
-> (Padding -> Padding -> Bool)
-> (Padding -> Padding -> Bool)
-> (Padding -> Padding -> Bool)
-> (Padding -> Padding -> Padding)
-> (Padding -> Padding -> Padding)
-> Ord Padding
Padding -> Padding -> Bool
Padding -> Padding -> Ordering
Padding -> Padding -> Padding
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Padding -> Padding -> Ordering
compare :: Padding -> Padding -> Ordering
$c< :: Padding -> Padding -> Bool
< :: Padding -> Padding -> Bool
$c<= :: Padding -> Padding -> Bool
<= :: Padding -> Padding -> Bool
$c> :: Padding -> Padding -> Bool
> :: Padding -> Padding -> Bool
$c>= :: Padding -> Padding -> Bool
>= :: Padding -> Padding -> Bool
$cmax :: Padding -> Padding -> Padding
max :: Padding -> Padding -> Padding
$cmin :: Padding -> Padding -> Padding
min :: Padding -> Padding -> Padding
Ord )
stackArgSpace :: Platform -> StackArg -> Int
stackArgSpace :: Platform -> StackArg -> Int
stackArgSpace Platform
platform = \case
StackArg CmmExpr
arg Int
padding ->
Platform -> CmmExpr -> Int
argSize Platform
platform CmmExpr
arg Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
padding
StackArgRef { stackRef :: StackArg -> StackRef
stackRef = StackRef
ref } ->
case StackRef
ref of
InReg {} -> Int
0
OnStack {} -> Int
8
padStackArgs :: Platform
-> ([RawStackArg], [CmmExpr])
-> ([StackArg], Bool)
padStackArgs :: Platform -> ([RawStackArg], [CmmExpr]) -> ([StackArg], Bool)
padStackArgs Platform
platform ([RawStackArg]
args0, [CmmExpr]
data_args0) =
let
([(RawStackArg, Padding)]
args, Bool
align_16_mid) = Bool -> [RawStackArg] -> ([(RawStackArg, Padding)], Bool)
pad_args Bool
True [RawStackArg]
args0
([(RawStackArg, Padding)]
data_args, Bool
align_16_end) = Bool -> [RawStackArg] -> ([(RawStackArg, Padding)], Bool)
pad_args Bool
align_16_mid ((CmmExpr -> RawStackArg) -> [CmmExpr] -> [RawStackArg]
forall a b. (a -> b) -> [a] -> [b]
map CmmExpr -> RawStackArg
RawStackArg [CmmExpr]
data_args0)
resolve_args :: [(RawStackArg, Padding)] -> [Padding] -> [StackArg]
resolve_args :: [(RawStackArg, Padding)] -> [Padding] -> [StackArg]
resolve_args [] [Padding]
_ = []
resolve_args ((RawStackArg
stk_arg, Padding Int
pad):[(RawStackArg, Padding)]
rest) [Padding]
pads =
let (StackArg
this_arg, [Padding]
pads') =
case RawStackArg
stk_arg of
RawStackArg CmmExpr
arg -> (CmmExpr -> Int -> StackArg
StackArg CmmExpr
arg Int
pad, [Padding]
pads)
RawStackArgRef StackRef
ref Int
size -> case [Padding]
pads of
Padding Int
arg_pad : [Padding]
rest_pads ->
let arg :: StackArg
arg = StackArgRef
{ stackRef :: StackRef
stackRef = StackRef
ref
, stackRefArgSize :: Int
stackRefArgSize = Int
size
, stackRefArgPadding :: Int
stackRefArgPadding = Int
arg_pad }
in (StackArg
arg, [Padding]
rest_pads)
[Padding]
_ -> String -> (StackArg, [Padding])
forall a. HasCallStack => String -> a
panic String
"padStackArgs: no padding info found for StackArgRef"
in StackArg
this_arg StackArg -> [StackArg] -> [StackArg]
forall a. a -> [a] -> [a]
: [(RawStackArg, Padding)] -> [Padding] -> [StackArg]
resolve_args [(RawStackArg, Padding)]
rest [Padding]
pads'
in
( [(RawStackArg, Padding)] -> [Padding] -> [StackArg]
resolve_args [(RawStackArg, Padding)]
args (((RawStackArg, Padding) -> Padding)
-> [(RawStackArg, Padding)] -> [Padding]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RawStackArg, Padding) -> Padding
forall a b. (a, b) -> b
snd [(RawStackArg, Padding)]
data_args) [StackArg] -> [StackArg] -> [StackArg]
forall a. [a] -> [a] -> [a]
++
[ case RawStackArg
data_arg of
RawStackArg CmmExpr
arg -> CmmExpr -> Int -> StackArg
StackArg CmmExpr
arg Int
pad
RawStackArgRef {} -> String -> StackArg
forall a. HasCallStack => String -> a
panic String
"padStackArgs: reference in data section"
| (RawStackArg
data_arg, Padding Int
pad) <- [(RawStackArg, Padding)]
data_args
]
, Bool
align_16_end )
where
pad_args :: Bool -> [RawStackArg] -> ([(RawStackArg, Padding)], Bool)
pad_args :: Bool -> [RawStackArg] -> ([(RawStackArg, Padding)], Bool)
pad_args Bool
aligned_16 [] = ([], Bool
aligned_16)
pad_args Bool
aligned_16 (RawStackArg
arg:[RawStackArg]
args)
| Int
needed_alignment Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
16
= String -> ([(RawStackArg, Padding)], Bool)
forall a. HasCallStack => String -> a
sorry (String -> ([(RawStackArg, Padding)], Bool))
-> String -> ([(RawStackArg, Padding)], Bool)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
"X86_86 C call: unsupported argument."
, String
" Alignment requirement: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
needed_alignment String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" bytes."
, if Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32
then String
" The X86_64 NCG does not (yet) support Windows C calls with 256/512 bit vectors."
else String
" The X86_64 NCG cannot (yet) pass 256/512 bit vectors on the stack for C calls."
, String
" Please use the LLVM backend (-fllvm)." ]
| Bool
otherwise
= let ( [(RawStackArg, Padding)]
rest, Bool
final_align_16 ) = Bool -> [RawStackArg] -> ([(RawStackArg, Padding)], Bool)
pad_args Bool
next_aligned_16 [RawStackArg]
args
in ( (RawStackArg
arg, Int -> Padding
Padding Int
padding) (RawStackArg, Padding)
-> [(RawStackArg, Padding)] -> [(RawStackArg, Padding)]
forall a. a -> [a] -> [a]
: [(RawStackArg, Padding)]
rest, Bool
final_align_16 )
where
needed_alignment :: Int
needed_alignment = case RawStackArg
arg of
RawStackArg CmmExpr
arg -> Platform -> CmmExpr -> Int
argSize Platform
platform CmmExpr
arg
RawStackArgRef {} -> Platform -> Int
platformWordSizeInBytes Platform
platform
padding :: Int
padding
| Int
needed_alignment Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
16 Bool -> Bool -> Bool
|| Bool
aligned_16
= Int
0
| Bool
otherwise
= Int
8
next_aligned_16 :: Bool
next_aligned_16 = Bool -> Bool
not ( Bool
aligned_16 Bool -> Bool -> Bool
&& Int
needed_alignment Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
16 )
loadArgs :: NCGConfig -> [CmmExpr] -> NatM LoadArgs
loadArgs :: NCGConfig -> [CmmExpr] -> NatM LoadArgs
loadArgs NCGConfig
config [CmmExpr]
args
| Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32
= StateT [(Reg, Reg)] NatM LoadArgs -> [(Reg, Reg)] -> NatM LoadArgs
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (NCGConfig -> [CmmExpr] -> StateT [(Reg, Reg)] NatM LoadArgs
loadArgsWin NCGConfig
config [CmmExpr]
args) (Platform -> [(Reg, Reg)]
allArgRegs Platform
platform)
| Bool
otherwise
= StateT ([Reg], [Reg]) NatM LoadArgs
-> ([Reg], [Reg]) -> NatM LoadArgs
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (NCGConfig -> [CmmExpr] -> StateT ([Reg], [Reg]) NatM LoadArgs
loadArgsSysV NCGConfig
config [CmmExpr]
args) (Platform -> [Reg]
allIntArgRegs Platform
platform
,Platform -> [Reg]
allFPArgRegs Platform
platform)
where
platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
loadArgsSysV :: NCGConfig
-> [CmmExpr]
-> StateT ([Reg], [Reg]) NatM LoadArgs
loadArgsSysV :: NCGConfig -> [CmmExpr] -> StateT ([Reg], [Reg]) NatM LoadArgs
loadArgsSysV NCGConfig
_ [] = LoadArgs -> StateT ([Reg], [Reg]) NatM LoadArgs
forall a. a -> StateT ([Reg], [Reg]) NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return LoadArgs
forall a. Monoid a => a
mempty
loadArgsSysV NCGConfig
config (CmmExpr
arg:[CmmExpr]
rest) = do
(iregs, fregs) <- StateT ([Reg], [Reg]) NatM ([Reg], [Reg])
forall (m :: * -> *) s. Monad m => StateT s m s
get
if null iregs && null fregs
then return $
LoadArgs
{ stackArgs = map RawStackArg (arg:rest)
, stackDataArgs = []
, assignArgsCode = nilOL
, usedRegs = []
}
else do
mbReg <-
if
| isIntFormat arg_fmt
, ireg:iregs' <- iregs
-> do put (iregs', fregs)
return $ Just ireg
| isFloatFormat arg_fmt || isVecFormat arg_fmt
, freg:fregs' <- fregs
-> do put (iregs, fregs')
return $ Just freg
| otherwise
-> return Nothing
this_arg <-
case mbReg of
Just Reg
reg -> do
assign_code <- NatM InstrBlock -> StateT ([Reg], [Reg]) NatM InstrBlock
forall (m :: * -> *) a. Monad m => m a -> StateT ([Reg], [Reg]) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (NatM InstrBlock -> StateT ([Reg], [Reg]) NatM InstrBlock)
-> NatM InstrBlock -> StateT ([Reg], [Reg]) NatM InstrBlock
forall a b. (a -> b) -> a -> b
$ CmmExpr -> Reg -> NatM InstrBlock
loadArgIntoReg CmmExpr
arg Reg
reg
return $
LoadArgs
{ stackArgs = []
, stackDataArgs = []
, assignArgsCode = assign_code
, usedRegs = [RegWithFormat reg arg_fmt]
}
Maybe Reg
Nothing -> do
LoadArgs -> StateT ([Reg], [Reg]) NatM LoadArgs
forall a. a -> StateT ([Reg], [Reg]) NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (LoadArgs -> StateT ([Reg], [Reg]) NatM LoadArgs)
-> LoadArgs -> StateT ([Reg], [Reg]) NatM LoadArgs
forall a b. (a -> b) -> a -> b
$
LoadArgs
{ stackArgs :: [RawStackArg]
stackArgs = [CmmExpr -> RawStackArg
RawStackArg CmmExpr
arg]
, stackDataArgs :: [CmmExpr]
stackDataArgs = []
, assignArgsCode :: InstrBlock
assignArgsCode = InstrBlock
forall a. OrdList a
nilOL
, usedRegs :: [RegWithFormat]
usedRegs = []
}
others <- loadArgsSysV config rest
return $ this_arg S.<> others
where
platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
arg_fmt :: Format
arg_fmt = CmmType -> Format
cmmTypeFormat (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
arg)
computeWinPushArgs :: Platform -> [CmmExpr] -> ([RawStackArg], [CmmExpr])
computeWinPushArgs :: Platform -> [CmmExpr] -> ([RawStackArg], [CmmExpr])
computeWinPushArgs Platform
platform = [CmmExpr] -> ([RawStackArg], [CmmExpr])
go
where
go :: [CmmExpr] -> ([RawStackArg], [CmmExpr])
go :: [CmmExpr] -> ([RawStackArg], [CmmExpr])
go [] = ([], [])
go (CmmExpr
arg:[CmmExpr]
args) =
let
arg_size :: Int
arg_size = Platform -> CmmExpr -> Int
argSize Platform
platform CmmExpr
arg
(RawStackArg
this_arg, [CmmExpr] -> [CmmExpr]
add_this_arg)
| Int
arg_size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
8
= ( StackRef -> Int -> RawStackArg
RawStackArgRef StackRef
OnStack Int
arg_size, (CmmExpr
arg CmmExpr -> [CmmExpr] -> [CmmExpr]
forall a. a -> [a] -> [a]
:) )
| Bool
otherwise
= ( CmmExpr -> RawStackArg
RawStackArg CmmExpr
arg, [CmmExpr] -> [CmmExpr]
forall a. a -> a
id )
([RawStackArg]
stk_args, [CmmExpr]
stk_data) = [CmmExpr] -> ([RawStackArg], [CmmExpr])
go [CmmExpr]
args
in
(RawStackArg
this_argRawStackArg -> [RawStackArg] -> [RawStackArg]
forall a. a -> [a] -> [a]
:[RawStackArg]
stk_args, [CmmExpr] -> [CmmExpr]
add_this_arg [CmmExpr]
stk_data)
loadArgsWin :: NCGConfig -> [CmmExpr] -> StateT [(Reg,Reg)] NatM LoadArgs
loadArgsWin :: NCGConfig -> [CmmExpr] -> StateT [(Reg, Reg)] NatM LoadArgs
loadArgsWin NCGConfig
_ [] = LoadArgs -> StateT [(Reg, Reg)] NatM LoadArgs
forall a. a -> StateT [(Reg, Reg)] NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return LoadArgs
forall a. Monoid a => a
mempty
loadArgsWin NCGConfig
config (CmmExpr
arg:[CmmExpr]
rest) = do
regs <- StateT [(Reg, Reg)] NatM [(Reg, Reg)]
forall (m :: * -> *) s. Monad m => StateT s m s
get
case regs of
(Reg, Reg)
reg:[(Reg, Reg)]
regs' -> do
[(Reg, Reg)] -> StateT [(Reg, Reg)] NatM ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put [(Reg, Reg)]
regs'
this_arg <- NatM LoadArgs -> StateT [(Reg, Reg)] NatM LoadArgs
forall (m :: * -> *) a. Monad m => m a -> StateT [(Reg, Reg)] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (NatM LoadArgs -> StateT [(Reg, Reg)] NatM LoadArgs)
-> NatM LoadArgs -> StateT [(Reg, Reg)] NatM LoadArgs
forall a b. (a -> b) -> a -> b
$ (Reg, Reg) -> NatM LoadArgs
load_arg_win (Reg, Reg)
reg
rest <- loadArgsWin config rest
return $ this_arg S.<> rest
[] -> do
let ([RawStackArg]
stk_args, [CmmExpr]
data_args) = Platform -> [CmmExpr] -> ([RawStackArg], [CmmExpr])
computeWinPushArgs Platform
platform (CmmExpr
argCmmExpr -> [CmmExpr] -> [CmmExpr]
forall a. a -> [a] -> [a]
:[CmmExpr]
rest)
LoadArgs -> StateT [(Reg, Reg)] NatM LoadArgs
forall a. a -> StateT [(Reg, Reg)] NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (LoadArgs -> StateT [(Reg, Reg)] NatM LoadArgs)
-> LoadArgs -> StateT [(Reg, Reg)] NatM LoadArgs
forall a b. (a -> b) -> a -> b
$
LoadArgs
{ stackArgs :: [RawStackArg]
stackArgs = [RawStackArg]
stk_args
, stackDataArgs :: [CmmExpr]
stackDataArgs = [CmmExpr]
data_args
, assignArgsCode :: InstrBlock
assignArgsCode = InstrBlock
forall a. OrdList a
nilOL
, usedRegs :: [RegWithFormat]
usedRegs = []
}
where
platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
arg_fmt :: Format
arg_fmt = CmmType -> Format
cmmTypeFormat (CmmType -> Format) -> CmmType -> Format
forall a b. (a -> b) -> a -> b
$ Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
arg
load_arg_win :: (Reg, Reg) -> NatM LoadArgs
load_arg_win (Reg
ireg, Reg
freg)
| Format -> Bool
isVecFormat Format
arg_fmt
= do LoadArgs -> NatM LoadArgs
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (LoadArgs -> NatM LoadArgs) -> LoadArgs -> NatM LoadArgs
forall a b. (a -> b) -> a -> b
$
LoadArgs
{ stackArgs :: [RawStackArg]
stackArgs = [StackRef -> Int -> RawStackArg
RawStackArgRef (Reg -> StackRef
InReg Reg
ireg) (Platform -> CmmExpr -> Int
argSize Platform
platform CmmExpr
arg)]
, stackDataArgs :: [CmmExpr]
stackDataArgs = [CmmExpr
arg]
, assignArgsCode :: InstrBlock
assignArgsCode = InstrBlock
forall a. OrdList a
nilOL
, usedRegs :: [RegWithFormat]
usedRegs = [Reg -> Format -> RegWithFormat
RegWithFormat Reg
ireg Format
II64]
}
| Bool
otherwise
= do let arg_reg :: Reg
arg_reg
| Format -> Bool
isFloatFormat Format
arg_fmt
= Reg
freg
| Bool
otherwise
= Reg
ireg
assign_code <- CmmExpr -> Reg -> NatM InstrBlock
loadArgIntoReg CmmExpr
arg Reg
arg_reg
let (assign_code', regs')
| isFloatFormat arg_fmt =
( assign_code `snocOL` MOVD FF64 II64 (OpReg freg) (OpReg ireg),
[ RegWithFormat freg FF64
, RegWithFormat ireg II64 ])
| otherwise = (assign_code, [RegWithFormat ireg II64])
return $
LoadArgs
{ stackArgs = []
, stackDataArgs = []
, assignArgsCode = assign_code'
, usedRegs = regs'
}
loadArgIntoReg :: CmmExpr -> Reg -> NatM InstrBlock
loadArgIntoReg :: CmmExpr -> Reg -> NatM InstrBlock
loadArgIntoReg CmmExpr
arg Reg
reg = do
Bool -> NatM () -> NatM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
debugIsOn Bool -> Bool -> Bool
&& CmmExpr -> Bool
loadIntoRegMightClobberOtherReg CmmExpr
arg) (NatM () -> NatM ()) -> NatM () -> NatM ()
forall a b. (a -> b) -> a -> b
$ do
platform <- NatM Platform
getPlatform
massertPpr False $
vcat [ text "loadArgIntoReg: arg might contain MachOp"
, text "arg:" <+> pdoc platform arg ]
arg_code <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
arg
return $ arg_code reg
argSize :: Platform -> CmmExpr -> Int
argSize :: Platform -> CmmExpr -> Int
argSize Platform
platform CmmExpr
arg =
Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Platform -> Int
platformWordSizeInBytes Platform
platform) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
Width -> Int
widthInBytes (CmmType -> Width
typeWidth (CmmType -> Width) -> CmmType -> Width
forall a b. (a -> b) -> a -> b
$ Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
arg)
addStackPadding :: Int
-> NatM InstrBlock
addStackPadding :: Int -> NatM InstrBlock
addStackPadding Int
pad_bytes
| Int
pad_bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
= InstrBlock -> NatM InstrBlock
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return InstrBlock
forall a. OrdList a
nilOL
| Bool
otherwise
= do delta <- NatM Int
getDeltaNat
setDeltaNat (delta - pad_bytes)
return $
toOL [ SUB II64 (OpImm (ImmInt pad_bytes)) (OpReg rsp)
, DELTA (delta - pad_bytes)
]
pushArgByValue :: NCGConfig -> CmmExpr -> NatM InstrBlock
pushArgByValue :: NCGConfig -> CmmExpr -> NatM InstrBlock
pushArgByValue NCGConfig
config CmmExpr
arg
| Format -> Bool
isIntFormat Format
fmt
, Format -> Int
formatInBytes Format
fmt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8
= do
(arg_op, arg_code) <- CmmExpr -> NatM (Operand, InstrBlock)
getOperand CmmExpr
arg
delta <- getDeltaNat
setDeltaNat (delta-arg_size)
return $
arg_code `appOL` toOL
[ PUSH II64 arg_op
, DELTA (delta-arg_size) ]
| Bool
otherwise
= do
(arg_reg, arg_code) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
arg
delta <- getDeltaNat
setDeltaNat (delta-arg_size)
return $ arg_code `appOL` toOL
[ SUB (intFormat (wordWidth platform)) (OpImm (ImmInt arg_size)) (OpReg rsp)
, DELTA (delta-arg_size)
, movInstr config fmt (OpReg arg_reg) (OpAddr (spRel platform 0)) ]
where
platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
arg_size :: Int
arg_size = Platform -> CmmExpr -> Int
argSize Platform
platform CmmExpr
arg
arg_rep :: CmmType
arg_rep = Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
arg
fmt :: Format
fmt = CmmType -> Format
cmmTypeFormat CmmType
arg_rep
loadOrPushArg :: NCGConfig -> (StackArg, Maybe Int) -> NatM (InstrBlock, InstrBlock)
loadOrPushArg :: NCGConfig -> (StackArg, Maybe Int) -> NatM (InstrBlock, InstrBlock)
loadOrPushArg NCGConfig
config (StackArg
stk_arg, Maybe Int
mb_off) =
case StackArg
stk_arg of
StackArg CmmExpr
arg Int
pad -> do
push_code <- NCGConfig -> CmmExpr -> NatM InstrBlock
pushArgByValue NCGConfig
config CmmExpr
arg
pad_code <- addStackPadding pad
return (nilOL, push_code `appOL` pad_code)
StackArgRef { stackRef :: StackArg -> StackRef
stackRef = StackRef
ref } ->
case StackRef
ref of
InReg Reg
ireg ->
(InstrBlock, InstrBlock) -> NatM (InstrBlock, InstrBlock)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Instr -> InstrBlock) -> Instr -> InstrBlock
forall a b. (a -> b) -> a -> b
$ Format -> Operand -> Operand -> Instr
LEA Format
II64 (AddrMode -> Operand
OpAddr (Platform -> Int -> AddrMode
spRel Platform
platform Int
off)) (Reg -> Operand
OpReg Reg
ireg), InstrBlock
forall a. OrdList a
nilOL)
OnStack {} -> do
tmp <- Format -> NatM Reg
getNewRegNat Format
II64
delta <- getDeltaNat
setDeltaNat (delta-arg_ref_size)
let push_code = [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL
[ Format -> Operand -> Operand -> Instr
SUB (Width -> Format
intFormat (Platform -> Width
wordWidth Platform
platform)) (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
arg_ref_size)) (Reg -> Operand
OpReg Reg
rsp)
, Int -> Instr
DELTA (Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
arg_ref_size)
, Format -> Operand -> Operand -> Instr
LEA Format
II64 (AddrMode -> Operand
OpAddr (Platform -> Int -> AddrMode
spRel Platform
platform Int
off)) (Reg -> Operand
OpReg Reg
tmp)
, Format -> Operand -> Operand -> Instr
MOV Format
II64 (Reg -> Operand
OpReg Reg
tmp) (AddrMode -> Operand
OpAddr (Platform -> Int -> AddrMode
spRel Platform
platform Int
0)) ]
return (nilOL, push_code)
where off :: Int
off = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
expectJust Maybe Int
mb_off
where
arg_ref_size :: Int
arg_ref_size = Int
8
platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
pushArgs :: NCGConfig
-> [RawStackArg]
-> [StackArg]
-> NatM (InstrBlock, InstrBlock)
pushArgs :: NCGConfig
-> [RawStackArg] -> [StackArg] -> NatM (InstrBlock, InstrBlock)
pushArgs NCGConfig
config [RawStackArg]
proper_args [StackArg]
all_stk_args
= do { let
vec_offs :: [Maybe Int]
vec_offs :: [Maybe Int]
vec_offs
| Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32
= Int -> [StackArg] -> [Maybe Int]
go Int
stack_arg_size [StackArg]
all_stk_args
| Bool
otherwise
= Maybe Int -> [Maybe Int]
forall a. a -> [a]
repeat Maybe Int
forall a. Maybe a
Nothing
stack_arg_size :: Int
stack_arg_size = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (RawStackArg -> Bool) -> [RawStackArg] -> Int
forall a. (a -> Bool) -> [a] -> Int
count RawStackArg -> Bool
not_in_reg [RawStackArg]
proper_args
not_in_reg :: RawStackArg -> Bool
not_in_reg (RawStackArg {}) = Bool
True
not_in_reg (RawStackArgRef { stackRef :: RawStackArg -> StackRef
stackRef = StackRef
ref }) =
case StackRef
ref of
InReg {} -> Bool
False
OnStack {} -> Bool
True
ok :: a -> Bool
ok a
off = a
off a -> a -> a
forall a. Integral a => a -> a -> a
`rem` a
8 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
go :: Int -> [StackArg] -> [Maybe Int]
go :: Int -> [StackArg] -> [Maybe Int]
go Int
_ [] = []
go Int
off (StackArg
stk_arg:[StackArg]
args) =
Bool -> SDoc -> [Maybe Int] -> [Maybe Int]
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Int -> Bool
forall a. Integral a => a -> Bool
ok Int
off) (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"unaligned offset:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
off) ([Maybe Int] -> [Maybe Int]) -> [Maybe Int] -> [Maybe Int]
forall a b. (a -> b) -> a -> b
$
case StackArg
stk_arg of
StackArg {} ->
let off' :: Int
off' = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Platform -> StackArg -> Int
stackArgSpace Platform
platform StackArg
stk_arg
in Maybe Int
forall a. Maybe a
Nothing Maybe Int -> [Maybe Int] -> [Maybe Int]
forall a. a -> [a] -> [a]
: Int -> [StackArg] -> [Maybe Int]
go Int
off' [StackArg]
args
StackArgRef
{ stackRefArgSize :: StackArg -> Int
stackRefArgSize = Int
data_size
, stackRefArgPadding :: StackArg -> Int
stackRefArgPadding = Int
data_pad } ->
Bool -> SDoc -> [Maybe Int] -> [Maybe Int]
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Int -> Bool
forall a. Integral a => a -> Bool
ok Int
data_size) (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"unaligned data size:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
data_size) ([Maybe Int] -> [Maybe Int]) -> [Maybe Int] -> [Maybe Int]
forall a b. (a -> b) -> a -> b
$
Bool -> SDoc -> [Maybe Int] -> [Maybe Int]
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Int -> Bool
forall a. Integral a => a -> Bool
ok Int
data_pad) (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"unaligned data padding:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
data_pad) ([Maybe Int] -> [Maybe Int]) -> [Maybe Int] -> [Maybe Int]
forall a b. (a -> b) -> a -> b
$
let off' :: Int
off' = Int
off
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
data_size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
data_pad
Int -> Int -> Int
forall a. Num a => a -> a -> a
- Platform -> StackArg -> Int
stackArgSpace Platform
platform StackArg
stk_arg
in Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
data_pad Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off) Maybe Int -> [Maybe Int] -> [Maybe Int]
forall a. a -> [a] -> [a]
: Int -> [StackArg] -> [Maybe Int]
go Int
off' [StackArg]
args
; (load_regs, push_args) <- ((StackArg, Maybe Int) -> NatM (InstrBlock, InstrBlock))
-> [(StackArg, Maybe Int)] -> NatM (InstrBlock, InstrBlock)
forall (m :: * -> *) (t :: * -> *) b a.
(Applicative m, Foldable t, Monoid b) =>
(a -> m b) -> t a -> m b
foldMapM (NCGConfig -> (StackArg, Maybe Int) -> NatM (InstrBlock, InstrBlock)
loadOrPushArg NCGConfig
config) ([(StackArg, Maybe Int)] -> [(StackArg, Maybe Int)]
forall a. [a] -> [a]
reverse ([(StackArg, Maybe Int)] -> [(StackArg, Maybe Int)])
-> [(StackArg, Maybe Int)] -> [(StackArg, Maybe Int)]
forall a b. (a -> b) -> a -> b
$ [StackArg] -> [Maybe Int] -> [(StackArg, Maybe Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [StackArg]
all_stk_args [Maybe Int]
vec_offs)
; return (load_regs, push_args) }
where
platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
genSwitch :: CmmExpr -> SwitchTargets -> NatM InstrBlock
genSwitch :: CmmExpr -> SwitchTargets -> NatM InstrBlock
genSwitch CmmExpr
expr SwitchTargets
targets = do
config <- NatM NCGConfig
getConfig
let platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
expr_w = Platform -> CmmExpr -> Width
cmmExprWidth Platform
platform CmmExpr
expr
indexExpr0 = Platform -> CmmExpr -> Int -> CmmExpr
cmmOffset Platform
platform CmmExpr
expr Int
offset
indexExpr = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp
(Width -> Width -> MachOp
MO_UU_Conv Width
expr_w (Platform -> Width
platformWordWidth Platform
platform))
[CmmExpr
indexExpr0]
if ncgPIC config
then do
(reg,e_code) <- getNonClobberedReg indexExpr
lbl <- getNewLabelNat
let is32bit = Platform -> Bool
target32Bit Platform
platform
os = Platform -> OS
platformOS Platform
platform
rosection = case OS
os of
OS
OSDarwin | Bool -> Bool
not Bool
is32bit -> SectionType -> CLabel -> Section
Section SectionType
Text CLabel
lbl
OS
_ -> SectionType -> CLabel -> Section
Section SectionType
ReadOnlyData CLabel
lbl
dynRef <- cmmMakeDynamicReference config DataReference lbl
(tableReg,t_code) <- getSomeReg $ dynRef
let op = AddrMode -> Operand
OpAddr (EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
tableReg)
(Reg -> Int -> EAIndex
EAIndex Reg
reg (Platform -> Int
platformWordSizeInBytes Platform
platform)) (Int -> Imm
ImmInt Int
0))
return $ e_code `appOL` t_code `appOL` toOL [
ADD (intFormat (platformWordWidth platform)) op (OpReg tableReg),
JMP_TBL (OpReg tableReg) ids rosection lbl
]
else do
(reg,e_code) <- getSomeReg indexExpr
lbl <- getNewLabelNat
let is32bit = Platform -> Bool
target32Bit Platform
platform
if is32bit
then let op = AddrMode -> Operand
OpAddr (EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex EABase
EABaseNone (Reg -> Int -> EAIndex
EAIndex Reg
reg (Platform -> Int
platformWordSizeInBytes Platform
platform)) (CLabel -> Imm
ImmCLbl CLabel
lbl))
jmp_code = Operand -> [Maybe JumpDest] -> Section -> CLabel -> Instr
JMP_TBL Operand
op [Maybe JumpDest]
ids (SectionType -> CLabel -> Section
Section SectionType
ReadOnlyData CLabel
lbl) CLabel
lbl
in return $ e_code `appOL` unitOL jmp_code
else do
tableReg <- getNewRegNat (intFormat (platformWordWidth platform))
targetReg <- getNewRegNat (intFormat (platformWordWidth platform))
let op = AddrMode -> Operand
OpAddr (EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
tableReg) (Reg -> Int -> EAIndex
EAIndex Reg
reg (Platform -> Int
platformWordSizeInBytes Platform
platform)) (Int -> Imm
ImmInt Int
0))
fmt = Bool -> Format
archWordFormat Bool
is32bit
code = InstrBlock
e_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL
[ Format -> Operand -> Operand -> Instr
LEA Format
fmt (AddrMode -> Operand
OpAddr (EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex EABase
EABaseRip EAIndex
EAIndexNone (CLabel -> Imm
ImmCLbl CLabel
lbl))) (Reg -> Operand
OpReg Reg
tableReg)
, Format -> Operand -> Operand -> Instr
MOV Format
fmt Operand
op (Reg -> Operand
OpReg Reg
targetReg)
, Operand -> [Maybe JumpDest] -> Section -> CLabel -> Instr
JMP_TBL (Reg -> Operand
OpReg Reg
targetReg) [Maybe JumpDest]
ids (SectionType -> CLabel -> Section
Section SectionType
ReadOnlyData CLabel
lbl) CLabel
lbl
]
return code
where
(Int
offset, [Maybe Label]
blockIds) = SwitchTargets -> (Int, [Maybe Label])
switchTargetsToTable SwitchTargets
targets
ids :: [Maybe JumpDest]
ids = (Maybe Label -> Maybe JumpDest)
-> [Maybe Label] -> [Maybe JumpDest]
forall a b. (a -> b) -> [a] -> [b]
map ((Label -> JumpDest) -> Maybe Label -> Maybe JumpDest
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Label -> JumpDest
DestBlockId) [Maybe Label]
blockIds
generateJumpTableForInstr :: NCGConfig -> Instr -> Maybe (NatCmmDecl (Alignment, RawCmmStatics) Instr)
generateJumpTableForInstr :: NCGConfig
-> Instr -> Maybe (NatCmmDecl (Alignment, RawCmmStatics) Instr)
generateJumpTableForInstr NCGConfig
config (JMP_TBL Operand
_ [Maybe JumpDest]
ids Section
section CLabel
lbl)
= let getBlockId :: JumpDest -> Label
getBlockId (DestBlockId Label
id) = Label
id
getBlockId JumpDest
_ = String -> Label
forall a. HasCallStack => String -> a
panic String
"Non-Label target in Jump Table"
blockIds :: [Maybe Label]
blockIds = (Maybe JumpDest -> Maybe Label)
-> [Maybe JumpDest] -> [Maybe Label]
forall a b. (a -> b) -> [a] -> [b]
map ((JumpDest -> Label) -> Maybe JumpDest -> Maybe Label
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JumpDest -> Label
getBlockId) [Maybe JumpDest]
ids
in NatCmmDecl (Alignment, RawCmmStatics) Instr
-> Maybe (NatCmmDecl (Alignment, RawCmmStatics) Instr)
forall a. a -> Maybe a
Just (NCGConfig
-> [Maybe Label]
-> Section
-> CLabel
-> NatCmmDecl (Alignment, RawCmmStatics) Instr
forall h g.
NCGConfig
-> [Maybe Label]
-> Section
-> CLabel
-> GenCmmDecl (Alignment, RawCmmStatics) h g
createJumpTable NCGConfig
config [Maybe Label]
blockIds Section
section CLabel
lbl)
generateJumpTableForInstr NCGConfig
_ Instr
_ = Maybe (NatCmmDecl (Alignment, RawCmmStatics) Instr)
forall a. Maybe a
Nothing
createJumpTable :: NCGConfig -> [Maybe BlockId] -> Section -> CLabel
-> GenCmmDecl (Alignment, RawCmmStatics) h g
createJumpTable :: forall h g.
NCGConfig
-> [Maybe Label]
-> Section
-> CLabel
-> GenCmmDecl (Alignment, RawCmmStatics) h g
createJumpTable NCGConfig
config [Maybe Label]
ids Section
section CLabel
lbl
= let jumpTable :: [CmmStatic]
jumpTable
| NCGConfig -> Bool
ncgPIC NCGConfig
config =
let ww :: Width
ww = NCGConfig -> Width
ncgWordWidth NCGConfig
config
jumpTableEntryRel :: Maybe Label -> CmmStatic
jumpTableEntryRel Maybe Label
Nothing
= CmmLit -> CmmStatic
CmmStaticLit (Integer -> Width -> CmmLit
CmmInt Integer
0 Width
ww)
jumpTableEntryRel (Just Label
blockid)
= CmmLit -> CmmStatic
CmmStaticLit (CLabel -> CLabel -> Int -> Width -> CmmLit
CmmLabelDiffOff CLabel
blockLabel CLabel
lbl Int
0 Width
ww)
where blockLabel :: CLabel
blockLabel = Label -> CLabel
blockLbl Label
blockid
in (Maybe Label -> CmmStatic) -> [Maybe Label] -> [CmmStatic]
forall a b. (a -> b) -> [a] -> [b]
map Maybe Label -> CmmStatic
jumpTableEntryRel [Maybe Label]
ids
| Bool
otherwise = (Maybe Label -> CmmStatic) -> [Maybe Label] -> [CmmStatic]
forall a b. (a -> b) -> [a] -> [b]
map (NCGConfig -> Maybe Label -> CmmStatic
jumpTableEntry NCGConfig
config) [Maybe Label]
ids
in Section
-> (Alignment, RawCmmStatics)
-> GenCmmDecl (Alignment, RawCmmStatics) h g
forall d h g. Section -> d -> GenCmmDecl d h g
CmmData Section
section (Int -> Alignment
mkAlignment Int
1, CLabel -> [CmmStatic] -> RawCmmStatics
forall (rawOnly :: Bool).
CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
CmmStaticsRaw CLabel
lbl [CmmStatic]
jumpTable)
extractUnwindPoints :: [Instr] -> [UnwindPoint]
[Instr]
instrs =
[ CLabel -> Map GlobalReg (Maybe UnwindExpr) -> UnwindPoint
UnwindPoint CLabel
lbl Map GlobalReg (Maybe UnwindExpr)
unwinds | UNWIND CLabel
lbl Map GlobalReg (Maybe UnwindExpr)
unwinds <- [Instr]
instrs]
condIntReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
cond CmmExpr
x CmmExpr
y = do
CondCode _ cond cond_code <- Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
cond CmmExpr
x CmmExpr
y
tmp <- getNewRegNat II8
let
code Reg
dst = InstrBlock
cond_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [
Cond -> Operand -> Instr
SETCC Cond
cond (Reg -> Operand
OpReg Reg
tmp),
Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
tmp) (Reg -> Operand
OpReg Reg
dst)
]
return (Any II32 code)
condFltReg :: Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg :: Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Bool
is32Bit Cond
cond CmmExpr
x CmmExpr
y = NatM Register
condFltReg_sse2
where
condFltReg_sse2 :: NatM Register
condFltReg_sse2 = do
CondCode _ cond cond_code <- Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
cond CmmExpr
x CmmExpr
y
tmp1 <- getNewRegNat (archWordFormat is32Bit)
tmp2 <- getNewRegNat (archWordFormat is32Bit)
let
code Reg
dst =
InstrBlock
cond_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
(case Cond
cond of
Cond
NE -> Reg -> InstrBlock
or_unordered Reg
dst
Cond
GU -> Reg -> InstrBlock
plain_test Reg
dst
Cond
GEU -> Reg -> InstrBlock
plain_test Reg
dst
Cond
LTT -> Bool -> SDoc -> InstrBlock -> InstrBlock
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr Bool
False (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Should have been turned into >") (InstrBlock -> InstrBlock) -> InstrBlock -> InstrBlock
forall a b. (a -> b) -> a -> b
$
Reg -> InstrBlock
and_ordered Reg
dst
Cond
LE -> Bool -> SDoc -> InstrBlock -> InstrBlock
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr Bool
False (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Should have been turned into >=") (InstrBlock -> InstrBlock) -> InstrBlock -> InstrBlock
forall a b. (a -> b) -> a -> b
$
Reg -> InstrBlock
and_ordered Reg
dst
Cond
_ -> Reg -> InstrBlock
and_ordered Reg
dst)
plain_test Reg
dst = [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [
Cond -> Operand -> Instr
SETCC Cond
cond (Reg -> Operand
OpReg Reg
tmp1),
Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
tmp1) (Reg -> Operand
OpReg Reg
dst)
]
or_unordered Reg
dst = [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [
Cond -> Operand -> Instr
SETCC Cond
cond (Reg -> Operand
OpReg Reg
tmp1),
Cond -> Operand -> Instr
SETCC Cond
PARITY (Reg -> Operand
OpReg Reg
tmp2),
Format -> Operand -> Operand -> Instr
OR Format
II8 (Reg -> Operand
OpReg Reg
tmp1) (Reg -> Operand
OpReg Reg
tmp2),
Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
tmp2) (Reg -> Operand
OpReg Reg
dst)
]
and_ordered Reg
dst = [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [
Cond -> Operand -> Instr
SETCC Cond
cond (Reg -> Operand
OpReg Reg
tmp1),
Cond -> Operand -> Instr
SETCC Cond
NOTPARITY (Reg -> Operand
OpReg Reg
tmp2),
Format -> Operand -> Operand -> Instr
AND Format
II8 (Reg -> Operand
OpReg Reg
tmp1) (Reg -> Operand
OpReg Reg
tmp2),
Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
tmp2) (Reg -> Operand
OpReg Reg
dst)
]
return (Any II32 code)
trivialCode :: Width -> (Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
-> CmmExpr -> CmmExpr -> NatM Register
trivialCode :: Width
-> (Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode Width
width Operand -> Operand -> Instr
instr Maybe (Operand -> Operand -> Instr)
m CmmExpr
a CmmExpr
b
= do platform <- NatM Platform
getPlatform
trivialCode' platform width instr m a b
trivialCode' :: Platform -> Width -> (Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
-> CmmExpr -> CmmExpr -> NatM Register
trivialCode' :: Platform
-> Width
-> (Operand -> Operand -> Instr)
-> Maybe (Operand -> Operand -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode' Platform
platform Width
width Operand -> Operand -> Instr
_ (Just Operand -> Operand -> Instr
revinstr) (CmmLit CmmLit
lit_a) CmmExpr
b
| Platform -> CmmLit -> Bool
is32BitLit Platform
platform CmmLit
lit_a = do
b_code <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
b
let
code Reg
dst
= Reg -> InstrBlock
b_code Reg
dst InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Operand -> Operand -> Instr
revinstr (Imm -> Operand
OpImm (CmmLit -> Imm
litToImm CmmLit
lit_a)) (Reg -> Operand
OpReg Reg
dst)
return (Any (intFormat width) code)
trivialCode' Platform
_ Width
width Operand -> Operand -> Instr
instr Maybe (Operand -> Operand -> Instr)
_ CmmExpr
a CmmExpr
b
= Format
-> (Operand -> Reg -> Instr) -> CmmExpr -> CmmExpr -> NatM Register
genTrivialCode (Width -> Format
intFormat Width
width) (\Operand
op2 -> Operand -> Operand -> Instr
instr Operand
op2 (Operand -> Instr) -> (Reg -> Operand) -> Reg -> Instr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reg -> Operand
OpReg) CmmExpr
a CmmExpr
b
genTrivialCode :: Format -> (Operand -> Reg -> Instr)
-> CmmExpr -> CmmExpr -> NatM Register
genTrivialCode :: Format
-> (Operand -> Reg -> Instr) -> CmmExpr -> CmmExpr -> NatM Register
genTrivialCode Format
rep Operand -> Reg -> Instr
instr CmmExpr
a CmmExpr
b = do
(b_op, b_code) <- CmmExpr -> NatM (Operand, InstrBlock)
getNonClobberedOperand CmmExpr
b
a_code <- getAnyReg a
tmp <- getNewRegNat rep
let
code Reg
dst
| Reg
dst Reg -> Operand -> Bool
`regClashesWithOp` Operand
b_op =
InstrBlock
b_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
rep Operand
b_op (Reg -> Operand
OpReg Reg
tmp)) InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> InstrBlock
a_code Reg
dst InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Operand -> Reg -> Instr
instr (Reg -> Operand
OpReg Reg
tmp) Reg
dst
| Bool
otherwise =
InstrBlock
b_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> InstrBlock
a_code Reg
dst InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Operand -> Reg -> Instr
instr Operand
b_op Reg
dst
return (Any rep code)
regClashesWithOp :: Reg -> Operand -> Bool
Reg
reg regClashesWithOp :: Reg -> Operand -> Bool
`regClashesWithOp` OpReg Reg
reg2 = Reg
reg Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
reg2
Reg
reg `regClashesWithOp` OpAddr AddrMode
amode = (Reg -> Bool) -> [Reg] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
==Reg
reg) (AddrMode -> [Reg]
addrModeRegs AddrMode
amode)
Reg
_ `regClashesWithOp` Operand
_ = Bool
False
genFMA3Code :: Length
-> Width
-> FMASign
-> CmmExpr -> CmmExpr -> CmmExpr -> NatM Register
genFMA3Code :: Int
-> Width
-> FMASign
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM Register
genFMA3Code Int
l Width
w FMASign
signs CmmExpr
x CmmExpr
y CmmExpr
z = do
config <- NatM NCGConfig
getConfig
let rep
| Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
= Width -> Format
floatFormat Width
w
| Bool
otherwise
= CmmType -> Format
vecFormat (Int -> CmmType -> CmmType
cmmVec Int
l (CmmType -> CmmType) -> CmmType -> CmmType
forall a b. (a -> b) -> a -> b
$ Width -> CmmType
cmmFloat Width
w)
(y_reg, y_code) <- getNonClobberedReg y
(z_op, z_code) <- getNonClobberedOperand z
x_code <- getAnyReg x
x_tmp <- getNewRegNat rep
let
fma213 = Format
-> FMASign -> FMAPermutation -> Operand -> Reg -> Reg -> Instr
FMA3 Format
rep FMASign
signs FMAPermutation
FMA213
code, code_direct, code_mov :: Reg -> InstrBlock
code_direct Reg
dst = Reg -> InstrBlock
x_code Reg
dst InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Operand -> Reg -> Reg -> Instr
fma213 Operand
z_op Reg
y_reg Reg
dst
code_mov Reg
dst = Reg -> InstrBlock
x_code Reg
x_tmp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Operand -> Reg -> Reg -> Instr
fma213 Operand
z_op Reg
y_reg Reg
x_tmp InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
HasDebugCallStack => NCGConfig -> Format -> Reg -> Reg -> Instr
NCGConfig -> Format -> Reg -> Reg -> Instr
mkRegRegMoveInstr NCGConfig
config Format
rep Reg
x_tmp Reg
dst
code Reg
dst =
InstrBlock
y_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
InstrBlock
z_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
( if Bool
arg_regs_conflict then Reg -> InstrBlock
code_mov Reg
dst else Reg -> InstrBlock
code_direct Reg
dst )
where
arg_regs_conflict :: Bool
arg_regs_conflict =
Reg
y_reg Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst Bool -> Bool -> Bool
||
case Operand
z_op of
OpReg Reg
z_reg -> Reg
z_reg Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
OpAddr AddrMode
amode -> Reg
dst Reg -> [Reg] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` AddrMode -> [Reg]
addrModeRegs AddrMode
amode
OpImm {} -> Bool
False
return (Any rep code)
trivialUCode :: Format -> (Operand -> Instr)
-> CmmExpr -> NatM Register
trivialUCode :: Format -> (Operand -> Instr) -> CmmExpr -> NatM Register
trivialUCode Format
rep Operand -> Instr
instr CmmExpr
x = do
x_code <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
x
let
code Reg
dst =
Reg -> InstrBlock
x_code Reg
dst InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Operand -> Instr
instr (Reg -> Operand
OpReg Reg
dst)
return (Any rep code)
trivialFCode_sse2 :: Width -> (Format -> Operand -> Reg -> Instr)
-> CmmExpr -> CmmExpr -> NatM Register
trivialFCode_sse2 :: Width
-> (Format -> Operand -> Reg -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialFCode_sse2 Width
ty Format -> Operand -> Reg -> Instr
instr CmmExpr
x CmmExpr
y
= Format
-> (Operand -> Reg -> Instr) -> CmmExpr -> CmmExpr -> NatM Register
genTrivialCode Format
format (Format -> Operand -> Reg -> Instr
instr Format
format) CmmExpr
x CmmExpr
y
where format :: Format
format = Width -> Format
floatFormat Width
ty
coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register
coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register
coerceInt2FP Width
from Width
to CmmExpr
x = NatM Register
coerce_sse2
where
coerce_sse2 :: NatM Register
coerce_sse2 = do
(x_op, x_code) <- CmmExpr -> NatM (Operand, InstrBlock)
getOperand CmmExpr
x
let
opc = case Width
to of Width
W32 -> Format -> Operand -> Reg -> Instr
CVTSI2SS; Width
W64 -> Format -> Operand -> Reg -> Instr
CVTSI2SD
Width
n -> String -> Format -> Operand -> Reg -> Instr
forall a. HasCallStack => String -> a
panic (String -> Format -> Operand -> Reg -> Instr)
-> String -> Format -> Operand -> Reg -> Instr
forall a b. (a -> b) -> a -> b
$ String
"coerceInt2FP.sse: unhandled width ("
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Width -> String
forall a. Show a => a -> String
show Width
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
code Reg
dst = InstrBlock
x_code InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Operand -> Reg -> Instr
opc (Width -> Format
intFormat Width
from) Operand
x_op Reg
dst
return (Any (floatFormat to) code)
coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register
coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register
coerceFP2Int Width
from Width
to CmmExpr
x = NatM Register
coerceFP2Int_sse2
where
coerceFP2Int_sse2 :: NatM Register
coerceFP2Int_sse2 = do
(x_op, x_code) <- CmmExpr -> NatM (Operand, InstrBlock)
getOperand CmmExpr
x
let
opc = case Width
from of Width
W32 -> Format -> Operand -> Reg -> Instr
CVTTSS2SIQ; Width
W64 -> Format -> Operand -> Reg -> Instr
CVTTSD2SIQ;
Width
n -> String -> Format -> Operand -> Reg -> Instr
forall a. HasCallStack => String -> a
panic (String -> Format -> Operand -> Reg -> Instr)
-> String -> Format -> Operand -> Reg -> Instr
forall a b. (a -> b) -> a -> b
$ String
"coerceFP2Init.sse: unhandled width ("
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Width -> String
forall a. Show a => a -> String
show Width
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
code Reg
dst = InstrBlock
x_code InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Operand -> Reg -> Instr
opc (Width -> Format
intFormat Width
to) Operand
x_op Reg
dst
return (Any (intFormat to) code)
coerceFP2FP :: Width -> CmmExpr -> NatM Register
coerceFP2FP :: Width -> CmmExpr -> NatM Register
coerceFP2FP Width
to CmmExpr
x = do
(x_reg, x_code) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
x
let
opc = case Width
to of Width
W32 -> Reg -> Reg -> Instr
CVTSD2SS; Width
W64 -> Reg -> Reg -> Instr
CVTSS2SD;
Width
n -> String -> Reg -> Reg -> Instr
forall a. HasCallStack => String -> a
panic (String -> Reg -> Reg -> Instr) -> String -> Reg -> Reg -> Instr
forall a b. (a -> b) -> a -> b
$ String
"coerceFP2FP: unhandled width ("
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Width -> String
forall a. Show a => a -> String
show Width
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
code Reg
dst = InstrBlock
x_code InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> Instr
opc Reg
x_reg Reg
dst
return (Any ( floatFormat to) code)
sse2NegCode :: Width -> CmmExpr -> NatM Register
sse2NegCode :: Width -> CmmExpr -> NatM Register
sse2NegCode Width
w CmmExpr
x = do
let fmt :: Format
fmt = Width -> Format
floatFormat Width
w
x_code <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
x
let
const = case Format
fmt of
Format
FF32 -> Integer -> Width -> CmmLit
CmmInt Integer
0x80000000 Width
W32
Format
FF64 -> Integer -> Width -> CmmLit
CmmInt Integer
0x8000000000000000 Width
W64
x :: Format
x@Format
II8 -> Format -> CmmLit
forall {a} {b}. Show a => a -> b
wrongFmt Format
x
x :: Format
x@Format
II16 -> Format -> CmmLit
forall {a} {b}. Show a => a -> b
wrongFmt Format
x
x :: Format
x@Format
II32 -> Format -> CmmLit
forall {a} {b}. Show a => a -> b
wrongFmt Format
x
x :: Format
x@Format
II64 -> Format -> CmmLit
forall {a} {b}. Show a => a -> b
wrongFmt Format
x
x :: Format
x@(VecFormat {}) -> Format -> CmmLit
forall {a} {b}. Show a => a -> b
wrongFmt Format
x
where
wrongFmt :: a -> b
wrongFmt a
x = String -> b
forall a. HasCallStack => String -> a
panic (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ String
"sse2NegCode: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x
Amode amode amode_code <- memConstant (mkAlignment $ widthInBytes w) const
tmp <- getNewRegNat fmt
let
code Reg
dst = Reg -> InstrBlock
x_code Reg
dst InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
amode_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [
Format -> Operand -> Operand -> Instr
MOV Format
fmt (AddrMode -> Operand
OpAddr AddrMode
amode) (Reg -> Operand
OpReg Reg
tmp),
Format -> Operand -> Operand -> Instr
XOR Format
fmt (Reg -> Operand
OpReg Reg
tmp) (Reg -> Operand
OpReg Reg
dst)
]
return (Any fmt code)
needLlvm :: MachOp -> NatM a
needLlvm :: forall a. MachOp -> NatM a
needLlvm MachOp
mop =
String -> NatM a
forall a. HasCallStack => String -> a
sorry (String -> NatM a) -> String -> NatM a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ String
"Unsupported vector instruction for the native code generator:"
, MachOp -> String
forall a. Show a => a -> String
show MachOp
mop
, String
"Please use -fllvm." ]
incorrectOperands :: NatM a
incorrectOperands :: forall a. NatM a
incorrectOperands = String -> NatM a
forall a. HasCallStack => String -> a
sorry String
"Incorrect number of operands"
invalidConversion :: Width -> Width -> NatM a
invalidConversion :: forall a. Width -> Width -> NatM a
invalidConversion Width
from Width
to =
String -> NatM a
forall a. HasCallStack => String -> a
sorry (String -> NatM a) -> String -> NatM a
forall a b. (a -> b) -> a -> b
$ String
"Invalid conversion operation from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Width -> String
forall a. Show a => a -> String
show Width
from String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Width -> String
forall a. Show a => a -> String
show Width
to
invertCondBranches :: Maybe CFG
-> LabelMap a
-> [NatBasicBlock Instr]
-> [NatBasicBlock Instr]
invertCondBranches :: forall a.
Maybe CFG
-> LabelMap a -> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
invertCondBranches Maybe CFG
Nothing LabelMap a
_ [NatBasicBlock Instr]
bs = [NatBasicBlock Instr]
bs
invertCondBranches (Just CFG
cfg) LabelMap a
keep [NatBasicBlock Instr]
bs =
[NatBasicBlock Instr] -> [NatBasicBlock Instr]
invert [NatBasicBlock Instr]
bs
where
invert :: [NatBasicBlock Instr] -> [NatBasicBlock Instr]
invert :: [NatBasicBlock Instr] -> [NatBasicBlock Instr]
invert (BasicBlock Label
lbl1 [Instr]
ins:b2 :: NatBasicBlock Instr
b2@(BasicBlock Label
lbl2 [Instr]
_):[NatBasicBlock Instr]
bs)
|
Just (Instr
jmp1,Instr
jmp2) <- [Instr] -> Maybe (Instr, Instr)
forall a. [a] -> Maybe (a, a)
last2 [Instr]
ins
, JXX Cond
cond1 Label
target1 <- Instr
jmp1
, Label
target1 Label -> Label -> Bool
forall a. Eq a => a -> a -> Bool
== Label
lbl2
, JXX Cond
ALWAYS Label
target2 <- Instr
jmp2
, Just EdgeInfo
edgeInfo1 <- Label -> Label -> CFG -> Maybe EdgeInfo
getEdgeInfo Label
lbl1 Label
target1 CFG
cfg
, Just EdgeInfo
edgeInfo2 <- Label -> Label -> CFG -> Maybe EdgeInfo
getEdgeInfo Label
lbl1 Label
target2 CFG
cfg
, EdgeInfo -> TransitionSource
transitionSource EdgeInfo
edgeInfo1 TransitionSource -> TransitionSource -> Bool
forall a. Eq a => a -> a -> Bool
== EdgeInfo -> TransitionSource
transitionSource EdgeInfo
edgeInfo2
, CmmSource {trans_cmmNode :: TransitionSource -> CmmNode O C
trans_cmmNode = CmmNode O C
cmmCondBranch} <- EdgeInfo -> TransitionSource
transitionSource EdgeInfo
edgeInfo1
, CmmCondBranch (CmmMachOp MachOp
op [CmmExpr]
_args) Label
_ Label
_ Maybe Bool
_ <- CmmNode O C
cmmCondBranch
, Just Width
_ <- MachOp -> Maybe Width
maybeIntComparison MachOp
op
, Just Cond
invCond <- Cond -> Maybe Cond
maybeInvertCond Cond
cond1
= let jumps :: [Instr]
jumps =
case () of
()
_ | Bool -> Bool
not (Label -> LabelMap a -> Bool
forall a. Label -> LabelMap a -> Bool
mapMember Label
target1 LabelMap a
keep)
-> [Cond -> Label -> Instr
JXX Cond
invCond Label
target2]
| EdgeInfo -> EdgeWeight
edgeWeight EdgeInfo
edgeInfo2 EdgeWeight -> EdgeWeight -> Bool
forall a. Ord a => a -> a -> Bool
> EdgeInfo -> EdgeWeight
edgeWeight EdgeInfo
edgeInfo1
-> [Cond -> Label -> Instr
JXX Cond
invCond Label
target2, Cond -> Label -> Instr
JXX Cond
ALWAYS Label
target1]
| Bool
otherwise
-> [Instr
jmp1, Instr
jmp2]
in
(Label -> [Instr] -> NatBasicBlock Instr
forall i. Label -> [i] -> GenBasicBlock i
BasicBlock Label
lbl1
(Int -> [Instr] -> [Instr]
forall a. Int -> [a] -> [a]
dropTail Int
2 [Instr]
ins [Instr] -> [Instr] -> [Instr]
forall a. [a] -> [a] -> [a]
++ [Instr]
jumps))
NatBasicBlock Instr
-> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
forall a. a -> [a] -> [a]
: [NatBasicBlock Instr] -> [NatBasicBlock Instr]
invert (NatBasicBlock Instr
b2NatBasicBlock Instr
-> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
forall a. a -> [a] -> [a]
:[NatBasicBlock Instr]
bs)
invert (NatBasicBlock Instr
b:[NatBasicBlock Instr]
bs) = NatBasicBlock Instr
b NatBasicBlock Instr
-> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
forall a. a -> [a] -> [a]
: [NatBasicBlock Instr] -> [NatBasicBlock Instr]
invert [NatBasicBlock Instr]
bs
invert [] = []
genAtomicRMW
:: BlockId
-> Width
-> AtomicMachOp
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM (InstrBlock, Maybe BlockId)
genAtomicRMW :: Label
-> Width
-> AtomicMachOp
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM (InstrBlock, Maybe Label)
genAtomicRMW Label
bid Width
width AtomicMachOp
amop LocalReg
dst CmmExpr
addr CmmExpr
n = do
Amode amode addr_code <-
if AtomicMachOp
amop AtomicMachOp -> [AtomicMachOp] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [AtomicMachOp
AMO_Add, AtomicMachOp
AMO_Sub]
then CmmExpr -> NatM Amode
getAmode CmmExpr
addr
else CmmExpr -> NatM Amode
getSimpleAmode CmmExpr
addr
arg <- getNewRegNat format
arg_code <- getAnyReg n
platform <- ncgPlatform <$> getConfig
let dst_r = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (LocalReg -> CmmReg
CmmLocal LocalReg
dst)
(code, lbl) <- op_code dst_r arg amode
return (addr_code `appOL` arg_code arg `appOL` code, Just lbl)
where
op_code :: Reg
-> Reg
-> AddrMode
-> NatM (OrdList Instr,BlockId)
op_code :: Reg -> Reg -> AddrMode -> NatM (InstrBlock, Label)
op_code Reg
dst_r Reg
arg AddrMode
amode = do
case AtomicMachOp
amop of
AtomicMachOp
AMO_Add -> (InstrBlock, Label) -> NatM (InstrBlock, Label)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return ((InstrBlock, Label) -> NatM (InstrBlock, Label))
-> (InstrBlock, Label) -> NatM (InstrBlock, Label)
forall a b. (a -> b) -> a -> b
$ ([Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Instr -> Instr
LOCK (Format -> Operand -> Operand -> Instr
XADD Format
format (Reg -> Operand
OpReg Reg
arg) (AddrMode -> Operand
OpAddr AddrMode
amode))
, Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
arg) (Reg -> Operand
OpReg Reg
dst_r)
], Label
bid)
AtomicMachOp
AMO_Sub -> (InstrBlock, Label) -> NatM (InstrBlock, Label)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return ((InstrBlock, Label) -> NatM (InstrBlock, Label))
-> (InstrBlock, Label) -> NatM (InstrBlock, Label)
forall a b. (a -> b) -> a -> b
$ ([Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Instr
NEGI Format
format (Reg -> Operand
OpReg Reg
arg)
, Instr -> Instr
LOCK (Format -> Operand -> Operand -> Instr
XADD Format
format (Reg -> Operand
OpReg Reg
arg) (AddrMode -> Operand
OpAddr AddrMode
amode))
, Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
arg) (Reg -> Operand
OpReg Reg
dst_r)
], Label
bid)
AtomicMachOp
AMO_And -> (Operand -> Operand -> InstrBlock) -> NatM (InstrBlock, Label)
cmpxchg_code (\ Operand
src Operand
dst -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Instr -> InstrBlock) -> Instr -> InstrBlock
forall a b. (a -> b) -> a -> b
$ Format -> Operand -> Operand -> Instr
AND Format
format Operand
src Operand
dst)
AtomicMachOp
AMO_Nand -> (Operand -> Operand -> InstrBlock) -> NatM (InstrBlock, Label)
cmpxchg_code (\ Operand
src Operand
dst -> [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Operand -> Instr
AND Format
format Operand
src Operand
dst
, Format -> Operand -> Instr
NOT Format
format Operand
dst
])
AtomicMachOp
AMO_Or -> (Operand -> Operand -> InstrBlock) -> NatM (InstrBlock, Label)
cmpxchg_code (\ Operand
src Operand
dst -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Instr -> InstrBlock) -> Instr -> InstrBlock
forall a b. (a -> b) -> a -> b
$ Format -> Operand -> Operand -> Instr
OR Format
format Operand
src Operand
dst)
AtomicMachOp
AMO_Xor -> (Operand -> Operand -> InstrBlock) -> NatM (InstrBlock, Label)
cmpxchg_code (\ Operand
src Operand
dst -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Instr -> InstrBlock) -> Instr -> InstrBlock
forall a b. (a -> b) -> a -> b
$ Format -> Operand -> Operand -> Instr
XOR Format
format Operand
src Operand
dst)
where
cmpxchg_code :: (Operand -> Operand -> OrdList Instr)
-> NatM (OrdList Instr, BlockId)
cmpxchg_code :: (Operand -> Operand -> InstrBlock) -> NatM (InstrBlock, Label)
cmpxchg_code Operand -> Operand -> InstrBlock
instrs = do
lbl1 <- NatM Label
getBlockIdNat
lbl2 <- getBlockIdNat
tmp <- getNewRegNat format
addImmediateSuccessorNat bid lbl1
addImmediateSuccessorNat lbl1 lbl2
updateCfgNat (addWeightEdge lbl1 lbl1 0)
return $ (toOL
[ MOV format (OpAddr amode) (OpReg eax)
, JXX ALWAYS lbl1
, NEWBLOCK lbl1
, MOV format (OpReg eax) (OpReg dst_r)
, MOV format (OpReg eax) (OpReg tmp)
]
`appOL` instrs (OpReg arg) (OpReg tmp) `appOL` toOL
[ LOCK (CMPXCHG format (OpReg tmp) (OpAddr amode))
, JXX NE lbl1
, JXX ALWAYS lbl2
, NEWBLOCK lbl2
],
lbl2)
format :: Format
format = Width -> Format
intFormat Width
width
genCtz :: BlockId -> Width -> LocalReg -> CmmExpr -> NatM (InstrBlock, Maybe BlockId)
genCtz :: Label
-> Width -> LocalReg -> CmmExpr -> NatM (InstrBlock, Maybe Label)
genCtz Label
bid Width
width LocalReg
dst CmmExpr
src = do
is32Bit <- NatM Bool
is32BitPlatform
if is32Bit && width == W64
then genCtz64_32 bid dst src
else (,Nothing) <$> genCtzGeneric width dst src
genCtz64_32
:: BlockId
-> LocalReg
-> CmmExpr
-> NatM (InstrBlock, Maybe BlockId)
genCtz64_32 :: Label -> LocalReg -> CmmExpr -> NatM (InstrBlock, Maybe Label)
genCtz64_32 Label
bid LocalReg
dst CmmExpr
src = do
RegCode64 vcode rhi rlo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
src
let dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
lbl1 <- getBlockIdNat
lbl2 <- getBlockIdNat
tmp_r <- getNewRegNat II64
weights <- getCfgWeights
updateCfgNat (addWeightEdge bid lbl1 110 .
addWeightEdge lbl1 lbl2 110 .
addImmediateSuccessor weights bid lbl2)
let instrs = InstrBlock
vcode InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL
([ Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
rhi) (Reg -> Operand
OpReg Reg
tmp_r)
, Format -> Operand -> Operand -> Instr
OR Format
II32 (Reg -> Operand
OpReg Reg
rlo) (Reg -> Operand
OpReg Reg
tmp_r)
, Format -> Operand -> Operand -> Instr
MOV Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
64)) (Reg -> Operand
OpReg Reg
dst_r)
, Cond -> Label -> Instr
JXX Cond
EQQ Label
lbl2
, Cond -> Label -> Instr
JXX Cond
ALWAYS Label
lbl1
, Label -> Instr
NEWBLOCK Label
lbl1
, Format -> Operand -> Reg -> Instr
BSF Format
II32 (Reg -> Operand
OpReg Reg
rhi) Reg
dst_r
, Format -> Operand -> Operand -> Instr
ADD Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
32)) (Reg -> Operand
OpReg Reg
dst_r)
, Format -> Operand -> Reg -> Instr
BSF Format
II32 (Reg -> Operand
OpReg Reg
rlo) Reg
tmp_r
, Cond -> Format -> Operand -> Reg -> Instr
CMOV Cond
NE Format
II32 (Reg -> Operand
OpReg Reg
tmp_r) Reg
dst_r
, Cond -> Label -> Instr
JXX Cond
ALWAYS Label
lbl2
, Label -> Instr
NEWBLOCK Label
lbl2
])
return (instrs, Just lbl2)
genCtzGeneric :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genCtzGeneric :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genCtzGeneric Width
width LocalReg
dst CmmExpr
src = do
code_src <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
src
config <- getConfig
let bw = Width -> Int
widthInBits Width
width
let dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
if ncgBmiVersion config >= Just BMI2
then do
src_r <- getNewRegNat (intFormat width)
let instrs = InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
appOL (Reg -> InstrBlock
code_src Reg
src_r) (InstrBlock -> InstrBlock) -> InstrBlock -> InstrBlock
forall a b. (a -> b) -> a -> b
$ case Width
width of
Width
W8 -> [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL
[ Format -> Operand -> Operand -> Instr
OR Format
II32 (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
0xFFFFFF00)) (Reg -> Operand
OpReg Reg
src_r)
, Format -> Operand -> Reg -> Instr
TZCNT Format
II32 (Reg -> Operand
OpReg Reg
src_r) Reg
dst_r
]
Width
W16 -> [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL
[ Format -> Operand -> Reg -> Instr
TZCNT Format
II16 (Reg -> Operand
OpReg Reg
src_r) Reg
dst_r
, Format -> Operand -> Operand -> Instr
MOVZxL Format
II16 (Reg -> Operand
OpReg Reg
dst_r) (Reg -> Operand
OpReg Reg
dst_r)
]
Width
_ -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Instr -> InstrBlock) -> Instr -> InstrBlock
forall a b. (a -> b) -> a -> b
$ Format -> Operand -> Reg -> Instr
TZCNT (Width -> Format
intFormat Width
width) (Reg -> Operand
OpReg Reg
src_r) Reg
dst_r
return instrs
else do
let format = if Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W8 then Format
II16 else Width -> Format
intFormat Width
width
src_r <- getNewRegNat format
tmp_r <- getNewRegNat format
let instrs = Reg -> InstrBlock
code_src Reg
src_r InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL
([ Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
src_r) (Reg -> Operand
OpReg Reg
src_r) | Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W8 ] [Instr] -> [Instr] -> [Instr]
forall a. [a] -> [a] -> [a]
++
[ Format -> Operand -> Reg -> Instr
BSF Format
format (Reg -> Operand
OpReg Reg
src_r) Reg
tmp_r
, Format -> Operand -> Operand -> Instr
MOV Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
bw)) (Reg -> Operand
OpReg Reg
dst_r)
, Cond -> Format -> Operand -> Reg -> Instr
CMOV Cond
NE Format
format (Reg -> Operand
OpReg Reg
tmp_r) Reg
dst_r
])
return instrs
genMemCpy
:: BlockId
-> Int
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genMemCpy :: Label -> Int -> CmmExpr -> CmmExpr -> CmmExpr -> NatM InstrBlock
genMemCpy Label
bid Int
align CmmExpr
dst CmmExpr
src CmmExpr
arg_n = do
let libc_memcpy :: NatM InstrBlock
libc_memcpy = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"memcpy") [] [CmmExpr
dst,CmmExpr
src,CmmExpr
arg_n]
case CmmExpr
arg_n of
CmmLit (CmmInt Integer
n Width
_) -> do
mcode <- Int -> CmmExpr -> CmmExpr -> Integer -> NatM (Maybe InstrBlock)
genMemCpyInlineMaybe Int
align CmmExpr
dst CmmExpr
src Integer
n
case mcode of
Maybe InstrBlock
Nothing -> NatM InstrBlock
libc_memcpy
Just InstrBlock
c -> InstrBlock -> NatM InstrBlock
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InstrBlock
c
CmmExpr
_ -> NatM InstrBlock
libc_memcpy
genMemCpyInlineMaybe
:: Int
-> CmmExpr
-> CmmExpr
-> Integer
-> NatM (Maybe InstrBlock)
genMemCpyInlineMaybe :: Int -> CmmExpr -> CmmExpr -> Integer -> NatM (Maybe InstrBlock)
genMemCpyInlineMaybe Int
align CmmExpr
dst CmmExpr
src Integer
n = do
config <- NatM NCGConfig
getConfig
let
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
maxAlignment = Platform -> Alignment
wordAlignment Platform
platform
effectiveAlignment = Alignment -> Alignment -> Alignment
forall a. Ord a => a -> a -> a
min (Int -> Alignment
alignmentOf Int
align) Alignment
maxAlignment
format = Width -> Format
intFormat (Width -> Format) -> (Int -> Width) -> Int -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Width
widthFromBytes (Int -> Format) -> Int -> Format
forall a b. (a -> b) -> a -> b
$ Alignment -> Int
alignmentBytes Alignment
effectiveAlignment
let sizeBytes :: Integer
sizeBytes = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Format -> Int
formatInBytes Format
format)
let insns = Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* ((Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
sizeBytes Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
sizeBytes)
go :: Reg -> Reg -> Reg -> Integer -> OrdList Instr
go Reg
dst Reg
src Reg
tmp Integer
i
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
sizeBytes =
Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
format (AddrMode -> Operand
OpAddr AddrMode
src_addr) (Reg -> Operand
OpReg Reg
tmp)) InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
tmp) (AddrMode -> Operand
OpAddr AddrMode
dst_addr)) InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> Reg -> Reg -> Integer -> InstrBlock
go Reg
dst Reg
src Reg
tmp (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
sizeBytes)
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
4 =
Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
II32 (AddrMode -> Operand
OpAddr AddrMode
src_addr) (Reg -> Operand
OpReg Reg
tmp)) InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
II32 (Reg -> Operand
OpReg Reg
tmp) (AddrMode -> Operand
OpAddr AddrMode
dst_addr)) InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> Reg -> Reg -> Integer -> InstrBlock
go Reg
dst Reg
src Reg
tmp (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
4)
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
2 =
Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOVZxL Format
II16 (AddrMode -> Operand
OpAddr AddrMode
src_addr) (Reg -> Operand
OpReg Reg
tmp)) InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
II16 (Reg -> Operand
OpReg Reg
tmp) (AddrMode -> Operand
OpAddr AddrMode
dst_addr)) InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> Reg -> Reg -> Integer -> InstrBlock
go Reg
dst Reg
src Reg
tmp (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
2)
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
1 =
Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (AddrMode -> Operand
OpAddr AddrMode
src_addr) (Reg -> Operand
OpReg Reg
tmp)) InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
II8 (Reg -> Operand
OpReg Reg
tmp) (AddrMode -> Operand
OpAddr AddrMode
dst_addr)) InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> Reg -> Reg -> Integer -> InstrBlock
go Reg
dst Reg
src Reg
tmp (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
| Bool
otherwise = InstrBlock
forall a. OrdList a
nilOL
where
src_addr :: AddrMode
src_addr = EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
src) EAIndex
EAIndexNone
(Integer -> Imm
ImmInteger (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
i))
dst_addr :: AddrMode
dst_addr = EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
dst) EAIndex
EAIndexNone
(Integer -> Imm
ImmInteger (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
i))
if insns > fromIntegral (ncgInlineThresholdMemcpy config)
then pure Nothing
else do
code_dst <- getAnyReg dst
dst_r <- getNewRegNat format
code_src <- getAnyReg src
src_r <- getNewRegNat format
tmp_r <- getNewRegNat format
pure $ Just $ code_dst dst_r `appOL` code_src src_r `appOL`
go dst_r src_r tmp_r (fromInteger n)
genMemSet
:: BlockId
-> Int
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genMemSet :: Label -> Int -> CmmExpr -> CmmExpr -> CmmExpr -> NatM InstrBlock
genMemSet Label
bid Int
align CmmExpr
dst CmmExpr
arg_c CmmExpr
arg_n = do
let libc_memset :: NatM InstrBlock
libc_memset = Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"memset") [] [CmmExpr
dst,CmmExpr
arg_c,CmmExpr
arg_n]
case (CmmExpr
arg_c,CmmExpr
arg_n) of
(CmmLit (CmmInt Integer
c Width
_), CmmLit (CmmInt Integer
n Width
_)) -> do
mcode <- Int -> CmmExpr -> Integer -> Integer -> NatM (Maybe InstrBlock)
genMemSetInlineMaybe Int
align CmmExpr
dst Integer
c Integer
n
case mcode of
Maybe InstrBlock
Nothing -> NatM InstrBlock
libc_memset
Just InstrBlock
c -> InstrBlock -> NatM InstrBlock
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InstrBlock
c
(CmmExpr, CmmExpr)
_ -> NatM InstrBlock
libc_memset
genMemSetInlineMaybe
:: Int
-> CmmExpr
-> Integer
-> Integer
-> NatM (Maybe InstrBlock)
genMemSetInlineMaybe :: Int -> CmmExpr -> Integer -> Integer -> NatM (Maybe InstrBlock)
genMemSetInlineMaybe Int
align CmmExpr
dst Integer
c Integer
n = do
config <- NatM NCGConfig
getConfig
let
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
maxAlignment = Platform -> Alignment
wordAlignment Platform
platform
effectiveAlignment = Alignment -> Alignment -> Alignment
forall a. Ord a => a -> a -> a
min (Int -> Alignment
alignmentOf Int
align) Alignment
maxAlignment
format = Width -> Format
intFormat (Width -> Format) -> (Int -> Width) -> Int -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Width
widthFromBytes (Int -> Format) -> Int -> Format
forall a b. (a -> b) -> a -> b
$ Alignment -> Int
alignmentBytes Alignment
effectiveAlignment
c2 = Integer
c Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
c
c4 = Integer
c2 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
16 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
c2
c8 = Integer
c4 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
32 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
c4
insns = (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
sizeBytes Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
sizeBytes
sizeBytes :: Integer
sizeBytes = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Format -> Int
formatInBytes Format
format)
gen4 :: AddrMode -> Integer -> (InstrBlock, Integer)
gen4 AddrMode
addr Integer
size
| Integer
size Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
4 =
(Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
II32 (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
c4)) (AddrMode -> Operand
OpAddr AddrMode
addr)), Integer
4)
| Integer
size Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
2 =
(Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
II16 (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
c2)) (AddrMode -> Operand
OpAddr AddrMode
addr)), Integer
2)
| Integer
size Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
1 =
(Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
II8 (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
c)) (AddrMode -> Operand
OpAddr AddrMode
addr)), Integer
1)
| Bool
otherwise = (InstrBlock
forall a. OrdList a
nilOL, Integer
0)
gen8 :: AddrMode -> Reg -> InstrBlock
gen8 AddrMode
addr Reg
reg8byte =
Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
reg8byte) (AddrMode -> Operand
OpAddr AddrMode
addr))
go4 :: Reg -> Integer -> InstrBlock
go4 Reg
dst Integer
left =
if Integer
left Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 then InstrBlock
forall a. OrdList a
nilOL
else InstrBlock
curMov InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> Integer -> InstrBlock
go4 Reg
dst (Integer
left Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
curWidth)
where
possibleWidth :: Integer
possibleWidth = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
left Integer
sizeBytes
dst_addr :: AddrMode
dst_addr = EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
dst) EAIndex
EAIndexNone (Integer -> Imm
ImmInteger (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
left))
(InstrBlock
curMov, Integer
curWidth) = AddrMode -> Integer -> (InstrBlock, Integer)
gen4 AddrMode
dst_addr Integer
possibleWidth
go8 :: Reg -> Reg -> Integer -> InstrBlock
go8 Reg
dst Reg
reg8byte Integer
left =
if Integer
possibleWidth Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
8 then
let curMov :: InstrBlock
curMov = AddrMode -> Reg -> InstrBlock
gen8 AddrMode
dst_addr Reg
reg8byte
in InstrBlock
curMov InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> Reg -> Integer -> InstrBlock
go8 Reg
dst Reg
reg8byte (Integer
left Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
8)
else Reg -> Integer -> InstrBlock
go4 Reg
dst Integer
left
where
possibleWidth :: Integer
possibleWidth = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
left Integer
sizeBytes
dst_addr :: AddrMode
dst_addr = EABase -> EAIndex -> Imm -> AddrMode
AddrBaseIndex (Reg -> EABase
EABaseReg Reg
dst) EAIndex
EAIndexNone (Integer -> Imm
ImmInteger (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
left))
if fromInteger insns > ncgInlineThresholdMemset config
then pure Nothing
else do
code_dst <- getAnyReg dst
dst_r <- getNewRegNat format
if format == II64 && n >= 8
then do
code_imm8byte <- getAnyReg (CmmLit (CmmInt c8 W64))
imm8byte_r <- getNewRegNat II64
return $ Just $ code_dst dst_r `appOL`
code_imm8byte imm8byte_r `appOL`
go8 dst_r imm8byte_r (fromInteger n)
else
return $ Just $ code_dst dst_r `appOL`
go4 dst_r (fromInteger n)
genMemMove :: BlockId -> p -> CmmActual -> CmmActual -> CmmActual -> NatM InstrBlock
genMemMove :: forall p.
Label -> p -> CmmExpr -> CmmExpr -> CmmExpr -> NatM InstrBlock
genMemMove Label
bid p
_align CmmExpr
dst CmmExpr
src CmmExpr
n = do
Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"memmove") [] [CmmExpr
dst,CmmExpr
src,CmmExpr
n]
genMemCmp :: BlockId -> p -> CmmFormal -> CmmActual -> CmmActual -> CmmActual -> NatM InstrBlock
genMemCmp :: forall p.
Label
-> p
-> LocalReg
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genMemCmp Label
bid p
_align LocalReg
res CmmExpr
dst CmmExpr
src CmmExpr
n = do
Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genLibCCall Label
bid (String -> FastString
fsLit String
"memcmp") [LocalReg
res] [CmmExpr
dst,CmmExpr
src,CmmExpr
n]
genPrefetchData :: Int -> CmmExpr -> NatM (OrdList Instr)
genPrefetchData :: Int -> CmmExpr -> NatM InstrBlock
genPrefetchData Int
n CmmExpr
src = do
is32Bit <- NatM Bool
is32BitPlatform
let
format = Bool -> Format
archWordFormat Bool
is32Bit
genPrefetch CmmExpr
inRegSrc Operand -> Instr
prefetchCTor = do
code_src <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
inRegSrc
src_r <- getNewRegNat format
return $ code_src src_r `appOL`
(unitOL (prefetchCTor (OpAddr
((AddrBaseIndex (EABaseReg src_r ) EAIndexNone (ImmInt 0)))) ))
case n of
Int
0 -> CmmExpr -> (Operand -> Instr) -> NatM InstrBlock
genPrefetch CmmExpr
src ((Operand -> Instr) -> NatM InstrBlock)
-> (Operand -> Instr) -> NatM InstrBlock
forall a b. (a -> b) -> a -> b
$ PrefetchVariant -> Format -> Operand -> Instr
PREFETCH PrefetchVariant
NTA Format
format
Int
1 -> CmmExpr -> (Operand -> Instr) -> NatM InstrBlock
genPrefetch CmmExpr
src ((Operand -> Instr) -> NatM InstrBlock)
-> (Operand -> Instr) -> NatM InstrBlock
forall a b. (a -> b) -> a -> b
$ PrefetchVariant -> Format -> Operand -> Instr
PREFETCH PrefetchVariant
Lvl2 Format
format
Int
2 -> CmmExpr -> (Operand -> Instr) -> NatM InstrBlock
genPrefetch CmmExpr
src ((Operand -> Instr) -> NatM InstrBlock)
-> (Operand -> Instr) -> NatM InstrBlock
forall a b. (a -> b) -> a -> b
$ PrefetchVariant -> Format -> Operand -> Instr
PREFETCH PrefetchVariant
Lvl1 Format
format
Int
3 -> CmmExpr -> (Operand -> Instr) -> NatM InstrBlock
genPrefetch CmmExpr
src ((Operand -> Instr) -> NatM InstrBlock)
-> (Operand -> Instr) -> NatM InstrBlock
forall a b. (a -> b) -> a -> b
$ PrefetchVariant -> Format -> Operand -> Instr
PREFETCH PrefetchVariant
Lvl0 Format
format
Int
l -> String -> SDoc -> NatM InstrBlock
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"genPrefetchData: unexpected prefetch level" (Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
l)
genByteSwap :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genByteSwap :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genByteSwap Width
width LocalReg
dst CmmExpr
src = do
is32Bit <- NatM Bool
is32BitPlatform
let format = Width -> Format
intFormat Width
width
case width of
Width
W64 | Bool
is32Bit -> do
let Reg64 Reg
dst_hi Reg
dst_lo = HasDebugCallStack => LocalReg -> Reg64
LocalReg -> Reg64
localReg64 LocalReg
dst
RegCode64 vcode rhi rlo <- HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock)
CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 CmmExpr
src
return $ vcode `appOL`
toOL [ MOV II32 (OpReg rlo) (OpReg dst_hi),
MOV II32 (OpReg rhi) (OpReg dst_lo),
BSWAP II32 dst_hi,
BSWAP II32 dst_lo ]
Width
W16 -> do
let dst_r :: Reg
dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
code_src <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
src
return $ code_src dst_r `appOL`
unitOL (BSWAP II32 dst_r) `appOL`
unitOL (SHR II32 (OpImm $ ImmInt 16) (OpReg dst_r))
Width
_ -> do
let dst_r :: Reg
dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
code_src <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
src
return $ code_src dst_r `appOL` unitOL (BSWAP format dst_r)
genBitRev :: BlockId -> Width -> CmmFormal -> CmmActual -> NatM InstrBlock
genBitRev :: Label -> Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genBitRev Label
bid Width
width LocalReg
dst CmmExpr
src = do
Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (Width -> FastString
bRevLabel Width
width) [LocalReg
dst] [CmmExpr
src]
genPopCnt :: BlockId -> Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genPopCnt :: Label -> Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genPopCnt Label
bid Width
width LocalReg
dst CmmExpr
src = do
config <- NatM NCGConfig
getConfig
let
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
format = Width -> Format
intFormat Width
width
sse4_2Enabled >>= \case
Bool
True -> do
code_src <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
src
src_r <- getNewRegNat format
let dst_r = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (LocalReg -> CmmReg
CmmLocal LocalReg
dst)
return $ code_src src_r `appOL`
(if width == W8 then
unitOL (MOVZxL II8 (OpReg src_r) (OpReg src_r)) `appOL`
unitOL (POPCNT II16 (OpReg src_r) dst_r)
else
unitOL (POPCNT format (OpReg src_r) dst_r)) `appOL`
(if width == W8 || width == W16 then
unitOL (MOVZxL II16 (OpReg dst_r) (OpReg dst_r))
else nilOL)
Bool
False ->
Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (Width -> FastString
popCntLabel Width
width) [LocalReg
dst] [CmmExpr
src]
genPdep :: BlockId -> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genPdep :: Label -> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genPdep Label
bid Width
width LocalReg
dst CmmExpr
src CmmExpr
mask = do
config <- NatM NCGConfig
getConfig
let
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
format = Width -> Format
intFormat Width
width
if ncgBmiVersion config >= Just BMI2
then do
code_src <- getAnyReg src
code_mask <- getAnyReg mask
src_r <- getNewRegNat format
mask_r <- getNewRegNat format
let dst_r = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (LocalReg -> CmmReg
CmmLocal LocalReg
dst)
return $ code_src src_r `appOL` code_mask mask_r `appOL`
( if width == W8 || width == W16 then
toOL
[ MOVZxL format (OpReg src_r ) (OpReg src_r )
, MOVZxL format (OpReg mask_r) (OpReg mask_r)
, PDEP II32 (OpReg mask_r) (OpReg src_r ) dst_r
, MOVZxL format (OpReg dst_r) (OpReg dst_r)
]
else
unitOL (PDEP format (OpReg mask_r) (OpReg src_r) dst_r)
)
else
genPrimCCall bid (pdepLabel width) [dst] [src,mask]
genPext :: BlockId -> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genPext :: Label -> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genPext Label
bid Width
width LocalReg
dst CmmExpr
src CmmExpr
mask = do
config <- NatM NCGConfig
getConfig
if ncgBmiVersion config >= Just BMI2
then do
let format = Width -> Format
intFormat Width
width
let dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
code_src <- getAnyReg src
code_mask <- getAnyReg mask
src_r <- getNewRegNat format
mask_r <- getNewRegNat format
return $ code_src src_r `appOL` code_mask mask_r `appOL`
(if width == W8 || width == W16 then
toOL
[ MOVZxL format (OpReg src_r ) (OpReg src_r )
, MOVZxL format (OpReg mask_r) (OpReg mask_r)
, PEXT II32 (OpReg mask_r) (OpReg src_r ) dst_r
, MOVZxL format (OpReg dst_r) (OpReg dst_r)
]
else
unitOL (PEXT format (OpReg mask_r) (OpReg src_r) dst_r)
)
else
genPrimCCall bid (pextLabel width) [dst] [src,mask]
genClz :: BlockId -> Width -> CmmFormal -> CmmActual -> NatM InstrBlock
genClz :: Label -> Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genClz Label
bid Width
width LocalReg
dst CmmExpr
src = do
is32Bit <- NatM Bool
is32BitPlatform
config <- getConfig
if is32Bit && width == W64
then
genPrimCCall bid (clzLabel width) [dst] [src]
else do
code_src <- getAnyReg src
let dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
if ncgBmiVersion config >= Just BMI2
then do
src_r <- getNewRegNat (intFormat width)
return $ appOL (code_src src_r) $ case width of
Width
W8 -> [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL
[ Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
src_r) (Reg -> Operand
OpReg Reg
src_r)
, Format -> Operand -> Reg -> Instr
LZCNT Format
II32 (Reg -> Operand
OpReg Reg
src_r) Reg
dst_r
, Format -> Operand -> Operand -> Instr
SUB Format
II32 (Imm -> Operand
OpImm (Int -> Imm
ImmInt Int
24)) (Reg -> Operand
OpReg Reg
dst_r)
]
Width
W16 -> [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL
[ Format -> Operand -> Reg -> Instr
LZCNT Format
II16 (Reg -> Operand
OpReg Reg
src_r) Reg
dst_r
, Format -> Operand -> Operand -> Instr
MOVZxL Format
II16 (Reg -> Operand
OpReg Reg
dst_r) (Reg -> Operand
OpReg Reg
dst_r)
]
Width
_ -> Instr -> InstrBlock
forall a. a -> OrdList a
unitOL (Format -> Operand -> Reg -> Instr
LZCNT (Width -> Format
intFormat Width
width) (Reg -> Operand
OpReg Reg
src_r) Reg
dst_r)
else do
let format = if Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W8 then Format
II16 else Width -> Format
intFormat Width
width
let bw = Width -> Int
widthInBits Width
width
src_r <- getNewRegNat format
tmp_r <- getNewRegNat format
return $ code_src src_r `appOL` toOL
([ MOVZxL II8 (OpReg src_r) (OpReg src_r) | width == W8 ] ++
[ BSR format (OpReg src_r) tmp_r
, MOV II32 (OpImm (ImmInt (2*bw-1))) (OpReg dst_r)
, CMOV NE format (OpReg tmp_r) dst_r
, XOR format (OpImm (ImmInt (bw-1))) (OpReg dst_r)
])
genWordToFloat :: BlockId -> Width -> CmmFormal -> CmmActual -> NatM InstrBlock
genWordToFloat :: Label -> Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genWordToFloat Label
bid Width
width LocalReg
dst CmmExpr
src =
Label -> FastString -> [LocalReg] -> [CmmExpr] -> NatM InstrBlock
genPrimCCall Label
bid (Width -> FastString
word2FloatLabel Width
width) [LocalReg
dst] [CmmExpr
src]
genAtomicRead :: Width -> MemoryOrdering -> LocalReg -> CmmExpr -> NatM InstrBlock
genAtomicRead :: Width -> MemoryOrdering -> LocalReg -> CmmExpr -> NatM InstrBlock
genAtomicRead Width
width MemoryOrdering
_mord LocalReg
dst CmmExpr
addr = do
let fmt :: Format
fmt = Width -> Format
intFormat Width
width
load_code <- (Operand -> Operand -> Instr)
-> CmmExpr -> NatM (Reg -> InstrBlock)
intLoadCode (Format -> Operand -> Operand -> Instr
MOV Format
fmt) CmmExpr
addr
return (load_code (getLocalRegReg dst))
genAtomicWrite :: Width -> MemoryOrdering -> CmmExpr -> CmmExpr -> NatM InstrBlock
genAtomicWrite :: Width -> MemoryOrdering -> CmmExpr -> CmmExpr -> NatM InstrBlock
genAtomicWrite Width
width MemoryOrdering
mord CmmExpr
addr CmmExpr
val = do
code <- Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_IntCode (Width -> Format
intFormat Width
width) CmmExpr
addr CmmExpr
val
let needs_fence = case MemoryOrdering
mord of
MemoryOrdering
MemOrderSeqCst -> Bool
True
MemoryOrdering
MemOrderRelease -> Bool
False
MemoryOrdering
MemOrderAcquire -> String -> SDoc -> Bool
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"genAtomicWrite: acquire ordering on write" SDoc
forall doc. IsOutput doc => doc
empty
MemoryOrdering
MemOrderRelaxed -> Bool
False
return $ if needs_fence then code `snocOL` MFENCE else code
genCmpXchg
:: BlockId
-> Width
-> LocalReg
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genCmpXchg :: Label
-> Width
-> LocalReg
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genCmpXchg Label
bid Width
width LocalReg
dst CmmExpr
addr CmmExpr
old CmmExpr
new = do
is32Bit <- NatM Bool
is32BitPlatform
if not (is32Bit && width == W64)
then do
let format = Width -> Format
intFormat Width
width
Amode amode addr_code <- getSimpleAmode addr
newval <- getNewRegNat format
newval_code <- getAnyReg new
oldval <- getNewRegNat format
oldval_code <- getAnyReg old
platform <- getPlatform
let dst_r = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (LocalReg -> CmmReg
CmmLocal LocalReg
dst)
code = [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL
[ Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
oldval) (Reg -> Operand
OpReg Reg
eax)
, Instr -> Instr
LOCK (Format -> Operand -> Operand -> Instr
CMPXCHG Format
format (Reg -> Operand
OpReg Reg
newval) (AddrMode -> Operand
OpAddr AddrMode
amode))
, Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
eax) (Reg -> Operand
OpReg Reg
dst_r)
]
return $ addr_code `appOL` newval_code newval `appOL` oldval_code oldval
`appOL` code
else
genPrimCCall bid (cmpxchgLabel width) [dst] [addr,old,new]
genXchg :: Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genXchg :: Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genXchg Width
width LocalReg
dst CmmExpr
addr CmmExpr
value = do
is32Bit <- NatM Bool
is32BitPlatform
when (is32Bit && width == W64) $
panic "genXchg: 64bit atomic exchange not supported on 32bit platforms"
Amode amode addr_code <- getSimpleAmode addr
(newval, newval_code) <- getSomeReg value
let format = Width -> Format
intFormat Width
width
let dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
let code = [Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL
[ Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
newval) (Reg -> Operand
OpReg Reg
dst_r)
, Format -> Operand -> Reg -> Instr
XCHG Format
format (AddrMode -> Operand
OpAddr AddrMode
amode) Reg
dst_r
]
return $ addr_code `appOL` newval_code `appOL` code
genFloatAbs :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genFloatAbs :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock
genFloatAbs Width
width LocalReg
dst CmmExpr
src = do
let
format :: Format
format = Width -> Format
floatFormat Width
width
const :: CmmLit
const = case Width
width of
Width
W32 -> Integer -> Width -> CmmLit
CmmInt Integer
0x7fffffff Width
W32
Width
W64 -> Integer -> Width -> CmmLit
CmmInt Integer
0x7fffffffffffffff Width
W64
Width
_ -> String -> SDoc -> CmmLit
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"genFloatAbs: invalid width" (Width -> SDoc
forall a. Outputable a => a -> SDoc
ppr Width
width)
src_code <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
src
Amode amode amode_code <- memConstant (mkAlignment $ widthInBytes width) const
tmp <- getNewRegNat format
let dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
pure $ src_code dst_r `appOL` amode_code `appOL` toOL
[ MOV format (OpAddr amode) (OpReg tmp)
, AND format (OpReg tmp) (OpReg dst_r)
]
genFloatSqrt :: Format -> LocalReg -> CmmExpr -> NatM InstrBlock
genFloatSqrt :: Format -> LocalReg -> CmmExpr -> NatM InstrBlock
genFloatSqrt Format
format LocalReg
dst CmmExpr
src = do
let dst_r :: Reg
dst_r = LocalReg -> Reg
getLocalRegReg LocalReg
dst
src_code <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
src
pure $ src_code dst_r `snocOL` SQRT format (OpReg dst_r) dst_r
genAddSubRetCarry
:: Width
-> (Format -> Operand -> Operand -> Instr)
-> (Format -> Maybe (Operand -> Operand -> Instr))
-> Cond
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genAddSubRetCarry :: Width
-> (Format -> Operand -> Operand -> Instr)
-> (Format -> Maybe (Operand -> Operand -> Instr))
-> Cond
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genAddSubRetCarry Width
width Format -> Operand -> Operand -> Instr
instr Format -> Maybe (Operand -> Operand -> Instr)
mrevinstr Cond
cond LocalReg
res_r LocalReg
res_c CmmExpr
arg_x CmmExpr
arg_y = do
platform <- NCGConfig -> Platform
ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NatM NCGConfig
getConfig
let format = Width -> Format
intFormat Width
width
rCode <- anyReg =<< trivialCode width (instr format)
(mrevinstr format) arg_x arg_y
reg_tmp <- getNewRegNat II8
let reg_c = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (LocalReg -> CmmReg
CmmLocal LocalReg
res_c)
reg_r = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (LocalReg -> CmmReg
CmmLocal LocalReg
res_r)
code = Reg -> InstrBlock
rCode Reg
reg_r InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Cond -> Operand -> Instr
SETCC Cond
cond (Reg -> Operand
OpReg Reg
reg_tmp) InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
reg_tmp) (Reg -> Operand
OpReg Reg
reg_c)
return code
genAddWithCarry
:: Width
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genAddWithCarry :: Width
-> LocalReg -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genAddWithCarry Width
width LocalReg
res_h LocalReg
res_l CmmExpr
arg_x CmmExpr
arg_y = do
hCode <- HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg (CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
0 Width
width))
let format = Width -> Format
intFormat Width
width
lCode <- anyReg =<< trivialCode width (ADD_CC format)
(Just (ADD_CC format)) arg_x arg_y
let reg_l = LocalReg -> Reg
getLocalRegReg LocalReg
res_l
reg_h = LocalReg -> Reg
getLocalRegReg LocalReg
res_h
code = Reg -> InstrBlock
hCode Reg
reg_h InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> InstrBlock
lCode Reg
reg_l InstrBlock -> Instr -> InstrBlock
forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Operand -> Operand -> Instr
ADC Format
format (Imm -> Operand
OpImm (Integer -> Imm
ImmInteger Integer
0)) (Reg -> Operand
OpReg Reg
reg_h)
return code
genSignedLargeMul
:: Width
-> LocalReg
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genSignedLargeMul :: Width
-> LocalReg
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genSignedLargeMul Width
width LocalReg
res_c LocalReg
res_h LocalReg
res_l CmmExpr
arg_x CmmExpr
arg_y = do
(y_reg, y_code) <- CmmExpr -> NatM (Operand, InstrBlock)
getRegOrMem CmmExpr
arg_y
x_code <- getAnyReg arg_x
reg_tmp <- getNewRegNat II8
let format = Width -> Format
intFormat Width
width
reg_h = LocalReg -> Reg
getLocalRegReg LocalReg
res_h
reg_l = LocalReg -> Reg
getLocalRegReg LocalReg
res_l
reg_c = LocalReg -> Reg
getLocalRegReg LocalReg
res_c
code = InstrBlock
y_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> InstrBlock
x_code Reg
rax InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [ Format -> Operand -> Instr
IMUL2 Format
format Operand
y_reg
, Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
rdx) (Reg -> Operand
OpReg Reg
reg_h)
, Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
rax) (Reg -> Operand
OpReg Reg
reg_l)
, Cond -> Operand -> Instr
SETCC Cond
CARRY (Reg -> Operand
OpReg Reg
reg_tmp)
, Format -> Operand -> Operand -> Instr
MOVZxL Format
II8 (Reg -> Operand
OpReg Reg
reg_tmp) (Reg -> Operand
OpReg Reg
reg_c)
]
return code
genUnsignedLargeMul
:: Width
-> LocalReg
-> LocalReg
-> CmmExpr
-> CmmExpr
-> NatM (OrdList Instr)
genUnsignedLargeMul :: Width
-> LocalReg -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
genUnsignedLargeMul Width
width LocalReg
res_h LocalReg
res_l CmmExpr
arg_x CmmExpr
arg_y = do
(y_reg, y_code) <- CmmExpr -> NatM (Operand, InstrBlock)
getRegOrMem CmmExpr
arg_y
x_code <- getAnyReg arg_x
let format = Width -> Format
intFormat Width
width
reg_h = LocalReg -> Reg
getLocalRegReg LocalReg
res_h
reg_l = LocalReg -> Reg
getLocalRegReg LocalReg
res_l
code = InstrBlock
y_code InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
Reg -> InstrBlock
x_code Reg
rax InstrBlock -> InstrBlock -> InstrBlock
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
[Instr] -> InstrBlock
forall a. [a] -> OrdList a
toOL [Format -> Operand -> Instr
MUL2 Format
format Operand
y_reg,
Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
rdx) (Reg -> Operand
OpReg Reg
reg_h),
Format -> Operand -> Operand -> Instr
MOV Format
format (Reg -> Operand
OpReg Reg
rax) (Reg -> Operand
OpReg Reg
reg_l)]
return code
genQuotRem
:: Width
-> Bool
-> LocalReg
-> LocalReg
-> Maybe CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genQuotRem :: Width
-> Bool
-> LocalReg
-> LocalReg
-> Maybe CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genQuotRem Width
width Bool
signed LocalReg
res_q LocalReg
res_r Maybe CmmExpr
m_arg_x_high CmmExpr
arg_x_low CmmExpr
arg_y = do
case Width
width of
Width
W8 -> do
let widen :: MachOp
widen | Bool
signed = Width -> Width -> MachOp
MO_SS_Conv Width
W8 Width
W16
| Bool
otherwise = Width -> Width -> MachOp
MO_UU_Conv Width
W8 Width
W16
arg_x_low_16 :: CmmExpr
arg_x_low_16 = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
widen [CmmExpr
arg_x_low]
arg_y_16 :: CmmExpr
arg_y_16 = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
widen [CmmExpr
arg_y]
m_arg_x_high_16 :: Maybe CmmExpr
m_arg_x_high_16 = (\CmmExpr
p -> MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
widen [CmmExpr
p]) (CmmExpr -> CmmExpr) -> Maybe CmmExpr -> Maybe CmmExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CmmExpr
m_arg_x_high
Width
-> Bool
-> LocalReg
-> LocalReg
-> Maybe CmmExpr
-> CmmExpr
-> CmmExpr
-> NatM InstrBlock
genQuotRem Width
W16 Bool
signed LocalReg
res_q LocalReg
res_r Maybe CmmExpr
m_arg_x_high_16 CmmExpr
arg_x_low_16 CmmExpr
arg_y_16
Width
_ -> do
let format :: Format
format = Width -> Format
intFormat Width
width
reg_q :: Reg
reg_q = LocalReg -> Reg
getLocalRegReg LocalReg
res_q
reg_r :: Reg
reg_r = LocalReg -> Reg
getLocalRegReg LocalReg
res_r
widen :: Instr
widen | Bool
signed = Format -> Instr
CLTD Format
format
| Bool
otherwise = Format -> Operand -> Operand -> Instr
XOR Format
format (Reg -> Operand
OpReg Reg
rdx) (Reg -> Operand
OpReg Reg
rdx)
instr :: Format -> Operand -> Instr
instr | Bool
signed = Format -> Operand -> Instr
IDIV
| Bool
otherwise = Format -> Operand -> Instr
DIV
(y_reg, y_code) <- CmmExpr -> NatM (Operand, InstrBlock)
getRegOrMem CmmExpr
arg_y
x_low_code <- getAnyReg arg_x_low
x_high_code <- case m_arg_x_high of
Just CmmExpr
arg_x_high ->
HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock)
CmmExpr -> NatM (Reg -> InstrBlock)
getAnyReg CmmExpr
arg_x_high
Maybe CmmExpr
Nothing ->
(Reg -> InstrBlock) -> NatM (Reg -> InstrBlock)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Reg -> InstrBlock) -> NatM (Reg -> InstrBlock))
-> (Reg -> InstrBlock) -> NatM (Reg -> InstrBlock)
forall a b. (a -> b) -> a -> b
$ InstrBlock -> Reg -> InstrBlock
forall a b. a -> b -> a
const (InstrBlock -> Reg -> InstrBlock)
-> InstrBlock -> Reg -> InstrBlock
forall a b. (a -> b) -> a -> b
$ Instr -> InstrBlock
forall a. a -> OrdList a
unitOL Instr
widen
return $ y_code `appOL`
x_low_code rax `appOL`
x_high_code rdx `appOL`
toOL [instr format y_reg,
MOV format (OpReg rax) (OpReg reg_q),
MOV format (OpReg rdx) (OpReg reg_r)]