git.iko.soy/distributed-process
on master help sign in
Modify the benchmarks to output the latencies
39d8085Edsko de Vries
benchmarks/Makefile+4−1
compare with master
unifiedsplit
@@ -8,6 +8,9 @@ trials = 1
8# Disable this to test installed packages only:
8# Disable this to test installed packages only:
9INCLUDES= -i../network-transport/src -i../network-transport-pipes/src
9INCLUDES= -i../network-transport/src -i../network-transport-pipes/src
10
10
11+# Enable for profiling
12+PROFILING=-prof -fprof-auto
13+
11ifeq ($(GHC),)
14ifeq ($(GHC),)
12 GHC=ghc
15 GHC=ghc
13endif
16endif
@@ -16,7 +19,7 @@ BENCHS= PingTCP.exe PingTCPTransport.exe PingPipes.exe SendTransport.exe
16
19
17all: $(BENCHS)
20all: $(BENCHS)
18$(BENCHS): %.exe: %.hs
21$(BENCHS): %.exe: %.hs
19− $(GHC) -O2 -rtsopts -threaded --make $(INCLUDES) $< -o $@
22+ $(GHC) -O2 -rtsopts -threaded --make $(INCLUDES) $(PROFILING) $< -o $@
20
23
21#-------------------------------------------------------------------------------
24#-------------------------------------------------------------------------------
22# Shorthands for running benchmarks:
25# Shorthands for running benchmarks:
benchmarks/PingTCP.hs+32−35
@@ -1,10 +1,8 @@
1−{-# LANGUAGE CPP #-}
1+{-# LANGUAGE CPP, BangPatterns #-}
2
2
3module Main where
3module Main where
4
4
5import Control.Monad
5import Control.Monad
6−import Criterion.Main (Benchmark, bench, defaultMainWith, nfIO)
7−import Criterion.Config (defaultConfig, ljust, Config(cfgSamples))
8
6
9import Data.Int
7import Data.Int
10import qualified Data.Serialize as Ser
8import qualified Data.Serialize as Ser
@@ -16,6 +14,8 @@ import Network.Socket
16 , defaultHints
14 , defaultHints
17 , getAddrInfo, listen, setSocketOption, socket, sClose, withSocketsDo )
15 , getAddrInfo, listen, setSocketOption, socket, sClose, withSocketsDo )
18import System.Environment (getArgs, withArgs)
16import System.Environment (getArgs, withArgs)
17+import Data.Time (getCurrentTime, diffUTCTime, NominalDiffTime)
18+import System.IO (withFile, IOMode(..), hPutStrLn)
19
19
20import qualified Network.Socket as N
20import qualified Network.Socket as N
21
21
@@ -23,11 +23,13 @@ import Debug.Trace
23
23
24#ifndef LAZY
24#ifndef LAZY
25import Data.ByteString (ByteString)
25import Data.ByteString (ByteString)
26+import Data.ByteString.Char8 (pack)
27+import qualified Data.ByteString as BS
26import qualified Network.Socket.ByteString as NBS
28import qualified Network.Socket.ByteString as NBS
27encode = Ser.encode
29encode = Ser.encode
28decode = Ser.decode
30decode = Ser.decode
29#else
31#else
30−import Data.ByteString.Lazy (ByteString)
32+import Data.ByteString.Lazy (ByteString, pack)
31import qualified Network.Socket.ByteString.Lazy as NBS
33import qualified Network.Socket.ByteString.Lazy as NBS
32encode = Ser.encodeLazy
34encode = Ser.encodeLazy
33decode = Ser.decodeLazy
35decode = Ser.decodeLazy
@@ -72,9 +74,9 @@ main = do
72 (clientSock, clientAddr) <- accept sock
74 (clientSock, clientAddr) <- accept sock
73
75
74 putStrLn "server: listening for pings"
76 putStrLn "server: listening for pings"
75− forever (pong clientSock)
77+ pong clientSock
76
78
77− "client": host : service : pingsStr : reps : args' -> withSocketsDo $ do
79+ "client": host : service : pingsStr : [] -> withSocketsDo $ do
78 let pings = read pingsStr
80 let pings = read pingsStr
79 serverAddrs <- getAddrInfo
81 serverAddrs <- getAddrInfo
80 Nothing
82 Nothing
@@ -85,36 +87,31 @@ main = do
85
87
86 N.connect sock (addrAddress serverAddr)
88 N.connect sock (addrAddress serverAddr)
87
89
88− -- benchmark the 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)
90+ ping sock pings
93− n -> withArgs args' $ defaultMainWith
91+
94− (defaultConfig{ cfgSamples = ljust n })
92+pingMessage :: ByteString
95− (return ()) -- Init action.
93+pingMessage = pack "ping123"
96− [ benchPing sock (fromIntegral pings) ]
94+
97− putStrLn "Done with all ping/pongs."
98−
99−-- withArgs args' $ defaultMain [ benchPing sock pings ]
100−-- replicateM_ pings (ping sock)
101−
102−-- | Each `ping` sends a single byte, and expects to receive one
103−-- back in return.
104−ping :: Socket -> IO Int64
95+ping :: Socket -> Int -> IO ()
105−ping sock = do
96+ping sock pings = go [] pings
97+ where
98+ go :: [Double] -> Int -> IO ()
99+ go rtl 0 = do
100+ withFile "round-trip-latency-tcp.data" WriteMode $ \h ->
101+ forM_ (zip [0..] rtl) $ \(i, latency) ->
102+ hPutStrLn h $ (show i) ++ " " ++ (show latency)
103+ putStrLn $ "client did " ++ show pings ++ " pings"
104+ go rtl !i = do
105+ before <- getCurrentTime
106− NBS.send sock $ encode (42 :: Int64)
106+ NBS.send sock pingMessage
107− bs <- NBS.recv sock 8
107+ bs <- NBS.recv sock 8
108− either error return $ decode bs
108+ after <- getCurrentTime
109+ let latency = (1e6 :: Double) * realToFrac (diffUTCTime after before)
110+ latency `seq` go (latency : rtl) (i - 1)
109
111
110pong :: Socket -> IO ()
112pong :: Socket -> IO ()
111pong sock = do
113pong sock = do
112 bs <- NBS.recv sock 8
114 bs <- NBS.recv sock 8
115+ when (BS.length bs > 0) $ do
113− NBS.sendAll sock bs
116+ NBS.sendAll sock bs
114− return ()
117+ pong sock
115−
116−benchPing :: Socket -> Int64 -> Benchmark
117−benchPing sock n =
118− bench "PingTCP" $
119− nfIO (replicateM_ (fromIntegral n) (ping sock))
120−
benchmarks/PingTCPTransport.hs+36−36
@@ -1,4 +1,4 @@
1−{-# LANGUAGE CPP #-}
1+{-# LANGUAGE CPP, BangPatterns #-}
2
2
3module Main where
3module Main where
4
4
@@ -6,14 +6,14 @@ import Network.Transport (newConnection, receive, connect, send, defaultHints,
6 serialize, deserialize, SourceEnd, TargetEnd)
6 serialize, deserialize, SourceEnd, TargetEnd)
7import Network.Transport.TCP (mkTransport, TCPConfig (..))
7import Network.Transport.TCP (mkTransport, TCPConfig (..))
8
8
9−import Control.Monad (forever, replicateM_)
9+import Control.Monad (forever, replicateM_, forM_)
10−import Criterion.Main (Benchmark, bench, defaultMainWith, nfIO)
11−import Criterion.Config (defaultConfig, ljust, Config(cfgSamples))
12
10
13import qualified Data.Serialize as Ser
11import qualified Data.Serialize as Ser
14import Data.Maybe (fromJust)
12import Data.Maybe (fromJust)
15import Data.Int
13import Data.Int
16import System.Environment (getArgs, withArgs)
14import System.Environment (getArgs, withArgs)
15+import Data.Time (getCurrentTime, diffUTCTime)
16+import System.IO (withFile, IOMode(..), hPutStrLn)
17
17
18#ifndef LAZY
18#ifndef LAZY
19import qualified Data.ByteString.Char8 as BS
19import qualified Data.ByteString.Char8 as BS
@@ -68,10 +68,10 @@ main = do
68
68
69 -- always respond to a ping with a pong
69 -- always respond to a ping with a pong
70 putStrLn "server: awaiting pings"
70 putStrLn "server: awaiting pings"
71− forever $ pong targetEndPing sourceEndPong
71+ pong targetEndPing sourceEndPong
72
72
73
73
74− "client" : host : service : sourceAddrFilePath : pingsStr : reps : args' -> do
74+ "client" : host : service : sourceAddrFilePath : pingsStr : [] -> do
75 let pings = read pingsStr
75 let pings = read pingsStr
76 -- establish transport
76 -- establish transport
77 transport <- mkTransport $ TCPConfig defaultHints host service
77 transport <- mkTransport $ TCPConfig defaultHints host service
@@ -84,39 +84,39 @@ main = do
84 (sourceAddrPong, targetEndPong) <- newConnection transport
84 (sourceAddrPong, targetEndPong) <- newConnection transport
85 send sourceEndPing [serialize sourceAddrPong]
85 send sourceEndPing [serialize sourceAddrPong]
86
86
87− -- benchmark the pings
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)
87+ ping sourceEndPing targetEndPong pings
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."
88 putStrLn "Done with all ping/pongs."
97
89
98−-- | This function takes a `TargetEnd` for the pings, and a `SourceEnd` for
90+-- | The message we use to ping (CAF so that we don't keep encoding it)
99−-- pongs. Whenever a ping is received from the `TargetEnd`, a pong is sent
91+pingMessage :: BS.ByteString
100−-- in reply down the `SourceEnd`, repeating whatever was sent.
92+pingMessage = BS.pack "ping123"
93+
94+-- | Keep replying to pings (send pongs)
101pong :: TargetEnd -> SourceEnd -> IO ()
95pong :: TargetEnd -> SourceEnd -> IO ()
102pong targetEndPing sourceEndPong = do
96pong targetEndPing sourceEndPong = do
103 bs <- receive targetEndPing
97 bs <- receive targetEndPing
104 send sourceEndPong bs
98 send sourceEndPong bs
105−
99+ pong targetEndPing sourceEndPong
106−-- | The effect of `ping sourceEndPing targetEndPong n` is to send the number
100+
107−-- `n` using `sourceEndPing`, and to then receive the a number from
101+-- | Send a number of pings
108−-- `targetEndPong`, which is then returned.
102+ping :: SourceEnd -> TargetEnd -> Int -> IO ()
109−ping :: SourceEnd -> TargetEnd -> Int64 -> IO Int64
103+ping sourceEndPing targetEndPong pings = go [] pings
110−ping sourceEndPing targetEndPong n = do
104+ where
105+ go :: [Double] -> Int -> IO ()
106+ go rtl 0 = do
107+ outputData rtl
108+ putStrLn $ "client did " ++ show pings ++ " pings"
109+ go rtl !i = do
110+ before <- getCurrentTime
111− send sourceEndPing [encode n]
111+ send sourceEndPing [pingMessage]
112− [bs] <- receive targetEndPong
112+ [bs] <- receive targetEndPong
113− let (Right n) = decode bs
113+ after <- getCurrentTime
114− return $! n
114+ let latency = (1e6 :: Double) * realToFrac (diffUTCTime after before)
115−
115+ latency `seq` go (latency : rtl) (i - 1)
116−-- | The effect of `benchPing sourceEndPing targetEndPong n` is to send
116+
117−-- `n` pings down `sourceEndPing` using the `ping` function. The time
117+-- | Output latencies to a file to be plotted
118−-- taken is benchmarked.
118+outputData :: [Double] -> IO ()
119−benchPing :: SourceEnd -> TargetEnd -> Int64 -> Benchmark
119+outputData rtl = do
120−benchPing sourceEndPing targetEndPong n = bench "PingTransport" $
120+ withFile "round-trip-latency-tcp-transport.data" WriteMode $ \h ->
121− nfIO (replicateM_ (fromIntegral n) (ping sourceEndPing targetEndPong 42))
121+ forM_ (zip [0..] rtl) $ \(i, latency) ->
122−
122+ hPutStrLn h $ (show i) ++ " " ++ (show latency)
benchmarks/pingtest.c+27
@@ -1,3 +1,23 @@
1+/**
2+ * Compute baseline average and standard deviancy ping latency
3+ *
4+ * Compile using
5+ *
6+ * gcc -o pingtest -O2 -std=c99 pingtest.c
7+ *
8+ * Then start server
9+ *
10+ * ./pingtest server &
11+ *
12+ * And finally start the client
13+ *
14+ * ./pingtest client <number of pings; for instance, 10000>
15+ *
16+ * The server will terminate when the client does.
17+ *
18+ * Edsko de Vries <edsko@well-typed.com>
19+ */
20+
1#include <stdio.h>
21#include <stdio.h>
2#include <stdlib.h>
22#include <stdlib.h>
3#include <sys/types.h>
23#include <sys/types.h>
@@ -112,6 +132,13 @@ int client(int pings) {
112
132
113 printf("client did %d pings\n", pings);
133 printf("client did %d pings\n", pings);
114
134
135+ // Write data to a file for plotting
136+ FILE* data = fopen("round-trip-latency-c.data", "wt");
137+ for(int i = 0; i < pings; i++) {
138+ fprintf(data, "%i %lf\n", i, round_trip_latency[i]);
139+ }
140+ fclose(data);
141+
115 // compute average
142 // compute average
116 double round_trip_latency_average = 0;
143 double round_trip_latency_average = 0;
117 for(int i = 0; i < pings; i++) {
144 for(int i = 0; i < pings; i++) {