module Foreign.OpenCL.Bindings.Program (
createProgram, createProgramWithBinary,
buildProgram, unloadCompiler,
programContext, programDevices, programSource, programBinaries
) where
import Control.Applicative
import Control.Monad
import Foreign hiding (withMany)
import Foreign.C.Types
import Foreign.C.String
import qualified Data.ByteString as B
import Foreign.OpenCL.Bindings.Internal.Types
import Foreign.OpenCL.Bindings.Internal.Finalizers
import Foreign.OpenCL.Bindings.Internal.Error
import Foreign.OpenCL.Bindings.Internal.Util
import Foreign.OpenCL.Bindings.Internal.Logging as Log
createProgram :: Context
-> String
-> IO Program
createProgram ctx str =
withForeignPtr ctx $ \ctx_ptr ->
withCStringLen str $ \(cstr, len) ->
with cstr $ \cstr_ptr ->
with (fromIntegral len) $ \len_ptr ->
alloca $ \ep -> do
Log.debug "Invoking clCreateProgramWithSource"
prog <- clCreateProgramWithSource ctx_ptr 1 cstr_ptr len_ptr ep
checkClError_ "clCreateProgramWithSource" =<< peek ep
attachFinalizer prog
createProgramWithBinary :: Context
-> [(DeviceID, B.ByteString)]
-> IO Program
createProgramWithBinary ctx devs_and_bins =
let (devices, binaries) = unzip devs_and_bins
lengths = map (fromIntegral . B.length) binaries
words' = map (map fromIntegral . B.unpack) binaries
in withForeignPtr ctx $ \ctx_ptr ->
withArrayLen devices $ \n dev_arr ->
allocaArray n $ \binary_status ->
alloca $ \ep ->
withArrays words' $ \bin_arr_list ->
withArray bin_arr_list $ \bin_arr ->
withArray lengths $ \length_arr -> do
prog <- clCreateProgramWithBinary
ctx_ptr (fromIntegral n) dev_arr length_arr
bin_arr binary_status ep
checkClError_ "createProgramWithBinary" =<< peek ep
mapM_ (checkClError "createProgramWithBinary -") =<< peekArray n binary_status
attachFinalizer prog
buildProgram :: Program
-> [DeviceID]
-> String
-> IO ()
buildProgram p devs opts =
withForeignPtr p $ \prog ->
withArrayLen devs $ \n dev_ptr ->
withCString opts $ \opt_ptr -> do
Log.debug "Invoking clBuildProgram"
err <- clBuildProgram
prog (fromIntegral n)
dev_ptr opt_ptr nullFunPtr nullPtr
if (toEnum (fromIntegral err) /= Success)
then do
buildlog <- sequence $ getBuildInfo p <$> devs <*> [ProgramBuildLog]
params <- sequence $ getBuildInfo p <$> devs <*> [ProgramBuildOptions]
putStrLn "*************************** BUILD ERROR ***************************"
putStrLn "Build failed when compiled with the following build options:"
mapM_ putStrLn (params :: [String])
putStrLn "\n*************************** BUILD LOG ***************************"
mapM_ putStrLn (buildlog :: [String])
putStrLn "*******************************************************************"
else return ()
checkClError_ "clBuildProgram" err
unloadCompiler :: IO ()
unloadCompiler = checkClError_ "clUnloadCompiler" =<< clUnloadCompiler
programContext :: Program -> IO Context
programContext prog =
getProgramInfo prog ProgramContext >>= attachRetainFinalizer
programDevices :: Program -> IO [DeviceID]
programDevices prog = getProgramInfo prog ProgramDevices
programSource :: Program -> IO String
programSource prog = getProgramInfo prog ProgramSource
programBinaries :: Program -> IO [(DeviceID, B.ByteString)]
programBinaries prog =
withForeignPtr prog $ \program_ptr -> do
devices <- programDevices prog
sizes <- (getProgramInfo prog ProgramBinarySizes :: IO [ClSize])
allocaArrays (map fromIntegral sizes) $ \ptrs ->
withArrayLen ptrs $ \n ptrs_array -> do
let info_code = fromIntegral $ fromEnum ProgramBinaries
bytes = fromIntegral $ n * sizeOf (head ptrs)
checkClError_ "programBinaries" =<<
clGetProgramInfo_ program_ptr info_code bytes
(castPtr ptrs_array) nullPtr
bin_ptrs <- peekArray n ptrs_array
binaries <- foldM readBinary [] $ zip sizes bin_ptrs
return $ zip devices binaries
where
readBinary :: [B.ByteString] -> (ClSize, Ptr Word8) -> IO [B.ByteString]
readBinary bs (0, _) = return bs
readBinary bs (size, ptr) = do
str <- B.pack <$> peekArray (fromIntegral size) ptr
return $ str : bs
getProgramInfo program info =
withForeignPtr program $ \program_ptr ->
getInfo (clGetProgramInfo_ program_ptr) info
clGetProgramInfo_ program name size value size_ret =
checkClError "clGetProgramInfo" =<<
clGetProgramInfo program name size value size_ret
getBuildInfo program dev info =
withForeignPtr program $ \program_ptr ->
getInfo (clGetProgramBuildInfo program_ptr dev) info
foreign import ccall unsafe "Foreign/OpenCL/Bindings/Program.chs.h clCreateProgramWithSource"
clCreateProgramWithSource :: ((Ptr (CContext)) -> (CUInt -> ((Ptr (Ptr CChar)) -> ((Ptr CULong) -> ((Ptr CInt) -> (IO (Ptr (CProgram))))))))
foreign import ccall unsafe "Foreign/OpenCL/Bindings/Program.chs.h clCreateProgramWithBinary"
clCreateProgramWithBinary :: ((Ptr (CContext)) -> (CUInt -> ((Ptr (DeviceID)) -> ((Ptr CULong) -> ((Ptr (Ptr CUChar)) -> ((Ptr CInt) -> ((Ptr CInt) -> (IO (Ptr (CProgram))))))))))
foreign import ccall unsafe "Foreign/OpenCL/Bindings/Program.chs.h clBuildProgram"
clBuildProgram :: ((Ptr (CProgram)) -> (CUInt -> ((Ptr (DeviceID)) -> ((Ptr CChar) -> ((FunPtr ((Ptr (CProgram)) -> ((Ptr ()) -> (IO ())))) -> ((Ptr ()) -> (IO CInt)))))))
foreign import ccall unsafe "Foreign/OpenCL/Bindings/Program.chs.h clUnloadCompiler"
clUnloadCompiler :: (IO CInt)
foreign import ccall unsafe "Foreign/OpenCL/Bindings/Program.chs.h clGetProgramInfo"
clGetProgramInfo :: ((Ptr (CProgram)) -> (CUInt -> (CULong -> ((Ptr ()) -> ((Ptr CULong) -> (IO CInt))))))
foreign import ccall unsafe "Foreign/OpenCL/Bindings/Program.chs.h clGetProgramBuildInfo"
clGetProgramBuildInfo :: ((Ptr (CProgram)) -> ((DeviceID) -> (CUInt -> (CULong -> ((Ptr ()) -> ((Ptr CULong) -> (IO CInt)))))))