perf(runtime): make MP benchmark use three producers

src/runtime-prototype/bench/disruptor/MP.hs

@@ -67,7 +67,7 @@ once = do
   let handler _s _n snr endOfBatch = do
         -- t' <- {-# SCC "transactions-1" #-} decrCounter 1 transactions
         -- measureInt_ t' histo
-        when (endOfBatch && getSequenceNumber snr == (iTERATIONS * 2) - 1) $
+        when (endOfBatch && getSequenceNumber snr == (iTERATIONS * 3) - 1) $
           putMVar consumerFinished ()
         return ()
 
@@ -78,22 +78,24 @@ once = do
   start <- getCurrentTime
   withEventProducer ep $ \aep1 ->
     withEventProducer ep $ \aep2 ->
-      withEventConsumer ec $ \aec -> do
-        () <- takeMVar consumerFinished
-        end <- getCurrentTime
-        cancel aep1
-        cancel aep2
-        cancel aec
-        let duration :: Double
-            duration = realToFrac (diffUTCTime end start)
+      withEventProducer ep $ \aep3 ->
+        withEventConsumer ec $ \aec -> do
+          () <- takeMVar consumerFinished
+          end <- getCurrentTime
+          cancel aep1
+          cancel aep2
+          cancel aep3
+          cancel aec
+          let duration :: Double
+              duration = realToFrac (diffUTCTime end start)
 
-            throughput :: Double
-            throughput = realToFrac iTERATIONS / duration
-        printf "%-25.25s%10.2f events/s\n" "Throughput" throughput
-        printf "%-25.25s%10.2f s\n" "Duration" duration
-        -- XXX: prettyPrintHistogram histo
-        -- meanTransactions <- hmean histo
-        -- printf "%-25.25s%10.2f\n" "Mean concurrent txs" meanTransactions
-        -- Just maxTransactions <- percentile 100.0 histo
-        -- printf "%-25.25s%10.2f\n" "Max concurrent txs" maxTransactions
-        -- printf "%-25.25s%10.2f ns\n" "Latency" ((meanTransactions / throughput) * 1000000)
+              throughput :: Double
+              throughput = realToFrac iTERATIONS / duration
+          printf "%-25.25s%10.2f events/s\n" "Throughput" throughput
+          printf "%-25.25s%10.2f s\n" "Duration" duration
+          -- XXX: prettyPrintHistogram histo
+          -- meanTransactions <- hmean histo
+          -- printf "%-25.25s%10.2f\n" "Mean concurrent txs" meanTransactions
+          -- Just maxTransactions <- percentile 100.0 histo
+          -- printf "%-25.25s%10.2f\n" "Max concurrent txs" maxTransactions
+          -- printf "%-25.25s%10.2f ns\n" "Latency" ((meanTransactions / throughput) * 1000000)

src/runtime-prototype/bench/disruptor/MPUnagiChan.hs

@@ -21,24 +21,26 @@ main = do
   (i, o) <- newChan
 
   let producer = replicateM_ iTERATIONS (writeChan i (1 :: Int))
-      consumer = replicateM_ (iTERATIONS * 2) (readChan (threadDelay 1) o)
+      consumer = replicateM_ (iTERATIONS * 3) (readChan (threadDelay 1) o)
 
   performGC
   start <- getCurrentTime
 
   withAsync producer $ \ap1 ->
     withAsync producer $ \ap2 ->
-      withAsync consumer $ \ac -> do
-        wait ap1
-        wait ap2
-        wait ac
-        end <- getCurrentTime
-
-        let duration :: Double
-            duration = realToFrac (diffUTCTime end start)
-
-            throughput :: Double
-            throughput = realToFrac iTERATIONS / duration
-
-        printf "%-25.25s%10.2f events/s\n" "Throughput" throughput
-        printf "%-25.25s%10.2f s\n" "Duration" duration
+      withAsync producer $ \ap3 ->
+        withAsync consumer $ \ac -> do
+          wait ac
+          end <- getCurrentTime
+          wait ap1
+          wait ap2
+          wait ap3
+
+          let duration :: Double
+              duration = realToFrac (diffUTCTime end start)
+
+              throughput :: Double
+              throughput = realToFrac iTERATIONS / duration
+
+          printf "%-25.25s%10.2f events/s\n" "Throughput" throughput
+          printf "%-25.25s%10.2f s\n" "Duration" duration

src/runtime-prototype/bench/disruptor/SP.hs

@@ -29,7 +29,7 @@ main = do
   n <- getNumCapabilities
   printf "%-25.25s%10d\n" "CPU capabilities" n
   printf "%-25.25s%10d\n" "Total number of events" iTERATIONS
-  mapM_ (\i -> printf "%s %d:\n" "Run" i >> once) [(0 :: Int)..7]
+  mapM_ (\i -> printf "%s %d:\n" "Run" i >> once) [(0 :: Int)..0]
 
 once :: IO ()
 once = do

src/runtime-prototype/bench/disruptor/SingleOps.hs

@@ -13,6 +13,16 @@ import System.CPUTime
 import StuntDouble.Histogram
 import qualified Disruptor.AtomicCounterPadded as Padded
 
+-- Can't load FastMutInt:
+--    Could not load module `FastMutInt'
+--    It is a member of the hidden package `ghc-8.10.4'.
+--    Perhaps you need to add `ghc' to the build-depends in your .cabal file.
+--
+-- But when I add ghc to build-depends it says it can't find a build plan, and
+-- also https://hackage.haskell.org/package/ghc doesn't seem to have 8.10.4...
+--
+-- import FastMutInt
+
 ------------------------------------------------------------------------
 
 main :: IO ()
@@ -23,6 +33,8 @@ main = do
 
   many "incrCounter1" (newCounter 0) (incrCounter 1)
   many "incrCounter1Padded" (Padded.newCounter 0) (Padded.incrCounter 1)
+  -- many "incrCounter1FastMutInt" (newFastMutInt 0)
+  --      (\r -> readFastMutInt r >>= \v -> writeFastMutInt r (v +1))
 
   manyConcurrent "incrCounter1Concurrent"
     3 (newCounter 0) (incrCounter 1)

src/runtime-prototype/benchmark.sh

@@ -8,7 +8,8 @@ BENCHMARK_WORKLOAD1="bench-disruptor-sp"
 BENCHMARK_WORKLOAD2="bench-disruptor-mp"
 BENCHMARK_NUMBER_OF_RUNS=5
 BENCHMARK_CABAL_BUILD_OPTS=("--disable-profiling" "-O2")
-BENCHMARK_CABAL_RUN_OPTS=("-O2")
+BENCHMARK_GHC_OPTS=("-threaded" "-rtsopts" "-with-rtsopts=-N")
+BENCHMARK_CABAL_RUN_OPTS=("-O2" "--ghc-options=${BENCHMARK_GHC_OPTS[*]}")
 BENCHMARK_PERF_EVENTS="L1-dcache-loads,L1-dcache-load-misses,LLC-loads,LLC-load-misses,dTLB-loads,dTLB-load-misses"
 
 # Save info about current hardware and OS setup.

src/runtime-prototype/src/Disruptor/MP/RingBuffer.hs

@@ -20,6 +20,7 @@ import Disruptor.AtomicCounterPadded
 -- | The lock-free multi-producer implementation is presented in the following
 -- talk:
 --
+--   Locks? We Don't Need No Stinkin' Locks! by Mike Barker (JAX London 2012)
 --   https://youtu.be/VBnLW9mKMh4?t=1813
 --
 -- and also discussed in the following thread: