add install-includes: field
[packages/pretty.git] / Foreign / Marshal / Alloc.hs
1 {-# OPTIONS_GHC -fno-implicit-prelude #-}
2 -----------------------------------------------------------------------------
3 -- |
4 -- Module : Foreign.Marshal.Alloc
5 -- Copyright : (c) The FFI task force 2001
6 -- License : BSD-style (see the file libraries/base/LICENSE)
7 --
8 -- Maintainer : ffi@haskell.org
9 -- Stability : provisional
10 -- Portability : portable
11 --
12 -- Marshalling support: basic routines for memory allocation
13 --
14 -----------------------------------------------------------------------------
15
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
21
22 -- ** Dynamic allocation
23 malloc, -- :: Storable a => IO (Ptr a)
24 mallocBytes, -- :: Int -> IO (Ptr a)
25
26 realloc, -- :: Storable b => Ptr a -> IO (Ptr b)
27 reallocBytes, -- :: Ptr a -> Int -> IO (Ptr a)
28
29 free, -- :: Ptr a -> IO ()
30 finalizerFree -- :: FinalizerPtr a
31 ) where
32
33 import Data.Maybe
34 import Foreign.Ptr ( Ptr, nullPtr, FunPtr )
35 import Foreign.C.Types ( CSize )
36 import Foreign.Storable ( Storable(sizeOf) )
37
38 #ifdef __GLASGOW_HASKELL__
39 import Foreign.ForeignPtr ( FinalizerPtr )
40 import GHC.IOBase
41 import GHC.Real
42 import GHC.Ptr
43 import GHC.Err
44 import GHC.Base
45 import GHC.Num
46 #elif defined(__NHC__)
47 import NHC.FFI ( FinalizerPtr, CInt(..) )
48 import IO ( bracket )
49 #else
50 import Control.Exception ( bracket )
51 #endif
52
53 #ifdef __HUGS__
54 import Hugs.Prelude ( IOException(IOError),
55 IOErrorType(ResourceExhausted) )
56 import Hugs.ForeignPtr ( FinalizerPtr )
57 #endif
58
59
60 -- exported functions
61 -- ------------------
62
63 -- |Allocate a block of memory that is sufficient to hold values of type
64 -- @a@. The size of the area allocated is determined by the 'sizeOf'
65 -- method from the instance of 'Storable' for the appropriate type.
66 --
67 -- The memory may be deallocated using 'free' or 'finalizerFree' when
68 -- no longer required.
69 --
70 malloc :: Storable a => IO (Ptr a)
71 malloc = doMalloc undefined
72 where
73 doMalloc :: Storable b => b -> IO (Ptr b)
74 doMalloc dummy = mallocBytes (sizeOf dummy)
75
76 -- |Allocate a block of memory of the given number of bytes.
77 -- The block of memory is sufficiently aligned for any of the basic
78 -- foreign types that fits into a memory block of the allocated size.
79 --
80 -- The memory may be deallocated using 'free' or 'finalizerFree' when
81 -- no longer required.
82 --
83 mallocBytes :: Int -> IO (Ptr a)
84 mallocBytes size = failWhenNULL "malloc" (_malloc (fromIntegral size))
85
86 -- |@'alloca' f@ executes the computation @f@, passing as argument
87 -- a pointer to a temporarily allocated block of memory sufficient to
88 -- hold values of type @a@.
89 --
90 -- The memory is freed when @f@ terminates (either normally or via an
91 -- exception), so the pointer passed to @f@ must /not/ be used after this.
92 --
93 alloca :: Storable a => (Ptr a -> IO b) -> IO b
94 alloca = doAlloca undefined
95 where
96 doAlloca :: Storable a' => a' -> (Ptr a' -> IO b') -> IO b'
97 doAlloca dummy = allocaBytes (sizeOf dummy)
98
99 -- |@'allocaBytes' n f@ executes the computation @f@, passing as argument
100 -- a pointer to a temporarily allocated block of memory of @n@ bytes.
101 -- The block of memory is sufficiently aligned for any of the basic
102 -- foreign types that fits into a memory block of the allocated size.
103 --
104 -- The memory is freed when @f@ terminates (either normally or via an
105 -- exception), so the pointer passed to @f@ must /not/ be used after this.
106 --
107 #ifdef __GLASGOW_HASKELL__
108 allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
109 allocaBytes (I# size) action = IO $ \ s ->
110 case newPinnedByteArray# size s of { (# s, mbarr# #) ->
111 case unsafeFreezeByteArray# mbarr# s of { (# s, barr# #) ->
112 let addr = Ptr (byteArrayContents# barr#) in
113 case action addr of { IO action ->
114 case action s of { (# s, r #) ->
115 case touch# barr# s of { s ->
116 (# s, r #)
117 }}}}}
118 #else
119 allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
120 allocaBytes size = bracket (mallocBytes size) free
121 #endif
122
123 -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
124 -- to the size needed to store values of type @b@. The returned pointer
125 -- may refer to an entirely different memory area, but will be suitably
126 -- aligned to hold values of type @b@. The contents of the referenced
127 -- memory area will be the same as of the original pointer up to the
128 -- minimum of the original size and the size of values of type @b@.
129 --
130 -- If the argument to 'realloc' is 'nullPtr', 'realloc' behaves like
131 -- 'malloc'.
132 --
133 realloc :: Storable b => Ptr a -> IO (Ptr b)
134 realloc = doRealloc undefined
135 where
136 doRealloc :: Storable b' => b' -> Ptr a' -> IO (Ptr b')
137 doRealloc dummy ptr = let
138 size = fromIntegral (sizeOf dummy)
139 in
140 failWhenNULL "realloc" (_realloc ptr size)
141
142 -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
143 -- to the given size. The returned pointer may refer to an entirely
144 -- different memory area, but will be sufficiently aligned for any of the
145 -- basic foreign types that fits into a memory block of the given size.
146 -- The contents of the referenced memory area will be the same as of
147 -- the original pointer up to the minimum of the original size and the
148 -- given size.
149 --
150 -- If the pointer argument to 'reallocBytes' is 'nullPtr', 'reallocBytes'
151 -- behaves like 'malloc'. If the requested size is 0, 'reallocBytes'
152 -- behaves like 'free'.
153 --
154 reallocBytes :: Ptr a -> Int -> IO (Ptr a)
155 reallocBytes ptr 0 = do free ptr; return nullPtr
156 reallocBytes ptr size =
157 failWhenNULL "realloc" (_realloc ptr (fromIntegral size))
158
159 -- |Free a block of memory that was allocated with 'malloc',
160 -- 'mallocBytes', 'realloc', 'reallocBytes', 'Foreign.Marshal.Utils.new'
161 -- or any of the @new@/X/ functions in "Foreign.Marshal.Array" or
162 -- "Foreign.C.String".
163 --
164 free :: Ptr a -> IO ()
165 free = _free
166
167
168 -- auxilliary routines
169 -- -------------------
170
171 -- asserts that the pointer returned from the action in the second argument is
172 -- non-null
173 --
174 failWhenNULL :: String -> IO (Ptr a) -> IO (Ptr a)
175 failWhenNULL name f = do
176 addr <- f
177 if addr == nullPtr
178 #if __GLASGOW_HASKELL__ || __HUGS__
179 then ioError (IOError Nothing ResourceExhausted name
180 "out of memory" Nothing)
181 #else
182 then ioError (userError (name++": out of memory"))
183 #endif
184 else return addr
185
186 -- basic C routines needed for memory allocation
187 --
188 foreign import ccall unsafe "stdlib.h malloc" _malloc :: CSize -> IO (Ptr a)
189 foreign import ccall unsafe "stdlib.h realloc" _realloc :: Ptr a -> CSize -> IO (Ptr b)
190 foreign import ccall unsafe "stdlib.h free" _free :: Ptr a -> IO ()
191
192 -- | A pointer to a foreign function equivalent to 'free', which may be
193 -- used as a finalizer (cf 'Foreign.ForeignPtr.ForeignPtr') for storage
194 -- allocated with 'malloc', 'mallocBytes', 'realloc' or 'reallocBytes'.
195 foreign import ccall unsafe "stdlib.h &free" finalizerFree :: FinalizerPtr a