{-# LANGUAGE CPP #-}
-- emitPrimOp is quite large
{-# OPTIONS_GHC -fmax-pmcheck-iterations=4000000 #-}

----------------------------------------------------------------------------
--
-- Stg to C--: primitive operations
--
-- (c) The University of Glasgow 2004-2006
--
-----------------------------------------------------------------------------

module StgCmmPrim (
   cgOpApp,
   cgPrimOp, -- internal(ish), used by cgCase to get code for a
             -- comparison without also turning it into a Bool.
   shouldInlinePrimOp
 ) where

#include "GhclibHsVersions.h"

import GhcPrelude hiding ((<*>))

import StgCmmLayout
import StgCmmForeign
import StgCmmEnv
import StgCmmMonad
import StgCmmUtils
import StgCmmTicky
import StgCmmHeap
import StgCmmProf ( costCentreFrom )

import DynFlags
import Platform
import BasicTypes
import BlockId
import MkGraph
import StgSyn
import Cmm
import Type     ( Type, tyConAppTyCon )
import TyCon
import CLabel
import CmmUtils
import PrimOp
import SMRep
import FastString
import Outputable
import Util

import Data.Bits ((.&.), bit)
import Control.Monad (liftM, when, unless)

------------------------------------------------------------------------
--      Primitive operations and foreign calls
------------------------------------------------------------------------

{- Note [Foreign call results]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~
A foreign call always returns an unboxed tuple of results, one
of which is the state token.  This seems to happen even for pure
calls.

Even if we returned a single result for pure calls, it'd still be
right to wrap it in a singleton unboxed tuple, because the result
might be a Haskell closure pointer, we don't want to evaluate it. -}

----------------------------------
cgOpApp :: StgOp        -- The op
        -> [StgArg]     -- Arguments
        -> Type         -- Result type (always an unboxed tuple)
        -> FCode ReturnKind

-- Foreign calls
cgOpApp :: StgOp -> [StgArg] -> Type -> FCode ReturnKind
cgOpApp (StgFCallOp ForeignCall
fcall Unique
_) [StgArg]
stg_args Type
res_ty
  = ForeignCall -> [StgArg] -> Type -> FCode ReturnKind
cgForeignCall ForeignCall
fcall [StgArg]
stg_args Type
res_ty
      -- Note [Foreign call results]

-- tagToEnum# is special: we need to pull the constructor
-- out of the table, and perform an appropriate return.

cgOpApp (StgPrimOp PrimOp
TagToEnumOp) [StgArg
arg] Type
res_ty
  = ASSERT(isEnumerationTyCon tycon)
    do  { DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        ; [CmmExpr]
args' <- [StgArg] -> FCode [CmmExpr]
getNonVoidArgAmodes [StgArg
arg]
        ; let amode :: CmmExpr
amode = case [CmmExpr]
args' of [CmmExpr
amode] -> CmmExpr
amode
                                    [CmmExpr]
_ -> String -> CmmExpr
forall a. String -> a
panic String
"TagToEnumOp had void arg"
        ; [CmmExpr] -> FCode ReturnKind
emitReturn [DynFlags -> TyCon -> CmmExpr -> CmmExpr
tagToClosure DynFlags
dflags TyCon
tycon CmmExpr
amode] }
   where
          -- If you're reading this code in the attempt to figure
          -- out why the compiler panic'ed here, it is probably because
          -- you used tagToEnum# in a non-monomorphic setting, e.g.,
          --         intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#
          -- That won't work.
        tycon :: TyCon
tycon = Type -> TyCon
tyConAppTyCon Type
res_ty

cgOpApp (StgPrimOp PrimOp
primop) [StgArg]
args Type
res_ty = do
    DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    [CmmExpr]
cmm_args <- [StgArg] -> FCode [CmmExpr]
getNonVoidArgAmodes [StgArg]
args
    case DynFlags -> PrimOp -> [CmmExpr] -> Maybe ([LocalReg] -> FCode ())
shouldInlinePrimOp DynFlags
dflags PrimOp
primop [CmmExpr]
cmm_args of
        Maybe ([LocalReg] -> FCode ())
Nothing -> do  -- out-of-line
          let fun :: CmmExpr
fun = CmmLit -> CmmExpr
CmmLit (CLabel -> CmmLit
CmmLabel (PrimOp -> CLabel
mkRtsPrimOpLabel PrimOp
primop))
          (Convention, Convention)
-> CmmExpr -> [CmmExpr] -> FCode ReturnKind
emitCall (Convention
NativeNodeCall, Convention
NativeReturn) CmmExpr
fun [CmmExpr]
cmm_args

        Just [LocalReg] -> FCode ()
f  -- inline
          | ReturnsPrim PrimRep
VoidRep <- PrimOpResultInfo
result_info
          -> do [LocalReg] -> FCode ()
f []
                [CmmExpr] -> FCode ReturnKind
emitReturn []

          | ReturnsPrim PrimRep
rep <- PrimOpResultInfo
result_info
          -> do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
                LocalReg
res <- CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp (DynFlags -> PrimRep -> CmmType
primRepCmmType DynFlags
dflags PrimRep
rep)
                [LocalReg] -> FCode ()
f [LocalReg
res]
                [CmmExpr] -> FCode ReturnKind
emitReturn [CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
res)]

          | ReturnsAlg TyCon
tycon <- PrimOpResultInfo
result_info, TyCon -> Bool
isUnboxedTupleTyCon TyCon
tycon
          -> do ([LocalReg]
regs, [ForeignHint]
_hints) <- Type -> FCode ([LocalReg], [ForeignHint])
newUnboxedTupleRegs Type
res_ty
                [LocalReg] -> FCode ()
f [LocalReg]
regs
                [CmmExpr] -> FCode ReturnKind
emitReturn ((LocalReg -> CmmExpr) -> [LocalReg] -> [CmmExpr]
forall a b. (a -> b) -> [a] -> [b]
map (CmmReg -> CmmExpr
CmmReg (CmmReg -> CmmExpr) -> (LocalReg -> CmmReg) -> LocalReg -> CmmExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalReg -> CmmReg
CmmLocal) [LocalReg]
regs)

          | Bool
otherwise -> String -> FCode ReturnKind
forall a. String -> a
panic String
"cgPrimop"
          where
             result_info :: PrimOpResultInfo
result_info = PrimOp -> PrimOpResultInfo
getPrimOpResultInfo PrimOp
primop

cgOpApp (StgPrimCallOp PrimCall
primcall) [StgArg]
args Type
_res_ty
  = do  { [CmmExpr]
cmm_args <- [StgArg] -> FCode [CmmExpr]
getNonVoidArgAmodes [StgArg]
args
        ; let fun :: CmmExpr
fun = CmmLit -> CmmExpr
CmmLit (CLabel -> CmmLit
CmmLabel (PrimCall -> CLabel
mkPrimCallLabel PrimCall
primcall))
        ; (Convention, Convention)
-> CmmExpr -> [CmmExpr] -> FCode ReturnKind
emitCall (Convention
NativeNodeCall, Convention
NativeReturn) CmmExpr
fun [CmmExpr]
cmm_args }

-- | Interpret the argument as an unsigned value, assuming the value
-- is given in two-complement form in the given width.
--
-- Example: @asUnsigned W64 (-1)@ is 18446744073709551615.
--
-- This function is used to work around the fact that many array
-- primops take Int# arguments, but we interpret them as unsigned
-- quantities in the code gen. This means that we have to be careful
-- every time we work on e.g. a CmmInt literal that corresponds to the
-- array size, as it might contain a negative Integer value if the
-- user passed a value larger than 2^(wORD_SIZE_IN_BITS-1) as the Int#
-- literal.
asUnsigned :: Width -> Integer -> Integer
asUnsigned :: Width -> Integer -> Integer
asUnsigned Width
w Integer
n = Integer
n Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. (Int -> Integer
forall a. Bits a => Int -> a
bit (Width -> Int
widthInBits Width
w) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)

-- TODO: Several primop implementations (e.g. 'doNewByteArrayOp') use
--     ByteOff (or some other fixed width signed type) to represent
--     array sizes or indices. This means that these will overflow for
--     large enough sizes.

-- | Decide whether an out-of-line primop should be replaced by an
-- inline implementation. This might happen e.g. if there's enough
-- static information, such as statically know arguments, to emit a
-- more efficient implementation inline.
--
-- Returns 'Nothing' if this primop should use its out-of-line
-- implementation (defined elsewhere) and 'Just' together with a code
-- generating function that takes the output regs as arguments
-- otherwise.
shouldInlinePrimOp :: DynFlags
                   -> PrimOp     -- ^ The primop
                   -> [CmmExpr]  -- ^ The primop arguments
                   -> Maybe ([LocalReg] -> FCode ())

shouldInlinePrimOp :: DynFlags -> PrimOp -> [CmmExpr] -> Maybe ([LocalReg] -> FCode ())
shouldInlinePrimOp DynFlags
dflags PrimOp
NewByteArrayOp_Char [(CmmLit (CmmInt Integer
n Width
w))]
  | Width -> Integer -> Integer
asUnsigned Width
w Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DynFlags -> Int
maxInlineAllocSize DynFlags
dflags) =
      ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a. a -> Maybe a
Just (([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ()))
-> ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] -> LocalReg -> Int -> FCode ()
doNewByteArrayOp LocalReg
res (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)

shouldInlinePrimOp DynFlags
dflags PrimOp
NewArrayOp [(CmmLit (CmmInt Integer
n Width
w)), CmmExpr
init]
  | DynFlags -> Integer -> Integer
forall a. Num a => DynFlags -> a -> a
wordsToBytes DynFlags
dflags (Width -> Integer -> Integer
asUnsigned Width
w Integer
n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DynFlags -> Int
maxInlineAllocSize DynFlags
dflags) =
      ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a. a -> Maybe a
Just (([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ()))
-> ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] ->
      LocalReg
-> SMRep
-> CLabel
-> [(CmmExpr, Int)]
-> Int
-> CmmExpr
-> FCode ()
doNewArrayOp LocalReg
res (DynFlags -> Int -> SMRep
arrPtrsRep DynFlags
dflags (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)) CLabel
mkMAP_DIRTY_infoLabel
      [ (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n),
         DynFlags -> Int
fixedHdrSize DynFlags
dflags Int -> Int -> Int
forall a. Num a => a -> a -> a
+ DynFlags -> Int
oFFSET_StgMutArrPtrs_ptrs DynFlags
dflags)
      , (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (SMRep -> Int
nonHdrSizeW (DynFlags -> Int -> SMRep
arrPtrsRep DynFlags
dflags (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n))),
         DynFlags -> Int
fixedHdrSize DynFlags
dflags Int -> Int -> Int
forall a. Num a => a -> a -> a
+ DynFlags -> Int
oFFSET_StgMutArrPtrs_size DynFlags
dflags)
      ]
      (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n) CmmExpr
init

shouldInlinePrimOp DynFlags
_ PrimOp
CopyArrayOp
    [CmmExpr
src, CmmExpr
src_off, CmmExpr
dst, CmmExpr
dst_off, (CmmLit (CmmInt Integer
n Width
_))] =
        ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a. a -> Maybe a
Just (([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ()))
-> ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a b. (a -> b) -> a -> b
$ \ [] -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
doCopyArrayOp CmmExpr
src CmmExpr
src_off CmmExpr
dst CmmExpr
dst_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)

shouldInlinePrimOp DynFlags
_ PrimOp
CopyMutableArrayOp
    [CmmExpr
src, CmmExpr
src_off, CmmExpr
dst, CmmExpr
dst_off, (CmmLit (CmmInt Integer
n Width
_))] =
        ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a. a -> Maybe a
Just (([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ()))
-> ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a b. (a -> b) -> a -> b
$ \ [] -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
doCopyMutableArrayOp CmmExpr
src CmmExpr
src_off CmmExpr
dst CmmExpr
dst_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)

shouldInlinePrimOp DynFlags
_ PrimOp
CopyArrayArrayOp
    [CmmExpr
src, CmmExpr
src_off, CmmExpr
dst, CmmExpr
dst_off, (CmmLit (CmmInt Integer
n Width
_))] =
        ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a. a -> Maybe a
Just (([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ()))
-> ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a b. (a -> b) -> a -> b
$ \ [] -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
doCopyArrayOp CmmExpr
src CmmExpr
src_off CmmExpr
dst CmmExpr
dst_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)

shouldInlinePrimOp DynFlags
_ PrimOp
CopyMutableArrayArrayOp
    [CmmExpr
src, CmmExpr
src_off, CmmExpr
dst, CmmExpr
dst_off, (CmmLit (CmmInt Integer
n Width
_))] =
        ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a. a -> Maybe a
Just (([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ()))
-> ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a b. (a -> b) -> a -> b
$ \ [] -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
doCopyMutableArrayOp CmmExpr
src CmmExpr
src_off CmmExpr
dst CmmExpr
dst_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)

shouldInlinePrimOp DynFlags
dflags PrimOp
CloneArrayOp [CmmExpr
src, CmmExpr
src_off, (CmmLit (CmmInt Integer
n Width
w))]
  | DynFlags -> Integer -> Integer
forall a. Num a => DynFlags -> a -> a
wordsToBytes DynFlags
dflags (Width -> Integer -> Integer
asUnsigned Width
w Integer
n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DynFlags -> Int
maxInlineAllocSize DynFlags
dflags) =
      ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a. a -> Maybe a
Just (([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ()))
-> ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] -> CLabel -> LocalReg -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCloneArray CLabel
mkMAP_FROZEN_CLEAN_infoLabel LocalReg
res CmmExpr
src CmmExpr
src_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)

shouldInlinePrimOp DynFlags
dflags PrimOp
CloneMutableArrayOp [CmmExpr
src, CmmExpr
src_off, (CmmLit (CmmInt Integer
n Width
w))]
  | DynFlags -> Integer -> Integer
forall a. Num a => DynFlags -> a -> a
wordsToBytes DynFlags
dflags (Width -> Integer -> Integer
asUnsigned Width
w Integer
n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DynFlags -> Int
maxInlineAllocSize DynFlags
dflags) =
      ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a. a -> Maybe a
Just (([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ()))
-> ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] -> CLabel -> LocalReg -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCloneArray CLabel
mkMAP_DIRTY_infoLabel LocalReg
res CmmExpr
src CmmExpr
src_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)

shouldInlinePrimOp DynFlags
dflags PrimOp
FreezeArrayOp [CmmExpr
src, CmmExpr
src_off, (CmmLit (CmmInt Integer
n Width
w))]
  | DynFlags -> Integer -> Integer
forall a. Num a => DynFlags -> a -> a
wordsToBytes DynFlags
dflags (Width -> Integer -> Integer
asUnsigned Width
w Integer
n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DynFlags -> Int
maxInlineAllocSize DynFlags
dflags) =
      ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a. a -> Maybe a
Just (([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ()))
-> ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] -> CLabel -> LocalReg -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCloneArray CLabel
mkMAP_FROZEN_CLEAN_infoLabel LocalReg
res CmmExpr
src CmmExpr
src_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)

shouldInlinePrimOp DynFlags
dflags PrimOp
ThawArrayOp [CmmExpr
src, CmmExpr
src_off, (CmmLit (CmmInt Integer
n Width
w))]
  | DynFlags -> Integer -> Integer
forall a. Num a => DynFlags -> a -> a
wordsToBytes DynFlags
dflags (Width -> Integer -> Integer
asUnsigned Width
w Integer
n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DynFlags -> Int
maxInlineAllocSize DynFlags
dflags) =
      ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a. a -> Maybe a
Just (([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ()))
-> ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] -> CLabel -> LocalReg -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCloneArray CLabel
mkMAP_DIRTY_infoLabel LocalReg
res CmmExpr
src CmmExpr
src_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)

shouldInlinePrimOp DynFlags
dflags PrimOp
NewSmallArrayOp [(CmmLit (CmmInt Integer
n Width
w)), CmmExpr
init]
  | DynFlags -> Integer -> Integer
forall a. Num a => DynFlags -> a -> a
wordsToBytes DynFlags
dflags (Width -> Integer -> Integer
asUnsigned Width
w Integer
n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DynFlags -> Int
maxInlineAllocSize DynFlags
dflags) =
      ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a. a -> Maybe a
Just (([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ()))
-> ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] ->
      LocalReg
-> SMRep
-> CLabel
-> [(CmmExpr, Int)]
-> Int
-> CmmExpr
-> FCode ()
doNewArrayOp LocalReg
res (Int -> SMRep
smallArrPtrsRep (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)) CLabel
mkSMAP_DIRTY_infoLabel
      [ (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n),
         DynFlags -> Int
fixedHdrSize DynFlags
dflags Int -> Int -> Int
forall a. Num a => a -> a -> a
+ DynFlags -> Int
oFFSET_StgSmallMutArrPtrs_ptrs DynFlags
dflags)
      ]
      (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n) CmmExpr
init

shouldInlinePrimOp DynFlags
_ PrimOp
CopySmallArrayOp
    [CmmExpr
src, CmmExpr
src_off, CmmExpr
dst, CmmExpr
dst_off, (CmmLit (CmmInt Integer
n Width
_))] =
        ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a. a -> Maybe a
Just (([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ()))
-> ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a b. (a -> b) -> a -> b
$ \ [] -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
doCopySmallArrayOp CmmExpr
src CmmExpr
src_off CmmExpr
dst CmmExpr
dst_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)

shouldInlinePrimOp DynFlags
_ PrimOp
CopySmallMutableArrayOp
    [CmmExpr
src, CmmExpr
src_off, CmmExpr
dst, CmmExpr
dst_off, (CmmLit (CmmInt Integer
n Width
_))] =
        ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a. a -> Maybe a
Just (([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ()))
-> ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a b. (a -> b) -> a -> b
$ \ [] -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
doCopySmallMutableArrayOp CmmExpr
src CmmExpr
src_off CmmExpr
dst CmmExpr
dst_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)

shouldInlinePrimOp DynFlags
dflags PrimOp
CloneSmallArrayOp [CmmExpr
src, CmmExpr
src_off, (CmmLit (CmmInt Integer
n Width
w))]
  | DynFlags -> Integer -> Integer
forall a. Num a => DynFlags -> a -> a
wordsToBytes DynFlags
dflags (Width -> Integer -> Integer
asUnsigned Width
w Integer
n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DynFlags -> Int
maxInlineAllocSize DynFlags
dflags) =
      ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a. a -> Maybe a
Just (([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ()))
-> ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] -> CLabel -> LocalReg -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCloneSmallArray CLabel
mkSMAP_FROZEN_CLEAN_infoLabel LocalReg
res CmmExpr
src CmmExpr
src_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)

shouldInlinePrimOp DynFlags
dflags PrimOp
CloneSmallMutableArrayOp [CmmExpr
src, CmmExpr
src_off, (CmmLit (CmmInt Integer
n Width
w))]
  | DynFlags -> Integer -> Integer
forall a. Num a => DynFlags -> a -> a
wordsToBytes DynFlags
dflags (Width -> Integer -> Integer
asUnsigned Width
w Integer
n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DynFlags -> Int
maxInlineAllocSize DynFlags
dflags) =
      ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a. a -> Maybe a
Just (([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ()))
-> ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] -> CLabel -> LocalReg -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCloneSmallArray CLabel
mkSMAP_DIRTY_infoLabel LocalReg
res CmmExpr
src CmmExpr
src_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)

shouldInlinePrimOp DynFlags
dflags PrimOp
FreezeSmallArrayOp [CmmExpr
src, CmmExpr
src_off, (CmmLit (CmmInt Integer
n Width
w))]
  | DynFlags -> Integer -> Integer
forall a. Num a => DynFlags -> a -> a
wordsToBytes DynFlags
dflags (Width -> Integer -> Integer
asUnsigned Width
w Integer
n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DynFlags -> Int
maxInlineAllocSize DynFlags
dflags) =
      ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a. a -> Maybe a
Just (([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ()))
-> ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] -> CLabel -> LocalReg -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCloneSmallArray CLabel
mkSMAP_FROZEN_CLEAN_infoLabel LocalReg
res CmmExpr
src CmmExpr
src_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)

shouldInlinePrimOp DynFlags
dflags PrimOp
ThawSmallArrayOp [CmmExpr
src, CmmExpr
src_off, (CmmLit (CmmInt Integer
n Width
w))]
  | DynFlags -> Integer -> Integer
forall a. Num a => DynFlags -> a -> a
wordsToBytes DynFlags
dflags (Width -> Integer -> Integer
asUnsigned Width
w Integer
n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DynFlags -> Int
maxInlineAllocSize DynFlags
dflags) =
      ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a. a -> Maybe a
Just (([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ()))
-> ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] -> CLabel -> LocalReg -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCloneSmallArray CLabel
mkSMAP_DIRTY_infoLabel LocalReg
res CmmExpr
src CmmExpr
src_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)

shouldInlinePrimOp DynFlags
dflags PrimOp
primop [CmmExpr]
args
  | PrimOp -> Bool
primOpOutOfLine PrimOp
primop = Maybe ([LocalReg] -> FCode ())
forall a. Maybe a
Nothing
  | Bool
otherwise = ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a. a -> Maybe a
Just (([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ()))
-> ([LocalReg] -> FCode ()) -> Maybe ([LocalReg] -> FCode ())
forall a b. (a -> b) -> a -> b
$ \ [LocalReg]
regs -> DynFlags -> [LocalReg] -> PrimOp -> [CmmExpr] -> FCode ()
emitPrimOp DynFlags
dflags [LocalReg]
regs PrimOp
primop [CmmExpr]
args

-- TODO: Several primops, such as 'copyArray#', only have an inline
-- implementation (below) but could possibly have both an inline
-- implementation and an out-of-line implementation, just like
-- 'newArray#'. This would lower the amount of code generated,
-- hopefully without a performance impact (needs to be measured).

---------------------------------------------------
cgPrimOp   :: [LocalReg]        -- where to put the results
           -> PrimOp            -- the op
           -> [StgArg]          -- arguments
           -> FCode ()

cgPrimOp :: [LocalReg] -> PrimOp -> [StgArg] -> FCode ()
cgPrimOp [LocalReg]
results PrimOp
op [StgArg]
args
  = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
       [CmmExpr]
arg_exprs <- [StgArg] -> FCode [CmmExpr]
getNonVoidArgAmodes [StgArg]
args
       DynFlags -> [LocalReg] -> PrimOp -> [CmmExpr] -> FCode ()
emitPrimOp DynFlags
dflags [LocalReg]
results PrimOp
op [CmmExpr]
arg_exprs


------------------------------------------------------------------------
--      Emitting code for a primop
------------------------------------------------------------------------

emitPrimOp :: DynFlags
           -> [LocalReg]        -- where to put the results
           -> PrimOp            -- the op
           -> [CmmExpr]         -- arguments
           -> FCode ()

-- First we handle various awkward cases specially.  The remaining
-- easy cases are then handled by translateOp, defined below.

emitPrimOp :: DynFlags -> [LocalReg] -> PrimOp -> [CmmExpr] -> FCode ()
emitPrimOp DynFlags
_ [LocalReg
res] PrimOp
ParOp [CmmExpr
arg]
  =
        -- for now, just implement this in a C function
        -- later, we might want to inline it.
    [(LocalReg, ForeignHint)]
-> CmmExpr -> [(CmmExpr, ForeignHint)] -> FCode ()
emitCCall
        [(LocalReg
res,ForeignHint
NoHint)]
        (CmmLit -> CmmExpr
CmmLit (CLabel -> CmmLit
CmmLabel (FastString
-> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel (String -> FastString
fsLit String
"newSpark") Maybe Int
forall a. Maybe a
Nothing ForeignLabelSource
ForeignLabelInExternalPackage FunctionOrData
IsFunction)))
        [(CmmExpr
baseExpr, ForeignHint
AddrHint), (CmmExpr
arg,ForeignHint
AddrHint)]

emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
SparkOp [CmmExpr
arg]
  = do
        -- returns the value of arg in res.  We're going to therefore
        -- refer to arg twice (once to pass to newSpark(), and once to
        -- assign to res), so put it in a temporary.
        LocalReg
tmp <- CmmExpr -> FCode LocalReg
assignTemp CmmExpr
arg
        LocalReg
tmp2 <- CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp (DynFlags -> CmmType
bWord DynFlags
dflags)
        [(LocalReg, ForeignHint)]
-> CmmExpr -> [(CmmExpr, ForeignHint)] -> FCode ()
emitCCall
            [(LocalReg
tmp2,ForeignHint
NoHint)]
            (CmmLit -> CmmExpr
CmmLit (CLabel -> CmmLit
CmmLabel (FastString
-> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel (String -> FastString
fsLit String
"newSpark") Maybe Int
forall a. Maybe a
Nothing ForeignLabelSource
ForeignLabelInExternalPackage FunctionOrData
IsFunction)))
            [(CmmExpr
baseExpr, ForeignHint
AddrHint), ((CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
tmp)), ForeignHint
AddrHint)]
        CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
tmp))

emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
GetCCSOfOp [CmmExpr
arg]
  = CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) CmmExpr
val
  where
    val :: CmmExpr
val
     | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SccProfilingOn DynFlags
dflags = DynFlags -> CmmExpr -> CmmExpr
costCentreFrom DynFlags
dflags (DynFlags -> CmmExpr -> CmmExpr
cmmUntag DynFlags
dflags CmmExpr
arg)
     | Bool
otherwise                      = CmmLit -> CmmExpr
CmmLit (DynFlags -> CmmLit
zeroCLit DynFlags
dflags)

