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 )
44 import GHC.IO.Exception
50 #elif defined(__NHC__)
51 import NHC.FFI ( FinalizerPtr, CInt(..) )
54 import Control.Exception.Base ( bracket )
58 import Hugs.Prelude ( IOException(IOError),
59 IOErrorType(ResourceExhausted) )
60 import Hugs.ForeignPtr ( FinalizerPtr )
67 -- |Allocate a block of memory that is sufficient to hold values of type
68 -- @a@. The size of the area allocated is determined by the 'sizeOf'
69 -- method from the instance of 'Storable' for the appropriate type.
71 -- The memory may be deallocated using 'free' or 'finalizerFree' when
72 -- 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.
97 alloca :: Storable a => (Ptr a -> IO b) -> IO b
98 alloca = doAlloca undefined
100 doAlloca :: Storable a' => a' -> (Ptr a' -> IO b') -> IO b'
101 doAlloca dummy = allocaBytesAligned (sizeOf dummy) (alignment dummy)
103 -- |@'allocaBytes' n f@ executes the computation @f@, passing as argument
104 -- a pointer to a temporarily allocated block of memory of @n@ bytes.
105 -- The block of memory is sufficiently aligned for any of the basic
106 -- foreign types that fits into a memory block of the allocated size.
108 -- The memory is freed when @f@ terminates (either normally or via an
109 -- exception), so the pointer passed to @f@ must /not/ be used after this.
111 #ifdef __GLASGOW_HASKELL__
112 allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
113 allocaBytes (I# size) action = IO $ \ s0 ->
114 case newPinnedByteArray# size s0 of { (# s1, mbarr# #) ->
115 case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr# #) ->
116 let addr = Ptr (byteArrayContents# barr#) in
117 case action addr of { IO action' ->
118 case action' s2 of { (# s3, r #) ->
119 case touch# barr# s3 of { s4 ->
123 allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b
124 allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 ->
125 case newAlignedPinnedByteArray# size align s0 of { (# s1, mbarr# #) ->
126 case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr# #) ->
127 let addr = Ptr (byteArrayContents# barr#) in
128 case action addr of { IO action' ->
129 case action' s2 of { (# s3, r #) ->
130 case touch# barr# s3 of { s4 ->
134 allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
135 allocaBytes size = bracket (mallocBytes size) free
137 allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b
138 allocaBytesAligned size align = allocaBytes size -- wrong
141 -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
142 -- to the size needed to store values of type @b@. The returned pointer
143 -- may refer to an entirely different memory area, but will be suitably
144 -- aligned to hold values of type @b@. The contents of the referenced
145 -- memory area will be the same as of the original pointer up to the
146 -- minimum of the original size and the size of values of type @b@.
148 -- If the argument to 'realloc' is 'nullPtr', 'realloc' behaves like
151 realloc :: Storable b => Ptr a -> IO (Ptr b)
152 realloc = doRealloc undefined
154 doRealloc :: Storable b' => b' -> Ptr a' -> IO (Ptr b')
155 doRealloc dummy ptr = let
156 size = fromIntegral (sizeOf dummy)
158 failWhenNULL "realloc" (_realloc ptr size)
160 -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
161 -- to the given size. The returned pointer may refer to an entirely
162 -- different memory area, but will be sufficiently aligned for any of the
163 -- basic foreign types that fits into a memory block of the given size.
164 -- The contents of the referenced memory area will be the same as of
165 -- the original pointer up to the minimum of the original size and the
168 -- If the pointer argument to 'reallocBytes' is 'nullPtr', 'reallocBytes'
169 -- behaves like 'malloc'. If the requested size is 0, 'reallocBytes'
170 -- behaves like 'free'.
172 reallocBytes :: Ptr a -> Int -> IO (Ptr a)
173 reallocBytes ptr 0 = do free ptr; return nullPtr
174 reallocBytes ptr size =
175 failWhenNULL "realloc" (_realloc ptr (fromIntegral size))
177 -- |Free a block of memory that was allocated with 'malloc',
178 -- 'mallocBytes', 'realloc', 'reallocBytes', 'Foreign.Marshal.Utils.new'
179 -- or any of the @new@/X/ functions in "Foreign.Marshal.Array" or
180 -- "Foreign.C.String".
182 free :: Ptr a -> IO ()
186 -- auxilliary routines
187 -- -------------------
189 -- asserts that the pointer returned from the action in the second argument is
192 failWhenNULL :: String -> IO (Ptr a) -> IO (Ptr a)
193 failWhenNULL name f = do
196 #if __GLASGOW_HASKELL__
197 then ioError (IOError Nothing ResourceExhausted name
198 "out of memory" Nothing Nothing)
200 then ioError (IOError Nothing ResourceExhausted name
201 "out of memory" Nothing)
203 then ioError (userError (name++": out of memory"))
207 -- basic C routines needed for memory allocation
209 foreign import ccall unsafe "stdlib.h malloc" _malloc :: CSize -> IO (Ptr a)
210 foreign import ccall unsafe "stdlib.h realloc" _realloc :: Ptr a -> CSize -> IO (Ptr b)
211 foreign import ccall unsafe "stdlib.h free" _free :: Ptr a -> IO ()
213 -- | A pointer to a foreign function equivalent to 'free', which may be
214 -- used as a finalizer (cf 'Foreign.ForeignPtr.ForeignPtr') for storage
215 -- allocated with 'malloc', 'mallocBytes', 'realloc' or 'reallocBytes'.
216 foreign import ccall unsafe "stdlib.h &free" finalizerFree :: FinalizerPtr a