git.iko.soy/distributed-process
on master help sign in
Cleaned up the benchmark setup. Now all benchmarks can run either

a single trial (no criterion) or multiple trials with criterion. Added some notes on the performance I'm observing. The TCP transport is adding an unfortunate amount of latency.

commitcdfd7dad3cab477c38a31915f1892651798dd51c authorRyan Newton <rrnewton@gmail.com> dateFri 24 Feb 2012, 10:44 (15 years ago) parentf5494b3
7 files changed+166−31
compare with master
unifiedsplit
benchmarks/Makefile+34−10 benchmarks/PingPipes.hs+27−9 benchmarks/PingTCP.hs+15−4 benchmarks/PingTransport.hs → benchmarks/PingTCPTransport.hs+15−5 benchmarks/results_notes.md+64 network-transport-pipes/network-transport-pipes.cabal+5−2 network-transport/network-transport.cabal+6−1
benchmarks/Makefile+34−10
@@ -1,27 +1,51 @@
11
2+# Run 100K ping-pongs, for one trial:
3+pings = 100000
4+trials = 1
5+# You can run "make run1 pings=1000 trials=100" for example.
6+
7+
8+# Disable this to test installed packages only:
9+INCLUDES= -i../network-transport/src -i../network-transport-pipes/src
210
311ifeq ($(GHC),)
412 GHC=ghc
513endif
614
7−all: pipes tcp transport
15+all: pipes tcp baseline
16+baseline:
17+ $(GHC) -O2 -rtsopts -threaded --make $(INCLUDES) PingTCP.hs -o PingTCP.exe
818tcp:
9− $(GHC) -O2 -rtsopts -threaded --make -i../network-transport/src PingTCP.hs -o PingTCP.exe
10−transport:
11− $(GHC) -O2 -rtsopts -threaded --make -i../network-transport/src PingTransport.hs -o PingTransport.exe
19+ $(GHC) -O2 -rtsopts -threaded --make $(INCLUDES) PingTCPTransport.hs -o PingTCPTransport.exe
1220pipes:
13− $(GHC) -O2 -rtsopts -threaded --make -i../network-transport/src PingPipes.hs -o PingPipes.exe
21+ $(GHC) -O2 -rtsopts -threaded --make $(INCLUDES) PingPipes.hs -o PingPipes.exe
22+
23+run: run1 run2
1424
15−run: runBaseline runTransport
25+run1: runBaseline
1626runBaseline:
1727 ./PingTCP.exe server 8080 &
1828 sleep 1
19− ./PingTCP.exe client 0.0.0.0 8080 1000
29+ time ./PingTCP.exe client 0.0.0.0 8080 $(pings) $(trials)
30+ # Kill the server:
31+ killall PingTCP.exe
32+
33+run2: runTCP
34+runTCP:
35+ ./PingTCPTransport.exe server 0.0.0.0 8080 sourceAddr &
36+ sleep 1
37+ # Run 100K ping-pongs, for one trial:
38+ time ./PingTCPTransport.exe client 0.0.0.0 8081 sourceAddr $(pings) $(trials)
39+ # Kill the server:
40+ killall PingTCPTransport.exe
2041
21−runTransport:
22− ./PingTransport.exe server 0.0.0.0 8080 sourceAddr &
42+run3: runPipes
43+runPipes:
44+ ./PingPipes.exe server sourceAddr &
2345 sleep 1
24− ./PingTransport.exe client 0.0.0.0 8081 sourceAddr 1000
46+ time ./PingPipes.exe client sourceAddr $(pings) $(trials)
47+ # Kill the server:
48+ killall PingPipes.exe
2549
2650clean:
2751 rm -f *.hi *.o *.exe
benchmarks/PingPipes.hs+27−9
@@ -1,16 +1,22 @@
11module Main where
22
3−import Network.Transport
3+-- TODO: Merge with PingTCPTransport and factor differences.
4+
5+import Network.Transport (newConnection, receive, connect, send,
6+ serialize, deserialize, SourceEnd, TargetEnd)
47import Network.Transport.Pipes (mkTransport)
58
69import Control.Monad (forever, replicateM_)
7−import Criterion.Main (Benchmark, bench, defaultMain, nfIO)
8−import Data.Binary
10+import Criterion.Main (Benchmark, bench, defaultMainWith, nfIO)
11+import Criterion.Config (defaultConfig, ljust, Config(cfgSamples))
12+-- import Data.Binary (encode,decode)
13+import Data.Serialize (encode,decode)
914import Data.Maybe (fromJust)
1015import Data.Int
1116import System.Environment (getArgs, withArgs)
1217
13−import qualified Data.ByteString.Lazy.Char8 as BS
18+-- import qualified Data.ByteString.Lazy.Char8 as LBS
19+import qualified Data.ByteString.Char8 as BS
1420
1521-- | This performs a ping benchmark on the TCP transport. This can be
1622-- compiled using:
@@ -50,7 +56,7 @@ main = do
5056 forever $ pong targetEndPing sourceEndPong
5157
5258
53− "client" : sourceAddrFilePath : pingsStr : args' -> do
59+ "client" : sourceAddrFilePath : pingsStr : reps : args' -> do
5460 let pings = read pingsStr
5561 -- establish transport
5662 transport <- mkTransport
@@ -64,10 +70,17 @@ main = do
6470 send sourceEndPing [serialize sourceAddrPong]
6571
6672 -- benchmark the pings
67−-- withArgs args' $ defaultMain [ benchPing sourceEndPing targetEndPong pings]
68− replicateM_ pings (ping sourceEndPing targetEndPong)
73+ case (read reps) :: Int of
74+ 0 -> error "What would zero reps mean?"
75+ 1 -> do putStrLn "Because you're timing only one trial, skipping Criterion..."
76+ replicateM_ pings (ping sourceEndPing targetEndPong)
77+ n -> withArgs args' $ defaultMainWith
78+ (defaultConfig{ cfgSamples = ljust n })
79+ (return ()) -- Init action.
80+ [ benchPing sourceEndPing targetEndPong (fromIntegral pings) ]
6981 putStrLn "Done with all ping/pongs."
7082
83+
7184-- | This function takes a `TargetEnd` for the pings, and a `SourceEnd` for
7285-- pongs. Whenever a ping is received from the `TargetEnd`, a pong is sent
7386-- in reply down the `SourceEnd`, repeating whatever was sent.
@@ -81,9 +94,14 @@ pong targetEndPing sourceEndPong = do
8194-- `targetEndPong`, which is then returned.
8295ping :: SourceEnd -> TargetEnd -> IO Int64
8396ping sourceEndPing targetEndPong = do
84− send sourceEndPing [BS.empty]
97+ -- send sourceEndPing [BS.empty]
98+ send sourceEndPing [encode (42 :: Int64)]
99+
85100 [bs] <- receive targetEndPong
86− return $ decode bs
101+-- return $ decode bs
102+ case decode bs of
103+ Left err -> error$ "decode failure: " ++ err
104+ Right x -> return x
87105
88106-- | The effect of `benchPing sourceEndPing targetEndPong n` is to send
89107-- `n` pings down `sourceEndPing` using the `ping` function. The time
benchmarks/PingTCP.hs+15−4
@@ -3,7 +3,8 @@
33module Main where
44
55import Control.Monad
6−import Criterion.Main (Benchmark, bench, defaultMain, nfIO, bgroup)
6+import Criterion.Main (Benchmark, bench, defaultMainWith, nfIO)
7+import Criterion.Config (defaultConfig, ljust, Config(cfgSamples))
78
89import Data.Int
910import qualified Data.Serialize as Ser
@@ -73,7 +74,7 @@ main = do
7374 putStrLn "server: listening for pings"
7475 forever (pong clientSock)
7576
76− "client": host : service : pingsStr : args' -> withSocketsDo $ do
77+ "client": host : service : pingsStr : reps : args' -> withSocketsDo $ do
7778 let pings = read pingsStr
7879 serverAddrs <- getAddrInfo
7980 Nothing
@@ -85,14 +86,24 @@ main = do
8586 N.connect sock (addrAddress serverAddr)
8687
8788 -- benchmark the pings
88− withArgs args' $ defaultMain [ benchPing sock pings ]
89+ case (read reps) :: Int of
90+ 0 -> error "What would zero reps mean?"
91+ 1 -> do putStrLn "Because you're timing only one trial, skipping Criterion..."
92+ replicateM_ pings (ping sock)
93+ n -> withArgs args' $ defaultMainWith
94+ (defaultConfig{ cfgSamples = ljust n })
95+ (return ()) -- Init action.
96+ [ benchPing sock (fromIntegral pings) ]
97+ putStrLn "Done with all ping/pongs."
98+
99+-- withArgs args' $ defaultMain [ benchPing sock pings ]
89100-- replicateM_ pings (ping sock)
90101
91102-- | Each `ping` sends a single byte, and expects to receive one
92103-- back in return.
93104ping :: Socket -> IO Int64
94105ping sock = do
95− NBS.send sock $ encode (0 :: Int64)
106+ NBS.send sock $ encode (42 :: Int64)
96107 bs <- NBS.recv sock 8
97108 either error return $ decode bs
98109
benchmarks/PingTransport.hs → benchmarks/PingTCPTransport.hsrenamed+15−5
@@ -2,11 +2,14 @@
22
33module Main where
44
5−import Network.Transport
5+import Network.Transport (newConnection, receive, connect, send, defaultHints,
6+ serialize, deserialize, SourceEnd, TargetEnd)
67import Network.Transport.TCP (mkTransport, TCPConfig (..))
78
89import Control.Monad (forever, replicateM_)
9−import Criterion.Main (Benchmark, bench, defaultMain, nfIO)
10+import Criterion.Main (Benchmark, bench, defaultMainWith, nfIO)
11+import Criterion.Config (defaultConfig, ljust, Config(cfgSamples))
12+
1013import qualified Data.Serialize as Ser
1114import Data.Maybe (fromJust)
1215import Data.Int
@@ -68,7 +71,7 @@ main = do
6871 forever $ pong targetEndPing sourceEndPong
6972
7073
71− "client" : host : service : sourceAddrFilePath : pingsStr : args' -> do
74+ "client" : host : service : sourceAddrFilePath : pingsStr : reps : args' -> do
7275 let pings = read pingsStr
7376 -- establish transport
7477 transport <- mkTransport $ TCPConfig defaultHints host service
@@ -82,8 +85,15 @@ main = do
8285 send sourceEndPing [serialize sourceAddrPong]
8386
8487 -- benchmark the pings
85− withArgs args' $ defaultMain [ benchPing sourceEndPing targetEndPong pings]
86−-- replicateM_ pings (ping sourceEndPing targetEndPong)
88+ case (read reps) :: Int of
89+ 0 -> error "What would zero reps mean?"
90+ 1 -> do putStrLn "Because you're timing only one trial, skipping Criterion..."
91+ replicateM_ pings (ping sourceEndPing targetEndPong 42)
92+ n -> withArgs args' $ defaultMainWith
93+ (defaultConfig{ cfgSamples = ljust n })
94+ (return ()) -- Init action.
95+ [ benchPing sourceEndPing targetEndPong (fromIntegral pings)]
96+ putStrLn "Done with all ping/pongs."
8797
8898-- | This function takes a `TargetEnd` for the pings, and a `SourceEnd` for
8999-- pongs. Whenever a ping is received from the `TargetEnd`, a pong is sent
benchmarks/results_notes.mdnew file+64
@@ -0,0 +1,64 @@
1+
2+
3+[2012.02.22] {File for notes on results}
4+============================================================
5+
6+Here's a run of the PingTCP benchmark on a 3.1 ghz Intel Westmere running RHEL 6.2:
7+
8+ ./PingTCP.exe server 8080 &
9+ sleep 1
10+ server: creating TCP connection
11+ server: awaiting client connection
12+ ./PingTCP.exe client 0.0.0.0 8080 1000
13+ server: listening for pings
14+ warming up
15+ estimating clock resolution...
16+ mean is 1.963031 us (320001 iterations)
17+ found 38180 outliers among 319999 samples (11.9%)
18+ 32741 (10.2%) low severe
19+ 5439 (1.7%) high severe
20+ estimating cost of a clock call...
21+ mean is 43.17696 ns (15 iterations)
22+ found 2 outliers among 15 samples (13.3%)
23+ 1 (6.7%) high mild
24+ 1 (6.7%) high severe
25+
26+ benchmarking PingTCP
27+ collecting 100 samples, 1 iterations each, in estimated 8.073997 s
28+ mean: 77.01177 ms, lb 76.92822 ms, ub 77.14009 ms, ci 0.950
29+ std dev: 526.1251 us, lb 366.2692 us, ub 803.1751 us, ci 0.950
30+
31+(That was without -O2)
32+
33+ -----
34+
35+Running a C benchmark on the same machine it takes 5.6 seconds to do
36+200K ping pongs.
37+
38+ => 28 us avg latency for C
39+
40+I got 72 us avg latency using PingTCP. The named pipes backend took
41+19.8s and was using 100% CPU. That's a 99 us latency.
42+
43+Pipes with unix-bytestring take 11.0 seconds, but still use 100% CPU.
44+
45+ => 55 us latency for Pipes with unix-bytestring
46+
47+
48+
49+[2012.02.24] {After Adam's strictness refactoring.}
50+============================================================
51+
52+100K ping/pongs, 1 trial:
53+
54+ PingTCP: 7.34s >80%CPU
55+ PingTCPTransport: 19s ~60%CPU
56+ PingPipes: 6.36s >=100%CPU
57+
58+Timing instead using 100 trials of 1000 pingpongs via criterion gives
59+results consistent with the above. Here are the mean latencies:
60+
61+ PingTCP: 72 us
62+ PingTCPTransport: 191 us
63+ PingPipes: 65 us
64+
network-transport-pipes/network-transport-pipes.cabal+5−2
@@ -1,5 +1,8 @@
11Name: network-transport-pipes
2−Version: 0.0.1
2+Version: 0.0.1.1
3+-- Version History:
4+-- 0.0.1.1 - Initial
5+
36Description: Named Pipes backend for network-transport interface.
47License: BSD3
58License-file: LICENSE
@@ -14,7 +17,7 @@ Library
1417 binary >= 0.5,
1518 cereal,
1619 bytestring >= 0.9,
17− network-transport,
20+ network-transport >= 0.0.1.1,
1821 containers >= 0.4,
1922-- network >= 2.3,
2023-- safe >= 0.3,
network-transport/network-transport.cabal+6−1
@@ -1,5 +1,10 @@
11Name: network-transport
2−Version: 0.0.1
2+Version: 0.0.1.1
3+
4+-- Version History:
5+-- 0.0.1 - Initial
6+-- 0.0.1.1 - Bump for Adam's change to strict BS.
7+
38Description: Network transport interface
49License: BSD3
510License-file: LICENSE