{-# LANGUAGE TypeFamilies #-}

-- | Code generation for ImpCode with multicore operations.
module Futhark.CodeGen.ImpGen.Multicore
  ( Futhark.CodeGen.ImpGen.Multicore.compileProg,
    Warnings,
  )
where

import Control.Monad
import Data.Map qualified as M
import Futhark.CodeGen.ImpCode.Multicore qualified as Imp
import Futhark.CodeGen.ImpGen
import Futhark.CodeGen.ImpGen.Multicore.Base
import Futhark.CodeGen.ImpGen.Multicore.SegHist
import Futhark.CodeGen.ImpGen.Multicore.SegMap
import Futhark.CodeGen.ImpGen.Multicore.SegRed
import Futhark.CodeGen.ImpGen.Multicore.SegScan
import Futhark.IR.MCMem
import Futhark.MonadFreshNames
import Futhark.Util.IntegralExp (rem)
import Prelude hiding (quot, rem)

opCompiler :: OpCompiler MCMem HostEnv Imp.Multicore
opCompiler :: OpCompiler MCMem HostEnv Multicore
opCompiler Pat (LetDec MCMem)
dest (Alloc SubExp
e Space
space) = Pat (LetDec MCMem)
-> SubExp -> Space -> ImpM MCMem HostEnv Multicore ()
forall rep (inner :: * -> *) r op.
Mem rep inner =>
Pat (LetDec rep) -> SubExp -> Space -> ImpM rep r op ()
compileAlloc Pat (LetDec MCMem)
dest SubExp
e Space
space
opCompiler Pat (LetDec MCMem)
dest (Inner MCOp NoOp MCMem
op) = Pat LParamMem -> MCOp NoOp MCMem -> ImpM MCMem HostEnv Multicore ()
compileMCOp Pat (LetDec MCMem)
Pat LParamMem
dest MCOp NoOp MCMem
op

parallelCopy :: CopyCompiler MCMem HostEnv Imp.Multicore
parallelCopy :: CopyCompiler MCMem HostEnv Multicore
parallelCopy PrimType
pt MemLoc
destloc MemLoc
srcloc = do
  seq_code <- ImpM MCMem HostEnv Multicore ()
-> ImpM MCMem HostEnv Multicore (Code Multicore)
forall rep r op. ImpM rep r op () -> ImpM rep r op (Code op)
collect (ImpM MCMem HostEnv Multicore ()
 -> ImpM MCMem HostEnv Multicore (Code Multicore))
-> ImpM MCMem HostEnv Multicore ()
-> ImpM MCMem HostEnv Multicore (Code Multicore)
forall a b. (a -> b) -> a -> b
$ Operations MCMem HostEnv Multicore
-> ImpM MCMem HostEnv Multicore ()
-> ImpM MCMem HostEnv Multicore ()
forall rep r op a.
Operations rep r op -> ImpM rep r op a -> ImpM rep r op a
localOps Operations MCMem HostEnv Multicore
inThreadOps (ImpM MCMem HostEnv Multicore ()
 -> ImpM MCMem HostEnv Multicore ())
-> ImpM MCMem HostEnv Multicore ()
-> ImpM MCMem HostEnv Multicore ()
forall a b. (a -> b) -> a -> b
$ do
    body <- ImpM MCMem HostEnv Multicore (Code Multicore)
genCopy
    free_params <- freeParams body
    emit $ Imp.Op $ Imp.ParLoop "copy" body free_params
  free_params <- freeParams seq_code
  s <- prettyString <$> newVName "copy"
  iterations <- dPrimVE "iterations" $ product $ map pe64 srcshape
  let scheduling = Exp -> Scheduling -> SchedulerInfo
Imp.SchedulerInfo (TExp Int64 -> Exp
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TExp Int64
iterations) Scheduling
Imp.Static
  emit . Imp.Op $
    Imp.SegOp s free_params (Imp.ParallelTask seq_code) Nothing [] scheduling
  where
    MemLoc VName
destmem [SubExp]
_ LMAD (TExp Int64)
_ = MemLoc
destloc
    MemLoc VName
srcmem [SubExp]
srcshape LMAD (TExp Int64)
_ = MemLoc
srcloc
    genCopy :: ImpM MCMem HostEnv Multicore (Code Multicore)
genCopy = ImpM MCMem HostEnv Multicore ()
-> ImpM MCMem HostEnv Multicore (Code Multicore)
forall rep r op. ImpM rep r op () -> ImpM rep r op (Code op)
collect (ImpM MCMem HostEnv Multicore ()
 -> ImpM MCMem HostEnv Multicore (Code Multicore))
-> ((TExp Int64 -> ImpM MCMem HostEnv Multicore ())
    -> ImpM MCMem HostEnv Multicore ())
-> (TExp Int64 -> ImpM MCMem HostEnv Multicore ())
-> ImpM MCMem HostEnv Multicore (Code Multicore)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImpM MCMem HostEnv Multicore () -> ImpM MCMem HostEnv Multicore ()
inISPC (ImpM MCMem HostEnv Multicore ()
 -> ImpM MCMem HostEnv Multicore ())
-> ((TExp Int64 -> ImpM MCMem HostEnv Multicore ())
    -> ImpM MCMem HostEnv Multicore ())
-> (TExp Int64 -> ImpM MCMem HostEnv Multicore ())
-> ImpM MCMem HostEnv Multicore ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char]
-> ChunkLoopVectorization
-> (TExp Int64 -> ImpM MCMem HostEnv Multicore ())
-> ImpM MCMem HostEnv Multicore ()
generateChunkLoop [Char]
"copy" ChunkLoopVectorization
Vectorized ((TExp Int64 -> ImpM MCMem HostEnv Multicore ())
 -> ImpM MCMem HostEnv Multicore (Code Multicore))
