Foreign/Marshal/Alloc.hs

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