{-# LINE 1 "src/Bindings/Libpci/Pci.hsc" #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}


module Bindings.Libpci.Pci where
import Foreign.Ptr
import Foreign.Ptr (Ptr,FunPtr,plusPtr)
import Foreign.Ptr (wordPtrToPtr,castPtrToFunPtr)
import Foreign.Storable
import Foreign.C.Types
import Foreign.C.String (CString,CStringLen,CWString,CWStringLen)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (peekArray,pokeArray)
import Data.Int
import Data.Word

{-# LINE 7 "src/Bindings/Libpci/Pci.hsc" #-}

import Bindings.Libpci.Types
{- struct pci_methods; -}
data C'pci_methods = C'pci_methods

{-# LINE 11 "src/Bindings/Libpci/Pci.hsc" #-}
{- struct id_entry; -}
data C'id_entry = C'id_entry

{-# LINE 13 "src/Bindings/Libpci/Pci.hsc" #-}
{- struct id_bucket; -}
data C'id_bucket = C'id_bucket

{-# LINE 15 "src/Bindings/Libpci/Pci.hsc" #-}
{- struct udev; -}
data C'udev = C'udev

{-# LINE 17 "src/Bindings/Libpci/Pci.hsc" #-}
{- struct udev_hwdb; -}
data C'udev_hwdb = C'udev_hwdb

{-# LINE 19 "src/Bindings/Libpci/Pci.hsc" #-}
{- struct pci_property; -}
data C'pci_property = C'pci_property

{-# LINE 21 "src/Bindings/Libpci/Pci.hsc" #-}
{- enum pci_access_type {
    PCI_ACCESS_AUTO,
    PCI_ACCESS_SYS_BUS_PCI,
    PCI_ACCESS_PROC_BUS_PCI,
    PCI_ACCESS_I386_TYPE1,
    PCI_ACCESS_I386_TYPE2,
    PCI_ACCESS_FBSD_DEVICE,
    PCI_ACCESS_AIX_DEVICE,
    PCI_ACCESS_NBSD_LIBPCI,
    PCI_ACCESS_OBSD_DEVICE,
    PCI_ACCESS_DUMP,
    PCI_ACCESS_DARWIN,
    PCI_ACCESS_SYLIXOS_DEVICE,
    PCI_ACCESS_HURD,
    PCI_ACCESS_MAX
}; -}
type C'pci_access_type = CUInt

{-# LINE 38 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Autodetection
c'PCI_ACCESS_AUTO :: a
c'PCI_ACCESS_AUTO = a
0
c'PCI_ACCESS_AUTO :: (Num a) => a

{-# LINE 41 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Linux /sys/bus/pci
c'PCI_ACCESS_SYS_BUS_PCI = 1
c'PCI_ACCESS_SYS_BUS_PCI :: (Num a) => a

{-# LINE 44 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Linux /proc/bus/pci
c'PCI_ACCESS_PROC_BUS_PCI = 2
c'PCI_ACCESS_PROC_BUS_PCI :: (Num a) => a

{-# LINE 47 "src/Bindings/Libpci/Pci.hsc" #-}

-- | i386 ports, type 1
c'PCI_ACCESS_I386_TYPE1 = 3
c'PCI_ACCESS_I386_TYPE1 :: (Num a) => a

{-# LINE 50 "src/Bindings/Libpci/Pci.hsc" #-}

-- | i386 ports, type 2
c'PCI_ACCESS_I386_TYPE2 = 4
c'PCI_ACCESS_I386_TYPE2 :: (Num a) => a

{-# LINE 53 "src/Bindings/Libpci/Pci.hsc" #-}

-- | FreeBSD /dev/pci
c'PCI_ACCESS_FBSD_DEVICE = 5
c'PCI_ACCESS_FBSD_DEVICE :: (Num a) => a

{-# LINE 56 "src/Bindings/Libpci/Pci.hsc" #-}

-- | /dev/pci0, /dev/bus0, etc.
c'PCI_ACCESS_AIX_DEVICE = 6
c'PCI_ACCESS_AIX_DEVICE :: (Num a) => a

{-# LINE 59 "src/Bindings/Libpci/Pci.hsc" #-}

-- | NetBSD libpci
c'PCI_ACCESS_NBSD_LIBPCI = 7
c'PCI_ACCESS_NBSD_LIBPCI :: (Num a) => a

{-# LINE 62 "src/Bindings/Libpci/Pci.hsc" #-}

-- | OpenBSD /dev/pci
c'PCI_ACCESS_OBSD_DEVICE = 8
c'PCI_ACCESS_OBSD_DEVICE :: (Num a) => a

{-# LINE 65 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Dump file
c'PCI_ACCESS_DUMP = 9
c'PCI_ACCESS_DUMP :: (Num a) => a

{-# LINE 68 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Darwin
c'PCI_ACCESS_DARWIN = 10
c'PCI_ACCESS_DARWIN :: (Num a) => a

{-# LINE 71 "src/Bindings/Libpci/Pci.hsc" #-}


{-# LINE 76 "src/Bindings/Libpci/Pci.hsc" #-}


{-# LINE 81 "src/Bindings/Libpci/Pci.hsc" #-}

c'PCI_ACCESS_MAX :: a
c'PCI_ACCESS_MAX = a
13
c'PCI_ACCESS_MAX :: (Num a) => a

{-# LINE 83 "src/Bindings/Libpci/Pci.hsc" #-}
{- struct pci_access {
    unsigned int method;
    int writeable;
    int buscentric;
    char * id_file_name;
    int free_id_name;
    int numeric_ids;
    unsigned int id_lookup_mode;
    int debugging;
    void (* error)(char * msg, ...) __attribute__((format(printf, 1, 2)));
    void (* warning)(char * msg, ...) __attribute__((format(printf, 1, 2)));
    void (* debug)(char * msg, ...) __attribute__((format(printf, 1, 2)));
    struct pci_dev * devices;
    struct pci_methods * methods;
    struct pci_param * params;
    struct id_entry * * id_hash;
    struct id_bucket * current_id_bucket;
    int id_load_failed;
    int id_cache_status;
    struct udev * id_udev;
    struct udev_hwdb * id_udev_hwdb;
    int fd;
    int fd_rw;
    int fd_pos;
    int fd_vpd;
    struct pci_dev * cached_dev;
}; -}
-- | PCI Access Structure

{-# LINE 112 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Access method

{-# LINE 115 "src/Bindings/Libpci/Pci.hsc" #-}


{-# LINE 117 "src/Bindings/Libpci/Pci.hsc" #-}
-- ^ Open in read/write mode

-- | Bus-centric view of the world

{-# LINE 121 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Name of ID list file (use pci_set_name_list_path())

{-# LINE 124 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Set if id_file_name is malloced

{-# LINE 127 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Enforce PCI_LOOKUP_NUMERIC (>1 => PCI_LOOKUP_MIXED)

{-# LINE 130 "src/Bindings/Libpci/Pci.hsc" #-}

-- | pci_lookup_mode flags which are set automatically
-- Default: PCI_LOOKUP_CACHE

{-# LINE 134 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Turn on debugging messages

{-# LINE 137 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Write error message and quit

{-# LINE 140 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Write a warning message

{-# LINE 143 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Write a debugging message

{-# LINE 146 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Devices found on this bus

{-# LINE 149 "src/Bindings/Libpci/Pci.hsc" #-}


{-# LINE 151 "src/Bindings/Libpci/Pci.hsc" #-}

{-# LINE 152 "src/Bindings/Libpci/Pci.hsc" #-}

-- | names.c

{-# LINE 155 "src/Bindings/Libpci/Pci.hsc" #-}

{-# LINE 156 "src/Bindings/Libpci/Pci.hsc" #-}

{-# LINE 157 "src/Bindings/Libpci/Pci.hsc" #-}

-- | 0=not read, 1=read, 2=dirty

{-# LINE 160 "src/Bindings/Libpci/Pci.hsc" #-}

-- | names-hwdb.c

{-# LINE 163 "src/Bindings/Libpci/Pci.hsc" #-}

{-# LINE 164 "src/Bindings/Libpci/Pci.hsc" #-}

-- | proc/sys: fd for config space

{-# LINE 167 "src/Bindings/Libpci/Pci.hsc" #-}

-- | proc/sys: fd opened read-write

{-# LINE 170 "src/Bindings/Libpci/Pci.hsc" #-}

-- | proc/sys: current position

{-# LINE 173 "src/Bindings/Libpci/Pci.hsc" #-}

-- | sys: fd for VPD

{-# LINE 176 "src/Bindings/Libpci/Pci.hsc" #-}

-- | proc/sys: device the fds are for

{-# LINE 179 "src/Bindings/Libpci/Pci.hsc" #-}
data C'pci_access = C'pci_access{
  c'pci_access'method :: CUInt,
  c'pci_access'writeable :: CInt,
  c'pci_access'buscentric :: CInt,
  c'pci_access'id_file_name :: CString,
  c'pci_access'free_id_name :: CInt,
  c'pci_access'numeric_ids :: CInt,
  c'pci_access'id_lookup_mode :: CUInt,
  c'pci_access'debugging :: CInt,
  c'pci_access'error :: FunPtr (CString -> IO ()),
  c'pci_access'warning :: FunPtr (CString -> IO ()),
  c'pci_access'debug :: FunPtr (CString -> IO ()),
  c'pci_access'devices :: Ptr C'pci_dev,
  c'pci_access'methods :: Ptr C'pci_methods,
  c'pci_access'params :: Ptr C'pci_param,
  c'pci_access'id_hash :: Ptr (Ptr C'id_entry),
  c'pci_access'current_id_bucket :: Ptr C'id_bucket,
  c'pci_access'id_load_failed :: CInt,
  c'pci_access'id_cache_status :: CInt,
  c'pci_access'id_udev :: Ptr C'udev,
  c'pci_access'id_udev_hwdb :: Ptr C'udev_hwdb,
  c'pci_access'fd :: CInt,
  c'pci_access'fd_rw :: CInt,
  c'pci_access'fd_pos :: CInt,
  c'pci_access'fd_vpd :: CInt,
  c'pci_access'cached_dev :: Ptr C'pci_dev
} deriving (Eq,Show)
p'pci_access'method :: Ptr C'pci_access -> Ptr CUInt
p'pci_access'method Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
0
p'pci_access'method :: Ptr (C'pci_access) -> Ptr (CUInt)
p'pci_access'writeable :: Ptr C'pci_access -> Ptr CInt
p'pci_access'writeable Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
4
p'pci_access'writeable :: Ptr (C'pci_access) -> Ptr (CInt)
p'pci_access'buscentric :: Ptr C'pci_access -> Ptr CInt
p'pci_access'buscentric Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
8
p'pci_access'buscentric :: Ptr (C'pci_access) -> Ptr (CInt)
p'pci_access'id_file_name :: Ptr C'pci_access -> Ptr CString
p'pci_access'id_file_name Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
16
p'pci_access'id_file_name :: Ptr (C'pci_access) -> Ptr (CString)
p'pci_access'free_id_name :: Ptr C'pci_access -> Ptr CInt
p'pci_access'free_id_name Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
24
p'pci_access'free_id_name :: Ptr (C'pci_access) -> Ptr (CInt)
p'pci_access'numeric_ids :: Ptr C'pci_access -> Ptr CInt
p'pci_access'numeric_ids Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
28
p'pci_access'numeric_ids :: Ptr (C'pci_access) -> Ptr (CInt)
p'pci_access'id_lookup_mode :: Ptr C'pci_access -> Ptr CUInt
p'pci_access'id_lookup_mode Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
32
p'pci_access'id_lookup_mode :: Ptr (C'pci_access) -> Ptr (CUInt)
p'pci_access'debugging :: Ptr C'pci_access -> Ptr CInt
p'pci_access'debugging Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
36
p'pci_access'debugging :: Ptr (C'pci_access) -> Ptr (CInt)
p'pci_access'error :: Ptr C'pci_access -> Ptr (FunPtr (CString -> IO ()))
p'pci_access'error Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr (FunPtr (CString -> IO ()))
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
40
p'pci_access'error :: Ptr (C'pci_access) -> Ptr (FunPtr (CString -> IO ()))
p'pci_access'warning :: Ptr C'pci_access -> Ptr (FunPtr (CString -> IO ()))
p'pci_access'warning Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr (FunPtr (CString -> IO ()))
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
48
p'pci_access'warning :: Ptr (C'pci_access) -> Ptr (FunPtr (CString -> IO ()))
p'pci_access'debug :: Ptr C'pci_access -> Ptr (FunPtr (CString -> IO ()))
p'pci_access'debug Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr (FunPtr (CString -> IO ()))
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
56
p'pci_access'debug :: Ptr (C'pci_access) -> Ptr (FunPtr (CString -> IO ()))
p'pci_access'devices :: Ptr C'pci_access -> Ptr (Ptr C'pci_dev)
p'pci_access'devices Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr (Ptr C'pci_dev)
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
64
p'pci_access'devices :: Ptr (C'pci_access) -> Ptr (Ptr C'pci_dev)
p'pci_access'methods Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr (Ptr C'pci_methods)
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
72
p'pci_access'methods :: Ptr (C'pci_access) -> Ptr (Ptr C'pci_methods)
p'pci_access'params :: Ptr C'pci_access -> Ptr (Ptr C'pci_param)
p'pci_access'params Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr (Ptr C'pci_param)
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
80
p'pci_access'params :: Ptr (C'pci_access) -> Ptr (Ptr C'pci_param)
p'pci_access'id_hash :: Ptr C'pci_access -> Ptr (Ptr (Ptr C'id_entry))
p'pci_access'id_hash Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr (Ptr (Ptr C'id_entry))
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
88
p'pci_access'id_hash :: Ptr (C'pci_access) -> Ptr (Ptr (Ptr C'id_entry))
p'pci_access'current_id_bucket :: Ptr C'pci_access -> Ptr (Ptr C'id_bucket)
p'pci_access'current_id_bucket Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr (Ptr C'id_bucket)
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
96
p'pci_access'current_id_bucket :: Ptr (C'pci_access) -> Ptr (Ptr C'id_bucket)
p'pci_access'id_load_failed :: Ptr C'pci_access -> Ptr CInt
p'pci_access'id_load_failed Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
104
p'pci_access'id_load_failed :: Ptr (C'pci_access) -> Ptr (CInt)
p'pci_access'id_cache_status :: Ptr C'pci_access -> Ptr CInt
p'pci_access'id_cache_status Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
108
p'pci_access'id_cache_status :: Ptr (C'pci_access) -> Ptr (CInt)
p'pci_access'id_udev :: Ptr C'pci_access -> Ptr (Ptr C'udev)
p'pci_access'id_udev Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr (Ptr C'udev)
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
112
p'pci_access'id_udev :: Ptr (C'pci_access) -> Ptr (Ptr C'udev)
p'pci_access'id_udev_hwdb :: Ptr C'pci_access -> Ptr (Ptr C'udev_hwdb)
p'pci_access'id_udev_hwdb Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr (Ptr C'udev_hwdb)
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
120
p'pci_access'id_udev_hwdb :: Ptr (C'pci_access) -> Ptr (Ptr C'udev_hwdb)
p'pci_access'fd :: Ptr C'pci_access -> Ptr CInt
p'pci_access'fd Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
128
p'pci_access'fd :: Ptr (C'pci_access) -> Ptr (CInt)
p'pci_access'fd_rw :: Ptr C'pci_access -> Ptr CInt
p'pci_access'fd_rw Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
132
p'pci_access'fd_rw :: Ptr (C'pci_access) -> Ptr (CInt)
p'pci_access'fd_pos :: Ptr C'pci_access -> Ptr CInt
p'pci_access'fd_pos Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
136
p'pci_access'fd_pos :: Ptr (C'pci_access) -> Ptr (CInt)
p'pci_access'fd_vpd :: Ptr C'pci_access -> Ptr CInt
p'pci_access'fd_vpd Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
140
p'pci_access'fd_vpd :: Ptr (C'pci_access) -> Ptr (CInt)
p'pci_access'cached_dev :: Ptr C'pci_access -> Ptr (Ptr C'pci_dev)
p'pci_access'cached_dev Ptr C'pci_access
p = Ptr C'pci_access -> Int -> Ptr (Ptr C'pci_dev)
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_access
p Int
144
p'pci_access'cached_dev :: Ptr (C'pci_access) -> Ptr (Ptr C'pci_dev)
instance Storable C'pci_access where
  sizeOf _ = Int
152
  alignment :: C'pci_access -> Int
alignment C'pci_access
_ = Int
8
  peek :: Ptr C'pci_access -> IO C'pci_access
peek Ptr C'pci_access
_p = do
    CUInt
v0 <- Ptr C'pci_access -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
0
    CInt
v1 <- Ptr C'pci_access -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
4
    CInt
v2 <- Ptr C'pci_access -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
8
    CString
v3 <- Ptr C'pci_access -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
16
    CInt
v4 <- Ptr C'pci_access -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
24
    CInt
v5 <- Ptr C'pci_access -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
28
    CUInt
v6 <- Ptr C'pci_access -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
32
    CInt
v7 <- Ptr C'pci_access -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
36
    FunPtr (CString -> IO ())
v8 <- Ptr C'pci_access -> Int -> IO (FunPtr (CString -> IO ()))
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
40
    FunPtr (CString -> IO ())
v9 <- Ptr C'pci_access -> Int -> IO (FunPtr (CString -> IO ()))
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
48
    FunPtr (CString -> IO ())
v10 <- Ptr C'pci_access -> Int -> IO (FunPtr (CString -> IO ()))
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
56
    Ptr C'pci_dev
v11 <- Ptr C'pci_access -> Int -> IO (Ptr C'pci_dev)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
64
    Ptr C'pci_methods
v12 <- Ptr C'pci_access -> Int -> IO (Ptr C'pci_methods)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
72
    Ptr C'pci_param
v13 <- Ptr C'pci_access -> Int -> IO (Ptr C'pci_param)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
80
    Ptr (Ptr C'id_entry)
v14 <- Ptr C'pci_access -> Int -> IO (Ptr (Ptr C'id_entry))
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
88
    Ptr C'id_bucket
v15 <- Ptr C'pci_access -> Int -> IO (Ptr C'id_bucket)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
96
    CInt
v16 <- Ptr C'pci_access -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
104
    CInt
v17 <- Ptr C'pci_access -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
108
    Ptr C'udev
v18 <- Ptr C'pci_access -> Int -> IO (Ptr C'udev)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
112
    Ptr C'udev_hwdb
v19 <- Ptr C'pci_access -> Int -> IO (Ptr C'udev_hwdb)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
120
    CInt
v20 <- Ptr C'pci_access -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
128
    CInt
v21 <- Ptr C'pci_access -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
132
    CInt
v22 <- Ptr C'pci_access -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
136
    CInt
v23 <- Ptr C'pci_access -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
140
    Ptr C'pci_dev
v24 <- Ptr C'pci_access -> Int -> IO (Ptr C'pci_dev)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'pci_access
_p Int
144
    C'pci_access -> IO C'pci_access
forall (m :: * -> *) a. Monad m => a -> m a
return (C'pci_access -> IO C'pci_access)
-> C'pci_access -> IO C'pci_access
forall a b. (a -> b) -> a -> b
$ CUInt
-> CInt
-> CInt
-> CString
-> CInt
-> CInt
-> CUInt
-> CInt
-> FunPtr (CString -> IO ())
-> FunPtr (CString -> IO ())
-> FunPtr (CString -> IO ())
-> Ptr C'pci_dev
-> Ptr C'pci_methods
-> Ptr C'pci_param
-> Ptr (Ptr C'id_entry)
-> Ptr C'id_bucket
-> CInt
-> CInt
-> Ptr C'udev
-> Ptr C'udev_hwdb
-> CInt
-> CInt
-> CInt
-> CInt
-> Ptr C'pci_dev
-> C'pci_access
C'pci_access CUInt
v0 CInt
v1 CInt
v2 CString
v3 CInt
v4 CInt
v5 CUInt
v6 CInt
v7 FunPtr (CString -> IO ())
v8 FunPtr (CString -> IO ())
v9 FunPtr (CString -> IO ())
v10 Ptr C'pci_dev
v11 Ptr C'pci_methods
v12 Ptr C'pci_param
v13 Ptr (Ptr C'id_entry)
v14 Ptr C'id_bucket
v15 CInt
v16 CInt
v17 Ptr C'udev
v18 Ptr C'udev_hwdb
v19 CInt
v20 CInt
v21 CInt
v22 CInt
v23 Ptr C'pci_dev
v24
  poke :: Ptr C'pci_access -> C'pci_access -> IO ()
poke Ptr C'pci_access
_p (C'pci_access CUInt
v0 CInt
v1 CInt
v2 CString
v3 CInt
v4 CInt
v5 CUInt
v6 CInt
v7 FunPtr (CString -> IO ())
v8 FunPtr (CString -> IO ())
v9 FunPtr (CString -> IO ())
v10 Ptr C'pci_dev
v11 Ptr C'pci_methods
v12 Ptr C'pci_param
v13 Ptr (Ptr C'id_entry)
v14 Ptr C'id_bucket
v15 CInt
v16 CInt
v17 Ptr C'udev
v18 Ptr C'udev_hwdb
v19 CInt
v20 CInt
v21 CInt
v22 CInt
v23 Ptr C'pci_dev
v24) = do
    Ptr C'pci_access -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
0 CUInt
v0
    Ptr C'pci_access -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
4 CInt
v1
    Ptr C'pci_access -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
8 CInt
v2
    Ptr C'pci_access -> Int -> CString -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
16 CString
v3
    Ptr C'pci_access -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
24 CInt
v4
    Ptr C'pci_access -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
28 CInt
v5
    Ptr C'pci_access -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
32 CUInt
v6
    Ptr C'pci_access -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
36 CInt
v7
    Ptr C'pci_access -> Int -> FunPtr (CString -> IO ()) -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
40 FunPtr (CString -> IO ())
v8
    Ptr C'pci_access -> Int -> FunPtr (CString -> IO ()) -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
48 FunPtr (CString -> IO ())
v9
    Ptr C'pci_access -> Int -> FunPtr (CString -> IO ()) -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
56 FunPtr (CString -> IO ())
v10
    Ptr C'pci_access -> Int -> Ptr C'pci_dev -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
64 Ptr C'pci_dev
v11
    Ptr C'pci_access -> Int -> Ptr C'pci_methods -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
72 Ptr C'pci_methods
v12
    Ptr C'pci_access -> Int -> Ptr C'pci_param -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
80 Ptr C'pci_param
v13
    Ptr C'pci_access -> Int -> Ptr (Ptr C'id_entry) -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
88 Ptr (Ptr C'id_entry)
v14
    Ptr C'pci_access -> Int -> Ptr C'id_bucket -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
96 Ptr C'id_bucket
v15
    Ptr C'pci_access -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
104 CInt
v16
    Ptr C'pci_access -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
108 CInt
v17
    Ptr C'pci_access -> Int -> Ptr C'udev -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
112 Ptr C'udev
v18
    Ptr C'pci_access -> Int -> Ptr C'udev_hwdb -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
120 Ptr C'udev_hwdb
v19
    Ptr C'pci_access -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
128 CInt
v20
    Ptr C'pci_access -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
132 CInt
v21
    Ptr C'pci_access -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
136 CInt
v22
    Ptr C'pci_access -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
140 CInt
v23
    Ptr C'pci_access -> Int -> Ptr C'pci_dev -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_access
_p Int
144 Ptr C'pci_dev
v24
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 180 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Initialize PCI access
foreign import ccall "pci_alloc" c'pci_alloc
  :: IO (Ptr C'pci_access)
foreign import ccall "&pci_alloc" p'pci_alloc
  :: FunPtr (IO (Ptr C'pci_access))

{-# LINE 183 "src/Bindings/Libpci/Pci.hsc" #-}
foreign import ccall "pci_init" c'pci_init
  :: Ptr C'pci_access -> IO ()
foreign import ccall "&pci_init" p'pci_init
  :: FunPtr (Ptr C'pci_access -> IO ())

{-# LINE 184 "src/Bindings/Libpci/Pci.hsc" #-}
foreign import ccall "pci_cleanup" c'pci_cleanup
  :: Ptr C'pci_access -> IO ()
foreign import ccall "&pci_cleanup" p'pci_cleanup
  :: FunPtr (Ptr C'pci_access -> IO ())

{-# LINE 185 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Scanning of devices
foreign import ccall "pci_scan_bus" c'pci_scan_bus
  :: Ptr C'pci_access -> IO ()
foreign import ccall "&pci_scan_bus" p'pci_scan_bus
  :: FunPtr (Ptr C'pci_access -> IO ())

{-# LINE 188 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Raw access to specified device
foreign import ccall "pci_get_dev" c'pci_get_dev
  :: Ptr C'pci_access -> CInt -> CInt -> CInt -> CInt -> IO (Ptr C'pci_dev)
foreign import ccall "&pci_get_dev" p'pci_get_dev
  :: FunPtr (Ptr C'pci_access -> CInt -> CInt -> CInt -> CInt -> IO (Ptr C'pci_dev))

{-# LINE 191 "src/Bindings/Libpci/Pci.hsc" #-}
foreign import ccall "pci_free_dev" c'pci_free_dev
  :: Ptr C'pci_dev -> IO ()
foreign import ccall "&pci_free_dev" p'pci_free_dev
  :: FunPtr (Ptr C'pci_dev -> IO ())

{-# LINE 192 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Names of access methods
-- | Returns -1 if not found
foreign import ccall "pci_lookup_method" c'pci_lookup_method
  :: CString -> IO CInt
foreign import ccall "&pci_lookup_method" p'pci_lookup_method
  :: FunPtr (CString -> IO CInt)

{-# LINE 196 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Returns "" if unavailable, NULL if index out of range
foreign import ccall "pci_get_method_name" c'pci_get_method_name
  :: CInt -> IO CString
foreign import ccall "&pci_get_method_name" p'pci_get_method_name
  :: FunPtr (CInt -> IO CString)

{-# LINE 199 "src/Bindings/Libpci/Pci.hsc" #-}

{- struct pci_param {
    struct pci_param * next;
    char * param;
    char * value;
    int value_malloced;
    char * help;
}; -}
-- | Named parameters

{-# LINE 209 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Please use pci_walk_params() for traversing the list

{-# LINE 212 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Name of the parameter

{-# LINE 215 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Value of the parameter

{-# LINE 218 "src/Bindings/Libpci/Pci.hsc" #-}

-- | used internally

{-# LINE 221 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Explanation of the parameter

{-# LINE 224 "src/Bindings/Libpci/Pci.hsc" #-}
data C'pci_param = C'pci_param{
  c'pci_param'next :: Ptr C'pci_param,
  c'pci_param'param :: CString,
  c'pci_param'value :: CString,
  c'pci_param'value_malloced :: CInt,
  c'pci_param'help :: CString
} deriving (Eq,Show)
p'pci_param'next p = plusPtr p 0
p'pci_param'next :: Ptr (C'pci_param) -> Ptr (Ptr C'pci_param)
p'pci_param'param p = plusPtr p 8
p'pci_param'param :: Ptr (C'pci_param) -> Ptr (CString)
p'pci_param'value p = plusPtr p 16
p'pci_param'value :: Ptr (C'pci_param) -> Ptr (CString)
p'pci_param'value_malloced p = plusPtr p 24
p'pci_param'value_malloced :: Ptr (C'pci_param) -> Ptr (CInt)
p'pci_param'help p = plusPtr p 32
p'pci_param'help :: Ptr (C'pci_param) -> Ptr (CString)
instance Storable C'pci_param where
  sizeOf _ = 40
  alignment _ = 8
  peek _p = do
    v0 <- peekByteOff _p 0
    v1 <- peekByteOff _p 8
    v2 <- peekByteOff _p 16
    v3 <- peekByteOff _p 24
    v4 <- peekByteOff _p 32
    return $ C'pci_param v0 v1 v2 v3 v4
  poke _p (C'pci_param v0 v1 v2 v3 v4) = do
    pokeByteOff _p 0 v0
    pokeByteOff _p 8 v1
    pokeByteOff _p 16 v2
    pokeByteOff _p 24 v3
    pokeByteOff _p 32 v4
    return ()

{-# LINE 225 "src/Bindings/Libpci/Pci.hsc" #-}

foreign import ccall "pci_get_param" c'pci_get_param
  :: Ptr C'pci_access -> CString -> IO CString
foreign import ccall "&pci_get_param" p'pci_get_param
  :: FunPtr (Ptr C'pci_access -> CString -> IO CString)

{-# LINE 227 "src/Bindings/Libpci/Pci.hsc" #-}

-- | 0 on success, -1 if no such parameter
foreign import ccall "pci_set_param" c'pci_set_param
  :: Ptr C'pci_access -> CString -> CString -> IO CInt
foreign import ccall "&pci_set_param" p'pci_set_param
  :: FunPtr (Ptr C'pci_access -> CString -> CString -> IO CInt)

{-# LINE 230 "src/Bindings/Libpci/Pci.hsc" #-}

-- | To traverse the list, call pci_walk_params repeatedly, first with prev=NULL, and do not modify the parameters during traversal
foreign import ccall "pci_walk_params" c'pci_walk_params
  :: Ptr C'pci_access -> Ptr C'pci_param -> IO (Ptr C'pci_param)
foreign import ccall "&pci_walk_params" p'pci_walk_params
  :: FunPtr (Ptr C'pci_access -> Ptr C'pci_param -> IO (Ptr C'pci_param))

{-# LINE 233 "src/Bindings/Libpci/Pci.hsc" #-}

{- struct pci_dev {
    struct pci_dev * next;
    u16 domain_16;
    u8 bus, dev, func;
    int known_fields;
    u16 vendor_id, device_id;
    u16 device_class;
    int irq;
    pciaddr_t base_addr[6];
    pciaddr_t size[6];
    pciaddr_t rom_base_addr;
    pciaddr_t rom_size;
    struct pci_cap * first_cap;
    char * phy_slot;
    char * module_alias;
    char * label;
    int numa_node;
    pciaddr_t flags[6];
    pciaddr_t rom_flags;
    int domain;
    struct pci_access * access;
    struct pci_methods * methods;
    u8 * cache;
    int cache_len;
    int hdrtype;
    void * aux;
    struct pci_property * properties;
    struct pci_cap * last_cap;
}; -}
-- | Devices

{-# LINE 265 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Next device in the chain

{-# LINE 268 "src/Bindings/Libpci/Pci.hsc" #-}

-- | 16-bit version of the PCI domain for backward compatibility

{-# LINE 271 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Bus inside domain, device and function

{-# LINE 274 "src/Bindings/Libpci/Pci.hsc" #-}

{-# LINE 275 "src/Bindings/Libpci/Pci.hsc" #-}

{-# LINE 276 "src/Bindings/Libpci/Pci.hsc" #-}

-- | These fields are set by pci_fill_info()
-- | Set of info fields already known (see pci_fill_info())

{-# LINE 280 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Identity of the device

{-# LINE 283 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Identity of the device

{-# LINE 286 "src/Bindings/Libpci/Pci.hsc" #-}

-- | PCI device class

{-# LINE 289 "src/Bindings/Libpci/Pci.hsc" #-}

-- | IRQ number

{-# LINE 292 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Base addresses including flags in lower bits

{-# LINE 295 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Region sizes

{-# LINE 298 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Expansion ROM base address

{-# LINE 301 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Expansion ROM size

{-# LINE 304 "src/Bindings/Libpci/Pci.hsc" #-}

-- | List of capabilities

{-# LINE 307 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Physical slot

{-# LINE 310 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Linux kernel module alias

{-# LINE 313 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Device name as exported by BIOS

{-# LINE 316 "src/Bindings/Libpci/Pci.hsc" #-}

-- | NUMA node

{-# LINE 319 "src/Bindings/Libpci/Pci.hsc" #-}

-- | PCI_IORESOURCE_* flags for regions

{-# LINE 322 "src/Bindings/Libpci/Pci.hsc" #-}

-- | PCI_IORESOURCE_* flags for expansion ROM

{-# LINE 325 "src/Bindings/Libpci/Pci.hsc" #-}

-- | PCI domain (host bridge)

{-# LINE 328 "src/Bindings/Libpci/Pci.hsc" #-}

{-# LINE 329 "src/Bindings/Libpci/Pci.hsc" #-}

{-# LINE 330 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Cached config registers

{-# LINE 333 "src/Bindings/Libpci/Pci.hsc" #-}

{-# LINE 334 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Cached low 7 bits of header type, -1 if unknown

{-# LINE 337 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Auxiliary data for use by the back-end

{-# LINE 340 "src/Bindings/Libpci/Pci.hsc" #-}


{-# LINE 345 "src/Bindings/Libpci/Pci.hsc" #-}


{-# LINE 350 "src/Bindings/Libpci/Pci.hsc" #-}
data C'pci_dev = C'pci_dev{
  C'pci_dev -> Ptr C'pci_dev
c'pci_dev'next :: Ptr C'pci_dev,
  C'pci_dev -> CUShort
c'pci_dev'domain_16 :: CUShort,
  c'pci_dev'bus :: CUChar,
  c'pci_dev'dev :: CUChar,
  c'pci_dev'func :: CUChar,
  c'pci_dev'known_fields :: CInt,
  c'pci_dev'vendor_id :: CUShort,
  c'pci_dev'device_id :: CUShort,
  c'pci_dev'device_class :: CUShort,
  c'pci_dev'irq :: CInt,
  c'pci_dev'base_addr :: [CULong],
  c'pci_dev'size :: [CULong],
  c'pci_dev'rom_base_addr :: CULong,
  c'pci_dev'rom_size :: CULong,
  C'pci_dev -> Ptr C'pci_cap
c'pci_dev'first_cap :: Ptr C'pci_cap,
  C'pci_dev -> CString
c'pci_dev'phy_slot :: CString,
  C'pci_dev -> CString
c'pci_dev'module_alias :: CString,
  C'pci_dev -> CString
c'pci_dev'label :: CString,
  C'pci_dev -> CInt
c'pci_dev'numa_node :: CInt,
  C'pci_dev -> [CULong]
c'pci_dev'flags :: [CULong],
  C'pci_dev -> CULong
c'pci_dev'rom_flags :: CULong,
  C'pci_dev -> CInt
c'pci_dev'domain :: CInt,
  C'pci_dev -> Ptr C'pci_access
c'pci_dev'access :: Ptr C'pci_access,
  C'pci_dev -> Ptr C'pci_methods
c'pci_dev'methods :: Ptr C'pci_methods,
  C'pci_dev -> Ptr CUChar
c'pci_dev'cache :: Ptr CUChar,
  C'pci_dev -> CInt
c'pci_dev'cache_len :: CInt,
  C'pci_dev -> CInt
c'pci_dev'hdrtype :: CInt,
  C'pci_dev -> Ptr ()
c'pci_dev'aux :: Ptr ()
} deriving (C'pci_dev -> C'pci_dev -> Bool
(C'pci_dev -> C'pci_dev -> Bool)
-> (C'pci_dev -> C'pci_dev -> Bool) -> Eq C'pci_dev
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: C'pci_dev -> C'pci_dev -> Bool
$c/= :: C'pci_dev -> C'pci_dev -> Bool
== :: C'pci_dev -> C'pci_dev -> Bool
$c== :: C'pci_dev -> C'pci_dev -> Bool
Eq,Int -> C'pci_dev -> ShowS
[C'pci_dev] -> ShowS
C'pci_dev -> String
(Int -> C'pci_dev -> ShowS)
-> (C'pci_dev -> String)
-> ([C'pci_dev] -> ShowS)
-> Show C'pci_dev
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [C'pci_dev] -> ShowS
$cshowList :: [C'pci_dev] -> ShowS
show :: C'pci_dev -> String
$cshow :: C'pci_dev -> String
showsPrec :: Int -> C'pci_dev -> ShowS
$cshowsPrec :: Int -> C'pci_dev -> ShowS
Show)
p'pci_dev'next :: Ptr C'pci_dev -> Ptr (Ptr C'pci_dev)
p'pci_dev'next Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr (Ptr C'pci_dev)
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
0
p'pci_dev'next :: Ptr (C'pci_dev) -> Ptr (Ptr C'pci_dev)
p'pci_dev'domain_16 :: Ptr C'pci_dev -> Ptr CUShort
p'pci_dev'domain_16 Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr CUShort
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
8
p'pci_dev'domain_16 :: Ptr (C'pci_dev) -> Ptr (CUShort)
p'pci_dev'bus :: Ptr C'pci_dev -> Ptr CUChar
p'pci_dev'bus Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr CUChar
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
10
p'pci_dev'bus :: Ptr (C'pci_dev) -> Ptr (CUChar)
p'pci_dev'dev :: Ptr C'pci_dev -> Ptr CUChar
p'pci_dev'dev Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr CUChar
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
11
p'pci_dev'dev :: Ptr (C'pci_dev) -> Ptr (CUChar)
p'pci_dev'func :: Ptr C'pci_dev -> Ptr CUChar
p'pci_dev'func Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr CUChar
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
12
p'pci_dev'func :: Ptr (C'pci_dev) -> Ptr (CUChar)
p'pci_dev'known_fields :: Ptr C'pci_dev -> Ptr CInt
p'pci_dev'known_fields Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
16
p'pci_dev'known_fields :: Ptr (C'pci_dev) -> Ptr (CInt)
c'PCI_FILL_EXT_CAPS :: a
p'pci_dev'vendor_id :: Ptr C'pci_dev -> Ptr CUShort
p'pci_dev'vendor_id Ptr C'pci_dev
p = plusPtr Ptr C'pci_dev
p Int
20
p'pci_dev'vendor_id :: Ptr (C'pci_dev) -> Ptr (CUShort)
p'pci_dev'device_id :: Ptr C'pci_dev -> Ptr CUShort
p'pci_dev'device_id Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr CUShort
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
22
p'pci_dev'device_id :: Ptr (C'pci_dev) -> Ptr (CUShort)
p'pci_dev'device_class :: Ptr C'pci_dev -> Ptr CUShort
p'pci_dev'device_class Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr CUShort
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
24
p'pci_dev'device_class :: Ptr (C'pci_dev) -> Ptr (CUShort)
p'pci_dev'irq :: Ptr C'pci_dev -> Ptr CInt
p'pci_dev'irq Ptr C'pci_dev
p = plusPtr p 28
p'pci_dev'irq :: Ptr (C'pci_dev) -> Ptr (CInt)
p'pci_dev'base_addr :: Ptr C'pci_dev -> Ptr CULong
p'pci_dev'base_addr Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr CULong
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
32
p'pci_dev'base_addr :: Ptr (C'pci_dev) -> Ptr (CULong)
p'pci_dev'size :: Ptr C'pci_dev -> Ptr CULong
p'pci_dev'size Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr CULong
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
80
p'pci_dev'size :: Ptr (C'pci_dev) -> Ptr (CULong)
p'pci_dev'rom_base_addr :: Ptr C'pci_dev -> Ptr CULong
p'pci_dev'rom_base_addr Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr CULong
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
128
p'pci_dev'rom_base_addr :: Ptr (C'pci_dev) -> Ptr (CULong)
p'pci_dev'rom_size :: Ptr C'pci_dev -> Ptr CULong
p'pci_dev'rom_size Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr CULong
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
136
p'pci_dev'rom_size :: Ptr (C'pci_dev) -> Ptr (CULong)
p'pci_dev'first_cap :: Ptr C'pci_dev -> Ptr (Ptr C'pci_cap)
p'pci_dev'first_cap Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr (Ptr C'pci_cap)
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
144
p'pci_dev'first_cap :: Ptr (C'pci_dev) -> Ptr (Ptr C'pci_cap)
p'pci_dev'phy_slot :: Ptr C'pci_dev -> Ptr CString
p'pci_dev'phy_slot Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
152
p'pci_dev'phy_slot :: Ptr (C'pci_dev) -> Ptr (CString)
p'pci_dev'module_alias :: Ptr C'pci_dev -> Ptr CString
p'pci_dev'module_alias Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
160
p'pci_dev'module_alias :: Ptr (C'pci_dev) -> Ptr (CString)
p'pci_dev'label :: Ptr C'pci_dev -> Ptr CString
p'pci_dev'label Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
168
p'pci_dev'label :: Ptr (C'pci_dev) -> Ptr (CString)
p'pci_dev'numa_node :: Ptr C'pci_dev -> Ptr CInt
p'pci_dev'numa_node Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
176
p'pci_dev'numa_node :: Ptr (C'pci_dev) -> Ptr (CInt)
p'pci_dev'flags :: Ptr C'pci_dev -> Ptr CULong
p'pci_dev'flags Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr CULong
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
184
p'pci_dev'flags :: Ptr (C'pci_dev) -> Ptr (CULong)
p'pci_dev'rom_flags :: Ptr C'pci_dev -> Ptr CULong
p'pci_dev'rom_flags Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr CULong
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
232
p'pci_dev'rom_flags :: Ptr (C'pci_dev) -> Ptr (CULong)
p'pci_dev'domain :: Ptr C'pci_dev -> Ptr CInt
p'pci_dev'domain Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
240
p'pci_dev'domain :: Ptr (C'pci_dev) -> Ptr (CInt)
p'pci_dev'access :: Ptr C'pci_dev -> Ptr (Ptr C'pci_access)
p'pci_dev'access Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr (Ptr C'pci_access)
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
248
p'pci_dev'access :: Ptr (C'pci_dev) -> Ptr (Ptr C'pci_access)
p'pci_dev'methods :: Ptr C'pci_dev -> Ptr (Ptr C'pci_methods)
p'pci_dev'methods Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr (Ptr C'pci_methods)
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
256
p'pci_dev'methods :: Ptr (C'pci_dev) -> Ptr (Ptr C'pci_methods)
p'pci_dev'cache :: Ptr C'pci_dev -> Ptr (Ptr CUChar)
p'pci_dev'cache Ptr C'pci_dev
p = Ptr C'pci_dev -> Int -> Ptr (Ptr CUChar)
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'pci_dev
p Int
264
p'pci_dev'cache :: Ptr (C'pci_dev) -> Ptr (Ptr CUChar)
p'pci_dev'cache_len :: Ptr C'pci_dev -> Ptr CInt
p'pci_dev'cache_len Ptr C'pci_dev
p = plusPtr p 272
p'pci_dev'cache_len :: Ptr (C'pci_dev) -> Ptr (CInt)
p'pci_dev'hdrtype :: Ptr C'pci_dev -> Ptr CInt
p'pci_dev'hdrtype Ptr C'pci_dev
p = plusPtr Ptr C'pci_dev
p Int
276
p'pci_dev'hdrtype :: Ptr (C'pci_dev) -> Ptr (CInt)
p'pci_dev'aux :: Ptr C'pci_dev -> Ptr (Ptr ())
p'pci_dev'aux Ptr C'pci_dev
p = plusPtr p Int
280
p'pci_dev'aux :: Ptr (C'pci_dev) -> Ptr (Ptr ())
instance Storable C'pci_dev where
  sizeOf _ = 304
  alignment _ = 8
  peek _p = do
    v0 <- peekByteOff _p 0
    v1 <- peekByteOff _p 8
    v2 <- peekByteOff _p 10
    v3 <- peekByteOff _p 11
    v4 <- peekByteOff _p 12
    v5 <- peekByteOff _p 16
    v6 <- peekByteOff _p 20
    v7 <- peekByteOff _p 22
    v8 <- peekByteOff _p 24
    v9 <- peekByteOff _p 28
    v10 <- let s10 = div 48 $ sizeOf $ (undefined :: CULong) in peekArray s10 (plusPtr _p 32)
    v11 <- let s11 = div 48 $ sizeOf $ (undefined :: CULong) in peekArray s11 (plusPtr _p 80)
    v12 <- peekByteOff _p 128
    v13 <- peekByteOff _p 136
    v14 <- peekByteOff _p 144
    v15 <- peekByteOff _p 152
    v16 <- peekByteOff _p 160
    v17 <- peekByteOff _p 168
    v18 <- peekByteOff _p 176
    v19 <- let s19 = div 48 $ sizeOf $ (undefined :: CULong) in peekArray s19 (plusPtr _p 184)
    v20 <- peekByteOff _p 232
    v21 <- peekByteOff _p 240
    v22 <- peekByteOff _p 248
    v23 <- peekByteOff _p 256
    v24 <- peekByteOff _p 264
    v25 <- peekByteOff _p 272
    v26 <- peekByteOff _p 276
    v27 <- peekByteOff _p 280
    return $ C'pci_dev v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16 v17 v18 v19 v20 v21 v22 v23 v24 v25 v26 v27
  poke :: Ptr C'pci_dev -> C'pci_dev -> IO ()
poke Ptr C'pci_dev
_p (C'pci_dev v0 v1 CUChar
v2 CUChar
v3 CUChar
v4 CInt
v5 CUShort
v6 CUShort
v7 CUShort
v8 CInt
v9 [CULong]
v10 [CULong]
v11 CULong
v12 CULong
v13 Ptr C'pci_cap
v14 CString
v15 CString
v16 CString
v17 CInt
v18 [CULong]
v19 CULong
v20 CInt
v21 Ptr C'pci_access
v22 Ptr C'pci_methods
v23 Ptr CUChar
v24 CInt
v25 CInt
v26 Ptr ()
v27) = do
    Ptr C'pci_dev -> Int -> Ptr C'pci_dev -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_dev
_p Int
0 Ptr C'pci_dev
v0
    Ptr C'pci_dev -> Int -> CUShort -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_dev
_p Int
8 CUShort
v1
    pokeByteOff _p 10 v2
    pokeByteOff _p 11 v3
    pokeByteOff _p 12 v4
    pokeByteOff _p 16 v5
    pokeByteOff _p 20 v6
    pokeByteOff _p 22 v7
    pokeByteOff _p 24 v8
    pokeByteOff _p 28 v9
    let s10 = div 48 $ sizeOf $ (undefined :: CULong)
    pokeArray (plusPtr _p 32) (take s10 v10)
    let s11 = div 48 $ sizeOf $ (undefined :: CULong)
    pokeArray (plusPtr _p 80) (take s11 v11)
    pokeByteOff _p 128 v12
    pokeByteOff _p 136 v13
    pokeByteOff _p 144 v14
    pokeByteOff _p 152 v15
    Ptr C'pci_dev -> Int -> CString -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_dev
_p Int
160 CString
v16
    Ptr C'pci_dev -> Int -> CString -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_dev
_p Int
168 CString
v17
    Ptr C'pci_dev -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'pci_dev
_p Int
176 CInt
v18
    let s19 = div 48 $ sizeOf $ (undefined :: CULong)
    pokeArray (plusPtr _p 184) (take s19 v19)
    pokeByteOff _p 232 v20
    pokeByteOff _p 240 v21
    pokeByteOff _p 248 v22
    pokeByteOff _p 256 v23
    pokeByteOff _p 264 v24
    pokeByteOff _p 272 v25
    pokeByteOff _p 276 v26
    pokeByteOff _p 280 v27
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 351 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Access to configuration space
foreign import ccall "pci_read_byte" c'pci_read_byte
  :: Ptr C'pci_dev -> CInt -> IO CUChar
foreign import ccall "&pci_read_byte" p'pci_read_byte
  :: FunPtr (Ptr C'pci_dev -> CInt -> IO CUChar)

{-# LINE 354 "src/Bindings/Libpci/Pci.hsc" #-}
foreign import ccall "pci_read_word" c'pci_read_word
  :: Ptr C'pci_dev -> CInt -> IO CUShort
foreign import ccall "&pci_read_word" p'pci_read_word
  :: FunPtr (Ptr C'pci_dev -> CInt -> IO CUShort)

{-# LINE 355 "src/Bindings/Libpci/Pci.hsc" #-}
foreign import ccall "pci_read_long" c'pci_read_long
  :: Ptr C'pci_dev -> CInt -> IO CUInt
foreign import ccall "&pci_read_long" p'pci_read_long
  :: FunPtr (Ptr C'pci_dev -> CInt -> IO CUInt)

{-# LINE 356 "src/Bindings/Libpci/Pci.hsc" #-}
foreign import ccall "pci_read_block" c'pci_read_block
  :: Ptr C'pci_dev -> CInt -> Ptr CUChar -> CInt -> IO CInt
foreign import ccall "&pci_read_block" p'pci_read_block
  :: FunPtr (Ptr C'pci_dev -> CInt -> Ptr CUChar -> CInt -> IO CInt)

{-# LINE 357 "src/Bindings/Libpci/Pci.hsc" #-}
foreign import ccall "pci_read_vpd" c'pci_read_vpd
  :: Ptr C'pci_dev -> CInt -> Ptr CUChar -> CInt -> IO CInt
foreign import ccall "&pci_read_vpd" p'pci_read_vpd
  :: FunPtr (Ptr C'pci_dev -> CInt -> Ptr CUChar -> CInt -> IO CInt)

{-# LINE 358 "src/Bindings/Libpci/Pci.hsc" #-}
foreign import ccall "pci_write_byte" c'pci_write_byte
  :: Ptr C'pci_dev -> CInt -> CUChar -> IO CInt
foreign import ccall "&pci_write_byte" p'pci_write_byte
  :: FunPtr (Ptr C'pci_dev -> CInt -> CUChar -> IO CInt)

{-# LINE 359 "src/Bindings/Libpci/Pci.hsc" #-}
foreign import ccall "pci_write_word" c'pci_write_word
  :: Ptr C'pci_dev -> CInt -> CUShort -> IO CInt
foreign import ccall "&pci_write_word" p'pci_write_word
  :: FunPtr (Ptr C'pci_dev -> CInt -> CUShort -> IO CInt)

{-# LINE 360 "src/Bindings/Libpci/Pci.hsc" #-}
foreign import ccall "pci_write_long" c'pci_write_long
  :: Ptr C'pci_dev -> CInt -> CUInt -> IO CInt
foreign import ccall "&pci_write_long" p'pci_write_long
  :: FunPtr (Ptr C'pci_dev -> CInt -> CUInt -> IO CInt)

{-# LINE 361 "src/Bindings/Libpci/Pci.hsc" #-}
foreign import ccall "pci_write_block" c'pci_write_block
  :: Ptr C'pci_dev -> CInt -> Ptr CUChar -> CInt -> IO CInt
foreign import ccall "&pci_write_block" p'pci_write_block
  :: FunPtr (Ptr C'pci_dev -> CInt -> Ptr CUChar -> CInt -> IO CInt)

{-# LINE 362 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Most device properties take some effort to obtain, so libpci does not
-- initialize them during default bus scan. Instead, you have to call
-- pci_fill_info() with the proper PCI_FILL_xxx constants OR'ed together.
-- 
-- Some properties are stored directly in the pci_dev structure.
-- The remaining ones can be accessed through pci_get_string_property().
--
-- pci_fill_info() returns the current value of pci_dev->known_fields.
-- This is a bit mask of all fields, which were already obtained during
-- the lifetime of the device. This includes fields which are not supported
-- by the particular device -- in that case, the field is left at its default
-- value, which is 0 for integer fields and NULL for pointers. On the other
-- hand, we never consider known fields unsupported by the current back-end;
-- such fields always contain the default value.
--
-- XXX: flags and the result should be unsigned, but we do not want to break the ABI.
foreign import ccall "pci_fill_info" c'pci_fill_info
  :: Ptr C'pci_dev -> CInt -> IO CInt
foreign import ccall "&pci_fill_info" p'pci_fill_info
  :: FunPtr (Ptr C'pci_dev -> CInt -> IO CInt)

{-# LINE 380 "src/Bindings/Libpci/Pci.hsc" #-}


{-# LINE 384 "src/Bindings/Libpci/Pci.hsc" #-}

c'PCI_FILL_IDENT = 1
c'PCI_FILL_IDENT :: (Num a) => a

{-# LINE 386 "src/Bindings/Libpci/Pci.hsc" #-}
c'PCI_FILL_IRQ = 2
c'PCI_FILL_IRQ :: (Num a) => a

{-# LINE 387 "src/Bindings/Libpci/Pci.hsc" #-}
c'PCI_FILL_BASES = 4
c'PCI_FILL_BASES :: (Num a) => a

{-# LINE 388 "src/Bindings/Libpci/Pci.hsc" #-}
c'PCI_FILL_ROM_BASE = 8
c'PCI_FILL_ROM_BASE :: (Num a) => a

{-# LINE 389 "src/Bindings/Libpci/Pci.hsc" #-}
c'PCI_FILL_SIZES = 16
c'PCI_FILL_SIZES :: (Num a) => a

{-# LINE 390 "src/Bindings/Libpci/Pci.hsc" #-}
c'PCI_FILL_CLASS = 32
c'PCI_FILL_CLASS :: (Num a) => a

{-# LINE 391 "src/Bindings/Libpci/Pci.hsc" #-}
c'PCI_FILL_CAPS = 64
c'PCI_FILL_CAPS :: (Num a) => a

{-# LINE 392 "src/Bindings/Libpci/Pci.hsc" #-}
c'PCI_FILL_EXT_CAPS = 128
c'PCI_FILL_EXT_CAPS :: (Num a) => a

{-# LINE 393 "src/Bindings/Libpci/Pci.hsc" #-}
c'PCI_FILL_PHYS_SLOT = 256
c'PCI_FILL_PHYS_SLOT :: (Num a) => a

{-# LINE 394 "src/Bindings/Libpci/Pci.hsc" #-}
c'PCI_FILL_MODULE_ALIAS = 512
c'PCI_FILL_MODULE_ALIAS :: (Num a) => a

{-# LINE 395 "src/Bindings/Libpci/Pci.hsc" #-}
c'PCI_FILL_LABEL = 1024
c'PCI_FILL_LABEL :: (Num a) => a

{-# LINE 396 "src/Bindings/Libpci/Pci.hsc" #-}
c'PCI_FILL_NUMA_NODE = 2048
c'PCI_FILL_NUMA_NODE :: (Num a) => a

{-# LINE 397 "src/Bindings/Libpci/Pci.hsc" #-}
c'PCI_FILL_IO_FLAGS = 4096
c'PCI_FILL_IO_FLAGS :: (Num a) => a

{-# LINE 398 "src/Bindings/Libpci/Pci.hsc" #-}


{-# LINE 403 "src/Bindings/Libpci/Pci.hsc" #-}


{-# LINE 407 "src/Bindings/Libpci/Pci.hsc" #-}

c'PCI_FILL_RESCAN = 65536
c'PCI_FILL_RESCAN :: (Num a) => a

{-# LINE 409 "src/Bindings/Libpci/Pci.hsc" #-}

foreign import ccall "pci_setup_cache" c'pci_setup_cache
  :: Ptr C'pci_dev -> Ptr CUChar -> CInt -> IO ()
foreign import ccall "&pci_setup_cache" p'pci_setup_cache
  :: FunPtr (Ptr C'pci_dev -> Ptr CUChar -> CInt -> IO ())

{-# LINE 411 "src/Bindings/Libpci/Pci.hsc" #-}
{- struct pci_cap {
    struct pci_cap * next; u16 id; u16 type; unsigned int addr;
}; -}
-- | Capabilities

{-# LINE 416 "src/Bindings/Libpci/Pci.hsc" #-}

{-# LINE 417 "src/Bindings/Libpci/Pci.hsc" #-}

-- | PCI_CAP_ID_xxx

{-# LINE 420 "src/Bindings/Libpci/Pci.hsc" #-}

-- | PCI_CAP_xxx

{-# LINE 423 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Position in the config space

{-# LINE 426 "src/Bindings/Libpci/Pci.hsc" #-}
data C'pci_cap = C'pci_cap{
  c'pci_cap'next :: Ptr C'pci_cap,
  c'pci_cap'id :: CUShort,
  c'pci_cap'type :: CUShort,
  c'pci_cap'addr :: CUInt
} deriving (Eq,Show)
p'pci_cap'next p = plusPtr p 0
p'pci_cap'next :: Ptr (C'pci_cap) -> Ptr (Ptr C'pci_cap)
p'pci_cap'id p = plusPtr p 8
p'pci_cap'id :: Ptr (C'pci_cap) -> Ptr (CUShort)
p'pci_cap'type p = plusPtr p 10
p'pci_cap'type :: Ptr (C'pci_cap) -> Ptr (CUShort)
p'pci_cap'addr p = plusPtr p 12
p'pci_cap'addr :: Ptr (C'pci_cap) -> Ptr (CUInt)
instance Storable C'pci_cap where
  sizeOf _ = 16
  alignment _ = 8
  peek _p = do
    v0 <- peekByteOff _p 0
    v1 <- peekByteOff _p 8
    v2 <- peekByteOff _p 10
    v3 <- peekByteOff _p 12
    return $ C'pci_cap v0 v1 v2 v3
  poke _p (C'pci_cap v0 v1 v2 v3) = do
    pokeByteOff _p 0 v0
    pokeByteOff _p 8 v1
    pokeByteOff _p 10 v2
    pokeByteOff _p 12 v3
    return ()

{-# LINE 427 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Traditional PCI capabilities
c'PCI_CAP_NORMAL = 1
c'PCI_CAP_NORMAL :: (Num a) => a

{-# LINE 430 "src/Bindings/Libpci/Pci.hsc" #-}

-- | PCIe extended capabilities
c'PCI_CAP_EXTENDED = 2
c'PCI_CAP_EXTENDED :: (Num a) => a

{-# LINE 433 "src/Bindings/Libpci/Pci.hsc" #-}

foreign import ccall "pci_find_cap" c'pci_find_cap
  :: Ptr C'pci_dev -> CUInt -> CUInt -> IO (Ptr C'pci_cap)
foreign import ccall "&pci_find_cap" p'pci_find_cap
  :: FunPtr (Ptr C'pci_dev -> CUInt -> CUInt -> IO (Ptr C'pci_cap))

{-# LINE 435 "src/Bindings/Libpci/Pci.hsc" #-}


{-# LINE 439 "src/Bindings/Libpci/Pci.hsc" #-}
{- struct pci_filter {
    int domain, bus, slot, func;
    int vendor, device, device_class;
    int rfu[3];
}; -}
-- | Filters

{-# LINE 446 "src/Bindings/Libpci/Pci.hsc" #-}

-- | -1 = ANY

{-# LINE 449 "src/Bindings/Libpci/Pci.hsc" #-}

-- | -1 = ANY

{-# LINE 452 "src/Bindings/Libpci/Pci.hsc" #-}

-- | -1 = ANY

{-# LINE 455 "src/Bindings/Libpci/Pci.hsc" #-}

-- | -1 = ANY

{-# LINE 458 "src/Bindings/Libpci/Pci.hsc" #-}

{-# LINE 459 "src/Bindings/Libpci/Pci.hsc" #-}

{-# LINE 460 "src/Bindings/Libpci/Pci.hsc" #-}

{-# LINE 461 "src/Bindings/Libpci/Pci.hsc" #-}

{-# LINE 462 "src/Bindings/Libpci/Pci.hsc" #-}
data C'pci_filter = C'pci_filter{
  c'pci_filter'domain :: CInt,
  c'pci_filter'bus :: CInt,
  c'pci_filter'slot :: CInt,
  c'pci_filter'func :: CInt,
  c'pci_filter'vendor :: CInt,
  c'pci_filter'device :: CInt,
  c'pci_filter'device_class :: CInt,
  c'pci_filter'rfu :: [CInt]
} deriving (Eq,Show)
p'pci_filter'domain p = plusPtr p 0
p'pci_filter'domain :: Ptr (C'pci_filter) -> Ptr (CInt)
p'pci_filter'bus p = plusPtr p 4
p'pci_filter'bus :: Ptr (C'pci_filter) -> Ptr (CInt)
p'pci_filter'slot p = plusPtr p 8
p'pci_filter'slot :: Ptr (C'pci_filter) -> Ptr (CInt)
p'pci_filter'func p = plusPtr p 12
p'pci_filter'func :: Ptr (C'pci_filter) -> Ptr (CInt)
p'pci_filter'vendor p = plusPtr p 16
p'pci_filter'vendor :: Ptr (C'pci_filter) -> Ptr (CInt)
p'pci_filter'device p = plusPtr p 20
p'pci_filter'device :: Ptr (C'pci_filter) -> Ptr (CInt)
p'pci_filter'device_class p = plusPtr p 24
p'pci_filter'device_class :: Ptr (C'pci_filter) -> Ptr (CInt)
p'pci_filter'rfu p = plusPtr p 28
p'pci_filter'rfu :: Ptr (C'pci_filter) -> Ptr (CInt)
instance Storable C'pci_filter where
  sizeOf _ = 40
  alignment _ = 4
  peek _p = do
    v0 <- peekByteOff _p 0
    v1 <- peekByteOff _p 4
    v2 <- peekByteOff _p 8
    v3 <- peekByteOff _p 12
    v4 <- peekByteOff _p 16
    v5 <- peekByteOff _p 20
    v6 <- peekByteOff _p 24
    v7 <- let s7 = div 12 $ sizeOf $ (undefined :: CInt) in peekArray s7 (plusPtr _p 28)
    return $ C'pci_filter v0 v1 v2 v3 v4 v5 v6 v7
  poke _p (C'pci_filter v0 v1 v2 v3 v4 v5 v6 v7) = do
    pokeByteOff _p 0 v0
    pokeByteOff _p 4 v1
    pokeByteOff _p 8 v2
    pokeByteOff _p 12 v3
    pokeByteOff _p 16 v4
    pokeByteOff _p 20 v5
    pokeByteOff _p 24 v6
    let s7 = div 12 $ sizeOf $ (undefined :: CInt)
    pokeArray (plusPtr _p 28) (take s7 v7)
    return ()

{-# LINE 463 "src/Bindings/Libpci/Pci.hsc" #-}
foreign import ccall "pci_filter_init" c'pci_filter_init
  :: Ptr C'pci_access -> Ptr C'pci_filter -> IO ()
foreign import ccall "&pci_filter_init" p'pci_filter_init
  :: FunPtr (Ptr C'pci_access -> Ptr C'pci_filter -> IO ())

{-# LINE 464 "src/Bindings/Libpci/Pci.hsc" #-}
foreign import ccall "pci_filter_parse_slot" c'pci_filter_parse_slot
  :: Ptr C'pci_filter -> CString -> IO CString
foreign import ccall "&pci_filter_parse_slot" p'pci_filter_parse_slot
  :: FunPtr (Ptr C'pci_filter -> CString -> IO CString)

{-# LINE 465 "src/Bindings/Libpci/Pci.hsc" #-}
foreign import ccall "pci_filter_parse_id" c'pci_filter_parse_id
  :: Ptr C'pci_filter -> CString -> IO CString
foreign import ccall "&pci_filter_parse_id" p'pci_filter_parse_id
  :: FunPtr (Ptr C'pci_filter -> CString -> IO CString)

{-# LINE 466 "src/Bindings/Libpci/Pci.hsc" #-}
foreign import ccall "pci_filter_match" c'pci_filter_match
  :: Ptr C'pci_filter -> Ptr C'pci_dev -> IO CInt
foreign import ccall "&pci_filter_match" p'pci_filter_match
  :: FunPtr (Ptr C'pci_filter -> Ptr C'pci_dev -> IO CInt)

{-# LINE 467 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Conversion of PCI ID's to names (according to the pci.ids file)
-- Call pci_lookup_name() to identify different types of ID's:
-- VENDOR(vendorID) -> vendor
-- DEVICE(vendorID, deviceID) -> device
-- VENDOR | DEVICE(vendorID, deviceID) -> combined vendor and device
-- SUBSYSTEM | VENDOR(subvendorID) -> subsystem vendor
-- SUBSYSTEM | DEVICE(vendorID, deviceID, subvendorID, subdevID) -> subsystem device
-- SUBSYSTEM | VENDOR | DEVICE(vendorID, deviceID, subvendorID, subdevID) -> combined subsystem v+d
-- SUBSYSTEM | ...(-1, -1, subvendorID, subdevID) -> generic subsystem
-- CLASS(classID) -> class
-- PROGIF(classID, progif) -> programming interface
foreign import ccall "pci_lookup_name" c'pci_lookup_name
  :: Ptr C'pci_access -> CString -> CInt -> CUInt -> CInt -> CInt -> CInt -> CInt -> IO CString
foreign import ccall "&pci_lookup_name" p'pci_lookup_name
  :: FunPtr (Ptr C'pci_access -> CString -> CInt -> CUInt -> CInt -> CInt -> CInt -> CInt -> IO CString)

{-# LINE 480 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Called automatically by pci_lookup_*() when needed; returns success
foreign import ccall "pci_load_name_list" c'pci_load_name_list
  :: Ptr C'pci_access -> IO CInt
foreign import ccall "&pci_load_name_list" p'pci_load_name_list
  :: FunPtr (Ptr C'pci_access -> IO CInt)

{-# LINE 483 "src/Bindings/Libpci/Pci.hsc" #-}

-- | Called automatically by pci_cleanup
foreign import ccall "pci_free_name_list" c'pci_free_name_list
  :: Ptr C'pci_access -> IO ()
foreign import ccall "&pci_free_name_list" p'pci_free_name_list
  :: FunPtr (Ptr C'pci_access -> IO ())

{-# LINE 486 "src/Bindings/Libpci/Pci.hsc" #-}
foreign import ccall "pci_set_name_list_path" c'pci_set_name_list_path
  :: Ptr C'pci_access -> CString -> CInt -> IO ()
foreign import ccall "&pci_set_name_list_path" p'pci_set_name_list_path
  :: FunPtr (Ptr C'pci_access -> CString -> CInt -> IO ())

{-# LINE 487 "src/Bindings/Libpci/Pci.hsc" #-}
foreign import ccall "pci_id_cache_flush" c'pci_id_cache_flush
  :: Ptr C'pci_access -> IO ()
foreign import ccall "&pci_id_cache_flush" p'pci_id_cache_flush
  :: FunPtr (Ptr C'pci_access -> IO ())

{-# LINE 488 "src/Bindings/Libpci/Pci.hsc" #-}
{- enum pci_lookup_mode {
    PCI_LOOKUP_VENDOR = 1,
    PCI_LOOKUP_DEVICE = 2,
    PCI_LOOKUP_CLASS = 4,
    PCI_LOOKUP_SUBSYSTEM = 8,
    PCI_LOOKUP_PROGIF = 16,
    PCI_LOOKUP_NUMERIC = 0x10000,
    PCI_LOOKUP_NO_NUMBERS = 0x20000,
    PCI_LOOKUP_MIXED = 0x40000,
    PCI_LOOKUP_NETWORK = 0x80000,
    PCI_LOOKUP_SKIP_LOCAL = 0x100000,
    PCI_LOOKUP_CACHE = 0x200000,
    PCI_LOOKUP_REFRESH_CACHE = 0x400000,
    PCI_LOOKUP_NO_HWDB = 0x800000
}; -}
type C'pci_lookup_mode = CUInt

{-# LINE 504 "src/Bindings/Libpci/Pci.hsc" #-}

-- | 1 Vendor name (args: vendorID)
c'PCI_LOOKUP_VENDOR = 1
c'PCI_LOOKUP_VENDOR :: (Num a) => a

{-# LINE 507 "src/Bindings/Libpci/Pci.hsc" #-}

-- | 2 Device name (args: vendorID, deviceID)
c'PCI_LOOKUP_DEVICE = 2
c'PCI_LOOKUP_DEVICE :: (Num a) => a

{-# LINE 510 "src/Bindings/Libpci/Pci.hsc" #-}

-- | 4 Device class (args: classID)
c'PCI_LOOKUP_CLASS = 4
c'PCI_LOOKUP_CLASS :: (Num a) => a

{-# LINE 513 "src/Bindings/Libpci/Pci.hsc" #-}

-- | 8
c'PCI_LOOKUP_SUBSYSTEM = 8
c'PCI_LOOKUP_SUBSYSTEM :: (Num a) => a

{-# LINE 516 "src/Bindings/Libpci/Pci.hsc" #-}

-- | 16 Programming interface (args: classID, prog_if)
c'PCI_LOOKUP_PROGIF = 16
c'PCI_LOOKUP_PROGIF :: (Num a) => a

{-# LINE 519 "src/Bindings/Libpci/Pci.hsc" #-}

-- | 0x10000 Want only formatted numbers; default if access->numeric_id is set
c'PCI_LOOKUP_NUMERIC = 65536
c'PCI_LOOKUP_NUMERIC :: (Num a) => a

{-# LINE 522 "src/Bindings/Libpci/Pci.hsc" #-}

-- | 0x20000 Return NULL if not found in the database; default is to print numerically
c'PCI_LOOKUP_NO_NUMBERS = 131072
c'PCI_LOOKUP_NO_NUMBERS :: (Num a) => a

{-# LINE 525 "src/Bindings/Libpci/Pci.hsc" #-}

-- | 0x40000 Include both numbers and names
c'PCI_LOOKUP_MIXED = 262144
c'PCI_LOOKUP_MIXED :: (Num a) => a

{-# LINE 528 "src/Bindings/Libpci/Pci.hsc" #-}

-- | 0x80000 Try to resolve unknown ID's by DNS
c'PCI_LOOKUP_NETWORK = 524288
c'PCI_LOOKUP_NETWORK :: (Num a) => a

{-# LINE 531 "src/Bindings/Libpci/Pci.hsc" #-}

-- | 0x100000 Do not consult local database
c'PCI_LOOKUP_SKIP_LOCAL = 1048576
c'PCI_LOOKUP_SKIP_LOCAL :: (Num a) => a

{-# LINE 534 "src/Bindings/Libpci/Pci.hsc" #-}

-- | 0x200000 Consult the local cache before using DNS
c'PCI_LOOKUP_CACHE = 2097152
c'PCI_LOOKUP_CACHE :: (Num a) => a

{-# LINE 537 "src/Bindings/Libpci/Pci.hsc" #-}

-- | 0x400000 Forget all previously cached entries, but still allow updating the cache
c'PCI_LOOKUP_REFRESH_CACHE = 4194304
c'PCI_LOOKUP_REFRESH_CACHE :: (Num a) => a

{-# LINE 540 "src/Bindings/Libpci/Pci.hsc" #-}

-- | 0x800000 Do not ask udev's hwdb
c'PCI_LOOKUP_NO_HWDB = 8388608
c'PCI_LOOKUP_NO_HWDB :: (Num a) => a

{-# LINE 543 "src/Bindings/Libpci/Pci.hsc" #-}