{-# LANGUAGE QuasiQuotes #-}

-- | C code generator.  This module can convert a correct ImpCode
-- program to an equivalent C program.
module Futhark.CodeGen.Backends.MulticoreC
  ( compileProg,
    GC.CParts (..),
    GC.asLibrary,
    GC.asExecutable,
    GC.asServer,
    operations,
    cliOptions,
    compileOp,
    ValueType (..),
    paramToCType,
    prepareTaskStruct,
    closureFreeStructField,
    generateParLoopFn,
    addTimingFields,
    functionTiming,
    functionIterations,
    multicoreDef,
    multicoreName,
    DefSpecifier,
    atomicOps,
  )
where

import Control.Monad
import Data.Loc
import Data.Map qualified as M
import Data.Maybe
import Data.Text qualified as T
import Futhark.CodeGen.Backends.GenericC qualified as GC
import Futhark.CodeGen.Backends.GenericC.Options
import Futhark.CodeGen.Backends.MulticoreC.Boilerplate (generateBoilerplate)
import Futhark.CodeGen.Backends.SimpleRep
import Futhark.CodeGen.ImpCode.Multicore hiding (ValueType)
import Futhark.CodeGen.ImpGen.Multicore qualified as ImpGen
import Futhark.IR.MCMem (MCMem, Prog)
import Futhark.MonadFreshNames
import Language.C.Quote.OpenCL qualified as C
import Language.C.Syntax qualified as C

-- | Compile the program to ImpCode with multicore operations.
compileProg ::
  (MonadFreshNames m) => T.Text -> Prog MCMem -> m (ImpGen.Warnings, GC.CParts)
compileProg :: forall (m :: * -> *).
MonadFreshNames m =>
Text -> Prog MCMem -> m (Warnings, CParts)
compileProg Text
version =
  (Definitions Multicore -> m CParts)
-> (Warnings, Definitions Multicore) -> m (Warnings, CParts)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (Warnings, a) -> f (Warnings, b)
traverse
    ( Text
-> Text
-> ParamMap
-> Operations Multicore ()
-> CompilerM Multicore () ()
-> Text
-> (Space, [Space])
-> [Option]
-> Definitions Multicore
-> m CParts
forall (m :: * -> *) op.
MonadFreshNames m =>
Text
-> Text
-> ParamMap
-> Operations op ()
-> CompilerM op () ()
-> Text
-> (Space, [Space])
-> [Option]
-> Definitions op
-> m CParts
GC.compileProg
        Text
"multicore"
        Text
version
        ParamMap
forall a. Monoid a => a
mempty
        Operations Multicore ()
forall s. Operations Multicore s
operations
        CompilerM Multicore () ()
forall op s. CompilerM op s ()
generateBoilerplate
        Text
"#include <pthread.h>\n"
        (Space
DefaultSpace, [Space
DefaultSpace])
        [Option]
cliOptions
    )
    ((Warnings, Definitions Multicore) -> m (Warnings, CParts))
-> (Prog MCMem -> m (Warnings, Definitions Multicore))
-> Prog MCMem
-> m (Warnings, CParts)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Prog MCMem -> m (Warnings, Definitions Multicore)
forall (m :: * -> *).
MonadFreshNames m =>
Prog MCMem -> m (Warnings, Definitions Multicore)
ImpGen.compileProg

-- | Multicore-related command line options.
cliOptions :: [Option]
cliOptions :: [Option]
cliOptions =
  [ Option
      { optionLongName :: String
optionLongName = String
"num-threads",
        optionShortName :: Maybe Char
optionShortName = Maybe Char
forall a. Maybe a
Nothing,
        optionArgument :: OptionArgument
optionArgument = String -> OptionArgument
RequiredArgument String
"INT",
        optionAction :: Stm
optionAction = [C.cstm|futhark_context_config_set_num_threads(cfg, atoi(optarg));|],
        optionDescription :: String
optionDescription = String
"Set number of threads used for execution."
      }
  ]

-- | Operations for generating multicore code.
operations :: GC.Operations Multicore s
operations :: forall s. Operations Multicore s
operations =
  Operations Multicore s
forall op s. Operations op s
GC.defaultOperations
    { GC.opsCompiler = compileOp,
      GC.opsCritical =
        -- The thread entering an API function is always considered
        -- the "first worker" - note that this might differ from the
        -- thread that created the context!  This likely only matters
        -- for entry points, since they are the only API functions
        -- that contain parallel operations.
        ( [C.citems|worker_local = &ctx->scheduler.workers[0];|],
          []
        )
    }

closureFreeStructField :: VName -> Name
closureFreeStructField :: VName -> Name
closureFreeStructField VName
v =
  String -> Name
nameFromString String
"free_" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> String -> Name
nameFromString (VName -> String
forall a. Pretty a => a -> String
prettyString VName
v)

closureRetvalStructField :: VName -> Name
closureRetvalStructField :: VName -> Name
closureRetvalStructField VName
v =
  String -> Name
nameFromString String
"retval_" Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> String -> Name
nameFromString (VName -> String
forall a. Pretty a => a -> String
prettyString VName
v)

data ValueType = Prim PrimType | MemBlock | RawMem

compileFreeStructFields :: [VName] -> [(C.Type, ValueType)] -> [C.FieldGroup]
compileFreeStructFields :: [VName] -> [(Type, ValueType)] -> [FieldGroup]
compileFreeStructFields = (VName -> (Type, ValueType) -> FieldGroup)
-> [VName] -> [(Type, ValueType)] -> [FieldGroup]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith VName -> (Type, ValueType) -> FieldGroup
field
  where
    field :: VName -> (Type, ValueType) -> FieldGroup
field VName
name (Type
ty, Prim PrimType
_) =
      [C.csdecl|$ty:ty $id:(closureFreeStructField name);|]
    field VName
name (Type
_, ValueType
_) =
      [C.csdecl|$ty:defaultMemBlockType $id:(closureFreeStructField name);|]

compileRetvalStructFields :: [VName] -> [(C.Type, ValueType)] -> [C.FieldGroup]
compileRetvalStructFields :: [VName] -> [(Type, ValueType)] -> [FieldGroup]
compileRetvalStructFields = (VName -> (Type, ValueType) -> FieldGroup)
-> [VName] -> [(Type, ValueType)] -> [FieldGroup]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith VName -> (Type, ValueType) -> FieldGroup
field
  where
    field :: VName -> (Type, ValueType) -> FieldGroup
field VName
name (Type
ty, Prim PrimType
_) =
      [C.csdecl|$ty:ty *$id:(closureRetvalStructField name);|]
    field VName
name (Type
_, ValueType
_) =
      [C.csdecl|$ty:defaultMemBlockType $id:(closureRetvalStructField name);|]

compileSetStructValues ::
  (C.ToIdent a) =>
  a ->
  [VName] ->
  [(C.Type, ValueType)] ->
  [C.Stm]
compileSetStructValues :: forall a. ToIdent a => a -> [VName] -> [(Type, ValueType)] -> [Stm]
compileSetStructValues a
struct = (VName -> (Type, ValueType) -> Stm)
-> [VName] -> [(Type, ValueType)] -> [Stm]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith VName -> (Type, ValueType) -> Stm
forall {a}. VName -> (a, ValueType) -> Stm
field
  where
    field :: VName -> (a, ValueType) -> Stm
field VName
name (a
_, Prim PrimType
pt) =
      [C.cstm|$id:struct.$id:(closureFreeStructField name)=$exp:(toStorage pt (C.toExp name noLoc));|]
    field VName
name (a
_, ValueType
MemBlock) =
      [C.cstm|$id:struct.$id:(closureFreeStructField name)=$id:name.mem;|]
    field VName
name (a
_, ValueType
RawMem) =
      [C.cstm|$id:struct.$id:(closureFreeStructField name)=$id:name;|]

compileSetRetvalStructValues ::
  (C.ToIdent a) =>
  a ->
  [VName] ->
  [(C.Type, ValueType)] ->
  [C.Stm]
compileSetRetvalStructValues :: forall a. ToIdent a => a -> [VName] -> [(Type, ValueType)] -> [Stm]
compileSetRetvalStructValues a
struct [VName]
vnames [(Type, ValueType)]
we = [[Stm]] -> [Stm]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Stm]] -> [Stm]) -> [[Stm]] -> [Stm]
forall a b. (a -> b) -> a -> b
$ (VName -> (Type, ValueType) -> [Stm])
-> [VName] -> [(Type, ValueType)] -> [[Stm]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith VName -> (Type, ValueType) -> [Stm]
field [VName]
vnames [(Type, ValueType)]
we
  where
    field :: VName -> (Type, ValueType) -> [Stm]
field VName
name (Type
ct, Prim PrimType
_) =
      [C.cstms|$id:struct.$id:(closureRetvalStructField name)=(($ty:ct*)&$id:name);
               $escstm:("#if defined(ISPC)")
               $id:struct.$id:(closureRetvalStructField name)+= programIndex;
               $escstm:("#endif")|]
    field VName
name (Type
_, ValueType
MemBlock) =
      [C.cstms|$id:struct.$id:(closureRetvalStructField name)=$id:name.mem;|]
    field VName
name (Type
_, ValueType
RawMem) =
      [C.cstms|$id:struct.$id:(closureRetvalStructField name)=$id:name;|]

compileGetRetvalStructVals :: (C.ToIdent a) => a -> [VName] -> [(C.Type, ValueType)] -> [C.InitGroup]
compileGetRetvalStructVals :: forall a.
ToIdent a =>
a -> [VName] -> [(Type, ValueType)] -> [InitGroup]
compileGetRetvalStructVals a
struct = (VName -> (Type, ValueType) -> InitGroup)
-> [VName] -> [(Type, ValueType)] -> [InitGroup]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith VName -> (Type, ValueType) -> InitGroup
field
  where
    field :: VName -> (Type, ValueType) -> InitGroup
field VName
name (Type
ty, Prim PrimType
pt) =
      let inner :: Exp
inner = [C.cexp|*$id:struct->$id:(closureRetvalStructField name)|]
       in [C.cdecl|$ty:ty $id:name = $exp:(fromStorage pt inner);|]
    field VName
name (Type
ty, ValueType
_) =
      [C.cdecl|$ty:ty $id:name =
                 {.desc = $string:(prettyString name),
                 .mem = $id:struct->$id:(closureRetvalStructField name),
                 .size = 0, .references = NULL};|]

compileGetStructVals ::
  (C.ToIdent a) =>
  a ->
  [VName] ->
  [(C.Type, ValueType)] ->
  [C.InitGroup]
compileGetStructVals :: forall a.
ToIdent a =>
a -> [VName] -> [(Type, ValueType)] -> [InitGroup]
compileGetStructVals a
struct = (VName -> (Type, ValueType) -> InitGroup)
-> [VName] -> [(Type, ValueType)] -> [InitGroup]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith VName -> (Type, ValueType) -> InitGroup
field
  where
    field :: VName -> (Type, ValueType) -> InitGroup
field VName
name (Type
ty, Prim PrimType
pt) =
      let inner :: Exp
inner = [C.cexp|$id:struct->$id:(closureFreeStructField name)|]
       in [C.cdecl|$ty:ty $id:name = $exp:(fromStorage pt inner);|]
    field VName
name (Type
ty, ValueType
_) =
      [C.cdecl|$ty:ty $id:name =
                 {.desc = $string:(prettyString name),
                  .mem = $id:struct->$id:(closureFreeStructField name),
                  .size = 0, .references = NULL};|]

compileWriteBackResVals :: (C.ToIdent a) => a -> [VName] -> [(C.Type, ValueType)] -> [C.Stm]
compileWriteBackResVals :: forall a. ToIdent a => a -> [VName] -> [(Type, ValueType)] -> [Stm]
compileWriteBackResVals a
struct = (VName -> (Type, ValueType) -> Stm)
-> [VName] -> [(Type, ValueType)] -> [Stm]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith VName -> (Type, ValueType) -> Stm
forall {a}. VName -> (a, ValueType) -> Stm
field
  where
    field :: VName -> (a, ValueType) -> Stm
field VName
name (a
_, Prim PrimType
pt) =
      [C.cstm|*$id:struct->$id:(closureRetvalStructField name) = $exp:(toStorage pt (C.toExp name noLoc));|]
    field VName
name (a
_, ValueType
_) =
      [C.cstm|$id:struct->$id:(closureRetvalStructField name) = $id:name.mem;|]

paramToCType :: Param -> GC.CompilerM op s (C.Type, ValueType)
paramToCType :: forall op s. Param -> CompilerM op s (Type, ValueType)
paramToCType (ScalarParam VName
_ PrimType
pt) = do
  let t :: Type
t = PrimType -> Type
primStorageType PrimType
pt
  (Type, ValueType) -> CompilerM op s (Type, ValueType)
forall a. a -> CompilerM op s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type
t, PrimType -> ValueType
Prim PrimType
pt)
paramToCType (MemParam VName
name Space
space') = VName -> Space -> CompilerM op s (Type, ValueType)
forall op s. VName -> Space -> CompilerM op s (Type, ValueType)
mcMemToCType VName
name Space
space'

mcMemToCType :: VName -> Space -> GC.CompilerM op s (C.Type, ValueType)
mcMemToCType :: forall op s. VName -> Space -> CompilerM op s (Type, ValueType)
mcMemToCType VName
v Space
space = do
  refcount <- Space -> CompilerM op s Bool
forall op s. Space -> CompilerM op s Bool
GC.fatMemory Space
space
  cached <- isJust <$> GC.cacheMem v
  pure
    ( GC.fatMemType space,
      if refcount && not cached
        then MemBlock
        else RawMem
    )

benchmarkCode :: Name -> [C.BlockItem] -> GC.CompilerM op s [C.BlockItem]
benchmarkCode :: forall op s. Name -> [BlockItem] -> CompilerM op s [BlockItem]
benchmarkCode Name
name [BlockItem]
code = do
  event <- String -> CompilerM op s VName
forall (m :: * -> *). MonadFreshNames m => String -> m VName
newVName String
"event"
  provenance <- GC.provenanceExp
  pure
    [C.citems|
     struct mc_event* $id:event = mc_event_new(ctx);
     if ($id:event != NULL) {
       $id:event->bef = get_wall_time();
     }
     $items:code
     if ($id:event != NULL) {
       $id:event->aft = get_wall_time();
       lock_lock(&ctx->event_list_lock);
       add_event(ctx,
                 $string:(nameToString name),
                 $exp:provenance,
                 NULL,
                 $id:event,
                 (typename event_report_fn)mc_event_report);
       lock_unlock(&ctx->event_list_lock);
     }|]

functionTiming :: Name -> C.Id
functionTiming :: Name -> Id
functionTiming = (Name -> SrcLoc -> Id
forall a. ToIdent a => a -> SrcLoc -> Id
`C.toIdent` SrcLoc
forall a. Monoid a => a
mempty) (Name -> Id) -> (Name -> Name) -> Name -> Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"_total_time")