emitPrimOp DynFlags
_ [LocalReg
res] PrimOp
GetCurrentCCSOp [CmmExpr
_dummy_arg]
   = CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) CmmExpr
cccsExpr

emitPrimOp DynFlags
_ [LocalReg
res] PrimOp
MyThreadIdOp []
   = CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) CmmExpr
currentTSOExpr

emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
ReadMutVarOp [CmmExpr
mutv]
   = CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (DynFlags -> CmmExpr -> Int -> CmmType -> CmmExpr
cmmLoadIndexW DynFlags
dflags CmmExpr
mutv (DynFlags -> Int
fixedHdrSizeW DynFlags
dflags) (DynFlags -> CmmType
gcWord DynFlags
dflags))

emitPrimOp DynFlags
dflags res :: [LocalReg]
res@[] PrimOp
WriteMutVarOp [CmmExpr
mutv,CmmExpr
var]
   = do -- Without this write barrier, other CPUs may see this pointer before
        -- the writes for the closure it points to have occurred.
        [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [LocalReg]
res CallishMachOp
MO_WriteBarrier []
        CmmExpr -> CmmExpr -> FCode ()
emitStore (DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetW DynFlags
dflags CmmExpr
mutv (DynFlags -> Int
fixedHdrSizeW DynFlags
dflags)) CmmExpr
var
        [(LocalReg, ForeignHint)]
-> CmmExpr -> [(CmmExpr, ForeignHint)] -> FCode ()
emitCCall
                [{-no results-}]
                (CmmLit -> CmmExpr
CmmLit (CLabel -> CmmLit
CmmLabel CLabel
mkDirty_MUT_VAR_Label))
                [(CmmExpr
baseExpr, ForeignHint
AddrHint), (CmmExpr
mutv,ForeignHint
AddrHint)]

--  #define sizzeofByteArrayzh(r,a) \
--     r = ((StgArrBytes *)(a))->bytes
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
SizeofByteArrayOp [CmmExpr
arg]
   = CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (DynFlags -> CmmExpr -> Int -> CmmType -> CmmExpr
cmmLoadIndexW DynFlags
dflags CmmExpr
arg (DynFlags -> Int
fixedHdrSizeW DynFlags
dflags) (DynFlags -> CmmType
bWord DynFlags
dflags))

--  #define sizzeofMutableByteArrayzh(r,a) \
--      r = ((StgArrBytes *)(a))->bytes
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
SizeofMutableByteArrayOp [CmmExpr
arg]
   = DynFlags -> [LocalReg] -> PrimOp -> [CmmExpr] -> FCode ()
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
SizeofByteArrayOp [CmmExpr
arg]

--  #define getSizzeofMutableByteArrayzh(r,a) \
--      r = ((StgArrBytes *)(a))->bytes
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
GetSizeofMutableByteArrayOp [CmmExpr
arg]
   = CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (DynFlags -> CmmExpr -> Int -> CmmType -> CmmExpr
cmmLoadIndexW DynFlags
dflags CmmExpr
arg (DynFlags -> Int
fixedHdrSizeW DynFlags
dflags) (DynFlags -> CmmType
bWord DynFlags
dflags))


--  #define touchzh(o)                  /* nothing */
emitPrimOp DynFlags
_ res :: [LocalReg]
res@[] PrimOp
TouchOp args :: [CmmExpr]
args@[CmmExpr
_arg]
   = do [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [LocalReg]
res CallishMachOp
MO_Touch [CmmExpr]
args

--  #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
ByteArrayContents_Char [CmmExpr
arg]
   = CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetB DynFlags
dflags CmmExpr
arg (DynFlags -> Int
arrWordsHdrSize DynFlags
dflags))

--  #define stableNameToIntzh(r,s)   (r = ((StgStableName *)s)->sn)
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
StableNameToIntOp [CmmExpr
arg]
   = CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (DynFlags -> CmmExpr -> Int -> CmmType -> CmmExpr
cmmLoadIndexW DynFlags
dflags CmmExpr
arg (DynFlags -> Int
fixedHdrSizeW DynFlags
dflags) (DynFlags -> CmmType
bWord DynFlags
dflags))

emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
ReallyUnsafePtrEqualityOp [CmmExpr
arg1,CmmExpr
arg2]
   = CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordEq DynFlags
dflags) [CmmExpr
arg1,CmmExpr
arg2])

--  #define addrToHValuezh(r,a) r=(P_)a
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
AddrToAnyOp [CmmExpr
arg]
   = CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) CmmExpr
arg

--  #define hvalueToAddrzh(r, a) r=(W_)a
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
AnyToAddrOp [CmmExpr
arg]
   = CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) CmmExpr
arg

{- Freezing arrays-of-ptrs requires changing an info table, for the
   benefit of the generational collector.  It needs to scavenge mutable
   objects, even if they are in old space.  When they become immutable,
   they can be removed from this scavenge list.  -}

--  #define unsafeFreezzeArrayzh(r,a)
--      {
--        SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN_DIRTY_info);
--        r = a;
--      }
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
UnsafeFreezeArrayOp [CmmExpr
arg]
   = CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ [CmmAGraph] -> CmmAGraph
catAGraphs
   [ CmmExpr -> CmmExpr -> CmmAGraph
setInfo CmmExpr
arg (CmmLit -> CmmExpr
CmmLit (CLabel -> CmmLit
CmmLabel CLabel
mkMAP_FROZEN_DIRTY_infoLabel)),
     CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) CmmExpr
arg ]
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
UnsafeFreezeArrayArrayOp [CmmExpr
arg]
   = CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ [CmmAGraph] -> CmmAGraph
catAGraphs
   [ CmmExpr -> CmmExpr -> CmmAGraph
setInfo CmmExpr
arg (CmmLit -> CmmExpr
CmmLit (CLabel -> CmmLit
CmmLabel CLabel
mkMAP_FROZEN_DIRTY_infoLabel)),
     CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) CmmExpr
arg ]
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
UnsafeFreezeSmallArrayOp [CmmExpr
arg]
   = CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ [CmmAGraph] -> CmmAGraph
catAGraphs
   [ CmmExpr -> CmmExpr -> CmmAGraph
setInfo CmmExpr
arg (CmmLit -> CmmExpr
CmmLit (CLabel -> CmmLit
CmmLabel CLabel
mkSMAP_FROZEN_DIRTY_infoLabel)),
     CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) CmmExpr
arg ]

--  #define unsafeFreezzeByteArrayzh(r,a)       r=(a)
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
UnsafeFreezeByteArrayOp [CmmExpr
arg]
   = CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) CmmExpr
arg

-- Reading/writing pointer arrays

emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
ReadArrayOp  [CmmExpr
obj,CmmExpr
ix]    = LocalReg -> CmmExpr -> CmmExpr -> FCode ()
doReadPtrArrayOp LocalReg
res CmmExpr
obj CmmExpr
ix
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
IndexArrayOp [CmmExpr
obj,CmmExpr
ix]    = LocalReg -> CmmExpr -> CmmExpr -> FCode ()
doReadPtrArrayOp LocalReg
res CmmExpr
obj CmmExpr
ix
emitPrimOp DynFlags
_      []  PrimOp
WriteArrayOp [CmmExpr
obj,CmmExpr
ix,CmmExpr
v]  = CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doWritePtrArrayOp CmmExpr
obj CmmExpr
ix CmmExpr
v

emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
IndexArrayArrayOp_ByteArray         [CmmExpr
obj,CmmExpr
ix]   = LocalReg -> CmmExpr -> CmmExpr -> FCode ()
doReadPtrArrayOp LocalReg
res CmmExpr
obj CmmExpr
ix
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
IndexArrayArrayOp_ArrayArray        [CmmExpr
obj,CmmExpr
ix]   = LocalReg -> CmmExpr -> CmmExpr -> FCode ()
doReadPtrArrayOp LocalReg
res CmmExpr
obj CmmExpr
ix
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
ReadArrayArrayOp_ByteArray          [CmmExpr
obj,CmmExpr
ix]   = LocalReg -> CmmExpr -> CmmExpr -> FCode ()
doReadPtrArrayOp LocalReg
res CmmExpr
obj CmmExpr
ix
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
ReadArrayArrayOp_MutableByteArray   [CmmExpr
obj,CmmExpr
ix]   = LocalReg -> CmmExpr -> CmmExpr -> FCode ()
doReadPtrArrayOp LocalReg
res CmmExpr
obj CmmExpr
ix
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
ReadArrayArrayOp_ArrayArray         [CmmExpr
obj,CmmExpr
ix]   = LocalReg -> CmmExpr -> CmmExpr -> FCode ()
doReadPtrArrayOp LocalReg
res CmmExpr
obj CmmExpr
ix
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
ReadArrayArrayOp_MutableArrayArray  [CmmExpr
obj,CmmExpr
ix]   = LocalReg -> CmmExpr -> CmmExpr -> FCode ()
doReadPtrArrayOp LocalReg
res CmmExpr
obj CmmExpr
ix
emitPrimOp DynFlags
_      []  PrimOp
WriteArrayArrayOp_ByteArray         [CmmExpr
obj,CmmExpr
ix,CmmExpr
v] = CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doWritePtrArrayOp CmmExpr
obj CmmExpr
ix CmmExpr
v
emitPrimOp DynFlags
_      []  PrimOp
WriteArrayArrayOp_MutableByteArray  [CmmExpr
obj,CmmExpr
ix,CmmExpr
v] = CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doWritePtrArrayOp CmmExpr
obj CmmExpr
ix CmmExpr
v
emitPrimOp DynFlags
_      []  PrimOp
WriteArrayArrayOp_ArrayArray        [CmmExpr
obj,CmmExpr
ix,CmmExpr
v] = CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doWritePtrArrayOp CmmExpr
obj CmmExpr
ix CmmExpr
v
emitPrimOp DynFlags
_      []  PrimOp
WriteArrayArrayOp_MutableArrayArray [CmmExpr
obj,CmmExpr
ix,CmmExpr
v] = CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doWritePtrArrayOp CmmExpr
obj CmmExpr
ix CmmExpr
v

emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
ReadSmallArrayOp  [CmmExpr
obj,CmmExpr
ix] = LocalReg -> CmmExpr -> CmmExpr -> FCode ()
doReadSmallPtrArrayOp LocalReg
res CmmExpr
obj CmmExpr
ix
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
IndexSmallArrayOp [CmmExpr
obj,CmmExpr
ix] = LocalReg -> CmmExpr -> CmmExpr -> FCode ()
doReadSmallPtrArrayOp LocalReg
res CmmExpr
obj CmmExpr
ix
emitPrimOp DynFlags
_      []  PrimOp
WriteSmallArrayOp [CmmExpr
obj,CmmExpr
ix,CmmExpr
v] = CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doWriteSmallPtrArrayOp CmmExpr
obj CmmExpr
ix CmmExpr
v

-- Getting the size of pointer arrays

emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
SizeofArrayOp [CmmExpr
arg]
   = CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (DynFlags -> CmmExpr -> Int -> CmmType -> CmmExpr
cmmLoadIndexW DynFlags
dflags CmmExpr
arg
    (DynFlags -> Int
fixedHdrSizeW DynFlags
dflags Int -> Int -> Int
forall a. Num a => a -> a -> a
+ DynFlags -> Int -> Int
bytesToWordsRoundUp DynFlags
dflags (DynFlags -> Int
oFFSET_StgMutArrPtrs_ptrs DynFlags
dflags))
        (DynFlags -> CmmType
bWord DynFlags
dflags))
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
SizeofMutableArrayOp [CmmExpr
arg]
   = DynFlags -> [LocalReg] -> PrimOp -> [CmmExpr] -> FCode ()
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
SizeofArrayOp [CmmExpr
arg]
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
SizeofArrayArrayOp [CmmExpr
arg]
   = DynFlags -> [LocalReg] -> PrimOp -> [CmmExpr] -> FCode ()
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
SizeofArrayOp [CmmExpr
arg]
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
SizeofMutableArrayArrayOp [CmmExpr
arg]
   = DynFlags -> [LocalReg] -> PrimOp -> [CmmExpr] -> FCode ()
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
SizeofArrayOp [CmmExpr
arg]

emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
SizeofSmallArrayOp [CmmExpr
arg] =
    CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res)
    (DynFlags -> CmmExpr -> Int -> CmmType -> CmmExpr
cmmLoadIndexW DynFlags
dflags CmmExpr
arg
     (DynFlags -> Int
fixedHdrSizeW DynFlags
dflags Int -> Int -> Int
forall a. Num a => a -> a -> a
+ DynFlags -> Int -> Int
bytesToWordsRoundUp DynFlags
dflags (DynFlags -> Int
oFFSET_StgSmallMutArrPtrs_ptrs DynFlags
dflags))
        (DynFlags -> CmmType
bWord DynFlags
dflags))
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
SizeofSmallMutableArrayOp [CmmExpr
arg] =
    DynFlags -> [LocalReg] -> PrimOp -> [CmmExpr] -> FCode ()
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
SizeofSmallArrayOp [CmmExpr
arg]

-- IndexXXXoffAddr

emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexOffAddrOp_Char             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_8ToWord DynFlags
dflags)) CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexOffAddrOp_WideChar         [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_32ToWord DynFlags
dflags)) CmmType
b32 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexOffAddrOp_Int              [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexOffAddrOp_Word             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexOffAddrOp_Addr             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
IndexOffAddrOp_Float            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
IndexOffAddrOp_Double           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexOffAddrOp_StablePtr        [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexOffAddrOp_Int8             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_8ToWord DynFlags
dflags)) CmmType
b8  [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexOffAddrOp_Int16            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_16ToWord DynFlags
dflags)) CmmType
b16 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexOffAddrOp_Int32            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_32ToWord DynFlags
dflags)) CmmType
b32 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
IndexOffAddrOp_Int64            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexOffAddrOp_Word8            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_8ToWord DynFlags
dflags)) CmmType
b8  [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexOffAddrOp_Word16           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_16ToWord DynFlags
dflags)) CmmType
b16 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexOffAddrOp_Word32           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_32ToWord DynFlags
dflags)) CmmType
b32 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
IndexOffAddrOp_Word64           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args

-- ReadXXXoffAddr, which are identical, for our purposes, to IndexXXXoffAddr.

emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadOffAddrOp_Char             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_8ToWord DynFlags
dflags)) CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadOffAddrOp_WideChar         [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_32ToWord DynFlags
dflags)) CmmType
b32 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadOffAddrOp_Int              [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadOffAddrOp_Word             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadOffAddrOp_Addr             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
ReadOffAddrOp_Float            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
ReadOffAddrOp_Double           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadOffAddrOp_StablePtr        [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadOffAddrOp_Int8             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_8ToWord DynFlags
dflags)) CmmType
b8  [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadOffAddrOp_Int16            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_16ToWord DynFlags
dflags)) CmmType
b16 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadOffAddrOp_Int32            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_32ToWord DynFlags
dflags)) CmmType
b32 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
ReadOffAddrOp_Int64            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadOffAddrOp_Word8            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_8ToWord DynFlags
dflags)) CmmType
b8  [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadOffAddrOp_Word16           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_16ToWord DynFlags
dflags)) CmmType
b16 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadOffAddrOp_Word32           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_32ToWord DynFlags
dflags)) CmmType
b32 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
ReadOffAddrOp_Word64           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args

-- IndexXXXArray

emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_Char             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_8ToWord DynFlags
dflags)) CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_WideChar         [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_32ToWord DynFlags
dflags)) CmmType
b32 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_Int              [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_Word             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_Addr             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
IndexByteArrayOp_Float            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
IndexByteArrayOp_Double           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_StablePtr        [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_Int8             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_8ToWord DynFlags
dflags)) CmmType
b8  [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_Int16            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_16ToWord DynFlags
dflags)) CmmType
b16  [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_Int32            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_32ToWord DynFlags
dflags)) CmmType
b32  [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
IndexByteArrayOp_Int64            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64  [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_Word8            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_8ToWord DynFlags
dflags)) CmmType
b8  [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_Word16           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_16ToWord DynFlags
dflags)) CmmType
b16  [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_Word32           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_32ToWord DynFlags
dflags)) CmmType
b32  [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
IndexByteArrayOp_Word64           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64  [LocalReg]
res [CmmExpr]
args

-- ReadXXXArray, identical to IndexXXXArray.

emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_Char             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_8ToWord DynFlags
dflags)) CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_WideChar         [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_32ToWord DynFlags
dflags)) CmmType
b32 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_Int              [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_Word             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_Addr             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
ReadByteArrayOp_Float            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
ReadByteArrayOp_Double           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_StablePtr        [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_Int8             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_8ToWord DynFlags
dflags)) CmmType
b8  [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_Int16            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_16ToWord DynFlags
dflags)) CmmType
b16  [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_Int32            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_32ToWord DynFlags
dflags)) CmmType
b32  [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
ReadByteArrayOp_Int64            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64  [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_Word8            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_8ToWord DynFlags
dflags)) CmmType
b8  [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_Word16           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_16ToWord DynFlags
dflags)) CmmType
b16  [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_Word32           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_32ToWord DynFlags
dflags)) CmmType
b32  [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
ReadByteArrayOp_Word64           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64  [LocalReg]
res [CmmExpr]
args

-- IndexWord8ArrayAsXXX

emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_Word8AsChar      [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_8ToWord DynFlags
dflags)) CmmType
b8 CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_Word8AsWideChar  [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_32ToWord DynFlags
dflags)) CmmType
b32 CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_Word8AsInt       [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_Word8AsWord      [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_Word8AsAddr      [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
IndexByteArrayOp_Word8AsFloat     [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
IndexByteArrayOp_Word8AsDouble    [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_Word8AsStablePtr [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_Word8AsInt16     [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_16ToWord DynFlags
dflags)) CmmType
b16 CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_Word8AsInt32     [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_32ToWord DynFlags
dflags)) CmmType
b32 CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
IndexByteArrayOp_Word8AsInt64     [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_Word8AsWord16    [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_16ToWord DynFlags
dflags)) CmmType
b16 CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
IndexByteArrayOp_Word8AsWord32    [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_32ToWord DynFlags
dflags)) CmmType
b32 CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
IndexByteArrayOp_Word8AsWord64    [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 CmmType
b8 [LocalReg]
res [CmmExpr]
args

-- ReadInt8ArrayAsXXX, identical to IndexInt8ArrayAsXXX

emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_Word8AsChar      [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_8ToWord DynFlags
dflags)) CmmType
b8 CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_Word8AsWideChar  [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_32ToWord DynFlags
dflags)) CmmType
b32 CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_Word8AsInt       [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_Word8AsWord      [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_Word8AsAddr      [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
ReadByteArrayOp_Word8AsFloat     [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
ReadByteArrayOp_Word8AsDouble    [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_Word8AsStablePtr [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_Word8AsInt16     [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_16ToWord DynFlags
dflags)) CmmType
b16 CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_Word8AsInt32     [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_32ToWord DynFlags
dflags)) CmmType
b32 CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
ReadByteArrayOp_Word8AsInt64     [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_Word8AsWord16    [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_16ToWord DynFlags
dflags)) CmmType
b16 CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
ReadByteArrayOp_Word8AsWord32    [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_32ToWord DynFlags
dflags)) CmmType
b32 CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
ReadByteArrayOp_Word8AsWord64    [CmmExpr]
args = Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 CmmType
b8 [LocalReg]
res [CmmExpr]
args

-- WriteXXXoffAddr

emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteOffAddrOp_Char             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo8 DynFlags
dflags))  CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteOffAddrOp_WideChar         [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo32 DynFlags
dflags)) CmmType
b32 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteOffAddrOp_Int              [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteOffAddrOp_Word             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteOffAddrOp_Addr             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
WriteOffAddrOp_Float            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
WriteOffAddrOp_Double           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteOffAddrOp_StablePtr        [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteOffAddrOp_Int8             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo8 DynFlags
dflags))  CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteOffAddrOp_Int16            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo16 DynFlags
dflags)) CmmType
b16 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteOffAddrOp_Int32            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo32 DynFlags
dflags)) CmmType
b32 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
WriteOffAddrOp_Int64            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteOffAddrOp_Word8            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo8 DynFlags
dflags))  CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteOffAddrOp_Word16           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo16 DynFlags
dflags)) CmmType
b16 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteOffAddrOp_Word32           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo32 DynFlags
dflags)) CmmType
b32 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
WriteOffAddrOp_Word64           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args

-- WriteXXXArray

emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteByteArrayOp_Char             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo8 DynFlags
dflags))  CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteByteArrayOp_WideChar         [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo32 DynFlags
dflags)) CmmType
b32 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteByteArrayOp_Int              [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteByteArrayOp_Word             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteByteArrayOp_Addr             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
WriteByteArrayOp_Float            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
WriteByteArrayOp_Double           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteByteArrayOp_StablePtr        [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
bWord DynFlags
dflags) [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteByteArrayOp_Int8             [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo8 DynFlags
dflags))  CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteByteArrayOp_Int16            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo16 DynFlags
dflags)) CmmType
b16 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteByteArrayOp_Int32            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo32 DynFlags
dflags)) CmmType
b32 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
WriteByteArrayOp_Int64            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteByteArrayOp_Word8            [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo8 DynFlags
dflags))  CmmType
b8  [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteByteArrayOp_Word16           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo16 DynFlags
dflags)) CmmType
b16 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteByteArrayOp_Word32           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo32 DynFlags
dflags)) CmmType
b32 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
WriteByteArrayOp_Word64           [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args

-- WriteInt8ArrayAsXXX

emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteByteArrayOp_Word8AsChar       [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo8 DynFlags
dflags))  CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteByteArrayOp_Word8AsWideChar   [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo32 DynFlags
dflags)) CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
WriteByteArrayOp_Word8AsInt        [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
WriteByteArrayOp_Word8AsWord       [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
WriteByteArrayOp_Word8AsAddr       [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
WriteByteArrayOp_Word8AsFloat      [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
WriteByteArrayOp_Word8AsDouble     [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
WriteByteArrayOp_Word8AsStablePtr  [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteByteArrayOp_Word8AsInt16      [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo16 DynFlags
dflags)) CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteByteArrayOp_Word8AsInt32      [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo32 DynFlags
dflags)) CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
WriteByteArrayOp_Word8AsInt64      [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteByteArrayOp_Word8AsWord16     [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo16 DynFlags
dflags)) CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
dflags [LocalReg]
res PrimOp
WriteByteArrayOp_Word8AsWord32     [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo32 DynFlags
dflags)) CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp DynFlags
_      [LocalReg]
res PrimOp
WriteByteArrayOp_Word8AsWord64     [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args

-- Copying and setting byte arrays
emitPrimOp DynFlags
_      [] PrimOp
CopyByteArrayOp [CmmExpr
src,CmmExpr
src_off,CmmExpr
dst,CmmExpr
dst_off,CmmExpr
n] =
    CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyByteArrayOp CmmExpr
src CmmExpr
src_off CmmExpr
dst CmmExpr
dst_off CmmExpr
n
emitPrimOp DynFlags
_      [] PrimOp
CopyMutableByteArrayOp [CmmExpr
src,CmmExpr
src_off,CmmExpr
dst,CmmExpr
dst_off,CmmExpr
n] =
    CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyMutableByteArrayOp CmmExpr
src CmmExpr
src_off CmmExpr
dst CmmExpr
dst_off CmmExpr
n
emitPrimOp DynFlags
_      [] PrimOp
CopyByteArrayToAddrOp [CmmExpr
src,CmmExpr
src_off,CmmExpr
dst,CmmExpr
n] =
    CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyByteArrayToAddrOp CmmExpr
src CmmExpr
src_off CmmExpr
dst CmmExpr
n
emitPrimOp DynFlags
_      [] PrimOp
CopyMutableByteArrayToAddrOp [CmmExpr
src,CmmExpr
src_off,CmmExpr
dst,CmmExpr
n] =
    CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyMutableByteArrayToAddrOp CmmExpr
src CmmExpr
src_off CmmExpr
dst CmmExpr
n
emitPrimOp DynFlags
_      [] PrimOp
CopyAddrToByteArrayOp [CmmExpr
src,CmmExpr
dst,CmmExpr
dst_off,CmmExpr
n] =
    CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyAddrToByteArrayOp CmmExpr
src CmmExpr
dst CmmExpr
dst_off CmmExpr
n
emitPrimOp DynFlags
_      [] PrimOp
SetByteArrayOp [CmmExpr
ba,CmmExpr
off,CmmExpr
len,CmmExpr
c] =
    CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doSetByteArrayOp CmmExpr
ba CmmExpr
off CmmExpr
len CmmExpr
c

-- Comparing byte arrays
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
CompareByteArraysOp [CmmExpr
ba1,CmmExpr
ba1_off,CmmExpr
ba2,CmmExpr
ba2_off,CmmExpr
n] =
    LocalReg
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCompareByteArraysOp LocalReg
res CmmExpr
ba1 CmmExpr
ba1_off CmmExpr
ba2 CmmExpr
ba2_off CmmExpr
n

emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
BSwap16Op [CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitBSwapCall LocalReg
res CmmExpr
w Width
W16
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
BSwap32Op [CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitBSwapCall LocalReg
res CmmExpr
w Width
W32
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
BSwap64Op [CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitBSwapCall LocalReg
res CmmExpr
w Width
W64
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
BSwapOp   [CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitBSwapCall LocalReg
res CmmExpr
w (DynFlags -> Width
wordWidth DynFlags
dflags)

-- Population count
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
PopCnt8Op  [CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitPopCntCall LocalReg
res CmmExpr
w Width
W8
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
PopCnt16Op [CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitPopCntCall LocalReg
res CmmExpr
w Width
W16
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
PopCnt32Op [CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitPopCntCall LocalReg
res CmmExpr
w Width
W32
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
PopCnt64Op [CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitPopCntCall LocalReg
res CmmExpr
w Width
W64
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
PopCntOp   [CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitPopCntCall LocalReg
res CmmExpr
w (DynFlags -> Width
wordWidth DynFlags
dflags)

-- Parallel bit deposit
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
Pdep8Op  [CmmExpr
src, CmmExpr
mask] = LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPdepCall LocalReg
res CmmExpr
src CmmExpr
mask Width
W8
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
Pdep16Op [CmmExpr
src, CmmExpr
mask] = LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPdepCall LocalReg
res CmmExpr
src CmmExpr
mask Width
W16
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
Pdep32Op [CmmExpr
src, CmmExpr
mask] = LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPdepCall LocalReg
res CmmExpr
src CmmExpr
mask Width
W32
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
Pdep64Op [CmmExpr
src, CmmExpr
mask] = LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPdepCall LocalReg
res CmmExpr
src CmmExpr
mask Width
W64
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
PdepOp   [CmmExpr
src, CmmExpr
mask] = LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPdepCall LocalReg
res CmmExpr
src CmmExpr
mask (DynFlags -> Width
wordWidth DynFlags
dflags)

-- Parallel bit extract
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
Pext8Op  [CmmExpr
src, CmmExpr
mask] = LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPextCall LocalReg
res CmmExpr
src CmmExpr
mask Width
W8
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
Pext16Op [CmmExpr
src, CmmExpr
mask] = LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPextCall LocalReg
res CmmExpr
src CmmExpr
mask Width
W16
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
Pext32Op [CmmExpr
src, CmmExpr
mask] = LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPextCall LocalReg
res CmmExpr
src CmmExpr
mask Width
W32
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
Pext64Op [CmmExpr
src, CmmExpr
mask] = LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPextCall LocalReg
res CmmExpr
src CmmExpr
mask Width
W64
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
PextOp   [CmmExpr
src, CmmExpr
mask] = LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPextCall LocalReg
res CmmExpr
src CmmExpr
mask (DynFlags -> Width
wordWidth DynFlags
dflags)

-- count leading zeros
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
Clz8Op  [CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitClzCall LocalReg
res CmmExpr
w Width
W8
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
Clz16Op [CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitClzCall LocalReg
res CmmExpr
w Width
W16
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
Clz32Op [CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitClzCall LocalReg
res CmmExpr
w Width
W32
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
Clz64Op [CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitClzCall LocalReg
res CmmExpr
w Width
W64
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
ClzOp   [CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitClzCall LocalReg
res CmmExpr
w (DynFlags -> Width
wordWidth DynFlags
dflags)

-- count trailing zeros
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
Ctz8Op [CmmExpr
w]  = LocalReg -> CmmExpr -> Width -> FCode ()
emitCtzCall LocalReg
res CmmExpr
w Width
W8
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
Ctz16Op [CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitCtzCall LocalReg
res CmmExpr
w Width
W16
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
Ctz32Op [CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitCtzCall LocalReg
res CmmExpr
w Width
W32
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
Ctz64Op [CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitCtzCall LocalReg
res CmmExpr
w Width
W64
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
CtzOp   [CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitCtzCall LocalReg
res CmmExpr
w (DynFlags -> Width
wordWidth DynFlags
dflags)

-- Unsigned int to floating point conversions
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
Word2FloatOp  [CmmExpr
w] = [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [LocalReg
res]
                                            (Width -> CallishMachOp
MO_UF_Conv Width
W32) [CmmExpr
w]
emitPrimOp DynFlags
_      [LocalReg
res] PrimOp
Word2DoubleOp [CmmExpr
w] = [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [LocalReg
res]
                                            (Width -> CallishMachOp
MO_UF_Conv Width
W64) [CmmExpr
w]

-- SIMD primops
emitPrimOp DynFlags
dflags [LocalReg
res] (VecBroadcastOp PrimOpVecCat
vcat Int
n Width
w) [CmmExpr
e] = do
    DynFlags -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility DynFlags
dflags PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp
-> CmmType -> CmmExpr -> [CmmExpr] -> LocalReg -> FCode ()
doVecPackOp (DynFlags -> PrimOpVecCat -> Width -> Maybe MachOp
vecElemInjectCast DynFlags
dflags PrimOpVecCat
vcat Width
w) CmmType
ty CmmExpr
zeros (Int -> CmmExpr -> [CmmExpr]
forall a. Int -> a -> [a]
replicate Int
n CmmExpr
e) LocalReg
res
  where
    zeros :: CmmExpr
    zeros :: CmmExpr
zeros = CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ [CmmLit] -> CmmLit
CmmVec (Int -> CmmLit -> [CmmLit]
forall a. Int -> a -> [a]
replicate Int
n CmmLit
zero)

    zero :: CmmLit
    zero :: CmmLit
zero = case PrimOpVecCat
vcat of
             PrimOpVecCat
IntVec   -> Integer -> Width -> CmmLit
CmmInt Integer
0 Width
w
             PrimOpVecCat
WordVec  -> Integer -> Width -> CmmLit
CmmInt Integer
0 Width
w
             PrimOpVecCat
FloatVec -> Rational -> Width -> CmmLit
CmmFloat Rational
0 Width
w

    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

emitPrimOp DynFlags
dflags [LocalReg
res] (VecPackOp PrimOpVecCat
vcat Int
n Width
w) [CmmExpr]
es = do
    DynFlags -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility DynFlags
dflags PrimOpVecCat
vcat Int
n Width
w
    Bool -> FCode () -> FCode ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([CmmExpr]
es [CmmExpr] -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthIsNot` Int
n) (FCode () -> FCode ()) -> FCode () -> FCode ()
forall a b. (a -> b) -> a -> b
$
        String -> FCode ()
forall a. String -> a
panic String
"emitPrimOp: VecPackOp has wrong number of arguments"
    Maybe MachOp
-> CmmType -> CmmExpr -> [CmmExpr] -> LocalReg -> FCode ()
doVecPackOp (DynFlags -> PrimOpVecCat -> Width -> Maybe MachOp
vecElemInjectCast DynFlags
dflags PrimOpVecCat
vcat Width
w) CmmType
ty CmmExpr
zeros [CmmExpr]
es LocalReg
res
  where
    zeros :: CmmExpr
    zeros :: CmmExpr
zeros = CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ [CmmLit] -> CmmLit
CmmVec (Int -> CmmLit -> [CmmLit]
forall a. Int -> a -> [a]
replicate Int
n CmmLit
zero)

    zero :: CmmLit
    zero :: CmmLit
zero = case PrimOpVecCat
vcat of
             PrimOpVecCat
IntVec   -> Integer -> Width -> CmmLit
CmmInt Integer
0 Width
w
             PrimOpVecCat
WordVec  -> Integer -> Width -> CmmLit
CmmInt Integer
0 Width
w
             PrimOpVecCat
FloatVec -> Rational -> Width -> CmmLit
CmmFloat Rational
0 Width
w

    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

emitPrimOp DynFlags
dflags [LocalReg]
res (VecUnpackOp PrimOpVecCat
vcat Int
n Width
w) [CmmExpr
arg] = do
    DynFlags -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility DynFlags
dflags PrimOpVecCat
vcat Int
n Width
w
    Bool -> FCode () -> FCode ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([LocalReg]
res [LocalReg] -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthIsNot` Int
n) (FCode () -> FCode ()) -> FCode () -> FCode ()
forall a b. (a -> b) -> a -> b
$
        String -> FCode ()
forall a. String -> a
panic String
"emitPrimOp: VecUnpackOp has wrong number of results"
    Maybe MachOp -> CmmType -> CmmExpr -> [LocalReg] -> FCode ()
doVecUnpackOp (DynFlags -> PrimOpVecCat -> Width -> Maybe MachOp
vecElemProjectCast DynFlags
dflags PrimOpVecCat
vcat Width
w) CmmType
ty CmmExpr
arg [LocalReg]
res
  where
    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

emitPrimOp DynFlags
dflags [LocalReg
res] (VecInsertOp PrimOpVecCat
vcat Int
n Width
w) [CmmExpr
v,CmmExpr
e,CmmExpr
i] = do
    DynFlags -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility DynFlags
dflags PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp
-> CmmType -> CmmExpr -> CmmExpr -> CmmExpr -> LocalReg -> FCode ()
doVecInsertOp (DynFlags -> PrimOpVecCat -> Width -> Maybe MachOp
vecElemInjectCast DynFlags
dflags PrimOpVecCat
vcat Width
w) CmmType
ty CmmExpr
v CmmExpr
e CmmExpr
i LocalReg
res
  where
    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

emitPrimOp DynFlags
dflags [LocalReg]
res (VecIndexByteArrayOp PrimOpVecCat
vcat Int
n Width
w) [CmmExpr]
args = do
    DynFlags -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility DynFlags
dflags PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
ty [LocalReg]
res [CmmExpr]
args
  where
    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

emitPrimOp DynFlags
dflags [LocalReg]
res (VecReadByteArrayOp PrimOpVecCat
vcat Int
n Width
w) [CmmExpr]
args = do
    DynFlags -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility DynFlags
dflags PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
ty [LocalReg]
res [CmmExpr]
args
  where
    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

emitPrimOp DynFlags
dflags [LocalReg]
res (VecWriteByteArrayOp PrimOpVecCat
vcat Int
n Width
w) [CmmExpr]
args = do
    DynFlags -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility DynFlags
dflags PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
ty [LocalReg]
res [CmmExpr]
args
  where
    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

emitPrimOp DynFlags
dflags [LocalReg]
res (VecIndexOffAddrOp PrimOpVecCat
vcat Int
n Width
w) [CmmExpr]
args = do
    DynFlags -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility DynFlags
dflags PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
ty [LocalReg]
res [CmmExpr]
args
  where
    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

emitPrimOp DynFlags
dflags [LocalReg]
res (VecReadOffAddrOp PrimOpVecCat
vcat Int
n Width
w) [CmmExpr]
args = do
    DynFlags -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility DynFlags
dflags PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
ty [LocalReg]
res [CmmExpr]
args
  where
    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

emitPrimOp DynFlags
dflags [LocalReg]
res (VecWriteOffAddrOp PrimOpVecCat
vcat Int
n Width
w) [CmmExpr]
args = do
    DynFlags -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility DynFlags
dflags PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
ty [LocalReg]
res [CmmExpr]
args
  where
    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

emitPrimOp DynFlags
dflags [LocalReg]
res (VecIndexScalarByteArrayOp PrimOpVecCat
vcat Int
n Width
w) [CmmExpr]
args = do
    DynFlags -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility DynFlags
dflags PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs Maybe MachOp
forall a. Maybe a
Nothing CmmType
vecty CmmType
ty [LocalReg]
res [CmmExpr]
args
  where
    vecty :: CmmType
    vecty :: CmmType
vecty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Width -> CmmType
vecCmmCat PrimOpVecCat
vcat Width
w

emitPrimOp DynFlags
dflags [LocalReg]
res (VecReadScalarByteArrayOp PrimOpVecCat
vcat Int
n Width
w) [CmmExpr]
args = do
    DynFlags -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility DynFlags
dflags PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs Maybe MachOp
forall a. Maybe a
Nothing CmmType
vecty CmmType
ty [LocalReg]
res [CmmExpr]
args
  where
    vecty :: CmmType
    vecty :: CmmType
vecty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Width -> CmmType
vecCmmCat PrimOpVecCat
vcat Width
w

emitPrimOp DynFlags
dflags [LocalReg]
res (VecWriteScalarByteArrayOp PrimOpVecCat
vcat Int
n Width
w) [CmmExpr]
args = do
    DynFlags -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility DynFlags
dflags PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
ty [LocalReg]
res [CmmExpr]
args
  where
    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Width -> CmmType
vecCmmCat PrimOpVecCat
vcat Width
w

emitPrimOp DynFlags
dflags [LocalReg]
res (VecIndexScalarOffAddrOp PrimOpVecCat
vcat Int
n Width
w) [CmmExpr]
args = do
    DynFlags -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility DynFlags
dflags PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOpAs Maybe MachOp
forall a. Maybe a
Nothing CmmType
vecty CmmType
ty [LocalReg]
res [CmmExpr]
args
  where
    vecty :: CmmType
    vecty :: CmmType
vecty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Width -> CmmType
vecCmmCat PrimOpVecCat
vcat Width
w

emitPrimOp DynFlags
dflags [LocalReg]
res (VecReadScalarOffAddrOp PrimOpVecCat
vcat Int
n Width
w) [CmmExpr]
args = do
    DynFlags -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility DynFlags
dflags PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOpAs Maybe MachOp
forall a. Maybe a
Nothing CmmType
vecty CmmType
ty [LocalReg]
res [CmmExpr]
args
  where
    vecty :: CmmType
    vecty :: CmmType
vecty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Width -> CmmType
vecCmmCat PrimOpVecCat
vcat Width
w

emitPrimOp DynFlags
dflags [LocalReg]
res (VecWriteScalarOffAddrOp PrimOpVecCat
vcat Int
n Width
w) [CmmExpr]
args = do
    DynFlags -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility DynFlags
dflags PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
ty [LocalReg]
res [CmmExpr]
args
  where
    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Width -> CmmType
vecCmmCat PrimOpVecCat
vcat Width
w

-- Prefetch
emitPrimOp DynFlags
_ [] PrimOp
PrefetchByteArrayOp3        [CmmExpr]
args = Int -> [CmmExpr] -> FCode ()
doPrefetchByteArrayOp Int
3  [CmmExpr]
args
emitPrimOp DynFlags
_ [] PrimOp
PrefetchMutableByteArrayOp3 [CmmExpr]
args = Int -> [CmmExpr] -> FCode ()
doPrefetchMutableByteArrayOp Int
3  [CmmExpr]
args
emitPrimOp DynFlags
_ [] PrimOp
PrefetchAddrOp3             [CmmExpr]
args = Int -> [CmmExpr] -> FCode ()
doPrefetchAddrOp  Int
3  [CmmExpr]
args
emitPrimOp DynFlags
_ [] PrimOp
PrefetchValueOp3            [CmmExpr]
args = Int -> [CmmExpr] -> FCode ()
doPrefetchValueOp Int
3 [CmmExpr]
args

emitPrimOp DynFlags
_ [] PrimOp
PrefetchByteArrayOp2        [CmmExpr]
args = Int -> [CmmExpr] -> FCode ()
doPrefetchByteArrayOp Int
2  [CmmExpr]
args
emitPrimOp DynFlags
_ [] PrimOp
PrefetchMutableByteArrayOp2 [CmmExpr]
args = Int -> [CmmExpr] -> FCode ()
doPrefetchMutableByteArrayOp Int
2  [CmmExpr]
args
emitPrimOp DynFlags
_ [] PrimOp
PrefetchAddrOp2             [CmmExpr]
args = Int -> [CmmExpr] -> FCode ()
doPrefetchAddrOp Int
2  [CmmExpr]
args
emitPrimOp DynFlags
_ [] PrimOp
PrefetchValueOp2           [CmmExpr]
args = Int -> [CmmExpr] -> FCode ()
doPrefetchValueOp Int
2 [CmmExpr]
args

emitPrimOp DynFlags
_ [] PrimOp
PrefetchByteArrayOp1        [CmmExpr]
args = Int -> [CmmExpr] -> FCode ()
doPrefetchByteArrayOp Int
1  [CmmExpr]
args
emitPrimOp DynFlags
_ [] PrimOp
PrefetchMutableByteArrayOp1 [CmmExpr]
args = Int -> [CmmExpr] -> FCode ()
doPrefetchMutableByteArrayOp Int
1  [CmmExpr]
args
emitPrimOp DynFlags
_ [] PrimOp
PrefetchAddrOp1             [CmmExpr]
args = Int -> [CmmExpr] -> FCode ()
doPrefetchAddrOp Int
1  [CmmExpr]
args
emitPrimOp DynFlags
_ [] PrimOp
PrefetchValueOp1            [CmmExpr]
args = Int -> [CmmExpr] -> FCode ()
doPrefetchValueOp Int
1 [CmmExpr]
args

emitPrimOp DynFlags
_ [] PrimOp
PrefetchByteArrayOp0        [CmmExpr]
args = Int -> [CmmExpr] -> FCode ()
doPrefetchByteArrayOp Int
0  [CmmExpr]
args
emitPrimOp DynFlags
_ [] PrimOp
PrefetchMutableByteArrayOp0 [CmmExpr]
args = Int -> [CmmExpr] -> FCode ()
doPrefetchMutableByteArrayOp Int
0  [CmmExpr]
args
emitPrimOp DynFlags
_ [] PrimOp
PrefetchAddrOp0             [CmmExpr]
args = Int -> [CmmExpr] -> FCode ()
doPrefetchAddrOp Int
0  [CmmExpr]
args
emitPrimOp DynFlags
_ [] PrimOp
PrefetchValueOp0            [CmmExpr]
args = Int -> [CmmExpr] -> FCode ()
doPrefetchValueOp Int
0 [CmmExpr]
args

-- Atomic read-modify-write
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
FetchAddByteArrayOp_Int [CmmExpr
mba, CmmExpr
ix, CmmExpr
n] =
    LocalReg
-> AtomicMachOp
-> CmmExpr
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
doAtomicRMW LocalReg
res AtomicMachOp
AMO_Add CmmExpr
mba CmmExpr
ix (DynFlags -> CmmType
bWord DynFlags
dflags) CmmExpr
n
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
FetchSubByteArrayOp_Int [CmmExpr
mba, CmmExpr
ix, CmmExpr
n] =
    LocalReg
-> AtomicMachOp
-> CmmExpr
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
doAtomicRMW LocalReg
res AtomicMachOp
AMO_Sub CmmExpr
mba CmmExpr
ix (DynFlags -> CmmType
bWord DynFlags
dflags) CmmExpr
n
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
FetchAndByteArrayOp_Int [CmmExpr
mba, CmmExpr
ix, CmmExpr
n] =
    LocalReg
-> AtomicMachOp
-> CmmExpr
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
doAtomicRMW LocalReg
res AtomicMachOp
AMO_And CmmExpr
mba CmmExpr
ix (DynFlags -> CmmType
bWord DynFlags
dflags) CmmExpr
n
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
FetchNandByteArrayOp_Int [CmmExpr
mba, CmmExpr
ix, CmmExpr
n] =
    LocalReg
-> AtomicMachOp
-> CmmExpr
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
doAtomicRMW LocalReg
res AtomicMachOp
AMO_Nand CmmExpr
mba CmmExpr
ix (DynFlags -> CmmType
bWord DynFlags
dflags) CmmExpr
n
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
FetchOrByteArrayOp_Int [CmmExpr
mba, CmmExpr
ix, CmmExpr
n] =
    LocalReg
-> AtomicMachOp
-> CmmExpr
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
doAtomicRMW LocalReg
res AtomicMachOp
AMO_Or CmmExpr
mba CmmExpr
ix (DynFlags -> CmmType
bWord DynFlags
dflags) CmmExpr
n
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
FetchXorByteArrayOp_Int [CmmExpr
mba, CmmExpr
ix, CmmExpr
n] =
    LocalReg
-> AtomicMachOp
-> CmmExpr
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
doAtomicRMW LocalReg
res AtomicMachOp
AMO_Xor CmmExpr
mba CmmExpr
ix (DynFlags -> CmmType
bWord DynFlags
dflags) CmmExpr
n
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
AtomicReadByteArrayOp_Int [CmmExpr
mba, CmmExpr
ix] =
    LocalReg -> CmmExpr -> CmmExpr -> CmmType -> FCode ()
doAtomicReadByteArray LocalReg
res CmmExpr
mba CmmExpr
ix (DynFlags -> CmmType
bWord DynFlags
dflags)
emitPrimOp DynFlags
dflags [] PrimOp
AtomicWriteByteArrayOp_Int [CmmExpr
mba, CmmExpr
ix, CmmExpr
val] =
    CmmExpr -> CmmExpr -> CmmType -> CmmExpr -> FCode ()
doAtomicWriteByteArray CmmExpr
mba CmmExpr
ix (DynFlags -> CmmType
bWord DynFlags
dflags) CmmExpr
val
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
CasByteArrayOp_Int [CmmExpr
mba, CmmExpr
ix, CmmExpr
old, CmmExpr
new] =
    LocalReg
-> CmmExpr -> CmmExpr -> CmmType -> CmmExpr -> CmmExpr -> FCode ()
doCasByteArray LocalReg
res CmmExpr
mba CmmExpr
ix (DynFlags -> CmmType
bWord DynFlags
dflags) CmmExpr
old CmmExpr
new

-- The rest just translate straightforwardly
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
op [CmmExpr
arg]
   | PrimOp -> Bool
nopOp PrimOp
op
   = CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) CmmExpr
arg

   | Just (Width -> Width -> MachOp
mop,Width
rep) <- PrimOp -> Maybe (Width -> Width -> MachOp, Width)
narrowOp PrimOp
op
   = CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (CmmExpr -> FCode ()) -> CmmExpr -> FCode ()
forall a b. (a -> b) -> a -> b
$
           MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> Width -> MachOp
mop Width
rep (DynFlags -> Width
wordWidth DynFlags
dflags)) [MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> Width -> MachOp
mop (DynFlags -> Width
wordWidth DynFlags
dflags) Width
rep) [CmmExpr
arg]]

emitPrimOp DynFlags
dflags r :: [LocalReg]
r@[LocalReg
res] PrimOp
op [CmmExpr]
args
   | Just CallishMachOp
prim <- PrimOp -> Maybe CallishMachOp
callishOp PrimOp
op
   = do [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [LocalReg]
r CallishMachOp
prim [CmmExpr]
args

   | Just MachOp
mop <- DynFlags -> PrimOp -> Maybe MachOp
translateOp DynFlags
dflags PrimOp
op
   = let stmt :: CmmAGraph
stmt = CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
mop [CmmExpr]
args) in
     CmmAGraph -> FCode ()
emit CmmAGraph
stmt

emitPrimOp DynFlags
dflags [LocalReg]
results PrimOp
op [CmmExpr]
args
   = case DynFlags
-> PrimOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
callishPrimOpSupported DynFlags
dflags PrimOp
op of
          Left CallishMachOp
op   -> CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ ForeignTarget -> [LocalReg] -> [CmmExpr] -> CmmAGraph
mkUnsafeCall (CallishMachOp -> ForeignTarget
PrimTarget CallishMachOp
op) [LocalReg]
results [CmmExpr]
args
          Right [LocalReg] -> [CmmExpr] -> FCode ()
gen -> [LocalReg] -> [CmmExpr] -> FCode ()
gen [LocalReg]
results [CmmExpr]
args

type GenericOp = [CmmFormal] -> [CmmActual] -> FCode ()

callishPrimOpSupported :: DynFlags -> PrimOp -> Either CallishMachOp GenericOp
callishPrimOpSupported :: DynFlags
-> PrimOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
callishPrimOpSupported DynFlags
dflags PrimOp
op
  = case PrimOp
op of
      PrimOp
IntQuotRemOp   | Bool
ncg Bool -> Bool -> Bool
&& (Bool
x86ish Bool -> Bool -> Bool
|| Bool
ppc) ->
                         CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_S_QuotRem  (DynFlags -> Width
wordWidth DynFlags
dflags))
                     | Bool
otherwise              ->
                         ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right (Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericIntQuotRemOp (DynFlags -> Width
wordWidth DynFlags
dflags))

      PrimOp
Int8QuotRemOp  | Bool
ncg Bool -> Bool -> Bool
&& (Bool
x86ish Bool -> Bool -> Bool
|| Bool
ppc)
                                     -> CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_S_QuotRem Width
W8)
                     | Bool
otherwise     -> ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right (Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericIntQuotRemOp Width
W8)

      PrimOp
Int16QuotRemOp | Bool
ncg Bool -> Bool -> Bool
&& (Bool
x86ish Bool -> Bool -> Bool
|| Bool
ppc)
                                     -> CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_S_QuotRem Width
W16)
                     | Bool
otherwise     -> ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right (Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericIntQuotRemOp Width
W16)


      PrimOp
WordQuotRemOp  | Bool
ncg Bool -> Bool -> Bool
&& (Bool
x86ish Bool -> Bool -> Bool
|| Bool
ppc) ->
                         CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_U_QuotRem  (DynFlags -> Width
wordWidth DynFlags
dflags))
                     | Bool
otherwise      ->
                         ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right (Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericWordQuotRemOp (DynFlags -> Width
wordWidth DynFlags
dflags))

      PrimOp
WordQuotRem2Op | (Bool
ncg Bool -> Bool -> Bool
&& (Bool
x86ish Bool -> Bool -> Bool
|| Bool
ppc))
                          Bool -> Bool -> Bool
|| Bool
llvm     -> CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_U_QuotRem2 (DynFlags -> Width
wordWidth DynFlags
dflags))
                     | Bool
otherwise      -> ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right (DynFlags -> [LocalReg] -> [CmmExpr] -> FCode ()
genericWordQuotRem2Op DynFlags
dflags)

      PrimOp
Word8QuotRemOp | Bool
ncg Bool -> Bool -> Bool
&& (Bool
x86ish Bool -> Bool -> Bool
|| Bool
ppc)
                                      -> CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_U_QuotRem Width
W8)
                     | Bool
otherwise      -> ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right (Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericWordQuotRemOp Width
W8)

      PrimOp
Word16QuotRemOp| Bool
ncg Bool -> Bool -> Bool
&& (Bool
x86ish Bool -> Bool -> Bool
|| Bool
ppc)
                                     -> CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_U_QuotRem Width
W16)
                     | Bool
otherwise     -> ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right (Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericWordQuotRemOp Width
W16)

      PrimOp
WordAdd2Op     | (Bool
ncg Bool -> Bool -> Bool
&& (Bool
x86ish Bool -> Bool -> Bool
|| Bool
ppc))
                         Bool -> Bool -> Bool
|| Bool
llvm      -> CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_Add2       (DynFlags -> Width
wordWidth DynFlags
dflags))
                     | Bool
otherwise      -> ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right [LocalReg] -> [CmmExpr] -> FCode ()
genericWordAdd2Op

      PrimOp
WordAddCOp     | (Bool
ncg Bool -> Bool -> Bool
&& (Bool
x86ish Bool -> Bool -> Bool
|| Bool
ppc))
                         Bool -> Bool -> Bool
|| Bool
llvm      -> CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_AddWordC   (DynFlags -> Width
wordWidth DynFlags
dflags))
                     | Bool
otherwise      -> ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right [LocalReg] -> [CmmExpr] -> FCode ()
genericWordAddCOp

      PrimOp
WordSubCOp     | (Bool
ncg Bool -> Bool -> Bool
&& (Bool
x86ish Bool -> Bool -> Bool
|| Bool
ppc))
                         Bool -> Bool -> Bool
|| Bool
llvm      -> CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_SubWordC   (DynFlags -> Width
wordWidth DynFlags
dflags))
                     | Bool
otherwise      -> ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right [LocalReg] -> [CmmExpr] -> FCode ()
genericWordSubCOp

      PrimOp
IntAddCOp      | (Bool
ncg Bool -> Bool -> Bool
&& (Bool
x86ish Bool -> Bool -> Bool
|| Bool
ppc))
                         Bool -> Bool -> Bool
|| Bool
llvm      -> CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_AddIntC    (DynFlags -> Width
wordWidth DynFlags
dflags))
                     | Bool
otherwise      -> ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right [LocalReg] -> [CmmExpr] -> FCode ()
genericIntAddCOp

      PrimOp
IntSubCOp      | (Bool
ncg Bool -> Bool -> Bool
&& (Bool
x86ish Bool -> Bool -> Bool
|| Bool
ppc))
                         Bool -> Bool -> Bool
|| Bool
llvm      -> CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_SubIntC    (DynFlags -> Width
wordWidth DynFlags
dflags))
                     | Bool
otherwise      -> ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right [LocalReg] -> [CmmExpr] -> FCode ()
genericIntSubCOp

      PrimOp
WordMul2Op     | Bool
ncg Bool -> Bool -> Bool
&& (Bool
x86ish Bool -> Bool -> Bool
|| Bool
ppc)
                         Bool -> Bool -> Bool
|| Bool
llvm      -> CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_U_Mul2     (DynFlags -> Width
wordWidth DynFlags
dflags))
                     | Bool
otherwise      -> ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right [LocalReg] -> [CmmExpr] -> FCode ()
genericWordMul2Op
      PrimOp
FloatFabsOp    | (Bool
ncg Bool -> Bool -> Bool
&& Bool
x86ish Bool -> Bool -> Bool
|| Bool
ppc)
                         Bool -> Bool -> Bool
|| Bool
llvm      -> CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left CallishMachOp
MO_F32_Fabs
                     | Bool
otherwise      -> ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right (([LocalReg] -> [CmmExpr] -> FCode ())
 -> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ()))
-> ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. (a -> b) -> a -> b
$ Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericFabsOp Width
W32
      PrimOp
DoubleFabsOp   | (Bool
ncg Bool -> Bool -> Bool
&& Bool
x86ish Bool -> Bool -> Bool
|| Bool
ppc)
                         Bool -> Bool -> Bool
|| Bool
llvm      -> CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left CallishMachOp
MO_F64_Fabs
                     | Bool
otherwise      -> ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right (([LocalReg] -> [CmmExpr] -> FCode ())
 -> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ()))
-> ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. (a -> b) -> a -> b
$ Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericFabsOp Width
W64

      PrimOp
_ -> String
-> SDoc
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"emitPrimOp: can't translate PrimOp " (PrimOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimOp
op)
 where
  ncg :: Bool
ncg = case DynFlags -> HscTarget
hscTarget DynFlags
dflags of
           HscTarget
HscAsm -> Bool
True
           HscTarget
_      -> Bool
False
  llvm :: Bool
llvm = case DynFlags -> HscTarget
hscTarget DynFlags
dflags of
           HscTarget
HscLlvm -> Bool
True
           HscTarget
_       -> Bool
False
  x86ish :: Bool
x86ish = case Platform -> Arch
platformArch (DynFlags -> Platform
targetPlatform DynFlags
dflags) of
             Arch
ArchX86    -> Bool
True
             Arch
ArchX86_64 -> Bool
True
             Arch
_          -> Bool
False
  ppc :: Bool
ppc = case Platform -> Arch
platformArch (DynFlags -> Platform
targetPlatform DynFlags
dflags) of
          Arch
ArchPPC      -> Bool
True
          ArchPPC_64 PPC_64ABI
_ -> Bool
True
          Arch
_            -> Bool
False

genericIntQuotRemOp :: Width -> GenericOp
genericIntQuotRemOp :: Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericIntQuotRemOp Width
width [LocalReg
res_q, LocalReg
res_r] [CmmExpr
arg_x, CmmExpr
arg_y]
   = CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_q)
              (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_S_Quot Width
width) [CmmExpr
arg_x, CmmExpr
arg_y]) CmmAGraph -> CmmAGraph -> CmmAGraph
<*>
            CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_r)
              (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_S_Rem  Width
width) [CmmExpr
arg_x, CmmExpr
arg_y])
genericIntQuotRemOp Width
_ [LocalReg]
_ [CmmExpr]
_ = String -> FCode ()
forall a. String -> a
panic String
"genericIntQuotRemOp"

genericWordQuotRemOp :: Width -> GenericOp
genericWordQuotRemOp :: Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericWordQuotRemOp Width
width [LocalReg
res_q, LocalReg
res_r] [CmmExpr
arg_x, CmmExpr
arg_y]
    = CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_q)
               (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_U_Quot Width
width) [CmmExpr
arg_x, CmmExpr
arg_y]) CmmAGraph -> CmmAGraph -> CmmAGraph
<*>
             CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_r)
               (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_U_Rem  Width
width) [CmmExpr
arg_x, CmmExpr
arg_y])
genericWordQuotRemOp Width
_ [LocalReg]
_ [CmmExpr]
_ = String -> FCode ()
forall a. String -> a
panic String
"genericWordQuotRemOp"