-> (TExp Int64 -> ImpM MCMem HostEnv Multicore ())
-> ImpM MCMem HostEnv Multicore (Code Multicore)
forall a b. (a -> b) -> a -> b
$ \TExp Int64
i -> do
      is <- [Char]
-> [TExp Int64]
-> TExp Int64
-> ImpM MCMem HostEnv Multicore [TExp Int64]
forall rep r op.
[Char] -> [TExp Int64] -> TExp Int64 -> ImpM rep r op [TExp Int64]
dIndexSpace' [Char]
"i" ((SubExp -> TExp Int64) -> [SubExp] -> [TExp Int64]
forall a b. (a -> b) -> [a] -> [b]
map SubExp -> TExp Int64
pe64 [SubExp]
srcshape) TExp Int64
i
      (_, destspace, destidx) <- fullyIndexArray' destloc is
      (_, srcspace, srcidx) <- fullyIndexArray' srcloc is
      tmp <- dPrimS "tmp" pt
      emit $ Imp.Read tmp srcmem srcidx pt srcspace Imp.Nonvolatile
      emit $ Imp.Write destmem destidx pt destspace Imp.Nonvolatile $ Imp.var tmp pt

topLevelOps, inThreadOps :: Operations MCMem HostEnv Imp.Multicore
inThreadOps :: Operations MCMem HostEnv Multicore
inThreadOps =
  (OpCompiler MCMem HostEnv Multicore
-> Operations MCMem HostEnv Multicore
forall rep (inner :: * -> *) op r.
(Mem rep inner, FreeIn op) =>
OpCompiler rep r op -> Operations rep r op
defaultOperations OpCompiler MCMem HostEnv Multicore
opCompiler)
    { opsExpCompiler = compileMCExp
    }
topLevelOps :: Operations MCMem HostEnv Multicore
topLevelOps =
  (OpCompiler MCMem HostEnv Multicore
-> Operations MCMem HostEnv Multicore
forall rep (inner :: * -> *) op r.
(Mem rep inner, FreeIn op) =>
OpCompiler rep r op -> Operations rep r op
defaultOperations OpCompiler MCMem HostEnv Multicore
opCompiler)
    { opsExpCompiler = compileMCExp,
      opsCopyCompiler = parallelCopy
    }

updateAcc :: Safety -> VName -> [SubExp] -> [SubExp] -> MulticoreGen ()
updateAcc :: Safety
-> VName -> [SubExp] -> [SubExp] -> ImpM MCMem HostEnv Multicore ()
updateAcc Safety
safety VName
acc [SubExp]
is [SubExp]
vs = Text
-> ImpM MCMem HostEnv Multicore ()
-> ImpM MCMem HostEnv Multicore ()
forall rep r op. Text -> ImpM rep r op () -> ImpM rep r op ()
sComment Text
"UpdateAcc" (ImpM MCMem HostEnv Multicore ()
 -> ImpM MCMem HostEnv Multicore ())
