[commit: base] master: Add alignment-restricted ForeignPtr allocation actions (dcbaff9)

Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/dcbaff90f79c4fcb5b69308820351032a5c4a73e

>---------------------------------------------------------------

commit dcbaff90f79c4fcb5b69308820351032a5c4a73e
Author: Nicolas Trangez <[email protected]>
Date:   Wed Jul 11 15:16:11 2012 +0200

    Add alignment-restricted ForeignPtr allocation actions
    
    See: #7067
    See: http://hackage.haskell.org/trac/ghc/ticket/7067
    See: http://www.haskell.org/pipermail/glasgow-haskell-users/2012-July/022579.html

>---------------------------------------------------------------

 GHC/ForeignPtr.hs |   29 +++++++++++++++++++++++++++++
 1 files changed, 29 insertions(+), 0 deletions(-)

diff --git a/GHC/ForeignPtr.hs b/GHC/ForeignPtr.hs
index 5711484..f3ce527 100644
--- a/GHC/ForeignPtr.hs
+++ b/GHC/ForeignPtr.hs
@@ -34,6 +34,8 @@ module GHC.ForeignPtr
         mallocPlainForeignPtr,
         mallocForeignPtrBytes,
         mallocPlainForeignPtrBytes,
+        mallocForeignPtrAlignedBytes,
+        mallocPlainForeignPtrAlignedBytes,
         addForeignPtrFinalizer,
         addForeignPtrFinalizerEnv,
         touchForeignPtr,
@@ -183,6 +185,20 @@ mallocForeignPtrBytes (I# size) = do
                          (MallocPtr mbarr# r) #)
      }
 
+-- | This function is similar to 'mallocForeignPtrBytes', except that the
+-- size and alignment of the memory required is given explicitly as numbers of
+-- bytes.
+mallocForeignPtrAlignedBytes :: Int -> Int -> IO (ForeignPtr a)
+mallocForeignPtrAlignedBytes size alignment | size < 0 =
+  error "mallocForeignPtrAlignedBytes: size must be >= 0"
+mallocForeignPtrAlignedBytes (I# size) (I# alignment) = do
+  r <- newIORef (NoFinalizers, [])
+  IO $ \s ->
+     case newAlignedPinnedByteArray# size alignment s of { (# s', mbarr# #) ->
+       (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
+                         (MallocPtr mbarr# r) #)
+     }
+
 -- | Allocate some memory and return a 'ForeignPtr' to it.  The memory
 -- will be released automatically when the 'ForeignPtr' is discarded.
 --
@@ -222,6 +238,19 @@ mallocPlainForeignPtrBytes (I# size) = IO $ \s ->
                          (PlainPtr mbarr#) #)
      }
 
+-- | This function is similar to 'mallocForeignPtrAlignedBytes', except that
+-- the internally an optimised ForeignPtr representation with no
+-- finalizer is used. Attempts to add a finalizer will cause an
+-- exception to be thrown.
+mallocPlainForeignPtrAlignedBytes :: Int -> Int -> IO (ForeignPtr a)
+mallocPlainForeignPtrAlignedBytes size alignment | size < 0 =
+  error "mallocPlainForeignPtrAlignedBytes: size must be >= 0"
+mallocPlainForeignPtrAlignedBytes (I# size) (I# alignment) = IO $ \s ->
+    case newAlignedPinnedByteArray# size alignment s of { (# s', mbarr# #) ->
+       (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
+                         (PlainPtr mbarr#) #)
+     }
+
 addForeignPtrFinalizer :: FinalizerPtr a -> ForeignPtr a -> IO ()
 -- ^This function adds a finalizer to the given foreign object.  The
 -- finalizer will run /before/ all other finalizers for the same