functionIterations :: Name -> C.Id
functionIterations :: Name -> Id
functionIterations = (Name -> SrcLoc -> Id
forall a. ToIdent a => a -> SrcLoc -> Id
`C.toIdent` SrcLoc
forall a. Monoid a => a
mempty) (Name -> Id) -> (Name -> Name) -> Name -> Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"_total_iter")

addTimingFields :: Name -> GC.CompilerM op s ()
addTimingFields :: forall op s. Name -> CompilerM op s ()
addTimingFields Name
name = do
  Id -> Type -> Maybe Exp -> CompilerM op s ()
forall op s. Id -> Type -> Maybe Exp -> CompilerM op s ()
GC.contextField (Name -> Id
functionTiming Name
name) [C.cty|typename int64_t|] (Maybe Exp -> CompilerM op s ()) -> Maybe Exp -> CompilerM op s ()
forall a b. (a -> b) -> a -> b
$ Exp -> Maybe Exp
forall a. a -> Maybe a
Just [C.cexp|0|]
  Id -> Type -> Maybe Exp -> CompilerM op s ()
forall op s. Id -> Type -> Maybe Exp -> CompilerM op s ()
GC.contextField (Name -> Id
functionIterations Name
name) [C.cty|typename int64_t|] (Maybe Exp -> CompilerM op s ()) -> Maybe Exp -> CompilerM op s ()
forall a b. (a -> b) -> a -> b
$ Exp -> Maybe Exp
forall a. a -> Maybe a
Just [C.cexp|0|]

