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