{-# language CPP #-}
module Vulkan.Extensions.VK_EXT_pci_bus_info ( PhysicalDevicePCIBusInfoPropertiesEXT(..)
, EXT_PCI_BUS_INFO_SPEC_VERSION
, pattern EXT_PCI_BUS_INFO_SPEC_VERSION
, EXT_PCI_BUS_INFO_EXTENSION_NAME
, pattern EXT_PCI_BUS_INFO_EXTENSION_NAME
) where
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_PCI_BUS_INFO_PROPERTIES_EXT))
data PhysicalDevicePCIBusInfoPropertiesEXT = PhysicalDevicePCIBusInfoPropertiesEXT
{
PhysicalDevicePCIBusInfoPropertiesEXT -> Word32
pciDomain :: Word32
,
PhysicalDevicePCIBusInfoPropertiesEXT -> Word32
pciBus :: Word32
,
PhysicalDevicePCIBusInfoPropertiesEXT -> Word32
pciDevice :: Word32
,
PhysicalDevicePCIBusInfoPropertiesEXT -> Word32
pciFunction :: Word32
}
deriving (Typeable, PhysicalDevicePCIBusInfoPropertiesEXT
-> PhysicalDevicePCIBusInfoPropertiesEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDevicePCIBusInfoPropertiesEXT
-> PhysicalDevicePCIBusInfoPropertiesEXT -> Bool
$c/= :: PhysicalDevicePCIBusInfoPropertiesEXT
-> PhysicalDevicePCIBusInfoPropertiesEXT -> Bool
== :: PhysicalDevicePCIBusInfoPropertiesEXT
-> PhysicalDevicePCIBusInfoPropertiesEXT -> Bool
$c== :: PhysicalDevicePCIBusInfoPropertiesEXT
-> PhysicalDevicePCIBusInfoPropertiesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDevicePCIBusInfoPropertiesEXT)
#endif
deriving instance Show PhysicalDevicePCIBusInfoPropertiesEXT
instance ToCStruct PhysicalDevicePCIBusInfoPropertiesEXT where
withCStruct :: forall b.
PhysicalDevicePCIBusInfoPropertiesEXT
-> (Ptr PhysicalDevicePCIBusInfoPropertiesEXT -> IO b) -> IO b
withCStruct PhysicalDevicePCIBusInfoPropertiesEXT
x Ptr PhysicalDevicePCIBusInfoPropertiesEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p PhysicalDevicePCIBusInfoPropertiesEXT
x (Ptr PhysicalDevicePCIBusInfoPropertiesEXT -> IO b
f Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p)
pokeCStruct :: forall b.
Ptr PhysicalDevicePCIBusInfoPropertiesEXT
-> PhysicalDevicePCIBusInfoPropertiesEXT -> IO b -> IO b
pokeCStruct Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p PhysicalDevicePCIBusInfoPropertiesEXT{Word32
pciFunction :: Word32
pciDevice :: Word32
pciBus :: Word32
pciDomain :: Word32
$sel:pciFunction:PhysicalDevicePCIBusInfoPropertiesEXT :: PhysicalDevicePCIBusInfoPropertiesEXT -> Word32
$sel:pciDevice:PhysicalDevicePCIBusInfoPropertiesEXT :: PhysicalDevicePCIBusInfoPropertiesEXT -> Word32
$sel:pciBus:PhysicalDevicePCIBusInfoPropertiesEXT :: PhysicalDevicePCIBusInfoPropertiesEXT -> Word32
$sel:pciDomain:PhysicalDevicePCIBusInfoPropertiesEXT :: PhysicalDevicePCIBusInfoPropertiesEXT -> Word32
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_PCI_BUS_INFO_PROPERTIES_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
pciDomain)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (Word32
pciBus)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
pciDevice)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (Word32
pciFunction)
IO b
f
cStructSize :: Int
cStructSize = Int
32
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr PhysicalDevicePCIBusInfoPropertiesEXT -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_PCI_BUS_INFO_PROPERTIES_EXT)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct PhysicalDevicePCIBusInfoPropertiesEXT where
peekCStruct :: Ptr PhysicalDevicePCIBusInfoPropertiesEXT
-> IO PhysicalDevicePCIBusInfoPropertiesEXT
peekCStruct Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p = do
Word32
pciDomain <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
Word32
pciBus <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
Word32
pciDevice <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
Word32
pciFunction <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDevicePCIBusInfoPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32
-> Word32
-> Word32
-> Word32
-> PhysicalDevicePCIBusInfoPropertiesEXT
PhysicalDevicePCIBusInfoPropertiesEXT
Word32
pciDomain Word32
pciBus Word32
pciDevice Word32
pciFunction
instance Storable PhysicalDevicePCIBusInfoPropertiesEXT where
sizeOf :: PhysicalDevicePCIBusInfoPropertiesEXT -> Int
sizeOf ~PhysicalDevicePCIBusInfoPropertiesEXT
_ = Int
32
alignment :: PhysicalDevicePCIBusInfoPropertiesEXT -> Int
alignment ~PhysicalDevicePCIBusInfoPropertiesEXT
_ = Int
8
peek :: Ptr PhysicalDevicePCIBusInfoPropertiesEXT
-> IO PhysicalDevicePCIBusInfoPropertiesEXT
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDevicePCIBusInfoPropertiesEXT
-> PhysicalDevicePCIBusInfoPropertiesEXT -> IO ()
poke Ptr PhysicalDevicePCIBusInfoPropertiesEXT
ptr PhysicalDevicePCIBusInfoPropertiesEXT
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDevicePCIBusInfoPropertiesEXT
ptr PhysicalDevicePCIBusInfoPropertiesEXT
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDevicePCIBusInfoPropertiesEXT where
zero :: PhysicalDevicePCIBusInfoPropertiesEXT
zero = Word32
-> Word32
-> Word32
-> Word32
-> PhysicalDevicePCIBusInfoPropertiesEXT
PhysicalDevicePCIBusInfoPropertiesEXT
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
type EXT_PCI_BUS_INFO_SPEC_VERSION = 2
pattern EXT_PCI_BUS_INFO_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_PCI_BUS_INFO_SPEC_VERSION :: forall a. Integral a => a
$mEXT_PCI_BUS_INFO_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_PCI_BUS_INFO_SPEC_VERSION = 2
type EXT_PCI_BUS_INFO_EXTENSION_NAME = "VK_EXT_pci_bus_info"
pattern EXT_PCI_BUS_INFO_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_PCI_BUS_INFO_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mEXT_PCI_BUS_INFO_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_PCI_BUS_INFO_EXTENSION_NAME = "VK_EXT_pci_bus_info"