#if __GLASGOW_HASKELL__ <= 808
#endif
module GHC.StgToCmm.Prim (
cgOpApp,
cgPrimOp,
shouldInlinePrimOp
) where
#include "HsVersions.h"
import GhcPrelude hiding ((<*>))
import GHC.StgToCmm.Layout
import GHC.StgToCmm.Foreign
import GHC.StgToCmm.Env
import GHC.StgToCmm.Monad
import GHC.StgToCmm.Utils
import GHC.StgToCmm.Ticky
import GHC.StgToCmm.Heap
import GHC.StgToCmm.Prof ( costCentreFrom )
import DynFlags
import GHC.Platform
import BasicTypes
import BlockId
import MkGraph
import StgSyn
import Cmm
import Module ( rtsUnitId )
import Type ( Type, tyConAppTyCon )
import TyCon
import CLabel
import CmmUtils
import PrimOp
import SMRep
import FastString
import Outputable
import Util
import Data.Maybe
import Data.Bits ((.&.), bit)
import Control.Monad (liftM, when, unless)
cgOpApp :: StgOp
-> [StgArg]
-> Type
-> FCode ReturnKind
cgOpApp (StgFCallOp fcall ty) stg_args res_ty
= cgForeignCall fcall ty stg_args res_ty
cgOpApp (StgPrimOp primop) args res_ty = do
dflags <- getDynFlags
cmm_args <- getNonVoidArgAmodes args
case emitPrimOp dflags primop cmm_args of
PrimopCmmEmit_External -> do
let fun = CmmLit (CmmLabel (mkRtsPrimOpLabel primop))
emitCall (NativeNodeCall, NativeReturn) fun cmm_args
PrimopCmmEmit_Raw f -> do
exprs <- f res_ty
emitReturn exprs
PrimopCmmEmit_IntoRegs f
| ReturnsPrim VoidRep <- result_info
-> do f []
emitReturn []
| ReturnsPrim rep <- result_info
-> do dflags <- getDynFlags
res <- newTemp (primRepCmmType dflags rep)
f [res]
emitReturn [CmmReg (CmmLocal res)]
| ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
-> do (regs, _hints) <- newUnboxedTupleRegs res_ty
f regs
emitReturn (map (CmmReg . CmmLocal) regs)
| otherwise -> panic "cgPrimop"
where
result_info = getPrimOpResultInfo primop
cgOpApp (StgPrimCallOp primcall) args _res_ty
= do { cmm_args <- getNonVoidArgAmodes args
; let fun = CmmLit (CmmLabel (mkPrimCallLabel primcall))
; emitCall (NativeNodeCall, NativeReturn) fun cmm_args }
asUnsigned :: Width -> Integer -> Integer
asUnsigned w n = n .&. (bit (widthInBits w) 1)
cgPrimOp :: [LocalReg]
-> PrimOp
-> [StgArg]
-> FCode ()
cgPrimOp results op args = do
dflags <- getDynFlags
arg_exprs <- getNonVoidArgAmodes args
case emitPrimOp dflags op arg_exprs of
PrimopCmmEmit_External -> panic "External prim op"
PrimopCmmEmit_Raw _ -> panic "caller should handle TagToEnum themselves"
PrimopCmmEmit_IntoRegs f -> f results
shouldInlinePrimOp :: DynFlags -> PrimOp -> [CmmExpr] -> Bool
shouldInlinePrimOp dflags op args = case emitPrimOp dflags op args of
PrimopCmmEmit_External -> False
PrimopCmmEmit_IntoRegs _ -> True
PrimopCmmEmit_Raw _ -> True
emitPrimOp
:: DynFlags
-> PrimOp
-> [CmmExpr]
-> PrimopCmmEmit
emitPrimOp dflags = \case
NewByteArrayOp_Char -> \case
[(CmmLit (CmmInt n w))]
| asUnsigned w n <= fromIntegral (maxInlineAllocSize dflags)
-> opAllDone $ \ [res] -> doNewByteArrayOp res (fromInteger n)
_ -> PrimopCmmEmit_External
NewArrayOp -> \case
[(CmmLit (CmmInt n w)), init]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
-> opAllDone $ \[res] -> doNewArrayOp res (arrPtrsRep dflags (fromInteger n)) mkMAP_DIRTY_infoLabel
[ (mkIntExpr dflags (fromInteger n),
fixedHdrSize dflags + oFFSET_StgMutArrPtrs_ptrs dflags)
, (mkIntExpr dflags (nonHdrSizeW (arrPtrsRep dflags (fromInteger n))),
fixedHdrSize dflags + oFFSET_StgMutArrPtrs_size dflags)
]
(fromInteger n) init
_ -> PrimopCmmEmit_External
CopyArrayOp -> \case
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
opAllDone $ \ [] -> doCopyArrayOp src src_off dst dst_off (fromInteger n)
_ -> PrimopCmmEmit_External
CopyMutableArrayOp -> \case
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
opAllDone $ \ [] -> doCopyMutableArrayOp src src_off dst dst_off (fromInteger n)
_ -> PrimopCmmEmit_External
CopyArrayArrayOp -> \case
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
opAllDone $ \ [] -> doCopyArrayOp src src_off dst dst_off (fromInteger n)
_ -> PrimopCmmEmit_External
CopyMutableArrayArrayOp -> \case
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
opAllDone $ \ [] -> doCopyMutableArrayOp src src_off dst dst_off (fromInteger n)
_ -> PrimopCmmEmit_External
CloneArrayOp -> \case
[src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
-> opAllDone $ \ [res] -> emitCloneArray mkMAP_FROZEN_CLEAN_infoLabel res src src_off (fromInteger n)
_ -> PrimopCmmEmit_External
CloneMutableArrayOp -> \case
[src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
-> opAllDone $ \ [res] -> emitCloneArray mkMAP_DIRTY_infoLabel res src src_off (fromInteger n)
_ -> PrimopCmmEmit_External
FreezeArrayOp -> \case
[src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
-> opAllDone $ \ [res] -> emitCloneArray mkMAP_FROZEN_CLEAN_infoLabel res src src_off (fromInteger n)
_ -> PrimopCmmEmit_External
ThawArrayOp -> \case
[src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
-> opAllDone $ \ [res] -> emitCloneArray mkMAP_DIRTY_infoLabel res src src_off (fromInteger n)
_ -> PrimopCmmEmit_External
NewSmallArrayOp -> \case
[(CmmLit (CmmInt n w)), init]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
-> opAllDone $ \ [res] ->
doNewArrayOp res (smallArrPtrsRep (fromInteger n)) mkSMAP_DIRTY_infoLabel
[ (mkIntExpr dflags (fromInteger n),
fixedHdrSize dflags + oFFSET_StgSmallMutArrPtrs_ptrs dflags)
]
(fromInteger n) init
_ -> PrimopCmmEmit_External
CopySmallArrayOp -> \case
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
opAllDone $ \ [] -> doCopySmallArrayOp src src_off dst dst_off (fromInteger n)
_ -> PrimopCmmEmit_External
CopySmallMutableArrayOp -> \case
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
opAllDone $ \ [] -> doCopySmallMutableArrayOp src src_off dst dst_off (fromInteger n)
_ -> PrimopCmmEmit_External
CloneSmallArrayOp -> \case
[src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
-> opAllDone $ \ [res] -> emitCloneSmallArray mkSMAP_FROZEN_CLEAN_infoLabel res src src_off (fromInteger n)
_ -> PrimopCmmEmit_External
CloneSmallMutableArrayOp -> \case
[src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
-> opAllDone $ \ [res] -> emitCloneSmallArray mkSMAP_DIRTY_infoLabel res src src_off (fromInteger n)
_ -> PrimopCmmEmit_External
FreezeSmallArrayOp -> \case
[src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
-> opAllDone $ \ [res] -> emitCloneSmallArray mkSMAP_FROZEN_CLEAN_infoLabel res src src_off (fromInteger n)
_ -> PrimopCmmEmit_External
ThawSmallArrayOp -> \case
[src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
-> opAllDone $ \ [res] -> emitCloneSmallArray mkSMAP_DIRTY_infoLabel res src src_off (fromInteger n)
_ -> PrimopCmmEmit_External
ParOp -> \[arg] -> opAllDone $ \[res] -> do
emitCCall
[(res, Int64Rep, SignedHint)]
(CmmLit (CmmLabel (mkForeignLabel (fsLit "newSpark") Nothing ForeignLabelInExternalPackage IsFunction)))
[(baseExpr, AddrRep, AddrHint), (arg, AddrRep, AddrHint)]
SparkOp -> \[arg] -> opAllDone $ \[res] -> do
tmp <- assignTemp arg
tmp2 <- newTemp (bWord dflags)
emitCCall
[(tmp2, Int64Rep, SignedHint)]
(CmmLit (CmmLabel (mkForeignLabel (fsLit "newSpark") Nothing ForeignLabelInExternalPackage IsFunction)))
[(baseExpr, AddrRep, AddrHint), ((CmmReg (CmmLocal tmp)), AddrRep, AddrHint)]
emitAssign (CmmLocal res) (CmmReg (CmmLocal tmp))
GetCCSOfOp -> \[arg] -> opAllDone $ \[res] -> do
let
val
| gopt Opt_SccProfilingOn dflags = costCentreFrom dflags (cmmUntag dflags arg)
| otherwise = CmmLit (zeroCLit dflags)
emitAssign (CmmLocal res) val
GetCurrentCCSOp -> \[_] -> opAllDone $ \[res] -> do
emitAssign (CmmLocal res) cccsExpr
MyThreadIdOp -> \[] -> opAllDone $ \[res] -> do
emitAssign (CmmLocal res) currentTSOExpr
ReadMutVarOp -> \[mutv] -> opAllDone $ \[res] -> do
emitAssign (CmmLocal res) (cmmLoadIndexW dflags mutv (fixedHdrSizeW dflags) (gcWord dflags))
WriteMutVarOp -> \[mutv, var] -> opAllDone $ \res@[] -> do
old_val <- CmmLocal <$> newTemp (cmmExprType dflags var)
emitAssign old_val (cmmLoadIndexW dflags mutv (fixedHdrSizeW dflags) (gcWord dflags))
emitPrimCall res MO_WriteBarrier []
emitStore (cmmOffsetW dflags mutv (fixedHdrSizeW dflags)) var
emitCCall
[]
(CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
[(baseExpr, AddrRep, AddrHint), (mutv, AddrRep, AddrHint), (CmmReg old_val, AddrRep, AddrHint)]
SizeofByteArrayOp -> \[arg] -> opAllDone $ \[res] -> do
emit $ mkAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags) (bWord dflags))
SizeofMutableByteArrayOp -> emitPrimOp dflags SizeofByteArrayOp
GetSizeofMutableByteArrayOp -> \[arg] -> opAllDone $ \[res] -> do
emitAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags) (bWord dflags))
TouchOp -> \args@[_] -> opAllDone $ \res@[] -> do
emitPrimCall res MO_Touch args
ByteArrayContents_Char -> \[arg] -> opAllDone $ \[res] -> do
emitAssign (CmmLocal res) (cmmOffsetB dflags arg (arrWordsHdrSize dflags))
StableNameToIntOp -> \[arg] -> opAllDone $ \[res] -> do
emitAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags) (bWord dflags))
ReallyUnsafePtrEqualityOp -> \[arg1, arg2] -> opAllDone $ \[res] -> do
emitAssign (CmmLocal res) (CmmMachOp (mo_wordEq dflags) [arg1,arg2])
AddrToAnyOp -> \[arg] -> opAllDone $ \[res] -> do
emitAssign (CmmLocal res) arg
AnyToAddrOp -> \[arg] -> opAllDone $ \[res] -> do
emitAssign (CmmLocal res) arg
UnsafeFreezeArrayOp -> \[arg] -> opAllDone $ \[res] -> do
emit $ catAGraphs
[ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_DIRTY_infoLabel)),
mkAssign (CmmLocal res) arg ]
UnsafeFreezeArrayArrayOp -> \[arg] -> opAllDone $ \[res] -> do
emit $ catAGraphs
[ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_DIRTY_infoLabel)),
mkAssign (CmmLocal res) arg ]
UnsafeFreezeSmallArrayOp -> \[arg] -> opAllDone $ \[res] -> do
emit $ catAGraphs
[ setInfo arg (CmmLit (CmmLabel mkSMAP_FROZEN_DIRTY_infoLabel)),
mkAssign (CmmLocal res) arg ]
UnsafeFreezeByteArrayOp -> \[arg] -> opAllDone $ \[res] -> do
emitAssign (CmmLocal res) arg
ReadArrayOp -> \[obj, ix] -> opAllDone $ \[res] -> do
doReadPtrArrayOp res obj ix
IndexArrayOp -> \[obj, ix] -> opAllDone $ \[res] -> do
doReadPtrArrayOp res obj ix
WriteArrayOp -> \[obj, ix, v] -> opAllDone $ \[] -> do
doWritePtrArrayOp obj ix v
IndexArrayArrayOp_ByteArray -> \[obj, ix] -> opAllDone $ \[res] -> do
doReadPtrArrayOp res obj ix
IndexArrayArrayOp_ArrayArray -> \[obj, ix] -> opAllDone $ \[res] -> do
doReadPtrArrayOp res obj ix
ReadArrayArrayOp_ByteArray -> \[obj, ix] -> opAllDone $ \[res] -> do
doReadPtrArrayOp res obj ix
ReadArrayArrayOp_MutableByteArray -> \[obj, ix] -> opAllDone $ \[res] -> do
doReadPtrArrayOp res obj ix
ReadArrayArrayOp_ArrayArray -> \[obj, ix] -> opAllDone $ \[res] -> do
doReadPtrArrayOp res obj ix
ReadArrayArrayOp_MutableArrayArray -> \[obj, ix] -> opAllDone $ \[res] -> do
doReadPtrArrayOp res obj ix
WriteArrayArrayOp_ByteArray -> \[obj,ix,v] -> opAllDone $ \[] -> do
doWritePtrArrayOp obj ix v
WriteArrayArrayOp_MutableByteArray -> \[obj,ix,v] -> opAllDone $ \[] -> do
doWritePtrArrayOp obj ix v
WriteArrayArrayOp_ArrayArray -> \[obj,ix,v] -> opAllDone $ \[] -> do
doWritePtrArrayOp obj ix v
WriteArrayArrayOp_MutableArrayArray -> \[obj,ix,v] -> opAllDone $ \[] -> do
doWritePtrArrayOp obj ix v
ReadSmallArrayOp -> \[obj, ix] -> opAllDone $ \[res] -> do
doReadSmallPtrArrayOp res obj ix
IndexSmallArrayOp -> \[obj, ix] -> opAllDone $ \[res] -> do
doReadSmallPtrArrayOp res obj ix
WriteSmallArrayOp -> \[obj,ix,v] -> opAllDone $ \[] -> do
doWriteSmallPtrArrayOp obj ix v
SizeofArrayOp -> \[arg] -> opAllDone $ \[res] -> do
emit $ mkAssign (CmmLocal res) (cmmLoadIndexW dflags arg
(fixedHdrSizeW dflags + bytesToWordsRoundUp dflags (oFFSET_StgMutArrPtrs_ptrs dflags))
(bWord dflags))
SizeofMutableArrayOp -> emitPrimOp dflags SizeofArrayOp
SizeofArrayArrayOp -> emitPrimOp dflags SizeofArrayOp
SizeofMutableArrayArrayOp -> emitPrimOp dflags SizeofArrayOp
SizeofSmallArrayOp -> \[arg] -> opAllDone $ \[res] -> do
emit $ mkAssign (CmmLocal res)
(cmmLoadIndexW dflags arg
(fixedHdrSizeW dflags + bytesToWordsRoundUp dflags (oFFSET_StgSmallMutArrPtrs_ptrs dflags))
(bWord dflags))
SizeofSmallMutableArrayOp -> emitPrimOp dflags SizeofSmallArrayOp
GetSizeofSmallMutableArrayOp -> emitPrimOp dflags SizeofSmallArrayOp
IndexOffAddrOp_Char -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp (Just (mo_u_8ToWord dflags)) b8 res args
IndexOffAddrOp_WideChar -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp (Just (mo_u_32ToWord dflags)) b32 res args
IndexOffAddrOp_Int -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp Nothing (bWord dflags) res args
IndexOffAddrOp_Word -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp Nothing (bWord dflags) res args
IndexOffAddrOp_Addr -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp Nothing (bWord dflags) res args
IndexOffAddrOp_Float -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp Nothing f32 res args
IndexOffAddrOp_Double -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp Nothing f64 res args
IndexOffAddrOp_StablePtr -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp Nothing (bWord dflags) res args
IndexOffAddrOp_Int8 -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp (Just (mo_s_8ToWord dflags)) b8 res args
IndexOffAddrOp_Int16 -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp (Just (mo_s_16ToWord dflags)) b16 res args
IndexOffAddrOp_Int32 -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp (Just (mo_s_32ToWord dflags)) b32 res args
IndexOffAddrOp_Int64 -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp Nothing b64 res args
IndexOffAddrOp_Word8 -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp (Just (mo_u_8ToWord dflags)) b8 res args
IndexOffAddrOp_Word16 -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp (Just (mo_u_16ToWord dflags)) b16 res args
IndexOffAddrOp_Word32 -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp (Just (mo_u_32ToWord dflags)) b32 res args
IndexOffAddrOp_Word64 -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp Nothing b64 res args
ReadOffAddrOp_Char -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp (Just (mo_u_8ToWord dflags)) b8 res args
ReadOffAddrOp_WideChar -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp (Just (mo_u_32ToWord dflags)) b32 res args
ReadOffAddrOp_Int -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp Nothing (bWord dflags) res args
ReadOffAddrOp_Word -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp Nothing (bWord dflags) res args
ReadOffAddrOp_Addr -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp Nothing (bWord dflags) res args
ReadOffAddrOp_Float -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp Nothing f32 res args
ReadOffAddrOp_Double -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp Nothing f64 res args
ReadOffAddrOp_StablePtr -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp Nothing (bWord dflags) res args
ReadOffAddrOp_Int8 -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp (Just (mo_s_8ToWord dflags)) b8 res args
ReadOffAddrOp_Int16 -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp (Just (mo_s_16ToWord dflags)) b16 res args
ReadOffAddrOp_Int32 -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp (Just (mo_s_32ToWord dflags)) b32 res args
ReadOffAddrOp_Int64 -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp Nothing b64 res args
ReadOffAddrOp_Word8 -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp (Just (mo_u_8ToWord dflags)) b8 res args
ReadOffAddrOp_Word16 -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp (Just (mo_u_16ToWord dflags)) b16 res args
ReadOffAddrOp_Word32 -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp (Just (mo_u_32ToWord dflags)) b32 res args
ReadOffAddrOp_Word64 -> \args -> opAllDone $ \res -> do
doIndexOffAddrOp Nothing b64 res args
IndexByteArrayOp_Char -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp (Just (mo_u_8ToWord dflags)) b8 res args
IndexByteArrayOp_WideChar -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp (Just (mo_u_32ToWord dflags)) b32 res args
IndexByteArrayOp_Int -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp Nothing (bWord dflags) res args
IndexByteArrayOp_Word -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp Nothing (bWord dflags) res args
IndexByteArrayOp_Addr -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp Nothing (bWord dflags) res args
IndexByteArrayOp_Float -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp Nothing f32 res args
IndexByteArrayOp_Double -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp Nothing f64 res args
IndexByteArrayOp_StablePtr -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp Nothing (bWord dflags) res args
IndexByteArrayOp_Int8 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp (Just (mo_s_8ToWord dflags)) b8 res args
IndexByteArrayOp_Int16 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp (Just (mo_s_16ToWord dflags)) b16 res args
IndexByteArrayOp_Int32 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp (Just (mo_s_32ToWord dflags)) b32 res args
IndexByteArrayOp_Int64 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp Nothing b64 res args
IndexByteArrayOp_Word8 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp (Just (mo_u_8ToWord dflags)) b8 res args
IndexByteArrayOp_Word16 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp (Just (mo_u_16ToWord dflags)) b16 res args
IndexByteArrayOp_Word32 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp (Just (mo_u_32ToWord dflags)) b32 res args
IndexByteArrayOp_Word64 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp Nothing b64 res args
ReadByteArrayOp_Char -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp (Just (mo_u_8ToWord dflags)) b8 res args
ReadByteArrayOp_WideChar -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp (Just (mo_u_32ToWord dflags)) b32 res args
ReadByteArrayOp_Int -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp Nothing (bWord dflags) res args
ReadByteArrayOp_Word -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp Nothing (bWord dflags) res args
ReadByteArrayOp_Addr -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp Nothing (bWord dflags) res args
ReadByteArrayOp_Float -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp Nothing f32 res args
ReadByteArrayOp_Double -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp Nothing f64 res args
ReadByteArrayOp_StablePtr -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp Nothing (bWord dflags) res args
ReadByteArrayOp_Int8 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp (Just (mo_s_8ToWord dflags)) b8 res args
ReadByteArrayOp_Int16 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp (Just (mo_s_16ToWord dflags)) b16 res args
ReadByteArrayOp_Int32 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp (Just (mo_s_32ToWord dflags)) b32 res args
ReadByteArrayOp_Int64 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp Nothing b64 res args
ReadByteArrayOp_Word8 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp (Just (mo_u_8ToWord dflags)) b8 res args
ReadByteArrayOp_Word16 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp (Just (mo_u_16ToWord dflags)) b16 res args
ReadByteArrayOp_Word32 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp (Just (mo_u_32ToWord dflags)) b32 res args
ReadByteArrayOp_Word64 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOp Nothing b64 res args
IndexByteArrayOp_Word8AsChar -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs (Just (mo_u_8ToWord dflags)) b8 b8 res args
IndexByteArrayOp_Word8AsWideChar -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs (Just (mo_u_32ToWord dflags)) b32 b8 res args
IndexByteArrayOp_Word8AsInt -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs Nothing (bWord dflags) b8 res args
IndexByteArrayOp_Word8AsWord -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs Nothing (bWord dflags) b8 res args
IndexByteArrayOp_Word8AsAddr -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs Nothing (bWord dflags) b8 res args
IndexByteArrayOp_Word8AsFloat -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs Nothing f32 b8 res args
IndexByteArrayOp_Word8AsDouble -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs Nothing f64 b8 res args
IndexByteArrayOp_Word8AsStablePtr -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs Nothing (bWord dflags) b8 res args
IndexByteArrayOp_Word8AsInt16 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs (Just (mo_s_16ToWord dflags)) b16 b8 res args
IndexByteArrayOp_Word8AsInt32 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs (Just (mo_s_32ToWord dflags)) b32 b8 res args
IndexByteArrayOp_Word8AsInt64 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs Nothing b64 b8 res args
IndexByteArrayOp_Word8AsWord16 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs (Just (mo_u_16ToWord dflags)) b16 b8 res args
IndexByteArrayOp_Word8AsWord32 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs (Just (mo_u_32ToWord dflags)) b32 b8 res args
IndexByteArrayOp_Word8AsWord64 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs Nothing b64 b8 res args
ReadByteArrayOp_Word8AsChar -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs (Just (mo_u_8ToWord dflags)) b8 b8 res args
ReadByteArrayOp_Word8AsWideChar -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs (Just (mo_u_32ToWord dflags)) b32 b8 res args
ReadByteArrayOp_Word8AsInt -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs Nothing (bWord dflags) b8 res args
ReadByteArrayOp_Word8AsWord -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs Nothing (bWord dflags) b8 res args
ReadByteArrayOp_Word8AsAddr -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs Nothing (bWord dflags) b8 res args
ReadByteArrayOp_Word8AsFloat -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs Nothing f32 b8 res args
ReadByteArrayOp_Word8AsDouble -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs Nothing f64 b8 res args
ReadByteArrayOp_Word8AsStablePtr -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs Nothing (bWord dflags) b8 res args
ReadByteArrayOp_Word8AsInt16 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs (Just (mo_s_16ToWord dflags)) b16 b8 res args
ReadByteArrayOp_Word8AsInt32 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs (Just (mo_s_32ToWord dflags)) b32 b8 res args
ReadByteArrayOp_Word8AsInt64 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs Nothing b64 b8 res args
ReadByteArrayOp_Word8AsWord16 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs (Just (mo_u_16ToWord dflags)) b16 b8 res args
ReadByteArrayOp_Word8AsWord32 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs (Just (mo_u_32ToWord dflags)) b32 b8 res args
ReadByteArrayOp_Word8AsWord64 -> \args -> opAllDone $ \res -> do
doIndexByteArrayOpAs Nothing b64 b8 res args
WriteOffAddrOp_Char -> \args -> opAllDone $ \res -> do
doWriteOffAddrOp (Just (mo_WordTo8 dflags)) b8 res args
WriteOffAddrOp_WideChar -> \args -> opAllDone $ \res -> do
doWriteOffAddrOp (Just (mo_WordTo32 dflags)) b32 res args
WriteOffAddrOp_Int -> \args -> opAllDone $ \res -> do
doWriteOffAddrOp Nothing (bWord dflags) res args
WriteOffAddrOp_Word -> \args -> opAllDone $ \res -> do
doWriteOffAddrOp Nothing (bWord dflags) res args
WriteOffAddrOp_Addr -> \args -> opAllDone $ \res -> do
doWriteOffAddrOp Nothing (bWord dflags) res args
WriteOffAddrOp_Float -> \args -> opAllDone $ \res -> do
doWriteOffAddrOp Nothing f32 res args
WriteOffAddrOp_Double -> \args -> opAllDone $ \res -> do
doWriteOffAddrOp Nothing f64 res args
WriteOffAddrOp_StablePtr -> \args -> opAllDone $ \res -> do
doWriteOffAddrOp Nothing (bWord dflags) res args
WriteOffAddrOp_Int8 -> \args -> opAllDone $ \res -> do
doWriteOffAddrOp (Just (mo_WordTo8 dflags)) b8 res args
WriteOffAddrOp_Int16 -> \args -> opAllDone $ \res -> do
doWriteOffAddrOp (Just (mo_WordTo16 dflags)) b16 res args
WriteOffAddrOp_Int32 -> \args -> opAllDone $ \res -> do
doWriteOffAddrOp (Just (mo_WordTo32 dflags)) b32 res args
WriteOffAddrOp_Int64 -> \args -> opAllDone $ \res -> do
doWriteOffAddrOp Nothing b64 res args
WriteOffAddrOp_Word8 -> \args -> opAllDone $ \res -> do
doWriteOffAddrOp (Just (mo_WordTo8 dflags)) b8 res args
WriteOffAddrOp_Word16 -> \args -> opAllDone $ \res -> do
doWriteOffAddrOp (Just (mo_WordTo16 dflags)) b16 res args
WriteOffAddrOp_Word32 -> \args -> opAllDone $ \res -> do
doWriteOffAddrOp (Just (mo_WordTo32 dflags)) b32 res args
WriteOffAddrOp_Word64 -> \args -> opAllDone $ \res -> do
doWriteOffAddrOp Nothing b64 res args
WriteByteArrayOp_Char -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp (Just (mo_WordTo8 dflags)) b8 res args
WriteByteArrayOp_WideChar -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b32 res args
WriteByteArrayOp_Int -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp Nothing (bWord dflags) res args
WriteByteArrayOp_Word -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp Nothing (bWord dflags) res args
WriteByteArrayOp_Addr -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp Nothing (bWord dflags) res args
WriteByteArrayOp_Float -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp Nothing f32 res args
WriteByteArrayOp_Double -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp Nothing f64 res args
WriteByteArrayOp_StablePtr -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp Nothing (bWord dflags) res args
WriteByteArrayOp_Int8 -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp (Just (mo_WordTo8 dflags)) b8 res args
WriteByteArrayOp_Int16 -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp (Just (mo_WordTo16 dflags)) b16 res args
WriteByteArrayOp_Int32 -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b32 res args
WriteByteArrayOp_Int64 -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp Nothing b64 res args
WriteByteArrayOp_Word8 -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp (Just (mo_WordTo8 dflags)) b8 res args
WriteByteArrayOp_Word16 -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp (Just (mo_WordTo16 dflags)) b16 res args
WriteByteArrayOp_Word32 -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b32 res args
WriteByteArrayOp_Word64 -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp Nothing b64 res args
WriteByteArrayOp_Word8AsChar -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp (Just (mo_WordTo8 dflags)) b8 res args
WriteByteArrayOp_Word8AsWideChar -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b8 res args
WriteByteArrayOp_Word8AsInt -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp Nothing b8 res args
WriteByteArrayOp_Word8AsWord -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp Nothing b8 res args
WriteByteArrayOp_Word8AsAddr -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp Nothing b8 res args
WriteByteArrayOp_Word8AsFloat -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp Nothing b8 res args
WriteByteArrayOp_Word8AsDouble -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp Nothing b8 res args
WriteByteArrayOp_Word8AsStablePtr -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp Nothing b8 res args
WriteByteArrayOp_Word8AsInt16 -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp (Just (mo_WordTo16 dflags)) b8 res args
WriteByteArrayOp_Word8AsInt32 -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b8 res args
WriteByteArrayOp_Word8AsInt64 -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp Nothing b8 res args
WriteByteArrayOp_Word8AsWord16 -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp (Just (mo_WordTo16 dflags)) b8 res args
WriteByteArrayOp_Word8AsWord32 -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b8 res args
WriteByteArrayOp_Word8AsWord64 -> \args -> opAllDone $ \res -> do
doWriteByteArrayOp Nothing b8 res args
CopyByteArrayOp -> \[src,src_off,dst,dst_off,n] -> opAllDone $ \[] -> do
doCopyByteArrayOp src src_off dst dst_off n
CopyMutableByteArrayOp -> \[src,src_off,dst,dst_off,n] -> opAllDone $ \[] -> do
doCopyMutableByteArrayOp src src_off dst dst_off n
CopyByteArrayToAddrOp -> \[src,src_off,dst,n] -> opAllDone $ \[] -> do
doCopyByteArrayToAddrOp src src_off dst n
CopyMutableByteArrayToAddrOp -> \[src,src_off,dst,n] -> opAllDone $ \[] -> do
doCopyMutableByteArrayToAddrOp src src_off dst n
CopyAddrToByteArrayOp -> \[src,dst,dst_off,n] -> opAllDone $ \[] -> do
doCopyAddrToByteArrayOp src dst dst_off n
SetByteArrayOp -> \[ba,off,len,c] -> opAllDone $ \[] -> do
doSetByteArrayOp ba off len c
CompareByteArraysOp -> \[ba1,ba1_off,ba2,ba2_off,n] -> opAllDone $ \[res] -> do
doCompareByteArraysOp res ba1 ba1_off ba2 ba2_off n
BSwap16Op -> \[w] -> opAllDone $ \[res] -> do
emitBSwapCall res w W16
BSwap32Op -> \[w] -> opAllDone $ \[res] -> do
emitBSwapCall res w W32
BSwap64Op -> \[w] -> opAllDone $ \[res] -> do
emitBSwapCall res w W64
BSwapOp -> \[w] -> opAllDone $ \[res] -> do
emitBSwapCall res w (wordWidth dflags)
BRev8Op -> \[w] -> opAllDone $ \[res] -> do
emitBRevCall res w W8
BRev16Op -> \[w] -> opAllDone $ \[res] -> do
emitBRevCall res w W16
BRev32Op -> \[w] -> opAllDone $ \[res] -> do
emitBRevCall res w W32
BRev64Op -> \[w] -> opAllDone $ \[res] -> do
emitBRevCall res w W64
BRevOp -> \[w] -> opAllDone $ \[res] -> do
emitBRevCall res w (wordWidth dflags)
PopCnt8Op -> \[w] -> opAllDone $ \[res] -> do
emitPopCntCall res w W8
PopCnt16Op -> \[w] -> opAllDone $ \[res] -> do
emitPopCntCall res w W16
PopCnt32Op -> \[w] -> opAllDone $ \[res] -> do
emitPopCntCall res w W32
PopCnt64Op -> \[w] -> opAllDone $ \[res] -> do
emitPopCntCall res w W64
PopCntOp -> \[w] -> opAllDone $ \[res] -> do
emitPopCntCall res w (wordWidth dflags)
Pdep8Op -> \[src, mask] -> opAllDone $ \[res] -> do
emitPdepCall res src mask W8
Pdep16Op -> \[src, mask] -> opAllDone $ \[res] -> do
emitPdepCall res src mask W16
Pdep32Op -> \[src, mask] -> opAllDone $ \[res] -> do
emitPdepCall res src mask W32
Pdep64Op -> \[src, mask] -> opAllDone $ \[res] -> do
emitPdepCall res src mask W64
PdepOp -> \[src, mask] -> opAllDone $ \[res] -> do
emitPdepCall res src mask (wordWidth dflags)
Pext8Op -> \[src, mask] -> opAllDone $ \[res] -> do
emitPextCall res src mask W8
Pext16Op -> \[src, mask] -> opAllDone $ \[res] -> do
emitPextCall res src mask W16
Pext32Op -> \[src, mask] -> opAllDone $ \[res] -> do
emitPextCall res src mask W32
Pext64Op -> \[src, mask] -> opAllDone $ \[res] -> do
emitPextCall res src mask W64
PextOp -> \[src, mask] -> opAllDone $ \[res] -> do
emitPextCall res src mask (wordWidth dflags)
Clz8Op -> \[w] -> opAllDone $ \[res] -> do
emitClzCall res w W8
Clz16Op -> \[w] -> opAllDone $ \[res] -> do
emitClzCall res w W16
Clz32Op -> \[w] -> opAllDone $ \[res] -> do
emitClzCall res w W32
Clz64Op -> \[w] -> opAllDone $ \[res] -> do
emitClzCall res w W64
ClzOp -> \[w] -> opAllDone $ \[res] -> do
emitClzCall res w (wordWidth dflags)
Ctz8Op -> \[w] -> opAllDone $ \[res] -> do
emitCtzCall res w W8
Ctz16Op -> \[w] -> opAllDone $ \[res] -> do
emitCtzCall res w W16
Ctz32Op -> \[w] -> opAllDone $ \[res] -> do
emitCtzCall res w W32
Ctz64Op -> \[w] -> opAllDone $ \[res] -> do
emitCtzCall res w W64
CtzOp -> \[w] -> opAllDone $ \[res] -> do
emitCtzCall res w (wordWidth dflags)
Word2FloatOp -> \[w] -> opAllDone $ \[res] -> do
emitPrimCall [res] (MO_UF_Conv W32) [w]
Word2DoubleOp -> \[w] -> opAllDone $ \[res] -> do
emitPrimCall [res] (MO_UF_Conv W64) [w]
(VecBroadcastOp vcat n w) -> \[e] -> opAllDone $ \[res] -> do
checkVecCompatibility dflags vcat n w
doVecPackOp (vecElemInjectCast dflags vcat w) ty zeros (replicate n e) res
where
zeros :: CmmExpr
zeros = CmmLit $ CmmVec (replicate n zero)
zero :: CmmLit
zero = case vcat of
IntVec -> CmmInt 0 w
WordVec -> CmmInt 0 w
FloatVec -> CmmFloat 0 w
ty :: CmmType
ty = vecVmmType vcat n w
(VecPackOp vcat n w) -> \es -> opAllDone $ \[res] -> do
checkVecCompatibility dflags vcat n w
when (es `lengthIsNot` n) $
panic "emitPrimOp: VecPackOp has wrong number of arguments"
doVecPackOp (vecElemInjectCast dflags vcat w) ty zeros es res
where
zeros :: CmmExpr
zeros = CmmLit $ CmmVec (replicate n zero)
zero :: CmmLit
zero = case vcat of
IntVec -> CmmInt 0 w
WordVec -> CmmInt 0 w
FloatVec -> CmmFloat 0 w
ty :: CmmType
ty = vecVmmType vcat n w
(VecUnpackOp vcat n w) -> \[arg] -> opAllDone $ \res -> do
checkVecCompatibility dflags vcat n w
when (res `lengthIsNot` n) $
panic "emitPrimOp: VecUnpackOp has wrong number of results"
doVecUnpackOp (vecElemProjectCast dflags vcat w) ty arg res
where
ty :: CmmType
ty = vecVmmType vcat n w
(VecInsertOp vcat n w) -> \[v,e,i] -> opAllDone $ \[res] -> do
checkVecCompatibility dflags vcat n w
doVecInsertOp (vecElemInjectCast dflags vcat w) ty v e i res
where
ty :: CmmType
ty = vecVmmType vcat n w
(VecIndexByteArrayOp vcat n w) -> \args -> opAllDone $ \res0 -> do
checkVecCompatibility dflags vcat n w
doIndexByteArrayOp Nothing ty res0 args
where
ty :: CmmType
ty = vecVmmType vcat n w
(VecReadByteArrayOp vcat n w) -> \args -> opAllDone $ \res0 -> do
checkVecCompatibility dflags vcat n w
doIndexByteArrayOp Nothing ty res0 args
where
ty :: CmmType
ty = vecVmmType vcat n w
(VecWriteByteArrayOp vcat n w) -> \args -> opAllDone $ \res0 -> do
checkVecCompatibility dflags vcat n w
doWriteByteArrayOp Nothing ty res0 args
where
ty :: CmmType
ty = vecVmmType vcat n w
(VecIndexOffAddrOp vcat n w) -> \args -> opAllDone $ \res0 -> do
checkVecCompatibility dflags vcat n w
doIndexOffAddrOp Nothing ty res0 args
where
ty :: CmmType
ty = vecVmmType vcat n w
(VecReadOffAddrOp vcat n w) -> \args -> opAllDone $ \res0 -> do
checkVecCompatibility dflags vcat n w
doIndexOffAddrOp Nothing ty res0 args
where
ty :: CmmType
ty = vecVmmType vcat n w
(VecWriteOffAddrOp vcat n w) -> \args -> opAllDone $ \res0 -> do
checkVecCompatibility dflags vcat n w
doWriteOffAddrOp Nothing ty res0 args
where
ty :: CmmType
ty = vecVmmType vcat n w
(VecIndexScalarByteArrayOp vcat n w) -> \args -> opAllDone $ \res0 -> do
checkVecCompatibility dflags vcat n w
doIndexByteArrayOpAs Nothing vecty ty res0 args
where
vecty :: CmmType
vecty = vecVmmType vcat n w
ty :: CmmType
ty = vecCmmCat vcat w
(VecReadScalarByteArrayOp vcat n w) -> \args -> opAllDone $ \res0 -> do
checkVecCompatibility dflags vcat n w
doIndexByteArrayOpAs Nothing vecty ty res0 args
where
vecty :: CmmType
vecty = vecVmmType vcat n w
ty :: CmmType
ty = vecCmmCat vcat w
(VecWriteScalarByteArrayOp vcat n w) -> \args -> opAllDone $ \res0 -> do
checkVecCompatibility dflags vcat n w
doWriteByteArrayOp Nothing ty res0 args
where
ty :: CmmType
ty = vecCmmCat vcat w
(VecIndexScalarOffAddrOp vcat n w) -> \args -> opAllDone $ \res0 -> do
checkVecCompatibility dflags vcat n w
doIndexOffAddrOpAs Nothing vecty ty res0 args
where
vecty :: CmmType
vecty = vecVmmType vcat n w
ty :: CmmType
ty = vecCmmCat vcat w
(VecReadScalarOffAddrOp vcat n w) -> \args -> opAllDone $ \res0 -> do
checkVecCompatibility dflags vcat n w
doIndexOffAddrOpAs Nothing vecty ty res0 args
where
vecty :: CmmType
vecty = vecVmmType vcat n w
ty :: CmmType
ty = vecCmmCat vcat w
(VecWriteScalarOffAddrOp vcat n w) -> \args -> opAllDone $ \res0 -> do
checkVecCompatibility dflags vcat n w
doWriteOffAddrOp Nothing ty res0 args
where
ty :: CmmType
ty = vecCmmCat vcat w
PrefetchByteArrayOp3 -> \args -> opAllDone $ \[] -> do
doPrefetchByteArrayOp 3 args
PrefetchMutableByteArrayOp3 -> \args -> opAllDone $ \[] -> do
doPrefetchMutableByteArrayOp 3 args
PrefetchAddrOp3 -> \args -> opAllDone $ \[] -> do
doPrefetchAddrOp 3 args
PrefetchValueOp3 -> \args -> opAllDone $ \[] -> do
doPrefetchValueOp 3 args
PrefetchByteArrayOp2 -> \args -> opAllDone $ \[] -> do
doPrefetchByteArrayOp 2 args
PrefetchMutableByteArrayOp2 -> \args -> opAllDone $ \[] -> do
doPrefetchMutableByteArrayOp 2 args
PrefetchAddrOp2 -> \args -> opAllDone $ \[] -> do
doPrefetchAddrOp 2 args
PrefetchValueOp2 -> \args -> opAllDone $ \[] -> do
doPrefetchValueOp 2 args
PrefetchByteArrayOp1 -> \args -> opAllDone $ \[] -> do
doPrefetchByteArrayOp 1 args
PrefetchMutableByteArrayOp1 -> \args -> opAllDone $ \[] -> do
doPrefetchMutableByteArrayOp 1 args
PrefetchAddrOp1 -> \args -> opAllDone $ \[] -> do
doPrefetchAddrOp 1 args
PrefetchValueOp1 -> \args -> opAllDone $ \[] -> do
doPrefetchValueOp 1 args
PrefetchByteArrayOp0 -> \args -> opAllDone $ \[] -> do
doPrefetchByteArrayOp 0 args
PrefetchMutableByteArrayOp0 -> \args -> opAllDone $ \[] -> do
doPrefetchMutableByteArrayOp 0 args
PrefetchAddrOp0 -> \args -> opAllDone $ \[] -> do
doPrefetchAddrOp 0 args
PrefetchValueOp0 -> \args -> opAllDone $ \[] -> do
doPrefetchValueOp 0 args
FetchAddByteArrayOp_Int -> \[mba, ix, n] -> opAllDone $ \[res] -> do
doAtomicRMW res AMO_Add mba ix (bWord dflags) n
FetchSubByteArrayOp_Int -> \[mba, ix, n] -> opAllDone $ \[res] -> do
doAtomicRMW res AMO_Sub mba ix (bWord dflags) n
FetchAndByteArrayOp_Int -> \[mba, ix, n] -> opAllDone $ \[res] -> do
doAtomicRMW res AMO_And mba ix (bWord dflags) n
FetchNandByteArrayOp_Int -> \[mba, ix, n] -> opAllDone $ \[res] -> do
doAtomicRMW res AMO_Nand mba ix (bWord dflags) n
FetchOrByteArrayOp_Int -> \[mba, ix, n] -> opAllDone $ \[res] -> do
doAtomicRMW res AMO_Or mba ix (bWord dflags) n
FetchXorByteArrayOp_Int -> \[mba, ix, n] -> opAllDone $ \[res] -> do
doAtomicRMW res AMO_Xor mba ix (bWord dflags) n
AtomicReadByteArrayOp_Int -> \[mba, ix] -> opAllDone $ \[res] -> do
doAtomicReadByteArray res mba ix (bWord dflags)
AtomicWriteByteArrayOp_Int -> \[mba, ix, val] -> opAllDone $ \[] -> do
doAtomicWriteByteArray mba ix (bWord dflags) val
CasByteArrayOp_Int -> \[mba, ix, old, new] -> opAllDone $ \[res] -> do
doCasByteArray res mba ix (bWord dflags) old new
Int2WordOp -> \args -> opNop args
Word2IntOp -> \args -> opNop args
Int2AddrOp -> \args -> opNop args
Addr2IntOp -> \args -> opNop args
ChrOp -> \args -> opNop args
OrdOp -> \args -> opNop args
Narrow8IntOp -> \args -> opNarrow dflags args (MO_SS_Conv, W8)
Narrow16IntOp -> \args -> opNarrow dflags args (MO_SS_Conv, W16)
Narrow32IntOp -> \args -> opNarrow dflags args (MO_SS_Conv, W32)
Narrow8WordOp -> \args -> opNarrow dflags args (MO_UU_Conv, W8)
Narrow16WordOp -> \args -> opNarrow dflags args (MO_UU_Conv, W16)
Narrow32WordOp -> \args -> opNarrow dflags args (MO_UU_Conv, W32)
DoublePowerOp -> \args -> opCallish args MO_F64_Pwr
DoubleSinOp -> \args -> opCallish args MO_F64_Sin
DoubleCosOp -> \args -> opCallish args MO_F64_Cos
DoubleTanOp -> \args -> opCallish args MO_F64_Tan
DoubleSinhOp -> \args -> opCallish args MO_F64_Sinh
DoubleCoshOp -> \args -> opCallish args MO_F64_Cosh
DoubleTanhOp -> \args -> opCallish args MO_F64_Tanh
DoubleAsinOp -> \args -> opCallish args MO_F64_Asin
DoubleAcosOp -> \args -> opCallish args MO_F64_Acos
DoubleAtanOp -> \args -> opCallish args MO_F64_Atan
DoubleAsinhOp -> \args -> opCallish args MO_F64_Asinh
DoubleAcoshOp -> \args -> opCallish args MO_F64_Acosh
DoubleAtanhOp -> \args -> opCallish args MO_F64_Atanh
DoubleLogOp -> \args -> opCallish args MO_F64_Log
DoubleLog1POp -> \args -> opCallish args MO_F64_Log1P
DoubleExpOp -> \args -> opCallish args MO_F64_Exp
DoubleExpM1Op -> \args -> opCallish args MO_F64_ExpM1
DoubleSqrtOp -> \args -> opCallish args MO_F64_Sqrt
FloatPowerOp -> \args -> opCallish args MO_F32_Pwr
FloatSinOp -> \args -> opCallish args MO_F32_Sin
FloatCosOp -> \args -> opCallish args MO_F32_Cos
FloatTanOp -> \args -> opCallish args MO_F32_Tan
FloatSinhOp -> \args -> opCallish args MO_F32_Sinh
FloatCoshOp -> \args -> opCallish args MO_F32_Cosh
FloatTanhOp -> \args -> opCallish args MO_F32_Tanh
FloatAsinOp -> \args -> opCallish args MO_F32_Asin
FloatAcosOp -> \args -> opCallish args MO_F32_Acos
FloatAtanOp -> \args -> opCallish args MO_F32_Atan
FloatAsinhOp -> \args -> opCallish args MO_F32_Asinh
FloatAcoshOp -> \args -> opCallish args MO_F32_Acosh
FloatAtanhOp -> \args -> opCallish args MO_F32_Atanh
FloatLogOp -> \args -> opCallish args MO_F32_Log
FloatLog1POp -> \args -> opCallish args MO_F32_Log1P
FloatExpOp -> \args -> opCallish args MO_F32_Exp
FloatExpM1Op -> \args -> opCallish args MO_F32_ExpM1
FloatSqrtOp -> \args -> opCallish args MO_F32_Sqrt
IntAddOp -> \args -> opTranslate args (mo_wordAdd dflags)
IntSubOp -> \args -> opTranslate args (mo_wordSub dflags)
WordAddOp -> \args -> opTranslate args (mo_wordAdd dflags)
WordSubOp -> \args -> opTranslate args (mo_wordSub dflags)
AddrAddOp -> \args -> opTranslate args (mo_wordAdd dflags)
AddrSubOp -> \args -> opTranslate args (mo_wordSub dflags)
IntEqOp -> \args -> opTranslate args (mo_wordEq dflags)
IntNeOp -> \args -> opTranslate args (mo_wordNe dflags)
WordEqOp -> \args -> opTranslate args (mo_wordEq dflags)
WordNeOp -> \args -> opTranslate args (mo_wordNe dflags)
AddrEqOp -> \args -> opTranslate args (mo_wordEq dflags)
AddrNeOp -> \args -> opTranslate args (mo_wordNe dflags)
AndOp -> \args -> opTranslate args (mo_wordAnd dflags)
OrOp -> \args -> opTranslate args (mo_wordOr dflags)
XorOp -> \args -> opTranslate args (mo_wordXor dflags)
NotOp -> \args -> opTranslate args (mo_wordNot dflags)
SllOp -> \args -> opTranslate args (mo_wordShl dflags)
SrlOp -> \args -> opTranslate args (mo_wordUShr dflags)
AddrRemOp -> \args -> opTranslate args (mo_wordURem dflags)
IntMulOp -> \args -> opTranslate args (mo_wordMul dflags)
IntMulMayOfloOp -> \args -> opTranslate args (MO_S_MulMayOflo (wordWidth dflags))
IntQuotOp -> \args -> opTranslate args (mo_wordSQuot dflags)
IntRemOp -> \args -> opTranslate args (mo_wordSRem dflags)
IntNegOp -> \args -> opTranslate args (mo_wordSNeg dflags)
IntGeOp -> \args -> opTranslate args (mo_wordSGe dflags)
IntLeOp -> \args -> opTranslate args (mo_wordSLe dflags)
IntGtOp -> \args -> opTranslate args (mo_wordSGt dflags)
IntLtOp -> \args -> opTranslate args (mo_wordSLt dflags)
AndIOp -> \args -> opTranslate args (mo_wordAnd dflags)
OrIOp -> \args -> opTranslate args (mo_wordOr dflags)
XorIOp -> \args -> opTranslate args (mo_wordXor dflags)
NotIOp -> \args -> opTranslate args (mo_wordNot dflags)
ISllOp -> \args -> opTranslate args (mo_wordShl dflags)
ISraOp -> \args -> opTranslate args (mo_wordSShr dflags)
ISrlOp -> \args -> opTranslate args (mo_wordUShr dflags)
WordGeOp -> \args -> opTranslate args (mo_wordUGe dflags)
WordLeOp -> \args -> opTranslate args (mo_wordULe dflags)
WordGtOp -> \args -> opTranslate args (mo_wordUGt dflags)
WordLtOp -> \args -> opTranslate args (mo_wordULt dflags)
WordMulOp -> \args -> opTranslate args (mo_wordMul dflags)
WordQuotOp -> \args -> opTranslate args (mo_wordUQuot dflags)
WordRemOp -> \args -> opTranslate args (mo_wordURem dflags)
AddrGeOp -> \args -> opTranslate args (mo_wordUGe dflags)
AddrLeOp -> \args -> opTranslate args (mo_wordULe dflags)
AddrGtOp -> \args -> opTranslate args (mo_wordUGt dflags)
AddrLtOp -> \args -> opTranslate args (mo_wordULt dflags)
Int8Extend -> \args -> opTranslate args (MO_SS_Conv W8 (wordWidth dflags))
Int8Narrow -> \args -> opTranslate args (MO_SS_Conv (wordWidth dflags) W8)
Int8NegOp -> \args -> opTranslate args (MO_S_Neg W8)
Int8AddOp -> \args -> opTranslate args (MO_Add W8)
Int8SubOp -> \args -> opTranslate args (MO_Sub W8)
Int8MulOp -> \args -> opTranslate args (MO_Mul W8)
Int8QuotOp -> \args -> opTranslate args (MO_S_Quot W8)
Int8RemOp -> \args -> opTranslate args (MO_S_Rem W8)
Int8EqOp -> \args -> opTranslate args (MO_Eq W8)
Int8GeOp -> \args -> opTranslate args (MO_S_Ge W8)
Int8GtOp -> \args -> opTranslate args (MO_S_Gt W8)
Int8LeOp -> \args -> opTranslate args (MO_S_Le W8)
Int8LtOp -> \args -> opTranslate args (MO_S_Lt W8)
Int8NeOp -> \args -> opTranslate args (MO_Ne W8)
Word8Extend -> \args -> opTranslate args (MO_UU_Conv W8 (wordWidth dflags))
Word8Narrow -> \args -> opTranslate args (MO_UU_Conv (wordWidth dflags) W8)
Word8NotOp -> \args -> opTranslate args (MO_Not W8)
Word8AddOp -> \args -> opTranslate args (MO_Add W8)
Word8SubOp -> \args -> opTranslate args (MO_Sub W8)
Word8MulOp -> \args -> opTranslate args (MO_Mul W8)
Word8QuotOp -> \args -> opTranslate args (MO_U_Quot W8)
Word8RemOp -> \args -> opTranslate args (MO_U_Rem W8)
Word8EqOp -> \args -> opTranslate args (MO_Eq W8)
Word8GeOp -> \args -> opTranslate args (MO_U_Ge W8)
Word8GtOp -> \args -> opTranslate args (MO_U_Gt W8)
Word8LeOp -> \args -> opTranslate args (MO_U_Le W8)
Word8LtOp -> \args -> opTranslate args (MO_U_Lt W8)
Word8NeOp -> \args -> opTranslate args (MO_Ne W8)
Int16Extend -> \args -> opTranslate args (MO_SS_Conv W16 (wordWidth dflags))
Int16Narrow -> \args -> opTranslate args (MO_SS_Conv (wordWidth dflags) W16)
Int16NegOp -> \args -> opTranslate args (MO_S_Neg W16)
Int16AddOp -> \args -> opTranslate args (MO_Add W16)
Int16SubOp -> \args -> opTranslate args (MO_Sub W16)
Int16MulOp -> \args -> opTranslate args (MO_Mul W16)
Int16QuotOp -> \args -> opTranslate args (MO_S_Quot W16)
Int16RemOp -> \args -> opTranslate args (MO_S_Rem W16)
Int16EqOp -> \args -> opTranslate args (MO_Eq W16)
Int16GeOp -> \args -> opTranslate args (MO_S_Ge W16)
Int16GtOp -> \args -> opTranslate args (MO_S_Gt W16)
Int16LeOp -> \args -> opTranslate args (MO_S_Le W16)
Int16LtOp -> \args -> opTranslate args (MO_S_Lt W16)
Int16NeOp -> \args -> opTranslate args (MO_Ne W16)
Word16Extend -> \args -> opTranslate args (MO_UU_Conv W16 (wordWidth dflags))
Word16Narrow -> \args -> opTranslate args (MO_UU_Conv (wordWidth dflags) W16)
Word16NotOp -> \args -> opTranslate args (MO_Not W16)
Word16AddOp -> \args -> opTranslate args (MO_Add W16)
Word16SubOp -> \args -> opTranslate args (MO_Sub W16)
Word16MulOp -> \args -> opTranslate args (MO_Mul W16)
Word16QuotOp -> \args -> opTranslate args (MO_U_Quot W16)
Word16RemOp -> \args -> opTranslate args (MO_U_Rem W16)
Word16EqOp -> \args -> opTranslate args (MO_Eq W16)
Word16GeOp -> \args -> opTranslate args (MO_U_Ge W16)
Word16GtOp -> \args -> opTranslate args (MO_U_Gt W16)
Word16LeOp -> \args -> opTranslate args (MO_U_Le W16)
Word16LtOp -> \args -> opTranslate args (MO_U_Lt W16)
Word16NeOp -> \args -> opTranslate args (MO_Ne W16)
CharEqOp -> \args -> opTranslate args (MO_Eq (wordWidth dflags))
CharNeOp -> \args -> opTranslate args (MO_Ne (wordWidth dflags))
CharGeOp -> \args -> opTranslate args (MO_U_Ge (wordWidth dflags))
CharLeOp -> \args -> opTranslate args (MO_U_Le (wordWidth dflags))
CharGtOp -> \args -> opTranslate args (MO_U_Gt (wordWidth dflags))
CharLtOp -> \args -> opTranslate args (MO_U_Lt (wordWidth dflags))
DoubleEqOp -> \args -> opTranslate args (MO_F_Eq W64)
DoubleNeOp -> \args -> opTranslate args (MO_F_Ne W64)
DoubleGeOp -> \args -> opTranslate args (MO_F_Ge W64)
DoubleLeOp -> \args -> opTranslate args (MO_F_Le W64)
DoubleGtOp -> \args -> opTranslate args (MO_F_Gt W64)
DoubleLtOp -> \args -> opTranslate args (MO_F_Lt W64)
DoubleAddOp -> \args -> opTranslate args (MO_F_Add W64)
DoubleSubOp -> \args -> opTranslate args (MO_F_Sub W64)
DoubleMulOp -> \args -> opTranslate args (MO_F_Mul W64)
DoubleDivOp -> \args -> opTranslate args (MO_F_Quot W64)
DoubleNegOp -> \args -> opTranslate args (MO_F_Neg W64)
FloatEqOp -> \args -> opTranslate args (MO_F_Eq W32)
FloatNeOp -> \args -> opTranslate args (MO_F_Ne W32)
FloatGeOp -> \args -> opTranslate args (MO_F_Ge W32)
FloatLeOp -> \args -> opTranslate args (MO_F_Le W32)
FloatGtOp -> \args -> opTranslate args (MO_F_Gt W32)
FloatLtOp -> \args -> opTranslate args (MO_F_Lt W32)
FloatAddOp -> \args -> opTranslate args (MO_F_Add W32)
FloatSubOp -> \args -> opTranslate args (MO_F_Sub W32)
FloatMulOp -> \args -> opTranslate args (MO_F_Mul W32)
FloatDivOp -> \args -> opTranslate args (MO_F_Quot W32)
FloatNegOp -> \args -> opTranslate args (MO_F_Neg W32)
(VecAddOp FloatVec n w) -> \args -> opTranslate args (MO_VF_Add n w)
(VecSubOp FloatVec n w) -> \args -> opTranslate args (MO_VF_Sub n w)
(VecMulOp FloatVec n w) -> \args -> opTranslate args (MO_VF_Mul n w)
(VecDivOp FloatVec n w) -> \args -> opTranslate args (MO_VF_Quot n w)
(VecQuotOp FloatVec _ _) -> \_ -> panic "unsupported primop"
(VecRemOp FloatVec _ _) -> \_ -> panic "unsupported primop"
(VecNegOp FloatVec n w) -> \args -> opTranslate args (MO_VF_Neg n w)
(VecAddOp IntVec n w) -> \args -> opTranslate args (MO_V_Add n w)
(VecSubOp IntVec n w) -> \args -> opTranslate args (MO_V_Sub n w)
(VecMulOp IntVec n w) -> \args -> opTranslate args (MO_V_Mul n w)
(VecDivOp IntVec _ _) -> \_ -> panic "unsupported primop"
(VecQuotOp IntVec n w) -> \args -> opTranslate args (MO_VS_Quot n w)
(VecRemOp IntVec n w) -> \args -> opTranslate args (MO_VS_Rem n w)
(VecNegOp IntVec n w) -> \args -> opTranslate args (MO_VS_Neg n w)
(VecAddOp WordVec n w) -> \args -> opTranslate args (MO_V_Add n w)
(VecSubOp WordVec n w) -> \args -> opTranslate args (MO_V_Sub n w)
(VecMulOp WordVec n w) -> \args -> opTranslate args (MO_V_Mul n w)
(VecDivOp WordVec _ _) -> \_ -> panic "unsupported primop"
(VecQuotOp WordVec n w) -> \args -> opTranslate args (MO_VU_Quot n w)
(VecRemOp WordVec n w) -> \args -> opTranslate args (MO_VU_Rem n w)
(VecNegOp WordVec _ _) -> \_ -> panic "unsupported primop"
Int2DoubleOp -> \args -> opTranslate args (MO_SF_Conv (wordWidth dflags) W64)
Double2IntOp -> \args -> opTranslate args (MO_FS_Conv W64 (wordWidth dflags))
Int2FloatOp -> \args -> opTranslate args (MO_SF_Conv (wordWidth dflags) W32)
Float2IntOp -> \args -> opTranslate args (MO_FS_Conv W32 (wordWidth dflags))
Float2DoubleOp -> \args -> opTranslate args (MO_FF_Conv W32 W64)
Double2FloatOp -> \args -> opTranslate args (MO_FF_Conv W64 W32)
SameMutVarOp -> \args -> opTranslate args (mo_wordEq dflags)
SameMVarOp -> \args -> opTranslate args (mo_wordEq dflags)
SameMutableArrayOp -> \args -> opTranslate args (mo_wordEq dflags)
SameMutableByteArrayOp -> \args -> opTranslate args (mo_wordEq dflags)
SameMutableArrayArrayOp -> \args -> opTranslate args (mo_wordEq dflags)
SameSmallMutableArrayOp -> \args -> opTranslate args (mo_wordEq dflags)
SameTVarOp -> \args -> opTranslate args (mo_wordEq dflags)
EqStablePtrOp -> \args -> opTranslate args (mo_wordEq dflags)
EqStableNameOp -> \args -> opTranslate args (mo_wordEq dflags)
IntQuotRemOp -> \args -> opCallishHandledLater args $
if ncg && (x86ish || ppc) && not (quotRemCanBeOptimized args)
then Left (MO_S_QuotRem (wordWidth dflags))
else Right (genericIntQuotRemOp (wordWidth dflags))
Int8QuotRemOp -> \args -> opCallishHandledLater args $
if ncg && (x86ish || ppc) && not (quotRemCanBeOptimized args)
then Left (MO_S_QuotRem W8)
else Right (genericIntQuotRemOp W8)
Int16QuotRemOp -> \args -> opCallishHandledLater args $
if ncg && (x86ish || ppc) && not (quotRemCanBeOptimized args)
then Left (MO_S_QuotRem W16)
else Right (genericIntQuotRemOp W16)
WordQuotRemOp -> \args -> opCallishHandledLater args $
if ncg && (x86ish || ppc) && not (quotRemCanBeOptimized args)
then Left (MO_U_QuotRem (wordWidth dflags))
else Right (genericWordQuotRemOp (wordWidth dflags))
WordQuotRem2Op -> \args -> opCallishHandledLater args $
if (ncg && (x86ish || ppc)) || llvm
then Left (MO_U_QuotRem2 (wordWidth dflags))
else Right (genericWordQuotRem2Op dflags)
Word8QuotRemOp -> \args -> opCallishHandledLater args $
if ncg && (x86ish || ppc) && not (quotRemCanBeOptimized args)
then Left (MO_U_QuotRem W8)
else Right (genericWordQuotRemOp W8)
Word16QuotRemOp -> \args -> opCallishHandledLater args $
if ncg && (x86ish || ppc) && not (quotRemCanBeOptimized args)
then Left (MO_U_QuotRem W16)
else Right (genericWordQuotRemOp W16)
WordAdd2Op -> \args -> opCallishHandledLater args $
if (ncg && (x86ish || ppc)) || llvm
then Left (MO_Add2 (wordWidth dflags))
else Right genericWordAdd2Op
WordAddCOp -> \args -> opCallishHandledLater args $
if (ncg && (x86ish || ppc)) || llvm
then Left (MO_AddWordC (wordWidth dflags))
else Right genericWordAddCOp
WordSubCOp -> \args -> opCallishHandledLater args $
if (ncg && (x86ish || ppc)) || llvm
then Left (MO_SubWordC (wordWidth dflags))
else Right genericWordSubCOp
IntAddCOp -> \args -> opCallishHandledLater args $
if (ncg && (x86ish || ppc)) || llvm
then Left (MO_AddIntC (wordWidth dflags))
else Right genericIntAddCOp
IntSubCOp -> \args -> opCallishHandledLater args $
if (ncg && (x86ish || ppc)) || llvm
then Left (MO_SubIntC (wordWidth dflags))
else Right genericIntSubCOp
WordMul2Op -> \args -> opCallishHandledLater args $
if ncg && (x86ish || ppc) || llvm
then Left (MO_U_Mul2 (wordWidth dflags))
else Right genericWordMul2Op
FloatFabsOp -> \args -> opCallishHandledLater args $
if (ncg && x86ish || ppc) || llvm
then Left MO_F32_Fabs
else Right $ genericFabsOp W32
DoubleFabsOp -> \args -> opCallishHandledLater args $
if (ncg && x86ish || ppc) || llvm
then Left MO_F64_Fabs
else Right $ genericFabsOp W64
TagToEnumOp -> \[amode] -> PrimopCmmEmit_Raw $ \res_ty -> do
let tycon = tyConAppTyCon res_ty
MASSERT(isEnumerationTyCon tycon)
dflags <- getDynFlags
pure [tagToClosure dflags tycon amode]
UnsafeThawArrayOp -> alwaysExternal
CasArrayOp -> alwaysExternal
UnsafeThawSmallArrayOp -> alwaysExternal
CasSmallArrayOp -> alwaysExternal
NewPinnedByteArrayOp_Char -> alwaysExternal
NewAlignedPinnedByteArrayOp_Char -> alwaysExternal
MutableByteArrayIsPinnedOp -> alwaysExternal
DoubleDecode_2IntOp -> alwaysExternal
DoubleDecode_Int64Op -> alwaysExternal
FloatDecode_IntOp -> alwaysExternal
ByteArrayIsPinnedOp -> alwaysExternal
ShrinkMutableByteArrayOp_Char -> alwaysExternal
ResizeMutableByteArrayOp_Char -> alwaysExternal
ShrinkSmallMutableArrayOp_Char -> alwaysExternal
NewArrayArrayOp -> alwaysExternal
NewMutVarOp -> alwaysExternal
AtomicModifyMutVar2Op -> alwaysExternal
AtomicModifyMutVar_Op -> alwaysExternal
CasMutVarOp -> alwaysExternal
CatchOp -> alwaysExternal
RaiseOp -> alwaysExternal
RaiseIOOp -> alwaysExternal
MaskAsyncExceptionsOp -> alwaysExternal
MaskUninterruptibleOp -> alwaysExternal
UnmaskAsyncExceptionsOp -> alwaysExternal
MaskStatus -> alwaysExternal
AtomicallyOp -> alwaysExternal
RetryOp -> alwaysExternal
CatchRetryOp -> alwaysExternal
CatchSTMOp -> alwaysExternal
NewTVarOp -> alwaysExternal
ReadTVarOp -> alwaysExternal
ReadTVarIOOp -> alwaysExternal
WriteTVarOp -> alwaysExternal
NewMVarOp -> alwaysExternal
TakeMVarOp -> alwaysExternal
TryTakeMVarOp -> alwaysExternal
PutMVarOp -> alwaysExternal
TryPutMVarOp -> alwaysExternal
ReadMVarOp -> alwaysExternal
TryReadMVarOp -> alwaysExternal
IsEmptyMVarOp -> alwaysExternal
DelayOp -> alwaysExternal
WaitReadOp -> alwaysExternal
WaitWriteOp -> alwaysExternal
ForkOp -> alwaysExternal
ForkOnOp -> alwaysExternal
KillThreadOp -> alwaysExternal
YieldOp -> alwaysExternal
LabelThreadOp -> alwaysExternal
IsCurrentThreadBoundOp -> alwaysExternal
NoDuplicateOp -> alwaysExternal
ThreadStatusOp -> alwaysExternal
MkWeakOp -> alwaysExternal
MkWeakNoFinalizerOp -> alwaysExternal
AddCFinalizerToWeakOp -> alwaysExternal
DeRefWeakOp -> alwaysExternal
FinalizeWeakOp -> alwaysExternal
MakeStablePtrOp -> alwaysExternal
DeRefStablePtrOp -> alwaysExternal
MakeStableNameOp -> alwaysExternal
CompactNewOp -> alwaysExternal
CompactResizeOp -> alwaysExternal
CompactContainsOp -> alwaysExternal
CompactContainsAnyOp -> alwaysExternal
CompactGetFirstBlockOp -> alwaysExternal
CompactGetNextBlockOp -> alwaysExternal
CompactAllocateBlockOp -> alwaysExternal
CompactFixupPointersOp -> alwaysExternal
CompactAdd -> alwaysExternal
CompactAddWithSharing -> alwaysExternal
CompactSize -> alwaysExternal
SeqOp -> alwaysExternal
GetSparkOp -> alwaysExternal
NumSparks -> alwaysExternal
DataToTagOp -> alwaysExternal
MkApUpd0_Op -> alwaysExternal
NewBCOOp -> alwaysExternal
UnpackClosureOp -> alwaysExternal
ClosureSizeOp -> alwaysExternal
GetApStackValOp -> alwaysExternal
ClearCCSOp -> alwaysExternal
TraceEventOp -> alwaysExternal
TraceEventBinaryOp -> alwaysExternal
TraceMarkerOp -> alwaysExternal
SetThreadAllocationCounter -> alwaysExternal
where
alwaysExternal = \_ -> PrimopCmmEmit_External
quotRemCanBeOptimized = \case
[_, CmmLit (CmmInt n _) ] -> isJust (exactLog2 n)
_ -> False
ncg = case hscTarget dflags of
HscAsm -> True
_ -> False
llvm = case hscTarget dflags of
HscLlvm -> True
_ -> False
x86ish = case platformArch (targetPlatform dflags) of
ArchX86 -> True
ArchX86_64 -> True
_ -> False
ppc = case platformArch (targetPlatform dflags) of
ArchPPC -> True
ArchPPC_64 _ -> True
_ -> False
data PrimopCmmEmit
= PrimopCmmEmit_External
| PrimopCmmEmit_IntoRegs ([LocalReg]
-> FCode ())
| PrimopCmmEmit_Raw (Type
-> FCode [CmmExpr])
opNop :: [CmmExpr] -> PrimopCmmEmit
opNop args = PrimopCmmEmit_IntoRegs $ \[res] -> emitAssign (CmmLocal res) arg
where [arg] = args
opNarrow
:: DynFlags
-> [CmmExpr]
-> (Width -> Width -> MachOp, Width)
-> PrimopCmmEmit
opNarrow dflags args (mop, rep) = PrimopCmmEmit_IntoRegs $ \[res] -> emitAssign (CmmLocal res) $
CmmMachOp (mop rep (wordWidth dflags)) [CmmMachOp (mop (wordWidth dflags) rep) [arg]]
where [arg] = args
opCallish :: [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish args prim = PrimopCmmEmit_IntoRegs $ \[res] -> emitPrimCall [res] prim args
opTranslate :: [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate args mop = PrimopCmmEmit_IntoRegs $ \[res] -> do
let stmt = mkAssign (CmmLocal res) (CmmMachOp mop args)
emit stmt
opCallishHandledLater
:: [CmmExpr]
-> Either CallishMachOp GenericOp
-> PrimopCmmEmit
opCallishHandledLater args callOrNot = PrimopCmmEmit_IntoRegs $ \res0 -> case callOrNot of
Left op -> emit $ mkUnsafeCall (PrimTarget op) res0 args
Right gen -> gen res0 args
opAllDone
:: ([LocalReg]
-> FCode ())
-> PrimopCmmEmit
opAllDone f = PrimopCmmEmit_IntoRegs $ f
type GenericOp = [CmmFormal] -> [CmmActual] -> FCode ()
genericIntQuotRemOp :: Width -> GenericOp
genericIntQuotRemOp width [res_q, res_r] [arg_x, arg_y]
= emit $ mkAssign (CmmLocal res_q)
(CmmMachOp (MO_S_Quot width) [arg_x, arg_y]) <*>
mkAssign (CmmLocal res_r)
(CmmMachOp (MO_S_Rem width) [arg_x, arg_y])
genericIntQuotRemOp _ _ _ = panic "genericIntQuotRemOp"
genericWordQuotRemOp :: Width -> GenericOp
genericWordQuotRemOp width [res_q, res_r] [arg_x, arg_y]
= emit $ mkAssign (CmmLocal res_q)
(CmmMachOp (MO_U_Quot width) [arg_x, arg_y]) <*>
mkAssign (CmmLocal res_r)
(CmmMachOp (MO_U_Rem width) [arg_x, arg_y])
genericWordQuotRemOp _ _ _ = panic "genericWordQuotRemOp"
genericWordQuotRem2Op :: DynFlags -> GenericOp
genericWordQuotRem2Op dflags [res_q, res_r] [arg_x_high, arg_x_low, arg_y]
= emit =<< f (widthInBits (wordWidth dflags)) zero arg_x_high arg_x_low
where ty = cmmExprType dflags arg_x_high
shl x i = CmmMachOp (MO_Shl (wordWidth dflags)) [x, i]
shr x i = CmmMachOp (MO_U_Shr (wordWidth dflags)) [x, i]
or x y = CmmMachOp (MO_Or (wordWidth dflags)) [x, y]
ge x y = CmmMachOp (MO_U_Ge (wordWidth dflags)) [x, y]
ne x y = CmmMachOp (MO_Ne (wordWidth dflags)) [x, y]
minus x y = CmmMachOp (MO_Sub (wordWidth dflags)) [x, y]
times x y = CmmMachOp (MO_Mul (wordWidth dflags)) [x, y]
zero = lit 0
one = lit 1
negone = lit (fromIntegral (widthInBits (wordWidth dflags)) 1)
lit i = CmmLit (CmmInt i (wordWidth dflags))
f :: Int -> CmmExpr -> CmmExpr -> CmmExpr -> FCode CmmAGraph
f 0 acc high _ = return (mkAssign (CmmLocal res_q) acc <*>
mkAssign (CmmLocal res_r) high)
f i acc high low =
do roverflowedBit <- newTemp ty
rhigh' <- newTemp ty
rhigh'' <- newTemp ty
rlow' <- newTemp ty
risge <- newTemp ty
racc' <- newTemp ty
let high' = CmmReg (CmmLocal rhigh')
isge = CmmReg (CmmLocal risge)
overflowedBit = CmmReg (CmmLocal roverflowedBit)
let this = catAGraphs
[mkAssign (CmmLocal roverflowedBit)
(shr high negone),
mkAssign (CmmLocal rhigh')
(or (shl high one) (shr low negone)),
mkAssign (CmmLocal rlow')
(shl low one),
mkAssign (CmmLocal risge)
(or (overflowedBit `ne` zero)
(high' `ge` arg_y)),
mkAssign (CmmLocal rhigh'')
(high' `minus` (arg_y `times` isge)),
mkAssign (CmmLocal racc')
(or (shl acc one) isge)]
rest <- f (i 1) (CmmReg (CmmLocal racc'))
(CmmReg (CmmLocal rhigh''))
(CmmReg (CmmLocal rlow'))
return (this <*> rest)
genericWordQuotRem2Op _ _ _ = panic "genericWordQuotRem2Op"
genericWordAdd2Op :: GenericOp
genericWordAdd2Op [res_h, res_l] [arg_x, arg_y]
= do dflags <- getDynFlags
r1 <- newTemp (cmmExprType dflags arg_x)
r2 <- newTemp (cmmExprType dflags arg_x)
let topHalf x = CmmMachOp (MO_U_Shr (wordWidth dflags)) [x, hww]
toTopHalf x = CmmMachOp (MO_Shl (wordWidth dflags)) [x, hww]
bottomHalf x = CmmMachOp (MO_And (wordWidth dflags)) [x, hwm]
add x y = CmmMachOp (MO_Add (wordWidth dflags)) [x, y]
or x y = CmmMachOp (MO_Or (wordWidth dflags)) [x, y]
hww = CmmLit (CmmInt (fromIntegral (widthInBits (halfWordWidth dflags)))
(wordWidth dflags))
hwm = CmmLit (CmmInt (halfWordMask dflags) (wordWidth dflags))
emit $ catAGraphs
[mkAssign (CmmLocal r1)
(add (bottomHalf arg_x) (bottomHalf arg_y)),
mkAssign (CmmLocal r2)
(add (topHalf (CmmReg (CmmLocal r1)))
(add (topHalf arg_x) (topHalf arg_y))),
mkAssign (CmmLocal res_h)
(topHalf (CmmReg (CmmLocal r2))),
mkAssign (CmmLocal res_l)
(or (toTopHalf (CmmReg (CmmLocal r2)))
(bottomHalf (CmmReg (CmmLocal r1))))]
genericWordAdd2Op _ _ = panic "genericWordAdd2Op"
genericWordAddCOp :: GenericOp
genericWordAddCOp [res_r, res_c] [aa, bb]
= do dflags <- getDynFlags
emit $ catAGraphs [
mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordAdd dflags) [aa,bb]),
mkAssign (CmmLocal res_c) $
CmmMachOp (mo_wordUShr dflags) [
CmmMachOp (mo_wordOr dflags) [
CmmMachOp (mo_wordAnd dflags) [aa,bb],
CmmMachOp (mo_wordAnd dflags) [
CmmMachOp (mo_wordOr dflags) [aa,bb],
CmmMachOp (mo_wordNot dflags) [CmmReg (CmmLocal res_r)]
]
],
mkIntExpr dflags (wORD_SIZE_IN_BITS dflags 1)
]
]
genericWordAddCOp _ _ = panic "genericWordAddCOp"
genericWordSubCOp :: GenericOp
genericWordSubCOp [res_r, res_c] [aa, bb]
= do dflags <- getDynFlags
emit $ catAGraphs [
mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordSub dflags) [aa,bb]),
mkAssign (CmmLocal res_c) $
CmmMachOp (mo_wordUShr dflags) [
CmmMachOp (mo_wordOr dflags) [
CmmMachOp (mo_wordAnd dflags) [
CmmMachOp (mo_wordNot dflags) [aa],
bb
],
CmmMachOp (mo_wordAnd dflags) [
CmmMachOp (mo_wordOr dflags) [
CmmMachOp (mo_wordNot dflags) [aa],
bb
],
CmmReg (CmmLocal res_r)
]
],
mkIntExpr dflags (wORD_SIZE_IN_BITS dflags 1)
]
]
genericWordSubCOp _ _ = panic "genericWordSubCOp"
genericIntAddCOp :: GenericOp
genericIntAddCOp [res_r, res_c] [aa, bb]
= do dflags <- getDynFlags
emit $ catAGraphs [
mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordAdd dflags) [aa,bb]),
mkAssign (CmmLocal res_c) $
CmmMachOp (mo_wordUShr dflags) [
CmmMachOp (mo_wordAnd dflags) [
CmmMachOp (mo_wordNot dflags) [CmmMachOp (mo_wordXor dflags) [aa,bb]],
CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
],
mkIntExpr dflags (wORD_SIZE_IN_BITS dflags 1)
]
]
genericIntAddCOp _ _ = panic "genericIntAddCOp"
genericIntSubCOp :: GenericOp
genericIntSubCOp [res_r, res_c] [aa, bb]
= do dflags <- getDynFlags
emit $ catAGraphs [
mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordSub dflags) [aa,bb]),
mkAssign (CmmLocal res_c) $
CmmMachOp (mo_wordUShr dflags) [
CmmMachOp (mo_wordAnd dflags) [
CmmMachOp (mo_wordXor dflags) [aa,bb],
CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
],
mkIntExpr dflags (wORD_SIZE_IN_BITS dflags 1)
]
]
genericIntSubCOp _ _ = panic "genericIntSubCOp"
genericWordMul2Op :: GenericOp
genericWordMul2Op [res_h, res_l] [arg_x, arg_y]
= do dflags <- getDynFlags
let t = cmmExprType dflags arg_x
xlyl <- liftM CmmLocal $ newTemp t
xlyh <- liftM CmmLocal $ newTemp t
xhyl <- liftM CmmLocal $ newTemp t
r <- liftM CmmLocal $ newTemp t
let topHalf x = CmmMachOp (MO_U_Shr (wordWidth dflags)) [x, hww]
toTopHalf x = CmmMachOp (MO_Shl (wordWidth dflags)) [x, hww]
bottomHalf x = CmmMachOp (MO_And (wordWidth dflags)) [x, hwm]
add x y = CmmMachOp (MO_Add (wordWidth dflags)) [x, y]
sum = foldl1 add
mul x y = CmmMachOp (MO_Mul (wordWidth dflags)) [x, y]
or x y = CmmMachOp (MO_Or (wordWidth dflags)) [x, y]
hww = CmmLit (CmmInt (fromIntegral (widthInBits (halfWordWidth dflags)))
(wordWidth dflags))
hwm = CmmLit (CmmInt (halfWordMask dflags) (wordWidth dflags))
emit $ catAGraphs
[mkAssign xlyl
(mul (bottomHalf arg_x) (bottomHalf arg_y)),
mkAssign xlyh
(mul (bottomHalf arg_x) (topHalf arg_y)),
mkAssign xhyl
(mul (topHalf arg_x) (bottomHalf arg_y)),
mkAssign r
(sum [topHalf (CmmReg xlyl),
bottomHalf (CmmReg xhyl),
bottomHalf (CmmReg xlyh)]),
mkAssign (CmmLocal res_l)
(or (bottomHalf (CmmReg xlyl))
(toTopHalf (CmmReg r))),
mkAssign (CmmLocal res_h)
(sum [mul (topHalf arg_x) (topHalf arg_y),
topHalf (CmmReg xhyl),
topHalf (CmmReg xlyh),
topHalf (CmmReg r)])]
genericWordMul2Op _ _ = panic "genericWordMul2Op"
genericFabsOp :: Width -> GenericOp
genericFabsOp w [res_r] [aa]
= do dflags <- getDynFlags
let zero = CmmLit (CmmFloat 0 w)
eq x y = CmmMachOp (MO_F_Eq w) [x, y]
gt x y = CmmMachOp (MO_F_Gt w) [x, y]
neg x = CmmMachOp (MO_F_Neg w) [x]
g1 = catAGraphs [mkAssign (CmmLocal res_r) zero]
g2 = catAGraphs [mkAssign (CmmLocal res_r) aa]
res_t <- CmmLocal <$> newTemp (cmmExprType dflags aa)
let g3 = catAGraphs [mkAssign res_t aa,
mkAssign (CmmLocal res_r) (neg (CmmReg res_t))]
g4 <- mkCmmIfThenElse (gt aa zero) g2 g3
emit =<< mkCmmIfThenElse (eq aa zero) g1 g4
genericFabsOp _ _ _ = panic "genericFabsOp"
doIndexOffAddrOp :: Maybe MachOp
-> CmmType
-> [LocalReg]
-> [CmmExpr]
-> FCode ()
doIndexOffAddrOp maybe_post_read_cast rep [res] [addr,idx]
= mkBasicIndexedRead 0 maybe_post_read_cast rep res addr rep idx
doIndexOffAddrOp _ _ _ _
= panic "GHC.StgToCmm.Prim: doIndexOffAddrOp"
doIndexOffAddrOpAs :: Maybe MachOp
-> CmmType
-> CmmType
-> [LocalReg]
-> [CmmExpr]
-> FCode ()
doIndexOffAddrOpAs maybe_post_read_cast rep idx_rep [res] [addr,idx]
= mkBasicIndexedRead 0 maybe_post_read_cast rep res addr idx_rep idx
doIndexOffAddrOpAs _ _ _ _ _
= panic "GHC.StgToCmm.Prim: doIndexOffAddrOpAs"
doIndexByteArrayOp :: Maybe MachOp
-> CmmType
-> [LocalReg]
-> [CmmExpr]
-> FCode ()
doIndexByteArrayOp maybe_post_read_cast rep [res] [addr,idx]
= do dflags <- getDynFlags
mkBasicIndexedRead (arrWordsHdrSize dflags) maybe_post_read_cast rep res addr rep idx
doIndexByteArrayOp _ _ _ _
= panic "GHC.StgToCmm.Prim: doIndexByteArrayOp"
doIndexByteArrayOpAs :: Maybe MachOp
-> CmmType
-> CmmType
-> [LocalReg]
-> [CmmExpr]
-> FCode ()
doIndexByteArrayOpAs maybe_post_read_cast rep idx_rep [res] [addr,idx]
= do dflags <- getDynFlags
mkBasicIndexedRead (arrWordsHdrSize dflags) maybe_post_read_cast rep res addr idx_rep idx
doIndexByteArrayOpAs _ _ _ _ _
= panic "GHC.StgToCmm.Prim: doIndexByteArrayOpAs"
doReadPtrArrayOp :: LocalReg
-> CmmExpr
-> CmmExpr
-> FCode ()
doReadPtrArrayOp res addr idx
= do dflags <- getDynFlags
mkBasicIndexedRead (arrPtrsHdrSize dflags) Nothing (gcWord dflags) res addr (gcWord dflags) idx
doWriteOffAddrOp :: Maybe MachOp
-> CmmType
-> [LocalReg]
-> [CmmExpr]
-> FCode ()
doWriteOffAddrOp maybe_pre_write_cast idx_ty [] [addr,idx,val]
= mkBasicIndexedWrite 0 maybe_pre_write_cast addr idx_ty idx val
doWriteOffAddrOp _ _ _ _
= panic "GHC.StgToCmm.Prim: doWriteOffAddrOp"
doWriteByteArrayOp :: Maybe MachOp
-> CmmType
-> [LocalReg]
-> [CmmExpr]
-> FCode ()
doWriteByteArrayOp maybe_pre_write_cast idx_ty [] [addr,idx,val]
= do dflags <- getDynFlags
mkBasicIndexedWrite (arrWordsHdrSize dflags) maybe_pre_write_cast addr idx_ty idx val
doWriteByteArrayOp _ _ _ _
= panic "GHC.StgToCmm.Prim: doWriteByteArrayOp"
doWritePtrArrayOp :: CmmExpr
-> CmmExpr
-> CmmExpr
-> FCode ()
doWritePtrArrayOp addr idx val
= do dflags <- getDynFlags
let ty = cmmExprType dflags val
hdr_size = arrPtrsHdrSize dflags
whenUpdRemSetEnabled dflags
$ emitUpdRemSetPush (cmmLoadIndexOffExpr dflags hdr_size ty addr ty idx)
emitPrimCall [] MO_WriteBarrier []
mkBasicIndexedWrite hdr_size Nothing addr ty idx val
emit (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
emit $ mkStore (
cmmOffsetExpr dflags
(cmmOffsetExprW dflags (cmmOffsetB dflags addr hdr_size)
(loadArrPtrsSize dflags addr))
(CmmMachOp (mo_wordUShr dflags) [idx,
mkIntExpr dflags (mUT_ARR_PTRS_CARD_BITS dflags)])
) (CmmLit (CmmInt 1 W8))
loadArrPtrsSize :: DynFlags -> CmmExpr -> CmmExpr
loadArrPtrsSize dflags addr = CmmLoad (cmmOffsetB dflags addr off) (bWord dflags)
where off = fixedHdrSize dflags + oFFSET_StgMutArrPtrs_ptrs dflags
mkBasicIndexedRead :: ByteOff
-> Maybe MachOp
-> CmmType
-> LocalReg
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
mkBasicIndexedRead off Nothing ty res base idx_ty idx
= do dflags <- getDynFlags
emitAssign (CmmLocal res) (cmmLoadIndexOffExpr dflags off ty base idx_ty idx)
mkBasicIndexedRead off (Just cast) ty res base idx_ty idx
= do dflags <- getDynFlags
emitAssign (CmmLocal res) (CmmMachOp cast [
cmmLoadIndexOffExpr dflags off ty base idx_ty idx])
mkBasicIndexedWrite :: ByteOff
-> Maybe MachOp
-> CmmExpr
-> CmmType
-> CmmExpr
-> CmmExpr
-> FCode ()
mkBasicIndexedWrite off Nothing base idx_ty idx val
= do dflags <- getDynFlags
emitStore (cmmIndexOffExpr dflags off (typeWidth idx_ty) base idx) val
mkBasicIndexedWrite off (Just cast) base idx_ty idx val
= mkBasicIndexedWrite off Nothing base idx_ty idx (CmmMachOp cast [val])
cmmIndexOffExpr :: DynFlags
-> ByteOff
-> Width
-> CmmExpr
-> CmmExpr
-> CmmExpr
cmmIndexOffExpr dflags off width base idx
= cmmIndexExpr dflags width (cmmOffsetB dflags base off) idx
cmmLoadIndexOffExpr :: DynFlags
-> ByteOff
-> CmmType
-> CmmExpr
-> CmmType
-> CmmExpr
-> CmmExpr
cmmLoadIndexOffExpr dflags off ty base idx_ty idx
= CmmLoad (cmmIndexOffExpr dflags off (typeWidth idx_ty) base idx) ty
setInfo :: CmmExpr -> CmmExpr -> CmmAGraph
setInfo closure_ptr info_ptr = mkStore closure_ptr info_ptr
vecVmmType :: PrimOpVecCat -> Length -> Width -> CmmType
vecVmmType pocat n w = vec n (vecCmmCat pocat w)
vecCmmCat :: PrimOpVecCat -> Width -> CmmType
vecCmmCat IntVec = cmmBits
vecCmmCat WordVec = cmmBits
vecCmmCat FloatVec = cmmFloat
vecElemInjectCast :: DynFlags -> PrimOpVecCat -> Width -> Maybe MachOp
vecElemInjectCast _ FloatVec _ = Nothing
vecElemInjectCast dflags IntVec W8 = Just (mo_WordTo8 dflags)
vecElemInjectCast dflags IntVec W16 = Just (mo_WordTo16 dflags)
vecElemInjectCast dflags IntVec W32 = Just (mo_WordTo32 dflags)
vecElemInjectCast _ IntVec W64 = Nothing
vecElemInjectCast dflags WordVec W8 = Just (mo_WordTo8 dflags)
vecElemInjectCast dflags WordVec W16 = Just (mo_WordTo16 dflags)
vecElemInjectCast dflags WordVec W32 = Just (mo_WordTo32 dflags)
vecElemInjectCast _ WordVec W64 = Nothing
vecElemInjectCast _ _ _ = Nothing
vecElemProjectCast :: DynFlags -> PrimOpVecCat -> Width -> Maybe MachOp
vecElemProjectCast _ FloatVec _ = Nothing
vecElemProjectCast dflags IntVec W8 = Just (mo_s_8ToWord dflags)
vecElemProjectCast dflags IntVec W16 = Just (mo_s_16ToWord dflags)
vecElemProjectCast dflags IntVec W32 = Just (mo_s_32ToWord dflags)
vecElemProjectCast _ IntVec W64 = Nothing
vecElemProjectCast dflags WordVec W8 = Just (mo_u_8ToWord dflags)
vecElemProjectCast dflags WordVec W16 = Just (mo_u_16ToWord dflags)
vecElemProjectCast dflags WordVec W32 = Just (mo_u_32ToWord dflags)
vecElemProjectCast _ WordVec W64 = Nothing
vecElemProjectCast _ _ _ = Nothing
checkVecCompatibility :: DynFlags -> PrimOpVecCat -> Length -> Width -> FCode ()
checkVecCompatibility dflags vcat l w = do
when (hscTarget dflags /= HscLlvm) $ do
sorry $ unlines ["SIMD vector instructions require the LLVM back-end."
,"Please use -fllvm."]
check vecWidth vcat l w
where
check :: Width -> PrimOpVecCat -> Length -> Width -> FCode ()
check W128 FloatVec 4 W32 | not (isSseEnabled dflags) =
sorry $ "128-bit wide single-precision floating point " ++
"SIMD vector instructions require at least -msse."
check W128 _ _ _ | not (isSse2Enabled dflags) =
sorry $ "128-bit wide integer and double precision " ++
"SIMD vector instructions require at least -msse2."
check W256 FloatVec _ _ | not (isAvxEnabled dflags) =
sorry $ "256-bit wide floating point " ++
"SIMD vector instructions require at least -mavx."
check W256 _ _ _ | not (isAvx2Enabled dflags) =
sorry $ "256-bit wide integer " ++
"SIMD vector instructions require at least -mavx2."
check W512 _ _ _ | not (isAvx512fEnabled dflags) =
sorry $ "512-bit wide " ++
"SIMD vector instructions require -mavx512f."
check _ _ _ _ = return ()
vecWidth = typeWidth (vecVmmType vcat l w)
doVecPackOp :: Maybe MachOp
-> CmmType
-> CmmExpr
-> [CmmExpr]
-> CmmFormal
-> FCode ()
doVecPackOp maybe_pre_write_cast ty z es res = do
dst <- newTemp ty
emitAssign (CmmLocal dst) z
vecPack dst es 0
where
vecPack :: CmmFormal -> [CmmExpr] -> Int -> FCode ()
vecPack src [] _ =
emitAssign (CmmLocal res) (CmmReg (CmmLocal src))
vecPack src (e : es) i = do
dst <- newTemp ty
if isFloatType (vecElemType ty)
then emitAssign (CmmLocal dst) (CmmMachOp (MO_VF_Insert len wid)
[CmmReg (CmmLocal src), cast e, iLit])
else emitAssign (CmmLocal dst) (CmmMachOp (MO_V_Insert len wid)
[CmmReg (CmmLocal src), cast e, iLit])
vecPack dst es (i + 1)
where
iLit = CmmLit (CmmInt (toInteger i) W32)
cast :: CmmExpr -> CmmExpr
cast val = case maybe_pre_write_cast of
Nothing -> val
Just cast -> CmmMachOp cast [val]
len :: Length
len = vecLength ty
wid :: Width
wid = typeWidth (vecElemType ty)
doVecUnpackOp :: Maybe MachOp
-> CmmType
-> CmmExpr
-> [CmmFormal]
-> FCode ()
doVecUnpackOp maybe_post_read_cast ty e res =
vecUnpack res 0
where
vecUnpack :: [CmmFormal] -> Int -> FCode ()
vecUnpack [] _ =
return ()
vecUnpack (r : rs) i = do
if isFloatType (vecElemType ty)
then emitAssign (CmmLocal r) (cast (CmmMachOp (MO_VF_Extract len wid)
[e, iLit]))
else emitAssign (CmmLocal r) (cast (CmmMachOp (MO_V_Extract len wid)
[e, iLit]))
vecUnpack rs (i + 1)
where
iLit = CmmLit (CmmInt (toInteger i) W32)
cast :: CmmExpr -> CmmExpr
cast val = case maybe_post_read_cast of
Nothing -> val
Just cast -> CmmMachOp cast [val]
len :: Length
len = vecLength ty
wid :: Width
wid = typeWidth (vecElemType ty)
doVecInsertOp :: Maybe MachOp
-> CmmType
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> CmmFormal
-> FCode ()
doVecInsertOp maybe_pre_write_cast ty src e idx res = do
dflags <- getDynFlags
let idx' :: CmmExpr
idx' = CmmMachOp (MO_SS_Conv (wordWidth dflags) W32) [idx]
if isFloatType (vecElemType ty)
then emitAssign (CmmLocal res) (CmmMachOp (MO_VF_Insert len wid) [src, cast e, idx'])
else emitAssign (CmmLocal res) (CmmMachOp (MO_V_Insert len wid) [src, cast e, idx'])
where
cast :: CmmExpr -> CmmExpr
cast val = case maybe_pre_write_cast of
Nothing -> val
Just cast -> CmmMachOp cast [val]
len :: Length
len = vecLength ty
wid :: Width
wid = typeWidth (vecElemType ty)
doPrefetchByteArrayOp :: Int
-> [CmmExpr]
-> FCode ()
doPrefetchByteArrayOp locality [addr,idx]
= do dflags <- getDynFlags
mkBasicPrefetch locality (arrWordsHdrSize dflags) addr idx
doPrefetchByteArrayOp _ _
= panic "GHC.StgToCmm.Prim: doPrefetchByteArrayOp"
doPrefetchMutableByteArrayOp :: Int
-> [CmmExpr]
-> FCode ()
doPrefetchMutableByteArrayOp locality [addr,idx]
= do dflags <- getDynFlags
mkBasicPrefetch locality (arrWordsHdrSize dflags) addr idx
doPrefetchMutableByteArrayOp _ _
= panic "GHC.StgToCmm.Prim: doPrefetchByteArrayOp"
doPrefetchAddrOp ::Int
-> [CmmExpr]
-> FCode ()
doPrefetchAddrOp locality [addr,idx]
= mkBasicPrefetch locality 0 addr idx
doPrefetchAddrOp _ _
= panic "GHC.StgToCmm.Prim: doPrefetchAddrOp"
doPrefetchValueOp :: Int
-> [CmmExpr]
-> FCode ()
doPrefetchValueOp locality [addr]
= do dflags <- getDynFlags
mkBasicPrefetch locality 0 addr (CmmLit (CmmInt 0 (wordWidth dflags)))
doPrefetchValueOp _ _
= panic "GHC.StgToCmm.Prim: doPrefetchValueOp"
mkBasicPrefetch :: Int
-> ByteOff
-> CmmExpr
-> CmmExpr
-> FCode ()
mkBasicPrefetch locality off base idx
= do dflags <- getDynFlags
emitPrimCall [] (MO_Prefetch_Data locality) [cmmIndexExpr dflags W8 (cmmOffsetB dflags base off) idx]
return ()
doNewByteArrayOp :: CmmFormal -> ByteOff -> FCode ()
doNewByteArrayOp res_r n = do
dflags <- getDynFlags
let info_ptr = mkLblExpr mkArrWords_infoLabel
rep = arrWordsRep dflags n
tickyAllocPrim (mkIntExpr dflags (arrWordsHdrSize dflags))
(mkIntExpr dflags (nonHdrSize dflags rep))
(zeroExpr dflags)
let hdr_size = fixedHdrSize dflags
base <- allocHeapClosure rep info_ptr cccsExpr
[ (mkIntExpr dflags n,
hdr_size + oFFSET_StgArrBytes_bytes dflags)
]
emit $ mkAssign (CmmLocal res_r) base
doCompareByteArraysOp :: LocalReg -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
-> FCode ()
doCompareByteArraysOp res ba1 ba1_off ba2 ba2_off n = do
dflags <- getDynFlags
ba1_p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags ba1 (arrWordsHdrSize dflags)) ba1_off
ba2_p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags ba2 (arrWordsHdrSize dflags)) ba2_off
l_ptr_eq <- newBlockId
l_ptr_ne <- newBlockId
emit (mkAssign (CmmLocal res) (zeroExpr dflags))
emit (mkCbranch (cmmEqWord dflags ba1_p ba2_p)
l_ptr_eq l_ptr_ne (Just False))
emitLabel l_ptr_ne
emitMemcmpCall res ba1_p ba2_p n 1
emitLabel l_ptr_eq
doCopyByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
-> FCode ()
doCopyByteArrayOp = emitCopyByteArray copy
where
copy _src _dst dst_p src_p bytes align =
emitMemcpyCall dst_p src_p bytes align
doCopyMutableByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
-> FCode ()
doCopyMutableByteArrayOp = emitCopyByteArray copy
where
copy src dst dst_p src_p bytes align = do
dflags <- getDynFlags
(moveCall, cpyCall) <- forkAltPair
(getCode $ emitMemmoveCall dst_p src_p bytes align)
(getCode $ emitMemcpyCall dst_p src_p bytes align)
emit =<< mkCmmIfThenElse (cmmEqWord dflags src dst) moveCall cpyCall
emitCopyByteArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
-> Alignment -> FCode ())
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
-> FCode ()
emitCopyByteArray copy src src_off dst dst_off n = do
dflags <- getDynFlags
let byteArrayAlignment = wordAlignment dflags
srcOffAlignment = cmmExprAlignment src_off
dstOffAlignment = cmmExprAlignment dst_off
align = minimum [byteArrayAlignment, srcOffAlignment, dstOffAlignment]
dst_p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags dst (arrWordsHdrSize dflags)) dst_off
src_p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags src (arrWordsHdrSize dflags)) src_off
copy src dst dst_p src_p n align
doCopyByteArrayToAddrOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyByteArrayToAddrOp src src_off dst_p bytes = do
dflags <- getDynFlags
src_p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags src (arrWordsHdrSize dflags)) src_off
emitMemcpyCall dst_p src_p bytes (mkAlignment 1)
doCopyMutableByteArrayToAddrOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
-> FCode ()
doCopyMutableByteArrayToAddrOp = doCopyByteArrayToAddrOp
doCopyAddrToByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyAddrToByteArrayOp src_p dst dst_off bytes = do
dflags <- getDynFlags
dst_p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags dst (arrWordsHdrSize dflags)) dst_off
emitMemcpyCall dst_p src_p bytes (mkAlignment 1)
doSetByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
-> FCode ()
doSetByteArrayOp ba off len c = do
dflags <- getDynFlags
let byteArrayAlignment = wordAlignment dflags
offsetAlignment = cmmExprAlignment off
align = min byteArrayAlignment offsetAlignment
p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags ba (arrWordsHdrSize dflags)) off
emitMemsetCall p c len align
doNewArrayOp :: CmmFormal
-> SMRep
-> CLabel
-> [(CmmExpr, ByteOff)]
-> WordOff
-> CmmExpr
-> FCode ()
doNewArrayOp res_r rep info payload n init = do
dflags <- getDynFlags
let info_ptr = mkLblExpr info
tickyAllocPrim (mkIntExpr dflags (hdrSize dflags rep))
(mkIntExpr dflags (nonHdrSize dflags rep))
(zeroExpr dflags)
base <- allocHeapClosure rep info_ptr cccsExpr payload
arr <- CmmLocal `fmap` newTemp (bWord dflags)
emit $ mkAssign arr base
let mkOff off = cmmOffsetW dflags (CmmReg arr) (hdrSizeW dflags rep + off)
initialization = [ mkStore (mkOff off) init | off <- [0.. n 1] ]
emit (catAGraphs initialization)
emit $ mkAssign (CmmLocal res_r) (CmmReg arr)
assignTempE :: CmmExpr -> FCode CmmExpr
assignTempE e = do
t <- assignTemp e
return (CmmReg (CmmLocal t))
doCopyArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
-> FCode ()
doCopyArrayOp = emitCopyArray copy
where
copy _src _dst dst_p src_p bytes =
do dflags <- getDynFlags
emitMemcpyCall dst_p src_p (mkIntExpr dflags bytes)
(wordAlignment dflags)
doCopyMutableArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
-> FCode ()
doCopyMutableArrayOp = emitCopyArray copy
where
copy src dst dst_p src_p bytes = do
dflags <- getDynFlags
(moveCall, cpyCall) <- forkAltPair
(getCode $ emitMemmoveCall dst_p src_p (mkIntExpr dflags bytes)
(wordAlignment dflags))
(getCode $ emitMemcpyCall dst_p src_p (mkIntExpr dflags bytes)
(wordAlignment dflags))
emit =<< mkCmmIfThenElse (cmmEqWord dflags src dst) moveCall cpyCall
emitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> ByteOff
-> FCode ())
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> WordOff
-> FCode ()
emitCopyArray copy src0 src_off dst0 dst_off0 n =
when (n /= 0) $ do
dflags <- getDynFlags
src <- assignTempE src0
dst <- assignTempE dst0
dst_off <- assignTempE dst_off0
emitCopyUpdRemSetPush dflags (arrPtrsHdrSizeW dflags) dst dst_off n
emit (setInfo dst (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
dst_elems_p <- assignTempE $ cmmOffsetB dflags dst
(arrPtrsHdrSize dflags)
dst_p <- assignTempE $ cmmOffsetExprW dflags dst_elems_p dst_off
src_p <- assignTempE $ cmmOffsetExprW dflags
(cmmOffsetB dflags src (arrPtrsHdrSize dflags)) src_off
let bytes = wordsToBytes dflags n
copy src dst dst_p src_p bytes
dst_cards_p <- assignTempE $ cmmOffsetExprW dflags dst_elems_p
(loadArrPtrsSize dflags dst)
emitSetCards dst_off dst_cards_p n
doCopySmallArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
-> FCode ()
doCopySmallArrayOp = emitCopySmallArray copy
where
copy _src _dst dst_p src_p bytes =
do dflags <- getDynFlags
emitMemcpyCall dst_p src_p (mkIntExpr dflags bytes)
(wordAlignment dflags)
doCopySmallMutableArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
-> FCode ()
doCopySmallMutableArrayOp = emitCopySmallArray copy
where
copy src dst dst_p src_p bytes = do
dflags <- getDynFlags
(moveCall, cpyCall) <- forkAltPair
(getCode $ emitMemmoveCall dst_p src_p (mkIntExpr dflags bytes)
(wordAlignment dflags))
(getCode $ emitMemcpyCall dst_p src_p (mkIntExpr dflags bytes)
(wordAlignment dflags))
emit =<< mkCmmIfThenElse (cmmEqWord dflags src dst) moveCall cpyCall
emitCopySmallArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> ByteOff
-> FCode ())
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> WordOff
-> FCode ()
emitCopySmallArray copy src0 src_off dst0 dst_off n =
when (n /= 0) $ do
dflags <- getDynFlags
src <- assignTempE src0
dst <- assignTempE dst0
emitCopyUpdRemSetPush dflags (smallArrPtrsHdrSizeW dflags) dst dst_off n
emit (setInfo dst (CmmLit (CmmLabel mkSMAP_DIRTY_infoLabel)))
dst_p <- assignTempE $ cmmOffsetExprW dflags
(cmmOffsetB dflags dst (smallArrPtrsHdrSize dflags)) dst_off
src_p <- assignTempE $ cmmOffsetExprW dflags
(cmmOffsetB dflags src (smallArrPtrsHdrSize dflags)) src_off
let bytes = wordsToBytes dflags n
copy src dst dst_p src_p bytes
emitCloneArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> WordOff
-> FCode ()
emitCloneArray info_p res_r src src_off n = do
dflags <- getDynFlags
let info_ptr = mkLblExpr info_p
rep = arrPtrsRep dflags n
tickyAllocPrim (mkIntExpr dflags (arrPtrsHdrSize dflags))
(mkIntExpr dflags (nonHdrSize dflags rep))
(zeroExpr dflags)
let hdr_size = fixedHdrSize dflags
base <- allocHeapClosure rep info_ptr cccsExpr
[ (mkIntExpr dflags n,
hdr_size + oFFSET_StgMutArrPtrs_ptrs dflags)
, (mkIntExpr dflags (nonHdrSizeW rep),
hdr_size + oFFSET_StgMutArrPtrs_size dflags)
]
arr <- CmmLocal `fmap` newTemp (bWord dflags)
emit $ mkAssign arr base
dst_p <- assignTempE $ cmmOffsetB dflags (CmmReg arr)
(arrPtrsHdrSize dflags)
src_p <- assignTempE $ cmmOffsetExprW dflags src
(cmmAddWord dflags
(mkIntExpr dflags (arrPtrsHdrSizeW dflags)) src_off)
emitMemcpyCall dst_p src_p (mkIntExpr dflags (wordsToBytes dflags n))
(wordAlignment dflags)
emit $ mkAssign (CmmLocal res_r) (CmmReg arr)
emitCloneSmallArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> WordOff
-> FCode ()
emitCloneSmallArray info_p res_r src src_off n = do
dflags <- getDynFlags
let info_ptr = mkLblExpr info_p
rep = smallArrPtrsRep n
tickyAllocPrim (mkIntExpr dflags (smallArrPtrsHdrSize dflags))
(mkIntExpr dflags (nonHdrSize dflags rep))
(zeroExpr dflags)
let hdr_size = fixedHdrSize dflags
base <- allocHeapClosure rep info_ptr cccsExpr
[ (mkIntExpr dflags n,
hdr_size + oFFSET_StgSmallMutArrPtrs_ptrs dflags)
]
arr <- CmmLocal `fmap` newTemp (bWord dflags)
emit $ mkAssign arr base
dst_p <- assignTempE $ cmmOffsetB dflags (CmmReg arr)
(smallArrPtrsHdrSize dflags)
src_p <- assignTempE $ cmmOffsetExprW dflags src
(cmmAddWord dflags
(mkIntExpr dflags (smallArrPtrsHdrSizeW dflags)) src_off)
emitMemcpyCall dst_p src_p (mkIntExpr dflags (wordsToBytes dflags n))
(wordAlignment dflags)
emit $ mkAssign (CmmLocal res_r) (CmmReg arr)
emitSetCards :: CmmExpr -> CmmExpr -> WordOff -> FCode ()
emitSetCards dst_start dst_cards_start n = do
dflags <- getDynFlags
start_card <- assignTempE $ cardCmm dflags dst_start
let end_card = cardCmm dflags
(cmmSubWord dflags
(cmmAddWord dflags dst_start (mkIntExpr dflags n))
(mkIntExpr dflags 1))
emitMemsetCall (cmmAddWord dflags dst_cards_start start_card)
(mkIntExpr dflags 1)
(cmmAddWord dflags (cmmSubWord dflags end_card start_card) (mkIntExpr dflags 1))
(mkAlignment 1)
cardCmm :: DynFlags -> CmmExpr -> CmmExpr
cardCmm dflags i =
cmmUShrWord dflags i (mkIntExpr dflags (mUT_ARR_PTRS_CARD_BITS dflags))
doReadSmallPtrArrayOp :: LocalReg
-> CmmExpr
-> CmmExpr
-> FCode ()
doReadSmallPtrArrayOp res addr idx = do
dflags <- getDynFlags
mkBasicIndexedRead (smallArrPtrsHdrSize dflags) Nothing (gcWord dflags) res addr
(gcWord dflags) idx
doWriteSmallPtrArrayOp :: CmmExpr
-> CmmExpr
-> CmmExpr
-> FCode ()
doWriteSmallPtrArrayOp addr idx val = do
dflags <- getDynFlags
let ty = cmmExprType dflags val
tmp <- newTemp ty
mkBasicIndexedRead (smallArrPtrsHdrSize dflags) Nothing ty tmp addr ty idx
whenUpdRemSetEnabled dflags $ emitUpdRemSetPush (CmmReg (CmmLocal tmp))
emitPrimCall [] MO_WriteBarrier []
mkBasicIndexedWrite (smallArrPtrsHdrSize dflags) Nothing addr ty idx val
emit (setInfo addr (CmmLit (CmmLabel mkSMAP_DIRTY_infoLabel)))
doAtomicRMW :: LocalReg
-> AtomicMachOp
-> CmmExpr
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
doAtomicRMW res amop mba idx idx_ty n = do
dflags <- getDynFlags
let width = typeWidth idx_ty
addr = cmmIndexOffExpr dflags (arrWordsHdrSize dflags)
width mba idx
emitPrimCall
[ res ]
(MO_AtomicRMW width amop)
[ addr, n ]
doAtomicReadByteArray
:: LocalReg
-> CmmExpr
-> CmmExpr
-> CmmType
-> FCode ()
doAtomicReadByteArray res mba idx idx_ty = do
dflags <- getDynFlags
let width = typeWidth idx_ty
addr = cmmIndexOffExpr dflags (arrWordsHdrSize dflags)
width mba idx
emitPrimCall
[ res ]
(MO_AtomicRead width)
[ addr ]
doAtomicWriteByteArray
:: CmmExpr
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
doAtomicWriteByteArray mba idx idx_ty val = do
dflags <- getDynFlags
let width = typeWidth idx_ty
addr = cmmIndexOffExpr dflags (arrWordsHdrSize dflags)
width mba idx
emitPrimCall
[ ]
(MO_AtomicWrite width)
[ addr, val ]
doCasByteArray
:: LocalReg
-> CmmExpr
-> CmmExpr
-> CmmType
-> CmmExpr
-> CmmExpr
-> FCode ()
doCasByteArray res mba idx idx_ty old new = do
dflags <- getDynFlags
let width = (typeWidth idx_ty)
addr = cmmIndexOffExpr dflags (arrWordsHdrSize dflags)
width mba idx
emitPrimCall
[ res ]
(MO_Cmpxchg width)
[ addr, old, new ]
emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
emitMemcpyCall dst src n align = do
emitPrimCall
[ ]
(MO_Memcpy (alignmentBytes align))
[ dst, src, n ]
emitMemmoveCall :: CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
emitMemmoveCall dst src n align = do
emitPrimCall
[ ]
(MO_Memmove (alignmentBytes align))
[ dst, src, n ]
emitMemsetCall :: CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
emitMemsetCall dst c n align = do
emitPrimCall
[ ]
(MO_Memset (alignmentBytes align))
[ dst, c, n ]
emitMemcmpCall :: LocalReg -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemcmpCall res ptr1 ptr2 n align = do
dflags <- getDynFlags
let is32Bit = typeWidth (localRegType res) == W32
cres <- if is32Bit
then return res
else newTemp b32
emitPrimCall
[ cres ]
(MO_Memcmp align)
[ ptr1, ptr2, n ]
unless is32Bit $ do
emit $ mkAssign (CmmLocal res)
(CmmMachOp
(mo_s_32ToWord dflags)
[(CmmReg (CmmLocal cres))])
emitBSwapCall :: LocalReg -> CmmExpr -> Width -> FCode ()
emitBSwapCall res x width = do
emitPrimCall
[ res ]
(MO_BSwap width)
[ x ]
emitBRevCall :: LocalReg -> CmmExpr -> Width -> FCode ()
emitBRevCall res x width = do
emitPrimCall
[ res ]
(MO_BRev width)
[ x ]
emitPopCntCall :: LocalReg -> CmmExpr -> Width -> FCode ()
emitPopCntCall res x width = do
emitPrimCall
[ res ]
(MO_PopCnt width)
[ x ]
emitPdepCall :: LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPdepCall res x y width = do
emitPrimCall
[ res ]
(MO_Pdep width)
[ x, y ]
emitPextCall :: LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPextCall res x y width = do
emitPrimCall
[ res ]
(MO_Pext width)
[ x, y ]
emitClzCall :: LocalReg -> CmmExpr -> Width -> FCode ()
emitClzCall res x width = do
emitPrimCall
[ res ]
(MO_Clz width)
[ x ]
emitCtzCall :: LocalReg -> CmmExpr -> Width -> FCode ()
emitCtzCall res x width = do
emitPrimCall
[ res ]
(MO_Ctz width)
[ x ]
emitCopyUpdRemSetPush :: DynFlags
-> WordOff
-> CmmExpr
-> CmmExpr
-> Int
-> FCode ()
emitCopyUpdRemSetPush _dflags _hdr_size _dst _dst_off 0 = return ()
emitCopyUpdRemSetPush dflags hdr_size dst dst_off n =
whenUpdRemSetEnabled dflags $ do
updfr_off <- getUpdFrameOff
graph <- mkCall lbl (NativeNodeCall,NativeReturn) [] args updfr_off []
emit graph
where
lbl = mkLblExpr $ mkPrimCallLabel
$ PrimCall (fsLit "stg_copyArray_barrier") rtsUnitId
args =
[ mkIntExpr dflags hdr_size
, dst
, dst_off
, mkIntExpr dflags n
]