-> ImpM MCMem HostEnv Multicore ()
-> ImpM MCMem HostEnv Multicore ()
forall a b. (a -> b) -> a -> b
$ do
  -- See the ImpGen implementation of UpdateAcc for general notes.
  let is' :: [TExp Int64]
is' = (SubExp -> TExp Int64) -> [SubExp] -> [TExp Int64]
forall a b. (a -> b) -> [a] -> [b]
map SubExp -> TExp Int64
pe64 [SubExp]
is
  (c, _space, arrs, dims, op) <- VName
-> [TExp Int64]
-> ImpM
     MCMem
     HostEnv
     Multicore
     (VName, Space, [VName], [TExp Int64], Maybe (Lambda MCMem))
forall rep (inner :: * -> *) r op.
Mem rep inner =>
VName
-> [TExp Int64]
-> ImpM
     rep r op (VName, Space, [VName], [TExp Int64], Maybe (Lambda rep))
lookupAcc VName
acc [TExp Int64]
is'
  let boundsCheck =
        case Safety
safety of
          Safety
Safe -> TExp Bool
-> ImpM MCMem HostEnv Multicore ()
-> ImpM MCMem HostEnv Multicore ()
forall rep r op. TExp Bool -> ImpM rep r op () -> ImpM rep r op ()
sWhen (Slice (TExp Int64) -> [TExp Int64] -> TExp Bool
inBounds ([DimIndex (TExp Int64)] -> Slice (TExp Int64)
forall d. [DimIndex d] -> Slice d
Slice ((TExp Int64 -> DimIndex (TExp Int64))
-> [TExp Int64] -> [DimIndex (TExp Int64)]
forall a b. (a -> b) -> [a] -> [b]
map TExp Int64 -> DimIndex (TExp Int64)
forall d. d -> DimIndex d
DimFix [TExp Int64]
is')) [TExp Int64]
dims)
          Safety
_ -> ImpM MCMem HostEnv Multicore () -> ImpM MCMem HostEnv Multicore ()
forall a. a -> a
id
  boundsCheck $
    case op of
      Maybe (Lambda MCMem)
Nothing ->
        [(VName, SubExp)]
-> ((VName, SubExp) -> ImpM MCMem HostEnv Multicore ())
-> ImpM MCMem HostEnv Multicore ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([VName] -> [SubExp] -> [(VName, SubExp)]
forall a b. [a] -> [b] -> [(a, b)]
zip [VName]
arrs [SubExp]
vs) (((VName, SubExp) -> ImpM MCMem HostEnv Multicore ())
 -> ImpM MCMem HostEnv Multicore ())
-> ((VName, SubExp) -> ImpM MCMem HostEnv Multicore ())
-> ImpM MCMem HostEnv Multicore ()
forall a b. (a -> b) -> a -> b
$ \(VName
arr, SubExp
v) -> VName
-> [TExp Int64]
-> SubExp
-> [TExp Int64]
-> ImpM MCMem HostEnv Multicore ()
forall rep r op.
VName -> [TExp Int64] -> SubExp -> [TExp Int64] -> ImpM rep r op ()
copyDWIMFix VName
arr [TExp Int64]
is' SubExp
v []
      Just Lambda MCMem
lam -> do
        [LParam MCMem] -> ImpM MCMem HostEnv Multicore ()
forall rep (inner :: * -> *) r op.
Mem rep inner =>
[LParam rep] -> ImpM rep r op ()
dLParams ([LParam MCMem] -> ImpM MCMem HostEnv Multicore ())
-> [LParam MCMem] -> ImpM MCMem HostEnv Multicore ()
forall a b. (a -> b) -> a -> b
$ Lambda MCMem -> [LParam MCMem]
forall rep. Lambda rep -> [LParam rep]
lambdaParams Lambda MCMem
lam
        let ([VName]
_x_params, [VName]
y_params) =
              Int -> [VName] -> ([VName], [VName])
forall a. Int -> [a] -> ([a], [a])
splitAt ([SubExp] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SubExp]
vs) ([VName] -> ([VName], [VName])) -> [VName] -> ([VName], [VName])
forall a b. (a -> b) -> a -> b
$ (Param LParamMem -> VName) -> [Param LParamMem] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map Param LParamMem -> VName
forall dec. Param dec -> VName
paramName ([Param LParamMem] -> [VName]) -> [Param LParamMem] -> [VName]
forall a b. (a -> b) -> a -> b
$ Lambda MCMem -> [LParam MCMem]
forall rep. Lambda rep -> [LParam rep]
lambdaParams Lambda MCMem
lam
        [(VName, SubExp)]
-> ((VName, SubExp) -> ImpM MCMem HostEnv Multicore ())
-> ImpM MCMem HostEnv Multicore ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([VName] -> [SubExp] -> [(VName, SubExp)]
forall a b. [a] -> [b] -> [(a, b)]
zip [VName]
y_params [SubExp]
vs) (((VName, SubExp) -> ImpM MCMem HostEnv Multicore ())
 -> ImpM MCMem HostEnv Multicore ())
-> ((VName, SubExp) -> ImpM MCMem HostEnv Multicore ())
-> ImpM MCMem HostEnv Multicore ()
forall a b. (a -> b) -> a -> b
$ \(VName
yp, SubExp
v) -> VName
-> [DimIndex (TExp Int64)]
-> SubExp
-> [DimIndex (TExp Int64)]
-> ImpM MCMem HostEnv Multicore ()
forall rep r op.
VName
-> [DimIndex (TExp Int64)]
-> SubExp
-> [DimIndex (TExp Int64)]
-> ImpM rep r op ()
copyDWIM VName
yp [] SubExp
v []
        atomics <- HostEnv -> AtomicBinOp
hostAtomics (HostEnv -> AtomicBinOp)
-> ImpM MCMem HostEnv Multicore HostEnv
-> ImpM MCMem HostEnv Multicore AtomicBinOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM MCMem HostEnv Multicore HostEnv
forall rep r op. ImpM rep r op r
askEnv
        case atomicUpdateLocking atomics lam of
          AtomicPrim DoAtomicUpdate MCMem ()
f -> DoAtomicUpdate MCMem ()
f [VName]
arrs [TExp Int64]
is'
          AtomicCAS DoAtomicUpdate MCMem ()
f -> DoAtomicUpdate MCMem ()
f [VName]
arrs [TExp Int64]
is'
          AtomicLocking Locking -> DoAtomicUpdate MCMem ()
f -> do
            c_locks <- VName -> Map VName Locks -> Maybe Locks
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
c (Map VName Locks -> Maybe Locks)
-> (HostEnv -> Map VName Locks) -> HostEnv -> Maybe Locks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostEnv -> Map VName Locks
hostLocks (HostEnv -> Maybe Locks)
-> ImpM MCMem HostEnv Multicore HostEnv
-> ImpM MCMem HostEnv Multicore (Maybe Locks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM MCMem HostEnv Multicore HostEnv
forall rep r op. ImpM rep r op r
askEnv
            case c_locks of
              Just (Locks VName
locks Int
num_locks) -> do
                let locking :: Locking
locking =
                      VName
-> TExp Int32
-> TExp Int32
-> TExp Int32
-> ([TExp Int64] -> [TExp Int64])
-> Locking
Locking VName
locks TExp Int32
0 TExp Int32
1 TExp Int32
0 (([TExp Int64] -> [TExp Int64]) -> Locking)
-> ([TExp Int64] -> [TExp Int64]) -> Locking
forall a b. (a -> b) -> a -> b
$
                        TExp Int64 -> [TExp Int64]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TExp Int64 -> [TExp Int64])
-> ([TExp Int64] -> TExp Int64) -> [TExp Int64] -> [TExp Int64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TExp Int64 -> TExp Int64 -> TExp Int64
forall e. IntegralExp e => e -> e -> e
`rem` Int -> TExp Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
num_locks) (TExp Int64 -> TExp Int64)
-> ([TExp Int64] -> TExp Int64) -> [TExp Int64] -> TExp Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TExp Int64] -> [TExp Int64] -> TExp Int64
forall num. IntegralExp num => [num] -> [num] -> num
flattenIndex [TExp Int64]
dims
                Locking -> DoAtomicUpdate MCMem ()
