6b0bcfb4186d82801f5cb256b154082eea07a322
[packages/base.git] / Foreign / Marshal / Alloc.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE CPP
3 , NoImplicitPrelude
4 , MagicHash
5 , UnboxedTuples
6 , ForeignFunctionInterface
7 #-}
8
9 -----------------------------------------------------------------------------
10 -- |
11 -- Module : Foreign.Marshal.Alloc
12 -- Copyright : (c) The FFI task force 2001
13 -- License : BSD-style (see the file libraries/base/LICENSE)
14 --
15 -- Maintainer : ffi@haskell.org
16 -- Stability : provisional
17 -- Portability : portable
18 --
19 -- The module "Foreign.Marshal.Alloc" provides operations to allocate and
20 -- deallocate blocks of raw memory (i.e., unstructured chunks of memory
21 -- outside of the area maintained by the Haskell storage manager). These
22 -- memory blocks are commonly used to pass compound data structures to
23 -- foreign functions or to provide space in which compound result values
24 -- are obtained from foreign functions.
25 --
26 -- If any of the allocation functions fails, an exception is thrown.
27 -- In some cases, memory exhaustion may mean the process is terminated.
28 -- If 'free' or 'reallocBytes' is applied to a memory area
29 -- that has been allocated with 'alloca' or 'allocaBytes', the
30 -- behaviour is undefined. Any further access to memory areas allocated with
31 -- 'alloca' or 'allocaBytes', after the computation that was passed to
32 -- the allocation function has terminated, leads to undefined behaviour. Any
33 -- further access to the memory area referenced by a pointer passed to
34 -- 'realloc', 'reallocBytes', or 'free' entails undefined
35 -- behaviour.
36 --
37 -- All storage allocated by functions that allocate based on a /size in bytes/
38 -- must be sufficiently aligned for any of the basic foreign types
39 -- that fits into the newly allocated storage. All storage allocated by
40 -- functions that allocate based on a specific type must be sufficiently
41 -- aligned for that type. Array allocation routines need to obey the same
42 -- alignment constraints for each array element.
43 --
44 -----------------------------------------------------------------------------
45
46 module Foreign.Marshal.Alloc (
47 -- * Memory allocation
48 -- ** Local allocation
49 alloca,
50 allocaBytes,
51 allocaBytesAligned,
52
53 -- ** Dynamic allocation
54 malloc,
55 mallocBytes,
56
57 realloc,
58 reallocBytes,
59
60 free,
61 finalizerFree
62 ) where
63
64 import Data.Maybe
65 import Foreign.C.Types ( CSize(..) )
66 import Foreign.Storable ( Storable(sizeOf,alignment) )
67
68 #ifndef __GLASGOW_HASKELL__
69 import Foreign.Ptr ( Ptr, nullPtr, FunPtr )
70 #endif
71
72 #ifdef __GLASGOW_HASKELL__
73 import Foreign.ForeignPtr ( FinalizerPtr )
74 import GHC.IO.Exception
75 import GHC.Real
76 import GHC.Ptr
77 import GHC.Base
78 #else
79 import Control.Exception.Base ( bracket )
80 #endif
81
82 #ifdef __HUGS__
83 import Hugs.Prelude ( IOException(IOError),
84 IOErrorType(ResourceExhausted) )
85 import Hugs.ForeignPtr ( FinalizerPtr )
86 #endif
87
88
89 -- exported functions
90 -- ------------------
91
92 -- |Allocate a block of memory that is sufficient to hold values of type
93 -- @a@. The size of the area allocated is determined by the 'sizeOf'
94 -- method from the instance of 'Storable' for the appropriate type.
95 --
96 -- The memory may be deallocated using 'free' or 'finalizerFree' when
97 -- no longer required.
98 --
99 {-# INLINE malloc #-}
100 malloc :: Storable a => IO (Ptr a)
101 malloc = doMalloc undefined
102 where
103 doMalloc :: Storable b => b -> IO (Ptr b)
104 doMalloc dummy = mallocBytes (sizeOf dummy)
105
106 -- |Allocate a block of memory of the given number of bytes.
107 -- The block of memory is sufficiently aligned for any of the basic
108 -- foreign types that fits into a memory block of the allocated size.
109 --
110 -- The memory may be deallocated using 'free' or 'finalizerFree' when
111 -- no longer required.
112 --
113 mallocBytes :: Int -> IO (Ptr a)
114 mallocBytes size = failWhenNULL "malloc" (_malloc (fromIntegral size))
115
116 -- |@'alloca' f@ executes the computation @f@, passing as argument
117 -- a pointer to a temporarily allocated block of memory sufficient to
118 -- hold values of type @a@.
119 --
120 -- The memory is freed when @f@ terminates (either normally or via an
121 -- exception), so the pointer passed to @f@ must /not/ be used after this.
122 --
123 {-# INLINE alloca #-}
124 alloca :: Storable a => (Ptr a -> IO b) -> IO b
125 alloca = doAlloca undefined
126 where
127 doAlloca :: Storable a' => a' -> (Ptr a' -> IO b') -> IO b'
128 doAlloca dummy = allocaBytesAligned (sizeOf dummy) (alignment dummy)
129
130 -- |@'allocaBytes' n f@ executes the computation @f@, passing as argument
131 -- a pointer to a temporarily allocated block of memory of @n@ bytes.
132 -- The block of memory is sufficiently aligned for any of the basic
133 -- foreign types that fits into a memory block of the allocated size.
134 --
135 -- The memory is freed when @f@ terminates (either normally or via an
136 -- exception), so the pointer passed to @f@ must /not/ be used after this.
137 --
138 #ifdef __GLASGOW_HASKELL__
139 allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
140 allocaBytes (I# size) action = IO $ \ s0 ->
141 case newPinnedByteArray# size s0 of { (# s1, mbarr# #) ->
142 case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr# #) ->
143 let addr = Ptr (byteArrayContents# barr#) in
144 case action addr of { IO action' ->
145 case action' s2 of { (# s3, r #) ->
146 case touch# barr# s3 of { s4 ->
147 (# s4, r #)
148 }}}}}
149
150 allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b
151 allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 ->
152 case newAlignedPinnedByteArray# size align s0 of { (# s1, mbarr# #) ->
153 case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr# #) ->
154 let addr = Ptr (byteArrayContents# barr#) in
155 case action addr of { IO action' ->
156 case action' s2 of { (# s3, r #) ->
157 case touch# barr# s3 of { s4 ->
158 (# s4, r #)
159 }}}}}
160 #else
161 allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
162 allocaBytes size = bracket (mallocBytes size) free
163
164 allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b
165 allocaBytesAligned size align = allocaBytes size -- wrong
166 #endif
167
168 -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
169 -- to the size needed to store values of type @b@. The returned pointer
170 -- may refer to an entirely different memory area, but will be suitably
171 -- aligned to hold values of type @b@. The contents of the referenced
172 -- memory area will be the same as of the original pointer up to the
173 -- minimum of the original size and the size of values of type @b@.
174 --
175 -- If the argument to 'realloc' is 'nullPtr', 'realloc' behaves like
176 -- 'malloc'.
177 --
178 realloc :: Storable b => Ptr a -> IO (Ptr b)
179 realloc = doRealloc undefined
180 where
181 doRealloc :: Storable b' => b' -> Ptr a' -> IO (Ptr b')
182 doRealloc dummy ptr = let
183 size = fromIntegral (sizeOf dummy)
184 in
185 failWhenNULL "realloc" (_realloc ptr size)
186
187 -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
188 -- to the given size. The returned pointer may refer to an entirely
189 -- different memory area, but will be sufficiently aligned for any of the
190 -- basic foreign types that fits into a memory block of the given size.
191 -- The contents of the referenced memory area will be the same as of
192 -- the original pointer up to the minimum of the original size and the
193 -- given size.
194 --
195 -- If the pointer argument to 'reallocBytes' is 'nullPtr', 'reallocBytes'
196 -- behaves like 'malloc'. If the requested size is 0, 'reallocBytes'
197 -- behaves like 'free'.
198 --
199 reallocBytes :: Ptr a -> Int -> IO (Ptr a)
200 reallocBytes ptr 0 = do free ptr; return nullPtr
201 reallocBytes ptr size =
202 failWhenNULL "realloc" (_realloc ptr (fromIntegral size))
203
204 -- |Free a block of memory that was allocated with 'malloc',
205 -- 'mallocBytes', 'realloc', 'reallocBytes', 'Foreign.Marshal.Utils.new'
206 -- or any of the @new@/X/ functions in "Foreign.Marshal.Array" or
207 -- "Foreign.C.String".
208 --
209 free :: Ptr a -> IO ()
210 free = _free
211
212
213 -- auxilliary routines
214 -- -------------------
215
216 -- asserts that the pointer returned from the action in the second argument is
217 -- non-null
218 --
219 failWhenNULL :: String -> IO (Ptr a) -> IO (Ptr a)
220 failWhenNULL name f = do
221 addr <- f
222 if addr == nullPtr
223 #if __GLASGOW_HASKELL__
224 then ioError (IOError Nothing ResourceExhausted name
225 "out of memory" Nothing Nothing)
226 #elif __HUGS__
227 then ioError (IOError Nothing ResourceExhausted name
228 "out of memory" Nothing)
229 #else
230 then ioError (userError (name++": out of memory"))
231 #endif
232 else return addr
233
234 -- basic C routines needed for memory allocation
235 --
236 foreign import ccall unsafe "stdlib.h malloc" _malloc :: CSize -> IO (Ptr a)
237 foreign import ccall unsafe "stdlib.h realloc" _realloc :: Ptr a -> CSize -> IO (Ptr b)
238 foreign import ccall unsafe "stdlib.h free" _free :: Ptr a -> IO ()
239
240 -- | A pointer to a foreign function equivalent to 'free', which may be
241 -- used as a finalizer (cf 'Foreign.ForeignPtr.ForeignPtr') for storage
242 -- allocated with 'malloc', 'mallocBytes', 'realloc' or 'reallocBytes'.
243 foreign import ccall unsafe "stdlib.h &free" finalizerFree :: FinalizerPtr a
244