genericWordQuotRem2Op :: DynFlags -> GenericOp
genericWordQuotRem2Op :: DynFlags -> [LocalReg] -> [CmmExpr] -> FCode ()
genericWordQuotRem2Op DynFlags
dflags [LocalReg
res_q, LocalReg
res_r] [CmmExpr
arg_x_high, CmmExpr
arg_x_low, CmmExpr
arg_y]
    = CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> FCode CmmAGraph -> FCode ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> CmmExpr -> CmmExpr -> CmmExpr -> FCode CmmAGraph
f (Width -> Int
widthInBits (DynFlags -> Width
wordWidth DynFlags
dflags)) CmmExpr
zero CmmExpr
arg_x_high CmmExpr
arg_x_low
    where    ty :: CmmType
ty = DynFlags -> CmmExpr -> CmmType
cmmExprType DynFlags
dflags CmmExpr
arg_x_high
             shl :: CmmExpr -> CmmExpr -> CmmExpr
shl   CmmExpr
x CmmExpr
i = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Shl   (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
i]
             shr :: CmmExpr -> CmmExpr -> CmmExpr
shr   CmmExpr
x CmmExpr
i = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_U_Shr (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
i]
             or :: CmmExpr -> CmmExpr -> CmmExpr
or    CmmExpr
x CmmExpr
y = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Or    (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
y]
             ge :: CmmExpr -> CmmExpr -> CmmExpr
ge    CmmExpr
x CmmExpr
y = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_U_Ge  (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
y]
             ne :: CmmExpr -> CmmExpr -> CmmExpr
ne    CmmExpr
x CmmExpr
y = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Ne    (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
y]
             minus :: CmmExpr -> CmmExpr -> CmmExpr
minus CmmExpr
x CmmExpr
y = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Sub   (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
y]
             times :: CmmExpr -> CmmExpr -> CmmExpr
times CmmExpr
x CmmExpr
y = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Mul   (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
y]
             zero :: CmmExpr
zero   = Integer -> CmmExpr
lit Integer
0
             one :: CmmExpr
one    = Integer -> CmmExpr
lit Integer
1
             negone :: CmmExpr
negone = Integer -> CmmExpr
lit (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Width -> Int
widthInBits (DynFlags -> Width
wordWidth DynFlags
dflags)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
             lit :: Integer -> CmmExpr
lit Integer
i = CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
i (DynFlags -> Width
wordWidth DynFlags
dflags))

             f :: Int -> CmmExpr -> CmmExpr -> CmmExpr -> FCode CmmAGraph
             f :: Int -> CmmExpr -> CmmExpr -> CmmExpr -> FCode CmmAGraph
f Int
0 CmmExpr
acc CmmExpr
high CmmExpr
_ = CmmAGraph -> FCode CmmAGraph
forall (m :: * -> *) a. Monad m => a -> m a
return (CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_q) CmmExpr
acc CmmAGraph -> CmmAGraph -> CmmAGraph
<*>
                                      CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_r) CmmExpr
high)
             f Int
i CmmExpr
acc CmmExpr
high CmmExpr
low =
                 do LocalReg
roverflowedBit <- CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp CmmType
ty
                    LocalReg
rhigh'         <- CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp CmmType
ty
                    LocalReg
rhigh''        <- CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp CmmType
ty
                    LocalReg
rlow'          <- CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp CmmType
ty
                    LocalReg
risge          <- CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp CmmType
ty
                    LocalReg
racc'          <- CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp CmmType
ty
                    let high' :: CmmExpr
high'         = CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
rhigh')
                        isge :: CmmExpr
isge          = CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
risge)
                        overflowedBit :: CmmExpr
overflowedBit = CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
roverflowedBit)
                    let this :: CmmAGraph
this = [CmmAGraph] -> CmmAGraph
catAGraphs
                               [CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
roverflowedBit)
                                          (CmmExpr -> CmmExpr -> CmmExpr
shr CmmExpr
high CmmExpr
negone),
                                CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
rhigh')
                                          (CmmExpr -> CmmExpr -> CmmExpr
or (CmmExpr -> CmmExpr -> CmmExpr
shl CmmExpr
high CmmExpr
one) (CmmExpr -> CmmExpr -> CmmExpr
shr CmmExpr
low CmmExpr
negone)),
                                CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
rlow')
                                          (CmmExpr -> CmmExpr -> CmmExpr
shl CmmExpr
low CmmExpr
one),
                                CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
risge)
                                          (CmmExpr -> CmmExpr -> CmmExpr
or (CmmExpr
overflowedBit CmmExpr -> CmmExpr -> CmmExpr
`ne` CmmExpr
zero)
                                              (CmmExpr
high' CmmExpr -> CmmExpr -> CmmExpr
`ge` CmmExpr
arg_y)),
                                CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
rhigh'')
                                          (CmmExpr
high' CmmExpr -> CmmExpr -> CmmExpr
`minus` (CmmExpr
arg_y CmmExpr -> CmmExpr -> CmmExpr
`times` CmmExpr
isge)),
                                CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
racc')
                                          (CmmExpr -> CmmExpr -> CmmExpr
or (CmmExpr -> CmmExpr -> CmmExpr
shl CmmExpr
acc CmmExpr
one) CmmExpr
isge)]
                    CmmAGraph
rest <- Int -> CmmExpr -> CmmExpr -> CmmExpr -> FCode CmmAGraph
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
racc'))
                                      (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
rhigh''))
                                      (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
rlow'))
                    CmmAGraph -> FCode CmmAGraph
forall (m :: * -> *) a. Monad m => a -> m a
return (CmmAGraph
this CmmAGraph -> CmmAGraph -> CmmAGraph
<*> CmmAGraph
rest)
genericWordQuotRem2Op DynFlags
_ [LocalReg]
_ [CmmExpr]
_ = String -> FCode ()
forall a. String -> a
panic String
"genericWordQuotRem2Op"

genericWordAdd2Op :: GenericOp
genericWordAdd2Op :: [LocalReg] -> [CmmExpr] -> FCode ()
genericWordAdd2Op [LocalReg
res_h, LocalReg
res_l] [CmmExpr
arg_x, CmmExpr
arg_y]
  = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
       LocalReg
r1 <- CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp (DynFlags -> CmmExpr -> CmmType
cmmExprType DynFlags
dflags CmmExpr
arg_x)
       LocalReg
r2 <- CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp (DynFlags -> CmmExpr -> CmmType
cmmExprType DynFlags
dflags CmmExpr
arg_x)
       let topHalf :: CmmExpr -> CmmExpr
topHalf CmmExpr
x = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_U_Shr (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
hww]
           toTopHalf :: CmmExpr -> CmmExpr
toTopHalf CmmExpr
x = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Shl (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
hww]
           bottomHalf :: CmmExpr -> CmmExpr
bottomHalf CmmExpr
x = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_And (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
hwm]
           add :: CmmExpr -> CmmExpr -> CmmExpr
add CmmExpr
x CmmExpr
y = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
y]
           or :: CmmExpr -> CmmExpr -> CmmExpr
or CmmExpr
x CmmExpr
y = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Or (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
y]
           hww :: CmmExpr
hww = CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Width -> Int
widthInBits (DynFlags -> Width
halfWordWidth DynFlags
dflags)))
                                (DynFlags -> Width
wordWidth DynFlags
dflags))
           hwm :: CmmExpr
hwm = CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (DynFlags -> Integer
halfWordMask DynFlags
dflags) (DynFlags -> Width
wordWidth DynFlags
dflags))
       CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ [CmmAGraph] -> CmmAGraph
catAGraphs
          [CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
r1)
               (CmmExpr -> CmmExpr -> CmmExpr
add (CmmExpr -> CmmExpr
bottomHalf CmmExpr
arg_x) (CmmExpr -> CmmExpr
bottomHalf CmmExpr
arg_y)),
           CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
r2)
               (CmmExpr -> CmmExpr -> CmmExpr
add (CmmExpr -> CmmExpr
topHalf (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
r1)))
                    (CmmExpr -> CmmExpr -> CmmExpr
add (CmmExpr -> CmmExpr
topHalf CmmExpr
arg_x) (CmmExpr -> CmmExpr
topHalf CmmExpr
arg_y))),
           CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_h)
               (CmmExpr -> CmmExpr
topHalf (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
r2))),
           CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_l)
               (CmmExpr -> CmmExpr -> CmmExpr
or (CmmExpr -> CmmExpr
toTopHalf (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
r2)))
                   (CmmExpr -> CmmExpr
bottomHalf (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
r1))))]
genericWordAdd2Op [LocalReg]
_ [CmmExpr]
_ = String -> FCode ()
forall a. String -> a
panic String
"genericWordAdd2Op"

-- | Implements branchless recovery of the carry flag @c@ by checking the
-- leftmost bits of both inputs @a@ and @b@ and result @r = a + b@:
--
-- @
--    c = a&b | (a|b)&~r
-- @
--
-- https://brodowsky.it-sky.net/2015/04/02/how-to-recover-the-carry-bit/
genericWordAddCOp :: GenericOp
genericWordAddCOp :: [LocalReg] -> [CmmExpr] -> FCode ()
genericWordAddCOp [LocalReg
res_r, LocalReg
res_c] [CmmExpr
aa, CmmExpr
bb]
 = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
      CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ [CmmAGraph] -> CmmAGraph
catAGraphs [
        CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_r) (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordAdd DynFlags
dflags) [CmmExpr
aa,CmmExpr
bb]),
        CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_c) (CmmExpr -> CmmAGraph) -> CmmExpr -> CmmAGraph
forall a b. (a -> b) -> a -> b
$
          MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordUShr DynFlags
dflags) [
            MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordOr DynFlags
dflags) [
              MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordAnd DynFlags
dflags) [CmmExpr
aa,CmmExpr
bb],
              MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordAnd DynFlags
dflags) [
                MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordOr DynFlags
dflags) [CmmExpr
aa,CmmExpr
bb],
                MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordNot DynFlags
dflags) [CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
res_r)]
              ]
            ],
            DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (DynFlags -> Int
wORD_SIZE_IN_BITS DynFlags
dflags Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          ]
        ]
genericWordAddCOp [LocalReg]
_ [CmmExpr]
_ = String -> FCode ()
forall a. String -> a
panic String
"genericWordAddCOp"

-- | Implements branchless recovery of the carry flag @c@ by checking the
-- leftmost bits of both inputs @a@ and @b@ and result @r = a - b@:
--
-- @
--    c = ~a&b | (~a|b)&r
-- @
--
-- https://brodowsky.it-sky.net/2015/04/02/how-to-recover-the-carry-bit/
genericWordSubCOp :: GenericOp
genericWordSubCOp :: [LocalReg] -> [CmmExpr] -> FCode ()
genericWordSubCOp [LocalReg
res_r, LocalReg
res_c] [CmmExpr
aa, CmmExpr
bb]
 = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
      CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ [CmmAGraph] -> CmmAGraph
catAGraphs [
        CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_r) (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordSub DynFlags
dflags) [CmmExpr
aa,CmmExpr
bb]),
        CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_c) (CmmExpr -> CmmAGraph) -> CmmExpr -> CmmAGraph
forall a b. (a -> b) -> a -> b
$
          MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordUShr DynFlags
dflags) [
            MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordOr DynFlags
dflags) [
              MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordAnd DynFlags
dflags) [
                MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordNot DynFlags
dflags) [CmmExpr
aa],
                CmmExpr
bb
              ],
              MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordAnd DynFlags
dflags) [
                MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordOr DynFlags
dflags) [
                  MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordNot DynFlags
dflags) [CmmExpr
aa],
                  CmmExpr
bb
                ],
                CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
res_r)
              ]
            ],
            DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (DynFlags -> Int
wORD_SIZE_IN_BITS DynFlags
dflags Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          ]
        ]
genericWordSubCOp [LocalReg]
_ [CmmExpr]
_ = String -> FCode ()
forall a. String -> a
panic String
"genericWordSubCOp"

genericIntAddCOp :: GenericOp
genericIntAddCOp :: [LocalReg] -> [CmmExpr] -> FCode ()
genericIntAddCOp [LocalReg
res_r, LocalReg
res_c] [CmmExpr
aa, CmmExpr
bb]
{-
   With some bit-twiddling, we can define int{Add,Sub}Czh portably in
   C, and without needing any comparisons.  This may not be the
   fastest way to do it - if you have better code, please send it! --SDM

   Return : r = a + b,  c = 0 if no overflow, 1 on overflow.

   We currently don't make use of the r value if c is != 0 (i.e.
   overflow), we just convert to big integers and try again.  This
   could be improved by making r and c the correct values for
   plugging into a new J#.

   { r = ((I_)(a)) + ((I_)(b));                                 \
     c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r)))    \
         >> (BITS_IN (I_) - 1);                                 \
   }
   Wading through the mass of bracketry, it seems to reduce to:
   c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1)

-}
 = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
      CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ [CmmAGraph] -> CmmAGraph
catAGraphs [
        CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_r) (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordAdd DynFlags
dflags) [CmmExpr
aa,CmmExpr
bb]),
        CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_c) (CmmExpr -> CmmAGraph) -> CmmExpr -> CmmAGraph
forall a b. (a -> b) -> a -> b
$
          MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordUShr DynFlags
dflags) [
                MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordAnd DynFlags
dflags) [
                    MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordNot DynFlags
dflags) [MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordXor DynFlags
dflags) [CmmExpr
aa,CmmExpr
bb]],
                    MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordXor DynFlags
dflags) [CmmExpr
aa, CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
res_r)]
                ],
                DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (DynFlags -> Int
wORD_SIZE_IN_BITS DynFlags
dflags Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          ]
        ]
genericIntAddCOp [LocalReg]
_ [CmmExpr]
_ = String -> FCode ()
forall a. String -> a
panic String
"genericIntAddCOp"

genericIntSubCOp :: GenericOp
genericIntSubCOp :: [LocalReg] -> [CmmExpr] -> FCode ()
genericIntSubCOp [LocalReg
res_r, LocalReg
res_c] [CmmExpr
aa, CmmExpr
bb]
{- Similarly:
   #define subIntCzh(r,c,a,b)                                   \
   { r = ((I_)(a)) - ((I_)(b));                                 \
     c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r)))     \
         >> (BITS_IN (I_) - 1);                                 \
   }

   c =  ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
-}
 = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
      CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ [CmmAGraph] -> CmmAGraph
catAGraphs [
        CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_r) (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordSub DynFlags
dflags) [CmmExpr
aa,CmmExpr
bb]),
        CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_c) (CmmExpr -> CmmAGraph) -> CmmExpr -> CmmAGraph
forall a b. (a -> b) -> a -> b
$
          MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordUShr DynFlags
dflags) [
                MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordAnd DynFlags
dflags) [
                    MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordXor DynFlags
dflags) [CmmExpr
aa,CmmExpr
bb],
                    MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordXor DynFlags
dflags) [CmmExpr
aa, CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
res_r)]
                ],
                DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (DynFlags -> Int
wORD_SIZE_IN_BITS DynFlags
dflags Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          ]
        ]
genericIntSubCOp [LocalReg]
_ [CmmExpr]
_ = String -> FCode ()
forall a. String -> a
panic String
"genericIntSubCOp"

genericWordMul2Op :: GenericOp
genericWordMul2Op :: [LocalReg] -> [CmmExpr] -> FCode ()
genericWordMul2Op [LocalReg
res_h, LocalReg
res_l] [CmmExpr
arg_x, CmmExpr
arg_y]
 = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
      let t :: CmmType
t = DynFlags -> CmmExpr -> CmmType
cmmExprType DynFlags
dflags CmmExpr
arg_x
      CmmReg
xlyl <- (LocalReg -> CmmReg) -> FCode LocalReg -> FCode CmmReg
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM LocalReg -> CmmReg
CmmLocal (FCode LocalReg -> FCode CmmReg) -> FCode LocalReg -> FCode CmmReg
forall a b. (a -> b) -> a -> b
$ CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp CmmType
t
      CmmReg
xlyh <- (LocalReg -> CmmReg) -> FCode LocalReg -> FCode CmmReg
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM LocalReg -> CmmReg
CmmLocal (FCode LocalReg -> FCode CmmReg) -> FCode LocalReg -> FCode CmmReg
forall a b. (a -> b) -> a -> b
$ CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp CmmType
t
      CmmReg
xhyl <- (LocalReg -> CmmReg) -> FCode LocalReg -> FCode CmmReg
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM LocalReg -> CmmReg
CmmLocal (FCode LocalReg -> FCode CmmReg) -> FCode LocalReg -> FCode CmmReg
forall a b. (a -> b) -> a -> b
$ CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp CmmType
t
      CmmReg
r    <- (LocalReg -> CmmReg) -> FCode LocalReg -> FCode CmmReg
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM LocalReg -> CmmReg
CmmLocal (FCode LocalReg -> FCode CmmReg) -> FCode LocalReg -> FCode CmmReg
forall a b. (a -> b) -> a -> b
$ CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp CmmType
t
      -- This generic implementation is very simple and slow. We might
      -- well be able to do better, but for now this at least works.
      let topHalf :: CmmExpr -> CmmExpr
topHalf CmmExpr
x = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_U_Shr (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
hww]
          toTopHalf :: CmmExpr -> CmmExpr
toTopHalf CmmExpr
x = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Shl (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
hww]
          bottomHalf :: CmmExpr -> CmmExpr
bottomHalf CmmExpr
x = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_And (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
hwm]
          add :: CmmExpr -> CmmExpr -> CmmExpr
add CmmExpr
x CmmExpr
y = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
y]
          sum :: [CmmExpr] -> CmmExpr
sum = (CmmExpr -> CmmExpr -> CmmExpr) -> [CmmExpr] -> CmmExpr
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 CmmExpr -> CmmExpr -> CmmExpr
add
          mul :: CmmExpr -> CmmExpr -> CmmExpr
mul CmmExpr
x CmmExpr
y = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Mul (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
y]
          or :: CmmExpr -> CmmExpr -> CmmExpr
or CmmExpr
x CmmExpr
y = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Or (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
y]
          hww :: CmmExpr
hww = CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Width -> Int
widthInBits (DynFlags -> Width
halfWordWidth DynFlags
dflags)))
                               (DynFlags -> Width
wordWidth DynFlags
dflags))
          hwm :: CmmExpr
hwm = CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (DynFlags -> Integer
halfWordMask DynFlags
dflags) (DynFlags -> Width
wordWidth DynFlags
dflags))
      CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ [CmmAGraph] -> CmmAGraph
