{-# LINE 1 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}

{-# LINE 2 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}

{-# LINE 3 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}

-- | <http://library.gnome.org/devel/glib/stable/glib-Memory-Allocation.html>

module Bindings.GLib.CoreApplicationSupport.MemoryAllocation where
import Bindings.GLib.Fundamentals.BasicTypes
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 9 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}

foreign import ccall "g_malloc" c'g_malloc
  :: C'gsize -> IO C'gpointer
foreign import ccall "&g_malloc" p'g_malloc
  :: FunPtr (C'gsize -> IO C'gpointer)

{-# LINE 11 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}
foreign import ccall "g_malloc0" c'g_malloc0
  :: C'gsize -> IO C'gpointer
foreign import ccall "&g_malloc0" p'g_malloc0
  :: FunPtr (C'gsize -> IO C'gpointer)

{-# LINE 12 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}
foreign import ccall "g_realloc" c'g_realloc
  :: C'gpointer -> C'gsize -> IO C'gpointer
foreign import ccall "&g_realloc" p'g_realloc
  :: FunPtr (C'gpointer -> C'gsize -> IO C'gpointer)

{-# LINE 13 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}
foreign import ccall "g_try_malloc" c'g_try_malloc
  :: C'gsize -> IO C'gpointer
foreign import ccall "&g_try_malloc" p'g_try_malloc
  :: FunPtr (C'gsize -> IO C'gpointer)

{-# LINE 14 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}
foreign import ccall "g_try_malloc0" c'g_try_malloc0
  :: C'gsize -> IO C'gpointer
foreign import ccall "&g_try_malloc0" p'g_try_malloc0
  :: FunPtr (C'gsize -> IO C'gpointer)

{-# LINE 15 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}
foreign import ccall "g_try_realloc" c'g_try_realloc
  :: C'gpointer -> C'gsize -> IO C'gpointer
foreign import ccall "&g_try_realloc" p'g_try_realloc
  :: FunPtr (C'gpointer -> C'gsize -> IO C'gpointer)

{-# LINE 16 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}
foreign import ccall "g_free" c'g_free
  :: C'gpointer -> IO ()
foreign import ccall "&g_free" p'g_free
  :: FunPtr (C'gpointer -> IO ())

{-# LINE 17 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}
foreign import ccall "&g_mem_gc_friendly" p'g_mem_gc_friendly
  :: Ptr (C'gboolean)

{-# LINE 18 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}

foreign import ccall "g_memdup" c'g_memdup
  :: C'gconstpointer -> C'guint -> IO C'gpointer
foreign import ccall "&g_memdup" p'g_memdup
  :: FunPtr (C'gconstpointer -> C'guint -> IO C'gpointer)

{-# LINE 20 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}

data C'GMemVTable = C'GMemVTable{
{-# LINE 22 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}

  c'GMemVTable'malloc :: FunPtr (C'gsize -> IO C'gpointer)
{-# LINE 23 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}
,
  c'GMemVTable'realloc :: FunPtr (C'gpointer -> C'gsize -> IO C'gpointer)
{-# LINE 24 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}
,
  c'GMemVTable'free :: FunPtr (C'gpointer -> IO ())
{-# LINE 25 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}
,
  c'GMemVTable'calloc :: FunPtr (C'gsize -> C'gsize -> IO C'gpointer)
{-# LINE 26 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}
,
  c'GMemVTable'try_malloc :: FunPtr (C'gsize -> IO C'gpointer)
{-# LINE 27 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}
,
  c'GMemVTable'try_realloc :: FunPtr (C'gpointer -> C'gsize -> IO C'gpointer)
{-# LINE 28 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}

 } deriving (Eq,Show)
instance Storable C'GMemVTable where
  sizeOf _ = 24
  alignment = sizeOf
  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
    return $ C'GMemVTable v0 v1 v2 v3 v4 v5
  poke p (C'GMemVTable v0 v1 v2 v3 v4 v5) = 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
    return ()

{-# LINE 29 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}

foreign import ccall "g_mem_set_vtable" c'g_mem_set_vtable
  :: Ptr C'GMemVTable -> IO ()
foreign import ccall "&g_mem_set_vtable" p'g_mem_set_vtable
  :: FunPtr (Ptr C'GMemVTable -> IO ())

{-# LINE 31 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}
foreign import ccall "g_mem_is_system_malloc" c'g_mem_is_system_malloc
  :: IO C'gboolean
foreign import ccall "&g_mem_is_system_malloc" p'g_mem_is_system_malloc
  :: FunPtr (IO C'gboolean)

{-# LINE 32 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}

foreign import ccall "&glib_mem_profiler_table" p'glib_mem_profiler_table
  :: Ptr (Ptr C'GMemVTable)

{-# LINE 34 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}
foreign import ccall "g_mem_profile" c'g_mem_profile
  :: IO ()
foreign import ccall "&g_mem_profile" p'g_mem_profile
  :: FunPtr (IO ())

{-# LINE 35 "src/Bindings/GLib/CoreApplicationSupport/MemoryAllocation.hsc" #-}