f Locking
locking [VName]
arrs [TExp Int64]
is'
              Maybe Locks
Nothing ->
                [Char] -> ImpM MCMem HostEnv Multicore ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> ImpM MCMem HostEnv Multicore ())
-> [Char] -> ImpM MCMem HostEnv Multicore ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Missing locks for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ VName -> [Char]
forall a. Pretty a => a -> [Char]
prettyString VName
acc

withAcc ::
  Pat LetDecMem ->
  [(Shape, [VName], Maybe (Lambda MCMem, [SubExp]))] ->
  Lambda MCMem ->
  MulticoreGen ()
withAcc :: Pat LParamMem
-> [(Shape, [VName], Maybe (Lambda MCMem, [SubExp]))]
-> Lambda MCMem
-> ImpM MCMem HostEnv Multicore ()
withAcc Pat LParamMem
pat [(Shape, [VName], Maybe (Lambda MCMem, [SubExp]))]
inputs Lambda MCMem
lam = do
  atomics <- HostEnv -> AtomicBinOp
hostAtomics (HostEnv -> AtomicBinOp)
-> ImpM MCMem HostEnv Multicore HostEnv
-> ImpM MCMem HostEnv Multicore AtomicBinOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM MCMem HostEnv Multicore HostEnv
forall rep r op. ImpM rep r op r
askEnv
  locksForInputs atomics $ zip accs inputs
  where
    accs :: [VName]