catAGraphs
             [CmmReg -> CmmExpr -> CmmAGraph
mkAssign CmmReg
xlyl
                  (CmmExpr -> CmmExpr -> CmmExpr
mul (CmmExpr -> CmmExpr
bottomHalf CmmExpr
arg_x) (CmmExpr -> CmmExpr
bottomHalf CmmExpr
arg_y)),
              CmmReg -> CmmExpr -> CmmAGraph
mkAssign CmmReg
xlyh
                  (CmmExpr -> CmmExpr -> CmmExpr
mul (CmmExpr -> CmmExpr
bottomHalf CmmExpr
arg_x) (CmmExpr -> CmmExpr
topHalf CmmExpr
arg_y)),
              CmmReg -> CmmExpr -> CmmAGraph
mkAssign CmmReg
xhyl
                  (CmmExpr -> CmmExpr -> CmmExpr
mul (CmmExpr -> CmmExpr
topHalf CmmExpr
arg_x) (CmmExpr -> CmmExpr
bottomHalf CmmExpr
arg_y)),
              CmmReg -> CmmExpr -> CmmAGraph
mkAssign CmmReg
r
                  ([CmmExpr] -> CmmExpr
sum [CmmExpr -> CmmExpr
topHalf    (CmmReg -> CmmExpr
CmmReg CmmReg
xlyl),
                        CmmExpr -> CmmExpr
bottomHalf (CmmReg -> CmmExpr
CmmReg CmmReg
xhyl),
                        CmmExpr -> CmmExpr
bottomHalf (CmmReg -> CmmExpr
CmmReg CmmReg
xlyh)]),
              CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_l)
                  (CmmExpr -> CmmExpr -> CmmExpr
or (CmmExpr -> CmmExpr
bottomHalf (CmmReg -> CmmExpr
CmmReg CmmReg
xlyl))
                      (CmmExpr -> CmmExpr
toTopHalf (CmmReg -> CmmExpr
CmmReg CmmReg
r))),
              CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_h)
                  ([CmmExpr] -> CmmExpr
sum [CmmExpr -> CmmExpr -> CmmExpr
mul (CmmExpr -> CmmExpr
topHalf CmmExpr
arg_x) (CmmExpr -> CmmExpr
topHalf CmmExpr
arg_y),
                        CmmExpr -> CmmExpr
topHalf (CmmReg -> CmmExpr
CmmReg CmmReg
xhyl),
                        CmmExpr -> CmmExpr
topHalf (CmmReg -> CmmExpr
CmmReg CmmReg
xlyh),
                        CmmExpr -> CmmExpr
topHalf (CmmReg -> CmmExpr
CmmReg CmmReg
r)])]
genericWordMul2Op [LocalReg]
_ [CmmExpr]
_ = String -> FCode ()
forall a. String -> a
panic String
"genericWordMul2Op"

-- This replicates what we had in libraries/base/GHC/Float.hs:
--
--    abs x    | x == 0    = 0 -- handles (-0.0)
--             | x >  0    = x
--             | otherwise = negateFloat x
genericFabsOp :: Width -> GenericOp
genericFabsOp :: Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericFabsOp Width
w [LocalReg
res_r] [CmmExpr
aa]
 = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
      let zero :: CmmExpr
zero   = CmmLit -> CmmExpr
CmmLit (Rational -> Width -> CmmLit
CmmFloat Rational
0 Width
w)

          eq :: CmmExpr -> CmmExpr -> CmmExpr
eq CmmExpr
x CmmExpr
y = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_F_Eq Width
w) [CmmExpr
x, CmmExpr
y]
          gt :: CmmExpr -> CmmExpr -> CmmExpr
gt CmmExpr
x CmmExpr
y = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_F_Gt Width
w) [CmmExpr
x, CmmExpr
y]

          neg :: CmmExpr -> CmmExpr
neg CmmExpr
x  = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_F_Neg Width
w) [CmmExpr
x]

          g1 :: CmmAGraph
g1 = [CmmAGraph] -> CmmAGraph
catAGraphs [CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_r) CmmExpr
zero]
          g2 :: CmmAGraph
g2 = [CmmAGraph] -> CmmAGraph
catAGraphs [CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_r) CmmExpr
aa]

      CmmReg
res_t <- LocalReg -> CmmReg
CmmLocal (LocalReg -> CmmReg) -> FCode LocalReg -> FCode CmmReg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp (DynFlags -> CmmExpr -> CmmType
cmmExprType DynFlags
dflags CmmExpr
aa)
      let g3 :: CmmAGraph
g3 = [CmmAGraph] -> CmmAGraph
catAGraphs [CmmReg -> CmmExpr -> CmmAGraph
mkAssign CmmReg
res_t CmmExpr
aa,
                           CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_r) (CmmExpr -> CmmExpr
neg (CmmReg -> CmmExpr
CmmReg CmmReg
res_t))]

      CmmAGraph
g4 <- CmmExpr -> CmmAGraph -> CmmAGraph -> FCode CmmAGraph
mkCmmIfThenElse (CmmExpr -> CmmExpr -> CmmExpr
gt CmmExpr
aa CmmExpr
zero) CmmAGraph
g2 CmmAGraph
g3

      CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> FCode CmmAGraph -> FCode ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CmmExpr -> CmmAGraph -> CmmAGraph -> FCode CmmAGraph
mkCmmIfThenElse (CmmExpr -> CmmExpr -> CmmExpr
eq CmmExpr
aa CmmExpr
zero) CmmAGraph
g1 CmmAGraph
g4

genericFabsOp Width
_ [LocalReg]
_ [CmmExpr]
_ = String -> FCode ()
forall a. String -> a
panic String
"genericFabsOp"

-- These PrimOps are NOPs in Cmm

nopOp :: PrimOp -> Bool
nopOp :: PrimOp -> Bool
nopOp PrimOp
Int2WordOp     = Bool
True
nopOp PrimOp
Word2IntOp     = Bool
True
nopOp PrimOp
Int2AddrOp     = Bool
True
nopOp PrimOp
Addr2IntOp     = Bool
True
nopOp PrimOp
ChrOp          = Bool
True  -- Int# and Char# are rep'd the same
nopOp PrimOp
OrdOp          = Bool
True
nopOp PrimOp
_              = Bool
False

-- These PrimOps turn into double casts

narrowOp :: PrimOp -> Maybe (Width -> Width -> MachOp, Width)
narrowOp :: PrimOp -> Maybe (Width -> Width -> MachOp, Width)
narrowOp PrimOp
Narrow8IntOp   = (Width -> Width -> MachOp, Width)
-> Maybe (Width -> Width -> MachOp, Width)
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_SS_Conv, Width
W8)
narrowOp PrimOp
Narrow16IntOp  = (Width -> Width -> MachOp, Width)
-> Maybe (Width -> Width -> MachOp, Width)
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_SS_Conv, Width
W16)
narrowOp PrimOp
Narrow32IntOp  = (Width -> Width -> MachOp, Width)
-> Maybe (Width -> Width -> MachOp, Width)
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_SS_Conv, Width
W32)
narrowOp PrimOp
Narrow8WordOp  = (Width -> Width -> MachOp, Width)
-> Maybe (Width -> Width -> MachOp, Width)
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_UU_Conv, Width
W8)
narrowOp PrimOp
Narrow16WordOp = (Width -> Width -> MachOp, Width)
-> Maybe (Width -> Width -> MachOp, Width)
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_UU_Conv, Width
W16)
narrowOp PrimOp
Narrow32WordOp = (Width -> Width -> MachOp, Width)
-> Maybe (Width -> Width -> MachOp, Width)
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_UU_Conv, Width
W32)
narrowOp PrimOp
_              = Maybe (Width -> Width -> MachOp, Width)
forall a. Maybe a
Nothing

-- Native word signless ops

translateOp :: DynFlags -> PrimOp -> Maybe MachOp
translateOp :: DynFlags -> PrimOp -> Maybe MachOp
translateOp DynFlags
dflags PrimOp
IntAddOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordAdd DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
IntSubOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordSub DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
WordAddOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordAdd DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
WordSubOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordSub DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
AddrAddOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordAdd DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
AddrSubOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordSub DynFlags
dflags)

translateOp DynFlags
dflags PrimOp
IntEqOp        = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
IntNeOp        = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordNe DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
WordEqOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
WordNeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordNe DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
AddrEqOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
AddrNeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordNe DynFlags
dflags)

translateOp DynFlags
dflags PrimOp
AndOp          = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordAnd DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
OrOp           = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordOr DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
XorOp          = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordXor DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
NotOp          = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordNot DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
SllOp          = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordShl DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
SrlOp          = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordUShr DynFlags
dflags)

translateOp DynFlags
dflags PrimOp
AddrRemOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordURem DynFlags
dflags)

-- Native word signed ops

translateOp DynFlags
dflags PrimOp
IntMulOp        = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordMul DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
IntMulMayOfloOp = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_MulMayOflo (DynFlags -> Width
wordWidth DynFlags
dflags))
translateOp DynFlags
dflags PrimOp
IntQuotOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordSQuot DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
IntRemOp        = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordSRem DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
IntNegOp        = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordSNeg DynFlags
dflags)


translateOp DynFlags
dflags PrimOp
IntGeOp        = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordSGe DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
IntLeOp        = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordSLe DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
IntGtOp        = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordSGt DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
IntLtOp        = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordSLt DynFlags
dflags)

translateOp DynFlags
dflags PrimOp
AndIOp         = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordAnd DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
OrIOp          = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordOr DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
XorIOp         = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordXor DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
NotIOp         = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordNot DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
ISllOp         = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordShl DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
ISraOp         = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordSShr DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
ISrlOp         = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordUShr DynFlags
dflags)

-- Native word unsigned ops

translateOp DynFlags
dflags PrimOp
WordGeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordUGe DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
WordLeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordULe DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
WordGtOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordUGt DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
WordLtOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordULt DynFlags
dflags)

translateOp DynFlags
dflags PrimOp
WordMulOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordMul DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
WordQuotOp     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordUQuot DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
WordRemOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordURem DynFlags
dflags)

translateOp DynFlags
dflags PrimOp
AddrGeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordUGe DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
AddrLeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordULe DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
AddrGtOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordUGt DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
AddrLtOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordULt DynFlags
dflags)

-- Int8# signed ops

translateOp DynFlags
dflags PrimOp
Int8Extend     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_SS_Conv Width
W8 (DynFlags -> Width
wordWidth DynFlags
dflags))
translateOp DynFlags
dflags PrimOp
Int8Narrow     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_SS_Conv (DynFlags -> Width
wordWidth DynFlags
dflags) Width
W8)
translateOp DynFlags
_      PrimOp
Int8NegOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Neg Width
W8)
translateOp DynFlags
_      PrimOp
Int8AddOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Add Width
W8)
translateOp DynFlags
_      PrimOp
Int8SubOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Sub Width
W8)
translateOp DynFlags
_      PrimOp
Int8MulOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Mul Width
W8)
translateOp DynFlags
_      PrimOp
Int8QuotOp     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Quot Width
W8)
translateOp DynFlags
_      PrimOp
Int8RemOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Rem Width
W8)

translateOp DynFlags
_      PrimOp
Int8EqOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Eq Width
W8)
translateOp DynFlags
_      PrimOp
Int8GeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Ge Width
W8)
translateOp DynFlags
_      PrimOp
Int8GtOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Gt Width
W8)
translateOp DynFlags
_      PrimOp
Int8LeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Le Width
W8)
translateOp DynFlags
_      PrimOp
Int8LtOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Lt Width
W8)
translateOp DynFlags
_      PrimOp
Int8NeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Ne Width
W8)

-- Word8# unsigned ops

translateOp DynFlags
dflags PrimOp
Word8Extend     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_UU_Conv Width
W8 (DynFlags -> Width
wordWidth DynFlags
dflags))
translateOp DynFlags
dflags PrimOp
Word8Narrow     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_UU_Conv (DynFlags -> Width
wordWidth DynFlags
dflags) Width
W8)
translateOp DynFlags
_      PrimOp
Word8NotOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Not Width
W8)
translateOp DynFlags
_      PrimOp
Word8AddOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Add Width
W8)
translateOp DynFlags
_      PrimOp
Word8SubOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Sub Width
W8)
translateOp DynFlags
_      PrimOp
Word8MulOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Mul Width
W8)
translateOp DynFlags
_      PrimOp
Word8QuotOp     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Quot Width
W8)
translateOp DynFlags
_      PrimOp
Word8RemOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Rem Width
W8)

translateOp DynFlags
_      PrimOp
Word8EqOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Eq Width
W8)
translateOp DynFlags
_      PrimOp
Word8GeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Ge Width
W8)
translateOp DynFlags
_      PrimOp
Word8GtOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Gt Width
W8)
translateOp DynFlags
_      PrimOp
Word8LeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Le Width
W8)
translateOp DynFlags
_      PrimOp
Word8LtOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Lt Width
W8)
translateOp DynFlags
_      PrimOp
Word8NeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Ne Width
W8)

-- Int16# signed ops

translateOp DynFlags
dflags PrimOp
Int16Extend     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_SS_Conv Width
W16 (DynFlags -> Width
wordWidth DynFlags
dflags))
translateOp DynFlags
dflags PrimOp
Int16Narrow     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_SS_Conv (DynFlags -> Width
wordWidth DynFlags
dflags) Width
W16)
translateOp DynFlags
_      PrimOp
Int16NegOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Neg Width
W16)
translateOp DynFlags
_      PrimOp
Int16AddOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Add Width
W16)
translateOp DynFlags
_      PrimOp
Int16SubOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Sub Width
W16)
translateOp DynFlags
_      PrimOp
Int16MulOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Mul Width
W16)
translateOp DynFlags
_      PrimOp
Int16QuotOp     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Quot Width
W16)
translateOp DynFlags
_      PrimOp
Int16RemOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Rem Width
W16)

translateOp DynFlags
_      PrimOp
Int16EqOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Eq Width
W16)
translateOp DynFlags
_      PrimOp
Int16GeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Ge Width
W16)
translateOp DynFlags
_      PrimOp
Int16GtOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Gt Width
W16)
translateOp DynFlags
_      PrimOp
Int16LeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Le Width
W16)
translateOp DynFlags
_      PrimOp
Int16LtOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_S_Lt Width
W16)
translateOp DynFlags
_      PrimOp
Int16NeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Ne Width
W16)

-- Word16# unsigned ops

translateOp DynFlags
dflags PrimOp
Word16Extend     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_UU_Conv Width
W16 (DynFlags -> Width
wordWidth DynFlags
dflags))
translateOp DynFlags
dflags PrimOp
Word16Narrow     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_UU_Conv (DynFlags -> Width
wordWidth DynFlags
dflags) Width
W16)
translateOp DynFlags
_      PrimOp
Word16NotOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Not Width
W16)
translateOp DynFlags
_      PrimOp
Word16AddOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Add Width
W16)
translateOp DynFlags
_      PrimOp
Word16SubOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Sub Width
W16)
translateOp DynFlags
_      PrimOp
Word16MulOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Mul Width
W16)
translateOp DynFlags
_      PrimOp
Word16QuotOp     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Quot Width
W16)
translateOp DynFlags
_      PrimOp
Word16RemOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Rem Width
W16)

translateOp DynFlags
_      PrimOp
Word16EqOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Eq Width
W16)
translateOp DynFlags
_      PrimOp
Word16GeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Ge Width
W16)
translateOp DynFlags
_      PrimOp
Word16GtOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Gt Width
W16)
translateOp DynFlags
_      PrimOp
Word16LeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Le Width
W16)
translateOp DynFlags
_      PrimOp
Word16LtOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Lt Width
W16)
translateOp DynFlags
_      PrimOp
Word16NeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Ne Width
W16)

-- Char# ops

translateOp DynFlags
dflags PrimOp
CharEqOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Eq (DynFlags -> Width
wordWidth DynFlags
dflags))
translateOp DynFlags
dflags PrimOp
CharNeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_Ne (DynFlags -> Width
wordWidth DynFlags
dflags))
translateOp DynFlags
dflags PrimOp
CharGeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Ge (DynFlags -> Width
wordWidth DynFlags
dflags))
translateOp DynFlags
dflags PrimOp
CharLeOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Le (DynFlags -> Width
wordWidth DynFlags
dflags))
translateOp DynFlags
dflags PrimOp
CharGtOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Gt (DynFlags -> Width
wordWidth DynFlags
dflags))
translateOp DynFlags
dflags PrimOp
CharLtOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_U_Lt (DynFlags -> Width
wordWidth DynFlags
dflags))

-- Double ops

translateOp DynFlags
_      PrimOp
DoubleEqOp     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Eq Width
W64)
translateOp DynFlags
_      PrimOp
DoubleNeOp     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Ne Width
W64)
translateOp DynFlags
_      PrimOp
DoubleGeOp     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Ge Width
W64)
translateOp DynFlags
_      PrimOp
DoubleLeOp     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Le Width
W64)
translateOp DynFlags
_      PrimOp
DoubleGtOp     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Gt Width
W64)
translateOp DynFlags
_      PrimOp
DoubleLtOp     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Lt Width
W64)

translateOp DynFlags
_      PrimOp
DoubleAddOp    = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Add Width
W64)
translateOp DynFlags
_      PrimOp
DoubleSubOp    = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Sub Width
W64)
translateOp DynFlags
_      PrimOp
DoubleMulOp    = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Mul Width
W64)
translateOp DynFlags
_      PrimOp
DoubleDivOp    = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Quot Width
W64)
translateOp DynFlags
_      PrimOp
DoubleNegOp    = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Neg Width
W64)

-- Float ops

translateOp DynFlags
_      PrimOp
FloatEqOp     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Eq Width
W32)
translateOp DynFlags
_      PrimOp
FloatNeOp     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Ne Width
W32)
translateOp DynFlags
_      PrimOp
FloatGeOp     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Ge Width
W32)
translateOp DynFlags
_      PrimOp
FloatLeOp     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Le Width
W32)
translateOp DynFlags
_      PrimOp
FloatGtOp     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Gt Width
W32)
translateOp DynFlags
_      PrimOp
FloatLtOp     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Lt Width
W32)

translateOp DynFlags
_      PrimOp
FloatAddOp    = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Add  Width
W32)
translateOp DynFlags
_      PrimOp
FloatSubOp    = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Sub  Width
W32)
translateOp DynFlags
_      PrimOp
FloatMulOp    = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Mul  Width
W32)
translateOp DynFlags
_      PrimOp
FloatDivOp    = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Quot Width
W32)
translateOp DynFlags
_      PrimOp
FloatNegOp    = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> MachOp
MO_F_Neg  Width
W32)

-- Vector ops

translateOp DynFlags
_ (VecAddOp PrimOpVecCat
FloatVec Int
n Width
w) = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Int -> Width -> MachOp
MO_VF_Add  Int
n Width
w)
translateOp DynFlags
_ (VecSubOp PrimOpVecCat
FloatVec Int
n Width
w) = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Int -> Width -> MachOp
MO_VF_Sub  Int
n Width
w)
translateOp DynFlags
_ (VecMulOp PrimOpVecCat
FloatVec Int
n Width
w) = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Int -> Width -> MachOp
MO_VF_Mul  Int
n Width
w)
translateOp DynFlags
_ (VecDivOp PrimOpVecCat
FloatVec Int
n Width
w) = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Int -> Width -> MachOp
MO_VF_Quot Int
n Width
w)
translateOp DynFlags
_ (VecNegOp PrimOpVecCat
FloatVec Int
n Width
w) = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Int -> Width -> MachOp
MO_VF_Neg  Int
n Width
w)

translateOp DynFlags
_ (VecAddOp  PrimOpVecCat
IntVec Int
n Width
w) = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Int -> Width -> MachOp
MO_V_Add   Int
n Width
w)
translateOp DynFlags
_ (VecSubOp  PrimOpVecCat
IntVec Int
n Width
w) = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Int -> Width -> MachOp
MO_V_Sub   Int
n Width
w)
translateOp DynFlags
_ (VecMulOp  PrimOpVecCat
IntVec Int
n Width
w) = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Int -> Width -> MachOp
MO_V_Mul   Int
n Width
w)
translateOp DynFlags
_ (VecQuotOp PrimOpVecCat
IntVec Int
n Width
w) = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Int -> Width -> MachOp
MO_VS_Quot Int
n Width
w)
translateOp DynFlags
_ (VecRemOp  PrimOpVecCat
IntVec Int
n Width
w) = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Int -> Width -> MachOp
MO_VS_Rem  Int
n Width
w)
translateOp DynFlags
_ (VecNegOp  PrimOpVecCat
IntVec Int
n Width
w) = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Int -> Width -> MachOp
MO_VS_Neg  Int
n Width
w)

translateOp DynFlags
_ (VecAddOp  PrimOpVecCat
WordVec Int
n Width
w) = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Int -> Width -> MachOp
MO_V_Add   Int
n Width
w)
translateOp DynFlags
_ (VecSubOp  PrimOpVecCat
WordVec Int
n Width
w) = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Int -> Width -> MachOp
MO_V_Sub   Int
n Width
w)
translateOp DynFlags
_ (VecMulOp  PrimOpVecCat
WordVec Int
n Width
w) = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Int -> Width -> MachOp
MO_V_Mul   Int
n Width
w)
translateOp DynFlags
_ (VecQuotOp PrimOpVecCat
WordVec Int
n Width
w) = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Int -> Width -> MachOp
MO_VU_Quot Int
n Width
w)
translateOp DynFlags
_ (VecRemOp  PrimOpVecCat
WordVec Int
n Width
w) = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Int -> Width -> MachOp
MO_VU_Rem  Int
n Width
w)

-- Conversions

translateOp DynFlags
dflags PrimOp
Int2DoubleOp   = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_SF_Conv (DynFlags -> Width
wordWidth DynFlags
dflags) Width
W64)
translateOp DynFlags
dflags PrimOp
Double2IntOp   = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_FS_Conv Width
W64 (DynFlags -> Width
wordWidth DynFlags
dflags))

translateOp DynFlags
dflags PrimOp
Int2FloatOp    = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_SF_Conv (DynFlags -> Width
wordWidth DynFlags
dflags) Width
W32)
translateOp DynFlags
dflags PrimOp
Float2IntOp    = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_FS_Conv Width
W32 (DynFlags -> Width
wordWidth DynFlags
dflags))

translateOp DynFlags
_      PrimOp
Float2DoubleOp = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_FF_Conv Width
W32 Width
W64)
translateOp DynFlags
_      PrimOp
Double2FloatOp = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_FF_Conv Width
W64 Width
W32)

-- Word comparisons masquerading as more exotic things.

translateOp DynFlags
dflags PrimOp
SameMutVarOp           = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
SameMVarOp             = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
SameMutableArrayOp     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
SameMutableByteArrayOp = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
SameMutableArrayArrayOp= MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
SameSmallMutableArrayOp= MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
SameTVarOp             = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)
translateOp DynFlags
dflags PrimOp
EqStablePtrOp          = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)
-- See Note [Comparing stable names]
translateOp DynFlags
dflags PrimOp
EqStableNameOp         = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)

translateOp DynFlags
_      PrimOp
_ = Maybe MachOp
forall a. Maybe a
Nothing

-- Note [Comparing stable names]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- A StableName# is actually a pointer to a stable name object (SNO)
-- containing an index into the stable name table (SNT). We
-- used to compare StableName#s by following the pointers to the
-- SNOs and checking whether they held the same SNT indices. However,
-- this is not necessary: there is a one-to-one correspondence
-- between SNOs and entries in the SNT, so simple pointer equality
-- does the trick.

-- These primops are implemented by CallishMachOps, because they sometimes
-- turn into foreign calls depending on the backend.

callishOp :: PrimOp -> Maybe CallishMachOp
callishOp :: PrimOp -> Maybe CallishMachOp
callishOp PrimOp
DoublePowerOp  = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F64_Pwr
callishOp PrimOp
DoubleSinOp    = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F64_Sin
callishOp PrimOp
DoubleCosOp    = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F64_Cos
callishOp PrimOp
DoubleTanOp    = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F64_Tan
callishOp PrimOp
DoubleSinhOp   = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F64_Sinh
callishOp PrimOp
DoubleCoshOp   = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F64_Cosh
callishOp PrimOp
DoubleTanhOp   = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F64_Tanh
callishOp PrimOp
DoubleAsinOp   = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F64_Asin
callishOp PrimOp
DoubleAcosOp   = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F64_Acos
callishOp PrimOp
DoubleAtanOp   = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F64_Atan
callishOp PrimOp
DoubleAsinhOp  = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F64_Asinh
callishOp PrimOp
DoubleAcoshOp  = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F64_Acosh
callishOp PrimOp
DoubleAtanhOp  = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F64_Atanh
callishOp PrimOp
DoubleLogOp    = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F64_Log
callishOp PrimOp
DoubleExpOp    = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F64_Exp
callishOp PrimOp
DoubleSqrtOp   = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F64_Sqrt

callishOp PrimOp
FloatPowerOp  = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F32_Pwr
callishOp PrimOp
FloatSinOp    = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F32_Sin
callishOp PrimOp
FloatCosOp    = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F32_Cos
callishOp PrimOp
FloatTanOp    = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F32_Tan
callishOp PrimOp
FloatSinhOp   = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F32_Sinh
callishOp PrimOp
FloatCoshOp   = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F32_Cosh
callishOp PrimOp
FloatTanhOp   = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F32_Tanh
callishOp PrimOp
FloatAsinOp   = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F32_Asin
callishOp PrimOp
FloatAcosOp   = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F32_Acos
callishOp PrimOp
FloatAtanOp   = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F32_Atan
callishOp PrimOp
FloatAsinhOp  = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F32_Asinh
callishOp PrimOp
FloatAcoshOp  = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F32_Acosh
callishOp PrimOp
FloatAtanhOp  = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F32_Atanh
callishOp PrimOp
FloatLogOp    = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F32_Log
callishOp PrimOp
FloatExpOp    = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F32_Exp
callishOp PrimOp
FloatSqrtOp   = CallishMachOp -> Maybe CallishMachOp
forall a. a -> Maybe a
Just CallishMachOp
MO_F32_Sqrt

