为什么 GHC Sparks 会发出嘶嘶声？

Question

我有一个简单的例程，它计算 Double 的向量的乘积。我试图并行化这段代码，但许多火花最终都失败了。这是一个独立的基准测试，也提供了 as a gist:

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}

{-# OPTIONS_GHC -O2 -Wall -threaded -fforce-recomp #-}

import Criterion.Main
import Control.Monad (when)
import Control.Parallel.Strategies (runEval,rpar,rseq)
import qualified Data.Vector.Primitive as PV

main :: IO ()
main = do
  let expected = PV.product numbers
  when (not (serialProduct numbers == expected)) $ do
    fail "serialProduct implementation incorrect"
  defaultMain
    [ bgroup "product"
      [ bench "serial" $ whnf serialProduct numbers
      , bench "parallel" $ whnf parallelProduct numbers
      ]
    ]

numbers :: PV.Vector Double
numbers = PV.replicate 10000000 1.00000001
{-# NOINLINE numbers #-}

serialProduct :: PV.Vector Double -> Double
serialProduct v =
  let !len = PV.length v
      go :: Double -> Int -> Double
      go !d !ix = if ix < len then go (d * PV.unsafeIndex v ix) (ix + 1) else d
   in go 1.0 0

-- | This only works when the vector length is a multiple of 8.
parallelProduct :: PV.Vector Double -> Double
parallelProduct v = runEval $ do
  let chunk = div (PV.length v) 8
  p2 <- rpar (serialProduct (PV.slice (chunk * 6) chunk v))
  p3 <- rpar (serialProduct (PV.slice (chunk * 7) chunk v))
  p1 <- rseq (serialProduct (PV.slice (chunk * 0) (chunk * 6) v))
  return (p1 * p2 * p3)

这可以构建并且运行使用：

ghc -threaded parallel_compute.hs
./parallel_compute +RTS -N4 -s

我有一个八核盒子，所以给运行时间四个能力应该没问题。基准测试结果不是特别重要，但这里是：

benchmarking product/serial
time                 11.40 ms   (11.30 ms .. 11.53 ms)
                     0.999 R²   (0.998 R² .. 1.000 R²)
mean                 11.43 ms   (11.37 ms .. 11.50 ms)
std dev              167.2 μs   (120.4 μs .. 210.1 μs)

benchmarking product/parallel
time                 10.03 ms   (9.949 ms .. 10.15 ms)
                     0.999 R²   (0.999 R² .. 1.000 R²)
mean                 10.17 ms   (10.11 ms .. 10.31 ms)
std dev              235.7 μs   (133.4 μs .. 426.2 μs)

现在，运行时间统计。这是我感到困惑的地方：

   124,508,840 bytes allocated in the heap
   529,843,176 bytes copied during GC
    80,232,008 bytes maximum residency (8344 sample(s))
       901,272 bytes maximum slop
            83 MB total memory in use (0 MB lost due to fragmentation)

                                   Tot time (elapsed)  Avg pause  Max pause
Gen  0        19 colls,    19 par    0.008s   0.001s     0.0001s    0.0003s
Gen  1      8344 colls,  8343 par    2.916s   1.388s     0.0002s    0.0008s

Parallel GC work balance: 76.45% (serial 0%, perfect 100%)

TASKS: 13 (1 bound, 12 peak workers (12 total), using -N4)

SPARKS: 1024 (502 converted, 0 overflowed, 0 dud, 28 GC'd, 494 fizzled)

INIT    time    0.000s  (  0.002s elapsed)
MUT     time   11.480s  ( 10.414s elapsed)
GC      time    2.924s  (  1.389s elapsed)
EXIT    time    0.004s  (  0.005s elapsed)
Total   time   14.408s  ( 11.811s elapsed)

Alloc rate    10,845,717 bytes per MUT second

Productivity  79.7% of total user, 88.2% of total elapsed

在处理火花的部分，我们可以看到大约一半的火花熄灭了。这对我来说似乎难以置信。在 parallelProduct 中，我们让主线程处理的任务比分配给任一 spark 的任务大 6 倍。然而，这些火花中的一个似乎总是失败（或 GC）。这也不是一件小事。我们正在谈论一个需要几毫秒的计算，所以主线程可以在其他 thunk 被激发之前完成它似乎是难以置信的。

我的理解（可能完全错误）是这种计算对于并发运行时间应该是理想的。垃圾收集似乎是 GHC 中并发应用程序的最大问题，但我在这里做的任务几乎不会产生任何垃圾，因为 GHC 将 serialProduct 的内部结构变成了一个紧密循环，所有内容都未装箱。

从好的方面来看，我们确实看到基准测试中的并行版本有 11% 的加速。因此，成功引发的第八部分工作确实产生了可衡量的影响。我只是想知道为什么其他火花不能像我预期的那样工作。

如能帮助理解这一点，我们将不胜感激。

编辑

我更新了 the gist 以包含另一个实现：

-- | This only works when the vector length is a multiple of 4.
parallelProductFork :: PV.Vector Double -> Double
parallelProductFork v = unsafePerformIO $ do
  let chunk = div (PV.length v) 4
  var <- newEmptyMVar 
  _ <- forkIO $ evaluate (serialProduct (PV.slice (chunk * 0) chunk v)) >>= putMVar var
  _ <- forkIO $ evaluate (serialProduct (PV.slice (chunk * 1) chunk v)) >>= putMVar var
  _ <- forkIO $ evaluate (serialProduct (PV.slice (chunk * 2) chunk v)) >>= putMVar var
  _ <- forkIO $ evaluate (serialProduct (PV.slice (chunk * 3) chunk v)) >>= putMVar var
  a <- takeMVar var
  b <- takeMVar var
  c <- takeMVar var
  d <- takeMVar var
  return (a * b * c * d)

这台性能优异：

benchmarking product/parallel mvar
time                 3.814 ms   (3.669 ms .. 3.946 ms)
                     0.986 R²   (0.977 R² .. 0.992 R²)
mean                 3.818 ms   (3.708 ms .. 3.964 ms)
std dev              385.6 μs   (317.1 μs .. 439.8 μs)
variance introduced by outliers: 64% (severely inflated)

但是，它依赖于传统的并发原语而不是使用 spark。我不喜欢这个解决方案，但我提供它作为证据，证明使用基于 spark 的方法应该可以实现相同的性能。

Answer 1

这里的问题是创建 spark 不会立即唤醒空闲功能，请参阅 here。默认调度间隔是 20ms，所以当你创建一个 spark 时，它最多需要 20ms 才能将它变成一个真正的线程。到那时，调用线程很可能已经评估了 thunk，并且 spark 将被 GC 或 fizzled。

相比之下，forkIO 将立即唤醒空闲功能（如果有）。这就是显式并发比并行策略更可靠的原因。

您可以通过使用 -C 选项 (docs) 减少调度间隔来解决此问题。例如。 +RTS -C0.01 好像够了。

为什么 GHC Sparks 会发出嘶嘶声？

Why are GHC Sparks Fizzling?

haskell

ghc