accs = (Param LParamMem -> VName) -> [Param LParamMem] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map Param LParamMem -> VName
forall dec. Param dec -> VName
paramName ([Param LParamMem] -> [VName]) -> [Param LParamMem] -> [VName]
forall a b. (a -> b) -> a -> b
$ Lambda MCMem -> [LParam MCMem]
forall rep. Lambda rep -> [LParam rep]
lambdaParams Lambda MCMem
lam
    locksForInputs :: AtomicBinOp
-> [(VName, (Shape, [VName], Maybe (Lambda MCMem, [SubExp])))]
-> ImpM MCMem HostEnv Multicore ()
locksForInputs AtomicBinOp
_ [] =
      ExpCompiler MCMem HostEnv Multicore
forall rep (inner :: * -> *) r op.
Mem rep inner =>
Pat (LetDec rep) -> Exp rep -> ImpM rep r op ()
defCompileExp Pat (LetDec MCMem)
Pat LParamMem
pat (Exp MCMem -> ImpM MCMem HostEnv Multicore ())
-> Exp MCMem -> ImpM MCMem HostEnv Multicore ()
forall a b. (a -> b) -> a -> b
$ [(Shape, [VName], Maybe (Lambda MCMem, [SubExp]))]
-> Lambda MCMem -> Exp MCMem
forall rep. [WithAccInput rep] -> Lambda rep -> Exp rep
WithAcc [(Shape, [VName], Maybe (Lambda MCMem, [SubExp]))]
inputs Lambda MCMem
lam
    locksForInputs AtomicBinOp
