+++ /dev/null
-{-# OPTIONS_GHC -fno-implicit-prelude #-}
------------------------------------------------------------------------------
--- |
--- Module : Foreign.Marshal.Alloc
--- Copyright : (c) The FFI task force 2001
--- License : BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer : ffi@haskell.org
--- Stability : provisional
--- Portability : portable
---
--- Marshalling support: basic routines for memory allocation
---
------------------------------------------------------------------------------
-
-module Foreign.Marshal.Alloc (
- -- * Memory allocation
- -- ** Local allocation
- alloca, -- :: Storable a => (Ptr a -> IO b) -> IO b
- allocaBytes, -- :: Int -> (Ptr a -> IO b) -> IO b
-
- -- ** Dynamic allocation
- malloc, -- :: Storable a => IO (Ptr a)
- mallocBytes, -- :: Int -> IO (Ptr a)
-
- realloc, -- :: Storable b => Ptr a -> IO (Ptr b)
- reallocBytes, -- :: Ptr a -> Int -> IO (Ptr a)
-
- free, -- :: Ptr a -> IO ()
- finalizerFree -- :: FinalizerPtr a
-) where
-
-import Data.Maybe
-import Foreign.Ptr ( Ptr, nullPtr, FunPtr )
-import Foreign.C.Types ( CSize )
-import Foreign.Storable ( Storable(sizeOf) )
-
-#ifdef __GLASGOW_HASKELL__
-import Foreign.ForeignPtr ( FinalizerPtr )
-import GHC.IOBase
-import GHC.Real
-import GHC.Ptr
-import GHC.Err
-import GHC.Base
-import GHC.Num
-#elif defined(__NHC__)
-import NHC.FFI ( FinalizerPtr, CInt(..) )
-import IO ( bracket )
-#else
-import Control.Exception ( bracket )
-#endif
-
-#ifdef __HUGS__
-import Hugs.Prelude ( IOException(IOError),
- IOErrorType(ResourceExhausted) )
-import Hugs.ForeignPtr ( FinalizerPtr )
-#endif
-
-
--- exported functions
--- ------------------
-
--- |Allocate a block of memory that is sufficient to hold values of type
--- @a@. The size of the area allocated is determined by the 'sizeOf'
--- method from the instance of 'Storable' for the appropriate type.
---
--- The memory may be deallocated using 'free' or 'finalizerFree' when
--- no longer required.
---
-malloc :: Storable a => IO (Ptr a)
-malloc = doMalloc undefined
- where
- doMalloc :: Storable b => b -> IO (Ptr b)
- doMalloc dummy = mallocBytes (sizeOf dummy)
-
--- |Allocate a block of memory of the given number of bytes.
--- The block of memory is sufficiently aligned for any of the basic
--- foreign types that fits into a memory block of the allocated size.
---
--- The memory may be deallocated using 'free' or 'finalizerFree' when
--- no longer required.
---
-mallocBytes :: Int -> IO (Ptr a)
-mallocBytes size = failWhenNULL "malloc" (_malloc (fromIntegral size))
-
--- |@'alloca' f@ executes the computation @f@, passing as argument
--- a pointer to a temporarily allocated block of memory sufficient to
--- hold values of type @a@.
---
--- The memory is freed when @f@ terminates (either normally or via an
--- exception), so the pointer passed to @f@ must /not/ be used after this.
---
-alloca :: Storable a => (Ptr a -> IO b) -> IO b
-alloca = doAlloca undefined
- where
- doAlloca :: Storable a' => a' -> (Ptr a' -> IO b') -> IO b'
- doAlloca dummy = allocaBytes (sizeOf dummy)
-
--- |@'allocaBytes' n f@ executes the computation @f@, passing as argument
--- a pointer to a temporarily allocated block of memory of @n@ bytes.
--- The block of memory is sufficiently aligned for any of the basic
--- foreign types that fits into a memory block of the allocated size.
---
--- The memory is freed when @f@ terminates (either normally or via an
--- exception), so the pointer passed to @f@ must /not/ be used after this.
---
-#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
-
--- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
--- to the size needed to store values of type @b@. The returned pointer
--- may refer to an entirely different memory area, but will be suitably
--- aligned to hold values of type @b@. The contents of the referenced
--- memory area will be the same as of the original pointer up to the
--- minimum of the original size and the size of values of type @b@.
---
--- If the argument to 'realloc' is 'nullPtr', 'realloc' behaves like
--- 'malloc'.
---
-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)
-
--- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
--- to the given size. The returned pointer may refer to an entirely
--- different memory area, but will be sufficiently aligned for any of the
--- basic foreign types that fits into a memory block of the given size.
--- The contents of the referenced memory area will be the same as of
--- the original pointer up to the minimum of the original size and the
--- given size.
---
--- If the pointer argument to 'reallocBytes' is 'nullPtr', 'reallocBytes'
--- behaves like 'malloc'. If the requested size is 0, 'reallocBytes'
--- behaves like 'free'.
---
-reallocBytes :: Ptr a -> Int -> IO (Ptr a)
-reallocBytes ptr 0 = do free ptr; return nullPtr
-reallocBytes ptr size =
- failWhenNULL "realloc" (_realloc ptr (fromIntegral size))
-
--- |Free a block of memory that was allocated with 'malloc',
--- 'mallocBytes', 'realloc', 'reallocBytes', 'Foreign.Marshal.Utils.new'
--- or any of the @new@/X/ functions in "Foreign.Marshal.Array" or
--- "Foreign.C.String".
---
-free :: Ptr a -> IO ()
-free = _free
-
-
--- auxilliary routines
--- -------------------
-
--- asserts that the pointer returned from the action in the second argument is
--- non-null
---
-failWhenNULL :: String -> IO (Ptr a) -> IO (Ptr a)
-failWhenNULL name f = do
- addr <- f
- if addr == nullPtr
-#if __GLASGOW_HASKELL__ || __HUGS__
- then ioError (IOError Nothing ResourceExhausted name
- "out of memory" Nothing)
-#else
- then ioError (userError (name++": out of memory"))
-#endif
- else return addr
-
--- basic C routines needed for memory allocation
---
-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 ()
-
--- | A pointer to a foreign function equivalent to 'free', which may be
--- used as a finalizer (cf 'Foreign.ForeignPtr.ForeignPtr') for storage
--- allocated with 'malloc', 'mallocBytes', 'realloc' or 'reallocBytes'.
-foreign import ccall unsafe "stdlib.h &free" finalizerFree :: FinalizerPtr a
projects / haskell-directory.git / blobdiff