multicoreName :: String -> GC.CompilerM op s Name
multicoreName :: forall op s. String -> CompilerM op s Name
multicoreName String
s = do
  s' <- String -> CompilerM op s VName
forall (m :: * -> *). MonadFreshNames m => String -> m VName
newVName (String
"futhark_mc_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
  pure $ nameFromString $ baseString s' ++ "_" ++ show (baseTag s')

type DefSpecifier s = String -> (Name -> GC.CompilerM Multicore s C.Definition) -> GC.CompilerM Multicore s Name

multicoreDef :: DefSpecifier s
multicoreDef :: forall s. DefSpecifier s
multicoreDef String
s Name -> CompilerM Multicore s Definition
f = do
  s' <- String -> CompilerM Multicore s Name
forall op s. String -> CompilerM op s Name
multicoreName String
s
  GC.libDecl =<< f s'
  pure s'

generateParLoopFn ::
  (C.ToIdent a) =>
  M.Map VName Space ->
  String ->
  MCCode ->
  a ->
  [(VName, (C.Type, ValueType))] ->
  [(VName, (C.Type, ValueType))] ->
  GC.CompilerM Multicore s Name
generateParLoopFn :: forall a s.
ToIdent a =>
Map VName Space
-> String
-> MCCode
-> a
-> [(VName, (Type, ValueType))]
-> [(VName, (Type, ValueType))]
-> CompilerM Multicore s Name
generateParLoopFn Map VName Space
lexical String
basename MCCode
code a
fstruct [(VName, (Type, ValueType))]
free [(VName, (Type, ValueType))]
retval = do
  let ([VName]
fargs, [(Type, ValueType)]
fctypes) = [(VName, (Type, ValueType))] -> ([VName], [(Type, ValueType)])
forall a b. [(a, b)] -> ([a], [b])
unzip [(VName, (Type, ValueType))]
free
  let ([VName]
retval_args, [(Type, ValueType)]
retval_ctypes) = [(VName, (Type, ValueType))] -> ([VName], [(Type, ValueType)])
forall a b. [(a, b)] -> ([a], [b])
unzip [(VName, (Type, ValueType))]
retval
  DefSpecifier s
