Commit 93d6c9d5 authored by dterei's avatar dterei

Add new mem{cpy,set,move} cmm prim ops.

parent 5fb59c02
......@@ -459,7 +459,15 @@ data CallishMachOp
| MO_F32_Sqrt
| MO_WriteBarrier
| MO_Touch -- Keep variables live (when using interior pointers)
-- Note that these three MachOps all take 1 extra parameter than the
-- standard C lib versions. The extra (last) parameter contains
-- alignment of the pointers. Used for optimisation in backends.
| MO_Memcpy
| MO_Memset
| MO_Memmove
deriving (Eq, Show)
pprCallishMachOp :: CallishMachOp -> SDoc
pprCallishMachOp mo = text (show mo)
......@@ -735,7 +735,10 @@ machOps = listToUFM $
callishMachOps = listToUFM $
map (\(x, y) -> (mkFastString x, y)) [
( "write_barrier", MO_WriteBarrier )
( "write_barrier", MO_WriteBarrier ),
( "memcpy", MO_Memcpy ),
( "memset", MO_Memset ),
( "memmove", MO_Memmove )
-- ToDo: the rest, maybe
]
......
......@@ -132,6 +132,12 @@ data LlvmStatement
-}
| Expr LlvmExpression
{- |
A nop LLVM statement. Useful as its often more efficient to use this
then to wrap LLvmStatement in a Just or [].
-}
| Nop
deriving (Show, Eq)
......
......@@ -161,6 +161,7 @@ ppLlvmStatement stmt
Return result -> ppReturn result
Expr expr -> ppLlvmExpression expr
Unreachable -> text "unreachable"
Nop -> empty
-- | Print out an LLVM expression.
......
......@@ -28,7 +28,9 @@ import Outputable
import qualified Pretty as Prt
import UniqSupply
import Util
import SysTools ( figureLlvmVersion )
import Data.Maybe ( fromMaybe )
import System.IO
-- -----------------------------------------------------------------------------
......@@ -48,8 +50,9 @@ llvmCodeGen dflags h us cmms
in do
bufh <- newBufHandle h
Prt.bufLeftRender bufh $ pprLlvmHeader
ver <- (fromMaybe defaultLlvmVersion) `fmap` figureLlvmVersion dflags
env' <- cmmDataLlvmGens dflags bufh env cdata []
env' <- cmmDataLlvmGens dflags bufh (setLlvmVer ver env) cdata []
cmmProcLlvmGens dflags bufh us env' cmm 1 []
bFlush bufh
......
......@@ -9,8 +9,10 @@ module LlvmCodeGen.Base (
LlvmCmmTop, LlvmBasicBlock,
LlvmUnresData, LlvmData, UnresLabel, UnresStatic,
LlvmVersion, defaultLlvmVersion,
LlvmEnv, initLlvmEnv, clearVars, varLookup, varInsert,
funLookup, funInsert,
funLookup, funInsert, getLlvmVer, setLlvmVer,
cmmToLlvmType, widthToLlvmFloat, widthToLlvmInt, llvmFunTy,
llvmFunSig, llvmStdFunAttrs, llvmFunAlign, llvmInfAlign,
......@@ -128,33 +130,50 @@ tysToParams = map (\ty -> (ty, []))
llvmPtrBits :: Int
llvmPtrBits = widthInBits $ typeWidth gcWord
-- ----------------------------------------------------------------------------
-- * Llvm Version
--
-- | LLVM Version Number
type LlvmVersion = Int
-- | The LLVM Version we assume if we don't know
defaultLlvmVersion :: LlvmVersion
defaultLlvmVersion = 28
-- ----------------------------------------------------------------------------
-- * Environment Handling
--
type LlvmEnvMap = UniqFM LlvmType
-- two maps, one for functions and one for local vars.
type LlvmEnv = (LlvmEnvMap, LlvmEnvMap)
newtype LlvmEnv = LlvmEnv (LlvmEnvMap, LlvmEnvMap, LlvmVersion)
type LlvmEnvMap = UniqFM LlvmType
-- | Get initial Llvm environment.
initLlvmEnv :: LlvmEnv
initLlvmEnv = (emptyUFM, emptyUFM)
initLlvmEnv = LlvmEnv (emptyUFM, emptyUFM, defaultLlvmVersion)
-- | Clear variables from the environment.
clearVars :: LlvmEnv -> LlvmEnv
clearVars (e1, _) = (e1, emptyUFM)
clearVars (LlvmEnv (e1, _, n)) = LlvmEnv (e1, emptyUFM, n)
-- | Insert functions into the environment.
varInsert, funInsert :: Uniquable key => key -> LlvmType -> LlvmEnv -> LlvmEnv
varInsert s t (e1, e2) = (e1, addToUFM e2 s t)
funInsert s t (e1, e2) = (addToUFM e1 s t, e2)
varInsert s t (LlvmEnv (e1, e2, n)) = LlvmEnv (e1, addToUFM e2 s t, n)
funInsert s t (LlvmEnv (e1, e2, n)) = LlvmEnv (addToUFM e1 s t, e2, n)
-- | Lookup functions in the environment.
varLookup, funLookup :: Uniquable key => key -> LlvmEnv -> Maybe LlvmType
varLookup s (_, e2) = lookupUFM e2 s
funLookup s (e1, _) = lookupUFM e1 s
varLookup s (LlvmEnv (_, e2, _)) = lookupUFM e2 s
funLookup s (LlvmEnv (e1, _, _)) = lookupUFM e1 s
-- | Get the LLVM version we are generating code for
getLlvmVer :: LlvmEnv -> LlvmVersion
getLlvmVer (LlvmEnv (_, _, n)) = n
-- | Set the LLVM version we are generating code for
setLlvmVer :: LlvmVersion -> LlvmEnv -> LlvmEnv
setLlvmVer n (LlvmEnv (e1, e2, _)) = LlvmEnv (e1, e2, n)
-- ----------------------------------------------------------------------------
-- * Label handling
......
{-# OPTIONS -fno-warn-type-defaults #-}
-- ----------------------------------------------------------------------------
-- | Handle conversion of CmmProc to LLVM code.
--
......@@ -17,7 +18,6 @@ import OldCmm
import qualified OldPprCmm as PprCmm
import OrdList
import BasicTypes
import FastString
import ForeignCall
import Outputable hiding ( panic, pprPanic )
......@@ -175,9 +175,31 @@ genCall env (CmmPrim MO_WriteBarrier) _ _ _ = do
where
lmTrue :: LlvmVar
lmTrue = LMLitVar $ LMIntLit (-1) i1
lmTrue = mkIntLit i1 (-1)
#endif
-- Handle memcpy function specifically since llvm's intrinsic version takes
-- some extra parameters.
genCall env t@(CmmPrim op) [] args CmmMayReturn | op == MO_Memcpy ||
op == MO_Memset ||
op == MO_Memmove = do
let (isVolTy, isVolVal) = if getLlvmVer env >= 28
then ([i1], [mkIntLit i1 0]) else ([], [])
argTy | op == MO_Memset = [i8Ptr, i8, llvmWord, i32] ++ isVolTy
| otherwise = [i8Ptr, i8Ptr, llvmWord, i32] ++ isVolTy
funTy = \name -> LMFunction $ LlvmFunctionDecl name ExternallyVisible
CC_Ccc LMVoid FixedArgs (tysToParams argTy) Nothing
(env1, argVars, stmts1, top1) <- arg_vars env args ([], nilOL, [])
(env2, fptr, stmts2, top2) <- getFunPtr env1 funTy t
(argVars', stmts3) <- castVars $ zip argVars argTy
let arguments = argVars' ++ isVolVal
call = Expr $ Call StdCall fptr arguments []
stmts = stmts1 `appOL` stmts2 `appOL` stmts3
`appOL` trashStmts `snocOL` call
return (env2, stmts, top1 ++ top2)
-- Handle all other foreign calls and prim ops.
genCall env target res args ret = do
......@@ -225,91 +247,17 @@ genCall env target res args ret = do
let ccTy = StdCall -- tail calls should be done through CmmJump
let retTy = ret_type res
let argTy = tysToParams $ map arg_type args
let funTy name = LMFunction $ LlvmFunctionDecl name ExternallyVisible
let funTy = \name -> LMFunction $ LlvmFunctionDecl name ExternallyVisible
lmconv retTy FixedArgs argTy llvmFunAlign
-- get parameter values
(env1, argVars, stmts1, top1) <- arg_vars env args ([], nilOL, [])
-- get the return register
let ret_reg ([CmmHinted reg hint]) = (reg, hint)
ret_reg t = panic $ "genCall: Bad number of registers! Can only handle"
++ " 1, given " ++ show (length t) ++ "."
-- deal with call types
let getFunPtr :: CmmCallTarget -> UniqSM ExprData
getFunPtr targ = case targ of
CmmCallee (CmmLit (CmmLabel lbl)) _ -> do
let name = strCLabel_llvm lbl
case funLookup name env1 of
Just ty'@(LMFunction sig) -> do
-- Function in module in right form
let fun = LMGlobalVar name ty' (funcLinkage sig)
Nothing Nothing False
return (env1, fun, nilOL, [])
Just ty' -> do
-- label in module but not function pointer, convert
let fty@(LMFunction sig) = funTy name
let fun = LMGlobalVar name (pLift ty') (funcLinkage sig)
Nothing Nothing False
(v1, s1) <- doExpr (pLift fty)
$ Cast LM_Bitcast fun (pLift fty)
return (env1, v1, unitOL s1, [])
Nothing -> do
-- label not in module, create external reference
let fty@(LMFunction sig) = funTy name
let fun = LMGlobalVar name fty (funcLinkage sig)
Nothing Nothing False
let top = CmmData Data [([],[fty])]
let env' = funInsert name fty env1
return (env', fun, nilOL, [top])
CmmCallee expr _ -> do
(env', v1, stmts, top) <- exprToVar env1 expr
let fty = funTy $ fsLit "dynamic"
let cast = case getVarType v1 of
ty | isPointer ty -> LM_Bitcast
ty | isInt ty -> LM_Inttoptr
ty -> panic $ "genCall: Expr is of bad type for function"
++ " call! (" ++ show (ty) ++ ")"
(v2,s1) <- doExpr (pLift fty) $ Cast cast v1 (pLift fty)
return (env', v2, stmts `snocOL` s1, top)
CmmPrim mop -> do
let name = cmmPrimOpFunctions mop
let lbl = mkForeignLabel name Nothing
ForeignLabelInExternalPackage IsFunction
getFunPtr $ CmmCallee (CmmLit (CmmLabel lbl)) CCallConv
(env2, fptr, stmts2, top2) <- getFunPtr target
(env1, argVars, stmts1, top1) <- arg_vars env args ([], nilOL, [])
(env2, fptr, stmts2, top2) <- getFunPtr env1 funTy target
let retStmt | ccTy == TailCall = unitOL $ Return Nothing
| ret == CmmNeverReturns = unitOL $ Unreachable
| otherwise = nilOL
{- In LLVM we pass the STG registers around everywhere in function calls.
So this means LLVM considers them live across the entire function, when
in reality they usually aren't. For Caller save registers across C calls
the saving and restoring of them is done by the Cmm code generator,
using Cmm local vars. So to stop LLVM saving them as well (and saving
all of them since it thinks they're always live, we trash them just
before the call by assigning the 'undef' value to them. The ones we
need are restored from the Cmm local var and the ones we don't need
are fine to be trashed.
-}
let trashStmts = concatOL $ map trashReg activeStgRegs
where trashReg r =
let reg = lmGlobalRegVar r
ty = (pLower . getVarType) reg
trash = unitOL $ Store (LMLitVar $ LMUndefLit ty) reg
in case callerSaves r of
True -> trash
False -> nilOL
let stmts = stmts1 `appOL` stmts2 `appOL` trashStmts
-- make the actual call
......@@ -321,6 +269,10 @@ genCall env target res args ret = do
_ -> do
(v1, s1) <- doExpr retTy $ Call ccTy fptr argVars fnAttrs
-- get the return register
let ret_reg ([CmmHinted reg hint]) = (reg, hint)
ret_reg t = panic $ "genCall: Bad number of registers! Can only handle"
++ " 1, given " ++ show (length t) ++ "."
let (creg, _) = ret_reg res
let (env3, vreg, stmts3, top3) = getCmmReg env2 (CmmLocal creg)
let allStmts = stmts `snocOL` s1 `appOL` stmts3
......@@ -344,6 +296,55 @@ genCall env target res args ret = do
`appOL` retStmt, top1 ++ top2 ++ top3)
-- | Create a function pointer from a target.
getFunPtr :: LlvmEnv -> (LMString -> LlvmType) -> CmmCallTarget
-> UniqSM ExprData
getFunPtr env funTy targ = case targ of
CmmCallee (CmmLit (CmmLabel lbl)) _ -> litCase $ strCLabel_llvm lbl
CmmCallee expr _ -> do
(env', v1, stmts, top) <- exprToVar env expr
let fty = funTy $ fsLit "dynamic"
cast = case getVarType v1 of
ty | isPointer ty -> LM_Bitcast
ty | isInt ty -> LM_Inttoptr
ty -> panic $ "genCall: Expr is of bad type for function"
++ " call! (" ++ show (ty) ++ ")"
(v2,s1) <- doExpr (pLift fty) $ Cast cast v1 (pLift fty)
return (env', v2, stmts `snocOL` s1, top)
CmmPrim mop -> litCase $ cmmPrimOpFunctions env mop
where
litCase name = do
case funLookup name env of
Just ty'@(LMFunction sig) -> do
-- Function in module in right form
let fun = LMGlobalVar name ty' (funcLinkage sig)
Nothing Nothing False
return (env, fun, nilOL, [])
Just ty' -> do
-- label in module but not function pointer, convert
let fty@(LMFunction sig) = funTy name
fun = LMGlobalVar name (pLift ty') (funcLinkage sig)
Nothing Nothing False
(v1, s1) <- doExpr (pLift fty)
$ Cast LM_Bitcast fun (pLift fty)
return (env, v1, unitOL s1, [])
Nothing -> do
-- label not in module, create external reference
let fty@(LMFunction sig) = funTy name
fun = LMGlobalVar name fty (funcLinkage sig)
Nothing Nothing False
top = [CmmData Data [([],[fty])]]
env' = funInsert name fty env
return (env', fun, nilOL, top)
-- | Conversion of call arguments.
arg_vars :: LlvmEnv
-> HintedCmmActuals
......@@ -370,9 +371,41 @@ arg_vars env (CmmHinted e _:rest) (vars, stmts, tops)
= do (env', v1, stmts', top') <- exprToVar env e
arg_vars env' rest (vars ++ [v1], stmts `appOL` stmts', tops ++ top')
-- | Cast a collection of LLVM variables to specific types.
castVars :: [(LlvmVar, LlvmType)]
-> UniqSM ([LlvmVar], LlvmStatements)
castVars vars = do
done <- mapM (uncurry castVar) vars
let (vars', stmts) = unzip done
return (vars', toOL stmts)
-- | Cast an LLVM variable to a specific type, panicing if it can't be done.
castVar :: LlvmVar -> LlvmType -> UniqSM (LlvmVar, LlvmStatement)
castVar v t | getVarType v == t
= return (v, Nop)
| otherwise
= let op = case (getVarType v, t) of
(LMInt n, LMInt m)
-> if n < m then LM_Sext else LM_Trunc
(vt, _) | isFloat vt && isFloat t
-> if llvmWidthInBits vt < llvmWidthInBits t
then LM_Fpext else LM_Fptrunc
(vt, _) | isInt vt && isFloat t -> LM_Sitofp
(vt, _) | isFloat vt && isInt t -> LM_Fptosi
(vt, _) | isInt vt && isPointer t -> LM_Inttoptr
(vt, _) | isPointer vt && isInt t -> LM_Ptrtoint
(vt, _) | isPointer vt && isPointer t -> LM_Bitcast
(vt, _) -> panic $ "castVars: Can't cast this type ("
++ show vt ++ ") to (" ++ show t ++ ")"
in doExpr t $ Cast op v t
-- | Decide what C function to use to implement a CallishMachOp
cmmPrimOpFunctions :: CallishMachOp -> FastString
cmmPrimOpFunctions mop
cmmPrimOpFunctions :: LlvmEnv -> CallishMachOp -> LMString
cmmPrimOpFunctions env mop
= case mop of
MO_F32_Exp -> fsLit "expf"
MO_F32_Log -> fsLit "logf"
......@@ -408,8 +441,18 @@ cmmPrimOpFunctions mop
MO_F64_Cosh -> fsLit "cosh"
MO_F64_Tanh -> fsLit "tanh"
MO_Memcpy -> fsLit $ "llvm.memcpy." ++ intrinTy1
MO_Memmove -> fsLit $ "llvm.memmove." ++ intrinTy1
MO_Memset -> fsLit $ "llvm.memset." ++ intrinTy2
a -> panic $ "cmmPrimOpFunctions: Unknown callish op! (" ++ show a ++ ")"
where
intrinTy1 = (if getLlvmVer env >= 28
then "p0i8.p0i8." else "") ++ show llvmWord
intrinTy2 = (if getLlvmVer env >= 28
then "p0i8." else "") ++ show llvmWord
-- | Tail function calls
genJump :: LlvmEnv -> CmmExpr -> UniqSM StmtData
......@@ -594,7 +637,7 @@ genSwitch env cond maybe_ids = do
(env', vc, stmts, top) <- exprToVar env cond
let ty = getVarType vc
let pairs = [ (ix, id) | (ix,Just id) <- zip ([0..]::[Integer]) maybe_ids ]
let pairs = [ (ix, id) | (ix,Just id) <- zip [0..] maybe_ids ]
let labels = map (\(ix, b) -> (mkIntLit ty ix, blockIdToLlvm b)) pairs
-- out of range is undefied, so lets just branch to first label
let (_, defLbl) = head labels
......@@ -675,11 +718,11 @@ genMachOp :: LlvmEnv -> EOption -> MachOp -> [CmmExpr] -> UniqSM ExprData
genMachOp env _ op [x] = case op of
MO_Not w ->
let all1 = mkIntLit (widthToLlvmInt w) (-1::Int)
let all1 = mkIntLit (widthToLlvmInt w) (-1)
in negate (widthToLlvmInt w) all1 LM_MO_Xor
MO_S_Neg w ->
let all0 = mkIntLit (widthToLlvmInt w) (0::Int)
let all0 = mkIntLit (widthToLlvmInt w) 0
in negate (widthToLlvmInt w) all0 LM_MO_Sub
MO_F_Neg w ->
......@@ -1107,6 +1150,28 @@ funEpilogue = do
return (vars, concatOL stmts)
-- | A serries of statements to trash all the STG registers.
--
-- In LLVM we pass the STG registers around everywhere in function calls.
-- So this means LLVM considers them live across the entire function, when
-- in reality they usually aren't. For Caller save registers across C calls
-- the saving and restoring of them is done by the Cmm code generator,
-- using Cmm local vars. So to stop LLVM saving them as well (and saving
-- all of them since it thinks they're always live, we trash them just
-- before the call by assigning the 'undef' value to them. The ones we
-- need are restored from the Cmm local var and the ones we don't need
-- are fine to be trashed.
trashStmts :: LlvmStatements
trashStmts = concatOL $ map trashReg activeStgRegs
where trashReg r =
let reg = lmGlobalRegVar r
ty = (pLower . getVarType) reg
trash = unitOL $ Store (LMLitVar $ LMUndefLit ty) reg
in case callerSaves r of
True -> trash
False -> nilOL
-- | Get a function pointer to the CLabel specified.
--
-- This is for Haskell functions, function type is assumed, so doesn't work
......
......@@ -910,7 +910,7 @@ genCCall target dest_regs argsAndHints
(labelOrExpr, reduceToFF32) <- case target of
CmmCallee (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False)
CmmCallee expr conv -> return (Right expr, False)
CmmPrim mop -> outOfLineFloatOp mop
CmmPrim mop -> outOfLineMachOp mop
let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode
codeAfter = move_sp_up finalStack `appOL` moveResult reduceToFF32
......@@ -937,7 +937,17 @@ genCCall target dest_regs argsAndHints
initialStackOffset = 8
stackDelta finalStack = roundTo 16 finalStack
#endif
args = map hintlessCmm argsAndHints
-- need to remove alignment information
argsAndHints' | (CmmPrim mop) <- target,
(mop == MO_Memcpy ||
mop == MO_Memset ||
mop == MO_Memmove)
-> init argsAndHints
| otherwise
-> argsAndHints
args = map hintlessCmm argsAndHints'
argReps = map cmmExprType args
roundTo a x | x `mod` a == 0 = x
......@@ -1062,7 +1072,7 @@ genCCall target dest_regs argsAndHints
where rep = cmmRegType (CmmLocal dest)
r_dest = getRegisterReg (CmmLocal dest)
outOfLineFloatOp mop =
outOfLineMachOp mop =
do
dflags <- getDynFlagsNat
mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $
......@@ -1106,6 +1116,11 @@ genCCall target dest_regs argsAndHints
MO_F64_Cosh -> (fsLit "cosh", False)
MO_F64_Tanh -> (fsLit "tanh", False)
MO_F64_Pwr -> (fsLit "pow", False)
MO_Memcpy -> (fsLit "memcpy", False)
MO_Memset -> (fsLit "memset", False)
MO_Memmove -> (fsLit "memmove", False)
other -> pprPanic "genCCall(ppc): unknown callish op"
(pprCallishMachOp other)
......
......@@ -80,9 +80,19 @@ genCCall (CmmPrim (MO_WriteBarrier)) _ _
genCCall target dest_regs argsAndHints
= do
-- need to remove alignment information
let argsAndHints' | (CmmPrim mop) <- target,
(mop == MO_Memcpy ||
mop == MO_Memset ||
mop == MO_Memmove)
-> init argsAndHints
| otherwise
-> argsAndHints
-- strip hints from the arg regs
let args :: [CmmExpr]
args = map hintlessCmm argsAndHints
args = map hintlessCmm argsAndHints'
-- work out the arguments, and assign them to integer regs
......@@ -104,7 +114,7 @@ genCCall target dest_regs argsAndHints
return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
CmmPrim mop
-> do res <- outOfLineFloatOp mop
-> do res <- outOfLineMachOp mop
lblOrMopExpr <- case res of
Left lbl -> do
return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
......@@ -253,13 +263,13 @@ assign_code _
-- | Generate a call to implement an out-of-line floating point operation
outOfLineFloatOp
outOfLineMachOp
:: CallishMachOp
-> NatM (Either CLabel CmmExpr)
outOfLineFloatOp mop
outOfLineMachOp mop
= do let functionName
= outOfLineFloatOp_table mop
= outOfLineMachOp_table mop
dflags <- getDynFlagsNat
mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference
......@@ -275,11 +285,11 @@ outOfLineFloatOp mop
-- | Decide what C function to use to implement a CallishMachOp
--
outOfLineFloatOp_table
outOfLineMachOp_table
:: CallishMachOp
-> FastString
outOfLineFloatOp_table mop
outOfLineMachOp_table mop
= case mop of
MO_F32_Exp -> fsLit "expf"
MO_F32_Log -> fsLit "logf"
......@@ -315,5 +325,9 @@ outOfLineFloatOp_table mop
MO_F64_Cosh -> fsLit "cosh"
MO_F64_Tanh -> fsLit "tanh"
_ -> pprPanic "outOfLineFloatOp(sparc): Unknown callish mach op "
MO_Memcpy -> fsLit "memcpy"
MO_Memset -> fsLit "memset"
MO_Memmove -> fsLit "memmove"
_ -> pprPanic "outOfLineMachOp(sparc): Unknown callish mach op "
(pprCallishMachOp mop)
......@@ -69,7 +69,7 @@ import DynFlags
import Debug.Trace ( trace )
import Control.Monad ( mapAndUnzipM )
import Data.Maybe ( fromJust )
import Data.Maybe ( fromJust, catMaybes )
import Data.Bits
import Data.Word
import Data.Int
......@@ -1519,14 +1519,18 @@ genCCall (CmmPrim MO_WriteBarrier) _ _ = return nilOL
-- write barrier compiles to no code on x86/x86-64;
-- we keep it this long in order to prevent earlier optimisations.
-- void return type prim op
genCCall (CmmPrim op) [] args =
outOfLineCmmOp op Nothing args
-- we only cope with a single result for foreign calls
genCCall (CmmPrim op) [CmmHinted r _] args = do
genCCall (CmmPrim op) [r_hinted@(CmmHinted r _)] args = do
l1 <- getNewLabelNat
l2 <- getNewLabelNat
sse2 <- sse2Enabled
if sse2
then
outOfLineFloatOp op r args
outOfLineCmmOp op (Just r_hinted) args
else case op of
MO_F32_Sqrt -> actuallyInlineFloatOp GSQRT FF32 args
MO_F64_Sqrt -> actuallyInlineFloatOp GSQRT FF64 args
......@@ -1540,7 +1544,7 @@ genCCall (CmmPrim op) [CmmHinted r _] args = do
MO_F32_Tan -> actuallyInlineFloatOp (\s -> GTAN s l1 l2) FF32 args
MO_F64_Tan -> actuallyInlineFloatOp (\s -> GTAN s l1 l2) FF64 args
other_op -> outOfLineFloatOp op r args
other_op -> outOfLineCmmOp op (Just r_hinted) args
where
actuallyInlineFloatOp instr size [CmmHinted x _]
......@@ -1569,7 +1573,6 @@ genCCall target dest_regs args = do
-- deal with static vs dynamic call targets
(callinsns,cconv) <-