Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/67f4ab7e6b7705a9d617c6109a8c5434ede13cae >--------------------------------------------------------------- commit 67f4ab7e6b7705a9d617c6109a8c5434ede13cae Author: Simon Marlow <[email protected]> Date: Mon Feb 13 11:17:50 2012 +0000 Allocate pinned object blocks from the nursery, not the global allocator. Prompted by a benchmark posted to [email protected] by Andreas Voellmy <[email protected]>. This program exhibits contention for the block allocator when run with -N2 and greater without the fix: {-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns #-} module Main where import Control.Monad import Control.Concurrent import System.Environment import GHC.IO import GHC.Exts import GHC.Conc main = do [m] <- fmap (fmap read) getArgs n <- getNumCapabilities ms <- replicateM n newEmptyMVar sequence [ forkIO $ busyWorkerB (m `quot` n) >> putMVar mv () | mv <- ms ] mapM takeMVar ms busyWorkerB :: Int -> IO () busyWorkerB n_loops = go 0 where go !n | n >= n_loops = return () | otherwise = do p <- (IO $ \s -> case newPinnedByteArray# 1024# s of { (# s', mbarr# #) -> (# s', () #) } ) go (n+1) rts/Capability.c | 1 + rts/Capability.h | 2 + rts/sm/GC.c | 42 ++++++++++++++++++++++++++++++++++++++ rts/sm/Sanity.c | 1 + rts/sm/Storage.c | 59 +++++++++++++++++++++++++++++++++++++++++++----------- 5 files changed, 93 insertions(+), 12 deletions(-) Diff suppressed because of size. To see it, use: git show 67f4ab7e6b7705a9d617c6109a8c5434ede13cae _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
