Por que o GHC Sparks Fizzling?

Question

Oct 05, 2017, 03:31 PM

Por que o GHC Sparks Fizzling?

Eu tenho uma rotina simples que leva o produto de um vetor deDouble. Estou tentando paralelizar esse código, mas muitas das faíscas acabam fracassando. Aqui está uma referência independente que também é fornecidacomo uma essência:

{-# 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)

Isso pode ser criado e executado com:

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

Eu tenho uma caixa de oito núcleos, portanto, dar ao tempo de execução quatro recursos deve ser bom. Os resultados do benchmark não são super importantes, mas aqui estão eles:

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)

Agora, as estatísticas de tempo de execução. Aqui é onde estou confuso:

   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

Na seção que trata de faíscas, podemos ver que cerca de metade delas fracassa. Isso parece inacreditável para mim. NoparallelProduct, temos o trabalho do thread principal em uma tarefa 6 vezes maior do que o que é dado a qualquer uma das faíscas. No entanto, parece que uma dessas faíscas sempre fica fracassada (ou GCed). E este também não é um trabalho pequeno. Estamos falando de uma computação que leva milissegundos, por isso parece implausível que o thread principal possa finalizá-lo antes que os outros thunks sejam acionados.

Meu entendimento (que pode estar totalmente errado) é que esse tipo de computação deve ser ideal para o tempo de execução simultâneo. A coleta de lixo parece ser o maior problema para aplicativos concorrentes no GHC, mas a tarefa que estou realizando aqui não gera quase lixo, pois o GHC transforma as entranhas deserialProduct em um loop apertado com tudo fora da caixa.

No lado positivo, nósFaz veja uma aceleração de 11% para a versão paralela nos benchmarks. Portanto, a oitava parte do trabalho que foi desencadeado com sucesso realmente causou um impacto mensurável. Só estou me perguntando por que essa outra faísca não funciona como eu esperava.

Qualquer ajuda para entender isso seria apreciada.

EDITAR

Eu atualizeia essência para incluir outra implementação:

-- | 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)

Este possui excelente desempenho:

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)

Porém, ele recorre às primitivas de simultaneidade convencionais em vez de usar faíscas. Não gosto dessa solução, mas a estou fornecendo como evidência de que deve ser possível obter o mesmo desempenho com uma abordagem baseada em faíscas.

leaveComments