atomics ((VName
c, (Shape
_, [VName]
_, Maybe (Lambda MCMem, [SubExp])
op)) : [(VName, (Shape, [VName], Maybe (Lambda MCMem, [SubExp])))]
inputs')
      | Just (Lambda MCMem
op_lam, [SubExp]
_) <- Maybe (Lambda MCMem, [SubExp])
op,
        AtomicLocking Locking -> DoAtomicUpdate MCMem ()
_ <- AtomicBinOp -> Lambda MCMem -> AtomicUpdate MCMem ()
atomicUpdateLocking AtomicBinOp
atomics Lambda MCMem
op_lam = do
          let num_locks :: Int
num_locks = Int
100151
          locks_arr <-
            [Char]
-> PrimType -> ArrayContents -> ImpM MCMem HostEnv Multicore VName
forall rep r op.
[Char] -> PrimType -> ArrayContents -> ImpM rep r op VName
sStaticArray [Char]
"withacc_locks" PrimType
int32 (ArrayContents -> ImpM MCMem HostEnv Multicore VName)
-> ArrayContents -> ImpM MCMem HostEnv Multicore VName
forall a b. (a -> b) -> a -> b
$ Int -> ArrayContents
Imp.ArrayZeros Int
num_locks
          let locks = VName -> Int -> Locks
Locks VName
locks_arr Int
num_locks
              extend HostEnv
env = HostEnv
env {hostLocks = M.insert c locks $ hostLocks env}
          localEnv extend $ locksForInputs atomics inputs'
      | Bool
otherwise =
          AtomicBinOp
-> [(VName, (Shape, [VName], Maybe (Lambda MCMem, [SubExp])))]
-> ImpM MCMem HostEnv Multicore ()
locksForInputs AtomicBinOp
atomics [(VName, (Shape, [VName], Maybe (Lambda MCMem, [SubExp])))]
inputs'

compileMCExp :: ExpCompiler MCMem HostEnv Imp.Multicore
compileMCExp :: ExpCompiler MCMem HostEnv Multicore
compileMCExp Pat (LetDec MCMem)
_ (BasicOp (UpdateAcc Safety
safety VName
acc [SubExp]
is [SubExp]
vs)) =
  Safety
-> VName -> [SubExp] -> [SubExp] -> ImpM MCMem HostEnv Multicore ()
updateAcc Safety
safety VName
acc [SubExp]
is [SubExp]
vs
compileMCExp Pat (LetDec MCMem)
pat (WithAcc [(Shape, [VName], Maybe (Lambda MCMem, [SubExp]))]
inputs Lambda MCMem
lam) =
  Pat LParamMem
-> [(Shape, [VName], Maybe (Lambda MCMem, [SubExp]))]
-> Lambda MCMem
-> ImpM MCMem HostEnv Multicore ()
withAcc Pat (LetDec MCMem)
Pat LParamMem
pat [(Shape, [VName], Maybe (Lambda MCMem, [SubExp]))]
inputs Lambda MCMem
lam
compileMCExp Pat (LetDec MCMem)
dest Exp MCMem
e =
  ExpCompiler MCMem HostEnv Multicore
forall rep (inner :: * -> *) r op.
Mem rep inner =>
Pat (LetDec rep) -> Exp rep -> ImpM rep r op ()
defCompileExp Pat (LetDec MCMem)
dest Exp MCMem
e

compileMCOp ::
  Pat LetDecMem ->
  MCOp NoOp MCMem ->
  ImpM MCMem HostEnv Imp.Multicore ()
compileMCOp :: Pat LParamMem -> MCOp NoOp MCMem -> ImpM MCMem HostEnv Multicore ()
compileMCOp Pat LParamMem
_ (OtherOp NoOp MCMem
NoOp) = () -> ImpM MCMem HostEnv Multicore ()
forall a. a -> ImpM MCMem HostEnv Multicore a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
compileMCOp Pat LParamMem
pat (ParOp Maybe (SegOp () MCMem)
par_op SegOp () MCMem
op) = do
  let space :: SegSpace
space = SegOp () MCMem -> SegSpace
getSpace SegOp () MCMem
op
  VName -> TExp Int64 -> ImpM MCMem HostEnv Multicore ()
forall {k} (t :: k) rep r op. VName -> TExp t -> ImpM rep r op ()
dPrimV_ (SegSpace -> VName
segFlat SegSpace
space) (TExp Int64
0 :: Imp.TExp Int64)
  iterations <- SegOp () MCMem
-> SegSpace -> ImpM MCMem HostEnv Multicore (TExp Int64)
getIterationDomain SegOp () MCMem
op SegSpace
space
  seq_code <- collect $ localOps inThreadOps $ do
    nsubtasks <- dPrim "nsubtasks"
    sOp $ Imp.GetNumTasks $ tvVar nsubtasks
    emit =<< compileSegOp pat op nsubtasks
  retvals <- getReturnParams pat op

  let scheduling_info = Exp -> Scheduling -> SchedulerInfo
Imp.SchedulerInfo (TExp Int64 -> Exp
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TExp Int64
iterations)

  par_task <- case par_op of
    Just SegOp () MCMem
nested_op -> do
      let space' :: SegSpace
space' = SegOp () MCMem -> SegSpace
getSpace SegOp () MCMem
nested_op
      VName -> TExp Int64 -> ImpM MCMem HostEnv Multicore ()
forall {k} (t :: k) rep r op. VName -> TExp t -> ImpM rep r op ()
dPrimV_ (SegSpace -> VName
segFlat SegSpace
space') (TExp Int64
0 :: Imp.TExp Int64)
      par_code <- ImpM MCMem HostEnv Multicore ()
-> ImpM MCMem HostEnv Multicore (Code Multicore)
forall rep r op. ImpM rep r op () -> ImpM rep r op (Code op)
collect (ImpM MCMem HostEnv Multicore ()
 -> ImpM MCMem HostEnv Multicore (Code Multicore))
-> ImpM MCMem HostEnv Multicore ()
-> ImpM MCMem HostEnv Multicore (Code Multicore)
forall a b. (a -> b) -> a -> b
$ do
        nsubtasks <- [Char] -> ImpM MCMem HostEnv Multicore (TV Int32)
forall {k} (t :: k) rep r op.
MkTV t =>
[Char] -> ImpM rep r op (TV t)
dPrim [Char]
"nsubtasks"
        sOp $ Imp.GetNumTasks $ tvVar nsubtasks
        emit =<< compileSegOp pat nested_op nsubtasks
      pure $ Just $ Imp.ParallelTask par_code
    Maybe (SegOp () MCMem)
Nothing -> Maybe ParallelTask
-> ImpM MCMem HostEnv Multicore (Maybe ParallelTask)
forall a. a -> ImpM MCMem HostEnv Multicore a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ParallelTask
forall a. Maybe a
Nothing

  s <- segOpString op
  let seq_task = Code Multicore -> ParallelTask
Imp.ParallelTask Code Multicore
seq_code
  free_params <- filter (`notElem` retvals) <$> freeParams (par_task, seq_task)
  let code =
        Multicore -> Code Multicore
forall a. a -> Code a
Imp.Op (Multicore -> Code Multicore) -> Multicore -> Code Multicore
forall a b. (a -> b) -> a -> b
$
          [Char]
-> [Param]
-> ParallelTask
-> Maybe ParallelTask
-> [Param]
-> SchedulerInfo
-> Multicore
Imp.SegOp [Char]
s [Param]
free_params ParallelTask
seq_task Maybe ParallelTask
par_task [Param]
retvals (SchedulerInfo -> Multicore) -> SchedulerInfo -> Multicore
forall a b. (a -> b) -> a -> b
$
            Scheduling -> SchedulerInfo
scheduling_info (SegOp () MCMem -> Code Multicore -> Scheduling
forall rep. SegOp () rep -> Code Multicore -> Scheduling
decideScheduling' SegOp () MCMem
op Code Multicore
seq_code)
  emit $ Imp.Meta $ Imp.MetaProvenance $ taskProvenance code
  emit code

compileSegOp ::
  Pat LetDecMem ->
  SegOp () MCMem ->
  TV Int32 ->
  ImpM MCMem HostEnv Imp.Multicore Imp.MCCode
compileSegOp :: Pat LParamMem
-> SegOp () MCMem
-> TV Int32
-> ImpM MCMem HostEnv Multicore (Code Multicore)
compileSegOp Pat LParamMem
pat (SegHist ()
_ SegSpace
space [Type]
_ KernelBody MCMem
kbody [HistOp MCMem]
histops) TV Int32
ntasks =
  Pat LParamMem
-> SegSpace
-> [HistOp MCMem]
-> KernelBody MCMem
-> TV Int32
-> ImpM MCMem HostEnv Multicore (Code Multicore)
compileSegHist Pat LParamMem
pat SegSpace
space [HistOp MCMem]
histops KernelBody MCMem
kbody TV Int32
ntasks
compileSegOp Pat LParamMem
pat (SegScan ()
_ SegSpace
space [Type]
_ KernelBody MCMem
kbody [SegBinOp MCMem]
scans) TV Int32
ntasks =
  Pat LParamMem
-> SegSpace
-> [SegBinOp MCMem]
-> KernelBody MCMem
-> TV Int32
-> ImpM MCMem HostEnv Multicore (Code Multicore)
compileSegScan Pat LParamMem
pat SegSpace
space [SegBinOp MCMem]
scans KernelBody MCMem
kbody TV Int32
ntasks
compileSegOp Pat LParamMem
pat (SegRed ()
_ SegSpace
space [Type]
_ KernelBody MCMem
kbody [SegBinOp MCMem]
reds) TV Int32
ntasks =
  Pat LParamMem
-> SegSpace
-> [SegBinOp MCMem]
-> KernelBody MCMem
-> TV Int32
-> ImpM MCMem HostEnv Multicore (Code Multicore)
compileSegRed Pat LParamMem
pat SegSpace
space [SegBinOp MCMem]
reds KernelBody MCMem
kbody TV Int32
ntasks
compileSegOp Pat LParamMem
pat (SegMap ()
_ SegSpace
space [Type]
_ KernelBody MCMem
kbody) TV Int32
_ =
  Pat LParamMem
-> SegSpace
-> KernelBody MCMem
-> ImpM MCMem HostEnv Multicore (Code Multicore)
compileSegMap Pat LParamMem
pat SegSpace
space KernelBody MCMem
kbody

-- GCC supported primitve atomic Operations
-- TODO: Add support for 1, 2, and 16 bytes too
gccAtomics :: AtomicBinOp
gccAtomics :: AtomicBinOp
gccAtomics = (BinOp
 -> [(BinOp,
      VName -> VName -> Count Elements (TExp Int32) -> Exp -> AtomicOp)]
 -> Maybe
      (VName -> VName -> Count Elements (TExp Int32) -> Exp -> AtomicOp))
-> [(BinOp,
     VName -> VName -> Count Elements (TExp Int32) -> Exp -> AtomicOp)]
-> AtomicBinOp
forall a b c. (a -> b -> c) -> b -> a -> c
flip BinOp
-> [(BinOp,
     VName -> VName -> Count Elements (TExp Int32) -> Exp -> AtomicOp)]
-> Maybe
     (VName -> VName -> Count Elements (TExp Int32) -> Exp -> AtomicOp)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(BinOp,
  VName -> VName -> Count Elements (TExp Int32) -> Exp -> AtomicOp)]
