{-# LANGUAGE LambdaCase #-}

{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

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

module GHC.StgToCmm.Prim (
   cgOpApp,
   shouldInlinePrimOp
 ) where

import GHC.Prelude hiding ((<*>))

import GHC.Platform
import GHC.Platform.Profile

import GHC.StgToCmm.Config
import GHC.StgToCmm.Layout
import GHC.StgToCmm.Foreign
import GHC.StgToCmm.Monad
import GHC.StgToCmm.Utils
import GHC.StgToCmm.Ticky
import GHC.StgToCmm.Heap
import GHC.StgToCmm.Prof ( costCentreFrom )

import GHC.Types.Basic
import GHC.Cmm.BlockId
import GHC.Cmm.Graph
import GHC.Stg.Syntax
import GHC.Cmm
import GHC.Unit         ( rtsUnit )
import GHC.Core.Type    ( Type, tyConAppTyCon_maybe )
import GHC.Core.TyCon
import GHC.Cmm.CLabel
import GHC.Cmm.Info     ( closureInfoPtr )
import GHC.Cmm.Utils
import GHC.Builtin.PrimOps
import GHC.Runtime.Heap.Layout
import GHC.Data.FastString
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import Data.Maybe

import Control.Monad (liftM, when, unless)
import GHC.Utils.Outputable

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

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

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

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

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

cgOpApp (StgPrimOp PrimOp
primop) [StgArg]
args Type
res_ty = do
    StgToCmmConfig
cfg <- FCode StgToCmmConfig
getStgToCmmConfig
    [CmmExpr]
cmm_args <- [StgArg] -> FCode [CmmExpr]
getNonVoidArgAmodes [StgArg]
args
    StgToCmmConfig
-> PrimOp -> [CmmExpr] -> Maybe Type -> FCode ReturnKind
cmmPrimOpApp StgToCmmConfig
cfg PrimOp
primop [CmmExpr]
cmm_args (Type -> Maybe Type
forall a. a -> Maybe a
Just Type
res_ty)

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

cmmPrimOpApp :: StgToCmmConfig -> PrimOp -> [CmmExpr] -> Maybe Type -> FCode ReturnKind
cmmPrimOpApp :: StgToCmmConfig
-> PrimOp -> [CmmExpr] -> Maybe Type -> FCode ReturnKind
cmmPrimOpApp StgToCmmConfig
cfg PrimOp
primop [CmmExpr]
cmm_args Maybe Type
mres_ty =
  case StgToCmmConfig -> PrimOp -> [CmmExpr] -> PrimopCmmEmit
emitPrimOp StgToCmmConfig
cfg PrimOp
primop [CmmExpr]
cmm_args of
    PrimopCmmEmit_Internal Type -> FCode [CmmExpr]
f ->
      let
         -- if the result type isn't explicitly given, we directly use the
         -- result type of the primop.
         res_ty :: Type
res_ty = Type -> Maybe Type -> Type
forall a. a -> Maybe a -> a
fromMaybe (PrimOp -> Type
primOpResultType PrimOp
primop) Maybe Type
mres_ty
      in [CmmExpr] -> FCode ReturnKind
emitReturn ([CmmExpr] -> FCode ReturnKind)
-> FCode [CmmExpr] -> FCode ReturnKind
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> FCode [CmmExpr]
f Type
res_ty
    PrimopCmmEmit
PrimopCmmEmit_External -> do
      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


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

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

shouldInlinePrimOp :: StgToCmmConfig -> PrimOp -> [CmmExpr] -> Bool
shouldInlinePrimOp :: StgToCmmConfig -> PrimOp -> [CmmExpr] -> Bool
shouldInlinePrimOp StgToCmmConfig
cfg PrimOp
op [CmmExpr]
args = case StgToCmmConfig -> PrimOp -> [CmmExpr] -> PrimopCmmEmit
emitPrimOp StgToCmmConfig
cfg PrimOp
op [CmmExpr]
args of
  PrimopCmmEmit
PrimopCmmEmit_External -> Bool
False
  PrimopCmmEmit_Internal Type -> FCode [CmmExpr]
_ -> Bool
True

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

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

-- | The big function handling all the primops.
--
-- In the simple case, there is just one implementation, and we emit that.
--
-- In more complex cases, there is a foreign call (out of line) fallback. This
-- might happen e.g. if there's enough static information, such as statically
-- know arguments.
emitPrimOp
  :: StgToCmmConfig
  -> PrimOp            -- ^ The primop
  -> [CmmExpr]         -- ^ The primop arguments
  -> PrimopCmmEmit
emitPrimOp :: StgToCmmConfig -> PrimOp -> [CmmExpr] -> PrimopCmmEmit
emitPrimOp StgToCmmConfig
cfg PrimOp
primop =
  let max_inl_alloc_size :: Integer
max_inl_alloc_size = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (StgToCmmConfig -> Int
stgToCmmMaxInlAllocSize StgToCmmConfig
cfg)
  in case PrimOp
primop of
  PrimOp
NewByteArrayOp_Char -> \case
    [(CmmLit (CmmInt Integer
n Width
w))]
      | Width -> Integer -> Integer
asUnsigned Width
w Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
max_inl_alloc_size
      -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs  (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] -> LocalReg -> Int -> FCode ()
doNewByteArrayOp LocalReg
res (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)
    [CmmExpr]
_ -> PrimopCmmEmit
PrimopCmmEmit_External

  PrimOp
NewArrayOp -> \case
    [(CmmLit (CmmInt Integer
n Width
w)), CmmExpr
init]
      | Platform -> Integer -> Integer
forall a. Num a => Platform -> a -> a
wordsToBytes Platform
platform (Width -> Integer -> Integer
asUnsigned Width
w Integer
n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
max_inl_alloc_size
      -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] -> LocalReg
-> SMRep
-> CLabel
-> [(CmmExpr, Int)]
-> Int
-> CmmExpr
-> FCode ()
doNewArrayOp LocalReg
res (Platform -> Int -> SMRep
arrPtrsRep Platform
platform (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)) CLabel
mkMAP_DIRTY_infoLabel
        [ (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n),
           Profile -> Int
fixedHdrSize Profile
profile Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PlatformConstants -> Int
pc_OFFSET_StgMutArrPtrs_ptrs (Platform -> PlatformConstants
platformConstants Platform
platform))
        , (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (SMRep -> Int
nonHdrSizeW (Platform -> Int -> SMRep
arrPtrsRep Platform
platform (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n))),
           Profile -> Int
fixedHdrSize Profile
profile Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PlatformConstants -> Int
pc_OFFSET_StgMutArrPtrs_size (Platform -> PlatformConstants
platformConstants Platform
platform))
        ]
        (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n) CmmExpr
init
    [CmmExpr]
_ -> PrimopCmmEmit
PrimopCmmEmit_External

  PrimOp
CopyArrayOp -> \case
    [CmmExpr
src, CmmExpr
src_off, CmmExpr
dst, CmmExpr
dst_off, (CmmLit (CmmInt Integer
n Width
_))] ->
      ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
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)
    [CmmExpr]
_ -> PrimopCmmEmit
PrimopCmmEmit_External

  PrimOp
CopyMutableArrayOp -> \case
    [CmmExpr
src, CmmExpr
src_off, CmmExpr
dst, CmmExpr
dst_off, (CmmLit (CmmInt Integer
n Width
_))] ->
      ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
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)
    [CmmExpr]
_ -> PrimopCmmEmit
PrimopCmmEmit_External

  PrimOp
CloneArrayOp -> \case
    [CmmExpr
src, CmmExpr
src_off, (CmmLit (CmmInt Integer
n Width
w))]
      | Platform -> Integer -> Integer
forall a. Num a => Platform -> a -> a
wordsToBytes Platform
platform (Width -> Integer -> Integer
asUnsigned Width
w Integer
n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
max_inl_alloc_size
      -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] -> CLabel -> LocalReg -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCloneArray CLabel
mkMAP_FROZEN_CLEAN_infoLabel LocalReg
res CmmExpr
src CmmExpr
src_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)
    [CmmExpr]
_ -> PrimopCmmEmit
PrimopCmmEmit_External

  PrimOp
CloneMutableArrayOp -> \case
    [CmmExpr
src, CmmExpr
src_off, (CmmLit (CmmInt Integer
n Width
w))]
      | Platform -> Integer -> Integer
forall a. Num a => Platform -> a -> a
wordsToBytes Platform
platform (Width -> Integer -> Integer
asUnsigned Width
w Integer
n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
max_inl_alloc_size
      -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] -> CLabel -> LocalReg -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCloneArray CLabel
mkMAP_DIRTY_infoLabel LocalReg
res CmmExpr
src CmmExpr
src_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)
    [CmmExpr]
_ -> PrimopCmmEmit
PrimopCmmEmit_External

  PrimOp
FreezeArrayOp -> \case
    [CmmExpr
src, CmmExpr
src_off, (CmmLit (CmmInt Integer
n Width
w))]
      | Platform -> Integer -> Integer
forall a. Num a => Platform -> a -> a
wordsToBytes Platform
platform (Width -> Integer -> Integer
asUnsigned Width
w Integer
n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
max_inl_alloc_size
      -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] -> CLabel -> LocalReg -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCloneArray CLabel
mkMAP_FROZEN_CLEAN_infoLabel LocalReg
res CmmExpr
src CmmExpr
src_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)
    [CmmExpr]
_ -> PrimopCmmEmit
PrimopCmmEmit_External

  PrimOp
ThawArrayOp -> \case
    [CmmExpr
src, CmmExpr
src_off, (CmmLit (CmmInt Integer
n Width
w))]
      | Platform -> Integer -> Integer
forall a. Num a => Platform -> a -> a
wordsToBytes Platform
platform (Width -> Integer -> Integer
asUnsigned Width
w Integer
n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
max_inl_alloc_size
      -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] -> CLabel -> LocalReg -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCloneArray CLabel
mkMAP_DIRTY_infoLabel LocalReg
res CmmExpr
src CmmExpr
src_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)
    [CmmExpr]
_ -> PrimopCmmEmit
PrimopCmmEmit_External

  PrimOp
NewSmallArrayOp -> \case
    [(CmmLit (CmmInt Integer
n Width
w)), CmmExpr
init]
      | Platform -> Integer -> Integer
forall a. Num a => Platform -> a -> a
wordsToBytes Platform
platform (Width -> Integer -> Integer
asUnsigned Width
w Integer
n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
max_inl_alloc_size
      -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] ->
        LocalReg
-> SMRep
-> CLabel
-> [(CmmExpr, Int)]
-> Int
-> CmmExpr
-> FCode ()
doNewArrayOp LocalReg
res (Int -> SMRep
smallArrPtrsRep (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)) CLabel
mkSMAP_DIRTY_infoLabel
        [ (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n),
           Profile -> Int
fixedHdrSize Profile
profile Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PlatformConstants -> Int
pc_OFFSET_StgSmallMutArrPtrs_ptrs (Platform -> PlatformConstants
platformConstants Platform
platform))
        ]
        (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n) CmmExpr
init
    [CmmExpr]
_ -> PrimopCmmEmit
PrimopCmmEmit_External

  PrimOp
CopySmallArrayOp -> \case
    [CmmExpr
src, CmmExpr
src_off, CmmExpr
dst, CmmExpr
dst_off, (CmmLit (CmmInt Integer
n Width
_))] ->
      ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
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)
    [CmmExpr]
_ -> PrimopCmmEmit
PrimopCmmEmit_External

  PrimOp
CopySmallMutableArrayOp -> \case
    [CmmExpr
src, CmmExpr
src_off, CmmExpr
dst, CmmExpr
dst_off, (CmmLit (CmmInt Integer
n Width
_))] ->
      ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
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)
    [CmmExpr]
_ -> PrimopCmmEmit
PrimopCmmEmit_External

  PrimOp
CloneSmallArrayOp -> \case
    [CmmExpr
src, CmmExpr
src_off, (CmmLit (CmmInt Integer
n Width
w))]
      | Platform -> Integer -> Integer
forall a. Num a => Platform -> a -> a
wordsToBytes Platform
platform (Width -> Integer -> Integer
asUnsigned Width
w Integer
n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
max_inl_alloc_size
      -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] -> CLabel -> LocalReg -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCloneSmallArray CLabel
mkSMAP_FROZEN_CLEAN_infoLabel LocalReg
res CmmExpr
src CmmExpr
src_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)
    [CmmExpr]
_ -> PrimopCmmEmit
PrimopCmmEmit_External

  PrimOp
CloneSmallMutableArrayOp -> \case
    [CmmExpr
src, CmmExpr
src_off, (CmmLit (CmmInt Integer
n Width
w))]
      | Platform -> Integer -> Integer
forall a. Num a => Platform -> a -> a
wordsToBytes Platform
platform (Width -> Integer -> Integer
asUnsigned Width
w Integer
n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
max_inl_alloc_size
      -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] -> CLabel -> LocalReg -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCloneSmallArray CLabel
mkSMAP_DIRTY_infoLabel LocalReg
res CmmExpr
src CmmExpr
src_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)
    [CmmExpr]
_ -> PrimopCmmEmit
PrimopCmmEmit_External

  PrimOp
FreezeSmallArrayOp -> \case
    [CmmExpr
src, CmmExpr
src_off, (CmmLit (CmmInt Integer
n Width
w))]
      | Platform -> Integer -> Integer
forall a. Num a => Platform -> a -> a
wordsToBytes Platform
platform (Width -> Integer -> Integer
asUnsigned Width
w Integer
n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
max_inl_alloc_size
      -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] -> CLabel -> LocalReg -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCloneSmallArray CLabel
mkSMAP_FROZEN_CLEAN_infoLabel LocalReg
res CmmExpr
src CmmExpr
src_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)
    [CmmExpr]
_ -> PrimopCmmEmit
PrimopCmmEmit_External

  PrimOp
ThawSmallArrayOp -> \case
    [CmmExpr
src, CmmExpr
src_off, (CmmLit (CmmInt Integer
n Width
w))]
      | Platform -> Integer -> Integer
forall a. Num a => Platform -> a -> a
wordsToBytes Platform
platform (Width -> Integer -> Integer
asUnsigned Width
w Integer
n) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
max_inl_alloc_size
      -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \ [LocalReg
res] -> CLabel -> LocalReg -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCloneSmallArray CLabel
mkSMAP_DIRTY_infoLabel LocalReg
res CmmExpr
src CmmExpr
src_off (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)
    [CmmExpr]
_ -> PrimopCmmEmit
PrimopCmmEmit_External

-- First we handle various awkward cases specially.

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

  PrimOp
SparkOp -> \[CmmExpr
arg] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] -> 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 (Platform -> CmmType
bWord Platform
platform)
    [(LocalReg, ForeignHint)]
-> CmmExpr -> [(CmmExpr, ForeignHint)] -> FCode ()
emitCCall
        [(LocalReg
tmp2,ForeignHint
NoHint)]
        (CmmLit -> CmmExpr
CmmLit (CLabel -> CmmLit
CmmLabel (FastString
-> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel (String -> FastString
fsLit String
"newSpark") Maybe Int
forall a. Maybe a
Nothing ForeignLabelSource
ForeignLabelInExternalPackage FunctionOrData
IsFunction)))
        [(CmmExpr
baseExpr, ForeignHint
AddrHint), ((CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
tmp)), ForeignHint
AddrHint)]
    CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
tmp))

  PrimOp
GetCCSOfOp -> \[CmmExpr
arg] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] -> do
    let
      val :: CmmExpr
val
       | Profile -> Bool
profileIsProfiling Profile
profile = Platform -> CmmExpr -> CmmExpr
costCentreFrom Platform
platform (Platform -> CmmExpr -> CmmExpr
cmmUntag Platform
platform CmmExpr
arg)
       | Bool
otherwise                  = CmmLit -> CmmExpr
CmmLit (Platform -> CmmLit
zeroCLit Platform
platform)
    CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) CmmExpr
val

  PrimOp
GetCurrentCCSOp -> \[CmmExpr
_] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) CmmExpr
cccsExpr

  PrimOp
MyThreadIdOp -> \[] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) CmmExpr
currentTSOExpr

  PrimOp
ReadMutVarOp -> \[CmmExpr
mutv] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [LocalReg
res] (Width -> MemoryOrdering -> CallishMachOp
MO_AtomicRead (Platform -> Width
wordWidth Platform
platform) MemoryOrdering
MemOrderAcquire)
        [ Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetW Platform
platform CmmExpr
mutv (Profile -> Int
fixedHdrSizeW Profile
profile) ]

  PrimOp
WriteMutVarOp -> \[CmmExpr
mutv, CmmExpr
var] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] -> do
    CmmReg
old_val <- 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 (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
var)
    CmmReg -> CmmExpr -> FCode ()
emitAssign CmmReg
old_val (Platform -> CmmExpr -> Int -> CmmType -> CmmExpr
cmmLoadIndexW Platform
platform CmmExpr
mutv (Profile -> Int
fixedHdrSizeW Profile
profile) (Platform -> CmmType
gcWord Platform
platform))

    -- Without this write barrier, other CPUs may see this pointer before
    -- the writes for the closure it points to have occurred.
    -- Note that this also must come after we read the old value to ensure
    -- that the read of old_val comes before another core's write to the
    -- MutVar's value.
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [] (Width -> MemoryOrdering -> CallishMachOp
MO_AtomicWrite (Platform -> Width
wordWidth Platform
platform) MemoryOrdering
MemOrderRelease)
        [ Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetW Platform
platform CmmExpr
mutv (Profile -> Int
fixedHdrSizeW Profile
profile), CmmExpr
var ]

    Platform
platform <- FCode Platform
getPlatform
    CmmAGraph
mkdirtyMutVarCCall <- FCode () -> FCode CmmAGraph
forall a. FCode a -> FCode CmmAGraph
getCode (FCode () -> FCode CmmAGraph) -> FCode () -> FCode CmmAGraph
forall a b. (a -> b) -> a -> b
$! [(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), (CmmReg -> CmmExpr
CmmReg CmmReg
old_val, ForeignHint
AddrHint)]
    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
      (Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmEqWord Platform
platform (CLabel -> CmmExpr
mkLblExpr CLabel
mkMUT_VAR_CLEAN_infoLabel)
       (Platform -> Bool -> CmmExpr -> CmmExpr
closureInfoPtr Platform
platform (StgToCmmConfig -> Bool
stgToCmmAlignCheck StgToCmmConfig
cfg) CmmExpr
mutv))
      CmmAGraph
mkdirtyMutVarCCall

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

--  #define sizzeofMutableByteArrayzh(r,a) \
--      r = ((StgArrBytes *)(a))->bytes
  PrimOp
SizeofMutableByteArrayOp -> StgToCmmConfig -> PrimOp -> [CmmExpr] -> PrimopCmmEmit
emitPrimOp StgToCmmConfig
cfg PrimOp
SizeofByteArrayOp

--  #define getSizzeofMutableByteArrayzh(r,a) \
--      r = ((StgArrBytes *)(a))->bytes
  PrimOp
GetSizeofMutableByteArrayOp -> \[CmmExpr
arg] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (Platform -> CmmExpr -> Int -> CmmType -> CmmExpr
cmmLoadIndexW Platform
platform CmmExpr
arg (Profile -> Int
fixedHdrSizeW Profile
profile) (Platform -> CmmType
bWord Platform
platform))


--  #define touchzh(o)                  /* nothing */
  PrimOp
TouchOp -> \args :: [CmmExpr]
args@[CmmExpr
_] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \res :: [LocalReg]
res@[] ->
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [LocalReg]
res CallishMachOp
MO_Touch [CmmExpr]
args

--  #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
  PrimOp
ByteArrayContents_Char -> \[CmmExpr
arg] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
arg (Profile -> Int
arrWordsHdrSize Profile
profile))

--  #define mutableByteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
  PrimOp
MutableByteArrayContents_Char -> \[CmmExpr
arg] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
arg (Profile -> Int
arrWordsHdrSize Profile
profile))

--  #define stableNameToIntzh(r,s)   (r = ((StgStableName *)s)->sn)
  PrimOp
StableNameToIntOp -> \[CmmExpr
arg] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (Platform -> CmmExpr -> Int -> CmmType -> CmmExpr
cmmLoadIndexW Platform
platform CmmExpr
arg (Profile -> Int
fixedHdrSizeW Profile
profile) (Platform -> CmmType
bWord Platform
platform))

  PrimOp
EqStablePtrOp -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordEq Platform
platform)

  PrimOp
ReallyUnsafePtrEqualityOp -> \[CmmExpr
arg1, CmmExpr
arg2] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordEq Platform
platform) [CmmExpr
arg1,CmmExpr
arg2])

--  #define addrToHValuezh(r,a) r=(P_)a
  PrimOp
AddrToAnyOp -> \[CmmExpr
arg] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) CmmExpr
arg

--  #define hvalueToAddrzh(r, a) r=(W_)a
  PrimOp
AnyToAddrOp -> \[CmmExpr
arg] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    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;
--      }
  PrimOp
UnsafeFreezeArrayOp -> \[CmmExpr
arg] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    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 ]
  PrimOp
UnsafeFreezeSmallArrayOp -> \[CmmExpr
arg] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    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)
  PrimOp
UnsafeFreezeByteArrayOp -> \[CmmExpr
arg] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) CmmExpr
arg

-- Reading/writing pointer arrays

  PrimOp
ReadArrayOp -> \[CmmExpr
obj, CmmExpr
ix] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> CmmExpr -> FCode ()
doReadPtrArrayOp LocalReg
res CmmExpr
obj CmmExpr
ix
  PrimOp
IndexArrayOp -> \[CmmExpr
obj, CmmExpr
ix] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> CmmExpr -> FCode ()
doReadPtrArrayOp LocalReg
res CmmExpr
obj CmmExpr
ix
  PrimOp
WriteArrayOp -> \[CmmExpr
obj, CmmExpr
ix, CmmExpr
v] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doWritePtrArrayOp CmmExpr
obj CmmExpr
ix CmmExpr
v

  PrimOp
ReadSmallArrayOp -> \[CmmExpr
obj, CmmExpr
ix] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> CmmExpr -> FCode ()
doReadSmallPtrArrayOp LocalReg
res CmmExpr
obj CmmExpr
ix
  PrimOp
IndexSmallArrayOp -> \[CmmExpr
obj, CmmExpr
ix] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> CmmExpr -> FCode ()
doReadSmallPtrArrayOp LocalReg
res CmmExpr
obj CmmExpr
ix
  PrimOp
WriteSmallArrayOp -> \[CmmExpr
obj,CmmExpr
ix,CmmExpr
v] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doWriteSmallPtrArrayOp CmmExpr
obj CmmExpr
ix CmmExpr
v

-- Getting the size of pointer arrays

  PrimOp
SizeofArrayOp -> \[CmmExpr
arg] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (Platform -> CmmExpr -> Int -> CmmType -> CmmExpr
cmmLoadIndexW Platform
platform CmmExpr
arg
      (Profile -> Int
fixedHdrSizeW Profile
profile Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Platform -> Int -> Int
bytesToWordsRoundUp Platform
platform (PlatformConstants -> Int
pc_OFFSET_StgMutArrPtrs_ptrs (Platform -> PlatformConstants
platformConstants Platform
platform)))
        (Platform -> CmmType
bWord Platform
platform))
  PrimOp
SizeofMutableArrayOp      -> StgToCmmConfig -> PrimOp -> [CmmExpr] -> PrimopCmmEmit
emitPrimOp StgToCmmConfig
cfg PrimOp
SizeofArrayOp
  PrimOp
