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 )
43 import GHC.IO.Exception
49 #elif defined(__NHC__)
50 import NHC.FFI ( FinalizerPtr, CInt(..) )
53 import Control.Exception.Base ( bracket )
57 import Hugs.Prelude ( IOException(IOError),
58 IOErrorType(ResourceExhausted) )
59 import Hugs.ForeignPtr ( FinalizerPtr )
66 -- |Allocate a block of memory that is sufficient to hold values of type
67 -- @a@. The size of the area allocated is determined by the 'sizeOf'
68 -- method from the instance of 'Storable' for the appropriate type.
70 -- The memory may be deallocated using 'free' or 'finalizerFree' when
71 -- no longer required.
73 malloc :: Storable a => IO (Ptr a)
74 malloc = doMalloc undefined
76 doMalloc :: Storable b => b -> IO (Ptr b)
77 doMalloc dummy = mallocBytes (sizeOf dummy)
79 -- |Allocate a block of memory of the given number of bytes.
80 -- The block of memory is sufficiently aligned for any of the basic
81 -- foreign types that fits into a memory block of the allocated size.
83 -- The memory may be deallocated using 'free' or 'finalizerFree' when
84 -- no longer required.
86 mallocBytes :: Int -> IO (Ptr a)
87 mallocBytes size = failWhenNULL "malloc" (_malloc (fromIntegral size))
89 -- |@'alloca' f@ executes the computation @f@, passing as argument
90 -- a pointer to a temporarily allocated block of memory sufficient to
91 -- hold values of type @a@.
93 -- The memory is freed when @f@ terminates (either normally or via an
94 -- exception), so the pointer passed to @f@ must /not/ be used after this.
96 alloca :: Storable a => (Ptr a -> IO b) -> IO b
97 alloca = doAlloca undefined
99 doAlloca :: Storable a' => a' -> (Ptr a' -> IO b') -> IO b'
100 doAlloca dummy = allocaBytesAligned (sizeOf dummy) (alignment dummy)
102 -- |@'allocaBytes' n f@ executes the computation @f@, passing as argument
103 -- a pointer to a temporarily allocated block of memory of @n@ bytes.
104 -- The block of memory is sufficiently aligned for any of the basic
105 -- foreign types that fits into a memory block of the allocated size.
107 -- The memory is freed when @f@ terminates (either normally or via an
108 -- exception), so the pointer passed to @f@ must /not/ be used after this.
110 #ifdef __GLASGOW_HASKELL__
111 allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
112 allocaBytes (I# size) action = IO $ \ s0 ->
113 case newPinnedByteArray# size s0 of { (# s1, mbarr# #) ->
114 case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr# #) ->
115 let addr = Ptr (byteArrayContents# barr#) in
116 case action addr of { IO action' ->
117 case action' s2 of { (# s3, r #) ->
118 case touch# barr# s3 of { s4 ->
122 allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b
123 allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 ->
124 case newAlignedPinnedByteArray# size align s0 of { (# s1, mbarr# #) ->
125 case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr# #) ->
126 let addr = Ptr (byteArrayContents# barr#) in
127 case action addr of { IO action' ->
128 case action' s2 of { (# s3, r #) ->
129 case touch# barr# s3 of { s4 ->
133 allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
134 allocaBytes size = bracket (mallocBytes size) free
136 allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b
137 allocaBytesAligned size align = allocaBytes size -- wrong
140 -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
141 -- to the size needed to store values of type @b@. The returned pointer
142 -- may refer to an entirely different memory area, but will be suitably
143 -- aligned to hold values of type @b@. The contents of the referenced
144 -- memory area will be the same as of the original pointer up to the
145 -- minimum of the original size and the size of values of type @b@.
147 -- If the argument to 'realloc' is 'nullPtr', 'realloc' behaves like
150 realloc :: Storable b => Ptr a -> IO (Ptr b)
151 realloc = doRealloc undefined
153 doRealloc :: Storable b' => b' -> Ptr a' -> IO (Ptr b')
154 doRealloc dummy ptr = let
155 size = fromIntegral (sizeOf dummy)
157 failWhenNULL "realloc" (_realloc ptr size)
159 -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
160 -- to the given size. The returned pointer may refer to an entirely
161 -- different memory area, but will be sufficiently aligned for any of the
162 -- basic foreign types that fits into a memory block of the given size.
163 -- The contents of the referenced memory area will be the same as of
164 -- the original pointer up to the minimum of the original size and the
167 -- If the pointer argument to 'reallocBytes' is 'nullPtr', 'reallocBytes'
168 -- behaves like 'malloc'. If the requested size is 0, 'reallocBytes'
169 -- behaves like 'free'.
171 reallocBytes :: Ptr a -> Int -> IO (Ptr a)
172 reallocBytes ptr 0 = do free ptr; return nullPtr
173 reallocBytes ptr size =
174 failWhenNULL "realloc" (_realloc ptr (fromIntegral size))
176 -- |Free a block of memory that was allocated with 'malloc',
177 -- 'mallocBytes', 'realloc', 'reallocBytes', 'Foreign.Marshal.Utils.new'
178 -- or any of the @new@/X/ functions in "Foreign.Marshal.Array" or
179 -- "Foreign.C.String".
181 free :: Ptr a -> IO ()
185 -- auxilliary routines
186 -- -------------------
188 -- asserts that the pointer returned from the action in the second argument is
191 failWhenNULL :: String -> IO (Ptr a) -> IO (Ptr a)
192 failWhenNULL name f = do
195 #if __GLASGOW_HASKELL__
196 then ioError (IOError Nothing ResourceExhausted name
197 "out of memory" Nothing Nothing)
199 then ioError (IOError Nothing ResourceExhausted name
200 "out of memory" Nothing)
202 then ioError (userError (name++": out of memory"))
206 -- basic C routines needed for memory allocation
208 foreign import ccall unsafe "stdlib.h malloc" _malloc :: CSize -> IO (Ptr a)
209 foreign import ccall unsafe "stdlib.h realloc" _realloc :: Ptr a -> CSize -> IO (Ptr b)
210 foreign import ccall unsafe "stdlib.h free" _free :: Ptr a -> IO ()
212 -- | A pointer to a foreign function equivalent to 'free', which may be
213 -- used as a finalizer (cf 'Foreign.ForeignPtr.ForeignPtr') for storage
214 -- allocated with 'malloc', 'mallocBytes', 'realloc' or 'reallocBytes'.
215 foreign import ccall unsafe "stdlib.h &free" finalizerFree :: FinalizerPtr a