callishOp PrimOp
_ = Maybe CallishMachOp
forall a. Maybe a
Nothing

------------------------------------------------------------------------------
-- Helpers for translating various minor variants of array indexing.

doIndexOffAddrOp :: Maybe MachOp
                 -> CmmType
                 -> [LocalReg]
                 -> [CmmExpr]
                 -> FCode ()
doIndexOffAddrOp :: Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp Maybe MachOp
maybe_post_read_cast CmmType
rep [LocalReg
res] [CmmExpr
addr,CmmExpr
idx]
   = Int
-> Maybe MachOp
-> CmmType
-> LocalReg
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
mkBasicIndexedRead Int
0 Maybe MachOp
maybe_post_read_cast CmmType
rep LocalReg
res CmmExpr
addr CmmType
rep CmmExpr
idx
doIndexOffAddrOp Maybe MachOp
_ CmmType
_ [LocalReg]
_ [CmmExpr]
_
   = String -> FCode ()
forall a. String -> a
panic String
"StgCmmPrim: doIndexOffAddrOp"

doIndexOffAddrOpAs :: Maybe MachOp
                   -> CmmType
                   -> CmmType
                   -> [LocalReg]
                   -> [CmmExpr]
                   -> FCode ()
doIndexOffAddrOpAs :: Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOpAs Maybe MachOp
maybe_post_read_cast CmmType
rep CmmType
idx_rep [LocalReg
res] [CmmExpr
addr,CmmExpr
idx]
   = Int
-> Maybe MachOp
-> CmmType
-> LocalReg
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
mkBasicIndexedRead Int
0 Maybe MachOp
maybe_post_read_cast CmmType
rep LocalReg
res CmmExpr
addr CmmType
idx_rep CmmExpr
idx
doIndexOffAddrOpAs Maybe MachOp
_ CmmType
_ CmmType
_ [LocalReg]
_ [CmmExpr]
_
   = String -> FCode ()
forall a. String -> a
panic String
"StgCmmPrim: doIndexOffAddrOpAs"

doIndexByteArrayOp :: Maybe MachOp
                   -> CmmType
                   -> [LocalReg]
                   -> [CmmExpr]
                   -> FCode ()
doIndexByteArrayOp :: Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp Maybe MachOp
maybe_post_read_cast CmmType
rep [LocalReg
res] [CmmExpr
addr,CmmExpr
idx]
   = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        Int
-> Maybe MachOp
-> CmmType
-> LocalReg
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
mkBasicIndexedRead (DynFlags -> Int
arrWordsHdrSize DynFlags
dflags) Maybe MachOp
maybe_post_read_cast CmmType
rep LocalReg
res CmmExpr
addr CmmType
rep CmmExpr
idx
doIndexByteArrayOp Maybe MachOp
_ CmmType
_ [LocalReg]
_ [CmmExpr]
_
   = String -> FCode ()
forall a. String -> a
panic String
"StgCmmPrim: doIndexByteArrayOp"

doIndexByteArrayOpAs :: Maybe MachOp
                    -> CmmType
                    -> CmmType
                    -> [LocalReg]
                    -> [CmmExpr]
                    -> FCode ()
doIndexByteArrayOpAs :: Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs Maybe MachOp
maybe_post_read_cast CmmType
rep CmmType
idx_rep [LocalReg
res] [CmmExpr
addr,CmmExpr
idx]
   = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        Int
-> Maybe MachOp
-> CmmType
-> LocalReg
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
mkBasicIndexedRead (DynFlags -> Int
arrWordsHdrSize DynFlags
dflags) Maybe MachOp
maybe_post_read_cast CmmType
rep LocalReg
res CmmExpr
addr CmmType
idx_rep CmmExpr
idx
doIndexByteArrayOpAs Maybe MachOp
_ CmmType
_ CmmType
_ [LocalReg]
_ [CmmExpr]
_
   = String -> FCode ()
forall a. String -> a
panic String
"StgCmmPrim: doIndexByteArrayOpAs"

doReadPtrArrayOp :: LocalReg
                 -> CmmExpr
                 -> CmmExpr
                 -> FCode ()
doReadPtrArrayOp :: LocalReg -> CmmExpr -> CmmExpr -> FCode ()
doReadPtrArrayOp LocalReg
res CmmExpr
addr CmmExpr
idx
   = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        Int
-> Maybe MachOp
-> CmmType
-> LocalReg
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
mkBasicIndexedRead (DynFlags -> Int
arrPtrsHdrSize DynFlags
dflags) Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
gcWord DynFlags
dflags) LocalReg
res CmmExpr
addr (DynFlags -> CmmType
gcWord DynFlags
dflags) CmmExpr
idx

doWriteOffAddrOp :: Maybe MachOp
                 -> CmmType
                 -> [LocalReg]
                 -> [CmmExpr]
                 -> FCode ()
doWriteOffAddrOp :: Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
maybe_pre_write_cast CmmType
idx_ty [] [CmmExpr
addr,CmmExpr
idx,CmmExpr
val]
   = Int
-> Maybe MachOp
-> CmmExpr
-> CmmType
-> CmmExpr
-> CmmExpr
-> FCode ()
mkBasicIndexedWrite Int
0 Maybe MachOp
maybe_pre_write_cast CmmExpr
addr CmmType
idx_ty CmmExpr
idx CmmExpr
val
doWriteOffAddrOp Maybe MachOp
_ CmmType
_ [LocalReg]
_ [CmmExpr]
_
   = String -> FCode ()
forall a. String -> a
panic String
"StgCmmPrim: doWriteOffAddrOp"

doWriteByteArrayOp :: Maybe MachOp
                   -> CmmType
                   -> [LocalReg]
                   -> [CmmExpr]
                   -> FCode ()
doWriteByteArrayOp :: Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
maybe_pre_write_cast CmmType
idx_ty [] [CmmExpr
addr,CmmExpr
idx,CmmExpr
val]
   = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        Int
-> Maybe MachOp
-> CmmExpr
-> CmmType
-> CmmExpr
-> CmmExpr
-> FCode ()
mkBasicIndexedWrite (DynFlags -> Int
arrWordsHdrSize DynFlags
dflags) Maybe MachOp
maybe_pre_write_cast CmmExpr
addr CmmType
idx_ty CmmExpr
idx CmmExpr
val
doWriteByteArrayOp Maybe MachOp
_ CmmType
_ [LocalReg]
_ [CmmExpr]
_
   = String -> FCode ()
forall a. String -> a
panic String
"StgCmmPrim: doWriteByteArrayOp"

doWritePtrArrayOp :: CmmExpr
                  -> CmmExpr
                  -> CmmExpr
                  -> FCode ()
doWritePtrArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doWritePtrArrayOp CmmExpr
addr CmmExpr
idx CmmExpr
val
  = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
       let ty :: CmmType
ty = DynFlags -> CmmExpr -> CmmType
cmmExprType DynFlags
dflags CmmExpr
val
       -- This write barrier is to ensure that the heap writes to the object
       -- referred to by val have happened before we write val into the array.
       -- See #12469 for details.
       [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [] CallishMachOp
MO_WriteBarrier []
       Int
-> Maybe MachOp
-> CmmExpr
-> CmmType
-> CmmExpr
-> CmmExpr
-> FCode ()
mkBasicIndexedWrite (DynFlags -> Int
arrPtrsHdrSize DynFlags
dflags) Maybe MachOp
forall a. Maybe a
Nothing CmmExpr
addr CmmType
ty CmmExpr
idx CmmExpr
val
       CmmAGraph -> FCode ()
emit (CmmExpr -> CmmExpr -> CmmAGraph
setInfo CmmExpr
addr (CmmLit -> CmmExpr
CmmLit (CLabel -> CmmLit
CmmLabel CLabel
mkMAP_DIRTY_infoLabel)))
  -- the write barrier.  We must write a byte into the mark table:
  -- bits8[a + header_size + StgMutArrPtrs_size(a) + x >> N]
       CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ CmmExpr -> CmmExpr -> CmmAGraph
mkStore (
         DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExpr DynFlags
dflags
          (DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExprW DynFlags
dflags (DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetB DynFlags
dflags CmmExpr
addr (DynFlags -> Int
arrPtrsHdrSize DynFlags
dflags))
                         (DynFlags -> CmmExpr -> CmmExpr
loadArrPtrsSize DynFlags
dflags CmmExpr
addr))
          (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (DynFlags -> MachOp
mo_wordUShr DynFlags
dflags) [CmmExpr
idx,
                                           DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (DynFlags -> Int
mUT_ARR_PTRS_CARD_BITS DynFlags
dflags)])
         ) (CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
1 Width
W8))

loadArrPtrsSize :: DynFlags -> CmmExpr -> CmmExpr
loadArrPtrsSize :: DynFlags -> CmmExpr -> CmmExpr
loadArrPtrsSize DynFlags
dflags CmmExpr
addr = CmmExpr -> CmmType -> CmmExpr
CmmLoad (DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetB DynFlags
dflags CmmExpr
addr Int
off) (DynFlags -> CmmType
bWord DynFlags
dflags)
 where off :: Int
off = DynFlags -> Int
fixedHdrSize DynFlags
dflags Int -> Int -> Int
forall a. Num a => a -> a -> a
+ DynFlags -> Int
oFFSET_StgMutArrPtrs_ptrs DynFlags
dflags

mkBasicIndexedRead :: ByteOff      -- Initial offset in bytes
                   -> Maybe MachOp -- Optional result cast
                   -> CmmType      -- Type of element we are accessing
                   -> LocalReg     -- Destination
                   -> CmmExpr      -- Base address
                   -> CmmType      -- Type of element by which we are indexing
                   -> CmmExpr      -- Index
                   -> FCode ()
mkBasicIndexedRead :: Int
-> Maybe MachOp
-> CmmType
-> LocalReg
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
mkBasicIndexedRead Int
off Maybe MachOp
Nothing CmmType
ty LocalReg
res CmmExpr
base CmmType
idx_ty CmmExpr
idx
   = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (DynFlags
-> Int -> CmmType -> CmmExpr -> CmmType -> CmmExpr -> CmmExpr
cmmLoadIndexOffExpr DynFlags
dflags Int
off CmmType
ty CmmExpr
base CmmType
idx_ty CmmExpr
idx)
mkBasicIndexedRead Int
off (Just MachOp
cast) CmmType
ty LocalReg
res CmmExpr
base CmmType
idx_ty CmmExpr
idx
   = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
cast [
                                   DynFlags
-> Int -> CmmType -> CmmExpr -> CmmType -> CmmExpr -> CmmExpr
cmmLoadIndexOffExpr DynFlags
dflags Int
off CmmType
ty CmmExpr
base CmmType
idx_ty CmmExpr
idx])

mkBasicIndexedWrite :: ByteOff      -- Initial offset in bytes
                    -> Maybe MachOp -- Optional value cast
                    -> CmmExpr      -- Base address
                    -> CmmType      -- Type of element by which we are indexing
                    -> CmmExpr      -- Index
                    -> CmmExpr      -- Value to write
                    -> FCode ()
mkBasicIndexedWrite :: Int
-> Maybe MachOp
-> CmmExpr
-> CmmType
-> CmmExpr
-> CmmExpr
-> FCode ()
mkBasicIndexedWrite Int
off Maybe MachOp
Nothing CmmExpr
base CmmType
idx_ty CmmExpr
idx CmmExpr
val
   = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        CmmExpr -> CmmExpr -> FCode ()
emitStore (DynFlags -> Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr
cmmIndexOffExpr DynFlags
dflags Int
off (CmmType -> Width
typeWidth CmmType
idx_ty) CmmExpr
base CmmExpr
idx) CmmExpr
val
mkBasicIndexedWrite Int
off (Just MachOp
cast) CmmExpr
base CmmType
idx_ty CmmExpr
idx CmmExpr
val
   = Int
-> Maybe MachOp
-> CmmExpr
-> CmmType
-> CmmExpr
-> CmmExpr
-> FCode ()
mkBasicIndexedWrite Int
off Maybe MachOp
forall a. Maybe a
Nothing CmmExpr
base CmmType
idx_ty CmmExpr
idx (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
cast [CmmExpr
val])

-- ----------------------------------------------------------------------------
-- Misc utils

cmmIndexOffExpr :: DynFlags
                -> ByteOff  -- Initial offset in bytes
                -> Width    -- Width of element by which we are indexing
                -> CmmExpr  -- Base address
                -> CmmExpr  -- Index
                -> CmmExpr
cmmIndexOffExpr :: DynFlags -> Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr
cmmIndexOffExpr DynFlags
dflags Int
off Width
width CmmExpr
base CmmExpr
idx
   = DynFlags -> Width -> CmmExpr -> CmmExpr -> CmmExpr
cmmIndexExpr DynFlags
dflags Width
width (DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetB DynFlags
dflags CmmExpr
base Int
off) CmmExpr
idx

cmmLoadIndexOffExpr :: DynFlags
                    -> ByteOff  -- Initial offset in bytes
                    -> CmmType  -- Type of element we are accessing
                    -> CmmExpr  -- Base address
                    -> CmmType  -- Type of element by which we are indexing
                    -> CmmExpr  -- Index
                    -> CmmExpr
cmmLoadIndexOffExpr :: DynFlags
-> Int -> CmmType -> CmmExpr -> CmmType -> CmmExpr -> CmmExpr
cmmLoadIndexOffExpr DynFlags
dflags Int
off CmmType
ty CmmExpr
base CmmType
idx_ty CmmExpr
idx
   = CmmExpr -> CmmType -> CmmExpr
CmmLoad (DynFlags -> Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr
cmmIndexOffExpr DynFlags
dflags Int
off (CmmType -> Width
typeWidth CmmType
idx_ty) CmmExpr
base CmmExpr
idx) CmmType
ty

setInfo :: CmmExpr -> CmmExpr -> CmmAGraph
setInfo :: CmmExpr -> CmmExpr -> CmmAGraph
setInfo CmmExpr
closure_ptr CmmExpr
info_ptr = CmmExpr -> CmmExpr -> CmmAGraph
mkStore CmmExpr
closure_ptr CmmExpr
info_ptr

------------------------------------------------------------------------------
-- Helpers for translating vector primops.

vecVmmType :: PrimOpVecCat -> Length -> Width -> CmmType
vecVmmType :: PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
pocat Int
n Width
w = Int -> CmmType -> CmmType
vec Int
n (PrimOpVecCat -> Width -> CmmType
vecCmmCat PrimOpVecCat
pocat Width
w)

vecCmmCat :: PrimOpVecCat -> Width -> CmmType
vecCmmCat :: PrimOpVecCat -> Width -> CmmType
vecCmmCat PrimOpVecCat
IntVec   = Width -> CmmType
cmmBits
vecCmmCat PrimOpVecCat
WordVec  = Width -> CmmType
cmmBits
vecCmmCat PrimOpVecCat
FloatVec = Width -> CmmType
cmmFloat

vecElemInjectCast :: DynFlags -> PrimOpVecCat -> Width -> Maybe MachOp
vecElemInjectCast :: DynFlags -> PrimOpVecCat -> Width -> Maybe MachOp
vecElemInjectCast DynFlags
_      PrimOpVecCat
FloatVec Width
_   =  Maybe MachOp
forall a. Maybe a
Nothing
vecElemInjectCast DynFlags
dflags PrimOpVecCat
IntVec   Width
W8  =  MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo8  DynFlags
dflags)
vecElemInjectCast DynFlags
dflags PrimOpVecCat
IntVec   Width
W16 =  MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo16 DynFlags
dflags)
vecElemInjectCast DynFlags
dflags PrimOpVecCat
IntVec   Width
W32 =  MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo32 DynFlags
dflags)
vecElemInjectCast DynFlags
_      PrimOpVecCat
IntVec   Width
W64 =  Maybe MachOp
forall a. Maybe a
Nothing
vecElemInjectCast DynFlags
dflags PrimOpVecCat
WordVec  Width
W8  =  MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo8  DynFlags
dflags)
vecElemInjectCast DynFlags
dflags PrimOpVecCat
WordVec  Width
W16 =  MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo16 DynFlags
dflags)
vecElemInjectCast DynFlags
dflags PrimOpVecCat
WordVec  Width
W32 =  MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_WordTo32 DynFlags
dflags)
vecElemInjectCast DynFlags
_      PrimOpVecCat
WordVec  Width
W64 =  Maybe MachOp
forall a. Maybe a
Nothing
vecElemInjectCast DynFlags
_      PrimOpVecCat
_        Width
_   =  Maybe MachOp
forall a. Maybe a
Nothing

vecElemProjectCast :: DynFlags -> PrimOpVecCat -> Width -> Maybe MachOp
vecElemProjectCast :: DynFlags -> PrimOpVecCat -> Width -> Maybe MachOp
vecElemProjectCast DynFlags
_      PrimOpVecCat
FloatVec Width
_   =  Maybe MachOp
forall a. Maybe a
Nothing
vecElemProjectCast DynFlags
dflags PrimOpVecCat
IntVec   Width
W8  =  MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_8ToWord  DynFlags
dflags)
vecElemProjectCast DynFlags
dflags PrimOpVecCat
IntVec   Width
W16 =  MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_16ToWord DynFlags
dflags)
vecElemProjectCast DynFlags
dflags PrimOpVecCat
IntVec   Width
W32 =  MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_32ToWord DynFlags
dflags)
vecElemProjectCast DynFlags
_      PrimOpVecCat
IntVec   Width
W64 =  Maybe MachOp
forall a. Maybe a
Nothing
vecElemProjectCast DynFlags
dflags PrimOpVecCat
WordVec  Width
W8  =  MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_8ToWord  DynFlags
dflags)
vecElemProjectCast DynFlags
dflags PrimOpVecCat
WordVec  Width
W16 =  MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_16ToWord DynFlags
dflags)
vecElemProjectCast DynFlags
dflags PrimOpVecCat
WordVec  Width
W32 =  MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_32ToWord DynFlags
dflags)
vecElemProjectCast DynFlags
_      PrimOpVecCat
WordVec  Width
W64 =  Maybe MachOp
forall a. Maybe a
Nothing
vecElemProjectCast DynFlags
_      PrimOpVecCat
_        Width
_   =  Maybe MachOp
forall a. Maybe a
Nothing

-- Check to make sure that we can generate code for the specified vector type
-- given the current set of dynamic flags.
checkVecCompatibility :: DynFlags -> PrimOpVecCat -> Length -> Width -> FCode ()
checkVecCompatibility :: DynFlags -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility DynFlags
dflags PrimOpVecCat
vcat Int
l Width
w = do
    Bool -> FCode () -> FCode ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DynFlags -> HscTarget
hscTarget DynFlags
dflags HscTarget -> HscTarget -> Bool
forall a. Eq a => a -> a -> Bool
/= HscTarget
HscLlvm) (FCode () -> FCode ()) -> FCode () -> FCode ()
forall a b. (a -> b) -> a -> b
$ do
        String -> FCode ()
forall a. String -> a
sorry (String -> FCode ()) -> String -> FCode ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String
"SIMD vector instructions require the LLVM back-end."
                         ,String
"Please use -fllvm."]
    Width -> PrimOpVecCat -> Int -> Width -> FCode ()
check Width
vecWidth PrimOpVecCat
vcat Int
l Width
w
  where
    check :: Width -> PrimOpVecCat -> Length -> Width -> FCode ()
    check :: Width -> PrimOpVecCat -> Int -> Width -> FCode ()
check Width
W128 PrimOpVecCat
FloatVec Int
4 Width
W32 | Bool -> Bool
not (DynFlags -> Bool
isSseEnabled DynFlags
dflags) =
        String -> FCode ()
forall a. String -> a
sorry (String -> FCode ()) -> String -> FCode ()
forall a b. (a -> b) -> a -> b
$ String
"128-bit wide single-precision floating point " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                String
"SIMD vector instructions require at least -msse."
    check Width
W128 PrimOpVecCat
_ Int
_ Width
_ | Bool -> Bool
not (DynFlags -> Bool
isSse2Enabled DynFlags
dflags) =
        String -> FCode ()
forall a. String -> a
sorry (String -> FCode ()) -> String -> FCode ()
forall a b. (a -> b) -> a -> b
$ String
"128-bit wide integer and double precision " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                String
"SIMD vector instructions require at least -msse2."
    check Width
W256 PrimOpVecCat
FloatVec Int
_ Width
_ | Bool -> Bool
not (DynFlags -> Bool
isAvxEnabled DynFlags
dflags) =
        String -> FCode ()
forall a. String -> a
sorry (String -> FCode ()) -> String -> FCode ()
forall a b. (a -> b) -> a -> b
$ String
"256-bit wide floating point " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                String
"SIMD vector instructions require at least -mavx."
    check Width
W256 PrimOpVecCat
_ Int
_ Width
_ | Bool -> Bool
not (DynFlags -> Bool
isAvx2Enabled DynFlags
dflags) =
        String -> FCode ()
forall a. String -> a
sorry (String -> FCode ()) -> String -> FCode ()
forall a b. (a -> b) -> a -> b
$ String
"256-bit wide integer " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                String
"SIMD vector instructions require at least -mavx2."
    check Width
W512 PrimOpVecCat
_ Int
_ Width
_ | Bool -> Bool
not (DynFlags -> Bool
isAvx512fEnabled DynFlags
dflags) =
        String -> FCode ()
forall a. String -> a
sorry (String -> FCode ()) -> String -> FCode ()
forall a b. (a -> b) -> a -> b
$ String
"512-bit wide " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                String
"SIMD vector instructions require -mavx512f."
    check Width
_ PrimOpVecCat
_ Int
_ Width
_ = () -> FCode ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    vecWidth :: Width
vecWidth = CmmType -> Width
typeWidth (PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
l Width
w)

------------------------------------------------------------------------------
-- Helpers for translating vector packing and unpacking.

doVecPackOp :: Maybe MachOp  -- Cast from element to vector component
            -> CmmType       -- Type of vector
            -> CmmExpr       -- Initial vector
            -> [CmmExpr]     -- Elements
            -> CmmFormal     -- Destination for result
            -> FCode ()
doVecPackOp :: Maybe MachOp
-> CmmType -> CmmExpr -> [CmmExpr] -> LocalReg -> FCode ()
doVecPackOp Maybe MachOp
maybe_pre_write_cast CmmType
ty CmmExpr
z [CmmExpr]
es LocalReg
res = do
    LocalReg
dst <- CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp CmmType
ty
    CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
dst) CmmExpr
z
    LocalReg -> [CmmExpr] -> Int -> FCode ()
vecPack LocalReg
dst [CmmExpr]
es Int
0
  where
    vecPack :: CmmFormal -> [CmmExpr] -> Int -> FCode ()
    vecPack :: LocalReg -> [CmmExpr] -> Int -> FCode ()
vecPack LocalReg
src [] Int
_ =
        CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
src))

    vecPack LocalReg
src (CmmExpr
e : [CmmExpr]
es) Int
i = do
        LocalReg
dst <- CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp CmmType
ty
        if CmmType -> Bool
isFloatType (CmmType -> CmmType
vecElemType CmmType
ty)
          then CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
dst) (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Int -> Width -> MachOp
MO_VF_Insert Int
len Width
wid)
                                                    [CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
src), CmmExpr -> CmmExpr
cast CmmExpr
e, CmmExpr
iLit])
          else CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
dst) (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Int -> Width -> MachOp
MO_V_Insert Int
len Width
wid)
                                                    [CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
src), CmmExpr -> CmmExpr
cast CmmExpr
e, CmmExpr
iLit])
        LocalReg -> [CmmExpr] -> Int -> FCode ()
vecPack LocalReg
dst [CmmExpr]
es (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      where
        -- vector indices are always 32-bits
        iLit :: CmmExpr
iLit = CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
i) Width
W32)

    cast :: CmmExpr -> CmmExpr
    cast :: CmmExpr -> CmmExpr
cast CmmExpr
val = case Maybe MachOp
maybe_pre_write_cast of
                 Maybe MachOp
Nothing   -> CmmExpr
val
                 Just MachOp
cast -> MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
cast [CmmExpr
val]

    len :: Length
    len :: Int
len = CmmType -> Int
vecLength CmmType
ty

    wid :: Width
    wid :: Width
wid = CmmType -> Width
typeWidth (CmmType -> CmmType
vecElemType CmmType
ty)

doVecUnpackOp :: Maybe MachOp  -- Cast from vector component to element result
              -> CmmType       -- Type of vector
              -> CmmExpr       -- Vector
              -> [CmmFormal]   -- Element results
              -> FCode ()
doVecUnpackOp :: Maybe MachOp -> CmmType -> CmmExpr -> [LocalReg] -> FCode ()
doVecUnpackOp Maybe MachOp
maybe_post_read_cast CmmType
ty CmmExpr
e [LocalReg]
res =
    [LocalReg] -> Int -> FCode ()
vecUnpack [LocalReg]
res Int
0
  where
    vecUnpack :: [CmmFormal] -> Int -> FCode ()
    vecUnpack :: [LocalReg] -> Int -> FCode ()