forall s. DefSpecifier s
multicoreDef String
basename ((Name -> CompilerM Multicore s Definition)
 -> CompilerM Multicore s Name)
-> (Name -> CompilerM Multicore s Definition)
-> CompilerM Multicore s Name
forall a b. (a -> b) -> a -> b
$ \Name
s -> do
    fbody <- Name -> [BlockItem] -> CompilerM Multicore s [BlockItem]
forall op s. Name -> [BlockItem] -> CompilerM op s [BlockItem]
benchmarkCode Name
s ([BlockItem] -> CompilerM Multicore s [BlockItem])
-> (CompilerM Multicore s [BlockItem]
    -> CompilerM Multicore s [BlockItem])
-> CompilerM Multicore s [BlockItem]
-> CompilerM Multicore s [BlockItem]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< CompilerM Multicore s [BlockItem]
-> CompilerM Multicore s [BlockItem]
forall op s a. CompilerM op s a -> CompilerM op s a
GC.inNewFunction (CompilerM Multicore s [BlockItem]
 -> CompilerM Multicore s [BlockItem])
-> CompilerM Multicore s [BlockItem]
-> CompilerM Multicore s [BlockItem]
forall a b. (a -> b) -> a -> b
$
      Map VName Space
-> ([BlockItem] -> [Stm] -> CompilerM Multicore s [BlockItem])
-> CompilerM Multicore s [BlockItem]
forall op s a.
Map VName Space
-> ([BlockItem] -> [Stm] -> CompilerM op s a) -> CompilerM op s a
GC.cachingMemory Map VName Space
lexical (([BlockItem] -> [Stm] -> CompilerM Multicore s [BlockItem])
 -> CompilerM Multicore s [BlockItem])
-> ([BlockItem] -> [Stm] -> CompilerM Multicore s [BlockItem])
-> CompilerM Multicore s [BlockItem]
forall a b. (a -> b) -> a -> b
$ \[BlockItem]
decl_cached [Stm]
free_cached -> CompilerM Multicore s () -> CompilerM Multicore s [BlockItem]
forall op s. CompilerM op s () -> CompilerM op s [BlockItem]
GC.collect (CompilerM Multicore s () -> CompilerM Multicore s [BlockItem])
-> CompilerM Multicore s () -> CompilerM Multicore s [BlockItem]
forall a b. (a -> b) -> a -> b
$ do
        (BlockItem -> CompilerM Multicore s ())
-> [BlockItem] -> CompilerM Multicore s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ BlockItem -> CompilerM Multicore s ()
forall op s. BlockItem -> CompilerM op s ()
GC.item [C.citems|$decls:(compileGetStructVals fstruct fargs fctypes)|]
        (BlockItem -> CompilerM Multicore s ())
-> [BlockItem] -> CompilerM Multicore s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ BlockItem -> CompilerM Multicore s ()
forall op s. BlockItem -> CompilerM op s ()
GC.item [C.citems|$decls:(compileGetRetvalStructVals fstruct retval_args retval_ctypes)|]
        code' <- CompilerM Multicore s () -> CompilerM Multicore s [BlockItem]
forall op s. CompilerM op s () -> CompilerM op s [BlockItem]
GC.collect (CompilerM Multicore s () -> CompilerM Multicore s [BlockItem])
-> CompilerM Multicore s () -> CompilerM Multicore s [BlockItem]
forall a b. (a -> b) -> a -> b
$ MCCode -> CompilerM Multicore s ()
forall op s. Code op -> CompilerM op s ()
GC.compileCode MCCode
code
        mapM_ GC.item decl_cached
        mapM_ GC.item =<< GC.declAllocatedMem
        mapM_ GC.item code'
        free_mem <- GC.freeAllocatedMem
        GC.stm [C.cstm|cleanup: {$stms:free_cached $items:free_mem}|]
    pure
      [C.cedecl|int $id:s(void *args, typename int64_t iterations, int tid, struct scheduler_info info) {
                           int err = 0;
                           int subtask_id = tid;
                           struct $id:fstruct *$id:fstruct = (struct $id:fstruct*) args;
                           struct futhark_context *ctx = $id:fstruct->ctx;
                           $items:fbody
                           if (err == 0) {
                             $stms:(compileWriteBackResVals fstruct retval_args retval_ctypes)
                           }
                           return err;
                      }|]

prepareTaskStruct ::
  DefSpecifier s ->
  String ->
  [VName] ->
  [(C.Type, ValueType)] ->
  [VName] ->
  [(C.Type, ValueType)] ->
  GC.CompilerM Multicore s Name
prepareTaskStruct :: forall s.
DefSpecifier s
-> String
-> [VName]
-> [(Type, ValueType)]
-> [VName]
-> [(Type, ValueType)]
-> CompilerM Multicore s Name
prepareTaskStruct DefSpecifier s
def String
name [VName]
free_args [(Type, ValueType)]
free_ctypes [VName]
retval_args [(Type, ValueType)]
retval_ctypes = do
  let makeStruct :: a -> f Definition
makeStruct a
s =
        Definition -> f Definition
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          [C.cedecl|struct $id:s {
                       struct futhark_context *ctx;
                       $sdecls:(compileFreeStructFields free_args free_ctypes)
                       $sdecls:(compileRetvalStructFields retval_args retval_ctypes)
                     };|]
  fstruct <- DefSpecifier s
def String
name Name -> CompilerM Multicore s Definition
forall {f :: * -> *} {a}.
(Applicative f, ToIdent a) =>
a -> f Definition
makeStruct
  let fstruct' = Name
