New patches: [Obey alignment for Storable. lennart@augustsson.net**20090127214504 The Storable class contains a method, alignment, to determine what the alignment for the allocated object should be. This was previously totally ignored. This patch introduces new allocation functions that allocate with a particular alignment, and these functions are used when allocating a Storable or an array of Storable. For GHC we have mallocBytesAligned uses C malloc() when alignment is smaller or equal to what malloc returns, otherwise uses posix_memalign(). If the platform does not support posix_memalign() the allocation will throw an error. allocaBytesAligned uses the fast heap allocation when alignment is small enough, otherwise malloc&free. malloc*ForeignPtrBytesAligned uses fast heap allocation with the Addr# stored in the ForeignPtr rounded up to the alignment boundary. Note that posix_memalign() should never have to be used unless someone asks for an alignment that is bigger than what is needed for the platform. ] { addfile ./Control/Exception/Base.hs-boot hunk ./Control/Exception/Base.hs-boot 1 +module Control.Exception.Base where + +import GHC.IOBase + +bracket + :: IO a + -> (a -> IO b) + -> (a -> IO c) + -> IO c hunk ./Foreign/ForeignPtr.hs 76 -import Foreign.Storable ( Storable(sizeOf) ) +import Foreign.Storable ( Storable(sizeOf, alignment) ) hunk ./Foreign/ForeignPtr.hs 85 +import GHC.Ptr(Ptr(..)) hunk ./Foreign/ForeignPtr.hs 176 - doMalloc dummy size = mallocForeignPtrBytes (size * sizeOf dummy) + doMalloc dummy size = mallocForeignPtrBytesAligned (alignment dummy) (size * sizeOf dummy) hunk ./Foreign/ForeignPtr.hs 185 + hunk ./Foreign/Marshal/Alloc.hs 15 +#include "HsBaseConfig.h" hunk ./Foreign/Marshal/Alloc.hs 20 - alloca, -- :: Storable a => (Ptr a -> IO b) -> IO b - allocaBytes, -- :: Int -> (Ptr a -> IO b) -> IO b + 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 hunk ./Foreign/Marshal/Alloc.hs 25 - malloc, -- :: Storable a => IO (Ptr a) - mallocBytes, -- :: Int -> IO (Ptr a) + malloc, -- :: Storable a => IO (Ptr a) + mallocBytes, -- :: Int -> IO (Ptr a) + mallocBytesAligned, -- :: Int -> Int -> IO (Ptr a) hunk ./Foreign/Marshal/Alloc.hs 29 - realloc, -- :: Storable b => Ptr a -> IO (Ptr b) - reallocBytes, -- :: Ptr a -> Int -> IO (Ptr a) + realloc, -- :: Storable b => Ptr a -> IO (Ptr b) + reallocBytes, -- :: Ptr a -> Int -> IO (Ptr a) hunk ./Foreign/Marshal/Alloc.hs 32 - free, -- :: Ptr a -> IO () - finalizerFree -- :: FinalizerPtr a + free, -- :: Ptr a -> IO () + finalizerFree -- :: FinalizerPtr a hunk ./Foreign/Marshal/Alloc.hs 37 -import Foreign.C.Types ( CSize ) -import Foreign.Storable ( Storable(sizeOf) ) +import Foreign.C.Types ( CSize, CInt ) +import Foreign.Storable ( Storable(sizeOf, alignment, peek, poke) ) hunk ./Foreign/Marshal/Alloc.hs 52 +import {-# SOURCE #-} Control.Exception.Base ( bracket ) hunk ./Foreign/Marshal/Alloc.hs 66 +-- The alignment returned by C malloc(). +-- XXX This should not be hardwired. +mallocAlignment :: Int +mallocAlignment = 16 +allocaAlignment :: Int +allocaAlignment = 8 hunk ./Foreign/Marshal/Alloc.hs 87 - doMalloc dummy = mallocBytes (sizeOf dummy) + doMalloc dummy = mallocBytesAligned (alignment dummy) (sizeOf dummy) hunk ./Foreign/Marshal/Alloc.hs 99 +-- |Allocate a block of memory of the given number of bytes. +-- The block of memory is sufficiently aligned according the alignment. +-- The alignment must be a power of 2. +-- +-- The memory may be deallocated using 'free' or 'finalizerFree' when +-- no longer required. +-- +mallocBytesAligned :: Int -- ^Alignment + -> Int -- ^Size + -> IO (Ptr a) +mallocBytesAligned align size | align <= mallocAlignment = mallocBytes size + | otherwise = alloca $ \ pptr -> do + r <- posix_memalign pptr (fromIntegral align) (fromIntegral size) + if r /= 0 + then outOfMemoryError "mallocBytesAligned" + else peek pptr + hunk ./Foreign/Marshal/Alloc.hs 126 - 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 act = allocaBytesAligned (alignment dummy) (sizeOf dummy) act hunk ./Foreign/Marshal/Alloc.hs 137 -#ifdef __GLASGOW_HASKELL__ hunk ./Foreign/Marshal/Alloc.hs 138 +#ifdef __GLASGOW_HASKELL__ hunk ./Foreign/Marshal/Alloc.hs 149 -allocaBytes :: Int -> (Ptr a -> IO b) -> IO b hunk ./Foreign/Marshal/Alloc.hs 152 +-- |@'allocaBytesAligned' a n f@ is similar to @'allocaBytes' n f@, but the +-- allocated memory is on the specified alignment boundary. +allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b +allocaBytesAligned align size | align <= allocaAlignment = allocaBytes size +-- XXX Could use the more efficient GHC specific allocation, but +-- large alignments are rare. + | otherwise = bracket (mallocBytesAligned align size) free + +-- XXX This does not respect alignment. hunk ./Foreign/Marshal/Alloc.hs 216 + then outOfMemoryError name + else return addr + +outOfMemoryError :: String -> IO a +outOfMemoryError name = hunk ./Foreign/Marshal/Alloc.hs 222 - then ioError (IOError Nothing ResourceExhausted name - "out of memory" Nothing Nothing) + ioError (IOError Nothing ResourceExhausted name + "out of memory" Nothing Nothing) hunk ./Foreign/Marshal/Alloc.hs 225 - then ioError (IOError Nothing ResourceExhausted name - "out of memory" Nothing) + ioError (IOError Nothing ResourceExhausted name + "out of memory" Nothing) hunk ./Foreign/Marshal/Alloc.hs 228 - then ioError (userError (name++": out of memory")) + ioError (userError (name++": out of memory")) hunk ./Foreign/Marshal/Alloc.hs 230 - else return addr hunk ./Foreign/Marshal/Alloc.hs 237 +#ifdef HAVE_POSIX_MEMALIGN +foreign import ccall unsafe "stdlib.h posix_memalign" posix_memalign :: + Ptr (Ptr a) -> CSize -> CSize -> IO CInt +#else +posix_memalign :: Ptr (Ptr a) -> CSize -> CSize -> IO CInt +posix_memalign pptr _ size = do + -- Just allocate with no regard to alignment. XXX Should warn the user. + error "posix_memalign called" + ptr <- _malloc size + poke pptr ptr + return (if ptr == nullPtr then 1 else 0) +#endif + hunk ./Foreign/Marshal/Array.hs 66 -import Foreign.Storable (Storable(sizeOf,peekElemOff,pokeElemOff)) -import Foreign.Marshal.Alloc (mallocBytes, allocaBytes, reallocBytes) +import Foreign.Storable (Storable(sizeOf,peekElemOff,pokeElemOff,alignment)) +import Foreign.Marshal.Alloc (mallocBytesAligned, allocaBytesAligned, reallocBytes) hunk ./Foreign/Marshal/Array.hs 90 - doMalloc dummy size = mallocBytes (size * sizeOf dummy) + doMalloc dummy size = mallocBytesAligned (alignment dummy) (size * sizeOf dummy) hunk ./Foreign/Marshal/Array.hs 104 - doAlloca :: Storable a' => a' -> Int -> (Ptr a' -> IO b') -> IO b' - doAlloca dummy size = allocaBytes (size * sizeOf dummy) + doAlloca :: Storable a' => a' -> Int -> (Ptr a' -> IO b') -> IO b' + doAlloca dummy size act = allocaBytesAligned (alignment dummy) (size * sizeOf dummy) act hunk ./Foreign/Marshal/Array.hs 113 +-- XXX This is wrong. reallocBytes need to copy to a properly aligned place. hunk ./GHC/ForeignPtr.hs 28 + mallocForeignPtrBytesAligned, + mallocPlainForeignPtrBytesAligned, hunk ./GHC/ForeignPtr.hs 49 -import GHC.Ptr ( Ptr(..), FunPtr(..) ) +import GHC.Ptr ( Ptr(..), FunPtr(..), alignPtr ) hunk ./GHC/ForeignPtr.hs 51 +import GHC.Num hunk ./GHC/ForeignPtr.hs 134 -mallocForeignPtr :: Storable a => IO (ForeignPtr a) --- ^ Allocate some memory and return a 'ForeignPtr' to it. The memory --- will be released automatically when the 'ForeignPtr' is discarded. --- --- 'mallocForeignPtr' is equivalent to --- --- > do { p <- malloc; newForeignPtr finalizerFree p } --- --- although it may be implemented differently internally: you may not --- assume that the memory returned by 'mallocForeignPtr' has been --- allocated with 'Foreign.Marshal.Alloc.malloc'. --- --- GHC notes: 'mallocForeignPtr' has a heavily optimised --- implementation in GHC. It uses pinned memory in the garbage --- collected heap, so the 'ForeignPtr' does not require a finalizer to --- free the memory. Use of 'mallocForeignPtr' and associated --- functions is strongly recommended in preference to 'newForeignPtr' --- with a finalizer. --- -mallocForeignPtr = doMalloc undefined - where doMalloc :: Storable b => b -> IO (ForeignPtr b) - doMalloc a = do - r <- newIORef (NoFinalizers, []) - IO $ \s -> - case newPinnedByteArray# size s of { (# s', mbarr# #) -> - (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#)) - (MallocPtr mbarr# r) #) - } - where (I# size) = sizeOf a - hunk ./GHC/ForeignPtr.hs 145 --- | Allocate some memory and return a 'ForeignPtr' to it. The memory --- will be released automatically when the 'ForeignPtr' is discarded. --- --- GHC notes: 'mallocPlainForeignPtr' has a heavily optimised --- implementation in GHC. It uses pinned memory in the garbage --- collected heap, as for mallocForeignPtr. Unlike mallocForeignPtr, a --- ForeignPtr created with mallocPlainForeignPtr carries no finalizers. --- It is not possible to add a finalizer to a ForeignPtr created with --- mallocPlainForeignPtr. This is useful for ForeignPtrs that will live --- only inside Haskell (such as those created for packed strings). --- Attempts to add a finalizer to a ForeignPtr created this way, or to --- finalize such a pointer, will throw an exception. --- -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# #) -> - (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#)) - (PlainPtr mbarr#) #) - } - where (I# size) = sizeOf a - hunk ./GHC/ForeignPtr.hs 324 +---------------------- +-- Functions defined just in terms of the primitive ones above. + +-- XXX Where should we get this constant? +-- It's the alignment used by GHC's internal allocator. +mallocForeignAlignment :: Int +mallocForeignAlignment = 8 + +mallocForeignPtr :: Storable a => IO (ForeignPtr a) +-- ^ Allocate some memory and return a 'ForeignPtr' to it. The memory +-- will be released automatically when the 'ForeignPtr' is discarded. +-- +-- 'mallocForeignPtr' is equivalent to +-- +-- > do { p <- malloc; newForeignPtr finalizerFree p } +-- +-- although it may be implemented differently internally: you may not +-- assume that the memory returned by 'mallocForeignPtr' has been +-- allocated with 'Foreign.Marshal.Alloc.malloc'. +-- +-- GHC notes: 'mallocForeignPtr' has a heavily optimised +-- implementation in GHC. It uses pinned memory in the garbage +-- collected heap, so the 'ForeignPtr' does not require a finalizer to +-- free the memory. Use of 'mallocForeignPtr' and associated +-- functions is strongly recommended in preference to 'newForeignPtr' +-- with a finalizer. +-- +mallocForeignPtr = doMalloc undefined + where doMalloc :: Storable b => b -> IO (ForeignPtr b) + doMalloc a = mallocForeignPtrBytesAligned (alignment a) (sizeOf a) + +-- | This function is similar to 'mallocForeignPtrBytes', but +-- aligns the pointer to the given alignment. +mallocForeignPtrBytesAligned :: Int -> Int -> IO (ForeignPtr a) +mallocForeignPtrBytesAligned align size | align <= mallocForeignAlignment = mallocForeignPtrBytes size + | otherwise = do + -- XXX Adjust the Addr# part of the ForeignPtr. Is this always OK? + ForeignPtr ptr cnt <- mallocForeignPtrBytes (size + align - 1) + return (ForeignPtr (alignPtr' ptr align) cnt) + +-- | Allocate some memory and return a 'ForeignPtr' to it. The memory +-- will be released automatically when the 'ForeignPtr' is discarded. +-- +-- GHC notes: 'mallocPlainForeignPtr' has a heavily optimised +-- implementation in GHC. It uses pinned memory in the garbage +-- collected heap, as for mallocForeignPtr. Unlike mallocForeignPtr, a +-- ForeignPtr created with mallocPlainForeignPtr carries no finalizers. +-- It is not possible to add a finalizer to a ForeignPtr created with +-- mallocPlainForeignPtr. This is useful for ForeignPtrs that will live +-- only inside Haskell (such as those created for packed strings). +-- Attempts to add a finalizer to a ForeignPtr created this way, or to +-- finalize such a pointer, will throw an exception. +-- +mallocPlainForeignPtr :: Storable a => IO (ForeignPtr a) +mallocPlainForeignPtr = doMalloc undefined + where doMalloc :: Storable b => b -> IO (ForeignPtr b) + doMalloc a = mallocPlainForeignPtrBytesAligned (alignment a) (sizeOf a) + +-- | This function is similar to 'mallocPlainForeignPtr', but +-- allocates a pointer on the requested alignment. +mallocPlainForeignPtrBytesAligned :: Int -> Int -> IO (ForeignPtr a) +mallocPlainForeignPtrBytesAligned align size | align <= mallocForeignAlignment = mallocPlainForeignPtrBytes size + | otherwise = do + ForeignPtr ptr cnt <- mallocPlainForeignPtrBytes (size + align - 1) + return (ForeignPtr (alignPtr' ptr align) cnt) + +alignPtr' :: Addr# -> Int -> Addr# +alignPtr' a o = case alignPtr (Ptr a) o of Ptr a' -> a' + hunk ./configure.ac 37 +AC_CHECK_FUNCS([posix_memalign]) } [Use alignment in the pool allocator too. lennart@augustsson.net**20090127221519] { hunk ./Foreign/Marshal/Pool.hs 66 -import Foreign.Marshal.Alloc ( mallocBytes, reallocBytes, free ) +import Foreign.Marshal.Alloc ( mallocBytesAligned, reallocBytes, free ) hunk ./Foreign/Marshal/Pool.hs 70 -import Foreign.Storable ( Storable(sizeOf, poke) ) +import Foreign.Storable ( Storable(sizeOf, poke, alignment) ) hunk ./Foreign/Marshal/Pool.hs 121 - pm dummy pool = pooledMallocBytes pool (sizeOf dummy) + pm dummy pool = pooledMallocBytesAligned pool (alignment dummy) (sizeOf dummy) hunk ./Foreign/Marshal/Pool.hs 126 -pooledMallocBytes (Pool pool) size = do - ptr <- mallocBytes size +pooledMallocBytes pool size = pooledMallocBytesAligned pool 1 size + +pooledMallocBytesAligned :: Pool -> Int -> Int -> IO (Ptr a) +pooledMallocBytesAligned (Pool pool) align size = do + ptr <- mallocBytesAligned align size hunk ./Foreign/Marshal/Pool.hs 162 - pma dummy pool size = pooledMallocBytes pool (size * sizeOf dummy) + pma dummy pool size = pooledMallocBytesAligned pool (alignment dummy) (size * sizeOf dummy) } Context: [Require Cabal version >= 1.6 Ian Lynagh **20090122011251] [Add "bug-reports" and "source-repository" info to the Cabal file Ian Lynagh **20090121182010] [Proposal #2875: remove StringRep and StringConstr Jose Pedro Magalhaes **20090116142617] [Fix #2759: add mkRealConstr and mkIntegralConstr, deprecate mkFloatConstr and mkIntConstr Jose Pedro Magalhaes **20090116140655] [Correct SYB's representation of Char Jose Pedro Magalhaes **20081211144716] [avoid `mappend` in monoid laws, because it doesn't work with haddock Ross Paterson **20090118011508] [Make Data.Typeable imports and exports more explicit Ian Lynagh **20090114234512] [add Monoid laws Ross Paterson **20090116151624] [Unbreak an import cycle caused by moving 'catch' definitions around. Malcolm.Wallace@cs.york.ac.uk**20090116110132 The new cycle was introduced for nhc98 only. ] [make the Monoid docs more self-contained Ross Paterson **20090115222441] [Move some catch definitions around to avoid an import loop Ian Lynagh **20090114211033 As suggested by simonpj in trac #2822. ] [Add NoImplicitPrelude to the extensions used when building with GHC Ian Lynagh **20090114202810] [#2699: exit silently for EPIPE on stdout Simon Marlow **20090114134612 Ignore-this: 4236560e8e9c1135129e9526355f11b4 ] [Fix build when we have HTYPE_TCFLAG_T Ian Lynagh **20090105102020] [Fix the build on Windows Ian Lynagh **20090105014625] [Add errno to the IOError type Ian Lynagh **20090104173018] [Fix typo (reqwests -> requests); trac #2908, spotted by bancroft Ian Lynagh **20090104154405] [More compact error messages for record selectors simonpj@microsoft.com**20090102145325 Make recSelError generate the standard part of the record selector error message (i.e. "No match in record selector") rather than have that string duplicated for every record selector. ] [extra dependencies for the new build system Simon Marlow **20081217104655] [warning fix: don't use -XPatternSignatures in GHC >= 6.10 Simon Marlow **20081217104637] [Rollback INLINE patches Simon Marlow **20081216104143 rolling back: Fri Dec 5 17:00:15 GMT 2008 simonpj@microsoft.com * Update INLINE pragmas for new INLINE story - (.) and foldr should inline when applied to only two arguments - Make unpackCString# NOINLINE; it inlines too much (with little gain) M ./GHC/Base.lhs -10 +31 ] [FIX #1364: added support for C finalizers that run as soon as the value is no longer reachable. Ivan Tomac **20081210150510 Patch amended by Simon Marlow: - mkWeakFinalizer# commoned up with mkWeakFinalizerEnv# ] [Fix #2760: deprecate mkNorepType, add mkNoRepType Jose Pedro Magalhaes **20081121141905] [Update INLINE pragmas for new INLINE story simonpj@microsoft.com**20081205170015 - (.) and foldr should inline when applied to only two arguments - Make unpackCString# NOINLINE; it inlines too much (with little gain) ] [Fix #2750: change Prelude.(,) to Prelude.(,,) Jose Pedro Magalhaes **20081201113411] [Fix typo (or out of date reference) in throwTo documentation. shelarcy **20081129024639] [Add more description of what "round" does, from the H98 report Ian Lynagh **20081119143131] [re-instate the gcd/Integer and lcm/Integer RULES Simon Marlow **20081120101826 Fixes a performance regression between 6.8.3 and 6.10.1 ] [Change an "undefined" into a more informative error; trac #2782 Ian Lynagh **20081116160228] [updating Haddock documentation jpm@cs.uu.nl**20081111095023 Fixed the broken link from Data.Generics to Data.Data. ] [add GHC.Conc.runSparks (required by GHC patch "Run sparks in batches") Simon Marlow **20081106095419] [FIX #2722: update RULES for the Category/Arrow split Ross Paterson **20081104144515 The rule arr id = id interacts unpleasantly with the advice to define id = arr id in instances of Category that are also instances of Arrow (#2722). Also changed a couple of >>>'s to .'s in later rules. ] [Add AnnotationWrapper type so GHC can capture annotation dictionaries during compilation Max Bolingbroke **20081016122608] [docs about how exceptions are handled by forkIO'd threads (#2651) Simon Marlow **20081016100410] [Import n_capabilities via import symbol when linking dynamically Clemens Fruhwirth **20081013161220] [add link to the new syb wiki jpm@cs.uu.nl**20081013111605] [changing haddock links jpm@cs.uu.nl**20081010095434] [add readTVarIO :: TVar a -> IO a Simon Marlow **20081010113835] [removed (->) instance from Data.Data jpm@cs.uu.nl**20081006075254] [non-GHC: delete unnecessary imports Ross Paterson **20081007134809] [added new module Data.Data 'Jose Pedro Magalhaes '**20081002140535 The new Data.Data module contains all of Data.Generics.Basics and most of Data.Generics.Instances. The missing instances were deemed dubious and moved to the syb package. ] [add new Data.Data module 'Jose Pedro Magalhaes '**20081002082735] [restore Complex's derived Data instance 'Jose Pedro Magalhaes '**20081002082655] [update Data.Generics import 'Jose Pedro Magalhaes '**20081002082604] [Don't use ^(2::Int) in Data.Complex.magnitude; partially fixes trac #2450 Ian Lynagh **20081004142651 We still might want to make a RULE for this, so the bug is not fully fixed. ] [Restore the Haskell 98 behaviour of Show Ratio (#1920) Simon Marlow **20080923134949] [Pad version number to 4.0.0.0 Ian Lynagh **20080920155801] [TAG 6.10 branch has been forked Ian Lynagh **20080919123437] Patch bundle hash: 82c9a30f0e37346acf2cb7a30d86fa9936defe3e