packages feed

meta-par-accelerate (empty) → 0.3

raw patch · 5 files changed

+364/−0 lines, 5 filesdep +QuickCheckdep +abstract-dequedep +abstract-parsetup-changed

Dependencies added: QuickCheck, abstract-deque, abstract-par, abstract-par-accelerate, abstract-par-offchip, accelerate, accelerate-cuda, accelerate-io, array, base, meta-par, transformers, vector

Files

+ Control/Monad/Par/Meta/AccSMP.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, ConstraintKinds, FlexibleContexts, MultiParamTypeClasses #-}+{-# LANGUAGE ConstraintKinds, TypeFamilies #-}+{-# OPTIONS_GHC -Wall #-}++-- | A meta-par /scheduler/ for programming with shared memory+--   multicore CPUs plus GPU parallelism.+-- +-- This provides a full implementation of the+-- 'Control.Monad.Par.Par'-monad programming abstraction+-- (specifically, the 'Control.Monad.Par.ParIVar' class).+--+module Control.Monad.Par.Meta.AccSMP + (+    -- | A `Par` monad supporting only SMP and GPU resources.+    Par, ++    -- | The IVar type for use with the `Par` newtype in this module.+    Meta.IVar,++    -- | Running `Par` computations on CPU and GPU.+    runPar, ++    -- | Same as `runPar` but don't hide the IO.+    runParIO,+ +    -- * Par-monad operations, including GPU operations    +    ParAccelerate(..), unsafeHybridVector, unsafeHybridIArray,+--    module AC,     +--    module OC, +    module PC    + ) where++-- import Data.Array.Accelerate (Acc,Arrays)+-- import Data.Array.Accelerate.CUDA (Async)+import Data.Monoid+import Control.Monad.Par.Class as PC+import Control.Monad.Par.Accelerate as AC+-- import qualified Control.Monad.Par.OffChip    as OC+import qualified Control.Monad.Par.Meta as Meta +import qualified Control.Monad.Par.Meta.Resources.Accelerate as Rsrc+import qualified Control.Monad.Par.Meta.Resources.SMP as SMP+import GHC.Conc (numCapabilities)++--------------------------------------------------------------------------------++tries :: Int+tries = numCapabilities++newtype Par a = AccSMPPar (Meta.Par a)+ deriving (Monad, Functor, +           PC.ParFuture     Meta.IVar,+           PC.ParIVar       Meta.IVar,+           AC.ParAccelerate Meta.IVar +          ) -- NOT MonadIO  ++resource :: Meta.Resource+resource = SMP.mkResource tries `mappend` Rsrc.mkResource++-- <boilerplate>+{-+instance OC.ParOffChip Acc Meta.IVar Par where +  type OffChipConstraint a = Arrays a +  runOffChip   r x = AccSMPPar$ Rsrc.runAcc   r x+  spawnOffChip r x = AccSMPPar$ Rsrc.spawnAcc r x+  unsafeHybrid r cvt (AccSMPPar p,a) = AccSMPPar$ Rsrc.unsafeHybrid r cvt (p,a)  +-}++-- run1Async :: (Arrays a, Arrays b) => (Acc a -> Acc b) -> a -> Async b+++{-+instance OC.ParOffChip Async Meta.IVar Par where +  type OffChipConstraint a = Arrays a +  runOffChip   r x = AccSMPPar$ Rsrc.runAcc   r x+  spawnOffChip r x = AccSMPPar$ Rsrc.spawnAcc r x+  unsafeHybrid r cvt (AccSMPPar p,a) = AccSMPPar$ Rsrc.unsafeHybrid r cvt (p,a)  +-}++runPar   :: Par a -> a+runPar (AccSMPPar p) = Meta.runMetaPar resource p++runParIO :: Par a -> IO a+runParIO (AccSMPPar p) = Meta.runMetaParIO resource p
+ Control/Monad/Par/Meta/Resources/Accelerate.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}++{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_HADDOCK ignore-exports, prune #-}++-- | Do not use his module directly.  Use a /SCHEDULER/ module (such+--   as 'Control.Monad.Par.Meta.AccSMP').+-- +-- This provides a component (Resource) for assembling schedulers, as well as +-- exporting a `Control.Monad.Par.Accelerate.ParAccelerate` instance.++module Control.Monad.Par.Meta.Resources.Accelerate +  (+      mkResource,+      runAccWith, spawnAccWith, unsafeHybridWith+  ) where++import Control.Concurrent+import Control.Exception.Base (evaluate)+import Control.Monad+import Control.Monad.IO.Class++import Data.Array.Accelerate (Acc, Arrays)+-- #ifdef ACCELERATE_CUDA_BACKEND+-- #warning "Loading REAL, LIVE CUDA BACKEND..."+-- import qualified Data.Array.Accelerate.CUDA as Acc+-- #else+import qualified Data.Array.Accelerate.Interpreter as Run+-- #endif++import Data.Concurrent.Deque.Class (ConcQueue, WSDeque)+import Data.Concurrent.Deque.Reference as R++import System.IO.Unsafe++import Text.Printf++import qualified Control.Monad.Par.Accelerate as AC+-- import qualified Control.Monad.Par.OffChip    as OC+import Control.Monad.Par.Meta +-- import Control.Monad.Par.Class (new,put_)++dbg :: Bool+#ifdef DEBUG+dbg = True+#else+dbg = False+#endif+++--------------------------------------------------------------------------------+-- * The `Resource` itself:++-- | A mix-in component for assembling schedulers with an Accelerate capability.+mkResource :: Resource+mkResource = Resource defaultInit defaultSteal+++-- * /Internal/ Definitions+--------------------------------------------------------------------------------+-- Global structures for communicating between Par threads and GPU+-- daemon threads++{-# NOINLINE gpuOnlyQueue #-}+-- | GPU-only queue is pushed to by 'Par' workers on the right, and+-- popped by the GPU daemon on the left. No backstealing is possible+-- from this queue.+gpuOnlyQueue :: WSDeque (IO ())+gpuOnlyQueue = unsafePerformIO R.newQ++{-# NOINLINE gpuBackstealQueue #-}+-- | GPU-only queue is pushed to by 'Par' workers on the right, and+-- popped by the GPU daemon and 'Par' workers on the left.+gpuBackstealQueue :: ConcQueue (Par (), IO ())+gpuBackstealQueue = unsafePerformIO R.newQ++{-# NOINLINE resultQueue #-}+-- | Result queue is pushed to by the GPU daemon, and popped by the+-- 'Par' workers, meaning the 'WSDeque' is appropriate.+resultQueue :: WSDeque (Par ())+resultQueue = unsafePerformIO R.newQ++--------------------------------------------------------------------------------++-- See documentation for `Control.Monad.Par.Accelerate.spawnAcc`+spawnAccWith :: (Arrays a) => (Acc a -> a) -> Acc a -> Par (IVar a)+spawnAccWith runner comp = do +    when dbg $ liftIO $ printf "spawning Accelerate computation\n"+    iv <- new+    let wrappedComp = do+          when dbg $ printf$ "running Accelerate computation:\n"++show comp++"\n"+          ans <- evaluate $ runner comp+          R.pushL resultQueue $ do+            when dbg $ liftIO $ printf "Accelerate computation finished\n"+            put_ iv ans+    liftIO $ R.pushR gpuOnlyQueue wrappedComp+    return iv               ++ -- | Run an Accelerate computation and wait for its result.  In the+ -- context of a `Par` computation this can result in better+ -- performance than using an Accelerate-provided `run` function+ -- directly, because this version enables the CPU work scheduler to do+ -- other work while waiting for the GPU computation to complete.+ -- + -- Moreover, when configured with a high-performance /CPU/ Accelerate backend+ -- in the future this routine can enable automatic CPU/GPU work partitioning.+ -- + -- The more generic version of this function is "Control.Monad.Par.OffChip.runOffChip".+runAccWith  :: (Arrays a) => (Acc a -> a) -> Acc a -> Par a+runAccWith runner comp = spawnAccWith runner comp  >>= get++-- | See documentation for `Control.Monad.Par.Accelerate.unsafeHybrid`+unsafeHybridWith :: Arrays b => (Acc b -> b) -> (b -> a) -> (Par a, Acc b) -> Par (IVar a)+unsafeHybridWith runner convert (parComp, accComp) = do +    when dbg $ liftIO $ printf "spawning Accelerate computation\n"+    iv <- new+    let wrappedParComp :: Par ()+        wrappedParComp = do+          when dbg $ liftIO $ printf "running backstolen computation\n"+          put_ iv =<< parComp+        wrappedAccComp :: IO ()+        wrappedAccComp = do+          when dbg $ printf "running Accelerate computation\n"+--          ans <- convert $ Acc.run accComp+          let ans = convert $ runner accComp+          R.pushL resultQueue $ do+            when dbg $ liftIO $ printf "Accelerate computation finished\n"+            put_ iv ans+    liftIO $ R.pushR gpuBackstealQueue (wrappedParComp, wrappedAccComp)+    return iv+++--------------------------------------------------------------------------------++-- | Loop for the GPU daemon; repeatedly takes work off the 'gpuQueue'+-- and runs it.+gpuDaemon :: IO ()+gpuDaemon = do+  mwork <- R.tryPopL gpuOnlyQueue+  case mwork of+    Just work -> work+    Nothing -> do+      mwork2 <- R.tryPopL gpuBackstealQueue+      case mwork2 of+        Just (_, work) -> work +        Nothing -> return ()+  gpuDaemon+++defaultInit :: Startup+defaultInit = St ia+  where ia _ _ = do+          void $ forkIO gpuDaemon++defaultSteal :: WorkSearch+defaultSteal = WS sa +  where sa _ _ = do+          mfinished <- R.tryPopR resultQueue+          case mfinished of+            finished@(Just _) -> return finished+            Nothing -> fmap fst `fmap` R.tryPopL gpuBackstealQueue++--------------------------------------------------------------------------------++-- Generic instance for Meta.Par, needs to be newtype-derived for specific schedulers.+instance AC.ParAccelerate IVar Par where +  getDefaultAccImpl = return Run.run -- TEMP! FIXME - returning interpreter for now.  +  runAccWith        = runAccWith+  spawnAccWith      = spawnAccWith+  unsafeHybridWith  = unsafeHybridWith++--  compileAcc   = error "Accelerate resource -- compileAcc not implemented yet"++-- instance OC.ParOffChip Acc IVar Par where+--   type OffChipConstraint a = Arrays a+--   runOffChip = runAcc+--   spawnOffChip = spawnAcc+--   unsafeHybrid = unsafeHybrid
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Simon Marlow 2011++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Simon Marlow nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ meta-par-accelerate.cabal view
@@ -0,0 +1,67 @@+Name:                meta-par-accelerate+Version:             0.3+Synopsis:            Support for integrated Accelerate computations within Meta-par.++-- Version history:+-- +-- 0.3: Initial release.++Description:        +  This package provides a 'Control.Monad.Par.Meta.Resource' for building meta-par+  (<hackage.haskell.org/package/meta-par>) schedulers with GPU support.  +  +  This package also provides a complete scheduler for CPU plus GPU+  execution.  It supports the 'Control.Monad.Par.Par' monad+  programming model with additional support for GPUs.+++Homepage:            https://github.com/simonmar/monad-par+License:             BSD3+License-file:        LICENSE+Author:              Ryan Newton, Adam Foltzer 2011-2012+Maintainer:          Ryan Newton <rrnewton@gmail.com>+Copyright:           (c) Adam Foltzer 2011-2012+Stability:           Experimental+Category:            Parallelism+Build-type:          Simple+Cabal-version:       >=1.8++Library+  Exposed-modules: +                 -- This is a complete scheduler for shared-memory+                 -- (parallel) and GPU computation:+                 Control.Monad.Par.Meta.AccSMP,++                 -- This is a resource used to build schedulers:+                 Control.Monad.Par.Meta.Resources.Accelerate++  Build-depends:  +                  base >= 4 && < 5+                , abstract-par+                , meta-par+                , abstract-deque+                , accelerate >= 0.12+                , accelerate-io+                -- TEMPORARY, until Async can be factored out:+--                , accelerate-cuda+                , abstract-par-accelerate +                , abstract-par-offchip+                , QuickCheck +                , transformers+                , vector+                , array++  ghc-options:    -Wall ++  if flag(cuda)+     cpp-options: -DACCELERATE_CUDA_BACKEND+     Build-depends: accelerate-cuda++  if flag(debug)+     cpp-options: -DDEBUG++flag cuda+  default:           False++flag debug+  default:           False