From e88862353a3a868776dbbed3299baedb67b760e0 Mon Sep 17 00:00:00 2001 From: Ivo Gabe de Wolff Date: Wed, 10 Apr 2024 17:18:44 +0200 Subject: [PATCH 1/2] Remove debugging code --- .../src/Data/Array/Accelerate/LLVM/Native/Execute/Sleep.hs | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Execute/Sleep.hs b/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Execute/Sleep.hs index 90dea3681..43600ee9e 100644 --- a/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Execute/Sleep.hs +++ b/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Execute/Sleep.hs @@ -108,18 +108,14 @@ exitAll (SleepScope ref) = do ticket <- readForCAS ref case peekTicket ticket of Busy _ -> do - print "exitAll busy" (success, _) <- casIORef ref ticket Done - print success unless success $ exitAll (SleepScope ref) Waiting mvar -> do - print "exitAll waiting" new <- newEmptyMVar (success, _) <- casIORef ref ticket Done - print success if success then putMVar mvar Exit else exitAll (SleepScope ref) - Done -> print "exitAll done" -- return () + Done -> return () From 36c3506f8911e8e11ecf2a76ffb15da72b9ddec5 Mon Sep 17 00:00:00 2001 From: Ivo Gabe de Wolff Date: Wed, 10 Apr 2024 17:19:11 +0200 Subject: [PATCH 2/2] Detect number of threads using code from old backend --- .../Accelerate/LLVM/Native/Execute/Scheduler.hs | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Execute/Scheduler.hs b/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Execute/Scheduler.hs index 994f352f4..197675796 100644 --- a/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Execute/Scheduler.hs +++ b/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Execute/Scheduler.hs @@ -46,6 +46,7 @@ import Control.Concurrent.Extra import Control.DeepSeq import Control.Exception import Control.Monad +import System.Environment import System.IO.Unsafe import Data.Proxy import Data.Atomics @@ -54,12 +55,15 @@ import Data.Concurrent.Queue.MichaelScott import Data.IORef import Data.Int import Data.Sequence ( Seq ) +import Data.Maybe +import Text.Read (readMaybe) import Formatting import qualified Data.Sequence as Seq import Foreign.Ptr import Foreign.ForeignPtr import GHC.Base hiding ( build ) +import GHC.Conc #include "MachDeps.h" @@ -169,8 +173,13 @@ tryDequeue !workers = tryPopR (workerTaskQueue workers) -- hireWorkers :: IO Workers hireWorkers = do - ncpu <- getNumCapabilities - workers <- hireWorkersOn [0 .. ncpu-1] + nproc <- getNumProcessors + ncaps <- getNumCapabilities + menv <- (readMaybe =<<) <$> lookupEnv "ACCELERATE_LLVM_NATIVE_THREADS" + + let nthreads = fromMaybe nproc menv + + workers <- hireWorkersOn [0 .. nthreads-1] return workers -- Spawn worker threads on the specified capabilities