{-# 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 "HsVersions.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 fcall :: ForeignCall
fcall _) stg_args :: [StgArg]
stg_args res_ty :: 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 TagToEnumOp) [arg :: StgArg
arg] res_ty :: 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 [amode :: CmmExpr
amode] -> CmmExpr
amode
                                    _ -> String -> CmmExpr
forall a. String -> a
panic "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
primop) args :: [StgArg]
args res_ty :: 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
        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 f :: [LocalReg] -> FCode ()
f  -- inline
          | ReturnsPrim VoidRep <- PrimOpResultInfo
result_info
          -> do [LocalReg] -> FCode ()
f []
                [CmmExpr] -> FCode ReturnKind
emitReturn []

          | ReturnsPrim rep :: 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
tycon <- PrimOpResultInfo
result_info, TyCon -> Bool
isUnboxedTupleTyCon TyCon
tycon
          -> do (regs :: [LocalReg]
regs, _hints :: [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 "cgPrimop"
          where
             result_info :: PrimOpResultInfo
result_info = PrimOp -> PrimOpResultInfo
getPrimOpResultInfo PrimOp
primop

cgOpApp (StgPrimCallOp primcall :: PrimCall
primcall) args :: [StgArg]
args _res_ty :: 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 w :: Width
w n :: 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
- 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 dflags :: DynFlags
dflags NewByteArrayOp_Char [(CmmLit (CmmInt n :: Integer
n w :: 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
$ \ [res :: LocalReg
res] -> LocalReg -> Int -> FCode ()
doNewByteArrayOp LocalReg
res (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)

shouldInlinePrimOp dflags :: DynFlags
dflags NewArrayOp [(CmmLit (CmmInt n :: Integer
n w :: Width
w)), init :: 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
$ \ [res :: 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 _ CopyArrayOp
    [src :: CmmExpr
src, src_off :: CmmExpr
src_off, dst :: CmmExpr
dst, dst_off :: CmmExpr
dst_off, (CmmLit (CmmInt n :: Integer
n _))] =
        ([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 _ CopyMutableArrayOp
    [src :: CmmExpr
src, src_off :: CmmExpr
src_off, dst :: CmmExpr
dst, dst_off :: CmmExpr
dst_off, (CmmLit (CmmInt n :: Integer
n _))] =
        ([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 _ CopyArrayArrayOp
    [src :: CmmExpr
src, src_off :: CmmExpr
src_off, dst :: CmmExpr
dst, dst_off :: CmmExpr
dst_off, (CmmLit (CmmInt n :: Integer
n _))] =
        ([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 _ CopyMutableArrayArrayOp
    [src :: CmmExpr
src, src_off :: CmmExpr
src_off, dst :: CmmExpr
dst, dst_off :: CmmExpr
dst_off, (CmmLit (CmmInt n :: Integer
n _))] =
        ([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 dflags :: DynFlags
dflags CloneArrayOp [src :: CmmExpr
src, src_off :: CmmExpr
src_off, (CmmLit (CmmInt n :: Integer
n w :: 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
$ \ [res :: 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 dflags :: DynFlags
dflags CloneMutableArrayOp [src :: CmmExpr
src, src_off :: CmmExpr
src_off, (CmmLit (CmmInt n :: Integer
n w :: 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
$ \ [res :: 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 dflags :: DynFlags
dflags FreezeArrayOp [src :: CmmExpr
src, src_off :: CmmExpr
src_off, (CmmLit (CmmInt n :: Integer
n w :: 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
$ \ [res :: 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 dflags :: DynFlags
dflags ThawArrayOp [src :: CmmExpr
src, src_off :: CmmExpr
src_off, (CmmLit (CmmInt n :: Integer
n w :: 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
$ \ [res :: 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 dflags :: DynFlags
dflags NewSmallArrayOp [(CmmLit (CmmInt n :: Integer
n w :: Width
w)), init :: 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
$ \ [res :: 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 _ CopySmallArrayOp
    [src :: CmmExpr
src, src_off :: CmmExpr
src_off, dst :: CmmExpr
dst, dst_off :: CmmExpr
dst_off, (CmmLit (CmmInt n :: Integer
n _))] =
        ([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 _ CopySmallMutableArrayOp
    [src :: CmmExpr
src, src_off :: CmmExpr
src_off, dst :: CmmExpr
dst, dst_off :: CmmExpr
dst_off, (CmmLit (CmmInt n :: Integer
n _))] =
        ([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 dflags :: DynFlags
dflags CloneSmallArrayOp [src :: CmmExpr
src, src_off :: CmmExpr
src_off, (CmmLit (CmmInt n :: Integer
n w :: 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
$ \ [res :: 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 dflags :: DynFlags
dflags CloneSmallMutableArrayOp [src :: CmmExpr
src, src_off :: CmmExpr
src_off, (CmmLit (CmmInt n :: Integer
n w :: 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
$ \ [res :: 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 dflags :: DynFlags
dflags FreezeSmallArrayOp [src :: CmmExpr
src, src_off :: CmmExpr
src_off, (CmmLit (CmmInt n :: Integer
n w :: 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
$ \ [res :: 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 dflags :: DynFlags
dflags ThawSmallArrayOp [src :: CmmExpr
src, src_off :: CmmExpr
src_off, (CmmLit (CmmInt n :: Integer
n w :: 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
$ \ [res :: 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 dflags :: DynFlags
dflags primop :: PrimOp
primop args :: [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
$ \ regs :: [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 results :: [LocalReg]
results op :: PrimOp
op args :: [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 _ [res :: LocalReg
res] ParOp [arg :: 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 "newSpark") Maybe Int
forall a. Maybe a
Nothing ForeignLabelSource
ForeignLabelInExternalPackage FunctionOrData
IsFunction)))
        [(CmmExpr
baseExpr, ForeignHint
AddrHint), (CmmExpr
arg,ForeignHint
AddrHint)]

emitPrimOp dflags :: DynFlags
dflags [res :: LocalReg
res] SparkOp [arg :: 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 "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 dflags :: DynFlags
dflags [res :: LocalReg
res] GetCCSOfOp [arg :: 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 _ [res :: LocalReg
res] GetCurrentCCSOp [_dummy_arg :: CmmExpr
_dummy_arg]
   = CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) CmmExpr
cccsExpr

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

emitPrimOp dflags :: DynFlags
dflags [res :: LocalReg
res] ReadMutVarOp [mutv :: 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 dflags :: DynFlags
dflags res :: [LocalReg]
res@[] WriteMutVarOp [mutv :: CmmExpr
mutv,var :: 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 dflags :: DynFlags
dflags [res :: LocalReg
res] SizeofByteArrayOp [arg :: 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 dflags :: DynFlags
dflags [res :: LocalReg
res] SizeofMutableByteArrayOp [arg :: 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 dflags :: DynFlags
dflags [res :: LocalReg
res] GetSizeofMutableByteArrayOp [arg :: 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 _ res :: [LocalReg]
res@[] TouchOp args :: [CmmExpr]
args@[_arg :: 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 dflags :: DynFlags
dflags [res :: LocalReg
res] ByteArrayContents_Char [arg :: 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 dflags :: DynFlags
dflags [res :: LocalReg
res] StableNameToIntOp [arg :: 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 dflags :: DynFlags
dflags [res :: LocalReg
res] ReallyUnsafePtrEqualityOp [arg1 :: CmmExpr
arg1,arg2 :: 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 _      [res :: LocalReg
res] AddrToAnyOp [arg :: CmmExpr
arg]
   = CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) CmmExpr
arg

--  #define hvalueToAddrzh(r, a) r=(W_)a
emitPrimOp _      [res :: LocalReg
res] AnyToAddrOp [arg :: 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 _      [res :: LocalReg
res] UnsafeFreezeArrayOp [arg :: 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 _      [res :: LocalReg
res] UnsafeFreezeArrayArrayOp [arg :: 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 _      [res :: LocalReg
res] UnsafeFreezeSmallArrayOp [arg :: 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 _      [res :: LocalReg
res] UnsafeFreezeByteArrayOp [arg :: CmmExpr
arg]
   = CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) CmmExpr
arg

-- Reading/writing pointer arrays

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

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

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

-- Getting the size of pointer arrays

emitPrimOp dflags :: DynFlags
dflags [res :: LocalReg
res] SizeofArrayOp [arg :: 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 dflags :: DynFlags
dflags [res :: LocalReg
res] SizeofMutableArrayOp [arg :: CmmExpr
arg]
   = DynFlags -> [LocalReg] -> PrimOp -> [CmmExpr] -> FCode ()
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
SizeofArrayOp [CmmExpr
arg]
emitPrimOp dflags :: DynFlags
dflags [res :: LocalReg
res] SizeofArrayArrayOp [arg :: CmmExpr
arg]
   = DynFlags -> [LocalReg] -> PrimOp -> [CmmExpr] -> FCode ()
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
SizeofArrayOp [CmmExpr
arg]
emitPrimOp dflags :: DynFlags
dflags [res :: LocalReg
res] SizeofMutableArrayArrayOp [arg :: CmmExpr
arg]
   = DynFlags -> [LocalReg] -> PrimOp -> [CmmExpr] -> FCode ()
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
SizeofArrayOp [CmmExpr
arg]

emitPrimOp dflags :: DynFlags
dflags [res :: LocalReg
res] SizeofSmallArrayOp [arg :: 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 dflags :: DynFlags
dflags [res :: LocalReg
res] SizeofSmallMutableArrayOp [arg :: CmmExpr
arg] =
    DynFlags -> [LocalReg] -> PrimOp -> [CmmExpr] -> FCode ()
emitPrimOp DynFlags
dflags [LocalReg
res] PrimOp
SizeofSmallArrayOp [CmmExpr
arg]

-- IndexXXXoffAddr

emitPrimOp dflags :: DynFlags
dflags res :: [LocalReg]
res IndexOffAddrOp_Char             args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexOffAddrOp_WideChar         args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexOffAddrOp_Int              args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexOffAddrOp_Word             args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexOffAddrOp_Addr             args :: [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 _      res :: [LocalReg]
res IndexOffAddrOp_Float            args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 [LocalReg]
res [CmmExpr]
args
emitPrimOp _      res :: [LocalReg]
res IndexOffAddrOp_Double           args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 [LocalReg]
res [CmmExpr]
args
emitPrimOp dflags :: DynFlags
dflags res :: [LocalReg]
res IndexOffAddrOp_StablePtr        args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexOffAddrOp_Int8             args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexOffAddrOp_Int16            args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexOffAddrOp_Int32            args :: [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 _      res :: [LocalReg]
res IndexOffAddrOp_Int64            args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args
emitPrimOp dflags :: DynFlags
dflags res :: [LocalReg]
res IndexOffAddrOp_Word8            args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexOffAddrOp_Word16           args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexOffAddrOp_Word32           args :: [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 _      res :: [LocalReg]
res IndexOffAddrOp_Word64           args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadOffAddrOp_Char             args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadOffAddrOp_WideChar         args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadOffAddrOp_Int              args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadOffAddrOp_Word             args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadOffAddrOp_Addr             args :: [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 _      res :: [LocalReg]
res ReadOffAddrOp_Float            args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 [LocalReg]
res [CmmExpr]
args
emitPrimOp _      res :: [LocalReg]
res ReadOffAddrOp_Double           args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 [LocalReg]
res [CmmExpr]
args
emitPrimOp dflags :: DynFlags
dflags res :: [LocalReg]
res ReadOffAddrOp_StablePtr        args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadOffAddrOp_Int8             args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadOffAddrOp_Int16            args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadOffAddrOp_Int32            args :: [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 _      res :: [LocalReg]
res ReadOffAddrOp_Int64            args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args
emitPrimOp dflags :: DynFlags
dflags res :: [LocalReg]
res ReadOffAddrOp_Word8            args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadOffAddrOp_Word16           args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadOffAddrOp_Word32           args :: [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 _      res :: [LocalReg]
res ReadOffAddrOp_Word64           args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args

-- IndexXXXArray

emitPrimOp dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_Char             args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_WideChar         args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_Int              args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_Word             args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_Addr             args :: [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 _      res :: [LocalReg]
res IndexByteArrayOp_Float            args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 [LocalReg]
res [CmmExpr]
args
emitPrimOp _      res :: [LocalReg]
res IndexByteArrayOp_Double           args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 [LocalReg]
res [CmmExpr]
args
emitPrimOp dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_StablePtr        args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_Int8             args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_Int16            args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_Int32            args :: [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 _      res :: [LocalReg]
res IndexByteArrayOp_Int64            args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64  [LocalReg]
res [CmmExpr]
args
emitPrimOp dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_Word8            args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_Word16           args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_Word32           args :: [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 _      res :: [LocalReg]
res IndexByteArrayOp_Word64           args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_Char             args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_WideChar         args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_Int              args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_Word             args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_Addr             args :: [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 _      res :: [LocalReg]
res ReadByteArrayOp_Float            args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 [LocalReg]
res [CmmExpr]
args
emitPrimOp _      res :: [LocalReg]
res ReadByteArrayOp_Double           args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 [LocalReg]
res [CmmExpr]
args
emitPrimOp dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_StablePtr        args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_Int8             args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_Int16            args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_Int32            args :: [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 _      res :: [LocalReg]
res ReadByteArrayOp_Int64            args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64  [LocalReg]
res [CmmExpr]
args
emitPrimOp dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_Word8            args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_Word16           args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_Word32           args :: [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 _      res :: [LocalReg]
res ReadByteArrayOp_Word64           args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64  [LocalReg]
res [CmmExpr]
args

-- IndexWord8ArrayAsXXX

emitPrimOp dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_Word8AsChar      args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_Word8AsWideChar  args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_Word8AsInt       args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_Word8AsWord      args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_Word8AsAddr      args :: [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 _      res :: [LocalReg]
res IndexByteArrayOp_Word8AsFloat     args :: [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 _      res :: [LocalReg]
res IndexByteArrayOp_Word8AsDouble    args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_Word8AsStablePtr args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_Word8AsInt16     args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_Word8AsInt32     args :: [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 _      res :: [LocalReg]
res IndexByteArrayOp_Word8AsInt64     args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_Word8AsWord16    args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res IndexByteArrayOp_Word8AsWord32    args :: [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 _      res :: [LocalReg]
res IndexByteArrayOp_Word8AsWord64    args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_Word8AsChar      args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_Word8AsWideChar  args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_Word8AsInt       args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_Word8AsWord      args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_Word8AsAddr      args :: [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 _      res :: [LocalReg]
res ReadByteArrayOp_Word8AsFloat     args :: [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 _      res :: [LocalReg]
res ReadByteArrayOp_Word8AsDouble    args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_Word8AsStablePtr args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_Word8AsInt16     args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_Word8AsInt32     args :: [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 _      res :: [LocalReg]
res ReadByteArrayOp_Word8AsInt64     args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_Word8AsWord16    args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res ReadByteArrayOp_Word8AsWord32    args :: [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 _      res :: [LocalReg]
res ReadByteArrayOp_Word8AsWord64    args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteOffAddrOp_Char             args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteOffAddrOp_WideChar         args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteOffAddrOp_Int              args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteOffAddrOp_Word             args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteOffAddrOp_Addr             args :: [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 _      res :: [LocalReg]
res WriteOffAddrOp_Float            args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 [LocalReg]
res [CmmExpr]
args
emitPrimOp _      res :: [LocalReg]
res WriteOffAddrOp_Double           args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 [LocalReg]
res [CmmExpr]
args
emitPrimOp dflags :: DynFlags
dflags res :: [LocalReg]
res WriteOffAddrOp_StablePtr        args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteOffAddrOp_Int8             args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteOffAddrOp_Int16            args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteOffAddrOp_Int32            args :: [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 _      res :: [LocalReg]
res WriteOffAddrOp_Int64            args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args
emitPrimOp dflags :: DynFlags
dflags res :: [LocalReg]
res WriteOffAddrOp_Word8            args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteOffAddrOp_Word16           args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteOffAddrOp_Word32           args :: [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 _      res :: [LocalReg]
res WriteOffAddrOp_Word64           args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args

-- WriteXXXArray

emitPrimOp dflags :: DynFlags
dflags res :: [LocalReg]
res WriteByteArrayOp_Char             args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteByteArrayOp_WideChar         args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteByteArrayOp_Int              args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteByteArrayOp_Word             args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteByteArrayOp_Addr             args :: [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 _      res :: [LocalReg]
res WriteByteArrayOp_Float            args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 [LocalReg]
res [CmmExpr]
args
emitPrimOp _      res :: [LocalReg]
res WriteByteArrayOp_Double           args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 [LocalReg]
res [CmmExpr]
args
emitPrimOp dflags :: DynFlags
dflags res :: [LocalReg]
res WriteByteArrayOp_StablePtr        args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteByteArrayOp_Int8             args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteByteArrayOp_Int16            args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteByteArrayOp_Int32            args :: [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 _      res :: [LocalReg]
res WriteByteArrayOp_Int64            args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args
emitPrimOp dflags :: DynFlags
dflags res :: [LocalReg]
res WriteByteArrayOp_Word8            args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteByteArrayOp_Word16           args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteByteArrayOp_Word32           args :: [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 _      res :: [LocalReg]
res WriteByteArrayOp_Word64           args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args

-- WriteInt8ArrayAsXXX

emitPrimOp dflags :: DynFlags
dflags res :: [LocalReg]
res WriteByteArrayOp_Word8AsChar       args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteByteArrayOp_Word8AsWideChar   args :: [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 _      res :: [LocalReg]
res WriteByteArrayOp_Word8AsInt        args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp _      res :: [LocalReg]
res WriteByteArrayOp_Word8AsWord       args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp _      res :: [LocalReg]
res WriteByteArrayOp_Word8AsAddr       args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp _      res :: [LocalReg]
res WriteByteArrayOp_Word8AsFloat      args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp _      res :: [LocalReg]
res WriteByteArrayOp_Word8AsDouble     args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp _      res :: [LocalReg]
res WriteByteArrayOp_Word8AsStablePtr  args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp dflags :: DynFlags
dflags res :: [LocalReg]
res WriteByteArrayOp_Word8AsInt16      args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteByteArrayOp_Word8AsInt32      args :: [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 _      res :: [LocalReg]
res WriteByteArrayOp_Word8AsInt64      args :: [CmmExpr]
args = Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
emitPrimOp dflags :: DynFlags
dflags res :: [LocalReg]
res WriteByteArrayOp_Word8AsWord16     args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res WriteByteArrayOp_Word8AsWord32     args :: [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 _      res :: [LocalReg]
res WriteByteArrayOp_Word8AsWord64     args :: [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 _      [] CopyByteArrayOp [src :: CmmExpr
src,src_off :: CmmExpr
src_off,dst :: CmmExpr
dst,dst_off :: CmmExpr
dst_off,n :: CmmExpr
n] =
    CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyByteArrayOp CmmExpr
src CmmExpr
src_off CmmExpr
dst CmmExpr
dst_off CmmExpr
n
emitPrimOp _      [] CopyMutableByteArrayOp [src :: CmmExpr
src,src_off :: CmmExpr
src_off,dst :: CmmExpr
dst,dst_off :: CmmExpr
dst_off,n :: CmmExpr
n] =
    CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyMutableByteArrayOp CmmExpr
src CmmExpr
src_off CmmExpr
dst CmmExpr
dst_off CmmExpr
n
emitPrimOp _      [] CopyByteArrayToAddrOp [src :: CmmExpr
src,src_off :: CmmExpr
src_off,dst :: CmmExpr
dst,n :: CmmExpr
n] =
    CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyByteArrayToAddrOp CmmExpr
src CmmExpr
src_off CmmExpr
dst CmmExpr
n
emitPrimOp _      [] CopyMutableByteArrayToAddrOp [src :: CmmExpr
src,src_off :: CmmExpr
src_off,dst :: CmmExpr
dst,n :: CmmExpr
n] =
    CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyMutableByteArrayToAddrOp CmmExpr
src CmmExpr
src_off CmmExpr
dst CmmExpr
n
emitPrimOp _      [] CopyAddrToByteArrayOp [src :: CmmExpr
src,dst :: CmmExpr
dst,dst_off :: CmmExpr
dst_off,n :: CmmExpr
n] =
    CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyAddrToByteArrayOp CmmExpr
src CmmExpr
dst CmmExpr
dst_off CmmExpr
n
emitPrimOp _      [] SetByteArrayOp [ba :: CmmExpr
ba,off :: CmmExpr
off,len :: CmmExpr
len,c :: CmmExpr
c] =
    CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doSetByteArrayOp CmmExpr
ba CmmExpr
off CmmExpr
len CmmExpr
c

-- Comparing byte arrays
emitPrimOp _      [res :: LocalReg
res] CompareByteArraysOp [ba1 :: CmmExpr
ba1,ba1_off :: CmmExpr
ba1_off,ba2 :: CmmExpr
ba2,ba2_off :: CmmExpr
ba2_off,n :: 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 _      [res :: LocalReg
res] BSwap16Op [w :: CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitBSwapCall LocalReg
res CmmExpr
w Width
W16
emitPrimOp _      [res :: LocalReg
res] BSwap32Op [w :: CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitBSwapCall LocalReg
res CmmExpr
w Width
W32
emitPrimOp _      [res :: LocalReg
res] BSwap64Op [w :: CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitBSwapCall LocalReg
res CmmExpr
w Width
W64
emitPrimOp dflags :: DynFlags
dflags [res :: LocalReg
res] BSwapOp   [w :: CmmExpr
w] = LocalReg -> CmmExpr -> Width -> FCode ()
emitBSwapCall LocalReg
res CmmExpr
w (DynFlags -> Width
wordWidth DynFlags
dflags)

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

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

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

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

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

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

-- SIMD primops
emitPrimOp dflags :: DynFlags
dflags [res :: LocalReg
res] (VecBroadcastOp vcat :: PrimOpVecCat
vcat n :: Int
n w :: Width
w) [e :: 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
             IntVec   -> Integer -> Width -> CmmLit
CmmInt 0 Width
w
             WordVec  -> Integer -> Width -> CmmLit
CmmInt 0 Width
w
             FloatVec -> Rational -> Width -> CmmLit
CmmFloat 0 Width
w

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

emitPrimOp dflags :: DynFlags
dflags [res :: LocalReg
res] (VecPackOp vcat :: PrimOpVecCat
vcat n :: Int
n w :: Width
w) es :: [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 "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
             IntVec   -> Integer -> Width -> CmmLit
CmmInt 0 Width
w
             WordVec  -> Integer -> Width -> CmmLit
CmmInt 0 Width
w
             FloatVec -> Rational -> Width -> CmmLit
CmmFloat 0 Width
w

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

emitPrimOp dflags :: DynFlags
dflags res :: [LocalReg]
res (VecUnpackOp vcat :: PrimOpVecCat
vcat n :: Int
n w :: Width
w) [arg :: 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 "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 dflags :: DynFlags
dflags [res :: LocalReg
res] (VecInsertOp vcat :: PrimOpVecCat
vcat n :: Int
n w :: Width
w) [v :: CmmExpr
v,e :: CmmExpr
e,i :: 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 dflags :: DynFlags
dflags res :: [LocalReg]
res (VecIndexByteArrayOp vcat :: PrimOpVecCat
vcat n :: Int
n w :: Width
w) args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res (VecReadByteArrayOp vcat :: PrimOpVecCat
vcat n :: Int
n w :: Width
w) args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res (VecWriteByteArrayOp vcat :: PrimOpVecCat
vcat n :: Int
n w :: Width
w) args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res (VecIndexOffAddrOp vcat :: PrimOpVecCat
vcat n :: Int
n w :: Width
w) args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res (VecReadOffAddrOp vcat :: PrimOpVecCat
vcat n :: Int
n w :: Width
w) args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res (VecWriteOffAddrOp vcat :: PrimOpVecCat
vcat n :: Int
n w :: Width
w) args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res (VecIndexScalarByteArrayOp vcat :: PrimOpVecCat
vcat n :: Int
n w :: Width
w) args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res (VecReadScalarByteArrayOp vcat :: PrimOpVecCat
vcat n :: Int
n w :: Width
w) args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res (VecWriteScalarByteArrayOp vcat :: PrimOpVecCat
vcat n :: Int
n w :: Width
w) args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res (VecIndexScalarOffAddrOp vcat :: PrimOpVecCat
vcat n :: Int
n w :: Width
w) args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res (VecReadScalarOffAddrOp vcat :: PrimOpVecCat
vcat n :: Int
n w :: Width
w) args :: [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 dflags :: DynFlags
dflags res :: [LocalReg]
res (VecWriteScalarOffAddrOp vcat :: PrimOpVecCat
vcat n :: Int
n w :: Width
w) args :: [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 _ [] PrefetchByteArrayOp3        args :: [CmmExpr]
args = Int -> [CmmExpr] -> FCode ()
doPrefetchByteArrayOp 3  [CmmExpr]
args
emitPrimOp _ [] PrefetchMutableByteArrayOp3 args :: [CmmExpr]
args = Int -> [CmmExpr] -> FCode ()
doPrefetchMutableByteArrayOp 3  [CmmExpr]
args
emitPrimOp _ [] PrefetchAddrOp3             args :: [CmmExpr]
args = Int -> [CmmExpr] -> FCode ()
doPrefetchAddrOp  3  [CmmExpr]
args
emitPrimOp _ [] PrefetchValueOp3            args :: [CmmExpr]
args = Int -> [CmmExpr] -> FCode ()
doPrefetchValueOp 3 [CmmExpr]
args

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

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

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

-- Atomic read-modify-write
emitPrimOp dflags :: DynFlags
dflags [res :: LocalReg
res] FetchAddByteArrayOp_Int [mba :: CmmExpr
mba, ix :: CmmExpr
ix, n :: 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 dflags :: DynFlags
dflags [res :: LocalReg
res] FetchSubByteArrayOp_Int [mba :: CmmExpr
mba, ix :: CmmExpr
ix, n :: 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 dflags :: DynFlags
dflags [res :: LocalReg
res] FetchAndByteArrayOp_Int [mba :: CmmExpr
mba, ix :: CmmExpr
ix, n :: 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 dflags :: DynFlags
dflags [res :: LocalReg
res] FetchNandByteArrayOp_Int [mba :: CmmExpr
mba, ix :: CmmExpr
ix, n :: 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 dflags :: DynFlags
dflags [res :: LocalReg
res] FetchOrByteArrayOp_Int [mba :: CmmExpr
mba, ix :: CmmExpr
ix, n :: 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 dflags :: DynFlags
dflags [res :: LocalReg
res] FetchXorByteArrayOp_Int [mba :: CmmExpr
mba, ix :: CmmExpr
ix, n :: 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 dflags :: DynFlags
dflags [res :: LocalReg
res] AtomicReadByteArrayOp_Int [mba :: CmmExpr
mba, ix :: CmmExpr
ix] =
    LocalReg -> CmmExpr -> CmmExpr -> CmmType -> FCode ()
doAtomicReadByteArray LocalReg
res CmmExpr
mba CmmExpr
ix (DynFlags -> CmmType
bWord DynFlags
dflags)
emitPrimOp dflags :: DynFlags
dflags [] AtomicWriteByteArrayOp_Int [mba :: CmmExpr
mba, ix :: CmmExpr
ix, val :: CmmExpr
val] =
    CmmExpr -> CmmExpr -> CmmType -> CmmExpr -> FCode ()
doAtomicWriteByteArray CmmExpr
mba CmmExpr
ix (DynFlags -> CmmType
bWord DynFlags
dflags) CmmExpr
val
emitPrimOp dflags :: DynFlags
dflags [res :: LocalReg
res] CasByteArrayOp_Int [mba :: CmmExpr
mba, ix :: CmmExpr
ix, old :: CmmExpr
old, new :: 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 dflags :: DynFlags
dflags [res :: LocalReg
res] op :: PrimOp
op [arg :: CmmExpr
arg]
   | PrimOp -> Bool
nopOp PrimOp
op
   = CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) CmmExpr
arg

   | Just (mop :: Width -> Width -> MachOp
mop,rep :: 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 dflags :: DynFlags
dflags r :: [LocalReg]
r@[res :: LocalReg
res] op :: PrimOp
op args :: [CmmExpr]
args
   | Just prim :: CallishMachOp
prim <- PrimOp -> Maybe CallishMachOp
callishOp PrimOp
op
   = do [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [LocalReg]
r CallishMachOp
prim [CmmExpr]
args

   | Just mop :: 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 dflags :: DynFlags
dflags results :: [LocalReg]
results op :: PrimOp
op args :: [CmmExpr]
args
   = case DynFlags
-> PrimOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
callishPrimOpSupported DynFlags
dflags PrimOp
op of
          Left op :: 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 gen :: [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 dflags :: DynFlags
dflags op :: PrimOp
op
  = case PrimOp
op of
      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))

      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)

      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)


      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))

      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)

      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)

      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)

      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

      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

      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

      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

      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

      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
      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
      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

      _ -> String
-> SDoc
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a. HasCallStack => String -> SDoc -> a
pprPanic "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
           HscAsm -> Bool
True
           _      -> Bool
False
  llvm :: Bool
llvm = case DynFlags -> HscTarget
hscTarget DynFlags
dflags of
           HscLlvm -> Bool
True
           _       -> Bool
False
  x86ish :: Bool
x86ish = case Platform -> Arch
platformArch (DynFlags -> Platform
targetPlatform DynFlags
dflags) of
             ArchX86    -> Bool
True
             ArchX86_64 -> Bool
True
             _          -> Bool
False
  ppc :: Bool
ppc = case Platform -> Arch
platformArch (DynFlags -> Platform
targetPlatform DynFlags
dflags) of
          ArchPPC      -> Bool
True
          ArchPPC_64 _ -> Bool
True
          _            -> Bool
False

genericIntQuotRemOp :: Width -> GenericOp
genericIntQuotRemOp :: Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericIntQuotRemOp width :: Width
width [res_q :: LocalReg
res_q, res_r :: LocalReg
res_r] [arg_x :: CmmExpr
arg_x, arg_y :: 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 _ _ _ = String -> FCode ()
forall a. String -> a
panic "genericIntQuotRemOp"

genericWordQuotRemOp :: Width -> GenericOp
genericWordQuotRemOp :: Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericWordQuotRemOp width :: Width
width [res_q :: LocalReg
res_q, res_r :: LocalReg
res_r] [arg_x :: CmmExpr
arg_x, arg_y :: 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 _ _ _ = String -> FCode ()
forall a. String -> a
panic "genericWordQuotRemOp"

genericWordQuotRem2Op :: DynFlags -> GenericOp
genericWordQuotRem2Op :: DynFlags -> [LocalReg] -> [CmmExpr] -> FCode ()
genericWordQuotRem2Op dflags :: DynFlags
dflags [res_q :: LocalReg
res_q, res_r :: LocalReg
res_r] [arg_x_high :: CmmExpr
arg_x_high, arg_x_low :: CmmExpr
arg_x_low, arg_y :: 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   x :: CmmExpr
x i :: CmmExpr
i = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Shl   (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
i]
             shr :: CmmExpr -> CmmExpr -> CmmExpr
shr   x :: CmmExpr
x i :: 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    x :: CmmExpr
x y :: CmmExpr
y = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Or    (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
y]
             ge :: CmmExpr -> CmmExpr -> CmmExpr
ge    x :: CmmExpr
x y :: 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    x :: CmmExpr
x y :: CmmExpr
y = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Ne    (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
y]
             minus :: CmmExpr -> CmmExpr -> CmmExpr
minus x :: CmmExpr
x y :: CmmExpr
y = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Sub   (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
y]
             times :: CmmExpr -> CmmExpr -> CmmExpr
times x :: CmmExpr
x y :: 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 0
             one :: CmmExpr
one    = Integer -> CmmExpr
lit 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
- 1)
             lit :: Integer -> CmmExpr
lit i :: 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 0 acc :: CmmExpr
acc high :: CmmExpr
high _ = 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 i :: Int
i acc :: CmmExpr
acc high :: CmmExpr
high low :: 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
- 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 _ _ _ = String -> FCode ()
forall a. String -> a
panic "genericWordQuotRem2Op"

genericWordAdd2Op :: GenericOp
genericWordAdd2Op :: [LocalReg] -> [CmmExpr] -> FCode ()
genericWordAdd2Op [res_h :: LocalReg
res_h, res_l :: LocalReg
res_l] [arg_x :: CmmExpr
arg_x, arg_y :: 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 x :: CmmExpr
x = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_U_Shr (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
hww]
           toTopHalf :: CmmExpr -> CmmExpr
toTopHalf x :: CmmExpr
x = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Shl (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
hww]
           bottomHalf :: CmmExpr -> CmmExpr
bottomHalf x :: CmmExpr
x = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_And (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
hwm]
           add :: CmmExpr -> CmmExpr -> CmmExpr
add x :: CmmExpr
x y :: CmmExpr
y = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
y]
           or :: CmmExpr -> CmmExpr -> CmmExpr
or x :: CmmExpr
x y :: 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 _ _ = String -> FCode ()
forall a. String -> a
panic "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 [res_r :: LocalReg
res_r, res_c :: LocalReg
res_c] [aa :: CmmExpr
aa, bb :: 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
- 1)
          ]
        ]
genericWordAddCOp _ _ = String -> FCode ()
forall a. String -> a
panic "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 [res_r :: LocalReg
res_r, res_c :: LocalReg
res_c] [aa :: CmmExpr
aa, bb :: 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
- 1)
          ]
        ]
genericWordSubCOp _ _ = String -> FCode ()
forall a. String -> a
panic "genericWordSubCOp"

genericIntAddCOp :: GenericOp
genericIntAddCOp :: [LocalReg] -> [CmmExpr] -> FCode ()
genericIntAddCOp [res_r :: LocalReg
res_r, res_c :: LocalReg
res_c] [aa :: CmmExpr
aa, bb :: 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
- 1)
          ]
        ]
genericIntAddCOp _ _ = String -> FCode ()
forall a. String -> a
panic "genericIntAddCOp"

genericIntSubCOp :: GenericOp
genericIntSubCOp :: [LocalReg] -> [CmmExpr] -> FCode ()
genericIntSubCOp [res_r :: LocalReg
res_r, res_c :: LocalReg
res_c] [aa :: CmmExpr
aa, bb :: 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
- 1)
          ]
        ]
genericIntSubCOp _ _ = String -> FCode ()
forall a. String -> a
panic "genericIntSubCOp"

genericWordMul2Op :: GenericOp
genericWordMul2Op :: [LocalReg] -> [CmmExpr] -> FCode ()
genericWordMul2Op [res_h :: LocalReg
res_h, res_l :: LocalReg
res_l] [arg_x :: CmmExpr
arg_x, arg_y :: 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 x :: CmmExpr
x = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_U_Shr (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
hww]
          toTopHalf :: CmmExpr -> CmmExpr
toTopHalf x :: CmmExpr
x = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Shl (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
hww]
          bottomHalf :: CmmExpr -> CmmExpr
bottomHalf x :: CmmExpr
x = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_And (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
hwm]
          add :: CmmExpr -> CmmExpr -> CmmExpr
add x :: CmmExpr
x y :: 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 x :: CmmExpr
x y :: CmmExpr
y = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Mul (DynFlags -> Width
wordWidth DynFlags
dflags)) [CmmExpr
x, CmmExpr
y]
          or :: CmmExpr -> CmmExpr -> CmmExpr
or x :: CmmExpr
x y :: 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 _ _ = String -> FCode ()
forall a. String -> a
panic "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 w :: Width
w [res_r :: LocalReg
res_r] [aa :: 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 0 Width
w)

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

          neg :: CmmExpr -> CmmExpr
neg x :: 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 _ _ _ = String -> FCode ()
forall a. String -> a
panic "genericFabsOp"

-- These PrimOps are NOPs in Cmm

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

-- These PrimOps turn into double casts

narrowOp :: PrimOp -> Maybe (Width -> Width -> MachOp, Width)
narrowOp :: PrimOp -> Maybe (Width -> Width -> MachOp, Width)
narrowOp 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 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 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 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 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 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 _              = 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 dflags :: DynFlags
dflags IntAddOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordAdd DynFlags
dflags)
translateOp dflags :: DynFlags
dflags IntSubOp       = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordSub DynFlags
dflags)
translateOp dflags :: DynFlags
dflags WordAddOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordAdd DynFlags
dflags)
translateOp dflags :: DynFlags
dflags WordSubOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordSub DynFlags
dflags)
translateOp dflags :: DynFlags
dflags AddrAddOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordAdd DynFlags
dflags)
translateOp dflags :: DynFlags
dflags AddrSubOp      = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordSub DynFlags
dflags)

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

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

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

-- Native word signed ops

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


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

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

-- Native word unsigned ops

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

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

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

-- Int8# signed ops

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

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

-- Word8# unsigned ops

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

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

-- Int16# signed ops

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

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

-- Word16# unsigned ops

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

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

-- Char# ops

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

-- Double ops

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

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

-- Float ops

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

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

-- Vector ops

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

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

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

-- Conversions

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

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

translateOp _      Float2DoubleOp = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Width -> Width -> MachOp
MO_FF_Conv Width
W32 Width
W64)
translateOp _      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 dflags :: DynFlags
dflags SameMutVarOp           = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)
translateOp dflags :: DynFlags
dflags SameMVarOp             = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)
translateOp dflags :: DynFlags
dflags SameMutableArrayOp     = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)
translateOp dflags :: DynFlags
dflags SameMutableByteArrayOp = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)
translateOp dflags :: DynFlags
dflags SameMutableArrayArrayOp= MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)
translateOp dflags :: DynFlags
dflags SameSmallMutableArrayOp= MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)
translateOp dflags :: DynFlags
dflags SameTVarOp             = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)
translateOp dflags :: DynFlags
dflags EqStablePtrOp          = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)
-- See Note [Comparing stable names]
translateOp dflags :: DynFlags
dflags EqStableNameOp         = MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_wordEq DynFlags
dflags)

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

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

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

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

doIndexByteArrayOp :: Maybe MachOp
                   -> CmmType
                   -> [LocalReg]
                   -> [CmmExpr]
                   -> FCode ()
doIndexByteArrayOp :: Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp maybe_post_read_cast :: Maybe MachOp
maybe_post_read_cast rep :: CmmType
rep [res :: LocalReg
res] [addr :: CmmExpr
addr,idx :: 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 _ _ _ _
   = String -> FCode ()
forall a. String -> a
panic "StgCmmPrim: doIndexByteArrayOp"

doIndexByteArrayOpAs :: Maybe MachOp
                    -> CmmType
                    -> CmmType
                    -> [LocalReg]
                    -> [CmmExpr]
                    -> FCode ()
doIndexByteArrayOpAs :: Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs maybe_post_read_cast :: Maybe MachOp
maybe_post_read_cast rep :: CmmType
rep idx_rep :: CmmType
idx_rep [res :: LocalReg
res] [addr :: CmmExpr
addr,idx :: 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 _ _ _ _ _
   = String -> FCode ()
forall a. String -> a
panic "StgCmmPrim: doIndexByteArrayOpAs"

doReadPtrArrayOp :: LocalReg
                 -> CmmExpr
                 -> CmmExpr
                 -> FCode ()
doReadPtrArrayOp :: LocalReg -> CmmExpr -> CmmExpr -> FCode ()
doReadPtrArrayOp res :: LocalReg
res addr :: CmmExpr
addr idx :: 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_pre_write_cast :: Maybe MachOp
maybe_pre_write_cast idx_ty :: CmmType
idx_ty [] [addr :: CmmExpr
addr,idx :: CmmExpr
idx,val :: CmmExpr
val]
   = Int
-> Maybe MachOp
-> CmmExpr
-> CmmType
-> CmmExpr
-> CmmExpr
-> FCode ()
mkBasicIndexedWrite 0 Maybe MachOp
maybe_pre_write_cast CmmExpr
addr CmmType
idx_ty CmmExpr
idx CmmExpr
val
doWriteOffAddrOp _ _ _ _
   = String -> FCode ()
forall a. String -> a
panic "StgCmmPrim: doWriteOffAddrOp"

doWriteByteArrayOp :: Maybe MachOp
                   -> CmmType
                   -> [LocalReg]
                   -> [CmmExpr]
                   -> FCode ()
doWriteByteArrayOp :: Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp maybe_pre_write_cast :: Maybe MachOp
maybe_pre_write_cast idx_ty :: CmmType
idx_ty [] [addr :: CmmExpr
addr,idx :: CmmExpr
idx,val :: 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 _ _ _ _
   = String -> FCode ()
forall a. String -> a
panic "StgCmmPrim: doWriteByteArrayOp"

doWritePtrArrayOp :: CmmExpr
                  -> CmmExpr
                  -> CmmExpr
                  -> FCode ()
doWritePtrArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doWritePtrArrayOp addr :: CmmExpr
addr idx :: CmmExpr
idx val :: 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 1 Width
W8))

loadArrPtrsSize :: DynFlags -> CmmExpr -> CmmExpr
loadArrPtrsSize :: DynFlags -> CmmExpr -> CmmExpr
loadArrPtrsSize dflags :: DynFlags
dflags addr :: 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 off :: Int
off Nothing ty :: CmmType
ty res :: LocalReg
res base :: CmmExpr
base idx_ty :: CmmType
idx_ty idx :: 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 off :: Int
off (Just cast :: MachOp
cast) ty :: CmmType
ty res :: LocalReg
res base :: CmmExpr
base idx_ty :: CmmType
idx_ty idx :: 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 off :: Int
off Nothing base :: CmmExpr
base idx_ty :: CmmType
idx_ty idx :: CmmExpr
idx val :: 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 off :: Int
off (Just cast :: MachOp
cast) base :: CmmExpr
base idx_ty :: CmmType
idx_ty idx :: CmmExpr
idx val :: 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 dflags :: DynFlags
dflags off :: Int
off width :: Width
width base :: CmmExpr
base idx :: 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 dflags :: DynFlags
dflags off :: Int
off ty :: CmmType
ty base :: CmmExpr
base idx_ty :: CmmType
idx_ty idx :: 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 closure_ptr :: CmmExpr
closure_ptr info_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 pocat :: PrimOpVecCat
pocat n :: Int
n w :: 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 IntVec   = Width -> CmmType
cmmBits
vecCmmCat WordVec  = Width -> CmmType
cmmBits
vecCmmCat FloatVec = Width -> CmmType
cmmFloat

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

vecElemProjectCast :: DynFlags -> PrimOpVecCat -> Width -> Maybe MachOp
vecElemProjectCast :: DynFlags -> PrimOpVecCat -> Width -> Maybe MachOp
vecElemProjectCast _      FloatVec _   =  Maybe MachOp
forall a. Maybe a
Nothing
vecElemProjectCast dflags :: DynFlags
dflags IntVec   W8  =  MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_8ToWord  DynFlags
dflags)
vecElemProjectCast dflags :: DynFlags
dflags IntVec   W16 =  MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_16ToWord DynFlags
dflags)
vecElemProjectCast dflags :: DynFlags
dflags IntVec   W32 =  MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_s_32ToWord DynFlags
dflags)
vecElemProjectCast _      IntVec   W64 =  Maybe MachOp
forall a. Maybe a
Nothing
vecElemProjectCast dflags :: DynFlags
dflags WordVec  W8  =  MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_8ToWord  DynFlags
dflags)
vecElemProjectCast dflags :: DynFlags
dflags WordVec  W16 =  MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_16ToWord DynFlags
dflags)
vecElemProjectCast dflags :: DynFlags
dflags WordVec  W32 =  MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (DynFlags -> MachOp
mo_u_32ToWord DynFlags
dflags)
vecElemProjectCast _      WordVec  W64 =  Maybe MachOp
forall a. Maybe a
Nothing
vecElemProjectCast _      _        _   =  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 dflags :: DynFlags
dflags vcat :: PrimOpVecCat
vcat l :: Int
l w :: 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 ["SIMD vector instructions require the LLVM back-end."
                         ,"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 W128 FloatVec 4 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
$ "128-bit wide single-precision floating point " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                "SIMD vector instructions require at least -msse."
    check W128 _ _ _ | 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
$ "128-bit wide integer and double precision " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                "SIMD vector instructions require at least -msse2."
    check W256 FloatVec _ _ | 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
$ "256-bit wide floating point " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                "SIMD vector instructions require at least -mavx."
    check W256 _ _ _ | 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
$ "256-bit wide integer " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                "SIMD vector instructions require at least -mavx2."
    check W512 _ _ _ | 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
$ "512-bit wide " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                "SIMD vector instructions require -mavx512f."
    check _ _ _ _ = () -> 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_pre_write_cast :: Maybe MachOp
maybe_pre_write_cast ty :: CmmType
ty z :: CmmExpr
z es :: [CmmExpr]
es res :: 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 0
  where
    vecPack :: CmmFormal -> [CmmExpr] -> Int -> FCode ()
    vecPack :: LocalReg -> [CmmExpr] -> Int -> FCode ()
vecPack src :: LocalReg
src [] _ =
        CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
src))

    vecPack src :: LocalReg
src (e :: CmmExpr
e : es :: [CmmExpr]
es) i :: 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
+ 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 val :: CmmExpr
val = case Maybe MachOp
maybe_pre_write_cast of
                 Nothing   -> CmmExpr
val
                 Just cast :: 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_post_read_cast :: Maybe MachOp
maybe_post_read_cast ty :: CmmType
ty e :: CmmExpr
e res :: [LocalReg]
res =
    [LocalReg] -> Int -> FCode ()
vecUnpack [LocalReg]
res 0
  where
    vecUnpack :: [CmmFormal] -> Int -> FCode ()
    vecUnpack :: [LocalReg] -> Int -> FCode ()
vecUnpack [] _ =
        () -> FCode ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    vecUnpack (r :: LocalReg
r : rs :: [LocalReg]
rs) i :: 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
+ 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 val :: CmmExpr
val = case Maybe MachOp
maybe_post_read_cast of
                 Nothing   -> CmmExpr
val
                 Just cast :: 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_pre_write_cast :: Maybe MachOp
maybe_pre_write_cast ty :: CmmType
ty src :: CmmExpr
src e :: CmmExpr
e idx :: CmmExpr
idx res :: 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 val :: CmmExpr
val = case Maybe MachOp
maybe_pre_write_cast of
                 Nothing   -> CmmExpr
val
                 Just cast :: 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 locality :: Int
locality  [addr :: CmmExpr
addr,idx :: 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 _ _
   = String -> FCode ()
forall a. String -> a
panic "StgCmmPrim: doPrefetchByteArrayOp"

-- | Translate mutable byte array prefetch operations into proper primcalls.
doPrefetchMutableByteArrayOp :: Int
                      -> [CmmExpr]
                      -> FCode ()
doPrefetchMutableByteArrayOp :: Int -> [CmmExpr] -> FCode ()
doPrefetchMutableByteArrayOp locality :: Int
locality  [addr :: CmmExpr
addr,idx :: 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 _ _
   = String -> FCode ()
forall a. String -> a
panic "StgCmmPrim: doPrefetchByteArrayOp"

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

-- | Translate value prefetch operations into proper primcalls.
doPrefetchValueOp :: Int
                 -> [CmmExpr]
                 -> FCode ()
doPrefetchValueOp :: Int -> [CmmExpr] -> FCode ()
doPrefetchValueOp  locality :: Int
locality   [addr :: CmmExpr
addr]
  =  do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        Int -> Int -> CmmExpr -> CmmExpr -> FCode ()
mkBasicPrefetch Int
locality 0 CmmExpr
addr  (CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt 0 (DynFlags -> Width
wordWidth DynFlags
dflags)))
doPrefetchValueOp _ _
  = String -> FCode ()
forall a. String -> a
panic "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 locality :: Int
locality off :: Int
off base :: CmmExpr
base idx :: 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 res_r :: LocalReg
res_r n :: 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 res :: LocalReg
res ba1 :: CmmExpr
ba1 ba1_off :: CmmExpr
ba1_off ba2 :: CmmExpr
ba2 ba2_off :: CmmExpr
ba2_off n :: 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 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 _src :: p
_src _dst :: p
_dst dst_p :: CmmExpr
dst_p src_p :: CmmExpr
src_p bytes :: CmmExpr
bytes =
        CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemcpyCall CmmExpr
dst_p CmmExpr
src_p CmmExpr
bytes 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 src :: CmmExpr
src dst :: CmmExpr
dst dst_p :: CmmExpr
dst_p src_p :: CmmExpr
src_p bytes :: CmmExpr
bytes = do
        DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        (moveCall :: CmmAGraph
moveCall, cpyCall :: 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 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 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 copy :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
copy src :: CmmExpr
src src_off :: CmmExpr
src_off dst :: CmmExpr
dst dst_off :: CmmExpr
dst_off n :: 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 src :: CmmExpr
src src_off :: CmmExpr
src_off dst_p :: CmmExpr
dst_p bytes :: 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 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 src_p :: CmmExpr
src_p dst :: CmmExpr
dst dst_off :: CmmExpr
dst_off bytes :: 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 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 ba :: CmmExpr
ba off :: CmmExpr
off len :: CmmExpr
len c :: 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 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 res_r :: LocalReg
res_r rep :: SMRep
rep info :: CLabel
info payload :: [(CmmExpr, Int)]
payload n :: Int
n init :: 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)) 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 e :: 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 _src :: p
_src _dst :: p
_dst dst_p :: CmmExpr
dst_p src_p :: CmmExpr
src_p bytes :: 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 src :: CmmExpr
src dst :: CmmExpr
dst dst_p :: CmmExpr
dst_p src_p :: CmmExpr
src_p bytes :: Int
bytes = do
        DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        (moveCall :: CmmAGraph
moveCall, cpyCall :: 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 copy :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
copy src0 :: CmmExpr
src0 src_off :: CmmExpr
src_off dst0 :: CmmExpr
dst0 dst_off0 :: CmmExpr
dst_off0 n :: 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
/= 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 _src :: p
_src _dst :: p
_dst dst_p :: CmmExpr
dst_p src_p :: CmmExpr
src_p bytes :: 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 src :: CmmExpr
src dst :: CmmExpr
dst dst_p :: CmmExpr
dst_p src_p :: CmmExpr
src_p bytes :: Int
bytes = do
        DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        (moveCall :: CmmAGraph
moveCall, cpyCall :: 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 copy :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
copy src0 :: CmmExpr
src0 src_off :: CmmExpr
src_off dst0 :: CmmExpr
dst0 dst_off :: CmmExpr
dst_off n :: 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 info_p :: CLabel
info_p res_r :: LocalReg
res_r src :: CmmExpr
src src_off :: CmmExpr
src_off n :: 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 info_p :: CLabel
info_p res_r :: LocalReg
res_r src :: CmmExpr
src src_off :: CmmExpr
src_off n :: 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 dst_start :: CmmExpr
dst_start dst_cards_start :: CmmExpr
dst_cards_start n :: 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 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 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 1))
        1 -- no alignment (1 byte)

-- Convert an element index to a card index
cardCmm :: DynFlags -> CmmExpr -> CmmExpr
cardCmm :: DynFlags -> CmmExpr -> CmmExpr
cardCmm dflags :: DynFlags
dflags i :: 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 res :: LocalReg
res addr :: CmmExpr
addr idx :: 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 addr :: CmmExpr
addr idx :: CmmExpr
idx val :: 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 res :: LocalReg
res amop :: AtomicMachOp
amop mba :: CmmExpr
mba idx :: CmmExpr
idx idx_ty :: CmmType
idx_ty n :: 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 res :: LocalReg
res mba :: CmmExpr
mba idx :: CmmExpr
idx idx_ty :: 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 mba :: CmmExpr
mba idx :: CmmExpr
idx idx_ty :: CmmType
idx_ty val :: 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 res :: LocalReg
res mba :: CmmExpr
mba idx :: CmmExpr
idx idx_ty :: CmmType
idx_ty old :: CmmExpr
old new :: 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 dst :: CmmExpr
dst src :: CmmExpr
src n :: CmmExpr
n align :: 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 dst :: CmmExpr
dst src :: CmmExpr
src n :: CmmExpr
n align :: 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 dst :: CmmExpr
dst c :: CmmExpr
c n :: CmmExpr
n align :: 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 res :: LocalReg
res ptr1 :: CmmExpr
ptr1 ptr2 :: CmmExpr
ptr2 n :: CmmExpr
n align :: 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 res :: LocalReg
res x :: CmmExpr
x width :: 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 res :: LocalReg
res x :: CmmExpr
x width :: 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 res :: LocalReg
res x :: CmmExpr
x y :: CmmExpr
y width :: 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 res :: LocalReg
res x :: CmmExpr
x y :: CmmExpr
y width :: 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 res :: LocalReg
res x :: CmmExpr
x width :: 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 res :: LocalReg
res x :: CmmExpr
x width :: Width
width = do
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ LocalReg
res ]
        (Width -> CallishMachOp
MO_Ctz Width
width)
        [ CmmExpr
x ]