cpu
  where
    cpu :: [(BinOp,
  VName -> VName -> Count Elements (TExp Int32) -> Exp -> AtomicOp)]
cpu =
      [ (IntType -> Overflow -> BinOp
Add IntType
Int32 Overflow
OverflowUndef, IntType
-> VName -> VName -> Count Elements (TExp Int32) -> Exp -> AtomicOp
Imp.AtomicAdd IntType
Int32),
        (IntType -> Overflow -> BinOp
Sub IntType
Int32 Overflow
OverflowUndef, IntType
-> VName -> VName -> Count Elements (TExp Int32) -> Exp -> AtomicOp
Imp.AtomicSub IntType
Int32),
        (IntType -> BinOp
And IntType
Int32, IntType
-> VName -> VName -> Count Elements (TExp Int32) -> Exp -> AtomicOp
Imp.AtomicAnd IntType
Int32),
        (IntType -> BinOp
Xor IntType
Int32, IntType
-> VName -> VName -> Count Elements (TExp Int32) -> Exp -> AtomicOp
Imp.AtomicXor IntType
Int32),
        (IntType -> BinOp
Or IntType
Int32, IntType
-> VName -> VName -> Count Elements (TExp Int32) -> Exp -> AtomicOp
Imp.AtomicOr IntType
Int32),
        (IntType -> Overflow -> BinOp
Add IntType
Int64 Overflow
OverflowUndef, IntType
-> VName -> VName -> Count Elements (TExp Int32) -> Exp -> AtomicOp
Imp.AtomicAdd IntType
Int64),
        (IntType -> Overflow -> BinOp
Sub IntType
Int64 Overflow
OverflowUndef, IntType
-> VName -> VName -> Count Elements (TExp Int32) -> Exp -> AtomicOp
Imp.AtomicSub IntType
Int64),
        (IntType -> BinOp
And IntType
Int64, IntType
-> VName -> VName -> Count Elements (TExp Int32) -> Exp -> AtomicOp
Imp.AtomicAnd IntType
Int64),
        (IntType -> BinOp
Xor IntType
Int64, IntType
-> VName -> VName -> Count Elements (TExp Int32) -> Exp -> AtomicOp
Imp.AtomicXor IntType
Int64),
        (IntType -> BinOp
Or IntType
Int64, IntType
-> VName -> VName -> Count Elements (TExp Int32) -> Exp -> AtomicOp
Imp.AtomicOr IntType
Int64)
      ]

-- | Compile the program.
compileProg ::
  (MonadFreshNames m) =>
  Prog MCMem ->
  m (Warnings, Imp.Definitions Imp.Multicore)
compileProg :: forall (m :: * -> *).
MonadFreshNames m =>
Prog MCMem -> m (Warnings, Definitions Multicore)
compileProg =
  HostEnv
-> Operations MCMem HostEnv Multicore
-> Space
-> Prog MCMem
-> m (Warnings, Definitions Multicore)
forall rep (inner :: * -> *) op (m :: * -> *) r.
(Mem rep inner, FreeIn op, MonadFreshNames m) =>
r
-> Operations rep r op
-> Space
-> Prog rep
-> m (Warnings, Definitions op)
Futhark.CodeGen.ImpGen.compileProg
    (AtomicBinOp -> Map VName Locks -> HostEnv
HostEnv AtomicBinOp
gccAtomics Map VName Locks
forall a. Monoid a => a
mempty)
    Operations MCMem HostEnv Multicore
topLevelOps
    Space
Imp.DefaultSpace