Remove Hugs98 specific code
[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 -- exported functions
83 -- ------------------
84
85 -- |Allocate a block of memory that is sufficient to hold values of type
86 -- @a@. The size of the area allocated is determined by the 'sizeOf'
87 -- method from the instance of 'Storable' for the appropriate type.
88 --
89 -- The memory may be deallocated using 'free' or 'finalizerFree' when
90 -- no longer required.
91 --
92 {-# INLINE malloc #-}
93 malloc :: Storable a => IO (Ptr a)
94 malloc = doMalloc undefined
95 where
96 doMalloc :: Storable b => b -> IO (Ptr b)
97 doMalloc dummy = mallocBytes (sizeOf dummy)
98
99 -- |Allocate a block of memory of the given number of bytes.
100 -- The block of memory is sufficiently aligned for any of the basic
101 -- foreign types that fits into a memory block of the allocated size.
102 --
103 -- The memory may be deallocated using 'free' or 'finalizerFree' when
104 -- no longer required.
105 --
106 mallocBytes :: Int -> IO (Ptr a)
107 mallocBytes size = failWhenNULL "malloc" (_malloc (fromIntegral size))
108
109 -- |@'alloca' f@ executes the computation @f@, passing as argument
110 -- a pointer to a temporarily allocated block of memory sufficient to
111 -- hold values of type @a@.
112 --
113 -- The memory is freed when @f@ terminates (either normally or via an
114 -- exception), so the pointer passed to @f@ must /not/ be used after this.
115 --
116 {-# INLINE alloca #-}
117 alloca :: Storable a => (Ptr a -> IO b) -> IO b
118 alloca = doAlloca undefined
119 where
120 doAlloca :: Storable a' => a' -> (Ptr a' -> IO b') -> IO b'
121 doAlloca dummy = allocaBytesAligned (sizeOf dummy) (alignment dummy)
122
123 -- |@'allocaBytes' n f@ executes the computation @f@, passing as argument
124 -- a pointer to a temporarily allocated block of memory of @n@ bytes.
125 -- The block of memory is sufficiently aligned for any of the basic
126 -- foreign types that fits into a memory block of the allocated size.
127 --
128 -- The memory is freed when @f@ terminates (either normally or via an
129 -- exception), so the pointer passed to @f@ must /not/ be used after this.
130 --
131 #ifdef __GLASGOW_HASKELL__
132 allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
133 allocaBytes (I# size) action = IO $ \ s0 ->
134 case newPinnedByteArray# size s0 of { (# s1, mbarr# #) ->
135 case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr# #) ->
136 let addr = Ptr (byteArrayContents# barr#) in
137 case action addr of { IO action' ->
138 case action' s2 of { (# s3, r #) ->
139 case touch# barr# s3 of { s4 ->
140 (# s4, r #)
141 }}}}}
142
143 allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b
144 allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 ->
145 case newAlignedPinnedByteArray# size align s0 of { (# s1, mbarr# #) ->
146 case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr# #) ->
147 let addr = Ptr (byteArrayContents# barr#) in
148 case action addr of { IO action' ->
149 case action' s2 of { (# s3, r #) ->
150 case touch# barr# s3 of { s4 ->
151 (# s4, r #)
152 }}}}}
153 #else
154 allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
155 allocaBytes size = bracket (mallocBytes size) free
156
157 allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b
158 allocaBytesAligned size align = allocaBytes size -- wrong
159 #endif
160
161 -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
162 -- to the size needed to store values of type @b@. The returned pointer
163 -- may refer to an entirely different memory area, but will be suitably
164 -- aligned to hold values of type @b@. The contents of the referenced
165 -- memory area will be the same as of the original pointer up to the
166 -- minimum of the original size and the size of values of type @b@.
167 --
168 -- If the argument to 'realloc' is 'nullPtr', 'realloc' behaves like
169 -- 'malloc'.
170 --
171 realloc :: Storable b => Ptr a -> IO (Ptr b)
172 realloc = doRealloc undefined
173 where
174 doRealloc :: Storable b' => b' -> Ptr a' -> IO (Ptr b')
175 doRealloc dummy ptr = let
176 size = fromIntegral (sizeOf dummy)
177 in
178 failWhenNULL "realloc" (_realloc ptr size)
179
180 -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
181 -- to the given size. The returned pointer may refer to an entirely
182 -- different memory area, but will be sufficiently aligned for any of the
183 -- basic foreign types that fits into a memory block of the given size.
184 -- The contents of the referenced memory area will be the same as of
185 -- the original pointer up to the minimum of the original size and the
186 -- given size.
187 --
188 -- If the pointer argument to 'reallocBytes' is 'nullPtr', 'reallocBytes'
189 -- behaves like 'malloc'. If the requested size is 0, 'reallocBytes'
190 -- behaves like 'free'.
191 --
192 reallocBytes :: Ptr a -> Int -> IO (Ptr a)
193 reallocBytes ptr 0 = do free ptr; return nullPtr
194 reallocBytes ptr size =
195 failWhenNULL "realloc" (_realloc ptr (fromIntegral size))
196
197 -- |Free a block of memory that was allocated with 'malloc',
198 -- 'mallocBytes', 'realloc', 'reallocBytes', 'Foreign.Marshal.Utils.new'
199 -- or any of the @new@/X/ functions in "Foreign.Marshal.Array" or
200 -- "Foreign.C.String".
201 --
202 free :: Ptr a -> IO ()
203 free = _free
204
205
206 -- auxilliary routines
207 -- -------------------
208
209 -- asserts that the pointer returned from the action in the second argument is
210 -- non-null
211 --
212 failWhenNULL :: String -> IO (Ptr a) -> IO (Ptr a)
213 failWhenNULL name f = do
214 addr <- f
215 if addr == nullPtr
216 #if __GLASGOW_HASKELL__
217 then ioError (IOError Nothing ResourceExhausted name
218 "out of memory" Nothing Nothing)
219 #else
220 then ioError (userError (name++": out of memory"))
221 #endif
222 else return addr
223
224 -- basic C routines needed for memory allocation
225 --
226 foreign import ccall unsafe "stdlib.h malloc" _malloc :: CSize -> IO (Ptr a)
227 foreign import ccall unsafe "stdlib.h realloc" _realloc :: Ptr a -> CSize -> IO (Ptr b)
228 foreign import ccall unsafe "stdlib.h free" _free :: Ptr a -> IO ()
229
230 -- | A pointer to a foreign function equivalent to 'free', which may be
231 -- used as a finalizer (cf 'Foreign.ForeignPtr.ForeignPtr') for storage
232 -- allocated with 'malloc', 'mallocBytes', 'realloc' or 'reallocBytes'.
233 foreign import ccall unsafe "stdlib.h &free" finalizerFree :: FinalizerPtr a
234