5395dd9 · distributed-process

git.iko.soy/distributed-process

Merge branch 'master' of https://github.com/haskell-distributed/distributed-process

commit5395dd937cea3e99a837cba8795a8538c15722b8 authorAdam Foltzer <acfoltzer@gmail.com> dateFri 24 Feb 2012, 12:13 (15 years ago) parent5994848 ff8d9c6

9 files changed+253−34

compare with master

unifiedsplit

benchmarks/Makefile+54−12 benchmarks/PingPipes.hs+27−9 benchmarks/PingTCP.hs+15−4 benchmarks/PingTransport.hs → benchmarks/PingTCPTransport.hs+15−5 benchmarks/SendTransport.hs+2−1 benchmarks/results_notes.md+111 install_all.sh+18 network-transport-pipes/network-transport-pipes.cabal+5−2 network-transport/network-transport.cabal+6−1

benchmarks/Makefile+54−12

@@ -1,27 +1,69 @@

2+# Run 100K ping-pongs, for one trial:

3+size = 100000

4+trials = 1

5+# You can run "make run1 size=1000 trials=100" for example.

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

8−tcp:

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

12−pipes:

13− $(GHC) -O2 -rtsopts -threaded --make -i../network-transport/src PingPipes.hs -o PingPipes.exe

15+BENCHS= PingTCP.exe PingTCPTransport.exe PingPipes.exe SendTransport.exe

16+

17+all: $(BENCHS)

18+$(BENCHS): %.exe: %.hs

19+ $(GHC) -O2 -rtsopts -threaded --make $(INCLUDES) $< -o $@

20+

21+#-------------------------------------------------------------------------------

22+# Shorthands for running benchmarks:

23+

24+run: run1 run2 run3 run4

1425

15−run: runBaseline runTransport

26+run1: runBaseline

1627runBaseline:

1728 ./PingTCP.exe server 8080 &

1829 sleep 1

19− ./PingTCP.exe client 0.0.0.0 8080 1000

30+ time ./PingTCP.exe client 0.0.0.0 8080 $(size) $(trials)

31+ # Kill the server:

32+ killall PingTCP.exe

2033

21−runTransport:

22− ./PingTransport.exe server 0.0.0.0 8080 sourceAddr &

34+run2: runTCP

35+runTCP:

36+ ./PingTCPTransport.exe server 0.0.0.0 8080 sourceAddr &

2337 sleep 1

24− ./PingTransport.exe client 0.0.0.0 8081 sourceAddr 1000

38+ # Run 100K ping-pongs, for one trial:

39+ time ./PingTCPTransport.exe client 0.0.0.0 8081 sourceAddr $(size) $(trials)

40+ # Kill the server:

41+ killall PingTCPTransport.exe

42+

43+run3: runPipes

44+runPipes:

45+ ./PingPipes.exe server sourceAddr &

46+ sleep 1

47+ time ./PingPipes.exe client sourceAddr $(size) $(trials)

48+ # Kill the server:

49+ killall PingPipes.exe

50+

51+# This benchmark measures throughput rather than latency

52+# Here 'size' means message size rather than number of pings:

53+run4: runTPT

54+runTPT:

55+ ./SendTransport.exe server 0.0.0.0 8080 sourceAddr &

56+ sleep 1

57+ ./SendTransport.exe client 0.0.0.0 8081 sourceAddr $(size)

58+ killall SendTransport.exe

59+

60+# Run multiple sizes:

61+runTPTs:

62+ $(MAKE) runTPT size=1000

63+ $(MAKE) runTPT size=5000

64+ $(MAKE) runTPT size=10000

65+ $(MAKE) runTPT size=50000

66+ $(MAKE) runTPT size=100000

2567

2668clean:

2769 rm -f *.hi *.o *.exe

benchmarks/PingPipes.hs+27−9

@@ -1,16 +1,22 @@

11module Main where

3−import Network.Transport

3+-- TODO: Merge with PingTCPTransport and factor differences.

5+import Network.Transport (newConnection, receive, connect, send,

6+ serialize, deserialize, SourceEnd, TargetEnd)

47import Network.Transport.Pipes (mkTransport)

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

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

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

33module Main where

5−import Network.Transport

5+import Network.Transport (newConnection, receive, connect, send, defaultHints,

6+ serialize, deserialize, SourceEnd, TargetEnd)