SizeofSmallArrayOp -> \[CmmExpr
arg] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res)
     (Platform -> CmmExpr -> Int -> CmmType -> CmmExpr
cmmLoadIndexW Platform
platform CmmExpr
arg
     (Profile -> Int
fixedHdrSizeW Profile
profile Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Platform -> Int -> Int
bytesToWordsRoundUp Platform
platform (PlatformConstants -> Int
pc_OFFSET_StgSmallMutArrPtrs_ptrs (Platform -> PlatformConstants
platformConstants Platform
platform)))
        (Platform -> CmmType
bWord Platform
platform))

  PrimOp
SizeofSmallMutableArrayOp    -> StgToCmmConfig -> PrimOp -> [CmmExpr] -> PrimopCmmEmit
emitPrimOp StgToCmmConfig
cfg PrimOp
SizeofSmallArrayOp
  PrimOp
GetSizeofSmallMutableArrayOp -> StgToCmmConfig -> PrimOp -> [CmmExpr] -> PrimopCmmEmit
emitPrimOp StgToCmmConfig
cfg PrimOp
SizeofSmallArrayOp

-- IndexXXXoffAddr

  PrimOp
IndexOffAddrOp_Char -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Platform -> MachOp
mo_u_8ToWord Platform
platform)) CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexOffAddrOp_WideChar -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Platform -> MachOp
mo_u_32ToWord Platform
platform)) CmmType
b32 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexOffAddrOp_Int -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexOffAddrOp_Word -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexOffAddrOp_Addr -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexOffAddrOp_Float -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexOffAddrOp_Double -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexOffAddrOp_StablePtr -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexOffAddrOp_Int8 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8  [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexOffAddrOp_Int16 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b16 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexOffAddrOp_Int32 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b32 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexOffAddrOp_Int64 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexOffAddrOp_Word8 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8  [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexOffAddrOp_Word16 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b16 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexOffAddrOp_Word32 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b32 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexOffAddrOp_Word64 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    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.

  PrimOp
ReadOffAddrOp_Char -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Platform -> MachOp
mo_u_8ToWord Platform
platform)) CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadOffAddrOp_WideChar -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Platform -> MachOp
mo_u_32ToWord Platform
platform)) CmmType
b32 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadOffAddrOp_Int -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadOffAddrOp_Word -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadOffAddrOp_Addr -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadOffAddrOp_Float -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadOffAddrOp_Double -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadOffAddrOp_StablePtr -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadOffAddrOp_Int8 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8  [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadOffAddrOp_Int16 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b16 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadOffAddrOp_Int32 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b32 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadOffAddrOp_Int64 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadOffAddrOp_Word8 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8  [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadOffAddrOp_Word16 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b16 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadOffAddrOp_Word32 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b32 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadOffAddrOp_Word64 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args

-- IndexXXXArray

  PrimOp
IndexByteArrayOp_Char -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Platform -> MachOp
mo_u_8ToWord Platform
platform)) CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_WideChar -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Platform -> MachOp
mo_u_32ToWord Platform
platform)) CmmType
b32 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Int -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Word -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Addr -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Float -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Double -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_StablePtr -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Int8 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8  [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Int16 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b16  [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Int32 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b32  [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Int64 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64  [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Word8 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8  [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Word16 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b16  [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Word32 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b32  [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Word64 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64  [LocalReg]
res [CmmExpr]
args

-- ReadXXXArray, identical to IndexXXXArray.

  PrimOp
ReadByteArrayOp_Char -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Platform -> MachOp
mo_u_8ToWord Platform
platform)) CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_WideChar -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Platform -> MachOp
mo_u_32ToWord Platform
platform)) CmmType
b32 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Int -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Word -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Addr -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Float -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Double -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_StablePtr -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Int8 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8  [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Int16 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b16  [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Int32 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b32  [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Int64 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64  [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Word8 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8  [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Word16 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b16  [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Word32 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b32  [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Word64 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64  [LocalReg]
res [CmmExpr]
args

-- IndexWord8ArrayAsXXX

  PrimOp
IndexByteArrayOp_Word8AsChar -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Platform -> MachOp
mo_u_8ToWord Platform
platform)) CmmType
b8 CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Word8AsWideChar -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Platform -> MachOp
mo_u_32ToWord Platform
platform)) CmmType
b32 CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Word8AsInt -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Word8AsWord -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Word8AsAddr -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Word8AsFloat -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Word8AsDouble -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Word8AsStablePtr -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Word8AsInt16 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b16 CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Word8AsInt32 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b32 CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Word8AsInt64 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Word8AsWord16 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b16 CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Word8AsWord32 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b32 CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
IndexByteArrayOp_Word8AsWord64 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    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

  PrimOp
ReadByteArrayOp_Word8AsChar -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Platform -> MachOp
mo_u_8ToWord Platform
platform)) CmmType
b8 CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Word8AsWideChar -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Platform -> MachOp
mo_u_32ToWord Platform
platform)) CmmType
b32 CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Word8AsInt -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Word8AsWord -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Word8AsAddr -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Word8AsFloat -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Word8AsDouble -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Word8AsStablePtr -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Word8AsInt16 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b16 CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Word8AsInt32 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b32 CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Word8AsInt64 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Word8AsWord16 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b16 CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Word8AsWord32 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b32 CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
ReadByteArrayOp_Word8AsWord64 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs   Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 CmmType
b8 [LocalReg]
res [CmmExpr]
args

-- WriteXXXoffAddr

  PrimOp
WriteOffAddrOp_Char -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Platform -> MachOp
mo_WordTo8 Platform
platform))  CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteOffAddrOp_WideChar -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Platform -> MachOp
mo_WordTo32 Platform
platform)) CmmType
b32 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteOffAddrOp_Int -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteOffAddrOp_Word -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteOffAddrOp_Addr -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteOffAddrOp_Float -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteOffAddrOp_Double -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteOffAddrOp_StablePtr -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteOffAddrOp_Int8 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteOffAddrOp_Int16 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b16 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteOffAddrOp_Int32 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b32 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteOffAddrOp_Int64 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteOffAddrOp_Word8 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteOffAddrOp_Word16 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b16 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteOffAddrOp_Word32 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b32 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteOffAddrOp_Word64 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args

-- WriteXXXArray

  PrimOp
WriteByteArrayOp_Char -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Platform -> MachOp
mo_WordTo8 Platform
platform))  CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_WideChar -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Platform -> MachOp
mo_WordTo32 Platform
platform)) CmmType
b32 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Int -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Word -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Addr -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Float -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
f32 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Double -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
f64 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_StablePtr -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
bWord Platform
platform) [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Int8 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Int16 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b16 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Int32 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b32 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Int64 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Word8 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8  [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Word16 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b16 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Word32 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b32 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Word64 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b64 [LocalReg]
res [CmmExpr]
args

-- WriteInt8ArrayAsXXX

  PrimOp
WriteByteArrayOp_Word8AsChar -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Platform -> MachOp
mo_WordTo8 Platform
platform))  CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Word8AsWideChar -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp (MachOp -> Maybe MachOp
forall a. a -> Maybe a
Just (Platform -> MachOp
mo_WordTo32 Platform
platform)) CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Word8AsInt -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Word8AsWord -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Word8AsAddr -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Word8AsFloat -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Word8AsDouble -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Word8AsStablePtr -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Word8AsInt16 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Word8AsInt32 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Word8AsInt64 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Word8AsWord16 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Word8AsWord32 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
b8 [LocalReg]
res [CmmExpr]
args
  PrimOp
WriteByteArrayOp_Word8AsWord64 -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res ->
    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
  PrimOp
CopyByteArrayOp -> \[CmmExpr
src,CmmExpr
src_off,CmmExpr
dst,CmmExpr
dst_off,CmmExpr
n] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyByteArrayOp CmmExpr
src CmmExpr
src_off CmmExpr
dst CmmExpr
dst_off CmmExpr
n
  PrimOp
CopyMutableByteArrayOp -> \[CmmExpr
src,CmmExpr
src_off,CmmExpr
dst,CmmExpr
dst_off,CmmExpr
n] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyMutableByteArrayOp CmmExpr
src CmmExpr
src_off CmmExpr
dst CmmExpr
dst_off CmmExpr
n
  PrimOp
CopyByteArrayToAddrOp -> \[CmmExpr
src,CmmExpr
src_off,CmmExpr
dst,CmmExpr
n] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyByteArrayToAddrOp CmmExpr
src CmmExpr
src_off CmmExpr
dst CmmExpr
n
  PrimOp
CopyMutableByteArrayToAddrOp -> \[CmmExpr
src,CmmExpr
src_off,CmmExpr
dst,CmmExpr
n] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyMutableByteArrayToAddrOp CmmExpr
src CmmExpr
src_off CmmExpr
dst CmmExpr
n
  PrimOp
CopyAddrToByteArrayOp -> \[CmmExpr
src,CmmExpr
dst,CmmExpr
dst_off,CmmExpr
n] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyAddrToByteArrayOp CmmExpr
src CmmExpr
dst CmmExpr
dst_off CmmExpr
n
  PrimOp
SetByteArrayOp -> \[CmmExpr
ba,CmmExpr
off,CmmExpr
len,CmmExpr
c] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doSetByteArrayOp CmmExpr
ba CmmExpr
off CmmExpr
len CmmExpr
c

-- Comparing byte arrays
  PrimOp
CompareByteArraysOp -> \[CmmExpr
ba1,CmmExpr
ba1_off,CmmExpr
ba2,CmmExpr
ba2_off,CmmExpr
n] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCompareByteArraysOp LocalReg
res CmmExpr
ba1 CmmExpr
ba1_off CmmExpr
ba2 CmmExpr
ba2_off CmmExpr
n

  PrimOp
BSwap16Op -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitBSwapCall LocalReg
res CmmExpr
w Width
W16
  PrimOp
BSwap32Op -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitBSwapCall LocalReg
res CmmExpr
w Width
W32
  PrimOp
BSwap64Op -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitBSwapCall LocalReg
res CmmExpr
w Width
W64
  PrimOp
BSwapOp -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitBSwapCall LocalReg
res CmmExpr
w (Platform -> Width
wordWidth Platform
platform)

  PrimOp
BRev8Op -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitBRevCall LocalReg
res CmmExpr
w Width
W8
  PrimOp
BRev16Op -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitBRevCall LocalReg
res CmmExpr
w Width
W16
  PrimOp
BRev32Op -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitBRevCall LocalReg
res CmmExpr
w Width
W32
  PrimOp
BRev64Op -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitBRevCall LocalReg
res CmmExpr
w Width
W64
  PrimOp
BRevOp -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitBRevCall LocalReg
res CmmExpr
w (Platform -> Width
wordWidth Platform
platform)

-- Population count
  PrimOp
PopCnt8Op -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitPopCntCall LocalReg
res CmmExpr
w Width
W8
  PrimOp
PopCnt16Op -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitPopCntCall LocalReg
res CmmExpr
w Width
W16
  PrimOp
PopCnt32Op -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitPopCntCall LocalReg
res CmmExpr
w Width
W32
  PrimOp
PopCnt64Op -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitPopCntCall LocalReg
res CmmExpr
w Width
W64
  PrimOp
PopCntOp -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitPopCntCall LocalReg
res CmmExpr
w (Platform -> Width
wordWidth Platform
platform)

-- Parallel bit deposit
  PrimOp
Pdep8Op -> \[CmmExpr
src, CmmExpr
mask] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPdepCall LocalReg
res CmmExpr
src CmmExpr
mask Width
W8
  PrimOp
Pdep16Op -> \[CmmExpr
src, CmmExpr
mask] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPdepCall LocalReg
res CmmExpr
src CmmExpr
mask Width
W16
  PrimOp
Pdep32Op -> \[CmmExpr
src, CmmExpr
mask] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPdepCall LocalReg
res CmmExpr
src CmmExpr
mask Width
W32
  PrimOp
Pdep64Op -> \[CmmExpr
src, CmmExpr
mask] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPdepCall LocalReg
res CmmExpr
src CmmExpr
mask Width
W64
  PrimOp
PdepOp -> \[CmmExpr
src, CmmExpr
mask] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPdepCall LocalReg
res CmmExpr
src CmmExpr
mask (Platform -> Width
wordWidth Platform
platform)

-- Parallel bit extract
  PrimOp
Pext8Op -> \[CmmExpr
src, CmmExpr
mask] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPextCall LocalReg
res CmmExpr
src CmmExpr
mask Width
W8
  PrimOp
Pext16Op -> \[CmmExpr
src, CmmExpr
mask] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPextCall LocalReg
res CmmExpr
src CmmExpr
mask Width
W16
  PrimOp
Pext32Op -> \[CmmExpr
src, CmmExpr
mask] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPextCall LocalReg
res CmmExpr
src CmmExpr
mask Width
W32
  PrimOp
Pext64Op -> \[CmmExpr
src, CmmExpr
mask] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPextCall LocalReg
res CmmExpr
src CmmExpr
mask Width
W64
  PrimOp
PextOp -> \[CmmExpr
src, CmmExpr
mask] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
emitPextCall LocalReg
res CmmExpr
src CmmExpr
mask (Platform -> Width
wordWidth Platform
platform)

-- count leading zeros
  PrimOp
Clz8Op -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitClzCall LocalReg
res CmmExpr
w Width
W8
  PrimOp
Clz16Op -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitClzCall LocalReg
res CmmExpr
w Width
W16
  PrimOp
Clz32Op -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitClzCall LocalReg
res CmmExpr
w Width
W32
  PrimOp
Clz64Op -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitClzCall LocalReg
res CmmExpr
w Width
W64
  PrimOp
ClzOp -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitClzCall LocalReg
res CmmExpr
w (Platform -> Width
wordWidth Platform
platform)

-- count trailing zeros
  PrimOp
Ctz8Op -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitCtzCall LocalReg
res CmmExpr
w Width
W8
  PrimOp
Ctz16Op -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitCtzCall LocalReg
res CmmExpr
w Width
W16
  PrimOp
Ctz32Op -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitCtzCall LocalReg
res CmmExpr
w Width
W32
  PrimOp
Ctz64Op -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitCtzCall LocalReg
res CmmExpr
w Width
W64
  PrimOp
CtzOp -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> Width -> FCode ()
emitCtzCall LocalReg
res CmmExpr
w (Platform -> Width
wordWidth Platform
platform)

-- Unsigned int to floating point conversions
  PrimOp
WordToFloatOp -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [LocalReg
res] (Width -> CallishMachOp
MO_UF_Conv Width
W32) [CmmExpr
w]
  PrimOp
WordToDoubleOp -> \[CmmExpr
w] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [LocalReg
res] (Width -> CallishMachOp
MO_UF_Conv Width
W64) [CmmExpr
w]

-- Atomic operations
  PrimOp
InterlockedExchange_Addr -> \[CmmExpr
src, CmmExpr
value] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [LocalReg
res] (Width -> CallishMachOp
MO_Xchg (Platform -> Width
wordWidth Platform
platform)) [CmmExpr
src, CmmExpr
value]
  PrimOp
InterlockedExchange_Word -> \[CmmExpr
src, CmmExpr
value] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [LocalReg
res] (Width -> CallishMachOp
MO_Xchg (Platform -> Width
wordWidth Platform
platform)) [CmmExpr
src, CmmExpr
value]

  PrimOp
FetchAddAddrOp_Word -> \[CmmExpr
addr, CmmExpr
n] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg
-> AtomicMachOp -> CmmExpr -> CmmType -> CmmExpr -> FCode ()
doAtomicAddrRMW LocalReg
res AtomicMachOp
AMO_Add CmmExpr
addr (Platform -> CmmType
bWord Platform
platform) CmmExpr
n
  PrimOp
FetchSubAddrOp_Word -> \[CmmExpr
addr, CmmExpr
n] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg
-> AtomicMachOp -> CmmExpr -> CmmType -> CmmExpr -> FCode ()
doAtomicAddrRMW LocalReg
res AtomicMachOp
AMO_Sub CmmExpr
addr (Platform -> CmmType
bWord Platform
platform) CmmExpr
n
  PrimOp
FetchAndAddrOp_Word -> \[CmmExpr
addr, CmmExpr
n] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg
-> AtomicMachOp -> CmmExpr -> CmmType -> CmmExpr -> FCode ()
doAtomicAddrRMW LocalReg
res AtomicMachOp
AMO_And CmmExpr
addr (Platform -> CmmType
bWord Platform
platform) CmmExpr
n
  PrimOp
FetchNandAddrOp_Word -> \[CmmExpr
addr, CmmExpr
n] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg
-> AtomicMachOp -> CmmExpr -> CmmType -> CmmExpr -> FCode ()
doAtomicAddrRMW LocalReg
res AtomicMachOp
AMO_Nand CmmExpr
addr (Platform -> CmmType
bWord Platform
platform) CmmExpr
n
  PrimOp
FetchOrAddrOp_Word -> \[CmmExpr
addr, CmmExpr
n] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg
-> AtomicMachOp -> CmmExpr -> CmmType -> CmmExpr -> FCode ()
doAtomicAddrRMW LocalReg
res AtomicMachOp
AMO_Or CmmExpr
addr (Platform -> CmmType
bWord Platform
platform) CmmExpr
n
  PrimOp
FetchXorAddrOp_Word -> \[CmmExpr
addr, CmmExpr
n] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg
-> AtomicMachOp -> CmmExpr -> CmmType -> CmmExpr -> FCode ()
doAtomicAddrRMW LocalReg
res AtomicMachOp
AMO_Xor CmmExpr
addr (Platform -> CmmType
bWord Platform
platform) CmmExpr
n

  PrimOp
AtomicReadAddrOp_Word -> \[CmmExpr
addr] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> CmmType -> FCode ()
doAtomicReadAddr LocalReg
res CmmExpr
addr (Platform -> CmmType
bWord Platform
platform)
  PrimOp
AtomicWriteAddrOp_Word -> \[CmmExpr
addr, CmmExpr
val] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    CmmExpr -> CmmType -> CmmExpr -> FCode ()
doAtomicWriteAddr CmmExpr
addr (Platform -> CmmType
bWord Platform
platform) CmmExpr
val

  PrimOp
CasAddrOp_Addr -> \[CmmExpr
dst, CmmExpr
expected, CmmExpr
new] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [LocalReg
res] (Width -> CallishMachOp
MO_Cmpxchg (Platform -> Width
wordWidth Platform
platform)) [CmmExpr
dst, CmmExpr
expected, CmmExpr
new]
  PrimOp
CasAddrOp_Word -> \[CmmExpr
dst, CmmExpr
expected, CmmExpr
new] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [LocalReg
res] (Width -> CallishMachOp
MO_Cmpxchg (Platform -> Width
wordWidth Platform
platform)) [CmmExpr
dst, CmmExpr
expected, CmmExpr
new]
  PrimOp
CasAddrOp_Word8 -> \[CmmExpr
dst, CmmExpr
expected, CmmExpr
new] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [LocalReg
res] (Width -> CallishMachOp
MO_Cmpxchg Width
W8) [CmmExpr
dst, CmmExpr
expected, CmmExpr
new]
  PrimOp
CasAddrOp_Word16 -> \[CmmExpr
dst, CmmExpr
expected, CmmExpr
new] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [LocalReg
res] (Width -> CallishMachOp
MO_Cmpxchg Width
W16) [CmmExpr
dst, CmmExpr
expected, CmmExpr
new]
  PrimOp
CasAddrOp_Word32 -> \[CmmExpr
dst, CmmExpr
expected, CmmExpr
new] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [LocalReg
res] (Width -> CallishMachOp
MO_Cmpxchg Width
W32) [CmmExpr
dst, CmmExpr
expected, CmmExpr
new]
  PrimOp
CasAddrOp_Word64 -> \[CmmExpr
dst, CmmExpr
expected, CmmExpr
new] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [LocalReg
res] (Width -> CallishMachOp
MO_Cmpxchg Width
W64) [CmmExpr
dst, CmmExpr
expected, CmmExpr
new]

-- SIMD primops
  (VecBroadcastOp PrimOpVecCat
vcat Int
n Width
w) -> \[CmmExpr
e] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] -> do
    StgToCmmConfig -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility StgToCmmConfig
cfg PrimOpVecCat
vcat Int
n Width
w
    CmmType -> CmmExpr -> [CmmExpr] -> LocalReg -> FCode ()
doVecPackOp CmmType
ty CmmExpr
zeros (Int -> CmmExpr -> [CmmExpr]
forall a. Int -> a -> [a]
replicate Int
n CmmExpr
e) LocalReg
res
   where
    zeros :: CmmExpr
    zeros :: CmmExpr
zeros = CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ [CmmLit] -> CmmLit
CmmVec (Int -> CmmLit -> [CmmLit]
forall a. Int -> a -> [a]
replicate Int
n CmmLit
zero)

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

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

  (VecPackOp PrimOpVecCat
vcat Int
n Width
w) -> \[CmmExpr]
es -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] -> do
    StgToCmmConfig -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility StgToCmmConfig
cfg 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. HasCallStack => String -> a
panic String
"emitPrimOp: VecPackOp has wrong number of arguments"
    CmmType -> CmmExpr -> [CmmExpr] -> LocalReg -> FCode ()
doVecPackOp CmmType
ty CmmExpr
zeros [CmmExpr]
es LocalReg
res
   where
    zeros :: CmmExpr
    zeros :: CmmExpr
zeros = CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ [CmmLit] -> CmmLit
CmmVec (Int -> CmmLit -> [CmmLit]
forall a. Int -> a -> [a]
replicate Int
n CmmLit
zero)

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

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

  (VecUnpackOp PrimOpVecCat
vcat Int
n Width
w) -> \[CmmExpr
arg] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res -> do
    StgToCmmConfig -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility StgToCmmConfig
cfg 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. HasCallStack => String -> a
panic String
"emitPrimOp: VecUnpackOp has wrong number of results"
    CmmType -> CmmExpr -> [LocalReg] -> FCode ()
doVecUnpackOp CmmType
ty CmmExpr
arg [LocalReg]
res
   where
    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

  (VecInsertOp PrimOpVecCat
vcat Int
n Width
w) -> \[CmmExpr
v,CmmExpr
e,CmmExpr
i] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] -> do
    StgToCmmConfig -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility StgToCmmConfig
cfg PrimOpVecCat
vcat Int
n Width
w
    CmmType -> CmmExpr -> CmmExpr -> CmmExpr -> LocalReg -> FCode ()
doVecInsertOp 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

  (VecIndexByteArrayOp PrimOpVecCat
vcat Int
n Width
w) -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res0 -> do
    StgToCmmConfig -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility StgToCmmConfig
cfg PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
ty [LocalReg]
res0 [CmmExpr]
args
   where
    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

  (VecReadByteArrayOp PrimOpVecCat
vcat Int
n Width
w) -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res0 -> do
    StgToCmmConfig -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility StgToCmmConfig
cfg PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
ty [LocalReg]
res0 [CmmExpr]
args
   where
    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

  (VecWriteByteArrayOp PrimOpVecCat
vcat Int
n Width
w) -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res0 -> do
    StgToCmmConfig -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility StgToCmmConfig
cfg PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
ty [LocalReg]
res0 [CmmExpr]
args
   where
    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

  (VecIndexOffAddrOp PrimOpVecCat
vcat Int
n Width
w) -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res0 -> do
    StgToCmmConfig -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility StgToCmmConfig
cfg PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
ty [LocalReg]
res0 [CmmExpr]
args
   where
    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

  (VecReadOffAddrOp PrimOpVecCat
vcat Int
n Width
w) -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res0 -> do
    StgToCmmConfig -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility StgToCmmConfig
cfg PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
ty [LocalReg]
res0 [CmmExpr]
args
   where
    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

  (VecWriteOffAddrOp PrimOpVecCat
vcat Int
n Width
w) -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res0 -> do
    StgToCmmConfig -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility StgToCmmConfig
