X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Foreign%2FMarshal%2FAlloc.hs;h=ddb4a90baeefb507784e4187526aa32974c252da;hb=41e8fba828acbae1751628af50849f5352b27873;hp=3cf7174786ff1064877ebd05a1fbc70525874f2a;hpb=68f60ec9d6004e36d572bc3b2d38b25a16530706;p=ghc-base.git diff --git a/Foreign/Marshal/Alloc.hs b/Foreign/Marshal/Alloc.hs index 3cf7174..ddb4a90 100644 --- a/Foreign/Marshal/Alloc.hs +++ b/Foreign/Marshal/Alloc.hs @@ -1,4 +1,10 @@ -{-# OPTIONS -fno-implicit-prelude #-} +{-# LANGUAGE CPP + , NoImplicitPrelude + , MagicHash + , UnboxedTuples + , ForeignFunctionInterface + #-} + ----------------------------------------------------------------------------- -- | -- Module : Foreign.Marshal.Alloc @@ -9,122 +15,198 @@ -- 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. -- ----------------------------------------------------------------------------- module Foreign.Marshal.Alloc ( - -- * Allocation - malloc, -- :: Storable a => IO (Ptr a) - mallocBytes, -- :: Int -> IO (Ptr a) - + -- * Memory allocation + -- ** 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 #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.ForeignPtr ( FinalizerPtr ) +import Hugs.Prelude ( IOException(IOError), + IOErrorType(ResourceExhausted) ) +import Hugs.ForeignPtr ( FinalizerPtr ) #endif -- exported functions -- ------------------ --- |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. +-- |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. +-- +{-# INLINE malloc #-} malloc :: Storable a => IO (Ptr a) malloc = doMalloc undefined where - doMalloc :: Storable a => a -> IO (Ptr a) + doMalloc :: Storable b => b -> IO (Ptr b) doMalloc dummy = mallocBytes (sizeOf dummy) --- |Allocate given number of bytes of storage, equivalent to C\'s @malloc()@. +-- |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)) --- |Temporarily allocate space for a storable type. +-- |@'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 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 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 :: Storable a' => a' -> (Ptr a' -> IO b') -> IO b' + doAlloca dummy = allocaBytesAligned (sizeOf dummy) (alignment dummy) --- |Temporarily allocate the given number of bytes of storage. +-- |@'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 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 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# #) -> +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' 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 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 #) }}}}} #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 --- |Adjust a malloc\'ed storage area to the given size of the required type --- (corresponds to C\'s @realloc()@). +-- |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 :: 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()@). + 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 malloc\'ed storage (equivalent to --- C\'s @free()@) +-- |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 @@ -140,9 +222,12 @@ failWhenNULL :: String -> IO (Ptr a) -> IO (Ptr a) failWhenNULL name f = do addr <- f if addr == nullPtr -#ifdef __GLASGOW_HASKELL__ - then ioException (IOError Nothing ResourceExhausted name - "out of memory" Nothing) +#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) #else then ioError (userError (name++": out of memory")) #endif @@ -154,6 +239,7 @@ foreign import ccall unsafe "stdlib.h malloc" _malloc :: CSize -> IO 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 for storage allocated with 'malloc' or 'mallocBytes'. +-- | 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