1 {-# OPTIONS -fno-implicit-prelude #-}
2 -----------------------------------------------------------------------------
4 -- Module : Foreign.Marshal.Alloc
5 -- Copyright : (c) The FFI task force 2001
6 -- License : BSD-style (see the file libraries/core/LICENSE)
8 -- Maintainer : ffi@haskell.org
9 -- Stability : provisional
10 -- Portability : portable
12 -- Marshalling support: basic routines for memory allocation
14 -----------------------------------------------------------------------------
16 module Foreign.Marshal.Alloc (
17 malloc, -- :: Storable a => IO (Ptr a)
18 mallocBytes, -- :: Int -> IO (Ptr a)
20 alloca, -- :: Storable a => (Ptr a -> IO b) -> IO b
21 allocaBytes, -- :: Int -> (Ptr a -> IO b) -> IO b
23 reallocBytes, -- :: Ptr a -> Int -> IO (Ptr a)
25 free -- :: Ptr a -> IO ()
29 import Foreign.Ptr ( Ptr, nullPtr )
30 import Foreign.C.TypesISO ( CSize )
31 import Foreign.Storable ( Storable(sizeOf) )
33 #ifdef __GLASGOW_HASKELL__
34 import GHC.Exception ( bracket )
46 -- allocate space for storable type
48 malloc :: Storable a => IO (Ptr a)
49 malloc = doMalloc undefined
51 doMalloc :: Storable a => a -> IO (Ptr a)
52 doMalloc dummy = mallocBytes (sizeOf dummy)
54 -- allocate given number of bytes of storage
56 mallocBytes :: Int -> IO (Ptr a)
57 mallocBytes size = failWhenNULL "malloc" (_malloc (fromIntegral size))
59 -- temporarily allocate space for a storable type
61 -- * the pointer passed as an argument to the function must *not* escape from
62 -- this function; in other words, in `alloca f' the allocated storage must
63 -- not be used after `f' returns
65 alloca :: Storable a => (Ptr a -> IO b) -> IO b
66 alloca = doAlloca undefined
68 doAlloca :: Storable a => a -> (Ptr a -> IO b) -> IO b
69 doAlloca dummy = allocaBytes (sizeOf dummy)
71 -- temporarily allocate the given number of bytes of storage
73 -- * the pointer passed as an argument to the function must *not* escape from
74 -- this function; in other words, in `allocaBytes n f' the allocated storage
75 -- must not be used after `f' returns
77 #ifdef __GLASGOW_HASKELL__
78 allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
79 allocaBytes (I# size) action = IO $ \ s ->
80 case newPinnedByteArray# size s of { (# s, mbarr# #) ->
81 case unsafeFreezeByteArray# mbarr# s of { (# s, barr# #) ->
82 let addr = Ptr (byteArrayContents# barr#) in
83 case action addr of { IO action ->
84 case action s of { (# s, r #) ->
85 case touch# barr# s of { s ->
89 allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
90 allocaBytes size = bracket (mallocBytes size) free
93 -- adjust a malloc'ed storage area to the given size
95 reallocBytes :: Ptr a -> Int -> IO (Ptr a)
96 reallocBytes ptr size =
97 failWhenNULL "realloc" (_realloc ptr (fromIntegral size))
99 -- free malloc'ed storage
101 free :: Ptr a -> IO ()
105 -- auxilliary routines
106 -- -------------------
108 -- asserts that the pointer returned from the action in the second argument is
111 failWhenNULL :: String -> IO (Ptr a) -> IO (Ptr a)
112 failWhenNULL name f = do
115 #ifdef __GLASGOW_HASKELL__
116 then ioException (IOError Nothing ResourceExhausted name
117 "out of memory" Nothing)
119 then ioError (userError (name++": out of memory"))
123 -- basic C routines needed for memory allocation
125 foreign import ccall unsafe "malloc" _malloc :: CSize -> IO (Ptr a)
126 foreign import ccall unsafe "realloc" _realloc :: Ptr a -> CSize -> IO (Ptr a)
127 foreign import ccall unsafe "free" _free :: Ptr a -> IO ()