cfg PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
ty [LocalReg]
res0 [CmmExpr]
args
   where
    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Int -> Width -> CmmType
vecVmmType PrimOpVecCat
vcat Int
n Width
w

  (VecIndexScalarByteArrayOp PrimOpVecCat
vcat Int
n Width
w) -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res0 -> do
    StgToCmmConfig -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility StgToCmmConfig
cfg 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]
res0 [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

  (VecReadScalarByteArrayOp PrimOpVecCat
vcat Int
n Width
w) -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res0 -> do
    StgToCmmConfig -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility StgToCmmConfig
cfg 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]
res0 [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

  (VecWriteScalarByteArrayOp PrimOpVecCat
vcat Int
n Width
w) -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res0 -> do
    StgToCmmConfig -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility StgToCmmConfig
cfg PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
ty [LocalReg]
res0 [CmmExpr]
args
   where
    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Width -> CmmType
vecCmmCat PrimOpVecCat
vcat Width
w

  (VecIndexScalarOffAddrOp PrimOpVecCat
vcat Int
n Width
w) -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res0 -> do
    StgToCmmConfig -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility StgToCmmConfig
cfg 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]
res0 [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

  (VecReadScalarOffAddrOp PrimOpVecCat
vcat Int
n Width
w) -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res0 -> do
    StgToCmmConfig -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility StgToCmmConfig
cfg 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]
res0 [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

  (VecWriteScalarOffAddrOp PrimOpVecCat
vcat Int
n Width
w) -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res0 -> do
    StgToCmmConfig -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility StgToCmmConfig
cfg PrimOpVecCat
vcat Int
n Width
w
    Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteOffAddrOp Maybe MachOp
forall a. Maybe a
Nothing CmmType
ty [LocalReg]
res0 [CmmExpr]
args
   where
    ty :: CmmType
    ty :: CmmType
ty = PrimOpVecCat -> Width -> CmmType
vecCmmCat PrimOpVecCat
vcat Width
w

-- Prefetch
  PrimOp
PrefetchByteArrayOp3         -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    Int -> [CmmExpr] -> FCode ()
doPrefetchByteArrayOp Int
3  [CmmExpr]
args
  PrimOp
PrefetchMutableByteArrayOp3  -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    Int -> [CmmExpr] -> FCode ()
doPrefetchMutableByteArrayOp Int
3  [CmmExpr]
args
  PrimOp
PrefetchAddrOp3              -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    Int -> [CmmExpr] -> FCode ()
doPrefetchAddrOp  Int
3  [CmmExpr]
args
  PrimOp
PrefetchValueOp3             -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    Int -> [CmmExpr] -> FCode ()
doPrefetchValueOp Int
3 [CmmExpr]
args

  PrimOp
PrefetchByteArrayOp2         -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    Int -> [CmmExpr] -> FCode ()
doPrefetchByteArrayOp Int
2  [CmmExpr]
args
  PrimOp
PrefetchMutableByteArrayOp2  -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    Int -> [CmmExpr] -> FCode ()
doPrefetchMutableByteArrayOp Int
2  [CmmExpr]
args
  PrimOp
PrefetchAddrOp2              -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    Int -> [CmmExpr] -> FCode ()
doPrefetchAddrOp Int
2  [CmmExpr]
args
  PrimOp
PrefetchValueOp2             -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    Int -> [CmmExpr] -> FCode ()
doPrefetchValueOp Int
2 [CmmExpr]
args
  PrimOp
PrefetchByteArrayOp1         -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    Int -> [CmmExpr] -> FCode ()
doPrefetchByteArrayOp Int
1  [CmmExpr]
args
  PrimOp
PrefetchMutableByteArrayOp1  -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    Int -> [CmmExpr] -> FCode ()
doPrefetchMutableByteArrayOp Int
1  [CmmExpr]
args
  PrimOp
PrefetchAddrOp1              -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    Int -> [CmmExpr] -> FCode ()
doPrefetchAddrOp Int
1  [CmmExpr]
args
  PrimOp
PrefetchValueOp1             -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    Int -> [CmmExpr] -> FCode ()
doPrefetchValueOp Int
1 [CmmExpr]
args

  PrimOp
PrefetchByteArrayOp0         -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    Int -> [CmmExpr] -> FCode ()
doPrefetchByteArrayOp Int
0  [CmmExpr]
args
  PrimOp
PrefetchMutableByteArrayOp0  -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    Int -> [CmmExpr] -> FCode ()
doPrefetchMutableByteArrayOp Int
0  [CmmExpr]
args
  PrimOp
PrefetchAddrOp0              -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    Int -> [CmmExpr] -> FCode ()
doPrefetchAddrOp Int
0  [CmmExpr]
args
  PrimOp
PrefetchValueOp0             -> \[CmmExpr]
args -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    Int -> [CmmExpr] -> FCode ()
doPrefetchValueOp Int
0 [CmmExpr]
args

-- Atomic read-modify-write
  PrimOp
FetchAddByteArrayOp_Int -> \[CmmExpr
mba, CmmExpr
ix, CmmExpr
n] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg
-> AtomicMachOp
-> CmmExpr
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
doAtomicByteArrayRMW LocalReg
res AtomicMachOp
AMO_Add CmmExpr
mba CmmExpr
ix (Platform -> CmmType
bWord Platform
platform) CmmExpr
n
  PrimOp
FetchSubByteArrayOp_Int -> \[CmmExpr
mba, CmmExpr
ix, CmmExpr
n] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg
-> AtomicMachOp
-> CmmExpr
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
doAtomicByteArrayRMW LocalReg
res AtomicMachOp
AMO_Sub CmmExpr
mba CmmExpr
ix (Platform -> CmmType
bWord Platform
platform) CmmExpr
n
  PrimOp
FetchAndByteArrayOp_Int -> \[CmmExpr
mba, CmmExpr
ix, CmmExpr
n] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg
-> AtomicMachOp
-> CmmExpr
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
doAtomicByteArrayRMW LocalReg
res AtomicMachOp
AMO_And CmmExpr
mba CmmExpr
ix (Platform -> CmmType
bWord Platform
platform) CmmExpr
n
  PrimOp
FetchNandByteArrayOp_Int -> \[CmmExpr
mba, CmmExpr
ix, CmmExpr
n] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg
-> AtomicMachOp
-> CmmExpr
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
doAtomicByteArrayRMW LocalReg
res AtomicMachOp
AMO_Nand CmmExpr
mba CmmExpr
ix (Platform -> CmmType
bWord Platform
platform) CmmExpr
n
  PrimOp
FetchOrByteArrayOp_Int -> \[CmmExpr
mba, CmmExpr
ix, CmmExpr
n] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg
-> AtomicMachOp
-> CmmExpr
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
doAtomicByteArrayRMW LocalReg
res AtomicMachOp
AMO_Or CmmExpr
mba CmmExpr
ix (Platform -> CmmType
bWord Platform
platform) CmmExpr
n
  PrimOp
FetchXorByteArrayOp_Int -> \[CmmExpr
mba, CmmExpr
ix, CmmExpr
n] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg
-> AtomicMachOp
-> CmmExpr
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
doAtomicByteArrayRMW LocalReg
res AtomicMachOp
AMO_Xor CmmExpr
mba CmmExpr
ix (Platform -> CmmType
bWord Platform
platform) CmmExpr
n
  PrimOp
AtomicReadByteArrayOp_Int -> \[CmmExpr
mba, CmmExpr
ix] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg -> CmmExpr -> CmmExpr -> CmmType -> FCode ()
doAtomicReadByteArray LocalReg
res CmmExpr
mba CmmExpr
ix (Platform -> CmmType
bWord Platform
platform)
  PrimOp
AtomicWriteByteArrayOp_Int -> \[CmmExpr
mba, CmmExpr
ix, CmmExpr
val] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[] ->
    CmmExpr -> CmmExpr -> CmmType -> CmmExpr -> FCode ()
doAtomicWriteByteArray CmmExpr
mba CmmExpr
ix (Platform -> CmmType
bWord Platform
platform) CmmExpr
val
  PrimOp
CasByteArrayOp_Int -> \[CmmExpr
mba, CmmExpr
ix, CmmExpr
old, CmmExpr
new] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg
-> CmmExpr -> CmmExpr -> CmmType -> CmmExpr -> CmmExpr -> FCode ()
doCasByteArray LocalReg
res CmmExpr
mba CmmExpr
ix (Platform -> CmmType
bWord Platform
platform) CmmExpr
old CmmExpr
new
  PrimOp
CasByteArrayOp_Int8 -> \[CmmExpr
mba, CmmExpr
ix, CmmExpr
old, CmmExpr
new] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg
-> CmmExpr -> CmmExpr -> CmmType -> CmmExpr -> CmmExpr -> FCode ()
doCasByteArray LocalReg
res CmmExpr
mba CmmExpr
ix CmmType
b8 CmmExpr
old CmmExpr
new
  PrimOp
CasByteArrayOp_Int16 -> \[CmmExpr
mba, CmmExpr
ix, CmmExpr
old, CmmExpr
new] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg
-> CmmExpr -> CmmExpr -> CmmType -> CmmExpr -> CmmExpr -> FCode ()
doCasByteArray LocalReg
res CmmExpr
mba CmmExpr
ix CmmType
b16 CmmExpr
old CmmExpr
new
  PrimOp
CasByteArrayOp_Int32 -> \[CmmExpr
mba, CmmExpr
ix, CmmExpr
old, CmmExpr
new] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg
-> CmmExpr -> CmmExpr -> CmmType -> CmmExpr -> CmmExpr -> FCode ()
doCasByteArray LocalReg
res CmmExpr
mba CmmExpr
ix CmmType
b32 CmmExpr
old CmmExpr
new
  PrimOp
CasByteArrayOp_Int64 -> \[CmmExpr
mba, CmmExpr
ix, CmmExpr
old, CmmExpr
new] -> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] ->
    LocalReg
-> CmmExpr -> CmmExpr -> CmmType -> CmmExpr -> CmmExpr -> FCode ()
doCasByteArray LocalReg
res CmmExpr
mba CmmExpr
ix CmmType
b64 CmmExpr
old CmmExpr
new

-- The rest just translate straightforwardly

  PrimOp
Int8ToWord8Op   -> \[CmmExpr]
args -> [CmmExpr] -> PrimopCmmEmit
opNop [CmmExpr]
args
  PrimOp
Word8ToInt8Op   -> \[CmmExpr]
args -> [CmmExpr] -> PrimopCmmEmit
opNop [CmmExpr]
args
  PrimOp
Int16ToWord16Op -> \[CmmExpr]
args -> [CmmExpr] -> PrimopCmmEmit
opNop [CmmExpr]
args
  PrimOp
Word16ToInt16Op -> \[CmmExpr]
args -> [CmmExpr] -> PrimopCmmEmit
opNop [CmmExpr]
args
  PrimOp
Int32ToWord32Op -> \[CmmExpr]
args -> [CmmExpr] -> PrimopCmmEmit
opNop [CmmExpr]
args
  PrimOp
Word32ToInt32Op -> \[CmmExpr]
args -> [CmmExpr] -> PrimopCmmEmit
opNop [CmmExpr]
args
  PrimOp
Int64ToWord64Op -> \[CmmExpr]
args -> [CmmExpr] -> PrimopCmmEmit
opNop [CmmExpr]
args
  PrimOp
Word64ToInt64Op -> \[CmmExpr]
args -> [CmmExpr] -> PrimopCmmEmit
opNop [CmmExpr]
args
  PrimOp
IntToWordOp     -> \[CmmExpr]
args -> [CmmExpr] -> PrimopCmmEmit
opNop [CmmExpr]
args
  PrimOp
WordToIntOp     -> \[CmmExpr]
args -> [CmmExpr] -> PrimopCmmEmit
opNop [CmmExpr]
args
  PrimOp
IntToAddrOp     -> \[CmmExpr]
args -> [CmmExpr] -> PrimopCmmEmit
opNop [CmmExpr]
args
  PrimOp
AddrToIntOp     -> \[CmmExpr]
args -> [CmmExpr] -> PrimopCmmEmit
opNop [CmmExpr]
args
  PrimOp
ChrOp           -> \[CmmExpr]
args -> [CmmExpr] -> PrimopCmmEmit
opNop [CmmExpr]
args  -- Int# and Char# are rep'd the same
  PrimOp
OrdOp           -> \[CmmExpr]
args -> [CmmExpr] -> PrimopCmmEmit
opNop [CmmExpr]
args

  PrimOp
Narrow8IntOp   -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> Width -> MachOp, Width) -> PrimopCmmEmit
opNarrow [CmmExpr]
args (Width -> Width -> MachOp
MO_SS_Conv, Width
W8)
  PrimOp
Narrow16IntOp  -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> Width -> MachOp, Width) -> PrimopCmmEmit
opNarrow [CmmExpr]
args (Width -> Width -> MachOp
MO_SS_Conv, Width
W16)
  PrimOp
Narrow32IntOp  -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> Width -> MachOp, Width) -> PrimopCmmEmit
opNarrow [CmmExpr]
args (Width -> Width -> MachOp
MO_SS_Conv, Width
W32)
  PrimOp
Narrow8WordOp  -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> Width -> MachOp, Width) -> PrimopCmmEmit
opNarrow [CmmExpr]
args (Width -> Width -> MachOp
MO_UU_Conv, Width
W8)
  PrimOp
Narrow16WordOp -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> Width -> MachOp, Width) -> PrimopCmmEmit
opNarrow [CmmExpr]
args (Width -> Width -> MachOp
MO_UU_Conv, Width
W16)
  PrimOp
Narrow32WordOp -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> Width -> MachOp, Width) -> PrimopCmmEmit
opNarrow [CmmExpr]
args (Width -> Width -> MachOp
MO_UU_Conv, Width
W32)

  PrimOp
DoublePowerOp  -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F64_Pwr
  PrimOp
DoubleSinOp    -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F64_Sin
  PrimOp
DoubleCosOp    -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F64_Cos
  PrimOp
DoubleTanOp    -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F64_Tan
  PrimOp
DoubleSinhOp   -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F64_Sinh
  PrimOp
DoubleCoshOp   -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F64_Cosh
  PrimOp
DoubleTanhOp   -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F64_Tanh
  PrimOp
DoubleAsinOp   -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F64_Asin
  PrimOp
DoubleAcosOp   -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F64_Acos
  PrimOp
DoubleAtanOp   -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F64_Atan
  PrimOp
DoubleAsinhOp  -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F64_Asinh
  PrimOp
DoubleAcoshOp  -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F64_Acosh
  PrimOp
DoubleAtanhOp  -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F64_Atanh
  PrimOp
DoubleLogOp    -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F64_Log
  PrimOp
DoubleLog1POp  -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F64_Log1P
  PrimOp
DoubleExpOp    -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F64_Exp
  PrimOp
DoubleExpM1Op  -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F64_ExpM1
  PrimOp
DoubleSqrtOp   -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F64_Sqrt
  PrimOp
DoubleFabsOp   -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F64_Fabs

  PrimOp
FloatPowerOp   -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F32_Pwr
  PrimOp
FloatSinOp     -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F32_Sin
  PrimOp
FloatCosOp     -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F32_Cos
  PrimOp
FloatTanOp     -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F32_Tan
  PrimOp
FloatSinhOp    -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F32_Sinh
  PrimOp
FloatCoshOp    -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F32_Cosh
  PrimOp
FloatTanhOp    -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F32_Tanh
  PrimOp
FloatAsinOp    -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F32_Asin
  PrimOp
FloatAcosOp    -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F32_Acos
  PrimOp
FloatAtanOp    -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F32_Atan
  PrimOp
FloatAsinhOp   -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F32_Asinh
  PrimOp
FloatAcoshOp   -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F32_Acosh
  PrimOp
FloatAtanhOp   -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F32_Atanh
  PrimOp
FloatLogOp     -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F32_Log
  PrimOp
FloatLog1POp   -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F32_Log1P
  PrimOp
FloatExpOp     -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F32_Exp
  PrimOp
FloatExpM1Op   -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F32_ExpM1
  PrimOp
FloatSqrtOp    -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F32_Sqrt
  PrimOp
FloatFabsOp    -> \[CmmExpr]
args -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
MO_F32_Fabs

-- Native word signless ops

  PrimOp
IntAddOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordAdd Platform
platform)
  PrimOp
IntSubOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordSub Platform
platform)
  PrimOp
WordAddOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordAdd Platform
platform)
  PrimOp
WordSubOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordSub Platform
platform)
  PrimOp
AddrAddOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordAdd Platform
platform)
  PrimOp
AddrSubOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordSub Platform
platform)

  PrimOp
IntEqOp        -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordEq Platform
platform)
  PrimOp
IntNeOp        -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordNe Platform
platform)
  PrimOp
WordEqOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordEq Platform
platform)
  PrimOp
WordNeOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordNe Platform
platform)
  PrimOp
AddrEqOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordEq Platform
platform)
  PrimOp
AddrNeOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordNe Platform
platform)

  PrimOp
WordAndOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordAnd Platform
platform)
  PrimOp
WordOrOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordOr Platform
platform)
  PrimOp
WordXorOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordXor Platform
platform)
  PrimOp
WordNotOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordNot Platform
platform)
  PrimOp
WordSllOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordShl Platform
platform)
  PrimOp
WordSrlOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordUShr Platform
platform)

  PrimOp
AddrRemOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordURem Platform
platform)

-- Native word signed ops

  PrimOp
IntMulOp        -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordMul Platform
platform)
  PrimOp
IntMulMayOfloOp -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_MulMayOflo (Platform -> Width
wordWidth Platform
platform))
  PrimOp
IntQuotOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordSQuot Platform
platform)
  PrimOp
IntRemOp        -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordSRem Platform
platform)
  PrimOp
IntNegOp        -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordSNeg Platform
platform)

  PrimOp
IntGeOp        -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordSGe Platform
platform)
  PrimOp
IntLeOp        -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordSLe Platform
platform)
  PrimOp
IntGtOp        -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordSGt Platform
platform)
  PrimOp
IntLtOp        -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordSLt Platform
platform)

  PrimOp
IntAndOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordAnd Platform
platform)
  PrimOp
IntOrOp        -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordOr Platform
platform)
  PrimOp
IntXorOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordXor Platform
platform)
  PrimOp
IntNotOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordNot Platform
platform)
  PrimOp
IntSllOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordShl Platform
platform)
  PrimOp
IntSraOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordSShr Platform
platform)
  PrimOp
IntSrlOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordUShr Platform
platform)

-- Native word unsigned ops

  PrimOp
WordGeOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordUGe Platform
platform)
  PrimOp
WordLeOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordULe Platform
platform)
  PrimOp
WordGtOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordUGt Platform
platform)
  PrimOp
WordLtOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordULt Platform
platform)

  PrimOp
WordMulOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordMul Platform
platform)
  PrimOp
WordQuotOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordUQuot Platform
platform)
  PrimOp
WordRemOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordURem Platform
platform)

  PrimOp
AddrGeOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordUGe Platform
platform)
  PrimOp
AddrLeOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordULe Platform
platform)
  PrimOp
AddrGtOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordUGt Platform
platform)
  PrimOp
AddrLtOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Platform -> MachOp
mo_wordULt Platform
platform)

-- Int8# signed ops

  PrimOp
Int8ToIntOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> Width -> MachOp
MO_SS_Conv Width
W8 (Platform -> Width
wordWidth Platform
platform))
  PrimOp
IntToInt8Op    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> Width -> MachOp
MO_SS_Conv (Platform -> Width
wordWidth Platform
platform) Width
W8)
  PrimOp
Int8NegOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Neg Width
W8)
  PrimOp
Int8AddOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Add Width
W8)
  PrimOp
Int8SubOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Sub Width
W8)
  PrimOp
Int8MulOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Mul Width
W8)
  PrimOp
Int8QuotOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Quot Width
W8)
  PrimOp
Int8RemOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Rem Width
W8)

  PrimOp
Int8SllOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Shl Width
W8)
  PrimOp
Int8SraOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Shr Width
W8)
  PrimOp
Int8SrlOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Shr Width
W8)

  PrimOp
Int8EqOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Eq Width
W8)
  PrimOp
Int8GeOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Ge Width
W8)
  PrimOp
Int8GtOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Gt Width
W8)
  PrimOp
Int8LeOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Le Width
W8)
  PrimOp
Int8LtOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Lt Width
W8)
  PrimOp
Int8NeOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Ne Width
W8)

-- Word8# unsigned ops

  PrimOp
Word8ToWordOp  -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> Width -> MachOp
MO_UU_Conv Width
W8 (Platform -> Width
wordWidth Platform
platform))
  PrimOp
WordToWord8Op  -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> Width -> MachOp
MO_UU_Conv (Platform -> Width
wordWidth Platform
platform) Width
W8)
  PrimOp
Word8AddOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Add Width
W8)
  PrimOp
Word8SubOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Sub Width
W8)
  PrimOp
Word8MulOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Mul Width
W8)
  PrimOp
Word8QuotOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Quot Width
W8)
  PrimOp
Word8RemOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Rem Width
W8)

  PrimOp
Word8AndOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_And Width
W8)
  PrimOp
Word8OrOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Or Width
W8)
  PrimOp
Word8XorOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Xor Width
W8)
  PrimOp
Word8NotOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Not Width
W8)
  PrimOp
Word8SllOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Shl Width
W8)
  PrimOp
Word8SrlOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Shr Width
W8)

  PrimOp
Word8EqOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Eq Width
W8)
  PrimOp
Word8GeOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Ge Width
W8)
  PrimOp
Word8GtOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Gt Width
W8)
  PrimOp
Word8LeOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Le Width
W8)
  PrimOp
Word8LtOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Lt Width
W8)
  PrimOp
Word8NeOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Ne Width
W8)

-- Int16# signed ops

  PrimOp
Int16ToIntOp   -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> Width -> MachOp
MO_SS_Conv Width
W16 (Platform -> Width
wordWidth Platform
platform))
  PrimOp
IntToInt16Op   -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> Width -> MachOp
MO_SS_Conv (Platform -> Width
wordWidth Platform
platform) Width
W16)
  PrimOp
Int16NegOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Neg Width
W16)
  PrimOp
Int16AddOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Add Width
W16)
  PrimOp
Int16SubOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Sub Width
W16)
  PrimOp
Int16MulOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Mul Width
W16)
  PrimOp
Int16QuotOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Quot Width
W16)
  PrimOp
Int16RemOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Rem Width
W16)

  PrimOp
Int16SllOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Shl Width
W16)
  PrimOp
Int16SraOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Shr Width
W16)
  PrimOp
Int16SrlOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Shr Width
W16)

  PrimOp
Int16EqOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Eq Width
W16)
  PrimOp
Int16GeOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Ge Width
W16)
  PrimOp
Int16GtOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Gt Width
W16)
  PrimOp
Int16LeOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Le Width
W16)
  PrimOp
Int16LtOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Lt Width
W16)
  PrimOp
Int16NeOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Ne Width
W16)

-- Word16# unsigned ops

  PrimOp
Word16ToWordOp -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> Width -> MachOp
MO_UU_Conv Width
W16 (Platform -> Width
wordWidth Platform
platform))
  PrimOp
WordToWord16Op -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> Width -> MachOp
MO_UU_Conv (Platform -> Width
wordWidth Platform
platform) Width
W16)
  PrimOp
Word16AddOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Add Width
W16)
  PrimOp
