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