{-# INCLUDE <bindings.macros.h> #-}
{-# INCLUDE <sys/utsname.h> #-}
{-# LINE 1 "src/Bindings/Posix/Sys/Utsname.hsc" #-}

{-# LINE 2 "src/Bindings/Posix/Sys/Utsname.hsc" #-}

{-# LINE 3 "src/Bindings/Posix/Sys/Utsname.hsc" #-}

-- | <http://www.opengroup.org/onlinepubs/9699919799/basedefs/sys_utsname.h.html>

module Bindings.Posix.Sys.Utsname where
import Foreign
import Foreign.C


{-# LINE 11 "src/Bindings/Posix/Sys/Utsname.hsc" #-}

{-# LINE 12 "src/Bindings/Posix/Sys/Utsname.hsc" #-}

{-# LINE 13 "src/Bindings/Posix/Sys/Utsname.hsc" #-}

{-# LINE 14 "src/Bindings/Posix/Sys/Utsname.hsc" #-}

{-# LINE 15 "src/Bindings/Posix/Sys/Utsname.hsc" #-}

{-# LINE 16 "src/Bindings/Posix/Sys/Utsname.hsc" #-}
data C'utsname = C'utsname {utsname'sysname :: CString , utsname'nodename :: CString , utsname'release :: CString , utsname'version :: CString , utsname'machine :: CString}
instance Storable C'utsname where
 sizeOf _ = 390
 alignment = sizeOf
 peek p = do
  v0 <- peekByteOff p 0
  v1 <- peekByteOff p 65
  v2 <- peekByteOff p 130
  v3 <- peekByteOff p 195
  v4 <- peekByteOff p 260
  return $ C'utsname v0 v1 v2 v3 v4
 poke p (C'utsname v0 v1 v2 v3 v4  ) = do
  pokeByteOff p 0 v0
  pokeByteOff p 65 v1
  pokeByteOff p 130 v2
  pokeByteOff p 195 v3
  pokeByteOff p 260 v4
  return ()

{-# LINE 17 "src/Bindings/Posix/Sys/Utsname.hsc" #-}

foreign import ccall "uname" c'uname :: Ptr  C'utsname  -> IO CInt
foreign import ccall "&uname" p'uname :: FunPtr (Ptr  C'utsname  -> IO CInt)

{-# LINE 19 "src/Bindings/Posix/Sys/Utsname.hsc" #-}