-{-# OPTIONS_GHC -fno-implicit-prelude #-}
+{-# OPTIONS_GHC -XNoImplicitPrelude #-}
-----------------------------------------------------------------------------
-- |
-- Module : Foreign.Marshal.Alloc
-- Stability : provisional
-- Portability : portable
--
--- Marshalling support: basic routines for memory allocation
+-- The module "Foreign.Marshal.Alloc" provides operations to allocate and
+-- deallocate blocks of raw memory (i.e., unstructured chunks of memory
+-- outside of the area maintained by the Haskell storage manager). These
+-- memory blocks are commonly used to pass compound data structures to
+-- foreign functions or to provide space in which compound result values
+-- are obtained from foreign functions.
+--
+-- If any of the allocation functions fails, a value of 'nullPtr' is
+-- produced. If 'free' or 'reallocBytes' is applied to a memory area
+-- that has been allocated with 'alloca' or 'allocaBytes', the
+-- behaviour is undefined. Any further access to memory areas allocated with
+-- 'alloca' or 'allocaBytes', after the computation that was passed to
+-- the allocation function has terminated, leads to undefined behaviour. Any
+-- further access to the memory area referenced by a pointer passed to
+-- 'realloc', 'reallocBytes', or 'free' entails undefined
+-- behaviour.
+--
+-- All storage allocated by functions that allocate based on a /size in bytes/
+-- must be sufficiently aligned for any of the basic foreign types
+-- that fits into the newly allocated storage. All storage allocated by
+-- functions that allocate based on a specific type must be sufficiently
+-- aligned for that type. Array allocation routines need to obey the same
+-- alignment constraints for each array element.
--
-----------------------------------------------------------------------------
-- ** Local allocation
alloca, -- :: Storable a => (Ptr a -> IO b) -> IO b
allocaBytes, -- :: Int -> (Ptr a -> IO b) -> IO b
+ allocaBytesAligned, -- :: Int -> 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)
+ 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) )
+import Foreign.C.Types ( CSize )
+import Foreign.Storable ( Storable(sizeOf,alignment) )
+
+#ifndef __GLASGOW_HASKELL__
+import Foreign.Ptr ( Ptr, nullPtr, FunPtr )
+#endif
#ifdef __GLASGOW_HASKELL__
-import Foreign.ForeignPtr ( FinalizerPtr )
-import GHC.IOBase
+import Foreign.ForeignPtr ( FinalizerPtr )
+import GHC.IO.Exception
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 )
+import NHC.FFI ( FinalizerPtr, CInt(..) )
+import IO ( bracket )
#else
-import Control.Exception ( bracket )
+import Control.Exception.Base ( bracket )
#endif
#ifdef __HUGS__
-import Hugs.Prelude ( IOException(IOError),
- IOErrorType(ResourceExhausted) )
-import Hugs.ForeignPtr ( FinalizerPtr )
+import Hugs.Prelude ( IOException(IOError),
+ IOErrorType(ResourceExhausted) )
+import Hugs.ForeignPtr ( FinalizerPtr )
#endif
-- The memory may be deallocated using 'free' or 'finalizerFree' when
-- no longer required.
--
+{-# INLINE malloc #-}
malloc :: Storable a => IO (Ptr a)
malloc = doMalloc undefined
where
-- 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.
--
+{-# INLINE alloca #-}
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)
+ doAlloca dummy = allocaBytesAligned (sizeOf dummy) (alignment dummy)
-- |@'allocaBytes' n f@ executes the computation @f@, passing as argument
-- a pointer to a temporarily allocated block of memory of @n@ bytes.
--
#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# #) ->
+allocaBytes (I# size) action = IO $ \ s0 ->
+ case newPinnedByteArray# size s0 of { (# s1, mbarr# #) ->
+ case unsafeFreezeByteArray# mbarr# s1 of { (# s2, 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 #)
+ case action addr of { IO action' ->
+ case action' s2 of { (# s3, r #) ->
+ case touch# barr# s3 of { s4 ->
+ (# s4, r #)
+ }}}}}
+
+allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b
+allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 ->
+ case newAlignedPinnedByteArray# size align s0 of { (# s1, mbarr# #) ->
+ case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr# #) ->
+ let addr = Ptr (byteArrayContents# barr#) in
+ case action addr of { IO action' ->
+ case action' s2 of { (# s3, r #) ->
+ case touch# barr# s3 of { s4 ->
+ (# s4, r #)
}}}}}
#else
allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
allocaBytes size = bracket (mallocBytes size) free
+
+allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b
+allocaBytesAligned size align = allocaBytes size -- wrong
#endif
-- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
where
doRealloc :: Storable b' => b' -> Ptr a' -> IO (Ptr b')
doRealloc dummy ptr = let
- size = fromIntegral (sizeOf dummy)
- in
- failWhenNULL "realloc" (_realloc ptr size)
+ 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
failWhenNULL name f = do
addr <- f
if addr == nullPtr
-#if __GLASGOW_HASKELL__ || __HUGS__
+#if __GLASGOW_HASKELL__
+ then ioError (IOError Nothing ResourceExhausted name
+ "out of memory" Nothing Nothing)
+#elif __HUGS__
then ioError (IOError Nothing ResourceExhausted name
- "out of memory" Nothing)
+ "out of memory" Nothing)
#else
then ioError (userError (name++": out of memory"))
#endif
projects / ghc-base.git / blobdiff