Word16SubOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Sub Width
W16)
  PrimOp
Word16MulOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Mul Width
W16)
  PrimOp
Word16QuotOp   -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Quot Width
W16)
  PrimOp
Word16RemOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Rem Width
W16)

  PrimOp
Word16AndOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_And Width
W16)
  PrimOp
Word16OrOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Or Width
W16)
  PrimOp
Word16XorOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Xor Width
W16)
  PrimOp
Word16NotOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Not Width
W16)
  PrimOp
Word16SllOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Shl Width
W16)
  PrimOp
Word16SrlOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Shr Width
W16)

  PrimOp
Word16EqOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Eq Width
W16)
  PrimOp
Word16GeOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Ge Width
W16)
  PrimOp
Word16GtOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Gt Width
W16)
  PrimOp
Word16LeOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Le Width
W16)
  PrimOp
Word16LtOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Lt Width
W16)
  PrimOp
Word16NeOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Ne Width
W16)

-- Int32# signed ops

  PrimOp
Int32ToIntOp   -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> Width -> MachOp
MO_SS_Conv Width
W32 (Platform -> Width
wordWidth Platform
platform))
  PrimOp
IntToInt32Op   -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> Width -> MachOp
MO_SS_Conv (Platform -> Width
wordWidth Platform
platform) Width
W32)
  PrimOp
Int32NegOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Neg Width
W32)
  PrimOp
Int32AddOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Add Width
W32)
  PrimOp
Int32SubOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Sub Width
W32)
  PrimOp
Int32MulOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Mul Width
W32)
  PrimOp
Int32QuotOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Quot Width
W32)
  PrimOp
Int32RemOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Rem Width
W32)

  PrimOp
Int32SllOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Shl Width
W32)
  PrimOp
Int32SraOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Shr Width
W32)
  PrimOp
Int32SrlOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Shr Width
W32)

  PrimOp
Int32EqOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Eq Width
W32)
  PrimOp
Int32GeOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Ge Width
W32)
  PrimOp
Int32GtOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Gt Width
W32)
  PrimOp
Int32LeOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Le Width
W32)
  PrimOp
Int32LtOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_S_Lt Width
W32)
  PrimOp
Int32NeOp      -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Ne Width
W32)

-- Word32# unsigned ops

  PrimOp
Word32ToWordOp -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> Width -> MachOp
MO_UU_Conv Width
W32 (Platform -> Width
wordWidth Platform
platform))
  PrimOp
WordToWord32Op -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> Width -> MachOp
MO_UU_Conv (Platform -> Width
wordWidth Platform
platform) Width
W32)
  PrimOp
Word32AddOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Add Width
W32)
  PrimOp
Word32SubOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Sub Width
W32)
  PrimOp
Word32MulOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Mul Width
W32)
  PrimOp
Word32QuotOp   -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Quot Width
W32)
  PrimOp
Word32RemOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Rem Width
W32)

  PrimOp
Word32AndOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_And Width
W32)
  PrimOp
Word32OrOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Or Width
W32)
  PrimOp
Word32XorOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Xor Width
W32)
  PrimOp
Word32NotOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Not Width
W32)
  PrimOp
Word32SllOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Shl Width
W32)
  PrimOp
Word32SrlOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Shr Width
W32)

  PrimOp
Word32EqOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Eq Width
W32)
  PrimOp
Word32GeOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Ge Width
W32)
  PrimOp
Word32GtOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Gt Width
W32)
  PrimOp
Word32LeOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Le Width
W32)
  PrimOp
Word32LtOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Lt Width
W32)
  PrimOp
Word32NeOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Ne Width
W32)

-- Int64# signed ops

  PrimOp
Int64ToIntOp   -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args (\Width
w -> Width -> Width -> MachOp
MO_SS_Conv Width
w (Platform -> Width
wordWidth Platform
platform)) CallishMachOp
MO_I64_ToI
  PrimOp
IntToInt64Op   -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args (\Width
w -> Width -> Width -> MachOp
MO_SS_Conv (Platform -> Width
wordWidth Platform
platform) Width
w) CallishMachOp
MO_I64_FromI
  PrimOp
Int64NegOp     -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_S_Neg  CallishMachOp
MO_x64_Neg
  PrimOp
Int64AddOp     -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_Add    CallishMachOp
MO_x64_Add
  PrimOp
Int64SubOp     -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_Sub    CallishMachOp
MO_x64_Sub
  PrimOp
Int64MulOp     -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_Mul    CallishMachOp
MO_x64_Mul
  PrimOp
Int64QuotOp    -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_S_Quot CallishMachOp
MO_I64_Quot
  PrimOp
Int64RemOp     -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_S_Rem  CallishMachOp
MO_I64_Rem

  PrimOp
Int64SllOp     -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_Shl    CallishMachOp
MO_x64_Shl
  PrimOp
Int64SraOp     -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_S_Shr  CallishMachOp
MO_I64_Shr
  PrimOp
Int64SrlOp     -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_U_Shr  CallishMachOp
MO_W64_Shr

  PrimOp
Int64EqOp      -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_Eq     CallishMachOp
MO_x64_Eq
  PrimOp
Int64GeOp      -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_S_Ge   CallishMachOp
MO_I64_Ge
  PrimOp
Int64GtOp      -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_S_Gt   CallishMachOp
MO_I64_Gt
  PrimOp
Int64LeOp      -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_S_Le   CallishMachOp
MO_I64_Le
  PrimOp
Int64LtOp      -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_S_Lt   CallishMachOp
MO_I64_Lt
  PrimOp
Int64NeOp      -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_Ne     CallishMachOp
MO_x64_Ne

-- Word64# unsigned ops

  PrimOp
Word64ToWordOp -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args (\Width
w -> Width -> Width -> MachOp
MO_UU_Conv Width
w (Platform -> Width
wordWidth Platform
platform)) CallishMachOp
MO_W64_ToW
  PrimOp
WordToWord64Op -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args (\Width
w -> Width -> Width -> MachOp
MO_UU_Conv (Platform -> Width
wordWidth Platform
platform) Width
w) CallishMachOp
MO_W64_FromW
  PrimOp
Word64AddOp    -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_Add    CallishMachOp
MO_x64_Add
  PrimOp
Word64SubOp    -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_Sub    CallishMachOp
MO_x64_Sub
  PrimOp
Word64MulOp    -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_Mul    CallishMachOp
MO_x64_Mul
  PrimOp
Word64QuotOp   -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_U_Quot CallishMachOp
MO_W64_Quot
  PrimOp
Word64RemOp    -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_U_Rem  CallishMachOp
MO_W64_Rem

  PrimOp
Word64AndOp    -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_And    CallishMachOp
MO_x64_And
  PrimOp
Word64OrOp     -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_Or     CallishMachOp
MO_x64_Or
  PrimOp
Word64XorOp    -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_Xor    CallishMachOp
MO_x64_Xor
  PrimOp
Word64NotOp    -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_Not    CallishMachOp
MO_x64_Not
  PrimOp
Word64SllOp    -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_Shl    CallishMachOp
MO_x64_Shl
  PrimOp
Word64SrlOp    -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_U_Shr  CallishMachOp
MO_W64_Shr

  PrimOp
Word64EqOp     -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_Eq     CallishMachOp
MO_x64_Eq
  PrimOp
Word64GeOp     -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_U_Ge   CallishMachOp
MO_W64_Ge
  PrimOp
Word64GtOp     -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_U_Gt   CallishMachOp
MO_W64_Gt
  PrimOp
Word64LeOp     -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_U_Le   CallishMachOp
MO_W64_Le
  PrimOp
Word64LtOp     -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_U_Lt   CallishMachOp
MO_W64_Lt
  PrimOp
Word64NeOp     -> \[CmmExpr]
args -> [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
MO_Ne     CallishMachOp
MO_x64_Ne

-- Char# ops

  PrimOp
CharEqOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Eq (Platform -> Width
wordWidth Platform
platform))
  PrimOp
CharNeOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_Ne (Platform -> Width
wordWidth Platform
platform))
  PrimOp
CharGeOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Ge (Platform -> Width
wordWidth Platform
platform))
  PrimOp
CharLeOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Le (Platform -> Width
wordWidth Platform
platform))
  PrimOp
CharGtOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Gt (Platform -> Width
wordWidth Platform
platform))
  PrimOp
CharLtOp       -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_U_Lt (Platform -> Width
wordWidth Platform
platform))

-- Double ops

  PrimOp
DoubleEqOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Eq Width
W64)
  PrimOp
DoubleNeOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Ne Width
W64)
  PrimOp
DoubleGeOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Ge Width
W64)
  PrimOp
DoubleLeOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Le Width
W64)
  PrimOp
DoubleGtOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Gt Width
W64)
  PrimOp
DoubleLtOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Lt Width
W64)

  PrimOp
DoubleAddOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Add Width
W64)
  PrimOp
DoubleSubOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Sub Width
W64)
  PrimOp
DoubleMulOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Mul Width
W64)
  PrimOp
DoubleDivOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Quot Width
W64)
  PrimOp
DoubleNegOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Neg Width
W64)

-- Float ops

  PrimOp
FloatEqOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Eq Width
W32)
  PrimOp
FloatNeOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Ne Width
W32)
  PrimOp
FloatGeOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Ge Width
W32)
  PrimOp
FloatLeOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Le Width
W32)
  PrimOp
FloatGtOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Gt Width
W32)
  PrimOp
FloatLtOp     -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Lt Width
W32)

  PrimOp
FloatAddOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Add  Width
W32)
  PrimOp
FloatSubOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Sub  Width
W32)
  PrimOp
FloatMulOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Mul  Width
W32)
  PrimOp
FloatDivOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Quot Width
W32)
  PrimOp
FloatNegOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> MachOp
MO_F_Neg  Width
W32)

-- Vector ops

  (VecAddOp  PrimOpVecCat
FloatVec Int
n Width
w) -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Int -> Width -> MachOp
MO_VF_Add  Int
n Width
w)
  (VecSubOp  PrimOpVecCat
FloatVec Int
n Width
w) -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Int -> Width -> MachOp
MO_VF_Sub  Int
n Width
w)
  (VecMulOp  PrimOpVecCat
FloatVec Int
n Width
w) -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Int -> Width -> MachOp
MO_VF_Mul  Int
n Width
w)
  (VecDivOp  PrimOpVecCat
FloatVec Int
n Width
w) -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Int -> Width -> MachOp
MO_VF_Quot Int
n Width
w)
  (VecQuotOp PrimOpVecCat
FloatVec Int
_ Width
_) -> \[CmmExpr]
_ -> String -> PrimopCmmEmit
forall a. HasCallStack => String -> a
panic String
"unsupported primop"
  (VecRemOp  PrimOpVecCat
FloatVec Int
_ Width
_) -> \[CmmExpr]
_ -> String -> PrimopCmmEmit
forall a. HasCallStack => String -> a
panic String
"unsupported primop"
  (VecNegOp  PrimOpVecCat
FloatVec Int
n Width
w) -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Int -> Width -> MachOp
MO_VF_Neg  Int
n Width
w)

  (VecAddOp  PrimOpVecCat
IntVec Int
n Width
w) -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Int -> Width -> MachOp
MO_V_Add   Int
n Width
w)
  (VecSubOp  PrimOpVecCat
IntVec Int
n Width
w) -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Int -> Width -> MachOp
MO_V_Sub   Int
n Width
w)
  (VecMulOp  PrimOpVecCat
IntVec Int
n Width
w) -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Int -> Width -> MachOp
MO_V_Mul   Int
n Width
w)
  (VecDivOp  PrimOpVecCat
IntVec Int
_ Width
_) -> \[CmmExpr]
_ -> String -> PrimopCmmEmit
forall a. HasCallStack => String -> a
panic String
"unsupported primop"
  (VecQuotOp PrimOpVecCat
IntVec Int
n Width
w) -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Int -> Width -> MachOp
MO_VS_Quot Int
n Width
w)
  (VecRemOp  PrimOpVecCat
IntVec Int
n Width
w) -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Int -> Width -> MachOp
MO_VS_Rem  Int
n Width
w)
  (VecNegOp  PrimOpVecCat
IntVec Int
n Width
w) -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Int -> Width -> MachOp
MO_VS_Neg  Int
n Width
w)

  (VecAddOp  PrimOpVecCat
WordVec Int
n Width
w) -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Int -> Width -> MachOp
MO_V_Add   Int
n Width
w)
  (VecSubOp  PrimOpVecCat
WordVec Int
n Width
w) -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Int -> Width -> MachOp
MO_V_Sub   Int
n Width
w)
  (VecMulOp  PrimOpVecCat
WordVec Int
n Width
w) -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Int -> Width -> MachOp
MO_V_Mul   Int
n Width
w)
  (VecDivOp  PrimOpVecCat
WordVec Int
_ Width
_) -> \[CmmExpr]
_ -> String -> PrimopCmmEmit
forall a. HasCallStack => String -> a
panic String
"unsupported primop"
  (VecQuotOp PrimOpVecCat
WordVec Int
n Width
w) -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Int -> Width -> MachOp
MO_VU_Quot Int
n Width
w)
  (VecRemOp  PrimOpVecCat
WordVec Int
n Width
w) -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Int -> Width -> MachOp
MO_VU_Rem  Int
n Width
w)
  (VecNegOp  PrimOpVecCat
WordVec Int
_ Width
_) -> \[CmmExpr]
_ -> String -> PrimopCmmEmit
forall a. HasCallStack => String -> a
panic String
"unsupported primop"

-- Conversions

  PrimOp
IntToDoubleOp   -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> Width -> MachOp
MO_SF_Conv (Platform -> Width
wordWidth Platform
platform) Width
W64)
  PrimOp
DoubleToIntOp   -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> Width -> MachOp
MO_FS_Conv Width
W64 (Platform -> Width
wordWidth Platform
platform))

  PrimOp
IntToFloatOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> Width -> MachOp
MO_SF_Conv (Platform -> Width
wordWidth Platform
platform) Width
W32)
  PrimOp
FloatToIntOp    -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> Width -> MachOp
MO_FS_Conv Width
W32 (Platform -> Width
wordWidth Platform
platform))

  PrimOp
FloatToDoubleOp -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> Width -> MachOp
MO_FF_Conv Width
W32 Width
W64)
  PrimOp
DoubleToFloatOp -> \[CmmExpr]
args -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (Width -> Width -> MachOp
MO_FF_Conv Width
W64 Width
W32)

  PrimOp
IntQuotRemOp -> \[CmmExpr]
args -> [CmmExpr]
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
opCallishHandledLater [CmmExpr]
args (Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
 -> PrimopCmmEmit)
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$
    if Bool
allowQuotRem Bool -> Bool -> Bool
&& Bool -> Bool
not ([CmmExpr] -> Bool
quotRemCanBeOptimized [CmmExpr]
args)
    then CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_S_QuotRem  (Platform -> Width
wordWidth Platform
platform))
    else ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right (Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericIntQuotRemOp (Platform -> Width
wordWidth Platform
platform))

  PrimOp
Int8QuotRemOp -> \[CmmExpr]
args -> [CmmExpr]
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
opCallishHandledLater [CmmExpr]
args (Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
 -> PrimopCmmEmit)
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$
    if Bool
allowQuotRem Bool -> Bool -> Bool
&& Bool -> Bool
not ([CmmExpr] -> Bool
quotRemCanBeOptimized [CmmExpr]
args)
    then CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_S_QuotRem Width
W8)
    else ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right (Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericIntQuotRemOp Width
W8)

  PrimOp
Int16QuotRemOp -> \[CmmExpr]
args -> [CmmExpr]
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
opCallishHandledLater [CmmExpr]
args (Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
 -> PrimopCmmEmit)
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$
    if Bool
allowQuotRem Bool -> Bool -> Bool
&& Bool -> Bool
not ([CmmExpr] -> Bool
quotRemCanBeOptimized [CmmExpr]
args)
    then CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_S_QuotRem Width
W16)
    else ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right (Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericIntQuotRemOp Width
W16)

  PrimOp
Int32QuotRemOp -> \[CmmExpr]
args -> [CmmExpr]
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
opCallishHandledLater [CmmExpr]
args (Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
 -> PrimopCmmEmit)
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$
    if Bool
allowQuotRem Bool -> Bool -> Bool
&& Bool -> Bool
not ([CmmExpr] -> Bool
quotRemCanBeOptimized [CmmExpr]
args)
    then CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_S_QuotRem Width
W32)
    else ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right (Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericIntQuotRemOp Width
W32)

  PrimOp
WordQuotRemOp -> \[CmmExpr]
args -> [CmmExpr]
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
opCallishHandledLater [CmmExpr]
args (Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
 -> PrimopCmmEmit)
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$
    if Bool
allowQuotRem Bool -> Bool -> Bool
&& Bool -> Bool
not ([CmmExpr] -> Bool
quotRemCanBeOptimized [CmmExpr]
args)
    then CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_U_QuotRem  (Platform -> Width
wordWidth Platform
platform))
    else ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right (Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericWordQuotRemOp (Platform -> Width
wordWidth Platform
platform))

  PrimOp
WordQuotRem2Op -> \[CmmExpr]
args -> [CmmExpr]
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
opCallishHandledLater [CmmExpr]
args (Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
 -> PrimopCmmEmit)
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$
    if Bool
allowQuotRem2
    then CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_U_QuotRem2 (Platform -> Width
wordWidth Platform
platform))
    else ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right (Platform -> [LocalReg] -> [CmmExpr] -> FCode ()
genericWordQuotRem2Op Platform
platform)

  PrimOp
Word8QuotRemOp -> \[CmmExpr]
args -> [CmmExpr]
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
opCallishHandledLater [CmmExpr]
args (Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
 -> PrimopCmmEmit)
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$
    if Bool
allowQuotRem Bool -> Bool -> Bool
&& Bool -> Bool
not ([CmmExpr] -> Bool
quotRemCanBeOptimized [CmmExpr]
args)
    then CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_U_QuotRem Width
W8)
    else ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right (Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericWordQuotRemOp Width
W8)

  PrimOp
Word16QuotRemOp -> \[CmmExpr]
args -> [CmmExpr]
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
opCallishHandledLater [CmmExpr]
args (Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
 -> PrimopCmmEmit)
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$
    if Bool
allowQuotRem Bool -> Bool -> Bool
&& Bool -> Bool
not ([CmmExpr] -> Bool
quotRemCanBeOptimized [CmmExpr]
args)
    then CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_U_QuotRem Width
W16)
    else ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right (Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericWordQuotRemOp Width
W16)

  PrimOp
Word32QuotRemOp -> \[CmmExpr]
args -> [CmmExpr]
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
opCallishHandledLater [CmmExpr]
args (Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
 -> PrimopCmmEmit)
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$
    if Bool
allowQuotRem Bool -> Bool -> Bool
&& Bool -> Bool
not ([CmmExpr] -> Bool
quotRemCanBeOptimized [CmmExpr]
args)
    then CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_U_QuotRem Width
W32)
    else ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right (Width -> [LocalReg] -> [CmmExpr] -> FCode ()
genericWordQuotRemOp Width
W32)

  PrimOp
WordAdd2Op -> \[CmmExpr]
args -> [CmmExpr]
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
opCallishHandledLater [CmmExpr]
args (Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
 -> PrimopCmmEmit)
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$
    if Bool
allowExtAdd
    then CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_Add2       (Platform -> Width
wordWidth Platform
platform))
    else ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right [LocalReg] -> [CmmExpr] -> FCode ()
genericWordAdd2Op

  PrimOp
WordAddCOp -> \[CmmExpr]
args -> [CmmExpr]
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
opCallishHandledLater [CmmExpr]
args (Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
 -> PrimopCmmEmit)
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$
    if Bool
allowExtAdd
    then CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_AddWordC   (Platform -> Width
wordWidth Platform
platform))
    else ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right [LocalReg] -> [CmmExpr] -> FCode ()
genericWordAddCOp

  PrimOp
WordSubCOp -> \[CmmExpr]
args -> [CmmExpr]
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
opCallishHandledLater [CmmExpr]
args (Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
 -> PrimopCmmEmit)
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$
    if Bool
allowExtAdd
    then CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_SubWordC   (Platform -> Width
wordWidth Platform
platform))
    else ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right [LocalReg] -> [CmmExpr] -> FCode ()
genericWordSubCOp

  PrimOp
IntAddCOp -> \[CmmExpr]
args -> [CmmExpr]
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
opCallishHandledLater [CmmExpr]
args (Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
 -> PrimopCmmEmit)
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$
    if Bool
allowExtAdd
    then CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_AddIntC    (Platform -> Width
wordWidth Platform
platform))
    else ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right [LocalReg] -> [CmmExpr] -> FCode ()
genericIntAddCOp

  PrimOp
IntSubCOp -> \[CmmExpr]
args -> [CmmExpr]
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
opCallishHandledLater [CmmExpr]
args (Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
 -> PrimopCmmEmit)
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$
    if Bool
allowExtAdd
    then CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_SubIntC    (Platform -> Width
wordWidth Platform
platform))
    else ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right [LocalReg] -> [CmmExpr] -> FCode ()
genericIntSubCOp

  PrimOp
WordMul2Op -> \[CmmExpr]
args -> [CmmExpr]
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
opCallishHandledLater [CmmExpr]
args (Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
 -> PrimopCmmEmit)
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$
    if Bool
allowExtAdd
    then CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_U_Mul2     (Platform -> Width
wordWidth Platform
platform))
    else ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right [LocalReg] -> [CmmExpr] -> FCode ()
genericWordMul2Op

  PrimOp
IntMul2Op  -> \[CmmExpr]
args -> [CmmExpr]
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
opCallishHandledLater [CmmExpr]
args (Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
 -> PrimopCmmEmit)
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$
    if Bool
allowInt2Mul
    then CallishMachOp
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. a -> Either a b
Left (Width -> CallishMachOp
MO_S_Mul2     (Platform -> Width
wordWidth Platform
platform))
    else ([LocalReg] -> [CmmExpr] -> FCode ())
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
forall a b. b -> Either a b
Right [LocalReg] -> [CmmExpr] -> FCode ()
genericIntMul2Op

  -- tagToEnum# is special: we need to pull the constructor
  -- out of the table, and perform an appropriate return.
  PrimOp
TagToEnumOp -> \[CmmExpr
amode] -> (Type -> FCode [CmmExpr]) -> PrimopCmmEmit
PrimopCmmEmit_Internal ((Type -> FCode [CmmExpr]) -> PrimopCmmEmit)
-> (Type -> FCode [CmmExpr]) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \Type
res_ty -> do
    -- 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.
    let tycon :: TyCon
tycon = TyCon -> Maybe TyCon -> TyCon
forall a. a -> Maybe a -> a
fromMaybe (String -> SDoc -> TyCon
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tagToEnum#: Applied to non-concrete type" (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
res_ty)) (Type -> Maybe TyCon
tyConAppTyCon_maybe Type
res_ty)
    Bool -> FCode ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert (TyCon -> Bool
isEnumerationTyCon TyCon
tycon)
    Platform
platform <- FCode Platform
getPlatform
    [CmmExpr] -> FCode [CmmExpr]
forall a. a -> FCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Platform -> TyCon -> CmmExpr -> CmmExpr
tagToClosure Platform
platform TyCon
tycon CmmExpr
amode]

-- Out of line primops.
-- TODO compiler need not know about these

  PrimOp
UnsafeThawArrayOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
CasArrayOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
UnsafeThawSmallArrayOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
CasSmallArrayOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
NewPinnedByteArrayOp_Char -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
NewAlignedPinnedByteArrayOp_Char -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
MutableByteArrayIsPinnedOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
DoubleDecode_2IntOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
DoubleDecode_Int64Op -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
FloatDecode_IntOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
ByteArrayIsPinnedOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
ShrinkMutableByteArrayOp_Char -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
ResizeMutableByteArrayOp_Char -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
ShrinkSmallMutableArrayOp_Char -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
NewMutVarOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
AtomicModifyMutVar2Op -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
AtomicModifyMutVar_Op -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
CasMutVarOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
CatchOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
RaiseOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
RaiseUnderflowOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
RaiseOverflowOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
RaiseDivZeroOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
RaiseIOOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
MaskAsyncExceptionsOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
MaskUninterruptibleOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
UnmaskAsyncExceptionsOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
MaskStatus -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
NewPromptTagOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
PromptOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
Control0Op -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
AtomicallyOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
RetryOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
CatchRetryOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
CatchSTMOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
NewTVarOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
ReadTVarOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
ReadTVarIOOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
WriteTVarOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
NewMVarOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
TakeMVarOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
TryTakeMVarOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
PutMVarOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
TryPutMVarOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
ReadMVarOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
TryReadMVarOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
IsEmptyMVarOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
NewIOPortOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
ReadIOPortOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
WriteIOPortOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
DelayOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
WaitReadOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
WaitWriteOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
ForkOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
ForkOnOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
KillThreadOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
YieldOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
LabelThreadOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
IsCurrentThreadBoundOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
NoDuplicateOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
GetThreadLabelOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
ThreadStatusOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
MkWeakOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
MkWeakNoFinalizerOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
AddCFinalizerToWeakOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
DeRefWeakOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
FinalizeWeakOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
MakeStablePtrOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
DeRefStablePtrOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
MakeStableNameOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
CompactNewOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
CompactResizeOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
CompactContainsOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
CompactContainsAnyOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
CompactGetFirstBlockOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
CompactGetNextBlockOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
CompactAllocateBlockOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
CompactFixupPointersOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
CompactAdd -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
CompactAddWithSharing -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
CompactSize -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
SeqOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
GetSparkOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
NumSparks -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
DataToTagOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
MkApUpd0_Op -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
NewBCOOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
UnpackClosureOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
ListThreadsOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
ClosureSizeOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
WhereFromOp   -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
GetApStackValOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
ClearCCSOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
TraceEventOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
TraceEventBinaryOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
TraceMarkerOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
SetThreadAllocationCounter -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal
  PrimOp
KeepAliveOp -> [CmmExpr] -> PrimopCmmEmit
forall {p}. p -> PrimopCmmEmit
alwaysExternal

 where
  profile :: Profile
profile  = StgToCmmConfig -> Profile
stgToCmmProfile  StgToCmmConfig
cfg
  platform :: Platform
platform = StgToCmmConfig -> Platform
stgToCmmPlatform StgToCmmConfig
cfg
  result_info :: PrimOpResultInfo
result_info = PrimOp -> PrimOpResultInfo
getPrimOpResultInfo PrimOp
primop

  opNop :: [CmmExpr] -> PrimopCmmEmit
  opNop :: [CmmExpr] -> PrimopCmmEmit
opNop [CmmExpr]
args = ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] -> CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) CmmExpr
arg
    where [CmmExpr
arg] = [CmmExpr]
args

  opNarrow
    :: [CmmExpr]
    -> (Width -> Width -> MachOp, Width)
    -> PrimopCmmEmit
  opNarrow :: [CmmExpr] -> (Width -> Width -> MachOp, Width) -> PrimopCmmEmit
