下面的代码只是一个实验,看看调用forkIO
时的情况(测试GHC轻量级线程开销 - 内存开销和MVar争用的影响)和一个只读取和写入的函数{{ 1}}。我知道当有100万个线程等待MVar访问时会有访问争用 - 但由于每个函数只访问一次,所以它们最终都应该运行。我在测试中看到的是,如果我使用MVar
选项(GHC 7.0.3,Mac,x86_64)编译代码,代码会减慢很多 - 大约110倍。我将非常感谢使用-threaded
选项指出代码减速的原因。
-threaded
使用{-# LANGUAGE BangPatterns #-}
import Control.Concurrent (forkIO, MVar, newEmptyMVar, putMVar, takeMVar)
import qualified Data.Vector.Storable.Mutable as MSV
import Control.Monad.Primitive (PrimState)
import Control.Monad (mapM_)
f :: MVar Int -> IO ()
f m = do
!i <- takeMVar m
putMVar m (i+1)
main = do
m <- newEmptyMVar
putMVar m 0
let l = 1000000
mapM_ (\x -> forkIO $ f m) [1..l]
编译时:
ghc -O2 -rtsopts
使用 ./test +RTS -s
1,070,652,216 bytes allocated in the heap
1,023,908,744 bytes copied during GC
1,872 bytes maximum residency (1 sample(s))
177,328 bytes maximum slop
9 MB total memory in use (0 MB lost due to fragmentation)
Generation 0: 2029 collections, 0 parallel, 0.13s, 0.13s elapsed
Generation 1: 1 collections, 0 parallel, 0.00s, 0.00s elapsed
INIT time 0.00s ( 0.00s elapsed)
MUT time 0.08s ( 0.08s elapsed)
GC time 0.13s ( 0.13s elapsed)
EXIT time 0.00s ( 0.00s elapsed)
Total time 0.21s ( 0.22s elapsed)
%GC time 61.9% (61.7% elapsed)
Alloc rate 13,110,134,156 bytes per MUT second
Productivity 37.9% of total user, 37.2% of total elapsed
编译时(我使用ghc -O2 -rtsopts -threaded
进行四核imac):
-N3
如上所示,在./test +RTS -s -N3
1,096,608,080 bytes allocated in the heap
2,713,129,232 bytes copied during GC
761,160,288 bytes maximum residency (10 sample(s))
711,798,176 bytes maximum slop
2424 MB total memory in use (0 MB lost due to fragmentation)
Generation 0: 1177 collections, 1176 parallel, 46.51s, 15.93s elapsed
Generation 1: 10 collections, 10 parallel, 9.35s, 5.60s elapsed
Parallel GC work balance: 1.05 (339027672 / 323162843, ideal 3)
MUT time (elapsed) GC time (elapsed)
Task 0 (worker) : 0.00s ( 0.00s) 0.00s ( 0.00s)
Task 1 (worker) : 56.95s ( 1.49s) 0.26s ( 0.09s)
Task 2 (worker) : 57.05s ( 1.49s) 0.16s ( 0.05s)
Task 3 (bound) : 1.49s ( 1.23s) 55.27s ( 21.33s)
Task 4 (worker) : 57.20s ( 1.49s) 0.00s ( 0.00s)
Task 5 (worker) : 57.03s ( 1.49s) 0.18s ( 0.06s)
SPARKS: 0 (0 converted, 0 pruned)
INIT time 0.00s ( 0.00s elapsed)
MUT time 0.90s ( 1.23s elapsed)
GC time 55.86s ( 21.53s elapsed)
EXIT time 0.45s ( 0.40s elapsed)
Total time 57.21s ( 23.02s elapsed)
%GC time 97.6% (93.5% elapsed)
Alloc rate 811,808,581 bytes per MUT second
Productivity 2.4% of total user, 5.9% of total elapsed
gc_alloc_block_sync: 19789
whitehole_spin: 73
gen[0].sync_large_objects: 0
gen[1].sync_large_objects: 0
模式下,使用的总内存从~9MB上升到~2GB。在两种情况下在堆上分配的总内存在~1%之内。我怀疑大多数常驻内存开销来自分支函数,因为堆上的每个函数实例都必须是thunk。由于我没有使用任何标准策略,因此没有任何火花。
我编写了这段代码,因为我对使用和不使用-threaded
模式的行为感到好奇,而不是因为我打算以这种方式使用它。基本上,我正在教自己,如果你编写一个像这样的错误代码会发生什么。所以,你不必说不要这样写:)
编辑1:
ehird在评论中指出,检查-threaded
运行时本身是否有助于减速。线程运行时似乎不会导致速度减慢 - 使用threaded
选项进行编译不会改变性能。只有在运行时使用-threaded
选项时才会发生减速。
答案 0 :(得分:4)
测试程序没有做你期望的工作。一旦main
线程完成分叉,它就会完成并退出整个程序。
如果没有线程运行时,这很快就会发生。使用线程,运行时可以在main
线程完成之前切换并执行部分工作,但不能所有工作。
如果你想让这个微基准标记工作,你需要重新设计测试:
{-# LANGUAGE BangPatterns #-}
import Control.Concurrent (forkIO, MVar, newEmptyMVar, putMVar, takeMVar, threadDelay)
import Control.Monad (mapM_)
l = 100000
f :: MVar Int -> IO ()
f m = do
!i <- takeMVar m
putMVar m (i+1)
if i==l then print "done" else return ()
main = do
m <- newEmptyMVar
putMVar m 1
mapM_ (\x -> forkIO $ f m) [1..l]
-- threadDelay (1000*1000)
我稍微更改了l
值,并在1开始m
。当主线程延迟足够长时间让最后一个线程执行{{的最后一次增量时,它将只打印“done” 1}}。
如果将i
更改为程序退出命令,则可以执行时间。