content: {-# LANGUAGE BangPatterns      #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE TemplateHaskell   #-}
  -- |
  -- Module      : Data.Array.Accelerate.LLVM.Native.State
  -- Copyright   : [2014..2020] The Accelerate Team
  -- License     : BSD3
  --
  -- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
  -- Stability   : experimental
  -- Portability : non-portable (GHC extensions)
  --
  
  module Data.Array.Accelerate.LLVM.Native.State (
  
    evalNative,
    createTarget, defaultTarget,
  
  ) where
  
  import Data.Array.Accelerate.Debug.Internal
  
  import Data.Array.Accelerate.LLVM.State
  import Data.Array.Accelerate.LLVM.Native.Target
  import Data.Array.Accelerate.LLVM.Native.Execute.Scheduler
  import qualified Data.Array.Accelerate.LLVM.Native.Link.Cache       as LC
  import qualified Data.Array.Accelerate.LLVM.Native.Debug            as Debug
  
  import Data.Char
  import Data.Maybe
  import Formatting
  import Language.Haskell.TH
  import System.Environment
  import System.IO.Unsafe
  import Text.Read
  
  import GHC.Conc
  import GHC.Ptr
  
  
  -- | Execute a computation in the Native backend
  --
  evalNative :: Native -> LLVM Native a -> IO a
  -- evalNative = evalLLVM
  
  -- XXX: This is correct for run, but for runN we'll use this operation to
  -- do the compilation separately from execution, thus there will be an
  -- empty "frame" with no (execution) trace
  --
  evalNative target acc = do
    let label = Ptr $(litE (stringPrimL (map (fromIntegral . ord) "Native.run\0")))
    emit_frame_mark_start label
    !result <- evalLLVM target acc
    emit_frame_mark_end label
    return result
  
  
  -- | Create a Native execution target by spawning a worker thread on each of the
  -- given capabilities.
  --
  createTarget
      :: [Int]              -- ^ CPUs to launch worker threads on
      -> IO Native
  createTarget cpus = do
    gang    <- hireWorkersOn cpus
    linker  <- LC.new
    return  $! Native linker gang
  
  {--
  -- | The strategy for balancing work amongst the available worker threads.
  --
  type Strategy = Gang -> Executable
  
  
  -- | Execute an operation sequentially on a single thread
  --
  sequentialIO :: Strategy
  sequentialIO gang =
    Executable $ \name _ppt range fill ->
      timed name $ runSeqIO gang range fill
  
  
  -- | Execute a computation without load balancing. Each thread computes an
  -- equally sized chunk of the input. No work stealing occurs.
  --
  unbalancedParIO :: Strategy
  unbalancedParIO gang =
    Executable $ \name _ppt range fill ->
      timed name $ runParIO Single.mkResource gang range fill
  
  
  -- | Execute a computation where threads use work stealing (based on lazy
  -- splitting of work stealing queues and exponential backoff) in order to
  -- automatically balance the workload amongst themselves.
  --
  balancedParIO
      :: Int                -- ^ number of steal attempts before backing off
      -> Strategy
  balancedParIO retries gang =
    Executable $ \name ppt range fill ->
      -- TLM: A suitable PPT should be chosen when invoking the continuation in
      --      order to balance scheduler overhead with fine-grained function calls
      --
      let resource = LBS.mkResource ppt (SMP.mkResource retries <> Backoff.mkResource)
      in  timed name $ runParIO resource gang range fill
  --}
  
  
  -- Top-level mutable state
  -- -----------------------
  --
  -- It is important to keep some information alive for the entire run of the
  -- program, not just a single execution. These tokens use 'unsafePerformIO' to
  -- ensure they are executed only once, and reused for subsequent invocations.
  --
  
  -- | Initialise the gang of threads that will be used to execute computations.
  -- This spawns one worker for each available processor, or as specified by the
  -- value of the environment variable @ACCELERATE_LLVM_NATIVE_THREADS@.
  --
  -- This globally shared thread gang is auto-initialised on startup and shared by
  -- all computations (unless the user chooses to 'run' with a different gang).
  --
  -- It does not help to have multiple gangs running at the same time, as then the
  -- system as a whole may run slower as the threads contend for cache. The
  -- scheduler is able to execute operations from multiple sources concurrently,
  -- so multiple gangs should not be necessary.
  --
  {-# NOINLINE defaultTarget #-}
  defaultTarget :: Native
  defaultTarget = unsafePerformIO $ do
    nproc <- getNumProcessors
    ncaps <- getNumCapabilities
    menv  <- (readMaybe =<<) <$> lookupEnv "ACCELERATE_LLVM_NATIVE_THREADS"
  
    let nthreads = fromMaybe nproc menv
  
    -- Update the number of capabilities, but never set it lower than it already
    -- is. This target will spawn a worker on each processor (as returned by
    -- 'getNumProcessors', which includes SMT (hyperthreading) cores), but the
    -- user may have requested more capabilities than this to handle, for example,
    -- concurrent output.
    --
    setNumCapabilities (max ncaps nthreads)
  
    Debug.traceM Debug.dump_gc ("gc: initialise native target with " % int % " worker threads") nthreads
    createTarget [0 .. nthreads-1]
  
  
  {--
  -- Debugging
  -- ---------
  
  {-# INLINE timed #-}
  timed :: ShortByteString -> IO a -> IO a
  timed name f = Debug.timed Debug.dump_exec (elapsed name) f
  
  {-# INLINE elapsed #-}
  elapsed :: ShortByteString -> Double -> Double -> String
  elapsed name x y = printf "exec: %s %s" (unpack name) (Debug.elapsedP x y)
  --}
  
  