import Data.Maybe
import Foreign.C.Types ( CSize )
-import Foreign.Storable ( Storable(sizeOf) )
+import Foreign.Storable ( Storable(sizeOf,alignment) )
#ifndef __GLASGOW_HASKELL__
import Foreign.Ptr ( Ptr, nullPtr, FunPtr )
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.
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'
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.
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