Partial fix for #2917

 - add newAlignedPinnedByteArray# for allocating pinned BAs with
   arbitrary alignment

 - the old newPinnedByteArray# now aligns to 16 bytes

Foreign.alloca will use newAlignedPinnedByteArray#, and so might end
up wasting less space than before (we used to align to 8 by default).
Foreign.allocaBytes and Foreign.mallocForeignPtrBytes will get 16-byte
aligned memory, which is enough to avoid problems with SSE
instructions on x86, for example.

There was a bug in the old newPinnedByteArray#: it aligned to 8 bytes,
but would have failed if the header was not a multiple of 8
(fortunately it always was, even with profiling).  Also we
occasionally wasted some space unnecessarily due to alignment in
allocatePinned().

I haven't done anything about Foreign.malloc/mallocBytes, which will
give you the same alignment guarantees as malloc() (8 bytes on
Linux/x86 here).

1 files changed, 6 insertions, 4 deletions

diff --git a/libraries/base/GHC/ForeignPtr.hs b/libraries/base/GHC/ForeignPtr.hs
index 50fa58d043..9868942d76 100644
--- a/libraries/base/GHC/ForeignPtr.hs
+++ b/libraries/base/GHC/ForeignPtr.hs
@@ -152,11 +152,12 @@ mallocForeignPtr = doMalloc undefined
         doMalloc a = do
           r <- newIORef (NoFinalizers, [])
           IO $ \s ->
-            case newPinnedByteArray# size s of { (# s', mbarr# #) ->
+            case newAlignedPinnedByteArray# size align s of { (# s', mbarr# #) ->
              (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
                                (MallocPtr mbarr# r) #)
             }
-            where (I# size) = sizeOf a
+            where (I# size)  = sizeOf a
+                  (I# align) = alignment a
 
 -- | This function is similar to 'mallocForeignPtr', except that the
 -- size of the memory required is given explicitly as a number of bytes.
@@ -186,11 +187,12 @@ mallocPlainForeignPtr :: Storable a => IO (ForeignPtr a)
 mallocPlainForeignPtr = doMalloc undefined
   where doMalloc :: Storable b => b -> IO (ForeignPtr b)
         doMalloc a = IO $ \s ->
-            case newPinnedByteArray# size s of { (# s', mbarr# #) ->
+            case newAlignedPinnedByteArray# size align s of { (# s', mbarr# #) ->
              (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
                                (PlainPtr mbarr#) #)
             }
-            where (I# size) = sizeOf a
+            where (I# size)  = sizeOf a
+                  (I# align) = alignment a
 
 -- | This function is similar to 'mallocForeignPtrBytes', except that
 -- the internally an optimised ForeignPtr representation with no