{-# language CPP #-}
module Graphics.Vulkan.Extensions.VK_AMD_shader_info ( getShaderInfoAMD
, ShaderResourceUsageAMD(..)
, ShaderStatisticsInfoAMD(..)
, ShaderInfoTypeAMD( SHADER_INFO_TYPE_STATISTICS_AMD
, SHADER_INFO_TYPE_BINARY_AMD
, SHADER_INFO_TYPE_DISASSEMBLY_AMD
, ..
)
, AMD_SHADER_INFO_SPEC_VERSION
, pattern AMD_SHADER_INFO_SPEC_VERSION
, AMD_SHADER_INFO_EXTENSION_NAME
, pattern AMD_SHADER_INFO_EXTENSION_NAME
) where
import Graphics.Vulkan.CStruct.Utils (FixedArray)
import Control.Exception.Base (bracket)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Read (choose)
import GHC.Read (expectP)
import GHC.Read (parens)
import GHC.Show (showParen)
import GHC.Show (showString)
import GHC.Show (showsPrec)
import Text.ParserCombinators.ReadPrec ((+++))
import Text.ParserCombinators.ReadPrec (prec)
import Text.ParserCombinators.ReadPrec (step)
import Data.ByteString (packCStringLen)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Foreign.C.Types (CSize(..))
import Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
import Foreign.C.Types (CSize)
import Foreign.C.Types (CSize(CSize))
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import Data.Int (Int32)
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import GHC.Read (Read(readPrec))
import Data.Word (Word32)
import Data.Word (Word64)
import Text.Read.Lex (Lexeme(Ident))
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Graphics.Vulkan.CStruct.Utils (advancePtrBytes)
import Graphics.Vulkan.CStruct.Utils (lowerArrayPtr)
import Graphics.Vulkan.NamedType ((:::))
import Graphics.Vulkan.Core10.Handles (Device)
import Graphics.Vulkan.Core10.Handles (Device(..))
import Graphics.Vulkan.Dynamic (DeviceCmds(pVkGetShaderInfoAMD))
import Graphics.Vulkan.Core10.Handles (Device_T)
import Graphics.Vulkan.CStruct (FromCStruct)
import Graphics.Vulkan.CStruct (FromCStruct(..))
import Graphics.Vulkan.Core10.Handles (Pipeline)
import Graphics.Vulkan.Core10.Handles (Pipeline(..))
import Graphics.Vulkan.Core10.Enums.Result (Result)
import Graphics.Vulkan.Core10.Enums.Result (Result(..))
import Graphics.Vulkan.Core10.Enums.ShaderStageFlagBits (ShaderStageFlagBits)
import Graphics.Vulkan.Core10.Enums.ShaderStageFlagBits (ShaderStageFlagBits(..))
import Graphics.Vulkan.Core10.Enums.ShaderStageFlagBits (ShaderStageFlags)
import Graphics.Vulkan.CStruct (ToCStruct)
import Graphics.Vulkan.CStruct (ToCStruct(..))
import Graphics.Vulkan.Exception (VulkanException(..))
import Graphics.Vulkan.Zero (Zero)
import Graphics.Vulkan.Zero (Zero(..))
import Graphics.Vulkan.Core10.Enums.Result (Result(SUCCESS))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetShaderInfoAMD
:: FunPtr (Ptr Device_T -> Pipeline -> ShaderStageFlagBits -> ShaderInfoTypeAMD -> Ptr CSize -> Ptr () -> IO Result) -> Ptr Device_T -> Pipeline -> ShaderStageFlagBits -> ShaderInfoTypeAMD -> Ptr CSize -> Ptr () -> IO Result
getShaderInfoAMD :: forall io . MonadIO io => Device -> Pipeline -> ShaderStageFlagBits -> ShaderInfoTypeAMD -> io (Result, ("info" ::: ByteString))
getShaderInfoAMD device pipeline shaderStage infoType = liftIO . evalContT $ do
let vkGetShaderInfoAMD' = mkVkGetShaderInfoAMD (pVkGetShaderInfoAMD (deviceCmds (device :: Device)))
let device' = deviceHandle (device)
pPInfoSize <- ContT $ bracket (callocBytes @CSize 8) free
r <- lift $ vkGetShaderInfoAMD' device' (pipeline) (shaderStage) (infoType) (pPInfoSize) (nullPtr)
lift $ when (r < SUCCESS) (throwIO (VulkanException r))
pInfoSize <- lift $ peek @CSize pPInfoSize
pPInfo <- ContT $ bracket (callocBytes @(()) (fromIntegral (((\(CSize a) -> a) pInfoSize)))) free
r' <- lift $ vkGetShaderInfoAMD' device' (pipeline) (shaderStage) (infoType) (pPInfoSize) (pPInfo)
lift $ when (r' < SUCCESS) (throwIO (VulkanException r'))
pInfoSize'' <- lift $ peek @CSize pPInfoSize
pInfo' <- lift $ packCStringLen (castPtr @() @CChar pPInfo, (fromIntegral (((\(CSize a) -> a) pInfoSize''))))
pure $ ((r'), pInfo')
data ShaderResourceUsageAMD = ShaderResourceUsageAMD
{
numUsedVgprs :: Word32
,
numUsedSgprs :: Word32
,
ldsSizePerLocalWorkGroup :: Word32
,
ldsUsageSizeInBytes :: Word64
,
scratchMemUsageInBytes :: Word64
}
deriving (Typeable)
deriving instance Show ShaderResourceUsageAMD
instance ToCStruct ShaderResourceUsageAMD where
withCStruct x f = allocaBytesAligned 32 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p ShaderResourceUsageAMD{..} f = do
poke ((p `plusPtr` 0 :: Ptr Word32)) (numUsedVgprs)
poke ((p `plusPtr` 4 :: Ptr Word32)) (numUsedSgprs)
poke ((p `plusPtr` 8 :: Ptr Word32)) (ldsSizePerLocalWorkGroup)
poke ((p `plusPtr` 16 :: Ptr CSize)) (CSize (ldsUsageSizeInBytes))
poke ((p `plusPtr` 24 :: Ptr CSize)) (CSize (scratchMemUsageInBytes))
f
cStructSize = 32
cStructAlignment = 8
pokeZeroCStruct p f = do
poke ((p `plusPtr` 0 :: Ptr Word32)) (zero)
poke ((p `plusPtr` 4 :: Ptr Word32)) (zero)
poke ((p `plusPtr` 8 :: Ptr Word32)) (zero)
poke ((p `plusPtr` 16 :: Ptr CSize)) (CSize (zero))
poke ((p `plusPtr` 24 :: Ptr CSize)) (CSize (zero))
f
instance FromCStruct ShaderResourceUsageAMD where
peekCStruct p = do
numUsedVgprs <- peek @Word32 ((p `plusPtr` 0 :: Ptr Word32))
numUsedSgprs <- peek @Word32 ((p `plusPtr` 4 :: Ptr Word32))
ldsSizePerLocalWorkGroup <- peek @Word32 ((p `plusPtr` 8 :: Ptr Word32))
ldsUsageSizeInBytes <- peek @CSize ((p `plusPtr` 16 :: Ptr CSize))
scratchMemUsageInBytes <- peek @CSize ((p `plusPtr` 24 :: Ptr CSize))
pure $ ShaderResourceUsageAMD
numUsedVgprs numUsedSgprs ldsSizePerLocalWorkGroup ((\(CSize a) -> a) ldsUsageSizeInBytes) ((\(CSize a) -> a) scratchMemUsageInBytes)
instance Storable ShaderResourceUsageAMD where
sizeOf ~_ = 32
alignment ~_ = 8
peek = peekCStruct
poke ptr poked = pokeCStruct ptr poked (pure ())
instance Zero ShaderResourceUsageAMD where
zero = ShaderResourceUsageAMD
zero
zero
zero
zero
zero
data ShaderStatisticsInfoAMD = ShaderStatisticsInfoAMD
{
shaderStageMask :: ShaderStageFlags
,
resourceUsage :: ShaderResourceUsageAMD
,
numPhysicalVgprs :: Word32
,
numPhysicalSgprs :: Word32
,
numAvailableVgprs :: Word32
,
numAvailableSgprs :: Word32
,
computeWorkGroupSize :: (Word32, Word32, Word32)
}
deriving (Typeable)
deriving instance Show ShaderStatisticsInfoAMD
instance ToCStruct ShaderStatisticsInfoAMD where
withCStruct x f = allocaBytesAligned 72 8 $ \p -> pokeCStruct p x (f p)
pokeCStruct p ShaderStatisticsInfoAMD{..} f = evalContT $ do
lift $ poke ((p `plusPtr` 0 :: Ptr ShaderStageFlags)) (shaderStageMask)
ContT $ pokeCStruct ((p `plusPtr` 8 :: Ptr ShaderResourceUsageAMD)) (resourceUsage) . ($ ())
lift $ poke ((p `plusPtr` 40 :: Ptr Word32)) (numPhysicalVgprs)
lift $ poke ((p `plusPtr` 44 :: Ptr Word32)) (numPhysicalSgprs)
lift $ poke ((p `plusPtr` 48 :: Ptr Word32)) (numAvailableVgprs)
lift $ poke ((p `plusPtr` 52 :: Ptr Word32)) (numAvailableSgprs)
let pComputeWorkGroupSize' = lowerArrayPtr ((p `plusPtr` 56 :: Ptr (FixedArray 3 Word32)))
lift $ case (computeWorkGroupSize) of
(e0, e1, e2) -> do
poke (pComputeWorkGroupSize' :: Ptr Word32) (e0)
poke (pComputeWorkGroupSize' `plusPtr` 4 :: Ptr Word32) (e1)
poke (pComputeWorkGroupSize' `plusPtr` 8 :: Ptr Word32) (e2)
lift $ f
cStructSize = 72
cStructAlignment = 8
pokeZeroCStruct p f = evalContT $ do
lift $ poke ((p `plusPtr` 0 :: Ptr ShaderStageFlags)) (zero)
ContT $ pokeCStruct ((p `plusPtr` 8 :: Ptr ShaderResourceUsageAMD)) (zero) . ($ ())
lift $ poke ((p `plusPtr` 40 :: Ptr Word32)) (zero)
lift $ poke ((p `plusPtr` 44 :: Ptr Word32)) (zero)
lift $ poke ((p `plusPtr` 48 :: Ptr Word32)) (zero)
lift $ poke ((p `plusPtr` 52 :: Ptr Word32)) (zero)
let pComputeWorkGroupSize' = lowerArrayPtr ((p `plusPtr` 56 :: Ptr (FixedArray 3 Word32)))
lift $ case ((zero, zero, zero)) of
(e0, e1, e2) -> do
poke (pComputeWorkGroupSize' :: Ptr Word32) (e0)
poke (pComputeWorkGroupSize' `plusPtr` 4 :: Ptr Word32) (e1)
poke (pComputeWorkGroupSize' `plusPtr` 8 :: Ptr Word32) (e2)
lift $ f
instance FromCStruct ShaderStatisticsInfoAMD where
peekCStruct p = do
shaderStageMask <- peek @ShaderStageFlags ((p `plusPtr` 0 :: Ptr ShaderStageFlags))
resourceUsage <- peekCStruct @ShaderResourceUsageAMD ((p `plusPtr` 8 :: Ptr ShaderResourceUsageAMD))
numPhysicalVgprs <- peek @Word32 ((p `plusPtr` 40 :: Ptr Word32))
numPhysicalSgprs <- peek @Word32 ((p `plusPtr` 44 :: Ptr Word32))
numAvailableVgprs <- peek @Word32 ((p `plusPtr` 48 :: Ptr Word32))
numAvailableSgprs <- peek @Word32 ((p `plusPtr` 52 :: Ptr Word32))
let pcomputeWorkGroupSize = lowerArrayPtr @Word32 ((p `plusPtr` 56 :: Ptr (FixedArray 3 Word32)))
computeWorkGroupSize0 <- peek @Word32 ((pcomputeWorkGroupSize `advancePtrBytes` 0 :: Ptr Word32))
computeWorkGroupSize1 <- peek @Word32 ((pcomputeWorkGroupSize `advancePtrBytes` 4 :: Ptr Word32))
computeWorkGroupSize2 <- peek @Word32 ((pcomputeWorkGroupSize `advancePtrBytes` 8 :: Ptr Word32))
pure $ ShaderStatisticsInfoAMD
shaderStageMask resourceUsage numPhysicalVgprs numPhysicalSgprs numAvailableVgprs numAvailableSgprs ((computeWorkGroupSize0, computeWorkGroupSize1, computeWorkGroupSize2))
instance Zero ShaderStatisticsInfoAMD where
zero = ShaderStatisticsInfoAMD
zero
zero
zero
zero
zero
zero
(zero, zero, zero)
newtype ShaderInfoTypeAMD = ShaderInfoTypeAMD Int32
deriving newtype (Eq, Ord, Storable, Zero)
pattern SHADER_INFO_TYPE_STATISTICS_AMD = ShaderInfoTypeAMD 0
pattern SHADER_INFO_TYPE_BINARY_AMD = ShaderInfoTypeAMD 1
pattern SHADER_INFO_TYPE_DISASSEMBLY_AMD = ShaderInfoTypeAMD 2
{-# complete SHADER_INFO_TYPE_STATISTICS_AMD,
SHADER_INFO_TYPE_BINARY_AMD,
SHADER_INFO_TYPE_DISASSEMBLY_AMD :: ShaderInfoTypeAMD #-}
instance Show ShaderInfoTypeAMD where
showsPrec p = \case
SHADER_INFO_TYPE_STATISTICS_AMD -> showString "SHADER_INFO_TYPE_STATISTICS_AMD"
SHADER_INFO_TYPE_BINARY_AMD -> showString "SHADER_INFO_TYPE_BINARY_AMD"
SHADER_INFO_TYPE_DISASSEMBLY_AMD -> showString "SHADER_INFO_TYPE_DISASSEMBLY_AMD"
ShaderInfoTypeAMD x -> showParen (p >= 11) (showString "ShaderInfoTypeAMD " . showsPrec 11 x)
instance Read ShaderInfoTypeAMD where
readPrec = parens (choose [("SHADER_INFO_TYPE_STATISTICS_AMD", pure SHADER_INFO_TYPE_STATISTICS_AMD)
, ("SHADER_INFO_TYPE_BINARY_AMD", pure SHADER_INFO_TYPE_BINARY_AMD)
, ("SHADER_INFO_TYPE_DISASSEMBLY_AMD", pure SHADER_INFO_TYPE_DISASSEMBLY_AMD)]
+++
prec 10 (do
expectP (Ident "ShaderInfoTypeAMD")
v <- step readPrec
pure (ShaderInfoTypeAMD v)))
type AMD_SHADER_INFO_SPEC_VERSION = 1
pattern AMD_SHADER_INFO_SPEC_VERSION :: forall a . Integral a => a
pattern AMD_SHADER_INFO_SPEC_VERSION = 1
type AMD_SHADER_INFO_EXTENSION_NAME = "VK_AMD_shader_info"
pattern AMD_SHADER_INFO_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern AMD_SHADER_INFO_EXTENSION_NAME = "VK_AMD_shader_info"