fstruct Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"_"
  GC.decl [C.cdecl|struct $id:fstruct $id:fstruct';|]
  GC.stm [C.cstm|$id:fstruct'.ctx = ctx;|]
  GC.stms [C.cstms|$stms:(compileSetStructValues fstruct' free_args free_ctypes)|]
  GC.stms [C.cstms|$stms:(compileSetRetvalStructValues fstruct' retval_args retval_ctypes)|]
  pure fstruct

-- Generate a segop function for top_level and potentially nested SegOp code
compileOp :: GC.OpCompiler Multicore s
compileOp :: forall s. OpCompiler Multicore s
compileOp (GetLoopBounds VName
start VName
end) = do
  Stm -> CompilerM Multicore s ()
forall op s. Stm -> CompilerM op s ()
GC.stm [C.cstm|$id:start = start;|]
  Stm -> CompilerM Multicore s ()
forall op s. Stm -> CompilerM op s ()
GC.stm [C.cstm|$id:end = end;|]
compileOp (GetTaskId VName
v) =
  Stm -> CompilerM Multicore s ()
forall op s. Stm -> CompilerM op s ()
GC.stm [C.cstm|$id:v = subtask_id;|]
compileOp (GetNumTasks VName
v) =
  Stm -> CompilerM Multicore s ()
forall op s. Stm -> CompilerM op s ()
GC.stm [C.cstm|$id:v = info.nsubtasks;|]
compileOp (SegOp String
name [Param]
params ParallelTask
seq_task Maybe ParallelTask
par_task [Param]
retvals (SchedulerInfo Exp
e Scheduling
sched)) = do
  let (ParallelTask MCCode
seq_code) = ParallelTask
seq_task
  free_ctypes <- (Param -> CompilerM Multicore s (Type, ValueType))
-> [Param] -> CompilerM Multicore s [(Type, ValueType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Param -> CompilerM Multicore s (Type, ValueType)
forall op s. Param -> CompilerM op s (Type, ValueType)
paramToCType [Param]
params
  retval_ctypes <- mapM paramToCType retvals
  let free_args = (Param -> VName) -> [Param] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map Param -> VName
paramName [Param]
params
      retval_args = (Param -> VName) -> [Param] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map Param -> VName
paramName [Param]
retvals
      free = [VName] -> [(Type, ValueType)] -> [(VName, (Type, ValueType))]
forall a b. [a] -> [b] -> [(a, b)]
zip [VName]
free_args [(Type, ValueType)]
free_ctypes
      retval = [VName] -> [(Type, ValueType)] -> [(VName, (Type, ValueType))]
forall a b. [a] -> [b] -> [(a, b)]
zip [VName]
retval_args [(Type, ValueType)]
retval_ctypes

  e' <- GC.compileExp e

  let lexical = KernelHandling -> Function Multicore -> Map VName Space
lexicalMemoryUsageMC KernelHandling
TraverseKernels (Function Multicore -> Map VName Space)
-> Function Multicore -> Map VName Space
forall a b. (a -> b) -> a -> b
$ Maybe EntryPoint
-> [Param] -> [Param] -> MCCode -> Function Multicore
forall a.
Maybe EntryPoint -> [Param] -> [Param] -> Code a -> FunctionT a
Function Maybe EntryPoint
forall a. Maybe a
Nothing [] [Param]
params MCCode
seq_code

  fstruct <-
    prepareTaskStruct multicoreDef "task" free_args free_ctypes retval_args retval_ctypes

  fpar_task <- generateParLoopFn lexical (name ++ "_task") seq_code fstruct free retval
  addTimingFields fpar_task

  let ftask_name = Name
fstruct Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"_task"
  GC.decl [C.cdecl|struct scheduler_segop $id:ftask_name;|]
  GC.stm [C.cstm|$id:ftask_name.args = &$id:(fstruct <> "_");|]
  GC.stm [C.cstm|$id:ftask_name.top_level_fn = $id:fpar_task;|]
  GC.stm [C.cstm|$id:ftask_name.name = $string:(nameToString fpar_task);|]
  GC.stm [C.cstm|$id:ftask_name.iterations = $exp:e';|]
  -- Create the timing fields for the task
  GC.stm [C.cstm|$id:ftask_name.task_time = &ctx->program->$id:(functionTiming fpar_task);|]
  GC.stm [C.cstm|$id:ftask_name.task_iter = &ctx->program->$id:(functionIterations fpar_task);|]

  case sched of
    Scheduling
Dynamic -> Stm -> CompilerM Multicore s ()
forall op s. Stm -> CompilerM op s ()
GC.stm [C.cstm|$id:ftask_name.sched = DYNAMIC;|]
    Scheduling
Static -> Stm -> CompilerM Multicore s ()
forall op s. Stm -> CompilerM op s ()
GC.stm [C.cstm|$id:ftask_name.sched = STATIC;|]

  -- Generate the nested segop function if available
  case par_task of
    Just (ParallelTask MCCode
nested_code) -> do
      let lexical_nested :: Map VName Space
lexical_nested = KernelHandling -> Function Multicore -> Map VName Space
lexicalMemoryUsageMC KernelHandling
TraverseKernels (Function Multicore -> Map VName Space)
-> Function Multicore -> Map VName Space
forall a b. (a -> b) -> a -> b
$ Maybe EntryPoint
-> [Param] -> [Param] -> MCCode -> Function Multicore
forall a.
Maybe EntryPoint -> [Param] -> [Param] -> Code a -> FunctionT a
Function Maybe EntryPoint
forall a. Maybe a
Nothing [] [Param]
params MCCode
nested_code
      fnpar_task <- Map VName Space
-> String
-> MCCode
-> Name
-> [(VName, (Type, ValueType))]
-> [(VName, (Type, ValueType))]
-> CompilerM Multicore s Name
forall a s.
ToIdent a =>
Map VName Space
-> String
-> MCCode
-> a
-> [(VName, (Type, ValueType))]
-> [(VName, (Type, ValueType))]
-> CompilerM Multicore s Name
generateParLoopFn Map VName Space
lexical_nested (String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_nested_task") MCCode
nested_code Name
fstruct [(VName, (Type, ValueType))]
free [(VName, (Type, ValueType))]
retval
      GC.stm [C.cstm|$id:ftask_name.nested_fn = $id:fnpar_task;|]
    Maybe ParallelTask
Nothing ->
      Stm -> CompilerM Multicore s ()
forall op s. Stm -> CompilerM op s ()
GC.stm [C.cstm|$id:ftask_name.nested_fn=NULL;|]

  let ftask_err = Name
fpar_task Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"_err"
      code =
        [C.citems|int $id:ftask_err = scheduler_prepare_task(&ctx->scheduler, &$id:ftask_name);
                  if ($id:ftask_err != 0) {
                    err = $id:ftask_err;
                    goto cleanup;
                  }|]

  mapM_ GC.item code
compileOp (ParLoop String
s' MCCode
body [Param]
free) = do
  free_ctypes <- (Param -> CompilerM Multicore s (Type, ValueType))
-> [Param] -> CompilerM Multicore s [(Type, ValueType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Param -> CompilerM Multicore s (Type, ValueType)
forall op s. Param -> CompilerM op s (Type, ValueType)
paramToCType [Param]
free
  let free_args = (Param -> VName) -> [Param] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map Param -> VName
paramName [Param]
free

  let lexical = KernelHandling -> Function Multicore -> Map VName Space
lexicalMemoryUsageMC KernelHandling
TraverseKernels (Function Multicore -> Map VName Space)
-> Function Multicore -> Map VName Space
forall a b. (a -> b) -> a -> b
$ Maybe EntryPoint
-> [Param] -> [Param] -> MCCode -> Function Multicore
forall a.
Maybe EntryPoint -> [Param] -> [Param] -> Code a -> FunctionT a
Function Maybe EntryPoint
forall a. Maybe a
Nothing [] [Param]
free MCCode
body

  fstruct <-
    prepareTaskStruct multicoreDef (s' ++ "_parloop_struct") free_args free_ctypes mempty mempty

  ftask <- multicoreDef (s' ++ "_parloop") $ \Name
s -> do
    fbody <- Name -> [BlockItem] -> CompilerM Multicore s [BlockItem]
forall op s. Name -> [BlockItem] -> CompilerM op s [BlockItem]
benchmarkCode Name
s ([BlockItem] -> CompilerM Multicore s [BlockItem])
-> (CompilerM Multicore s [BlockItem]
    -> CompilerM Multicore s [BlockItem])
-> CompilerM Multicore s [BlockItem]
-> CompilerM Multicore s [BlockItem]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< CompilerM Multicore s [BlockItem]
-> CompilerM Multicore s [BlockItem]
forall op s a. CompilerM op s a -> CompilerM op s a
GC.inNewFunction (CompilerM Multicore s [BlockItem]
 -> CompilerM Multicore s [BlockItem])
-> CompilerM Multicore s [BlockItem]
-> CompilerM Multicore s [BlockItem]
forall a b. (a -> b) -> a -> b
$
      Map VName Space
-> ([BlockItem] -> [Stm] -> CompilerM Multicore s [BlockItem])
-> CompilerM Multicore s [BlockItem]
forall op s a.
Map VName Space
-> ([BlockItem] -> [Stm] -> CompilerM op s a) -> CompilerM op s a
GC.cachingMemory Map VName Space
lexical (([BlockItem] -> [Stm] -> CompilerM Multicore s [BlockItem])
 -> CompilerM Multicore s [BlockItem])
-> ([BlockItem] -> [Stm] -> CompilerM Multicore s [BlockItem])
-> CompilerM Multicore s [BlockItem]
forall a b. (a -> b) -> a -> b
$ \[BlockItem]
decl_cached [Stm]
free_cached -> CompilerM Multicore s () -> CompilerM Multicore s [BlockItem]
forall op s. CompilerM op s () -> CompilerM op s [BlockItem]
GC.collect (CompilerM Multicore s () -> CompilerM Multicore s [BlockItem])
-> CompilerM Multicore s () -> CompilerM Multicore s [BlockItem]
forall a b. (a -> b) -> a -> b
$ do
        [BlockItem] -> CompilerM Multicore s ()
forall op s. [BlockItem] -> CompilerM op s ()
GC.items [C.citems|$decls:(compileGetStructVals fstruct free_args free_ctypes)|]

        InitGroup -> CompilerM Multicore s ()
forall op s. InitGroup -> CompilerM op s ()
GC.decl [C.cdecl|typename int64_t iterations = end-start;|]

        body' <- CompilerM Multicore s () -> CompilerM Multicore s [BlockItem]
forall op s. CompilerM op s () -> CompilerM op s [BlockItem]
GC.collect (CompilerM Multicore s () -> CompilerM Multicore s [BlockItem])
-> CompilerM Multicore s () -> CompilerM Multicore s [BlockItem]
forall a b. (a -> b) -> a -> b
$ MCCode -> CompilerM Multicore s ()
forall op s. Code op -> CompilerM op s ()
GC.compileCode MCCode
body

        mapM_ GC.item decl_cached
        mapM_ GC.item =<< GC.declAllocatedMem
        free_mem <- GC.freeAllocatedMem
        mapM_ GC.item body'
        GC.stm [C.cstm|cleanup: {$stms:free_cached $items:free_mem}|]
    pure
      [C.cedecl|static int $id:s(void *args,
                                 typename int64_t start,
                                 typename int64_t end,
                                 int subtask_id,
                                 int tid) {
                       (void)subtask_id;
                       (void)tid;
                       int err = 0;
                       struct $id:fstruct *$id:fstruct = (struct $id:fstruct*) args;
                       struct futhark_context *ctx = $id:fstruct->ctx;
                       $items:fbody
                       return err;
                }|]

  let ftask_name = Name
ftask Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"_task"
  GC.decl [C.cdecl|struct scheduler_parloop $id:ftask_name;|]
  GC.stm [C.cstm|$id:ftask_name.name = $string:(nameToString ftask);|]
  GC.stm [C.cstm|$id:ftask_name.fn = $id:ftask;|]
  GC.stm [C.cstm|$id:ftask_name.args = &$id:(fstruct <> "_");|]
  GC.stm [C.cstm|$id:ftask_name.iterations = iterations;|]
  GC.stm [C.cstm|$id:ftask_name.info = info;|]

  let ftask_err = Name
ftask Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"_err"
      ftask_total = Name
ftask Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"_total"
  code' <-
    benchmarkCode
      ftask_total
      [C.citems|int $id:ftask_err = scheduler_execute_task(&ctx->scheduler,
                                                           &$id:ftask_name);
               if ($id:ftask_err != 0) {
                 err = $id:ftask_err;
                 goto cleanup;
               }|]

  mapM_ GC.item code'
compileOp (Atomic AtomicOp
aop) =
  AtomicOp
-> (Type -> VName -> CompilerM Multicore s Type)
-> CompilerM Multicore s ()
forall op s.
AtomicOp
-> (Type -> VName -> CompilerM op s Type) -> CompilerM op s ()
atomicOps AtomicOp
aop (\Type
ty VName
_ -> Type -> CompilerM Multicore s Type
forall a. a -> CompilerM Multicore s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [C.cty|$ty:ty*|])
compileOp (ISPCKernel MCCode
body [Param]
_) =
  MCCode -> CompilerM Multicore s ()
forall s. MCCode -> CompilerM Multicore s ()
scopedBlock MCCode
body
compileOp (ForEach VName
i Exp
from Exp
bound MCCode
body) = do
  let i' :: SrcLoc -> Id
i' = VName -> SrcLoc -> Id
forall a. ToIdent a => a -> SrcLoc -> Id
C.toIdent VName
i
      t :: Type
t = PrimType -> Type
primTypeToCType (PrimType -> Type) -> PrimType -> Type
forall a b. (a -> b) -> a -> b
$ Exp -> PrimType
forall v. PrimExp v -> PrimType
primExpType Exp
bound
  from' <- Exp -> CompilerM Multicore s Exp
forall op s. Exp -> CompilerM op s Exp
GC.compileExp Exp
from
  bound' <- GC.compileExp bound
  body' <- GC.collect $ GC.compileCode body
  GC.stm
    [C.cstm|for ($ty:t $id:i' = $exp:from'; $id:i' < $exp:bound'; $id:i'++) {
            $items:body'
          }|]
compileOp (ForEachActive VName
i MCCode
body) = do
  InitGroup -> CompilerM Multicore s ()
forall op s. InitGroup -> CompilerM op s ()
GC.decl [C.cdecl|typename int64_t $id:i = 0;|]
  MCCode -> CompilerM Multicore s ()
forall s. MCCode -> CompilerM Multicore s ()
scopedBlock MCCode
body
compileOp (ExtractLane VName
dest Exp
tar Exp
_) = do
  tar' <- Exp -> CompilerM Multicore s Exp
forall op s. Exp -> CompilerM op s Exp
GC.compileExp Exp
tar
  GC.stm [C.cstm|$id:dest = $exp:tar';|]

scopedBlock :: MCCode -> GC.CompilerM Multicore s ()
scopedBlock :: forall s. MCCode -> CompilerM Multicore s ()
scopedBlock MCCode
code = do
  inner <- CompilerM Multicore s () -> CompilerM Multicore s [BlockItem]
forall op s. CompilerM op s () -> CompilerM op s [BlockItem]
GC.collect (CompilerM Multicore s () -> CompilerM Multicore s [BlockItem])
-> CompilerM Multicore s () -> CompilerM Multicore s [BlockItem]
forall a b. (a -> b) -> a -> b
$ MCCode -> CompilerM Multicore s ()
forall op s. Code op -> CompilerM op s ()
GC.compileCode MCCode
code
  GC.stm [C.cstm|{$items:inner}|]

doAtomic ::
  (C.ToIdent a1) =>
  a1 ->
  VName ->
  Count u (TExp Int32) ->
  Exp ->
  String ->
  C.Type ->
  (C.Type -> VName -> GC.CompilerM op s C.Type) ->
  GC.CompilerM op s ()
doAtomic :: forall {k} a1 (u :: k) op s.
ToIdent a1 =>
a1
-> VName
-> Count u (TExp Int32)
-> Exp
-> String
-> Type
-> (Type -> VName -> CompilerM op s Type)
-> CompilerM op s ()
doAtomic a1
old VName
arr Count u (TExp Int32)
ind Exp
val String
op Type
ty Type -> VName -> CompilerM op s Type
castf = do
  ind' <- Exp -> CompilerM op s Exp
forall op s. Exp -> CompilerM op s Exp
GC.compileExp (Exp -> CompilerM op s Exp) -> Exp -> CompilerM op s Exp
forall a b. (a -> b) -> a -> b
$ TExp Int32 -> Exp
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped (TExp Int32 -> Exp) -> TExp Int32 -> Exp
forall a b. (a -> b) -> a -> b
$ Count u (TExp Int32) -> TExp Int32
forall {k} (u :: k) e. Count u e -> e
unCount Count u (TExp Int32)
ind
  val' <- GC.compileExp val
  cast <- castf ty arr
  arr' <- GC.rawMem arr
  GC.stm [C.cstm|$id:old = $id:op(&(($ty:cast)$exp:arr')[$exp:ind'], ($ty:ty) $exp:val', __ATOMIC_RELAXED);|]

atomicOps :: AtomicOp -> (C.Type -> VName -> GC.CompilerM op s C.Type) -> GC.CompilerM op s ()
atomicOps :: forall op s.
AtomicOp
-> (Type -> VName -> CompilerM op s Type) -> CompilerM op s ()
atomicOps (AtomicCmpXchg PrimType
t VName
old VName
arr Count Elements (TExp Int32)
ind VName
res Exp
val) Type -> VName -> CompilerM op s Type
castf = do
  ind' <- Exp -> CompilerM op s Exp
forall op s. Exp -> CompilerM op s Exp
GC.compileExp (Exp -> CompilerM op s Exp) -> Exp -> CompilerM op s Exp
forall a b. (a -> b) -> a -> b
$ TExp Int32 -> Exp
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped (TExp Int32 -> Exp) -> TExp Int32 -> Exp
forall a b. (a -> b) -> a -> b
$ Count Elements (TExp Int32) -> TExp Int32
forall {k} (u :: k) e. Count u e -> e
unCount Count Elements (TExp Int32)
ind
  new_val' <- GC.compileExp val
  cast <- castf [C.cty|$ty:(GC.primTypeToCType t)|] arr
  arr' <- GC.rawMem arr
  GC.stm
    [C.cstm|$id:res = $id:op(&(($ty:cast)$exp:arr')[$exp:ind'],
                 &$id:old,
                 $exp:new_val',
                 0, __ATOMIC_SEQ_CST, __ATOMIC_RELAXED);|]
  where
    op :: String
    op :: String
op = String
"__atomic_compare_exchange_n"
atomicOps (AtomicXchg PrimType
t VName
old VName
arr Count Elements (TExp Int32)
ind Exp
val) Type -> VName -> CompilerM op s Type
castf = do
  ind' <- Exp -> CompilerM op s Exp
forall op s. Exp -> CompilerM op s Exp
GC.compileExp (Exp -> CompilerM op s Exp) -> Exp -> CompilerM op s Exp
forall a b. (a -> b) -> a -> b
$ TExp Int32 -> Exp
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped (TExp Int32 -> Exp) -> TExp Int32 -> Exp
forall a b. (a -> b) -> a -> b
$ Count Elements (TExp Int32) -> TExp Int32
forall {k} (u :: k) e. Count u e -> e
unCount Count Elements (TExp Int32)
ind
  val' <- GC.compileExp val
  cast <- castf [C.cty|$ty:(GC.primTypeToCType t)|] arr
  GC.stm [C.cstm|$id:old = $id:op(&(($ty:cast)$id:arr.mem)[$exp:ind'], $exp:val', __ATOMIC_SEQ_CST);|]
  where
    op :: String
    op :: String
op = String
"__atomic_exchange_n"
atomicOps (AtomicAdd IntType
t VName
old VName
arr Count Elements (TExp Int32)
ind Exp
val) Type -> VName -> CompilerM op s Type
castf =
  VName
-> VName
-> Count Elements (TExp Int32)
-> Exp
-> String
-> Type
-> (Type -> VName -> CompilerM op s Type)
-> CompilerM op s ()
forall {k} a1 (u :: k) op s.
ToIdent a1 =>
a1
-> VName
-> Count u (TExp Int32)
-> Exp
-> String
-> Type
-> (Type -> VName -> CompilerM op s Type)
-> CompilerM op s ()
doAtomic VName
old VName
arr Count Elements (TExp Int32)
ind Exp
val String
"__atomic_fetch_add" [C.cty|$ty:(GC.intTypeToCType t)|] Type -> VName -> CompilerM op s Type
castf
atomicOps (AtomicSub IntType
t VName
old VName
arr Count Elements (TExp Int32)
ind Exp
val) Type -> VName -> CompilerM op s Type
castf =
  VName
-> VName
-> Count Elements (TExp Int32)
-> Exp
-> String
-> Type
-> (Type -> VName -> CompilerM op s Type)
-> CompilerM op s ()
forall {k} a1 (u :: k) op s.
ToIdent a1 =>
a1
-> VName
-> Count u (TExp Int32)
-> Exp
-> String
-> Type
-> (Type -> VName -> CompilerM op s Type)
-> CompilerM op s ()
doAtomic VName
old VName
arr Count Elements (TExp Int32)
ind Exp
val String
"__atomic_fetch_sub" [C.cty|$ty:(GC.intTypeToCType t)|] Type -> VName -> CompilerM op s Type
castf
atomicOps (AtomicAnd IntType
t VName
old VName
arr Count Elements (TExp Int32)
ind Exp
val) Type -> VName -> CompilerM op s Type
castf =
  VName
-> VName
-> Count Elements (TExp Int32)
-> Exp
-> String
-> Type
-> (Type -> VName -> CompilerM op s Type)
-> CompilerM op s ()
forall {k} a1 (u :: k) op s.
ToIdent a1 =>
a1
-> VName
-> Count u (TExp Int32)
-> Exp
-> String
-> Type
-> (Type -> VName -> CompilerM op s Type)
-> CompilerM op s ()
doAtomic VName
old VName
arr Count Elements (TExp Int32)
ind Exp
val String
"__atomic_fetch_and" [C.cty|$ty:(GC.intTypeToCType t)|] Type -> VName -> CompilerM op s Type
castf
atomicOps (AtomicOr IntType
t VName
old VName
arr Count Elements (TExp Int32)
ind Exp
val) Type -> VName -> CompilerM op s Type
castf =
  VName
-> VName
-> Count Elements (TExp Int32)
-> Exp
-> String
-> Type
-> (Type -> VName -> CompilerM op s Type)
-> CompilerM op s ()
forall {k} a1 (u :: k) op s.
ToIdent a1 =>
a1
-> VName
-> Count u (TExp Int32)
-> Exp
-> String
-> Type
-> (Type -> VName -> CompilerM op s Type)
-> CompilerM op s ()
doAtomic VName
old VName
arr Count Elements (TExp Int32)
ind Exp
val String
"__atomic_fetch_or" [C.cty|$ty:(GC.intTypeToCType t)|] Type -> VName -> CompilerM op s Type
castf
atomicOps (AtomicXor IntType
t VName
old VName
arr Count Elements (TExp Int32)
ind Exp
val) Type -> VName -> CompilerM op s Type
castf =
  VName
-> VName
-> Count Elements (TExp Int32)
-> Exp
-> String
-> Type
-> (Type -> VName -> CompilerM op s Type)
-> CompilerM op s ()
forall {k} a1 (u :: k) op s.
ToIdent a1 =>
a1
-> VName
-> Count u (TExp Int32)
-> Exp
-> String
-> Type
-> (Type -> VName -> CompilerM op s Type)
-> CompilerM op s ()
doAtomic VName
old VName
arr Count Elements (TExp Int32)
ind Exp
val String
"__atomic_fetch_xor" [C.cty|$ty:(GC.intTypeToCType t)|] Type -> VName -> CompilerM op s Type
castf