opNarrow [CmmExpr]
args (Width -> Width -> MachOp
mop, Width
rep) = ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] -> 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 (Platform -> Width
wordWidth Platform
platform)) [MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> Width -> MachOp
mop (Platform -> Width
wordWidth Platform
platform) Width
rep) [CmmExpr
arg]]
    where [CmmExpr
arg] = [CmmExpr]
args

  -- These primops are implemented by CallishMachOps, because they sometimes
  -- turn into foreign calls depending on the backend.
  opCallish :: [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
  opCallish :: [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
prim = ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] -> [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [LocalReg
res] CallishMachOp
prim [CmmExpr]
args

  opTranslate :: [CmmExpr] -> MachOp -> PrimopCmmEmit
  opTranslate :: [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args MachOp
mop = ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg
res] -> do
    let stmt :: CmmAGraph
stmt = CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
mop [CmmExpr]
args)
    CmmAGraph -> FCode ()
emit CmmAGraph
stmt

  opTranslate64
    :: [CmmExpr]
    -> (Width -> MachOp)
    -> CallishMachOp
    -> PrimopCmmEmit
  opTranslate64 :: [CmmExpr] -> (Width -> MachOp) -> CallishMachOp -> PrimopCmmEmit
opTranslate64 [CmmExpr]
args Width -> MachOp
mkMop CallishMachOp
callish =
    case Platform -> PlatformWordSize
platformWordSize Platform
platform of
      -- LLVM and C `can handle larger than native size arithmetic natively.
      PlatformWordSize
_ | StgToCmmConfig -> Bool
stgToCmmAllowBigArith StgToCmmConfig
cfg -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (MachOp -> PrimopCmmEmit) -> MachOp -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ Width -> MachOp
mkMop Width
W64
      PlatformWordSize
PW4 -> [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
opCallish [CmmExpr]
args CallishMachOp
callish
      PlatformWordSize
PW8 -> [CmmExpr] -> MachOp -> PrimopCmmEmit
opTranslate [CmmExpr]
args (MachOp -> PrimopCmmEmit) -> MachOp -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ Width -> MachOp
mkMop Width
W64

  -- Basically a "manual" case, rather than one of the common repetitive forms
  -- above. The results are a parameter to the returned function so we know the
  -- choice of variant never depends on them.
  opCallishHandledLater
    :: [CmmExpr]
    -> Either CallishMachOp GenericOp
    -> PrimopCmmEmit
  opCallishHandledLater :: [CmmExpr]
-> Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
-> PrimopCmmEmit
opCallishHandledLater [CmmExpr]
args Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
callOrNot = ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs (([LocalReg] -> FCode ()) -> PrimopCmmEmit)
-> ([LocalReg] -> FCode ()) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \[LocalReg]
res0 -> case Either CallishMachOp ([LocalReg] -> [CmmExpr] -> FCode ())
callOrNot of
    Left CallishMachOp
op   -> CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ ForeignTarget -> [LocalReg] -> [CmmExpr] -> CmmAGraph
mkUnsafeCall (CallishMachOp -> ForeignTarget
PrimTarget CallishMachOp
op) [LocalReg]
res0 [CmmExpr]
args
    Right [LocalReg] -> [CmmExpr] -> FCode ()
gen -> [LocalReg] -> [CmmExpr] -> FCode ()
gen [LocalReg]
res0 [CmmExpr]
args

  opIntoRegs
    :: ([LocalReg] -- where to put the results
        -> FCode ())
    -> PrimopCmmEmit
  opIntoRegs :: ([LocalReg] -> FCode ()) -> PrimopCmmEmit
opIntoRegs [LocalReg] -> FCode ()
f = (Type -> FCode [CmmExpr]) -> PrimopCmmEmit
PrimopCmmEmit_Internal ((Type -> FCode [CmmExpr]) -> PrimopCmmEmit)
-> (Type -> FCode [CmmExpr]) -> PrimopCmmEmit
forall a b. (a -> b) -> a -> b
$ \Type
res_ty -> do
    [LocalReg]
regs <- case PrimOpResultInfo
result_info of
      ReturnsPrim PrimRep
VoidRep -> [LocalReg] -> FCode [LocalReg]
forall a. a -> FCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      ReturnsPrim PrimRep
rep
        -> do LocalReg
reg <- CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp (Platform -> PrimRep -> CmmType
primRepCmmType Platform
platform PrimRep
rep)
              [LocalReg] -> FCode [LocalReg]
forall a. a -> FCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [LocalReg
reg]

      ReturnsAlg TyCon
tycon | TyCon -> Bool
isUnboxedTupleTyCon TyCon
tycon
        -> do ([LocalReg]
regs, [ForeignHint]
_hints) <- Type -> FCode ([LocalReg], [ForeignHint])
newUnboxedTupleRegs Type
res_ty
              [LocalReg] -> FCode [LocalReg]
forall a. a -> FCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [LocalReg]
regs

      PrimOpResultInfo
_ -> String -> FCode [LocalReg]
forall a. HasCallStack => String -> a
panic String
"cgOpApp"
    [LocalReg] -> FCode ()
f [LocalReg]
regs
    [CmmExpr] -> FCode [CmmExpr]
forall a. a -> FCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CmmExpr] -> FCode [CmmExpr]) -> [CmmExpr] -> FCode [CmmExpr]
forall a b. (a -> b) -> a -> b
$ (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

  alwaysExternal :: p -> PrimopCmmEmit
alwaysExternal = \p
_ -> PrimopCmmEmit
PrimopCmmEmit_External
  -- Note [QuotRem optimization]
  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
  -- `quot` and `rem` with constant divisor can be implemented with fast bit-ops
  -- (shift, .&.).
  --
  -- Currently we only support optimization (performed in GHC.Cmm.Opt) when the
  -- constant is a power of 2. #9041 tracks the implementation of the general
  -- optimization.
  --
  -- `quotRem` can be optimized in the same way. However as it returns two values,
  -- it is implemented as a "callish" primop which is harder to match and
  -- to transform later on. For simplicity, the current implementation detects cases
  -- that can be optimized (see `quotRemCanBeOptimized`) and converts STG quotRem
  -- primop into two CMM quot and rem primops.
  quotRemCanBeOptimized :: [CmmExpr] -> Bool
quotRemCanBeOptimized = \case
    [CmmExpr
_, CmmLit (CmmInt Integer
n Width
_) ] -> Maybe Integer -> Bool
forall a. Maybe a -> Bool
isJust (Integer -> Maybe Integer
exactLog2 Integer
n)
    [CmmExpr]
_                         -> Bool
False

  allowQuotRem :: Bool
allowQuotRem  = StgToCmmConfig -> Bool
stgToCmmAllowQuotRemInstr         StgToCmmConfig
cfg
  allowQuotRem2 :: Bool
allowQuotRem2 = StgToCmmConfig -> Bool
stgToCmmAllowQuotRem2             StgToCmmConfig
cfg
  allowExtAdd :: Bool
allowExtAdd   = StgToCmmConfig -> Bool
stgToCmmAllowExtendedAddSubInstrs StgToCmmConfig
cfg
  allowInt2Mul :: Bool
allowInt2Mul  = StgToCmmConfig -> Bool
stgToCmmAllowIntMul2Instr         StgToCmmConfig
cfg

data PrimopCmmEmit
  -- | Out of line fake primop that's actually just a foreign call to other
  -- (presumably) C--.
  = PrimopCmmEmit_External
  -- | Real primop turned into inline C--.
  | PrimopCmmEmit_Internal (Type -- the return type, some primops are specialized to it
                            -> FCode [CmmExpr]) -- just for TagToEnum for now

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

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

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

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

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

genericWordAdd2Op :: GenericOp
genericWordAdd2Op :: [LocalReg] -> [CmmExpr] -> FCode ()
genericWordAdd2Op [LocalReg
res_h, LocalReg
res_l] [CmmExpr
arg_x, CmmExpr
arg_y]
  = do Platform
platform <- FCode Platform
getPlatform
       LocalReg
r1 <- CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
arg_x)
       LocalReg
r2 <- CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
arg_x)
       let topHalf :: CmmExpr -> CmmExpr
topHalf CmmExpr
x = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_U_Shr (Platform -> Width
wordWidth Platform
platform)) [CmmExpr
x, CmmExpr
hww]
           toTopHalf :: CmmExpr -> CmmExpr
toTopHalf CmmExpr
x = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Shl (Platform -> Width
wordWidth Platform
platform)) [CmmExpr
x, CmmExpr
hww]
           bottomHalf :: CmmExpr -> CmmExpr
bottomHalf CmmExpr
x = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_And (Platform -> Width
wordWidth Platform
platform)) [CmmExpr
x, CmmExpr
hwm]
           add :: CmmExpr -> CmmExpr -> CmmExpr
add CmmExpr
x CmmExpr
y = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add (Platform -> Width
wordWidth Platform
platform)) [CmmExpr
x, CmmExpr
y]
           or :: CmmExpr -> CmmExpr -> CmmExpr
or CmmExpr
x CmmExpr
y = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Or (Platform -> Width
wordWidth Platform
platform)) [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 (Platform -> Width
halfWordWidth Platform
platform)))
                                (Platform -> Width
wordWidth Platform
platform))
           hwm :: CmmExpr
hwm = CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Platform -> Integer
halfWordMask Platform
platform) (Platform -> Width
wordWidth Platform
platform))
       CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
forall a b. (a -> b) -> a -> b
$ [CmmAGraph] -> CmmAGraph
catAGraphs
          [CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
r1)
               (CmmExpr -> CmmExpr -> CmmExpr
add (CmmExpr -> CmmExpr
bottomHalf CmmExpr
arg_x) (CmmExpr -> CmmExpr
bottomHalf CmmExpr
arg_y)),
           CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
r2)
               (CmmExpr -> CmmExpr -> CmmExpr
add (CmmExpr -> CmmExpr
topHalf (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
r1)))
                    (CmmExpr -> CmmExpr -> CmmExpr
add (CmmExpr -> CmmExpr
topHalf CmmExpr
arg_x) (CmmExpr -> CmmExpr
topHalf CmmExpr
arg_y))),
           CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_h)
               (CmmExpr -> CmmExpr
topHalf (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
r2))),
           CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_l)
               (CmmExpr -> CmmExpr -> CmmExpr
or (CmmExpr -> CmmExpr
toTopHalf (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
r2)))
                   (CmmExpr -> CmmExpr
bottomHalf (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
r1))))]
genericWordAdd2Op [LocalReg]
_ [CmmExpr]
_ = String -> FCode ()
forall a. HasCallStack => String -> a
panic String
"genericWordAdd2Op"

-- | Implements branchless recovery of the carry flag @c@ by checking the
-- leftmost bits of both inputs @a@ and @b@ and result @r = a + b@:
--
-- @
--    c = a&b | (a|b)&~r
-- @
--
-- https://brodowsky.it-sky.net/2015/04/02/how-to-recover-the-carry-bit/
genericWordAddCOp :: GenericOp
genericWordAddCOp :: [LocalReg] -> [CmmExpr] -> FCode ()
genericWordAddCOp [LocalReg
res_r, LocalReg
res_c] [CmmExpr
aa, CmmExpr
bb]
 = do Platform
platform <- FCode Platform
getPlatform
      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 (Platform -> MachOp
mo_wordAdd Platform
platform) [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 (Platform -> MachOp
mo_wordUShr Platform
platform) [
            MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordOr Platform
platform) [
              MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordAnd Platform
platform) [CmmExpr
aa,CmmExpr
bb],
              MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordAnd Platform
platform) [
                MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordOr Platform
platform) [CmmExpr
aa,CmmExpr
bb],
                MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordNot Platform
platform) [CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
res_r)]
              ]
            ],
            Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (Platform -> Int
platformWordSizeInBits Platform
platform Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          ]
        ]
genericWordAddCOp [LocalReg]
_ [CmmExpr]
_ = String -> FCode ()
forall a. HasCallStack => String -> a
panic String
"genericWordAddCOp"

-- | Implements branchless recovery of the carry flag @c@ by checking the
-- leftmost bits of both inputs @a@ and @b@ and result @r = a - b@:
--
-- @
--    c = ~a&b | (~a|b)&r
-- @
--
-- https://brodowsky.it-sky.net/2015/04/02/how-to-recover-the-carry-bit/
genericWordSubCOp :: GenericOp
genericWordSubCOp :: [LocalReg] -> [CmmExpr] -> FCode ()
genericWordSubCOp [LocalReg
res_r, LocalReg
res_c] [CmmExpr
aa, CmmExpr
bb]
 = do Platform
platform <- FCode Platform
getPlatform
      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 (Platform -> MachOp
mo_wordSub Platform
platform) [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 (Platform -> MachOp
mo_wordUShr Platform
platform) [
            MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordOr Platform
platform) [
              MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordAnd Platform
platform) [
                MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordNot Platform
platform) [CmmExpr
aa],
                CmmExpr
bb
              ],
              MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordAnd Platform
platform) [
                MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordOr Platform
platform) [
                  MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordNot Platform
platform) [CmmExpr
aa],
                  CmmExpr
bb
                ],
                CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
res_r)
              ]
            ],
            Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (Platform -> Int
platformWordSizeInBits Platform
platform Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          ]
        ]
genericWordSubCOp [LocalReg]
_ [CmmExpr]
_ = String -> FCode ()
forall a. HasCallStack => String -> a
panic String
"genericWordSubCOp"

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

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

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

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

-}
 = do Platform
platform <- FCode Platform
getPlatform
      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 (Platform -> MachOp
mo_wordAdd Platform
platform) [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 (Platform -> MachOp
mo_wordUShr Platform
platform) [
                MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordAnd Platform
platform) [
                    MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordNot Platform
platform) [MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordXor Platform
platform) [CmmExpr
aa,CmmExpr
bb]],
                    MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordXor Platform
platform) [CmmExpr
aa, CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
res_r)]
                ],
                Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (Platform -> Int
platformWordSizeInBits Platform
platform Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          ]
        ]
genericIntAddCOp [LocalReg]
_ [CmmExpr]
_ = String -> FCode ()
forall a. HasCallStack => String -> a
panic String
"genericIntAddCOp"

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

   c =  ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
-}
 = do Platform
platform <- FCode Platform
getPlatform
      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 (Platform -> MachOp
mo_wordSub Platform
platform) [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 (Platform -> MachOp
mo_wordUShr Platform
platform) [
                MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordAnd Platform
platform) [
                    MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordXor Platform
platform) [CmmExpr
aa,CmmExpr
bb],
                    MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordXor Platform
platform) [CmmExpr
aa, CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
res_r)]
                ],
                Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (Platform -> Int
platformWordSizeInBits Platform
platform Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          ]
        ]
genericIntSubCOp [LocalReg]
_ [CmmExpr]
_ = String -> FCode ()
forall a. HasCallStack => String -> a
panic String
"genericIntSubCOp"

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

genericIntMul2Op :: GenericOp
genericIntMul2Op :: [LocalReg] -> [CmmExpr] -> FCode ()
genericIntMul2Op [LocalReg
res_c, LocalReg
res_h, LocalReg
res_l] both_args :: [CmmExpr]
both_args@[CmmExpr
arg_x, CmmExpr
arg_y]
 = do StgToCmmConfig
cfg <- FCode StgToCmmConfig
getStgToCmmConfig
      -- Implement algorithm from Hacker's Delight, 2nd edition, p.174
      let t :: CmmType
t        = Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
arg_x
          platform :: Platform
platform = StgToCmmConfig -> Platform
stgToCmmPlatform StgToCmmConfig
cfg
      LocalReg
p   <- CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp CmmType
t
      -- 1) compute the multiplication as if numbers were unsigned
      ReturnKind
_ <- Sequel -> FCode ReturnKind -> FCode ReturnKind
forall a. Sequel -> FCode a -> FCode a
withSequel ([LocalReg] -> Bool -> Sequel
AssignTo [LocalReg
p, LocalReg
res_l] Bool
False) (FCode ReturnKind -> FCode ReturnKind)
-> FCode ReturnKind -> FCode ReturnKind
forall a b. (a -> b) -> a -> b
$
             StgToCmmConfig
-> PrimOp -> [CmmExpr] -> Maybe Type -> FCode ReturnKind
cmmPrimOpApp StgToCmmConfig
cfg PrimOp
WordMul2Op [CmmExpr]
both_args Maybe Type
forall a. Maybe a
Nothing
      -- 2) correct the high bits of the unsigned result
      let carryFill :: CmmExpr -> CmmExpr
carryFill CmmExpr
x = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_S_Shr Width
ww) [CmmExpr
x, CmmExpr
wwm1]
          sub :: CmmExpr -> CmmExpr -> CmmExpr
sub CmmExpr
x CmmExpr
y     = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Sub   Width
ww) [CmmExpr
x, CmmExpr
y]
          and :: CmmExpr -> CmmExpr -> CmmExpr
and CmmExpr
x CmmExpr
y     = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_And   Width
ww) [CmmExpr
x, CmmExpr
y]
          neq :: CmmExpr -> CmmExpr -> CmmExpr
neq CmmExpr
x CmmExpr
y     = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Ne    Width
ww) [CmmExpr
x, CmmExpr
y]
          f :: CmmExpr -> CmmExpr -> CmmExpr
f   CmmExpr
x CmmExpr
y     = (CmmExpr -> CmmExpr
carryFill CmmExpr
x) CmmExpr -> CmmExpr -> CmmExpr
`and` CmmExpr
y
          wwm1 :: CmmExpr
wwm1        = CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Width -> Int
widthInBits Width
ww Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Width
ww)
          rl :: LocalReg -> CmmExpr
rl LocalReg
x        = CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
x)
          ww :: Width
ww          = Platform -> Width
wordWidth Platform
platform
      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_h) (LocalReg -> CmmExpr
rl LocalReg
p CmmExpr -> CmmExpr -> CmmExpr
`sub` CmmExpr -> CmmExpr -> CmmExpr
f CmmExpr
arg_x CmmExpr
arg_y CmmExpr -> CmmExpr -> CmmExpr
`sub` CmmExpr -> CmmExpr -> CmmExpr
f CmmExpr
arg_y CmmExpr
arg_x)
             , CmmReg -> CmmExpr -> CmmAGraph
mkAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res_c) (LocalReg -> CmmExpr
rl LocalReg
res_h CmmExpr -> CmmExpr -> CmmExpr
`neq` CmmExpr -> CmmExpr
carryFill (LocalReg -> CmmExpr
rl LocalReg
res_l))
             ]
genericIntMul2Op [LocalReg]
_ [CmmExpr]
_ = String -> FCode ()
forall a. HasCallStack => String -> a
panic String
"genericIntMul2Op"

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

alignmentFromTypes :: CmmType  -- ^ element type
                   -> CmmType  -- ^ index type
                   -> AlignmentSpec
alignmentFromTypes :: CmmType -> CmmType -> AlignmentSpec
alignmentFromTypes CmmType
ty CmmType
idx_ty
  | CmmType -> Width
typeWidth CmmType
ty Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
< CmmType -> Width
typeWidth CmmType
idx_ty = AlignmentSpec
NaturallyAligned
  | Bool
otherwise                       = AlignmentSpec
Unaligned

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

doIndexOffAddrOpAs :: Maybe MachOp
                   -> CmmType
                   -> CmmType
                   -> [LocalReg]
                   -> [CmmExpr]
                   -> FCode ()
doIndexOffAddrOpAs :: Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexOffAddrOpAs Maybe MachOp
maybe_post_read_cast CmmType
rep CmmType
idx_rep [LocalReg
res] [CmmExpr
addr,CmmExpr
idx]
   = let alignment :: AlignmentSpec
alignment = CmmType -> CmmType -> AlignmentSpec
alignmentFromTypes CmmType
rep CmmType
idx_rep
     in AlignmentSpec
-> Int
-> Maybe MachOp
-> CmmType
-> LocalReg
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
mkBasicIndexedRead AlignmentSpec
alignment Int
0 Maybe MachOp
maybe_post_read_cast CmmType
rep LocalReg
res CmmExpr
addr CmmType
idx_rep CmmExpr
idx
doIndexOffAddrOpAs Maybe MachOp
_ CmmType
_ CmmType
_ [LocalReg]
_ [CmmExpr]
_
   = String -> FCode ()
forall a. HasCallStack => String -> a
panic String
"GHC.StgToCmm.Prim: doIndexOffAddrOpAs"

doIndexByteArrayOp :: Maybe MachOp
                   -> CmmType
                   -> [LocalReg]
                   -> [CmmExpr]
                   -> FCode ()
doIndexByteArrayOp :: Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOp Maybe MachOp
maybe_post_read_cast CmmType
rep [LocalReg
res] [CmmExpr
addr,CmmExpr
idx]
   = do Profile
profile <- FCode Profile
getProfile
        CmmExpr -> CmmExpr -> CmmType -> CmmType -> FCode ()
doByteArrayBoundsCheck CmmExpr
idx CmmExpr
addr CmmType
rep CmmType
rep
        AlignmentSpec
-> Int
-> Maybe MachOp
-> CmmType
-> LocalReg
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
mkBasicIndexedRead AlignmentSpec
NaturallyAligned (Profile -> Int
arrWordsHdrSize Profile
profile) Maybe MachOp
maybe_post_read_cast CmmType
rep LocalReg
res CmmExpr
addr CmmType
rep CmmExpr
idx
doIndexByteArrayOp Maybe MachOp
_ CmmType
_ [LocalReg]
_ [CmmExpr]
_
   = String -> FCode ()
forall a. HasCallStack => String -> a
panic String
"GHC.StgToCmm.Prim: doIndexByteArrayOp"

doIndexByteArrayOpAs :: Maybe MachOp
                    -> CmmType
                    -> CmmType
                    -> [LocalReg]
                    -> [CmmExpr]
                    -> FCode ()
doIndexByteArrayOpAs :: Maybe MachOp
-> CmmType -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doIndexByteArrayOpAs Maybe MachOp
maybe_post_read_cast CmmType
rep CmmType
idx_rep [LocalReg
res] [CmmExpr
addr,CmmExpr
idx]
   = do Profile
profile <- FCode Profile
getProfile
        CmmExpr -> CmmExpr -> CmmType -> CmmType -> FCode ()
doByteArrayBoundsCheck CmmExpr
idx CmmExpr
addr CmmType
idx_rep CmmType
rep
        let alignment :: AlignmentSpec
alignment = CmmType -> CmmType -> AlignmentSpec
alignmentFromTypes CmmType
rep CmmType
idx_rep
        AlignmentSpec
-> Int
-> Maybe MachOp
-> CmmType
-> LocalReg
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
mkBasicIndexedRead AlignmentSpec
alignment (Profile -> Int
arrWordsHdrSize Profile
profile) Maybe MachOp
maybe_post_read_cast CmmType
rep LocalReg
res CmmExpr
addr CmmType
idx_rep CmmExpr
idx
doIndexByteArrayOpAs Maybe MachOp
_ CmmType
_ CmmType
_ [LocalReg]
_ [CmmExpr]
_
   = String -> FCode ()
forall a. HasCallStack => String -> a
panic String
"GHC.StgToCmm.Prim: doIndexByteArrayOpAs"

doReadPtrArrayOp :: LocalReg
                 -> CmmExpr
                 -> CmmExpr
                 -> FCode ()
doReadPtrArrayOp :: LocalReg -> CmmExpr -> CmmExpr -> FCode ()
doReadPtrArrayOp LocalReg
res CmmExpr
addr CmmExpr
idx
   = do Profile
profile <- FCode Profile
getProfile
        Platform
platform <- FCode Platform
getPlatform
        CmmExpr -> CmmExpr -> FCode ()
doPtrArrayBoundsCheck CmmExpr
idx CmmExpr
addr
        AlignmentSpec
-> Int
-> Maybe MachOp
-> CmmType
-> LocalReg
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
mkBasicIndexedRead AlignmentSpec
NaturallyAligned (Profile -> Int
arrPtrsHdrSize Profile
profile) Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
gcWord Platform
platform) LocalReg
res CmmExpr
addr (Platform -> CmmType
gcWord Platform
platform) CmmExpr
idx

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

doWriteByteArrayOp :: Maybe MachOp
                   -> CmmType
                   -> [LocalReg]
                   -> [CmmExpr]
                   -> FCode ()
doWriteByteArrayOp :: Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
doWriteByteArrayOp Maybe MachOp
maybe_pre_write_cast CmmType
idx_ty [] [CmmExpr
addr,CmmExpr
idx,CmmExpr
val]
   = do Profile
profile <- FCode Profile
getProfile
        Platform
platform <- FCode Platform
getPlatform
        CmmExpr -> CmmExpr -> CmmType -> CmmType -> FCode ()
doByteArrayBoundsCheck CmmExpr
idx CmmExpr
addr CmmType
idx_ty (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
val)
        Int
-> Maybe MachOp
-> CmmExpr
-> CmmType
-> CmmExpr
-> CmmExpr
-> FCode ()
mkBasicIndexedWrite (Profile -> Int
arrWordsHdrSize Profile
profile) Maybe MachOp
maybe_pre_write_cast CmmExpr
addr CmmType
idx_ty CmmExpr
idx CmmExpr
val
doWriteByteArrayOp Maybe MachOp
_ CmmType
_ [LocalReg]
_ [CmmExpr]
_
   = String -> FCode ()
forall a. HasCallStack => String -> a
panic String
"GHC.StgToCmm.Prim: doWriteByteArrayOp"

doWritePtrArrayOp :: CmmExpr
                  -> CmmExpr
                  -> CmmExpr
                  -> FCode ()
doWritePtrArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doWritePtrArrayOp CmmExpr
addr CmmExpr
idx CmmExpr
val
  = do Profile
profile  <- FCode Profile
getProfile
       Platform
platform <- FCode Platform
getPlatform
       let ty :: CmmType
ty = Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
val
           hdr_size :: Int
hdr_size = Profile -> Int
arrPtrsHdrSize Profile
profile

       CmmExpr -> CmmExpr -> FCode ()
doPtrArrayBoundsCheck CmmExpr
idx CmmExpr
addr

       -- Update remembered set for non-moving collector
       FCode () -> FCode ()
forall a. FCode a -> FCode ()
whenUpdRemSetEnabled
           (FCode () -> FCode ()) -> FCode () -> FCode ()
forall a b. (a -> b) -> a -> b
$ CmmExpr -> FCode ()
emitUpdRemSetPush (Platform
-> AlignmentSpec
-> Int
-> CmmType
-> CmmExpr
-> CmmType
-> CmmExpr
-> CmmExpr
cmmLoadIndexOffExpr Platform
platform AlignmentSpec
NaturallyAligned Int
hdr_size CmmType
ty CmmExpr
addr CmmType
ty CmmExpr
idx)
       -- 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 Int
hdr_size 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 (
         Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExpr Platform
platform
          (Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExprW Platform
platform (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
addr Int
hdr_size)
                         (Profile -> CmmExpr -> CmmExpr
loadArrPtrsSize Profile
profile CmmExpr
addr))
          (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Platform -> MachOp
mo_wordUShr Platform
platform) [CmmExpr
idx, Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (PlatformConstants -> Int
pc_MUT_ARR_PTRS_CARD_BITS (Platform -> PlatformConstants
platformConstants Platform
platform))])
         ) (CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
1 Width
W8))

loadArrPtrsSize :: Profile -> CmmExpr -> CmmExpr
loadArrPtrsSize :: Profile -> CmmExpr -> CmmExpr
loadArrPtrsSize Profile
profile CmmExpr
addr = Platform -> CmmExpr -> CmmExpr
cmmLoadBWord Platform
platform (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
addr Int
off)
 where off :: Int
off = Profile -> Int
fixedHdrSize Profile
profile Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PlatformConstants -> Int
pc_OFFSET_StgMutArrPtrs_ptrs (Profile -> PlatformConstants
profileConstants Profile
profile)
       platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile

mkBasicIndexedRead :: AlignmentSpec
                   -> 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 :: AlignmentSpec
-> Int
-> Maybe MachOp
-> CmmType
-> LocalReg
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
mkBasicIndexedRead AlignmentSpec
alignment Int
off Maybe MachOp
Nothing CmmType
ty LocalReg
res CmmExpr
base CmmType
idx_ty CmmExpr
idx
   = do Platform
platform <- FCode Platform
getPlatform
        CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (Platform
-> AlignmentSpec
-> Int
-> CmmType
-> CmmExpr
-> CmmType
-> CmmExpr
-> CmmExpr
cmmLoadIndexOffExpr Platform
platform AlignmentSpec
alignment Int
off CmmType
ty CmmExpr
base CmmType
idx_ty CmmExpr
idx)
mkBasicIndexedRead AlignmentSpec
alignment Int
off (Just MachOp
cast) CmmType
ty LocalReg
res CmmExpr
base CmmType
idx_ty CmmExpr
idx
   = do Platform
platform <- FCode Platform
getPlatform
        CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
cast [
                                   Platform
-> AlignmentSpec
-> Int
-> CmmType
-> CmmExpr
-> CmmType
-> CmmExpr
-> CmmExpr
cmmLoadIndexOffExpr Platform
platform AlignmentSpec
alignment Int
off CmmType
ty CmmExpr
base CmmType
idx_ty CmmExpr
idx])

mkBasicIndexedWrite :: ByteOff      -- Initial offset in bytes
                    -> Maybe MachOp -- Optional value cast
                    -> CmmExpr      -- Base address
                    -> CmmType      -- Type of element by which we are indexing
                    -> CmmExpr      -- Index
                    -> CmmExpr      -- Value to write
                    -> FCode ()
mkBasicIndexedWrite :: Int
-> Maybe MachOp
-> CmmExpr
-> CmmType
-> CmmExpr
-> CmmExpr
-> FCode ()
mkBasicIndexedWrite Int
off Maybe MachOp
Nothing CmmExpr
base CmmType
idx_ty CmmExpr
idx CmmExpr
val
   = do Platform
platform <- FCode Platform
getPlatform
        let alignment :: AlignmentSpec
alignment = CmmType -> CmmType -> AlignmentSpec
alignmentFromTypes (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
val) CmmType
idx_ty
        AlignmentSpec -> CmmExpr -> CmmExpr -> FCode ()
emitStore' AlignmentSpec
alignment (Platform -> Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr
cmmIndexOffExpr Platform
platform Int
off (CmmType -> Width
typeWidth CmmType
idx_ty) CmmExpr
base CmmExpr
idx) CmmExpr
val
mkBasicIndexedWrite Int
off (Just MachOp
cast) CmmExpr
base CmmType
idx_ty CmmExpr
idx CmmExpr
val
   = Int
-> Maybe MachOp
-> CmmExpr
-> CmmType
-> CmmExpr
-> CmmExpr
-> FCode ()
mkBasicIndexedWrite Int
off Maybe MachOp
forall a. Maybe a
Nothing CmmExpr
base CmmType
idx_ty CmmExpr
idx (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp MachOp
cast [CmmExpr
val])

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

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

cmmLoadIndexOffExpr :: Platform
                    -> AlignmentSpec
                    -> 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 :: Platform
-> AlignmentSpec
-> Int
-> CmmType
-> CmmExpr
-> CmmType
-> CmmExpr
-> CmmExpr
cmmLoadIndexOffExpr Platform
platform AlignmentSpec
alignment Int
off CmmType
ty CmmExpr
base CmmType
idx_ty CmmExpr
idx
   = CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
CmmLoad (Platform -> Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr
cmmIndexOffExpr Platform
platform Int
off (CmmType -> Width
typeWidth CmmType
idx_ty) CmmExpr
base CmmExpr
idx) CmmType
ty AlignmentSpec
alignment

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

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

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

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

-- Note [SIMD Design for the future]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Check to make sure that we can generate code for the specified vector type
-- given the current set of dynamic flags.
-- Currently these checks are specific to x86 and x86_64 architecture.
-- This should be fixed!
-- In particular,
-- 1) Add better support for other architectures! (this may require a redesign)
-- 2) Decouple design choices from LLVM's pseudo SIMD model!
--   The high level LLVM naive rep makes per CPU family SIMD generation is own
--   optimization problem, and hides important differences in eg ARM vs x86_64 simd
-- 3) Depending on the architecture, the SIMD registers may also support general
--    computations on Float/Double/Word/Int scalars, but currently on
--    for example x86_64, we always put Word/Int (or sized) in GPR
--    (general purpose) registers. Would relaxing that allow for
--    useful optimization opportunities?
--      Phrased differently, it is worth experimenting with supporting
--    different register mapping strategies than we currently have, especially if
--    someday we want SIMD to be a first class denizen in GHC along with scalar
--    values!
--      The current design with respect to register mapping of scalars could
--    very well be the best,but exploring the  design space and doing careful
--    measurements is the only way to validate that.
--      In some next generation CPU ISAs, notably RISC V, the SIMD extension
--    includes  support for a sort of run time CPU dependent vectorization parameter,
--    where a loop may act upon a single scalar each iteration OR some 2,4,8 ...
--    element chunk! Time will tell if that direction sees wide adoption,
--    but it is from that context that unifying our handling of simd and scalars
--    may benefit. It is not likely to benefit current architectures, though
--    it may very well be a design perspective that helps guide improving the NCG.


checkVecCompatibility :: StgToCmmConfig -> PrimOpVecCat -> Length -> Width -> FCode ()
checkVecCompatibility :: StgToCmmConfig -> PrimOpVecCat -> Int -> Width -> FCode ()
checkVecCompatibility StgToCmmConfig
cfg PrimOpVecCat
vcat Int
l Width
w =
  case StgToCmmConfig -> Maybe String
stgToCmmVecInstrsErr StgToCmmConfig
cfg of
    Maybe String
Nothing  -> Width -> PrimOpVecCat -> Int -> Width -> FCode ()
check Width
vecWidth PrimOpVecCat
vcat Int
l Width
w  -- We are in a compatible backend
    Just String
err -> String -> FCode ()
forall a. HasCallStack => String -> a
sorry String
err                -- incompatible backend, do panic
  where
    platform :: Platform
platform = StgToCmmConfig -> Platform
stgToCmmPlatform StgToCmmConfig
cfg
    check :: Width -> PrimOpVecCat -> Length -> Width -> FCode ()
    check :: Width -> PrimOpVecCat -> Int -> Width -> FCode ()
check Width
W128 PrimOpVecCat
FloatVec Int
4 Width
W32 | Bool -> Bool
not (Platform -> Bool
isSseEnabled Platform
platform) =
        String -> FCode ()
forall a. HasCallStack => String -> a
sorry (String -> FCode ()) -> String -> FCode ()
forall a b. (a -> b) -> a -> b
$ String
"128-bit wide single-precision floating point " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                String
"SIMD vector instructions require at least -msse."
    check Width
W128 PrimOpVecCat
_ Int
_ Width
_ | Bool -> Bool
not (Platform -> Bool
isSse2Enabled Platform
platform) =
        String -> FCode ()
forall a. HasCallStack => String -> a
sorry (String -> FCode ()) -> String -> FCode ()
forall a b. (a -> b) -> a -> b
$ String
"128-bit wide integer and double precision " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                String
"SIMD vector instructions require at least -msse2."
    check Width
W256 PrimOpVecCat
FloatVec Int
_ Width
_ | Bool -> Bool
not (StgToCmmConfig -> Bool
stgToCmmAvx StgToCmmConfig
cfg) =
        String -> FCode ()
forall a. HasCallStack => String -> a
sorry (String -> FCode ()) -> String -> FCode ()
forall a b. (a -> b) -> a -> b
$ String
"256-bit wide floating point " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                String
"SIMD vector instructions require at least -mavx."
    check Width
W256 PrimOpVecCat
_ Int
_ Width
_ | Bool -> Bool
not (StgToCmmConfig -> Bool
stgToCmmAvx2 StgToCmmConfig
cfg) =
        String -> FCode ()
forall a. HasCallStack => String -> a
sorry (String -> FCode ()) -> String -> FCode ()
forall a b. (a -> b) -> a -> b
$ String
"256-bit wide integer " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                String
"SIMD vector instructions require at least -mavx2."
    check Width
W512 PrimOpVecCat
_ Int
_ Width
_ | Bool -> Bool
not (StgToCmmConfig -> Bool
stgToCmmAvx512f StgToCmmConfig
cfg) =
        String -> FCode ()
forall a. HasCallStack => String -> a
sorry (String -> FCode ()) -> String -> FCode ()
forall a b. (a -> b) -> a -> b
$ String
"512-bit wide " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                String
"SIMD vector instructions require -mavx512f."
    check Width
_ PrimOpVecCat
_ Int
_ Width
_ = () -> FCode ()
forall a. a -> FCode a
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 :: CmmType       -- Type of vector
            -> CmmExpr       -- Initial vector
            -> [CmmExpr]     -- Elements
            -> CmmFormal     -- Destination for result
            -> FCode ()
doVecPackOp :: CmmType -> CmmExpr -> [CmmExpr] -> LocalReg -> FCode ()
doVecPackOp CmmType
ty CmmExpr
z [CmmExpr]
es LocalReg
res = do
    LocalReg
dst <- CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp CmmType
ty
    CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
dst) CmmExpr
z
    LocalReg -> [CmmExpr] -> Int -> FCode ()
vecPack LocalReg
dst [CmmExpr]
es Int
0
  where
    vecPack :: CmmFormal -> [CmmExpr] -> Int -> FCode ()
    vecPack :: LocalReg -> [CmmExpr] -> Int -> FCode ()
vecPack LocalReg
src [] Int
_ =
        CmmReg -> CmmExpr -> FCode ()
emitAssign (LocalReg -> CmmReg
CmmLocal LocalReg
res) (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
src))

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

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

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

doVecUnpackOp :: CmmType       -- Type of vector
              -> CmmExpr       -- Vector
              -> [CmmFormal]   -- Element results
              -> FCode ()
doVecUnpackOp :: CmmType -> CmmExpr -> [LocalReg] -> FCode ()
doVecUnpackOp CmmType
ty CmmExpr
e [LocalReg]
res =
    [LocalReg] -> Int -> FCode ()
vecUnpack [LocalReg]
res Int
0
  where
    vecUnpack :: [CmmFormal] -> Int -> FCode ()
    vecUnpack :: [LocalReg] -> Int -> FCode ()
vecUnpack [] Int
_ =
        () -> FCode ()
forall a. a -> FCode a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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

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

doVecInsertOp :: CmmType       -- Vector type
              -> CmmExpr       -- Source vector
              -> CmmExpr       -- Element
              -> CmmExpr       -- Index at which to insert element
              -> CmmFormal     -- Destination for result
              -> FCode ()
doVecInsertOp :: CmmType -> CmmExpr -> CmmExpr -> CmmExpr -> LocalReg -> FCode ()
doVecInsertOp CmmType
ty CmmExpr
src CmmExpr
e CmmExpr
idx LocalReg
res = do
    Platform
platform <- FCode Platform
getPlatform
    -- vector indices are always 32-bits
    let idx' :: CmmExpr
        idx' :: CmmExpr
idx' = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> Width -> MachOp
MO_SS_Conv (Platform -> Width
wordWidth Platform
platform) 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
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
e, CmmExpr
idx'])
  where

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

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

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


-- | Translate byte array prefetch operations into proper primcalls.
doPrefetchByteArrayOp :: Int
                      -> [CmmExpr]
                      -> FCode ()
doPrefetchByteArrayOp :: Int -> [CmmExpr] -> FCode ()
doPrefetchByteArrayOp Int
locality  [CmmExpr
addr,CmmExpr
idx]
   = do Profile
profile <- FCode Profile
getProfile
        Int -> Int -> CmmExpr -> CmmExpr -> FCode ()
mkBasicPrefetch Int
locality (Profile -> Int
arrWordsHdrSize Profile
profile)  CmmExpr
addr CmmExpr
idx
doPrefetchByteArrayOp Int
_ [CmmExpr]
_
   = String -> FCode ()
forall a. HasCallStack => String -> a
panic String
"GHC.StgToCmm.Prim: doPrefetchByteArrayOp"

-- | Translate mutable byte array prefetch operations into proper primcalls.
doPrefetchMutableByteArrayOp :: Int
                      -> [CmmExpr]
                      -> FCode ()
doPrefetchMutableByteArrayOp :: Int -> [CmmExpr] -> FCode ()
doPrefetchMutableByteArrayOp Int
locality  [CmmExpr
addr,CmmExpr
idx]
   = do Profile
profile <- FCode Profile
getProfile
        Int -> Int -> CmmExpr -> CmmExpr -> FCode ()
mkBasicPrefetch Int
locality (Profile -> Int
arrWordsHdrSize Profile
profile)  CmmExpr
addr CmmExpr
idx
doPrefetchMutableByteArrayOp Int
_ [CmmExpr]
_
   = String -> FCode ()
forall a. HasCallStack => String -> a
panic String
"GHC.StgToCmm.Prim: doPrefetchByteArrayOp"

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

-- | Translate value prefetch operations into proper primcalls.
doPrefetchValueOp :: Int
                 -> [CmmExpr]
                 -> FCode ()
doPrefetchValueOp :: Int -> [CmmExpr] -> FCode ()
doPrefetchValueOp  Int
locality   [CmmExpr
addr]
  =  do Platform
platform <- FCode Platform
getPlatform
        Int -> Int -> CmmExpr -> CmmExpr -> FCode ()
mkBasicPrefetch Int
locality Int
0 CmmExpr
addr  (CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
0 (Platform -> Width
wordWidth Platform
platform)))
doPrefetchValueOp Int
_ [CmmExpr]
_
  = String -> FCode ()
forall a. HasCallStack => String -> a
panic String
"GHC.StgToCmm.Prim: doPrefetchValueOp"

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

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

-- | Takes a register to return the newly allocated array in and the
-- size of the new array in bytes. Allocates a new
-- 'MutableByteArray#'.
doNewByteArrayOp :: CmmFormal -> ByteOff -> FCode ()
doNewByteArrayOp :: LocalReg -> Int -> FCode ()
doNewByteArrayOp LocalReg
res_r Int
n = do
    Profile
profile <- FCode Profile
getProfile
    Platform
platform <- FCode Platform
getPlatform

    let info_ptr :: CmmExpr
info_ptr = CLabel -> CmmExpr
mkLblExpr CLabel
mkArrWords_infoLabel
        rep :: SMRep
rep = Platform -> Int -> SMRep
arrWordsRep Platform
platform Int
n

    CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
tickyAllocPrim (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (Profile -> Int
arrWordsHdrSize Profile
profile))
        (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (Platform -> SMRep -> Int
nonHdrSize Platform
platform SMRep
rep))
        (Platform -> CmmExpr
zeroExpr Platform
platform)

    let hdr_size :: Int
hdr_size = Profile -> Int
fixedHdrSize Profile
profile

    CmmExpr
base <- SMRep -> CmmExpr -> CmmExpr -> [(CmmExpr, Int)] -> FCode CmmExpr
allocHeapClosure SMRep
rep CmmExpr
info_ptr CmmExpr
cccsExpr
                     [ (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform Int
n,
                        Int
hdr_size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PlatformConstants -> Int
pc_OFFSET_StgArrBytes_bytes (Platform -> PlatformConstants
platformConstants Platform
platform))
                     ]

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

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

doCompareByteArraysOp :: LocalReg -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
                     -> FCode ()
doCompareByteArraysOp :: LocalReg
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCompareByteArraysOp LocalReg
res CmmExpr
ba1 CmmExpr
ba1_off CmmExpr
ba2 CmmExpr
ba2_off CmmExpr
n = do
    Profile
profile <- FCode Profile
getProfile
    Platform
platform <- FCode Platform
getPlatform

    CmmExpr -> FCode () -> FCode ()
ifNonZero CmmExpr
n (FCode () -> FCode ()) -> FCode () -> FCode ()
forall a b. (a -> b) -> a -> b
$ do
        let last_touched_idx :: CmmExpr -> CmmExpr
last_touched_idx CmmExpr
off = Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform (Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmAddWord Platform
platform CmmExpr
off CmmExpr
n) (-Int
1)
        CmmExpr -> CmmExpr -> CmmType -> CmmType -> FCode ()
doByteArrayBoundsCheck (CmmExpr -> CmmExpr
last_touched_idx CmmExpr
ba1_off) CmmExpr
ba1 CmmType
b8 CmmType
b8
        CmmExpr -> CmmExpr -> CmmType -> CmmType -> FCode ()
doByteArrayBoundsCheck (CmmExpr -> CmmExpr
last_touched_idx CmmExpr
ba2_off) CmmExpr
ba2 CmmType
b8 CmmType
b8

    CmmExpr
ba1_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExpr Platform
platform (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
ba1 (Profile -> Int
arrWordsHdrSize Profile
profile)) CmmExpr
ba1_off
    CmmExpr
ba2_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExpr Platform
platform (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
ba2 (Profile -> Int
arrWordsHdrSize Profile
profile)) 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) (Platform -> CmmExpr
zeroExpr Platform
platform))
    CmmAGraph -> FCode ()
emit (CmmExpr -> BlockId -> BlockId -> Maybe Bool -> CmmAGraph
mkCbranch (Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmEqWord Platform
platform CmmExpr
ba1_p CmmExpr
ba2_p)
                    BlockId
l_ptr_eq BlockId
l_ptr_ne (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False))

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

    BlockId -> FCode ()
emitLabel BlockId
l_ptr_eq

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

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

-- | 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
 -> Alignment
 -> FCode ())
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
emitCopyByteArray CmmExpr
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> Alignment
-> 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
-> Alignment
-> FCode ()
copy CmmExpr
src CmmExpr
dst CmmExpr
dst_p CmmExpr
src_p CmmExpr
bytes Alignment
align = do
        Platform
platform <- FCode Platform
getPlatform
        (CmmAGraph
moveCall, CmmAGraph
cpyCall) <- FCode CmmAGraph -> FCode CmmAGraph -> FCode (CmmAGraph, CmmAGraph)
forall a. FCode a -> FCode a -> FCode (a, a)
forkAltPair
            (FCode () -> FCode CmmAGraph
forall a. FCode a -> FCode CmmAGraph
getCode (FCode () -> FCode CmmAGraph) -> FCode () -> FCode CmmAGraph
forall a b. (a -> b) -> a -> b
$ CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
emitMemmoveCall CmmExpr
dst_p CmmExpr
src_p CmmExpr
bytes Alignment
align)
            (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 -> Alignment -> FCode ()
emitMemcpyCall  CmmExpr
dst_p CmmExpr
src_p CmmExpr
bytes Alignment
align)
        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 (Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmEqWord Platform
platform CmmExpr
src CmmExpr
dst) CmmAGraph
moveCall CmmAGraph
cpyCall

emitCopyByteArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
                      -> Alignment -> FCode ())
                  -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
                  -> FCode ()
emitCopyByteArray :: (CmmExpr
 -> CmmExpr
 -> CmmExpr
 -> CmmExpr
 -> CmmExpr
 -> Alignment
 -> FCode ())
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
emitCopyByteArray CmmExpr
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> Alignment
-> FCode ()
copy CmmExpr
src CmmExpr
src_off CmmExpr
dst CmmExpr
dst_off CmmExpr
n = do
    Profile
profile <- FCode Profile
getProfile
    Platform
platform <- FCode Platform
getPlatform

    CmmExpr -> FCode () -> FCode ()
ifNonZero CmmExpr
n (FCode () -> FCode ()) -> FCode () -> FCode ()
forall a b. (a -> b) -> a -> b
$ do
        let last_touched_idx :: CmmExpr -> CmmExpr
last_touched_idx CmmExpr
off = Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform (Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmAddWord Platform
platform CmmExpr
off CmmExpr
n) (-Int
1)
        CmmExpr -> CmmExpr -> CmmType -> CmmType -> FCode ()
doByteArrayBoundsCheck (CmmExpr -> CmmExpr
last_touched_idx CmmExpr
src_off) CmmExpr
src CmmType
b8 CmmType
b8
        CmmExpr -> CmmExpr -> CmmType -> CmmType -> FCode ()
doByteArrayBoundsCheck (CmmExpr -> CmmExpr
last_touched_idx CmmExpr
dst_off) CmmExpr
dst CmmType
b8 CmmType
b8

    let byteArrayAlignment :: Alignment
byteArrayAlignment = Platform -> Alignment
wordAlignment Platform
platform
        srcOffAlignment :: Alignment
srcOffAlignment = CmmExpr -> Alignment
cmmExprAlignment CmmExpr
src_off
        dstOffAlignment :: Alignment
dstOffAlignment = CmmExpr -> Alignment
cmmExprAlignment CmmExpr
dst_off
        align :: Alignment
align = [Alignment] -> Alignment
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Alignment
byteArrayAlignment, Alignment
srcOffAlignment, Alignment
dstOffAlignment]
    CmmExpr
dst_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExpr Platform
platform (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
dst (Profile -> Int
arrWordsHdrSize Profile
profile)) CmmExpr
dst_off
    CmmExpr
src_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExpr Platform
platform (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
src (Profile -> Int
arrWordsHdrSize Profile
profile)) CmmExpr
src_off
    CmmExpr
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> CmmExpr
-> Alignment
-> FCode ()
copy CmmExpr
src CmmExpr
dst CmmExpr
dst_p CmmExpr
src_p CmmExpr
n Alignment
align

-- | Takes a source 'ByteArray#', an offset in the source array, a
-- destination 'Addr#', and the number of bytes to copy.  Copies the given
-- number of bytes from the source array to the destination memory region.
doCopyByteArrayToAddrOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyByteArrayToAddrOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyByteArrayToAddrOp CmmExpr
src CmmExpr
src_off CmmExpr
dst_p CmmExpr
bytes = do
    -- Use memcpy (we are allowed to assume the arrays aren't overlapping)
    Profile
profile <- FCode Profile
getProfile
    Platform
platform <- FCode Platform
getPlatform
    CmmExpr -> FCode () -> FCode ()
ifNonZero CmmExpr
bytes (FCode () -> FCode ()) -> FCode () -> FCode ()
forall a b. (a -> b) -> a -> b
$ do
        let last_touched_idx :: CmmExpr -> CmmExpr
last_touched_idx CmmExpr
off = Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform (Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmAddWord Platform
platform CmmExpr
off CmmExpr
bytes) (-Int
1)
        CmmExpr -> CmmExpr -> CmmType -> CmmType -> FCode ()
doByteArrayBoundsCheck (CmmExpr -> CmmExpr
last_touched_idx CmmExpr
src_off) CmmExpr
src CmmType
b8 CmmType
b8
    CmmExpr
src_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExpr Platform
platform (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
src (Profile -> Int
arrWordsHdrSize Profile
profile)) CmmExpr
src_off
    CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
emitMemcpyCall CmmExpr
dst_p CmmExpr
src_p CmmExpr
bytes (Int -> Alignment
mkAlignment Int
1)

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

-- | Takes a source 'Addr#', a destination 'MutableByteArray#', an offset into
-- the destination array, and the number of bytes to copy.  Copies the given
-- number of bytes from the source memory region to the destination array.
doCopyAddrToByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyAddrToByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doCopyAddrToByteArrayOp CmmExpr
src_p CmmExpr
dst CmmExpr
dst_off CmmExpr
bytes = do
    -- Use memcpy (we are allowed to assume the arrays aren't overlapping)
    Profile
profile <- FCode Profile
getProfile
    Platform
platform <- FCode Platform
getPlatform
    CmmExpr -> FCode () -> FCode ()
ifNonZero CmmExpr
bytes (FCode () -> FCode ()) -> FCode () -> FCode ()
forall a b. (a -> b) -> a -> b
$ do
        let last_touched_idx :: CmmExpr -> CmmExpr
last_touched_idx CmmExpr
off = Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform (Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmAddWord Platform
platform CmmExpr
off CmmExpr
bytes) (-Int
1)
        CmmExpr -> CmmExpr -> CmmType -> CmmType -> FCode ()
doByteArrayBoundsCheck (CmmExpr -> CmmExpr
last_touched_idx CmmExpr
dst_off) CmmExpr
dst CmmType
b8 CmmType
b8
    CmmExpr
dst_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExpr Platform
platform (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
dst (Profile -> Int
arrWordsHdrSize Profile
profile)) CmmExpr
dst_off
    CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
emitMemcpyCall CmmExpr
dst_p CmmExpr
src_p CmmExpr
bytes (Int -> Alignment
mkAlignment Int
1)

ifNonZero :: CmmExpr -> FCode () -> FCode ()
ifNonZero :: CmmExpr -> FCode () -> FCode ()
ifNonZero CmmExpr
e FCode ()
it = do
    Platform
platform <- FCode Platform
getPlatform
    let pred :: CmmExpr
pred = Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmNeWord Platform
platform CmmExpr
e (Platform -> CmmExpr
zeroExpr Platform
platform)
    CmmAGraph
code <- FCode () -> FCode CmmAGraph
forall a. FCode a -> FCode CmmAGraph
getCode FCode ()
it
    CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> FCode CmmAGraph -> FCode ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CmmExpr -> CmmAGraph -> Maybe Bool -> FCode CmmAGraph
mkCmmIfThen' CmmExpr
pred CmmAGraph
code (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False)

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

-- | Takes a 'MutableByteArray#', an offset into the array, a length,
-- and a byte, and sets each of the selected bytes in the array to the
-- character.
doSetByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
                 -> FCode ()
doSetByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doSetByteArrayOp CmmExpr
ba CmmExpr
off CmmExpr
len CmmExpr
c = do
    Profile
profile <- FCode Profile
getProfile
    Platform
platform <- FCode Platform
getPlatform

    CmmExpr -> CmmExpr -> CmmType -> CmmType -> FCode ()
doByteArrayBoundsCheck CmmExpr
off CmmExpr
ba CmmType
b8 CmmType
b8
    CmmExpr -> CmmExpr -> CmmType -> CmmType -> FCode ()
doByteArrayBoundsCheck (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffset Platform
platform (Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmAddWord Platform
platform CmmExpr
off CmmExpr
len) (-Int
1)) CmmExpr
ba CmmType
b8 CmmType
b8

    let byteArrayAlignment :: Alignment
byteArrayAlignment = Platform -> Alignment
wordAlignment Platform
platform -- known since BA is allocated on heap
        offsetAlignment :: Alignment
offsetAlignment = CmmExpr -> Alignment
cmmExprAlignment CmmExpr
off
        align :: Alignment
align = Alignment -> Alignment -> Alignment
forall a. Ord a => a -> a -> a
min Alignment
byteArrayAlignment Alignment
offsetAlignment

    CmmExpr
p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExpr Platform
platform (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
ba (Profile -> Int
arrWordsHdrSize Profile
profile)) CmmExpr
off
    CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
emitMemsetCall CmmExpr
p CmmExpr
c CmmExpr
len Alignment
align

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

-- | Allocate a new array.
doNewArrayOp :: CmmFormal             -- ^ return register
             -> SMRep                 -- ^ representation of the array
             -> CLabel                -- ^ info pointer
             -> [(CmmExpr, ByteOff)]  -- ^ header payload
             -> WordOff               -- ^ array size
             -> CmmExpr               -- ^ initial element
             -> FCode ()
doNewArrayOp :: LocalReg
-> SMRep
-> CLabel
-> [(CmmExpr, Int)]
-> Int
-> CmmExpr
-> FCode ()
doNewArrayOp LocalReg
res_r SMRep
rep CLabel
info [(CmmExpr, Int)]
payload Int
n CmmExpr
init = do
    Profile
profile <- FCode Profile
getProfile
    Platform
platform <- FCode Platform
getPlatform

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

    CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
tickyAllocPrim (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (Profile -> SMRep -> Int
hdrSize Profile
profile SMRep
rep))
        (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (Platform -> SMRep -> Int
nonHdrSize Platform
platform SMRep
rep))
        (Platform -> CmmExpr
zeroExpr Platform
platform)

    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 a b. (a -> b) -> FCode a -> FCode b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp (Platform -> CmmType
bWord Platform
platform)
    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
    let mkOff :: Int -> CmmExpr
mkOff Int
off = Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetW Platform
platform (CmmReg -> CmmExpr
CmmReg CmmReg
arr) (Profile -> SMRep -> Int
hdrSizeW Profile
profile SMRep
rep Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off)
        initialization :: [CmmAGraph]
initialization = [ CmmExpr -> CmmExpr -> CmmAGraph
mkStore (Int -> CmmExpr
mkOff Int
off) CmmExpr
init | Int
off <- [Int
0.. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ]
    CmmAGraph -> FCode ()
emit ([CmmAGraph] -> CmmAGraph
catAGraphs [CmmAGraph]
initialization)

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

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

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

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

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


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

emitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> ByteOff
                  -> FCode ())  -- ^ copy function
              -> CmmExpr        -- ^ source array
              -> CmmExpr        -- ^ offset in source array
              -> CmmExpr        -- ^ destination array
              -> CmmExpr        -- ^ offset in destination array
              -> WordOff        -- ^ number of elements to copy
              -> FCode ()
emitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ())
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCopyArray CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
copy CmmExpr
src0 CmmExpr
src_off CmmExpr
dst0 CmmExpr
dst_off0 Int
n =
    Bool -> FCode () -> FCode ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (FCode () -> FCode ()) -> FCode () -> FCode ()
forall a b. (a -> b) -> a -> b
$ do
        Profile
profile <- FCode Profile
getProfile
        Platform
platform <- FCode Platform
getPlatform

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

        CmmExpr -> CmmExpr -> FCode ()
doPtrArrayBoundsCheck (Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmAddWord Platform
platform CmmExpr
src_off (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform Int
n)) CmmExpr
src
        CmmExpr -> CmmExpr -> FCode ()
doPtrArrayBoundsCheck (Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmAddWord Platform
platform CmmExpr
dst_off (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform Int
n)) CmmExpr
dst

        -- Nonmoving collector write barrier
        Platform -> Int -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCopyUpdRemSetPush Platform
platform (Profile -> Int
arrPtrsHdrSize Profile
profile) CmmExpr
dst CmmExpr
dst_off Int
n

        -- 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
$ Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
dst
                       (Profile -> Int
arrPtrsHdrSize Profile
profile)
        CmmExpr
dst_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExprW Platform
platform 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
$ Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExprW Platform
platform
                 (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
src (Profile -> Int
arrPtrsHdrSize Profile
profile)) CmmExpr
src_off
        let bytes :: Int
bytes = Platform -> Int -> Int
forall a. Num a => Platform -> a -> a
wordsToBytes Platform
platform 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
$ Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExprW Platform
platform CmmExpr
dst_elems_p
                       (Profile -> CmmExpr -> CmmExpr
loadArrPtrsSize Profile
profile CmmExpr
dst)

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

doCopySmallArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
                   -> FCode ()
doCopySmallArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
doCopySmallArrayOp = (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ())
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCopySmallArray CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
forall {p} {p}. p -> p -> CmmExpr -> CmmExpr -> Int -> FCode ()
copy
  where
    -- Copy data (we assume the arrays aren't overlapping since
    -- they're of different types)
    copy :: p -> p -> CmmExpr -> CmmExpr -> Int -> FCode ()
copy p
_src p
_dst CmmExpr
dst_p CmmExpr
src_p Int
bytes =
        do Platform
platform <- FCode Platform
getPlatform
           CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
emitMemcpyCall CmmExpr
dst_p CmmExpr
src_p (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform Int
bytes)
               (Platform -> Alignment
wordAlignment Platform
platform)


doCopySmallMutableArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
                          -> FCode ()
doCopySmallMutableArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
doCopySmallMutableArrayOp = (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ())
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCopySmallArray CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
copy
  where
    -- The only time the memory might overlap is when the two arrays
    -- we were provided are the same array!
    -- TODO: Optimize branch for common case of no aliasing.
    copy :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
copy CmmExpr
src CmmExpr
dst CmmExpr
dst_p CmmExpr
src_p Int
bytes = do
        Platform
platform <- FCode Platform
getPlatform
        (CmmAGraph
moveCall, CmmAGraph
cpyCall) <- FCode CmmAGraph -> FCode CmmAGraph -> FCode (CmmAGraph, CmmAGraph)
forall a. FCode a -> FCode a -> FCode (a, a)
forkAltPair
            (FCode () -> FCode CmmAGraph
forall a. FCode a -> FCode CmmAGraph
getCode (FCode () -> FCode CmmAGraph) -> FCode () -> FCode CmmAGraph
forall a b. (a -> b) -> a -> b
$ CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
emitMemmoveCall CmmExpr
dst_p CmmExpr
src_p (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform Int
bytes)
             (Platform -> Alignment
wordAlignment Platform
platform))
            (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 -> Alignment -> FCode ()
emitMemcpyCall  CmmExpr
dst_p CmmExpr
src_p (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform Int
bytes)
             (Platform -> Alignment
wordAlignment Platform
platform))
        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 (Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmEqWord Platform
platform CmmExpr
src CmmExpr
dst) CmmAGraph
moveCall CmmAGraph
cpyCall

emitCopySmallArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> ByteOff
                       -> FCode ())  -- ^ copy function
                   -> CmmExpr        -- ^ source array
                   -> CmmExpr        -- ^ offset in source array
                   -> CmmExpr        -- ^ destination array
                   -> CmmExpr        -- ^ offset in destination array
                   -> WordOff        -- ^ number of elements to copy
                   -> FCode ()
emitCopySmallArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ())
-> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCopySmallArray CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
copy CmmExpr
src0 CmmExpr
src_off CmmExpr
dst0 CmmExpr
dst_off Int
n =
    Bool -> FCode () -> FCode ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (FCode () -> FCode ()) -> FCode () -> FCode ()
forall a b. (a -> b) -> a -> b
$ do
        Profile
profile <- FCode Profile
getProfile
        Platform
platform <- FCode Platform
getPlatform

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

        Bool -> FCode () -> FCode ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (FCode () -> FCode ()) -> FCode () -> FCode ()
forall a b. (a -> b) -> a -> b
$ do
            CmmExpr -> CmmExpr -> FCode ()
doSmallPtrArrayBoundsCheck (Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmAddWord Platform
platform CmmExpr
src_off (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform Int
n)) CmmExpr
src
            CmmExpr -> CmmExpr -> FCode ()
doSmallPtrArrayBoundsCheck (Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmAddWord Platform
platform CmmExpr
dst_off (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform Int
n)) CmmExpr
dst

        -- Nonmoving collector write barrier
        Platform -> Int -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCopyUpdRemSetPush Platform
platform (Profile -> Int
smallArrPtrsHdrSize Profile
profile) CmmExpr
dst CmmExpr
dst_off Int
n

        -- 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
$ Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExprW Platform
platform
                 (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
dst (Profile -> Int
smallArrPtrsHdrSize Profile
profile)) CmmExpr
dst_off
        CmmExpr
src_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExprW Platform
platform
                 (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
src (Profile -> Int
smallArrPtrsHdrSize Profile
profile)) CmmExpr
src_off
        let bytes :: Int
bytes = Platform -> Int -> Int
forall a. Num a => Platform -> a -> a
wordsToBytes Platform
platform Int
n

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

-- | Takes an info table label, a register to return the newly
-- allocated array in, a source array, an offset in the source array,
-- and the number of elements to copy. Allocates a new array and
-- initializes it from the source array.
emitCloneArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> WordOff
               -> FCode ()
emitCloneArray :: CLabel -> LocalReg -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCloneArray CLabel
info_p LocalReg
res_r CmmExpr
src CmmExpr
src_off Int
n = do
    Profile
profile <- FCode Profile
getProfile
    Platform
platform <- FCode Platform
getPlatform

    let info_ptr :: CmmExpr
info_ptr = CLabel -> CmmExpr
mkLblExpr CLabel
info_p
        rep :: SMRep
rep = Platform -> Int -> SMRep
arrPtrsRep Platform
platform Int
n

    CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
tickyAllocPrim (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (Profile -> Int
arrPtrsHdrSize Profile
profile))
        (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (Platform -> SMRep -> Int
nonHdrSize Platform
platform SMRep
rep))
        (Platform -> CmmExpr
zeroExpr Platform
platform)

    let hdr_size :: Int
hdr_size = Profile -> Int
fixedHdrSize Profile
profile
        constants :: PlatformConstants
constants = Platform -> PlatformConstants
platformConstants Platform
platform

    CmmExpr
base <- SMRep -> CmmExpr -> CmmExpr -> [(CmmExpr, Int)] -> FCode CmmExpr
allocHeapClosure SMRep
rep CmmExpr
info_ptr CmmExpr
cccsExpr
                     [ (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform Int
n,
                        Int
hdr_size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PlatformConstants -> Int
pc_OFFSET_StgMutArrPtrs_ptrs PlatformConstants
constants)
                     , (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (SMRep -> Int
nonHdrSizeW SMRep
rep),
                        Int
hdr_size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PlatformConstants -> Int
pc_OFFSET_StgMutArrPtrs_size PlatformConstants
constants)
                     ]

    CmmReg
arr <- LocalReg -> CmmReg
CmmLocal (LocalReg -> CmmReg) -> FCode LocalReg -> FCode CmmReg
forall a b. (a -> b) -> FCode a -> FCode b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp (Platform -> CmmType
bWord Platform
platform)
    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
$ Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform (CmmReg -> CmmExpr
CmmReg CmmReg
arr)
             (Profile -> Int
arrPtrsHdrSize Profile
profile)
    CmmExpr
src_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExprW Platform
platform CmmExpr
src
             (Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmAddWord Platform
platform
              (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (Profile -> Int
arrPtrsHdrSizeW Profile
profile)) CmmExpr
src_off)

    CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
emitMemcpyCall CmmExpr
dst_p CmmExpr
src_p (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (Platform -> Int -> Int
forall a. Num a => Platform -> a -> a
wordsToBytes Platform
platform Int
n))
        (Platform -> Alignment
wordAlignment Platform
platform)

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

-- | Takes an info table label, a register to return the newly
-- allocated array in, a source array, an offset in the source array,
-- and the number of elements to copy. Allocates a new array and
-- initializes it from the source array.
emitCloneSmallArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> WordOff
                    -> FCode ()
emitCloneSmallArray :: CLabel -> LocalReg -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCloneSmallArray CLabel
info_p LocalReg
res_r CmmExpr
src CmmExpr
src_off Int
n = do
    Profile
profile  <- FCode Profile
getProfile
    Platform
platform <- FCode Platform
getPlatform

    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 (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (Profile -> Int
smallArrPtrsHdrSize Profile
profile))
        (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (Platform -> SMRep -> Int
nonHdrSize Platform
platform SMRep
rep))
        (Platform -> CmmExpr
zeroExpr Platform
platform)

    let hdr_size :: Int
hdr_size = Profile -> Int
fixedHdrSize Profile
profile

    CmmExpr
base <- SMRep -> CmmExpr -> CmmExpr -> [(CmmExpr, Int)] -> FCode CmmExpr
allocHeapClosure SMRep
rep CmmExpr
info_ptr CmmExpr
cccsExpr
                     [ (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform Int
n,
                        Int
hdr_size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PlatformConstants -> Int
pc_OFFSET_StgSmallMutArrPtrs_ptrs (Platform -> PlatformConstants
platformConstants Platform
platform))
                     ]

    CmmReg
arr <- LocalReg -> CmmReg
CmmLocal (LocalReg -> CmmReg) -> FCode LocalReg -> FCode CmmReg
forall a b. (a -> b) -> FCode a -> FCode b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp (Platform -> CmmType
bWord Platform
platform)
    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
$ Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform (CmmReg -> CmmExpr
CmmReg CmmReg
arr)
             (Profile -> Int
smallArrPtrsHdrSize Profile
profile)
    CmmExpr
src_p <- CmmExpr -> FCode CmmExpr
assignTempE (CmmExpr -> FCode CmmExpr) -> CmmExpr -> FCode CmmExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExprW Platform
platform CmmExpr
src
             (Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmAddWord Platform
platform
              (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (Profile -> Int
smallArrPtrsHdrSizeW Profile
profile)) CmmExpr
src_off)

    CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
emitMemcpyCall CmmExpr
dst_p CmmExpr
src_p (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (Platform -> Int -> Int
forall a. Num a => Platform -> a -> a
wordsToBytes Platform
platform Int
n))
        (Platform -> Alignment
wordAlignment Platform
platform)

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

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

-- Convert an element index to a card index
cardCmm :: Platform -> CmmExpr -> CmmExpr
cardCmm :: Platform -> CmmExpr -> CmmExpr
cardCmm Platform
platform CmmExpr
i =
    Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmUShrWord Platform
platform CmmExpr
i (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform (PlatformConstants -> Int
pc_MUT_ARR_PTRS_CARD_BITS (Platform -> PlatformConstants
platformConstants Platform
platform)))

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

doReadSmallPtrArrayOp :: LocalReg
                      -> CmmExpr
                      -> CmmExpr
                      -> FCode ()
doReadSmallPtrArrayOp :: LocalReg -> CmmExpr -> CmmExpr -> FCode ()
doReadSmallPtrArrayOp LocalReg
res CmmExpr
addr CmmExpr
idx = do
    Profile
profile <- FCode Profile
getProfile
    Platform
platform <- FCode Platform
getPlatform
    CmmExpr -> CmmExpr -> FCode ()
doSmallPtrArrayBoundsCheck CmmExpr
idx CmmExpr
addr
    AlignmentSpec
-> Int
-> Maybe MachOp
-> CmmType
-> LocalReg
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
mkBasicIndexedRead AlignmentSpec
NaturallyAligned (Profile -> Int
smallArrPtrsHdrSize Profile
profile) Maybe MachOp
forall a. Maybe a
Nothing (Platform -> CmmType
gcWord Platform
platform) LocalReg
res CmmExpr
addr
        (Platform -> CmmType
gcWord Platform
platform) CmmExpr
idx

doWriteSmallPtrArrayOp :: CmmExpr
                       -> CmmExpr
                       -> CmmExpr
                       -> FCode ()
doWriteSmallPtrArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
doWriteSmallPtrArrayOp CmmExpr
addr CmmExpr
idx CmmExpr
val = do
    Profile
profile <- FCode Profile
getProfile
    Platform
platform <- FCode Platform
getPlatform
    let ty :: CmmType
ty = Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
val

    CmmExpr -> CmmExpr -> FCode ()
doSmallPtrArrayBoundsCheck CmmExpr
idx CmmExpr
addr

    -- Update remembered set for non-moving collector
    LocalReg
tmp <- CmmType -> FCode LocalReg
forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
newTemp CmmType
ty
    AlignmentSpec
-> Int
-> Maybe MachOp
-> CmmType
-> LocalReg
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
mkBasicIndexedRead AlignmentSpec
NaturallyAligned (Profile -> Int
smallArrPtrsHdrSize Profile
profile) Maybe MachOp
forall a. Maybe a
Nothing CmmType
ty LocalReg
tmp CmmExpr
addr CmmType
ty CmmExpr
idx
    FCode () -> FCode ()
forall a. FCode a -> FCode ()
whenUpdRemSetEnabled (FCode () -> FCode ()) -> FCode () -> FCode ()
forall a b. (a -> b) -> a -> b
$ CmmExpr -> FCode ()
emitUpdRemSetPush (CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
tmp))

    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall [] CallishMachOp
MO_WriteBarrier [] -- #12469
    Int
-> Maybe MachOp
-> CmmExpr
-> CmmType
-> CmmExpr
-> CmmExpr
-> FCode ()
mkBasicIndexedWrite (Profile -> Int
smallArrPtrsHdrSize Profile
profile) 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.
doAtomicByteArrayRMW
            :: 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 ()
doAtomicByteArrayRMW :: LocalReg
-> AtomicMachOp
-> CmmExpr
-> CmmExpr
-> CmmType
-> CmmExpr
-> FCode ()
doAtomicByteArrayRMW LocalReg
res AtomicMachOp
amop CmmExpr
mba CmmExpr
idx CmmType
idx_ty CmmExpr
n = do
    Profile
profile <- FCode Profile
getProfile
    Platform
platform <- FCode Platform
getPlatform
    CmmExpr -> CmmExpr -> CmmType -> CmmType -> FCode ()
doByteArrayBoundsCheck CmmExpr
idx CmmExpr
mba CmmType
idx_ty CmmType
idx_ty
    let width :: Width
width = CmmType -> Width
typeWidth CmmType
idx_ty
        addr :: CmmExpr
addr  = Platform -> Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr
cmmIndexOffExpr Platform
platform (Profile -> Int
arrWordsHdrSize Profile
profile)
                Width
width CmmExpr
mba CmmExpr
idx
    LocalReg
-> AtomicMachOp -> CmmExpr -> CmmType -> CmmExpr -> FCode ()
doAtomicAddrRMW LocalReg
res AtomicMachOp
amop CmmExpr
addr CmmType
idx_ty CmmExpr
n

doAtomicAddrRMW
            :: LocalReg      -- ^ Result reg
            -> AtomicMachOp  -- ^ Atomic op (e.g. add)
            -> CmmExpr       -- ^ Addr#
            -> CmmType       -- ^ Pointed value type
            -> CmmExpr       -- ^ Op argument (e.g. amount to add)
            -> FCode ()
doAtomicAddrRMW :: LocalReg
-> AtomicMachOp -> CmmExpr -> CmmType -> CmmExpr -> FCode ()
doAtomicAddrRMW LocalReg
res AtomicMachOp
amop CmmExpr
addr CmmType
ty CmmExpr
n =
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ LocalReg
res ]
        (Width -> AtomicMachOp -> CallishMachOp
MO_AtomicRMW (CmmType -> Width
typeWidth CmmType
ty) AtomicMachOp
amop)
        [ CmmExpr
addr, CmmExpr
n ]

-- | Emit an atomic read to a byte array that acts as a memory barrier.
doAtomicReadByteArray
    :: LocalReg  -- ^ Result reg
    -> CmmExpr   -- ^ MutableByteArray#
    -> CmmExpr   -- ^ Index
    -> CmmType   -- ^ Type of element by which we are indexing
    -> FCode ()
doAtomicReadByteArray :: LocalReg -> CmmExpr -> CmmExpr -> CmmType -> FCode ()
doAtomicReadByteArray LocalReg
res CmmExpr
mba CmmExpr
idx CmmType
idx_ty = do
    Profile
profile <- FCode Profile
getProfile
    Platform
platform <- FCode Platform
getPlatform
    CmmExpr -> CmmExpr -> CmmType -> CmmType -> FCode ()
doByteArrayBoundsCheck CmmExpr
idx CmmExpr
mba CmmType
idx_ty CmmType
idx_ty
    let width :: Width
width = CmmType -> Width
typeWidth CmmType
idx_ty
        addr :: CmmExpr
addr  = Platform -> Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr
cmmIndexOffExpr Platform
platform (Profile -> Int
arrWordsHdrSize Profile
profile)
                Width
width CmmExpr
mba CmmExpr
idx
    LocalReg -> CmmExpr -> CmmType -> FCode ()
doAtomicReadAddr LocalReg
res CmmExpr
addr CmmType
idx_ty

-- | Emit an atomic read to an address that acts as a memory barrier.
doAtomicReadAddr
    :: LocalReg  -- ^ Result reg
    -> CmmExpr   -- ^ Addr#
    -> CmmType   -- ^ Type of element by which we are indexing
    -> FCode ()
doAtomicReadAddr :: LocalReg -> CmmExpr -> CmmType -> FCode ()
doAtomicReadAddr LocalReg
res CmmExpr
addr CmmType
ty =
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ LocalReg
res ]
        (Width -> MemoryOrdering -> CallishMachOp
MO_AtomicRead (CmmType -> Width
typeWidth CmmType
ty) MemoryOrdering
MemOrderSeqCst)
        [ CmmExpr
addr ]

-- | Emit an atomic write to a byte array that acts as a memory barrier.
doAtomicWriteByteArray
    :: CmmExpr   -- ^ MutableByteArray#
    -> CmmExpr   -- ^ Index
    -> CmmType   -- ^ Type of element by which we are indexing
    -> CmmExpr   -- ^ Value to write
    -> FCode ()
doAtomicWriteByteArray :: CmmExpr -> CmmExpr -> CmmType -> CmmExpr -> FCode ()
doAtomicWriteByteArray CmmExpr
mba CmmExpr
idx CmmType
idx_ty CmmExpr
val = do
    Profile
profile <- FCode Profile
getProfile
    Platform
platform <- FCode Platform
getPlatform
    CmmExpr -> CmmExpr -> CmmType -> CmmType -> FCode ()
doByteArrayBoundsCheck CmmExpr
idx CmmExpr
mba CmmType
idx_ty CmmType
idx_ty
    let width :: Width
width = CmmType -> Width
typeWidth CmmType
idx_ty
        addr :: CmmExpr
addr  = Platform -> Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr
cmmIndexOffExpr Platform
platform (Profile -> Int
arrWordsHdrSize Profile
profile)
                Width
width CmmExpr
mba CmmExpr
idx
    CmmExpr -> CmmType -> CmmExpr -> FCode ()
doAtomicWriteAddr CmmExpr
addr CmmType
idx_ty CmmExpr
val

-- | Emit an atomic write to an address that acts as a memory barrier.
doAtomicWriteAddr
    :: CmmExpr   -- ^ Addr#
    -> CmmType   -- ^ Type of element by which we are indexing
    -> CmmExpr   -- ^ Value to write
    -> FCode ()
doAtomicWriteAddr :: CmmExpr -> CmmType -> CmmExpr -> FCode ()
doAtomicWriteAddr CmmExpr
addr CmmType
ty CmmExpr
val =
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ {- no results -} ]
        (Width -> MemoryOrdering -> CallishMachOp
MO_AtomicWrite (CmmType -> Width
typeWidth CmmType
ty) MemoryOrdering
MemOrderSeqCst)
        [ CmmExpr
addr, CmmExpr
val ]

doCasByteArray
    :: LocalReg  -- ^ Result reg
    -> CmmExpr   -- ^ MutableByteArray#
    -> CmmExpr   -- ^ Index
    -> CmmType   -- ^ Type of element by which we are indexing
    -> CmmExpr   -- ^ Old value
    -> CmmExpr   -- ^ New value
    -> FCode ()
doCasByteArray :: LocalReg
-> CmmExpr -> CmmExpr -> CmmType -> CmmExpr -> CmmExpr -> FCode ()
doCasByteArray LocalReg
res CmmExpr
mba CmmExpr
idx CmmType
idx_ty CmmExpr
old CmmExpr
new = do
    Profile
profile <- FCode Profile
getProfile
    Platform
platform <- FCode Platform
getPlatform
    CmmExpr -> CmmExpr -> CmmType -> CmmType -> FCode ()
doByteArrayBoundsCheck CmmExpr
idx CmmExpr
mba CmmType
idx_ty CmmType
idx_ty
    let width :: Width
width = CmmType -> Width
typeWidth CmmType
idx_ty
        addr :: CmmExpr
addr = Platform -> Int -> Width -> CmmExpr -> CmmExpr -> CmmExpr
cmmIndexOffExpr Platform
platform (Profile -> Int
arrWordsHdrSize Profile
profile)
               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 -> Alignment -> FCode ()
emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
emitMemcpyCall CmmExpr
dst CmmExpr
src CmmExpr
n Alignment
align =
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ {-no results-} ]
        (Int -> CallishMachOp
MO_Memcpy (Alignment -> Int
alignmentBytes Alignment
align))
        [ CmmExpr
dst, CmmExpr
src, CmmExpr
n ]

-- | Emit a call to @memmove@.
emitMemmoveCall :: CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
emitMemmoveCall :: CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
emitMemmoveCall CmmExpr
dst CmmExpr
src CmmExpr
n Alignment
align =
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ {- no results -} ]
        (Int -> CallishMachOp
MO_Memmove (Alignment -> Int
alignmentBytes Alignment
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 -> Alignment -> FCode ()
emitMemsetCall :: CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
emitMemsetCall CmmExpr
dst CmmExpr
c CmmExpr
n Alignment
align =
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ {- no results -} ]
        (Int -> CallishMachOp
MO_Memset (Alignment -> Int
alignmentBytes Alignment
align))
        [ CmmExpr
dst, CmmExpr
c, CmmExpr
n ]

emitMemcmpCall :: LocalReg -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemcmpCall :: LocalReg -> CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitMemcmpCall LocalReg
res CmmExpr
ptr1 CmmExpr
ptr2 CmmExpr
n Int
align = do
    -- 'MO_Memcmp' is assumed to return an 32bit 'CInt' because all
    -- code-gens currently call out to the @memcmp(3)@ C function.
    -- This was easier than moving the sign-extensions into
    -- all the code-gens.
    Platform
platform <- FCode Platform
getPlatform
    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 a. a -> FCode a
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
$
      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
                         (Platform -> MachOp
mo_s_32ToWord Platform
platform)
                         [(CmmReg -> CmmExpr
CmmReg (LocalReg -> CmmReg
CmmLocal LocalReg
cres))])

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

emitBRevCall :: LocalReg -> CmmExpr -> Width -> FCode ()
emitBRevCall :: LocalReg -> CmmExpr -> Width -> FCode ()
emitBRevCall LocalReg
res CmmExpr
x Width
width =
    [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
emitPrimCall
        [ LocalReg
res ]
        (Width -> CallishMachOp
MO_BRev Width
width)
        [ CmmExpr
x ]

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

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

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

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

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

---------------------------------------------------------------------------
-- Array bounds checking
---------------------------------------------------------------------------

doBoundsCheck :: CmmExpr  -- ^ accessed index
              -> CmmExpr  -- ^ array size (in elements)
              -> FCode ()
doBoundsCheck :: CmmExpr -> CmmExpr -> FCode ()
doBoundsCheck CmmExpr
idx CmmExpr
sz = do
    Bool
do_bounds_check <- StgToCmmConfig -> Bool
stgToCmmDoBoundsCheck (StgToCmmConfig -> Bool) -> FCode StgToCmmConfig -> FCode Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FCode StgToCmmConfig
getStgToCmmConfig
    Platform
platform        <- FCode Platform
getPlatform
    Bool -> FCode () -> FCode ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
do_bounds_check (Platform -> FCode ()
doCheck Platform
platform)
  where
    doCheck :: Platform -> FCode ()
doCheck Platform
platform = do
        CmmAGraph
boundsCheckFailed <- FCode () -> FCode CmmAGraph
forall a. FCode a -> FCode CmmAGraph
getCode (FCode () -> FCode CmmAGraph) -> FCode () -> FCode CmmAGraph
forall a b. (a -> b) -> a -> b
$ [(LocalReg, ForeignHint)]
-> CmmExpr -> [(CmmExpr, ForeignHint)] -> FCode ()
emitCCall [] (CLabel -> CmmExpr
mkLblExpr CLabel
mkOutOfBoundsAccessLabel) []
        CmmAGraph -> FCode ()
emit (CmmAGraph -> FCode ()) -> FCode CmmAGraph -> FCode ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CmmExpr -> CmmAGraph -> Maybe Bool -> FCode CmmAGraph
mkCmmIfThen' CmmExpr
isOutOfBounds CmmAGraph
boundsCheckFailed (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False)
      where
        uGE :: CmmExpr -> CmmExpr -> CmmExpr
uGE = Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmUGeWord Platform
platform
        and :: CmmExpr -> CmmExpr -> CmmExpr
and = Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmAndWord Platform
platform
        zero :: CmmExpr
zero = Platform -> CmmExpr
zeroExpr Platform
platform
        ne :: CmmExpr -> CmmExpr -> CmmExpr
ne  = Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmNeWord Platform
platform
        isOutOfBounds :: CmmExpr
isOutOfBounds = ((CmmExpr
idx CmmExpr -> CmmExpr -> CmmExpr
`uGE` CmmExpr
sz) CmmExpr -> CmmExpr -> CmmExpr
`and` (CmmExpr
idx CmmExpr -> CmmExpr -> CmmExpr
`ne` CmmExpr
zero)) CmmExpr -> CmmExpr -> CmmExpr
`ne` CmmExpr
zero

-- We want to make sure that the array size computation is pushed into the
-- Opt_DoBoundsChecking check to avoid regregressing compiler performance when
-- it's disabled.
{-# INLINE doBoundsCheck #-}

doPtrArrayBoundsCheck
    :: CmmExpr  -- ^ accessed index (in bytes)
    -> CmmExpr  -- ^ pointer to @StgMutArrPtrs@
    -> FCode ()
doPtrArrayBoundsCheck :: CmmExpr -> CmmExpr -> FCode ()
doPtrArrayBoundsCheck CmmExpr
idx CmmExpr
arr = do
    Profile
profile <- FCode Profile
getProfile
    Platform
platform <- FCode Platform
getPlatform
    let sz :: CmmExpr
sz = Platform -> CmmExpr -> CmmExpr
cmmLoadBWord Platform
platform (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffset Platform
platform CmmExpr
arr Int
sz_off)
        sz_off :: Int
sz_off = Profile -> Int
fixedHdrSize Profile
profile Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PlatformConstants -> Int
pc_OFFSET_StgMutArrPtrs_ptrs (Platform -> PlatformConstants
platformConstants Platform
platform)
    CmmExpr -> CmmExpr -> FCode ()
doBoundsCheck CmmExpr
idx CmmExpr
sz

doSmallPtrArrayBoundsCheck
    :: CmmExpr  -- ^ accessed index (in bytes)
    -> CmmExpr  -- ^ pointer to @StgMutArrPtrs@
    -> FCode ()
doSmallPtrArrayBoundsCheck :: CmmExpr -> CmmExpr -> FCode ()
doSmallPtrArrayBoundsCheck CmmExpr
idx CmmExpr
arr = do
    Profile
profile <- FCode Profile
getProfile
    Platform
platform <- FCode Platform
getPlatform
    let sz :: CmmExpr
sz = Platform -> CmmExpr -> CmmExpr
cmmLoadBWord Platform
platform (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffset Platform
platform CmmExpr
arr Int
sz_off)
        sz_off :: Int
sz_off = Profile -> Int
fixedHdrSize Profile
profile Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PlatformConstants -> Int
pc_OFFSET_StgSmallMutArrPtrs_ptrs (Platform -> PlatformConstants
platformConstants Platform
platform)
    CmmExpr -> CmmExpr -> FCode ()
doBoundsCheck CmmExpr
idx CmmExpr
sz

doByteArrayBoundsCheck
    :: CmmExpr  -- ^ accessed index (in elements)
    -> CmmExpr  -- ^ pointer to @StgArrBytes@
    -> CmmType  -- ^ indexing type
    -> CmmType  -- ^ element type
    -> FCode ()
doByteArrayBoundsCheck :: CmmExpr -> CmmExpr -> CmmType -> CmmType -> FCode ()
doByteArrayBoundsCheck CmmExpr
idx CmmExpr
arr CmmType
idx_ty CmmType
elem_ty = do
    Profile
profile <- FCode Profile
getProfile
    Platform
platform <- FCode Platform
getPlatform
    let sz :: CmmExpr
sz = Platform -> CmmExpr -> CmmExpr
cmmLoadBWord Platform
platform (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffset Platform
platform CmmExpr
arr Int
sz_off)
        sz_off :: Int
sz_off = Profile -> Int
fixedHdrSize Profile
profile Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PlatformConstants -> Int
pc_OFFSET_StgArrBytes_bytes (Platform -> PlatformConstants
platformConstants Platform
platform)
        elem_sz :: Int
elem_sz = Width -> Int
widthInBytes (Width -> Int) -> Width -> Int
forall a b. (a -> b) -> a -> b
$ CmmType -> Width
typeWidth CmmType
elem_ty
        idx_sz :: Int
idx_sz = Width -> Int
widthInBytes (Width -> Int) -> Width -> Int
forall a b. (a -> b) -> a -> b
$ CmmType -> Width
typeWidth CmmType
idx_ty
        -- Ensure that the last byte of the access is within the array
        idx_bytes :: CmmExpr
idx_bytes = Platform -> CmmExpr -> Int -> CmmExpr
cmmOffsetB Platform
platform
          (Platform -> CmmExpr -> CmmExpr -> CmmExpr
cmmMulWord Platform
platform CmmExpr
idx (Platform -> Int -> CmmExpr
mkIntExpr Platform
platform Int
idx_sz))
          (Int
elem_sz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    CmmExpr -> CmmExpr -> FCode ()
doBoundsCheck CmmExpr
idx_bytes CmmExpr
sz

---------------------------------------------------------------------------
-- Pushing to the update remembered set
---------------------------------------------------------------------------

-- | Push a range of pointer-array elements that are about to be copied over to
-- the update remembered set.
emitCopyUpdRemSetPush :: Platform
                      -> ByteOff    -- ^ array header size (in bytes)
                      -> CmmExpr    -- ^ destination array
                      -> CmmExpr    -- ^ offset in destination array (in words)
                      -> Int        -- ^ number of elements to copy
                      -> FCode ()
emitCopyUpdRemSetPush :: Platform -> Int -> CmmExpr -> CmmExpr -> Int -> FCode ()
emitCopyUpdRemSetPush Platform
_platform Int
_hdr_size CmmExpr
_dst CmmExpr
_dst_off Int
0 = () -> FCode ()
forall a. a -> FCode a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
emitCopyUpdRemSetPush Platform
platform Int
hdr_size CmmExpr
dst CmmExpr
dst_off Int
n =
    FCode () -> FCode ()
forall a. FCode a -> FCode ()
whenUpdRemSetEnabled (FCode () -> FCode ()) -> FCode () -> FCode ()
forall a b. (a -> b) -> a -> b
$ do
        Int
updfr_off <- FCode Int
getUpdFrameOff
        CmmAGraph
graph <- CmmExpr
-> (Convention, Convention)
-> [LocalReg]
-> [CmmExpr]
-> Int
-> [CmmExpr]
-> FCode CmmAGraph
mkCall CmmExpr
lbl (Convention
NativeNodeCall,Convention
NativeReturn) [] [CmmExpr]
args Int
updfr_off []
        CmmAGraph -> FCode ()
emit CmmAGraph
graph
  where
    lbl :: CmmExpr
lbl = CLabel -> CmmExpr
mkLblExpr (CLabel -> CmmExpr) -> CLabel -> CmmExpr
forall a b. (a -> b) -> a -> b
$ PrimCall -> CLabel
mkPrimCallLabel
          (PrimCall -> CLabel) -> PrimCall -> CLabel
forall a b. (a -> b) -> a -> b
$ FastString -> Unit -> PrimCall
PrimCall (String -> FastString
fsLit String
"stg_copyArray_barrier") Unit
rtsUnit
    args :: [CmmExpr]
args =
      [ Platform -> Int -> CmmExpr
mkIntExpr Platform
platform Int
hdr_size
      , CmmExpr
dst
      , CmmExpr
dst_off
      , Platform -> Int -> CmmExpr
mkIntExpr Platform
platform Int
n
      ]