vecUnpack [] Int
_ =
        () -> FCode ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    vecUnpack (LocalReg
r : [LocalReg]
rs) Int
i = do
        if CmmType -> Bool
isFloatType (CmmType -> CmmType
vecElemType CmmType
ty)
          then CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
r) (CmmExpr -> CmmExpr
cast (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Int -> Width -> MachOp
MO_VF_Extract Int
len Width
wid)
                                             [CmmExpr
e, CmmExpr
iLit]))
          else CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
r) (CmmExpr -> CmmExpr
cast (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Int -> Width -> MachOp
MO_V_Extract Int
len Width
wid)
                                             [CmmExpr
e, CmmExpr
iLit]))
        [LocalReg] -> Int -> FCode ()
vecUnpack [LocalReg]
rs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      where
        -- vector indices are always 32-bits
        iLit :: CmmExpr
iLit = CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
i) Width
W32)

    cast :: CmmExpr -> CmmExpr
    cast :: CmmExpr -> CmmExpr
cast CmmExpr
val = case Maybe MachOp
maybe_post_read_cast of
                 Maybe MachOp
Nothing   -> CmmExpr
val
                 Just MachOp
cast -> MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
cast [CmmExpr
val]

    len :: Length
    len :: Int
len = CmmType -> Int
vecLength CmmType
ty

    wid :: Width
    wid :: Width
wid = CmmType -> Width
typeWidth (CmmType -> CmmType
vecElemType CmmType
ty)

doVecInsertOp :: Maybe MachOp  -- Cast from element to vector component
              -> CmmType       -- Vector type
              -> CmmExpr       -- Source vector
              -> CmmExpr       -- Element
              -> CmmExpr       -- Index at which to insert element
              -> CmmFormal     -- Destination for result
              -> FCode ()
doVecInsertOp :: Maybe MachOp
-> CmmType -> CmmExpr -> CmmExpr -> CmmExpr -> LocalReg -> FCode ()
doVecInsertOp Maybe MachOp
maybe_pre_write_cast CmmType
ty CmmExpr
src CmmExpr
e CmmExpr
idx LocalReg
res = do
    DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    -- vector indices are always 32-bits
    let idx' :: CmmExpr
        idx' :: CmmExpr
idx' = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> Width -> MachOp
MO_SS_Conv (DynFlags -> Width
wordWidth DynFlags
dflags) Width
W32) [CmmExpr
idx]
    if CmmType -> Bool
isFloatType (CmmType -> CmmType
vecElemType CmmType
ty)
      then CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Int -> Width -> MachOp
MO_VF_Insert Int
len Width
wid) [CmmExpr
src, CmmExpr -> CmmExpr
cast CmmExpr
e, CmmExpr
idx'])
      else CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Int -> Width -> MachOp
MO_V_Insert Int
len Width
wid) [CmmExpr
src, CmmExpr -> CmmExpr
cast CmmExpr
e, CmmExpr
idx'])
  where
    cast :: CmmExpr -> CmmExpr
    cast :: CmmExpr -> CmmExpr
cast CmmExpr
val = case Maybe MachOp
maybe_pre_write_cast of
                 Maybe MachOp
Nothing   -> CmmExpr
val
                 Just MachOp
cast -> MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
cast [CmmExpr
val]

    len :: Length
    len :: Int
len = CmmType -> Int
vecLength CmmType
ty

    wid :: Width
    wid :: Width
wid = CmmType -> Width
typeWidth (CmmType -> CmmType
vecElemType CmmType
ty)

------------------------------------------------------------------------------
-- Helpers for translating prefetching.


-- | Translate byte array prefetch operations into proper primcalls.
doPrefetchByteArrayOp :: Int
                      -> [CmmExpr]
                      -> FCode ()
doPrefetchByteArrayOp :: Int -> [CmmExpr] -> FCode ()
doPrefetchByteArrayOp Int
locality  [CmmExpr
addr,CmmExpr
idx]
   = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        Int -> Int -> CmmExpr -> CmmExpr -> FCode ()
mkBasicPrefetch Int
locality (DynFlags -> Int
arrWordsHdrSize DynFlags
dflags)  CmmExpr
addr CmmExpr
idx
doPrefetchByteArrayOp Int
_ [CmmExpr]
_
   = String -> FCode ()
forall a. String -> a
panic String
"StgCmmPrim: doPrefetchByteArrayOp"

-- | Translate mutable byte array prefetch operations into proper primcalls.
doPrefetchMutableByteArrayOp :: Int
                      -> [CmmExpr]
                      -> FCode ()
doPrefetchMutableByteArrayOp :: Int -> [CmmExpr] -> FCode ()
doPrefetchMutableByteArrayOp Int
locality  [CmmExpr
addr,CmmExpr
idx]
   = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        Int -> Int -> CmmExpr -> CmmExpr -> FCode ()
mkBasicPrefetch Int
locality (DynFlags -> Int
arrWordsHdrSize DynFlags
dflags)  CmmExpr
addr CmmExpr
idx
doPrefetchMutableByteArrayOp Int
_ [CmmExpr]
_
   = String -> FCode ()
forall a. String -> a
panic String
"StgCmmPrim: doPrefetchByteArrayOp"

-- | Translate address prefetch operations into proper primcalls.
doPrefetchAddrOp ::Int
                 -> [CmmExpr]
                 -> FCode ()
doPrefetchAddrOp :: Int -> [CmmExpr] -> FCode ()
doPrefetchAddrOp Int
locality   [CmmExpr
addr,CmmExpr
idx]
   = Int -> Int -> CmmExpr -> CmmExpr -> FCode ()
mkBasicPrefetch Int
locality Int
0  CmmExpr
addr CmmExpr
idx
doPrefetchAddrOp Int
_ [CmmExpr]
_
   = String -> FCode ()
forall a. String -> a
panic String
"StgCmmPrim: doPrefetchAddrOp"

-- | Translate value prefetch operations into proper primcalls.
doPrefetchValueOp :: Int
                 -> [CmmExpr]
                 -> FCode ()
doPrefetchValueOp :: Int -> [CmmExpr] -> FCode ()
doPrefetchValueOp  Int
locality   [CmmExpr
addr]
  =  do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        Int -> Int -> CmmExpr -> CmmExpr -> FCode ()
mkBasicPrefetch Int
locality Int
0 CmmExpr
addr  (CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
0 (DynFlags -> Width
wordWidth DynFlags
dflags)))
doPrefetchValueOp Int
_ [CmmExpr]
_
  = String -> FCode ()
forall a. String -> a
panic String
"StgCmmPrim: doPrefetchValueOp"

-- | helper to generate prefetch primcalls
mkBasicPrefetch :: Int          -- Locality level 0-3
                -> ByteOff      -- Initial offset in bytes
                -> CmmExpr      -- Base address
                -> CmmExpr      -- Index
                -> FCode ()
mkBasicPrefetch :: Int -> Int -> CmmExpr -> CmmExpr -> FCode ()
mkBasicPrefetch Int
locality Int
off CmmExpr
base CmmExpr
idx
   = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [] (Int -> CallishMachOp
MO_Prefetch_Data Int
locality) [DynFlags -> Width -> CmmExpr -> CmmExpr -> CmmExpr
cmmIndexExpr DynFlags
dflags Width
W8 (DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetB DynFlags
dflags CmmExpr
base Int
off) CmmExpr
idx]
        () -> FCode ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- ----------------------------------------------------------------------------
-- Allocating byte arrays

-- | Takes a register to return the newly allocated array in and the
-- size of the new array in bytes. Allocates a new
-- 'MutableByteArray#'.
doNewByteArrayOp :: CmmFormal -> ByteOff -> FCode ()
doNewByteArrayOp :: LocalReg -> Int -> FCode ()
doNewByteArrayOp LocalReg
res_r Int
n = do
    DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags

    let info_ptr :: CmmExpr
info_ptr = CLabel -> CmmExpr
mkLblExpr CLabel
mkArrWords_infoLabel
        rep :: SMRep
rep = DynFlags -> Int -> SMRep
arrWordsRep DynFlags
dflags Int
n

    CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
tickyAllocPrim (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (DynFlags -> Int
arrWordsHdrSize DynFlags
dflags))
        (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (DynFlags -> SMRep -> Int
nonHdrSize DynFlags
dflags SMRep
rep))
        (DynFlags -> CmmExpr
zeroExpr DynFlags
dflags)

    let hdr_size :: Int
hdr_size = DynFlags -> Int
fixedHdrSize DynFlags
dflags

    CmmExpr
base <- SMRep -> CmmExpr -> CmmExpr -> [(CmmExpr, Int)] -> FCode CmmExpr
allocHeapClosure SMRep
rep CmmExpr
info_ptr CmmExpr
cccsExpr
                     [ (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags Int
n,
                        Int
hdr_size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ DynFlags -> Int
oFFSET_StgArrBytes_bytes DynFlags
dflags)
                     ]

    CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_r) CmmExpr
base

-- ----------------------------------------------------------------------------
-- Comparing byte arrays

doCompareByteArraysOp :: LocalReg -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
                     -> FCode ()
doCompareByteArraysOp :: LocalReg
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCompareByteArraysOp LocalReg
res CmmExpr
ba1 CmmExpr
ba1_off CmmExpr
ba2 CmmExpr
ba2_off CmmExpr
n = do
    DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    CmmExpr
ba1_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExpr DynFlags
dflags (DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetB DynFlags
dflags CmmExpr
ba1 (DynFlags -> Int
arrWordsHdrSize DynFlags
dflags)) CmmExpr
ba1_off
    CmmExpr
ba2_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExpr DynFlags
dflags (DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetB DynFlags
dflags CmmExpr
ba2 (DynFlags -> Int
arrWordsHdrSize DynFlags
dflags)) CmmExpr
ba2_off

    -- short-cut in case of equal pointers avoiding a costly
    -- subroutine call to the memcmp(3) routine; the Cmm logic below
    -- results in assembly code being generated for
    --
    --   cmpPrefix10 :: ByteArray# -> ByteArray# -> Int#
    --   cmpPrefix10 ba1 ba2 = compareByteArrays# ba1 0# ba2 0# 10#
    --
    -- that looks like
    --
    --          leaq 16(%r14),%rax
    --          leaq 16(%rsi),%rbx
    --          xorl %ecx,%ecx
    --          cmpq %rbx,%rax
    --          je l_ptr_eq
    --
    --          ; NB: the common case (unequal pointers) falls-through
    --          ; the conditional jump, and therefore matches the
    --          ; usual static branch prediction convention of modern cpus
    --
    --          subq $8,%rsp
    --          movq %rbx,%rsi
    --          movq %rax,%rdi
    --          movl $10,%edx
    --          xorl %eax,%eax
    --          call memcmp
    --          addq $8,%rsp
    --          movslq %eax,%rax
    --          movq %rax,%rcx
    --  l_ptr_eq:
    --          movq %rcx,%rbx
    --          jmp *(%rbp)

    BlockId
l_ptr_eq <- FCode BlockId
forall (m :: * -> *). MonadUnique m => m BlockId
newBlockId
    BlockId
l_ptr_ne <- FCode BlockId
forall (m :: * -> *). MonadUnique m => m BlockId
newBlockId

    CmmAGraph -> FCode ()
emit (CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (DynFlags -> CmmExpr
zeroExpr DynFlags
dflags))
    CmmAGraph -> FCode ()
emit (CmmExpr -> BlockId -> BlockId -> Maybe Bool -> CmmAGraph
mkCbranch (DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmEqWord DynFlags
dflags CmmExpr
ba1_p CmmExpr
ba2_p)
                    BlockId
l_ptr_eq BlockId
l_ptr_ne (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False))

    BlockId -> FCode ()
emitLabel BlockId
l_ptr_ne
    LocalReg -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemcmpCall LocalReg
res CmmExpr
ba1_p CmmExpr
ba2_p CmmExpr
n Int
1

    BlockId -> FCode ()
emitLabel BlockId
l_ptr_eq

-- ----------------------------------------------------------------------------
-- Copying byte arrays

-- | Takes a source 'ByteArray#', an offset in the source array, a
-- destination 'MutableByteArray#', an offset into the destination
-- array, and the number of bytes to copy.  Copies the given number of
-- bytes from the source array to the destination array.
doCopyByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
                  -> FCode ()
doCopyByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyByteArrayOp = (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ())
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
emitCopyByteArray CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
forall p p. p -> p -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
copy
  where
    -- Copy data (we assume the arrays aren't overlapping since
    -- they're of different types)
    copy :: p -> p -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
copy p
_src p
_dst CmmExpr
dst_p CmmExpr
src_p CmmExpr
bytes =
        CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemcpyCall CmmExpr
dst_p CmmExpr
src_p CmmExpr
bytes Int
1

-- | Takes a source 'MutableByteArray#', an offset in the source
-- array, a destination 'MutableByteArray#', an offset into the
-- destination array, and the number of bytes to copy.  Copies the
-- given number of bytes from the source array to the destination
-- array.
doCopyMutableByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
                         -> FCode ()
doCopyMutableByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyMutableByteArrayOp = (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ())
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
emitCopyByteArray CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
copy
  where
    -- The only time the memory might overlap is when the two arrays
    -- we were provided are the same array!
    -- TODO: Optimize branch for common case of no aliasing.
    copy :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
copy CmmExpr
src CmmExpr
dst CmmExpr
dst_p CmmExpr
src_p CmmExpr
bytes = do
        DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        (CmmAGraph
moveCall, CmmAGraph
cpyCall) <- FCode CmmAGraph -> FCode CmmAGraph -> FCode (CmmAGraph, CmmAGraph)
forall a. FCode a -> FCode a -> FCode (a, a)
forkAltPair
            (FCode () -> FCode CmmAGraph
forall a. FCode a -> FCode CmmAGraph
getCode (FCode () -> FCode CmmAGraph) -> FCode () -> FCode CmmAGraph
forall a b. (a -> b) -> a -> b
$ CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemmoveCall CmmExpr
dst_p CmmExpr
src_p CmmExpr
bytes Int
1)
            (FCode () -> FCode CmmAGraph
forall a. FCode a -> FCode CmmAGraph
getCode (FCode () -> FCode CmmAGraph) -> FCode () -> FCode CmmAGraph
forall a b. (a -> b) -> a -> b
$ CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemcpyCall  CmmExpr
dst_p CmmExpr
src_p CmmExpr
bytes Int
1)
        CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> FCode CmmAGraph -> FCode ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CmmExpr -> CmmAGraph -> CmmAGraph -> FCode CmmAGraph
mkCmmIfThenElse (DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmEqWord DynFlags
dflags CmmExpr
src CmmExpr
dst) CmmAGraph
moveCall CmmAGraph
cpyCall

emitCopyByteArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
                      -> FCode ())
                  -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
                  -> FCode ()
emitCopyByteArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ())
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
emitCopyByteArray CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
copy CmmExpr
src CmmExpr
src_off CmmExpr
dst CmmExpr
dst_off CmmExpr
n = do
    DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    CmmExpr
dst_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExpr DynFlags
dflags (DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetB DynFlags
dflags CmmExpr
dst (DynFlags -> Int
arrWordsHdrSize DynFlags
dflags)) CmmExpr
dst_off
    CmmExpr
src_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExpr DynFlags
dflags (DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetB DynFlags
dflags CmmExpr
src (DynFlags -> Int
arrWordsHdrSize DynFlags
dflags)) CmmExpr
src_off
    CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
copy CmmExpr
src CmmExpr
dst CmmExpr
dst_p CmmExpr
src_p CmmExpr
n

-- | Takes a source 'ByteArray#', an offset in the source array, a
-- destination 'Addr#', and the number of bytes to copy.  Copies the given
-- number of bytes from the source array to the destination memory region.
doCopyByteArrayToAddrOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyByteArrayToAddrOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyByteArrayToAddrOp CmmExpr
src CmmExpr
src_off CmmExpr
dst_p CmmExpr
bytes = do
    -- Use memcpy (we are allowed to assume the arrays aren't overlapping)
    DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    CmmExpr
src_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExpr DynFlags
dflags (DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetB DynFlags
dflags CmmExpr
src (DynFlags -> Int
arrWordsHdrSize DynFlags
dflags)) CmmExpr
src_off
    CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemcpyCall CmmExpr
dst_p CmmExpr
src_p CmmExpr
bytes Int
1

-- | Takes a source 'MutableByteArray#', an offset in the source array, a
-- destination 'Addr#', and the number of bytes to copy.  Copies the given
-- number of bytes from the source array to the destination memory region.
doCopyMutableByteArrayToAddrOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
                               -> FCode ()
doCopyMutableByteArrayToAddrOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyMutableByteArrayToAddrOp = CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyByteArrayToAddrOp

-- | Takes a source 'Addr#', a destination 'MutableByteArray#', an offset into
-- the destination array, and the number of bytes to copy.  Copies the given
-- number of bytes from the source memory region to the destination array.
doCopyAddrToByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyAddrToByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyAddrToByteArrayOp CmmExpr
src_p CmmExpr
dst CmmExpr
dst_off CmmExpr
bytes = do
    -- Use memcpy (we are allowed to assume the arrays aren't overlapping)
    DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    CmmExpr
dst_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExpr DynFlags
dflags (DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetB DynFlags
dflags CmmExpr
dst (DynFlags -> Int
arrWordsHdrSize DynFlags
dflags)) CmmExpr
dst_off
    CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemcpyCall CmmExpr
dst_p CmmExpr
src_p CmmExpr
bytes Int
1


-- ----------------------------------------------------------------------------
-- Setting byte arrays

-- | Takes a 'MutableByteArray#', an offset into the array, a length,
-- and a byte, and sets each of the selected bytes in the array to the
-- character.
doSetByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
                 -> FCode ()
doSetByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doSetByteArrayOp CmmExpr
ba CmmExpr
off CmmExpr
len CmmExpr
c
    = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
         CmmExpr
p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExpr DynFlags
dflags (DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetB DynFlags
dflags CmmExpr
ba (DynFlags -> Int
arrWordsHdrSize DynFlags
dflags)) CmmExpr
off
         CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemsetCall CmmExpr
p CmmExpr
c CmmExpr
len Int
1

-- ----------------------------------------------------------------------------
-- Allocating arrays

-- | Allocate a new array.
doNewArrayOp :: CmmFormal             -- ^ return register
             -> SMRep                 -- ^ representation of the array
             -> CLabel                -- ^ info pointer
             -> [(CmmExpr, ByteOff)]  -- ^ header payload
             -> WordOff               -- ^ array size
             -> CmmExpr               -- ^ initial element
             -> FCode ()
doNewArrayOp :: LocalReg
-> SMRep
-> CLabel
-> [(CmmExpr, Int)]
-> Int
-> CmmExpr
-> FCode ()
doNewArrayOp LocalReg
res_r SMRep
rep CLabel
info [(CmmExpr, Int)]
payload Int
n CmmExpr
init = do
    DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags

    let info_ptr :: CmmExpr
info_ptr = CLabel -> CmmExpr
mkLblExpr CLabel
info

    CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
tickyAllocPrim (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (DynFlags -> SMRep -> Int
hdrSize DynFlags
dflags SMRep
rep))
        (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (DynFlags -> SMRep -> Int
nonHdrSize DynFlags
dflags SMRep
rep))
        (DynFlags -> CmmExpr
zeroExpr DynFlags
dflags)

    CmmExpr
base <- SMRep -> CmmExpr -> CmmExpr -> [(CmmExpr, Int)] -> FCode CmmExpr
allocHeapClosure SMRep
rep CmmExpr
info_ptr CmmExpr
cccsExpr [(CmmExpr, Int)]
payload

    CmmReg
arr <- LocalReg -> CmmReg
CmmLocal (LocalReg -> CmmReg) -> FCode LocalReg -> FCode CmmReg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp (DynFlags -> CmmType
bWord DynFlags
dflags)
    CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ CmmReg -> CmmExpr -> CmmAGraph
mkAssign CmmReg
arr CmmExpr
base

    -- Initialise all elements of the array
    LocalReg
p <- CmmExpr -> FCode LocalReg
assignTemp (CmmExpr -> FCode LocalReg) -> CmmExpr -> FCode LocalReg
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetB DynFlags
dflags (CmmReg -> CmmExpr
CmmReg CmmReg
arr) (DynFlags -> SMRep -> Int
hdrSize DynFlags
dflags SMRep
rep)
    BlockId
for <- FCode BlockId
forall (m :: * -> *). MonadUnique m => m BlockId
newBlockId
    BlockId -> FCode ()
emitLabel BlockId
for
    let loopBody :: [CmmAGraph]
loopBody =
            [ CmmExpr -> CmmExpr -> CmmAGraph
mkStore (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
p)) CmmExpr
init
            , CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
p) (DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetW DynFlags
dflags (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
p)) Int
1)
            , BlockId -> CmmAGraph
mkBranch BlockId
for ]
    CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> FCode CmmAGraph -> FCode ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CmmExpr -> CmmAGraph -> FCode CmmAGraph
mkCmmIfThen
        (DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmULtWord DynFlags
dflags (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
p))
         (DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetW DynFlags
dflags (CmmReg -> CmmExpr
CmmReg CmmReg
arr)
          (DynFlags -> SMRep -> Int
hdrSizeW DynFlags
dflags SMRep
rep Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)))
        ([CmmAGraph] -> CmmAGraph
catAGraphs [CmmAGraph]
loopBody)

    CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_r) (CmmReg -> CmmExpr
CmmReg CmmReg
arr)

-- ----------------------------------------------------------------------------
-- Copying pointer arrays

-- EZY: This code has an unusually high amount of assignTemp calls, seen
-- nowhere else in the code generator.  This is mostly because these
-- "primitive" ops result in a surprisingly large amount of code.  It
-- will likely be worthwhile to optimize what is emitted here, so that
-- our optimization passes don't waste time repeatedly optimizing the
-- same bits of code.

-- More closely imitates 'assignTemp' from the old code generator, which
-- returns a CmmExpr rather than a LocalReg.
assignTempE :: CmmExpr -> FCode CmmExpr
assignTempE :: CmmExpr -> FCode CmmExpr
assignTempE CmmExpr
e = do
    LocalReg
t <- CmmExpr -> FCode LocalReg
assignTemp CmmExpr
e
    CmmExpr -> FCode CmmExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
t))

-- | Takes a source 'Array#', an offset in the source array, a
-- destination 'MutableArray#', an offset into the destination array,
-- and the number of elements to copy.  Copies the given number of
-- elements from the source array to the destination array.
doCopyArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
              -> FCode ()
doCopyArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
doCopyArrayOp = (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ())
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCopyArray CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
forall p p. p -> p -> CmmExpr -> CmmExpr -> Int -> FCode ()
copy
  where
    -- Copy data (we assume the arrays aren't overlapping since
    -- they're of different types)
    copy :: p -> p -> CmmExpr -> CmmExpr -> Int -> FCode ()
copy p
_src p
_dst CmmExpr
dst_p CmmExpr
src_p Int
bytes =
        do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
           CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemcpyCall CmmExpr
dst_p CmmExpr
src_p (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags Int
bytes)
               (DynFlags -> Int
wORD_SIZE DynFlags
dflags)


-- | Takes a source 'MutableArray#', an offset in the source array, a
-- destination 'MutableArray#', an offset into the destination array,
-- and the number of elements to copy.  Copies the given number of
-- elements from the source array to the destination array.
doCopyMutableArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
                     -> FCode ()
doCopyMutableArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
doCopyMutableArrayOp = (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ())
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCopyArray CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
copy
  where
    -- The only time the memory might overlap is when the two arrays
    -- we were provided are the same array!
    -- TODO: Optimize branch for common case of no aliasing.
    copy :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
copy CmmExpr
src CmmExpr
dst CmmExpr
dst_p CmmExpr
src_p Int
bytes = do
        DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        (CmmAGraph
moveCall, CmmAGraph
cpyCall) <- FCode CmmAGraph -> FCode CmmAGraph -> FCode (CmmAGraph, CmmAGraph)
forall a. FCode a -> FCode a -> FCode (a, a)
forkAltPair
            (FCode () -> FCode CmmAGraph
forall a. FCode a -> FCode CmmAGraph
getCode (FCode () -> FCode CmmAGraph) -> FCode () -> FCode CmmAGraph
forall a b. (a -> b) -> a -> b
$ CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemmoveCall CmmExpr
dst_p CmmExpr
src_p (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags Int
bytes)
             (DynFlags -> Int
wORD_SIZE DynFlags
dflags))
            (FCode () -> FCode CmmAGraph
forall a. FCode a -> FCode CmmAGraph
getCode (FCode () -> FCode CmmAGraph) -> FCode () -> FCode CmmAGraph
forall a b. (a -> b) -> a -> b
$ CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemcpyCall  CmmExpr
dst_p CmmExpr
src_p (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags Int
bytes)
             (DynFlags -> Int
wORD_SIZE DynFlags
dflags))
        CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> FCode CmmAGraph -> FCode ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CmmExpr -> CmmAGraph -> CmmAGraph -> FCode CmmAGraph
mkCmmIfThenElse (DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmEqWord DynFlags
dflags CmmExpr
src CmmExpr
dst) CmmAGraph
moveCall CmmAGraph
cpyCall

emitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> ByteOff
                  -> FCode ())  -- ^ copy function
              -> CmmExpr        -- ^ source array
              -> CmmExpr        -- ^ offset in source array
              -> CmmExpr        -- ^ destination array
              -> CmmExpr        -- ^ offset in destination array
              -> WordOff        -- ^ number of elements to copy
              -> FCode ()
emitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ())
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCopyArray CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
copy CmmExpr
src0 CmmExpr
src_off CmmExpr
dst0 CmmExpr
dst_off0 Int
n = do
    DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    Bool -> FCode () -> FCode ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (FCode () -> FCode ()) -> FCode () -> FCode ()
forall a b. (a -> b) -> a -> b
$ do
        -- Passed as arguments (be careful)
        CmmExpr
src     <- CmmExpr -> FCode CmmExpr
assignTempE CmmExpr
src0
        CmmExpr
dst     <- CmmExpr -> FCode CmmExpr
assignTempE CmmExpr
dst0
        CmmExpr
dst_off <- CmmExpr -> FCode CmmExpr
assignTempE CmmExpr
dst_off0

        -- Set the dirty bit in the header.
        CmmAGraph -> FCode ()
emit (CmmExpr -> CmmExpr -> CmmAGraph
setInfo CmmExpr
dst (CmmLit -> CmmExpr
CmmLit (CLabel -> CmmLit
CmmLabel CLabel
mkMAP_DIRTY_infoLabel)))

        CmmExpr
dst_elems_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetB DynFlags
dflags CmmExpr
dst
                       (DynFlags -> Int
arrPtrsHdrSize DynFlags
dflags)
        CmmExpr
dst_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExprW DynFlags
dflags CmmExpr
dst_elems_p CmmExpr
dst_off
        CmmExpr
src_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExprW DynFlags
dflags
                 (DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetB DynFlags
dflags CmmExpr
src (DynFlags -> Int
arrPtrsHdrSize DynFlags
dflags)) CmmExpr
src_off
        let bytes :: Int
bytes = DynFlags -> Int -> Int
forall a. Num a => DynFlags -> a -> a
wordsToBytes DynFlags
dflags Int
n

        CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
copy CmmExpr
src CmmExpr
dst CmmExpr
dst_p CmmExpr
src_p Int
bytes

        -- The base address of the destination card table
        CmmExpr
dst_cards_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExprW DynFlags
dflags CmmExpr
dst_elems_p
                       (DynFlags -> CmmExpr -> CmmExpr
loadArrPtrsSize DynFlags
dflags CmmExpr
dst)

        CmmExpr -> CmmExpr -> Int -> FCode ()
emitSetCards CmmExpr
dst_off CmmExpr
dst_cards_p Int
n

doCopySmallArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
                   -> FCode ()
doCopySmallArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
doCopySmallArrayOp = (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ())
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCopySmallArray CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
forall p p. p -> p -> CmmExpr -> CmmExpr -> Int -> FCode ()
copy
  where
    -- Copy data (we assume the arrays aren't overlapping since
    -- they're of different types)
    copy :: p -> p -> CmmExpr -> CmmExpr -> Int -> FCode ()
copy p
_src p
_dst CmmExpr
dst_p CmmExpr
src_p Int
bytes =
        do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
           CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemcpyCall CmmExpr
dst_p CmmExpr
src_p (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags Int
bytes)
               (DynFlags -> Int
wORD_SIZE DynFlags
dflags)


doCopySmallMutableArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
                          -> FCode ()
doCopySmallMutableArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
doCopySmallMutableArrayOp = (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ())
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCopySmallArray CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
copy
  where
    -- The only time the memory might overlap is when the two arrays
    -- we were provided are the same array!
    -- TODO: Optimize branch for common case of no aliasing.
    copy :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
copy CmmExpr
src CmmExpr
dst CmmExpr
dst_p CmmExpr
src_p Int
bytes = do
        DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        (CmmAGraph
moveCall, CmmAGraph
cpyCall) <- FCode CmmAGraph -> FCode CmmAGraph -> FCode (CmmAGraph, CmmAGraph)
forall a. FCode a -> FCode a -> FCode (a, a)
forkAltPair
            (FCode () -> FCode CmmAGraph
forall a. FCode a -> FCode CmmAGraph
getCode (FCode () -> FCode CmmAGraph) -> FCode () -> FCode CmmAGraph
forall a b. (a -> b) -> a -> b
$ CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemmoveCall CmmExpr
dst_p CmmExpr
src_p (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags Int
bytes)
             (DynFlags -> Int
wORD_SIZE DynFlags
dflags))
            (FCode () -> FCode CmmAGraph
forall a. FCode a -> FCode CmmAGraph
getCode (FCode () -> FCode CmmAGraph) -> FCode () -> FCode CmmAGraph
forall a b. (a -> b) -> a -> b
$ CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemcpyCall  CmmExpr
dst_p CmmExpr
src_p (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags Int
bytes)
             (DynFlags -> Int
wORD_SIZE DynFlags
dflags))
        CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> FCode CmmAGraph -> FCode ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CmmExpr -> CmmAGraph -> CmmAGraph -> FCode CmmAGraph
mkCmmIfThenElse (DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmEqWord DynFlags
dflags CmmExpr
src CmmExpr
dst) CmmAGraph
moveCall CmmAGraph
cpyCall

emitCopySmallArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> ByteOff
                       -> FCode ())  -- ^ copy function
                   -> CmmExpr        -- ^ source array
                   -> CmmExpr        -- ^ offset in source array
                   -> CmmExpr        -- ^ destination array
                   -> CmmExpr        -- ^ offset in destination array
                   -> WordOff        -- ^ number of elements to copy
                   -> FCode ()
emitCopySmallArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ())
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCopySmallArray CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
copy CmmExpr
src0 CmmExpr
src_off CmmExpr
dst0 CmmExpr
dst_off Int
n = do
    DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags

    -- Passed as arguments (be careful)
    CmmExpr
src     <- CmmExpr -> FCode CmmExpr
assignTempE CmmExpr
src0
    CmmExpr
dst     <- CmmExpr -> FCode CmmExpr
assignTempE CmmExpr
dst0

    -- Set the dirty bit in the header.
    CmmAGraph -> FCode ()
emit (CmmExpr -> CmmExpr -> CmmAGraph
setInfo CmmExpr
dst (CmmLit -> CmmExpr
CmmLit (CLabel -> CmmLit
CmmLabel CLabel
mkSMAP_DIRTY_infoLabel)))

    CmmExpr
dst_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExprW DynFlags
dflags
             (DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetB DynFlags
dflags CmmExpr
dst (DynFlags -> Int
smallArrPtrsHdrSize DynFlags
dflags)) CmmExpr
dst_off
    CmmExpr
src_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExprW DynFlags
dflags
             (DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetB DynFlags
dflags CmmExpr
src (DynFlags -> Int
smallArrPtrsHdrSize DynFlags
dflags)) CmmExpr
src_off
    let bytes :: Int
bytes = DynFlags -> Int -> Int
forall a. Num a => DynFlags -> a -> a
wordsToBytes DynFlags
dflags Int
n

    CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
copy CmmExpr
src CmmExpr
dst CmmExpr
dst_p CmmExpr
src_p Int
bytes

-- | Takes an info table label, a register to return the newly
-- allocated array in, a source array, an offset in the source array,
-- and the number of elements to copy. Allocates a new array and
-- initializes it from the source array.
emitCloneArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> WordOff
               -> FCode ()
emitCloneArray :: CLabel -> LocalReg -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCloneArray CLabel
info_p LocalReg
res_r CmmExpr
src CmmExpr
src_off Int
n = do
    DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags

    let info_ptr :: CmmExpr
info_ptr = CLabel -> CmmExpr
mkLblExpr CLabel
info_p
        rep :: SMRep
rep = DynFlags -> Int -> SMRep
arrPtrsRep DynFlags
dflags Int
n

    CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
tickyAllocPrim (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (DynFlags -> Int
arrPtrsHdrSize DynFlags
dflags))
        (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (DynFlags -> SMRep -> Int
nonHdrSize DynFlags
dflags SMRep
rep))
        (DynFlags -> CmmExpr
zeroExpr DynFlags
dflags)

    let hdr_size :: Int
hdr_size = DynFlags -> Int
fixedHdrSize DynFlags
dflags

    CmmExpr
base <- SMRep -> CmmExpr -> CmmExpr -> [(CmmExpr, Int)] -> FCode CmmExpr
allocHeapClosure SMRep
rep CmmExpr
info_ptr CmmExpr
cccsExpr
                     [ (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags Int
n,
                        Int
hdr_size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ DynFlags -> Int
oFFSET_StgMutArrPtrs_ptrs DynFlags
dflags)
                     , (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (SMRep -> Int
nonHdrSizeW SMRep
rep),
                        Int
hdr_size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ DynFlags -> Int
oFFSET_StgMutArrPtrs_size DynFlags
dflags)
                     ]

    CmmReg
arr <- LocalReg -> CmmReg
CmmLocal (LocalReg -> CmmReg) -> FCode LocalReg -> FCode CmmReg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp (DynFlags -> CmmType
bWord DynFlags
dflags)
    CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ CmmReg -> CmmExpr -> CmmAGraph
mkAssign CmmReg
arr CmmExpr
base

    CmmExpr
dst_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetB DynFlags
dflags (CmmReg -> CmmExpr
CmmReg CmmReg
arr)
             (DynFlags -> Int
arrPtrsHdrSize DynFlags
dflags)
    CmmExpr
src_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExprW DynFlags
dflags CmmExpr
src
             (DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmAddWord DynFlags
dflags
              (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (DynFlags -> Int
arrPtrsHdrSizeW DynFlags
dflags)) CmmExpr
src_off)

    CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemcpyCall CmmExpr
dst_p CmmExpr
src_p (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (DynFlags -> Int -> Int
forall a. Num a => DynFlags -> a -> a
wordsToBytes DynFlags
dflags Int
n))
        (DynFlags -> Int
wORD_SIZE DynFlags
dflags)

    CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_r) (CmmReg -> CmmExpr
CmmReg CmmReg
arr)

-- | Takes an info table label, a register to return the newly
-- allocated array in, a source array, an offset in the source array,
-- and the number of elements to copy. Allocates a new array and
-- initializes it from the source array.
emitCloneSmallArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> WordOff
                    -> FCode ()
emitCloneSmallArray :: CLabel -> LocalReg -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCloneSmallArray CLabel
info_p LocalReg
res_r CmmExpr
src CmmExpr
src_off Int
n = do
    DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags

    let info_ptr :: CmmExpr
info_ptr = CLabel -> CmmExpr
mkLblExpr CLabel
info_p
        rep :: SMRep
rep = Int -> SMRep
smallArrPtrsRep Int
n

    CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
tickyAllocPrim (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (DynFlags -> Int
smallArrPtrsHdrSize DynFlags
dflags))
        (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (DynFlags -> SMRep -> Int
nonHdrSize DynFlags
dflags SMRep
rep))
        (DynFlags -> CmmExpr
zeroExpr DynFlags
dflags)

    let hdr_size :: Int
hdr_size = DynFlags -> Int
fixedHdrSize DynFlags
dflags

    CmmExpr
base <- SMRep -> CmmExpr -> CmmExpr -> [(CmmExpr, Int)] -> FCode CmmExpr
allocHeapClosure SMRep
rep CmmExpr
info_ptr CmmExpr
cccsExpr
                     [ (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags Int
n,
                        Int
hdr_size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ DynFlags -> Int
oFFSET_StgSmallMutArrPtrs_ptrs DynFlags
dflags)
                     ]

    CmmReg
arr <- LocalReg -> CmmReg
CmmLocal (LocalReg -> CmmReg) -> FCode LocalReg -> FCode CmmReg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp (DynFlags -> CmmType
bWord DynFlags
dflags)
    CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ CmmReg -> CmmExpr -> CmmAGraph
mkAssign CmmReg
arr CmmExpr
base

    CmmExpr
dst_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmExpr -> Int -> CmmExpr
cmmOffsetB DynFlags
dflags (CmmReg -> CmmExpr
CmmReg CmmReg
arr)
             (DynFlags -> Int
smallArrPtrsHdrSize DynFlags
dflags)
    CmmExpr
src_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExprW DynFlags
dflags CmmExpr
src
             (DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmAddWord DynFlags
dflags
              (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (DynFlags -> Int
smallArrPtrsHdrSizeW DynFlags
dflags)) CmmExpr
src_off)

    CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemcpyCall CmmExpr
dst_p CmmExpr
src_p (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (DynFlags -> Int -> Int
forall a. Num a => DynFlags -> a -> a
wordsToBytes DynFlags
dflags Int
n))
        (DynFlags -> Int
wORD_SIZE DynFlags
dflags)

    CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_r) (CmmReg -> CmmExpr
CmmReg CmmReg
arr)

-- | Takes and offset in the destination array, the base address of
-- the card table, and the number of elements affected (*not* the
-- number of cards). The number of elements may not be zero.
-- Marks the relevant cards as dirty.
emitSetCards :: CmmExpr -> CmmExpr -> WordOff -> FCode ()
emitSetCards :: CmmExpr -> CmmExpr -> Int -> FCode ()
emitSetCards CmmExpr
dst_start CmmExpr
dst_cards_start Int
n = do
    DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    CmmExpr
start_card <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmExpr -> CmmExpr
cardCmm DynFlags
dflags CmmExpr
dst_start
    let end_card :: CmmExpr
end_card = DynFlags -> CmmExpr -> CmmExpr
cardCmm DynFlags
dflags
                   (DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmSubWord DynFlags
dflags
                    (DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmAddWord DynFlags
dflags CmmExpr
dst_start (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags Int
n))
                    (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags Int
1))
    CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemsetCall (DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmAddWord DynFlags
dflags CmmExpr
dst_cards_start CmmExpr
start_card)
        (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags Int
1)
        (DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmAddWord DynFlags
dflags (DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmSubWord DynFlags
dflags CmmExpr
end_card CmmExpr
start_card) (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags Int
1))
        Int
1 -- no alignment (1 byte)

-- Convert an element index to a card index
cardCmm :: DynFlags -> CmmExpr -> CmmExpr
cardCmm :: DynFlags -> CmmExpr -> CmmExpr
cardCmm DynFlags
dflags CmmExpr
i =
    DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
cmmUShrWord DynFlags
dflags CmmExpr
i (DynFlags -> Int -> CmmExpr
mkIntExpr DynFlags
dflags (DynFlags -> Int
mUT_ARR_PTRS_CARD_BITS DynFlags
dflags))

------------------------------------------------------------------------------
-- SmallArray PrimOp implementations

doReadSmallPtrArrayOp :: LocalReg
                      -> CmmExpr
                      -> CmmExpr
                      -> FCode ()
doReadSmallPtrArrayOp :: LocalReg -> CmmExpr -> CmmExpr -> FCode ()
doReadSmallPtrArrayOp LocalReg
res CmmExpr
addr CmmExpr
idx = do
    DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    Int
-> Maybe MachOp
-> CmmType
-> LocalReg
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
mkBasicIndexedRead (DynFlags -> Int
smallArrPtrsHdrSize DynFlags
dflags) Maybe MachOp
forall a. Maybe a
Nothing (DynFlags -> CmmType
gcWord DynFlags
dflags) LocalReg
res CmmExpr
addr
        (DynFlags -> CmmType
gcWord DynFlags
dflags) CmmExpr
idx

doWriteSmallPtrArrayOp :: CmmExpr
                       -> CmmExpr
                       -> CmmExpr
                       -> FCode ()
doWriteSmallPtrArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doWriteSmallPtrArrayOp CmmExpr
addr CmmExpr
idx CmmExpr
val = do
    DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    let ty :: CmmType
ty = DynFlags -> CmmExpr -> CmmType
cmmExprType DynFlags
dflags CmmExpr
val
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [] CallishMachOp
MO_WriteBarrier [] -- #12469
    Int
-> Maybe MachOp
-> CmmExpr
-> CmmType
-> CmmExpr
-> CmmExpr
-> FCode ()
mkBasicIndexedWrite (DynFlags -> Int
smallArrPtrsHdrSize DynFlags
dflags) Maybe MachOp
forall a. Maybe a
Nothing CmmExpr
addr CmmType
ty CmmExpr
idx CmmExpr
val
    CmmAGraph -> FCode ()
emit (CmmExpr -> CmmExpr -> CmmAGraph
setInfo CmmExpr
addr (CmmLit -> CmmExpr
CmmLit (CLabel -> CmmLit
CmmLabel CLabel
mkSMAP_DIRTY_infoLabel)))

------------------------------------------------------------------------------
-- Atomic read-modify-write

-- | Emit an atomic modification to a byte array element. The result
-- reg contains that previous value of the element. Implies a full
-- memory barrier.
doAtomicRMW :: LocalReg      -- ^ Result reg
            -> AtomicMachOp  -- ^ Atomic op (e.g. add)
            -> CmmExpr       -- ^ MutableByteArray#
            -> CmmExpr       -- ^ Index
            -> CmmType       -- ^ Type of element by which we are indexing
            -> CmmExpr       -- ^ Op argument (e.g. amount to add)
            -> FCode ()
doAtomicRMW :: LocalReg
-> AtomicMachOp
-> CmmExpr
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
doAtomicRMW LocalReg
res AtomicMachOp
amop CmmExpr
mba CmmExpr
idx CmmType
idx_ty CmmExpr
n = do
    DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    let width :: Width
width = CmmType -> Width
typeWidth CmmType
idx_ty
        addr :: CmmExpr
addr  = DynFlags -> Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr
cmmIndexOffExpr DynFlags
dflags (DynFlags -> Int
arrWordsHdrSize DynFlags
dflags)
                Width
width CmmExpr
mba CmmExpr
idx
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ LocalReg
res ]
        (Width -> AtomicMachOp -> CallishMachOp
MO_AtomicRMW Width
width AtomicMachOp
amop)
        [ CmmExpr
addr, CmmExpr
n ]

-- | Emit an atomic read to a byte array that acts as a memory barrier.
doAtomicReadByteArray
    :: LocalReg  -- ^ Result reg
    -> CmmExpr   -- ^ MutableByteArray#
    -> CmmExpr   -- ^ Index
    -> CmmType   -- ^ Type of element by which we are indexing
    -> FCode ()
doAtomicReadByteArray :: LocalReg -> CmmExpr -> CmmExpr -> CmmType -> FCode ()
doAtomicReadByteArray LocalReg
res CmmExpr
mba CmmExpr
idx CmmType
idx_ty = do
    DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    let width :: Width
width = CmmType -> Width
typeWidth CmmType
idx_ty
        addr :: CmmExpr
addr  = DynFlags -> Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr
cmmIndexOffExpr DynFlags
dflags (DynFlags -> Int
arrWordsHdrSize DynFlags
dflags)
                Width
width CmmExpr
mba CmmExpr
idx
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ LocalReg
res ]
        (Width -> CallishMachOp
MO_AtomicRead Width
width)
        [ CmmExpr
addr ]

-- | Emit an atomic write to a byte array that acts as a memory barrier.
doAtomicWriteByteArray
    :: CmmExpr   -- ^ MutableByteArray#
    -> CmmExpr   -- ^ Index
    -> CmmType   -- ^ Type of element by which we are indexing
    -> CmmExpr   -- ^ Value to write
    -> FCode ()
doAtomicWriteByteArray :: CmmExpr -> CmmExpr -> CmmType -> CmmExpr -> FCode ()
doAtomicWriteByteArray CmmExpr
mba CmmExpr
idx CmmType
idx_ty CmmExpr
val = do
    DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    let width :: Width
width = CmmType -> Width
typeWidth CmmType
idx_ty
        addr :: CmmExpr
addr  = DynFlags -> Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr
cmmIndexOffExpr DynFlags
dflags (DynFlags -> Int
arrWordsHdrSize DynFlags
dflags)
                Width
width CmmExpr
mba CmmExpr
idx
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ {- no results -} ]
        (Width -> CallishMachOp
MO_AtomicWrite Width
width)
        [ CmmExpr
addr, CmmExpr
val ]

doCasByteArray
    :: LocalReg  -- ^ Result reg
    -> CmmExpr   -- ^ MutableByteArray#
    -> CmmExpr   -- ^ Index
    -> CmmType   -- ^ Type of element by which we are indexing
    -> CmmExpr   -- ^ Old value
    -> CmmExpr   -- ^ New value
    -> FCode ()
doCasByteArray :: LocalReg
-> CmmExpr -> CmmExpr -> CmmType -> CmmExpr -> CmmExpr -> FCode ()
doCasByteArray LocalReg
res CmmExpr
mba CmmExpr
idx CmmType
idx_ty CmmExpr
old CmmExpr
new = do
    DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    let width :: Width
width = (CmmType -> Width
typeWidth CmmType
idx_ty)
        addr :: CmmExpr
addr = DynFlags -> Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr
cmmIndexOffExpr DynFlags
dflags (DynFlags -> Int
arrWordsHdrSize DynFlags
dflags)
               Width
width CmmExpr
mba CmmExpr
idx
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ LocalReg
res ]
        (Width -> CallishMachOp
MO_Cmpxchg Width
width)
        [ CmmExpr
addr, CmmExpr
old, CmmExpr
new ]

------------------------------------------------------------------------------
-- Helpers for emitting function calls

-- | Emit a call to @memcpy@.
emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemcpyCall CmmExpr
dst CmmExpr
src CmmExpr
n Int
align = do
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ {-no results-} ]
        (Int -> CallishMachOp
MO_Memcpy Int
align)
        [ CmmExpr
dst, CmmExpr
src, CmmExpr
n ]

-- | Emit a call to @memmove@.
emitMemmoveCall :: CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemmoveCall :: CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemmoveCall CmmExpr
dst CmmExpr
src CmmExpr
n Int
align = do
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ {- no results -} ]
        (Int -> CallishMachOp
MO_Memmove Int
align)
        [ CmmExpr
dst, CmmExpr
src, CmmExpr
n ]

-- | Emit a call to @memset@.  The second argument must fit inside an
-- unsigned char.
emitMemsetCall :: CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemsetCall :: CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemsetCall CmmExpr
dst CmmExpr
c CmmExpr
n Int
align = do
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ {- no results -} ]
        (Int -> CallishMachOp
MO_Memset Int
align)
        [ CmmExpr
dst, CmmExpr
c, CmmExpr
n ]

emitMemcmpCall :: LocalReg -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemcmpCall :: LocalReg -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemcmpCall LocalReg
res CmmExpr
ptr1 CmmExpr
ptr2 CmmExpr
n Int
align = do
    -- 'MO_Memcmp' is assumed to return an 32bit 'CInt' because all
    -- code-gens currently call out to the @memcmp(3)@ C function.
    -- This was easier than moving the sign-extensions into
    -- all the code-gens.
    DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    let is32Bit :: Bool
is32Bit = CmmType -> Width
typeWidth (LocalReg -> CmmType
localRegType LocalReg
res) Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W32

    LocalReg
cres <- if Bool
is32Bit
              then LocalReg -> FCode LocalReg
forall (m :: * -> *) a. Monad m => a -> m a
return LocalReg
res
              else CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp CmmType
b32

    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ LocalReg
cres ]
        (Int -> CallishMachOp
MO_Memcmp Int
align)
        [ CmmExpr
ptr1, CmmExpr
ptr2, CmmExpr
n ]

    Bool -> FCode () -> FCode ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
is32Bit (FCode () -> FCode ()) -> FCode () -> FCode ()
forall a b. (a -> b) -> a -> b
$ do
      CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res)
                      (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp
                         (DynFlags -> MachOp
mo_s_32ToWord DynFlags
dflags)
                         [(CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
cres))])

emitBSwapCall :: LocalReg -> CmmExpr -> Width -> FCode ()
emitBSwapCall :: LocalReg -> CmmExpr -> Width -> FCode ()
emitBSwapCall LocalReg
res CmmExpr
x Width
width = do
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ LocalReg
res ]
        (Width -> CallishMachOp
MO_BSwap Width
width)
        [ CmmExpr
x ]

emitPopCntCall :: LocalReg -> CmmExpr -> Width -> FCode ()
emitPopCntCall :: LocalReg -> CmmExpr -> Width -> FCode ()
emitPopCntCall LocalReg
res CmmExpr
x Width
width = do
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ LocalReg
res ]
        (Width -> CallishMachOp
MO_PopCnt Width
width)
        [ CmmExpr
x ]

emitPdepCall :: LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPdepCall :: LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPdepCall LocalReg
res CmmExpr
x CmmExpr
y Width
width = do
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ LocalReg
res ]
        (Width -> CallishMachOp
MO_Pdep Width
width)
        [ CmmExpr
x, CmmExpr
y ]

emitPextCall :: LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPextCall :: LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPextCall LocalReg
res CmmExpr
x CmmExpr
y Width
width = do
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ LocalReg
res ]
        (Width -> CallishMachOp
MO_Pext Width
width)
        [ CmmExpr
x, CmmExpr
y ]

emitClzCall :: LocalReg -> CmmExpr -> Width -> FCode ()
emitClzCall :: LocalReg -> CmmExpr -> Width -> FCode ()
emitClzCall LocalReg
res CmmExpr
x Width
width = do
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ LocalReg
res ]
        (Width -> CallishMachOp
MO_Clz Width
width)
        [ CmmExpr
x ]

emitCtzCall :: LocalReg -> CmmExpr -> Width -> FCode ()
emitCtzCall :: LocalReg -> CmmExpr -> Width -> FCode ()
emitCtzCall LocalReg
res CmmExpr
x Width
width = do
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ LocalReg
res ]
        (Width -> CallishMachOp
MO_Ctz Width
width)
        [ CmmExpr
x ]