1 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
2 -----------------------------------------------------------------------------
4 -- Module : Foreign.Marshal.Alloc
5 -- Copyright : (c) The FFI task force 2001
6 -- License : BSD-style (see the file libraries/base/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 -- * Memory allocation
18 -- ** Local allocation
19 alloca, -- :: Storable a => (Ptr a -> IO b) -> IO b
20 allocaBytes, -- :: Int -> (Ptr a -> IO b) -> IO b
22 -- ** Dynamic allocation
23 malloc, -- :: Storable a => IO (Ptr a)
24 mallocBytes, -- :: Int -> IO (Ptr a)
26 realloc, -- :: Storable b => Ptr a -> IO (Ptr b)
27 reallocBytes, -- :: Ptr a -> Int -> IO (Ptr a)
29 free, -- :: Ptr a -> IO ()
30 finalizerFree -- :: FinalizerPtr a
34 import Foreign.C.Types ( CSize )
35 import Foreign.Storable ( Storable(sizeOf,alignment) )
37 #ifndef __GLASGOW_HASKELL__
38 import Foreign.Ptr ( Ptr, nullPtr, FunPtr )
41 #ifdef __GLASGOW_HASKELL__
42 import Foreign.ForeignPtr ( FinalizerPtr )
43 import GHC.IO.Exception
49 #elif defined(__NHC__)
50 import NHC.FFI ( FinalizerPtr, CInt(..) )
53 import Control.Exception.Base ( bracket )
57 import Hugs.Prelude ( IOException(IOError),
58 IOErrorType(ResourceExhausted) )
59 import Hugs.ForeignPtr ( FinalizerPtr )
66 -- |Allocate a block of memory that is sufficient to hold values of type
67 -- @a@. The size of the area allocated is determined by the 'sizeOf'
68 -- method from the instance of 'Storable' for the appropriate type.
70 -- The memory may be deallocated using 'free' or 'finalizerFree' when
71 -- no longer required.
74 malloc :: Storable a => IO (Ptr a)
75 malloc = doMalloc undefined
77 doMalloc :: Storable b => b -> IO (Ptr b)
78 doMalloc dummy = mallocBytes (sizeOf dummy)
80 -- |Allocate a block of memory of the given number of bytes.
81 -- The block of memory is sufficiently aligned for any of the basic
82 -- foreign types that fits into a memory block of the allocated size.
84 -- The memory may be deallocated using 'free' or 'finalizerFree' when
85 -- no longer required.
87 mallocBytes :: Int -> IO (Ptr a)
88 mallocBytes size = failWhenNULL "malloc" (_malloc (fromIntegral size))
90 -- |@'alloca' f@ executes the computation @f@, passing as argument
91 -- a pointer to a temporarily allocated block of memory sufficient to
92 -- hold values of type @a@.
94 -- The memory is freed when @f@ terminates (either normally or via an
95 -- exception), so the pointer passed to @f@ must /not/ be used after this.
98 alloca :: Storable a => (Ptr a -> IO b) -> IO b
99 alloca = doAlloca undefined
101 doAlloca :: Storable a' => a' -> (Ptr a' -> IO b') -> IO b'
102 doAlloca dummy = allocaBytesAligned (sizeOf dummy) (alignment dummy)
104 -- |@'allocaBytes' n f@ executes the computation @f@, passing as argument
105 -- a pointer to a temporarily allocated block of memory of @n@ bytes.
106 -- The block of memory is sufficiently aligned for any of the basic
107 -- foreign types that fits into a memory block of the allocated size.
109 -- The memory is freed when @f@ terminates (either normally or via an
110 -- exception), so the pointer passed to @f@ must /not/ be used after this.
112 #ifdef __GLASGOW_HASKELL__
113 allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
114 allocaBytes (I# size) action = IO $ \ s0 ->
115 case newPinnedByteArray# size s0 of { (# s1, mbarr# #) ->
116 case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr# #) ->
117 let addr = Ptr (byteArrayContents# barr#) in
118 case action addr of { IO action' ->
119 case action' s2 of { (# s3, r #) ->
120 case touch# barr# s3 of { s4 ->
124 allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b
125 allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 ->
126 case newAlignedPinnedByteArray# size align s0 of { (# s1, mbarr# #) ->
127 case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr# #) ->
128 let addr = Ptr (byteArrayContents# barr#) in
129 case action addr of { IO action' ->
130 case action' s2 of { (# s3, r #) ->
131 case touch# barr# s3 of { s4 ->
135 allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
136 allocaBytes size = bracket (mallocBytes size) free
138 allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b
139 allocaBytesAligned size align = allocaBytes size -- wrong
142 -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
143 -- to the size needed to store values of type @b@. The returned pointer
144 -- may refer to an entirely different memory area, but will be suitably
145 -- aligned to hold values of type @b@. The contents of the referenced
146 -- memory area will be the same as of the original pointer up to the
147 -- minimum of the original size and the size of values of type @b@.
149 -- If the argument to 'realloc' is 'nullPtr', 'realloc' behaves like
152 realloc :: Storable b => Ptr a -> IO (Ptr b)
153 realloc = doRealloc undefined
155 doRealloc :: Storable b' => b' -> Ptr a' -> IO (Ptr b')
156 doRealloc dummy ptr = let
157 size = fromIntegral (sizeOf dummy)
159 failWhenNULL "realloc" (_realloc ptr size)
161 -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
162 -- to the given size. The returned pointer may refer to an entirely
163 -- different memory area, but will be sufficiently aligned for any of the
164 -- basic foreign types that fits into a memory block of the given size.
165 -- The contents of the referenced memory area will be the same as of
166 -- the original pointer up to the minimum of the original size and the
169 -- If the pointer argument to 'reallocBytes' is 'nullPtr', 'reallocBytes'
170 -- behaves like 'malloc'. If the requested size is 0, 'reallocBytes'
171 -- behaves like 'free'.
173 reallocBytes :: Ptr a -> Int -> IO (Ptr a)
174 reallocBytes ptr 0 = do free ptr; return nullPtr
175 reallocBytes ptr size =
176 failWhenNULL "realloc" (_realloc ptr (fromIntegral size))
178 -- |Free a block of memory that was allocated with 'malloc',
179 -- 'mallocBytes', 'realloc', 'reallocBytes', 'Foreign.Marshal.Utils.new'
180 -- or any of the @new@/X/ functions in "Foreign.Marshal.Array" or
181 -- "Foreign.C.String".
183 free :: Ptr a -> IO ()
187 -- auxilliary routines
188 -- -------------------
190 -- asserts that the pointer returned from the action in the second argument is
193 failWhenNULL :: String -> IO (Ptr a) -> IO (Ptr a)
194 failWhenNULL name f = do
197 #if __GLASGOW_HASKELL__
198 then ioError (IOError Nothing ResourceExhausted name
199 "out of memory" Nothing Nothing)
201 then ioError (IOError Nothing ResourceExhausted name
202 "out of memory" Nothing)
204 then ioError (userError (name++": out of memory"))
208 -- basic C routines needed for memory allocation
210 foreign import ccall unsafe "stdlib.h malloc" _malloc :: CSize -> IO (Ptr a)
211 foreign import ccall unsafe "stdlib.h realloc" _realloc :: Ptr a -> CSize -> IO (Ptr b)
212 foreign import ccall unsafe "stdlib.h free" _free :: Ptr a -> IO ()
214 -- | A pointer to a foreign function equivalent to 'free', which may be
215 -- used as a finalizer (cf 'Foreign.ForeignPtr.ForeignPtr') for storage
216 -- allocated with 'malloc', 'mallocBytes', 'realloc' or 'reallocBytes'.
217 foreign import ccall unsafe "stdlib.h &free" finalizerFree :: FinalizerPtr a