-- GENERATED by C->Haskell Compiler, version 0.17.2 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Foreign/CUDA/Driver/Error.chs" #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE DeriveDataTypeable       #-}
{-# LANGUAGE ForeignFunctionInterface #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Foreign.CUDA.Driver.Error
-- Copyright : (c) [2009..2012] Trevor L. McDonell
-- License   : BSD
--
-- Error handling
--
--------------------------------------------------------------------------------

module Foreign.CUDA.Driver.Error
  where

-- Friends
import Foreign.CUDA.Internal.C2HS

-- System
import Data.Typeable
import Control.Exception
import Control.Monad
import Foreign.C
import Foreign.Ptr
import Foreign.Marshal
import Foreign.Storable
import System.IO.Unsafe



{-# LINE 31 "./Foreign/CUDA/Driver/Error.chs" #-}



--------------------------------------------------------------------------------
-- Return Status
--------------------------------------------------------------------------------

--
-- Error Codes
--
data Status = Success
            | InvalidValue
            | OutOfMemory
            | NotInitialized
            | Deinitialized
            | ProfilerDisabled
            | ProfilerNotInitialized
            | ProfilerAlreadyStarted
            | ProfilerAlreadyStopped
            | NoDevice
            | InvalidDevice
            | InvalidImage
            | InvalidContext
            | ContextAlreadyCurrent
            | MapFailed
            | UnmapFailed
            | ArrayIsMapped
            | AlreadyMapped
            | NoBinaryForGPU
            | AlreadyAcquired
            | NotMapped
            | NotMappedAsArray
            | NotMappedAsPointer
            | EccUncorrectable
            | UnsupportedLimit
            | ContextAlreadyInUse
            | PeerAccessUnsupported
            | InvalidPTX
            | InvalidSource
            | FileNotFound
            | SharedObjectSymbolNotFound
            | SharedObjectInitFailed
            | OperatingSystem
            | InvalidHandle
            | NotFound
            | NotReady
            | IllegalAddress
            | LaunchOutOfResources
            | LaunchTimeout
            | LaunchIncompatibleTexturing
            | PeerAccessAlreadyEnabled
            | PeerAccessNotEnabled
            | PrimaryContextActive
            | ContextIsDestroyed
            | Assert
            | TooManyPeers
            | HostMemoryAlreadyRegistered
            | HostMemoryNotRegistered
            | HardwareStackError
            | IllegalInstruction
            | MisalignedAddress
            | InvalidAddressSpace
            | InvalidPC
            | LaunchFailed
            | NotPermitted
            | NotSupported
            | Unknown
            deriving (Eq,Show)
instance Enum Status where
  fromEnum Success = 0
  fromEnum InvalidValue = 1
  fromEnum OutOfMemory = 2
  fromEnum NotInitialized = 3
  fromEnum Deinitialized = 4
  fromEnum ProfilerDisabled = 5
  fromEnum ProfilerNotInitialized = 6
  fromEnum ProfilerAlreadyStarted = 7
  fromEnum ProfilerAlreadyStopped = 8
  fromEnum NoDevice = 100
  fromEnum InvalidDevice = 101
  fromEnum InvalidImage = 200
  fromEnum InvalidContext = 201
  fromEnum ContextAlreadyCurrent = 202
  fromEnum MapFailed = 205
  fromEnum UnmapFailed = 206
  fromEnum ArrayIsMapped = 207
  fromEnum AlreadyMapped = 208
  fromEnum NoBinaryForGPU = 209
  fromEnum AlreadyAcquired = 210
  fromEnum NotMapped = 211
  fromEnum NotMappedAsArray = 212
  fromEnum NotMappedAsPointer = 213
  fromEnum EccUncorrectable = 214
  fromEnum UnsupportedLimit = 215
  fromEnum ContextAlreadyInUse = 216
  fromEnum PeerAccessUnsupported = 217
  fromEnum InvalidPTX = 218
  fromEnum InvalidSource = 300
  fromEnum FileNotFound = 301
  fromEnum SharedObjectSymbolNotFound = 302
  fromEnum SharedObjectInitFailed = 303
  fromEnum OperatingSystem = 304
  fromEnum InvalidHandle = 400
  fromEnum NotFound = 500
  fromEnum NotReady = 600
  fromEnum IllegalAddress = 700
  fromEnum LaunchOutOfResources = 701
  fromEnum LaunchTimeout = 702
  fromEnum LaunchIncompatibleTexturing = 703
  fromEnum PeerAccessAlreadyEnabled = 704
  fromEnum PeerAccessNotEnabled = 705
  fromEnum PrimaryContextActive = 708
  fromEnum ContextIsDestroyed = 709
  fromEnum Assert = 710
  fromEnum TooManyPeers = 711
  fromEnum HostMemoryAlreadyRegistered = 712
  fromEnum HostMemoryNotRegistered = 713
  fromEnum HardwareStackError = 714
  fromEnum IllegalInstruction = 715
  fromEnum MisalignedAddress = 716
  fromEnum InvalidAddressSpace = 717
  fromEnum InvalidPC = 718
  fromEnum LaunchFailed = 719
  fromEnum NotPermitted = 800
  fromEnum NotSupported = 801
  fromEnum Unknown = 999

  toEnum 0 = Success
  toEnum 1 = InvalidValue
  toEnum 2 = OutOfMemory
  toEnum 3 = NotInitialized
  toEnum 4 = Deinitialized
  toEnum 5 = ProfilerDisabled
  toEnum 6 = ProfilerNotInitialized
  toEnum 7 = ProfilerAlreadyStarted
  toEnum 8 = ProfilerAlreadyStopped
  toEnum 100 = NoDevice
  toEnum 101 = InvalidDevice
  toEnum 200 = InvalidImage
  toEnum 201 = InvalidContext
  toEnum 202 = ContextAlreadyCurrent
  toEnum 205 = MapFailed
  toEnum 206 = UnmapFailed
  toEnum 207 = ArrayIsMapped
  toEnum 208 = AlreadyMapped
  toEnum 209 = NoBinaryForGPU
  toEnum 210 = AlreadyAcquired
  toEnum 211 = NotMapped
  toEnum 212 = NotMappedAsArray
  toEnum 213 = NotMappedAsPointer
  toEnum 214 = EccUncorrectable
  toEnum 215 = UnsupportedLimit
  toEnum 216 = ContextAlreadyInUse
  toEnum 217 = PeerAccessUnsupported
  toEnum 218 = InvalidPTX
  toEnum 300 = InvalidSource
  toEnum 301 = FileNotFound
  toEnum 302 = SharedObjectSymbolNotFound
  toEnum 303 = SharedObjectInitFailed
  toEnum 304 = OperatingSystem
  toEnum 400 = InvalidHandle
  toEnum 500 = NotFound
  toEnum 600 = NotReady
  toEnum 700 = IllegalAddress
  toEnum 701 = LaunchOutOfResources
  toEnum 702 = LaunchTimeout
  toEnum 703 = LaunchIncompatibleTexturing
  toEnum 704 = PeerAccessAlreadyEnabled
  toEnum 705 = PeerAccessNotEnabled
  toEnum 708 = PrimaryContextActive
  toEnum 709 = ContextIsDestroyed
  toEnum 710 = Assert
  toEnum 711 = TooManyPeers
  toEnum 712 = HostMemoryAlreadyRegistered
  toEnum 713 = HostMemoryNotRegistered
  toEnum 714 = HardwareStackError
  toEnum 715 = IllegalInstruction
  toEnum 716 = MisalignedAddress
  toEnum 717 = InvalidAddressSpace
  toEnum 718 = InvalidPC
  toEnum 719 = LaunchFailed
  toEnum 800 = NotPermitted
  toEnum 801 = NotSupported
  toEnum 999 = Unknown
  toEnum unmatched = error ("Status.toEnum: Cannot match " ++ show unmatched)

{-# LINE 48 "./Foreign/CUDA/Driver/Error.chs" #-}



-- |
-- Return a descriptive error string associated with a particular error code
--
describe :: Status -> String
describe status
  = unsafePerformIO $ resultIfOk =<< cuGetErrorString status

cuGetErrorString :: (Status) -> IO ((Status), (String))
cuGetErrorString a1 =
  let {a1' = cFromEnum a1} in 
  alloca $ \a2' -> 
  cuGetErrorString'_ a1' a2' >>= \res ->
  let {res' = cToEnum res} in
  ppeek  a2'>>= \a2'' -> 
  return (res', a2'')

{-# LINE 61 "./Foreign/CUDA/Driver/Error.chs" #-}

    where
      ppeek = peek >=> peekCString



--------------------------------------------------------------------------------
-- Exceptions
--------------------------------------------------------------------------------

data CUDAException
  = ExitCode Status
  | UserError String
  deriving Typeable

instance Exception CUDAException

instance Show CUDAException where
  showsPrec _ (ExitCode  s) = showString ("CUDA Exception: " ++ describe s)
  showsPrec _ (UserError s) = showString ("CUDA Exception: " ++ s)


-- |
-- Raise a CUDAException in the IO Monad
--
cudaError :: String -> IO a
cudaError s = throwIO (UserError s)

-- |
-- A specially formatted error message
--
requireSDK :: Double -> String -> IO a
requireSDK v s = cudaError ("'" ++ s ++ "' requires at least cuda-" ++ show v)


--------------------------------------------------------------------------------
-- Helper Functions
--------------------------------------------------------------------------------


-- |
-- Return the results of a function on successful execution, otherwise throw an
-- exception with an error string associated with the return code
--
{-# INLINE resultIfOk #-}
resultIfOk :: (Status, a) -> IO a
resultIfOk (status, !result) =
    case status of
        Success -> return  result
        _       -> throwIO (ExitCode status)


-- |
-- Throw an exception with an error string associated with an unsuccessful
-- return code, otherwise return unit.
--
{-# INLINE nothingIfOk #-}
nothingIfOk :: Status -> IO ()
nothingIfOk status =
    case status of
        Success -> return  ()
        _       -> throwIO (ExitCode status)


foreign import ccall unsafe "Foreign/CUDA/Driver/Error.chs.h cuGetErrorString"
  cuGetErrorString'_ :: (CInt -> ((Ptr (Ptr CChar)) -> (IO CInt)))