{-# OPTIONS -fno-implicit-prelude #-}
-----------------------------------------------------------------------------
---
+-- |
-- Module : Foreign.Marshal.Alloc
-- Copyright : (c) The FFI task force 2001
--- License : BSD-style (see the file libraries/core/LICENSE)
+-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : ffi@haskell.org
-- Stability : provisional
-- Portability : portable
--
--- $Id: Alloc.hs,v 1.2 2001/07/03 11:37:50 simonmar Exp $
---
-- Marshalling support: basic routines for memory allocation
--
-----------------------------------------------------------------------------
module Foreign.Marshal.Alloc (
+ -- * Allocation
malloc, -- :: Storable a => IO (Ptr a)
mallocBytes, -- :: Int -> IO (Ptr a)
alloca, -- :: Storable a => (Ptr a -> IO b) -> IO b
allocaBytes, -- :: Int -> (Ptr a -> IO b) -> IO b
- reallocBytes, -- :: Ptr a -> Int -> IO (Ptr a)
+ realloc, -- :: Storable b => Ptr a -> IO (Ptr b)
+ reallocBytes, -- :: Ptr a -> Int -> IO (Ptr a)
free -- :: Ptr a -> IO ()
+#ifdef __HUGS__
+ , finalizerFree -- :: FunPtr (Ptr a -> IO ())
+#endif
) where
import Data.Maybe
-import Foreign.Ptr ( Ptr, nullPtr )
-import Foreign.C.TypesISO ( CSize )
+import Foreign.Ptr ( Ptr, nullPtr, FunPtr )
+import Foreign.C.Types ( CSize, CInt(..) )
+import Foreign.Storable ( Storable(sizeOf) )
#ifdef __GLASGOW_HASKELL__
-import GHC.Exception ( bracket )
-import GHC.Storable ( Storable(sizeOf) )
import GHC.IOBase
import GHC.Real
+import GHC.Ptr
import GHC.Err
import GHC.Base
+#elif defined(__NHC__)
+import System.IO ( bracket )
+#else
+import Control.Exception ( bracket )
#endif
-- exported functions
-- ------------------
--- allocate space for storable type
+-- |Allocate space for storable type. The size of the area allocated
+-- is determined by the 'sizeOf' method from the instance of
+-- 'Storable' for the appropriate type.
--
malloc :: Storable a => IO (Ptr a)
malloc = doMalloc undefined
doMalloc :: Storable a => a -> IO (Ptr a)
doMalloc dummy = mallocBytes (sizeOf dummy)
--- allocate given number of bytes of storage
+-- |Allocate given number of bytes of storage, equivalent to C\'s @malloc()@.
--
mallocBytes :: Int -> IO (Ptr a)
mallocBytes size = failWhenNULL "malloc" (_malloc (fromIntegral size))
--- temporarily allocate space for a storable type
+-- |Temporarily allocate space for a storable type.
--
--- * the pointer passed as an argument to the function must *not* escape from
--- this function; in other words, in `alloca f' the allocated storage must
--- not be used after `f' returns
+-- * the pointer passed as an argument to the function must /not/ escape from
+-- this function; in other words, in @alloca f@ the allocated storage must
+-- not be used after @f@ returns
--
alloca :: Storable a => (Ptr a -> IO b) -> IO b
alloca = doAlloca undefined
doAlloca :: Storable a => a -> (Ptr a -> IO b) -> IO b
doAlloca dummy = allocaBytes (sizeOf dummy)
--- temporarily allocate the given number of bytes of storage
+-- |Temporarily allocate the given number of bytes of storage.
--
--- * the pointer passed as an argument to the function must *not* escape from
--- this function; in other words, in `allocaBytes n f' the allocated storage
--- must not be used after `f' returns
+-- * the pointer passed as an argument to the function must /not/ escape from
+-- this function; in other words, in @allocaBytes n f@ the allocated storage
+-- must not be used after @f@ returns
--
+#ifdef __GLASGOW_HASKELL__
+allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
+allocaBytes (I# size) action = IO $ \ s ->
+ case newPinnedByteArray# size s of { (# s, mbarr# #) ->
+ case unsafeFreezeByteArray# mbarr# s of { (# s, barr# #) ->
+ let addr = Ptr (byteArrayContents# barr#) in
+ case action addr of { IO action ->
+ case action s of { (# s, r #) ->
+ case touch# barr# s of { s ->
+ (# s, r #)
+ }}}}}
+#else
allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
allocaBytes size = bracket (mallocBytes size) free
+#endif
--- adjust a malloc'ed storage area to the given size
+-- |Adjust a malloc\'ed storage area to the given size of the required type
+-- (corresponds to C\'s @realloc()@).
+--
+realloc :: Storable b => Ptr a -> IO (Ptr b)
+realloc = doRealloc undefined
+ where
+ doRealloc :: Storable b => b -> Ptr a -> IO (Ptr b)
+ doRealloc dummy ptr = let
+ size = fromIntegral (sizeOf dummy)
+ in
+ failWhenNULL "realloc" (_realloc ptr size)
+
+-- |Adjust a malloc\'ed storage area to the given size (equivalent to
+-- C\'s @realloc()@).
--
reallocBytes :: Ptr a -> Int -> IO (Ptr a)
reallocBytes ptr size =
failWhenNULL "realloc" (_realloc ptr (fromIntegral size))
--- free malloc'ed storage
+-- |Free malloc\'ed storage (equivalent to
+-- C\'s @free()@)
--
free :: Ptr a -> IO ()
free = _free
-- basic C routines needed for memory allocation
--
-foreign import "malloc" unsafe _malloc :: CSize -> IO (Ptr a)
-foreign import "realloc" unsafe _realloc :: Ptr a -> CSize -> IO (Ptr a)
-foreign import "free" unsafe _free :: Ptr a -> IO ()
+foreign import ccall unsafe "stdlib.h malloc" _malloc :: CSize -> IO (Ptr a)
+foreign import ccall unsafe "stdlib.h realloc" _realloc :: Ptr a -> CSize -> IO (Ptr b)
+foreign import ccall unsafe "stdlib.h free" _free :: Ptr a -> IO ()
+#ifdef __HUGS__
+-- |A pointer to a foreign function equivalent to @free@, which may be used
+-- as a finalizer for storage allocated with @malloc@ or @mallocBytes@.
+foreign import ccall unsafe "stdlib.h &free"
+ finalizerFree :: FunPtr (Ptr a -> IO ())
+#endif