67import Network.Transport.TCP (mkTransport, TCPConfig (..))

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/SendTransport.hs+2−1

@@ -3,7 +3,8 @@

44module Main where

6−import Network.Transport

6+import Network.Transport (newConnection, receive, connect, send, defaultHints,

7+ serialize, deserialize, SourceEnd, TargetEnd)

78import Network.Transport.TCP (mkTransport, TCPConfig (..))

910import Control.Applicative

benchmarks/results_notes.mdnew file+111

@@ -0,0 +1,111 @@

3+[2012.02.22] {File for notes on results}

4+============================================================

6+Here's a run of the PingTCP benchmark on a 3.1 ghz Intel Westmere running RHEL 6.2:

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+

65+And here is my first attempt at running the SendTransport benchmark (TCP backend):

66+

67+ ./SendTransport.exe client 0.0.0.0 8081 sourceAddr 1000

68+ mean: 38.10901 ms, lb 35.92353 ms, ub 39.30006 ms, ci 0.950

69+ std dev: 8.305210 ms, lb 4.935312 ms, ub 11.97144 ms, ci 0.950

70+ found 5 outliers among 100 samples (5.0%)

71+ 5 (5.0%) low severe

72+ variance introduced by outliers: 94.703%

73+ variance is severely inflated by outliers

74+

75+ ./SendTransport.exe client 0.0.0.0 8081 sourceAddr 5000

76+ mean: 32.87646 ms, lb 29.69947 ms, ub 35.62485 ms, ci 0.950

77+ std dev: 15.21419 ms, lb 12.39949 ms, ub 17.39441 ms, ci 0.950

78+ found 18 outliers among 100 samples (18.0%)

79+ 18 (18.0%) low severe

80+ variance introduced by outliers: 98.928%

81+ variance is severely inflated by outliers

82+

83+ ./SendTransport.exe client 0.0.0.0 8081 sourceAddr 10000

84+ mean: 32.87737 ms, lb 29.34305 ms, ub 35.62680 ms, ci 0.950

85+ std dev: 15.22060 ms, lb 12.40398 ms, ub 17.57401 ms, ci 0.950

86+ found 18 outliers among 100 samples (18.0%)

87+ 18 (18.0%) low severe

88+ variance introduced by outliers: 98.929%

89+ variance is severely inflated by outliers

90+

91+ ./SendTransport.exe client 0.0.0.0 8081 sourceAddr 50000

92+ mean: 1.351308 ms, lb 1.249680 ms, ub 1.548209 ms, ci 0.950

93+ std dev: 696.6768 us, lb 448.3538 us, ub 1.314057 ms, ci 0.950

94+ found 24 outliers among 100 samples (24.0%)

95+ 3 (3.0%) high mild

96+ 21 (21.0%) high severe

97+ variance introduced by outliers: 98.942%

98+ variance is severely inflated by outliers

99+

100+ ./SendTransport.exe client 0.0.0.0 8081 sourceAddr 100000

101+ mean: 2.184967 ms, lb 2.030858 ms, ub 2.641543 ms, ci 0.950

102+ std dev: 1.235358 ms, lb 518.3995 us, ub 2.666540 ms, ci 0.950

103+ found 15 outliers among 100 samples (15.0%)

104+ 4 (4.0%) low severe

105+ 9 (9.0%) high severe

106+ variance introduced by outliers: 98.952%

107+ variance is severely inflated by outliers

108+

109+This is quite odd. so in addition to the high variance it would seem

110+that messages of size 50K or 100K are much FASTER to send than smaller

111+massages?

install_all.shnew file+18

@@ -0,0 +1,18 @@

1+#!/bin/bash

3+set -e

5+if [ "$GHC" == "" ]; then

6+ GHC=ghc

7+fi

9+cd network-transport/

10+cabal.par install --with-ghc=$GHC

11+

12+echo;echo

13+cd ../network-transport-pipes/

14+cabal.par install --with-ghc=$GHC

15+

16+echo;echo

17+cd ../distributed-process/

18+cabal.par install --with-ghc=$GHC

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

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

4+-- Version History:

5+-- 0.0.1 - Initial

6+-- 0.0.1.1 - Bump for Adam's change to strict BS.

38Description: Network transport interface

49License: BSD3

510License-file: LICENSE