{-# LANGUAGE BangPatterns #-}
-- |
-- Module      : Data.Array.Accelerate.LLVM.PTX.Array.Table
-- 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.PTX.Array.Table (

  MemoryTable,
  new,

) where

import Data.Array.Accelerate.LLVM.PTX.Context                       ( Context, withContext )
import qualified Data.Array.Accelerate.Array.Remote                 as Remote
import qualified Data.Array.Accelerate.LLVM.PTX.Debug               as Debug
import {-# SOURCE #-} Data.Array.Accelerate.LLVM.PTX.Execute.Event

import qualified Foreign.CUDA.Ptr                                   as CUDA
import qualified Foreign.CUDA.Driver                                as CUDA

import Text.Printf


-- Remote memory tables. This builds upon the LRU-cached memory tables provided
-- by the base Accelerate package.
--
type MemoryTable = Remote.MemoryTable CUDA.DevicePtr (Maybe Event)


-- | Create a new PTX memory table. This is specific to a given PTX target, as
-- devices arrays are unique to a CUDA context.
--
{-# INLINEABLE new #-}
new :: Context -> IO MemoryTable
new :: Context -> IO MemoryTable
new !Context
ctx = (forall a. DevicePtr a -> IO ()) -> IO MemoryTable
forall (ptr :: * -> *) task.
(forall a. ptr a -> IO ()) -> IO (MemoryTable ptr task)
Remote.new forall a. DevicePtr a -> IO ()
freeRemote
  where
    freeRemote :: CUDA.DevicePtr a -> IO ()
    freeRemote :: DevicePtr a -> IO ()
freeRemote !DevicePtr a
ptr = do
      String -> IO ()
message (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"freeRemote %s" (DevicePtr a -> String
forall a. Show a => a -> String
show DevicePtr a
ptr))
      Context -> IO () -> IO ()
forall a. Context -> IO a -> IO a
withContext Context
ctx (DevicePtr a -> IO ()
forall a. DevicePtr a -> IO ()
CUDA.free DevicePtr a
ptr)


-- Debugging
-- ---------

{-# INLINE trace #-}
trace :: String -> IO a -> IO a
trace :: String -> IO a -> IO a
trace String
msg IO a
next = Flag -> String -> IO ()
Debug.traceIO Flag
Debug.dump_gc (String
"gc: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg) IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
next

{-# INLINE message #-}
message :: String -> IO ()
message :: String -> IO ()
message String
s = String
s String -> IO () -> IO ()
forall a. String -> IO a -> IO a
`trace` () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()