git.iko.soy/distributed-process
on master help sign in
Two more tests
bc4312eEdsko de Vries
benchmarks/JustPing.gnuplot+8−4
compare with master
unifiedsplit
@@ -1,14 +1,18 @@
1set title "Roundtrip (us)"
1set title "Roundtrip (us)"
2set yrange [0:200]
2set yrange [0:200]
3−plot "JustPingHaskell.data" smooth bezier with lines title "JustPingHaskell", \
3+plot "JustPingHaskell.data" smooth bezier with lines title "JustPingHaskell (NOT -threaded)", \
4− "JustPingHaskell2.data" smooth bezier with lines title "JustPingHaskell (-threaded)", \
4+ "JustPingHaskell2.data" smooth bezier with lines title "JustPingHaskell", \
5+ "JustPingForkClient.data" smooth bezier with lines title "JustPingForkClient", \
5 "JustPingNaiveHeader.data" smooth bezier with lines title "JustPingNaiveHeader", \
6 "JustPingNaiveHeader.data" smooth bezier with lines title "JustPingNaiveHeader", \
6 "JustPingOneRecv.data" smooth bezier with lines title "JustPingOneRecv", \
7 "JustPingOneRecv.data" smooth bezier with lines title "JustPingOneRecv", \
8+ "JustPingCacheHeader.data" smooth bezier with lines title "JustPingCacheHeader", \
7 "JustPingC.data" smooth bezier with lines title "JustPingC"
9 "JustPingC.data" smooth bezier with lines title "JustPingC"
8set terminal postscript color
10set terminal postscript color
9set output "JustPing.ps"
11set output "JustPing.ps"
10−plot "JustPingHaskell.data" smooth bezier with lines title "JustPingHaskell", \
12+plot "JustPingHaskell.data" smooth bezier with lines title "JustPingHaskell (NOT -threaded)", \
11− "JustPingHaskell2.data" smooth bezier with lines title "JustPingHaskell (-threaded)", \
13+ "JustPingHaskell2.data" smooth bezier with lines title "JustPingHaskell", \
14+ "JustPingForkClient.data" smooth bezier with lines title "JustPingForkClient", \
12 "JustPingNaiveHeader.data" smooth bezier with lines title "JustPingNaiveHeader", \
15 "JustPingNaiveHeader.data" smooth bezier with lines title "JustPingNaiveHeader", \
13 "JustPingOneRecv.data" smooth bezier with lines title "JustPingOneRecv", \
16 "JustPingOneRecv.data" smooth bezier with lines title "JustPingOneRecv", \
17+ "JustPingCacheHeader.data" smooth bezier with lines title "JustPingCacheHeader", \
14 "JustPingC.data" smooth bezier with lines title "JustPingC"
18 "JustPingC.data" smooth bezier with lines title "JustPingC"
benchmarks/JustPingCacheHeader.hsnew file+110
@@ -0,0 +1,110 @@
1+{-# LANGUAGE CPP, BangPatterns #-}
2+
3+module Main where
4+
5+import Control.Monad
6+
7+import Data.Int
8+import qualified Data.Serialize as Ser
9+import Data.Word (Word8)
10+import Network.Socket
11+ ( AddrInfoFlag (AI_PASSIVE), HostName, ServiceName, Socket
12+ , SocketType (Stream), SocketOption (ReuseAddr)
13+ , accept, addrAddress, addrFlags, addrFamily, bindSocket, defaultProtocol
14+ , defaultHints
15+ , getAddrInfo, listen, setSocketOption, socket, sClose, withSocketsDo )
16+import System.Environment (getArgs, withArgs)
17+import Data.Time (getCurrentTime, diffUTCTime, NominalDiffTime)
18+import System.IO (withFile, IOMode(..), hPutStrLn, Handle, stderr)
19+import Control.Concurrent (forkIO)
20+import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)
21+import qualified Network.Socket as N
22+import Debug.Trace
23+import Data.ByteString (ByteString)
24+import Data.ByteString.Char8 (pack, unpack)
25+import qualified Data.ByteString as BS
26+import qualified Network.Socket.ByteString as NBS
27+import Data.Time (getCurrentTime, diffUTCTime, NominalDiffTime)
28+
29+main :: IO ()
30+main = do
31+ [pingsStr] <- getArgs
32+ serverReady <- newEmptyMVar
33+
34+ -- Start the server
35+ forkIO $ do
36+ putStrLn "server: creating TCP connection"
37+ serverAddrs <- getAddrInfo
38+ (Just (defaultHints { addrFlags = [AI_PASSIVE] } ))
39+ Nothing
40+ (Just "8080")
41+ let serverAddr = head serverAddrs
42+ sock <- socket (addrFamily serverAddr) Stream defaultProtocol
43+ setSocketOption sock ReuseAddr 1
44+ bindSocket sock (addrAddress serverAddr)
45+
46+ putStrLn "server: awaiting client connection"
47+ putMVar serverReady ()
48+ listen sock 1
49+ (clientSock, clientAddr) <- accept sock
50+
51+ putStrLn "server: listening for pings"
52+ pong clientSock
53+
54+ -- Client
55+ takeMVar serverReady
56+ let pings = read pingsStr
57+ serverAddrs <- getAddrInfo
58+ Nothing
59+ (Just "127.0.0.1")
60+ (Just "8080")
61+ let serverAddr = head serverAddrs
62+ sock <- socket (addrFamily serverAddr) Stream defaultProtocol
63+
64+ N.connect sock (addrAddress serverAddr)
65+
66+ ping sock pings
67+
68+pingMessage :: ByteString
69+pingMessage = pack "ping123"
70+
71+ping :: Socket -> Int -> IO ()
72+ping sock pings = go pings
73+ where
74+ go :: Int -> IO ()
75+ go 0 = do
76+ putStrLn $ "client did " ++ show pings ++ " pings"
77+ go !i = do
78+ before <- getCurrentTime
79+ send sock pingMessage
80+ bs <- recv sock 8
81+ after <- getCurrentTime
82+ -- putStrLn $ "client received " ++ unpack bs
83+ let latency = (1e6 :: Double) * realToFrac (diffUTCTime after before)
84+ hPutStrLn stderr $ show i ++ " " ++ show latency
85+ go (i - 1)
86+
87+pong :: Socket -> IO ()
88+pong sock = do
89+ bs <- recv sock 8
90+ -- putStrLn $ "server received " ++ unpack bs
91+ when (BS.length bs > 0) $ do
92+ send sock bs
93+ pong sock
94+
95+-- | Wrapper around NBS.recv (for profiling)
96+recv :: Socket -> Int -> IO ByteString
97+recv sock i = do
98+ (header, payload) <- BS.splitAt 4 `fmap` NBS.recv sock (4 + i)
99+ case Ser.decode header :: Either String Int32 of
100+ Left _ -> error "Could not decode header"
101+ Right _ -> return payload
102+
103+-- | Cached header
104+header :: ByteString
105+header = Ser.encode (8 :: Int32)
106+
107+-- | Wrapper around NBS.send (for profiling)
108+send :: Socket -> ByteString -> IO ()
109+send sock bs = do
110+ NBS.sendMany sock [header, bs]
benchmarks/JustPingForkClient.hsnew file+107
@@ -0,0 +1,107 @@
1+{-# LANGUAGE CPP, BangPatterns #-}
2+
3+module Main where
4+
5+import Control.Monad
6+
7+import Data.Int
8+import qualified Data.Serialize as Ser
9+import Data.Word (Word8)
10+import Network.Socket
11+ ( AddrInfoFlag (AI_PASSIVE), HostName, ServiceName, Socket
12+ , SocketType (Stream), SocketOption (ReuseAddr)
13+ , accept, addrAddress, addrFlags, addrFamily, bindSocket, defaultProtocol
14+ , defaultHints
15+ , getAddrInfo, listen, setSocketOption, socket, sClose, withSocketsDo )
16+import System.Environment (getArgs, withArgs)
17+import Data.Time (getCurrentTime, diffUTCTime, NominalDiffTime)
18+import System.IO (withFile, IOMode(..), hPutStrLn, Handle, stderr)
19+import Control.Concurrent (forkIO)
20+import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)
21+import qualified Network.Socket as N
22+import Debug.Trace
23+import Data.ByteString (ByteString)
24+import Data.ByteString.Char8 (pack, unpack)
25+import qualified Data.ByteString as BS
26+import qualified Network.Socket.ByteString as NBS
27+import Data.Time (getCurrentTime, diffUTCTime, NominalDiffTime)
28+
29+main :: IO ()
30+main = do
31+ [pingsStr] <- getArgs
32+ serverReady <- newEmptyMVar
33+ clientDone <- newEmptyMVar
34+
35+ -- Start the server
36+ forkIO $ do
37+ putStrLn "server: creating TCP connection"
38+ serverAddrs <- getAddrInfo
39+ (Just (defaultHints { addrFlags = [AI_PASSIVE] } ))
40+ Nothing
41+ (Just "8080")
42+ let serverAddr = head serverAddrs
43+ sock <- socket (addrFamily serverAddr) Stream defaultProtocol
44+ setSocketOption sock ReuseAddr 1
45+ bindSocket sock (addrAddress serverAddr)
46+
47+ putStrLn "server: awaiting client connection"
48+ putMVar serverReady ()
49+ listen sock 1
50+ (clientSock, clientAddr) <- accept sock
51+
52+ putStrLn "server: listening for pings"
53+ pong clientSock
54+
55+ -- Client
56+ forkIO $ do
57+ takeMVar serverReady
58+ let pings = read pingsStr
59+ serverAddrs <- getAddrInfo
60+ Nothing
61+ (Just "127.0.0.1")
62+ (Just "8080")
63+ let serverAddr = head serverAddrs
64+ sock <- socket (addrFamily serverAddr) Stream defaultProtocol
65+
66+ N.connect sock (addrAddress serverAddr)
67+
68+ ping sock pings
69+ putMVar clientDone ()
70+
71+ -- Wait for the client to be complete
72+ takeMVar clientDone
73+
74+pingMessage :: ByteString
75+pingMessage = pack "ping123"
76+
77+ping :: Socket -> Int -> IO ()
78+ping sock pings = go pings
79+ where
80+ go :: Int -> IO ()
81+ go 0 = do
82+ putStrLn $ "client did " ++ show pings ++ " pings"
83+ go !i = do
84+ before <- getCurrentTime
85+ send sock pingMessage
86+ bs <- recv sock 8
87+ after <- getCurrentTime
88+ -- putStrLn $ "client received " ++ unpack bs
89+ let latency = (1e6 :: Double) * realToFrac (diffUTCTime after before)
90+ hPutStrLn stderr $ show i ++ " " ++ show latency
91+ go (i - 1)
92+
93+pong :: Socket -> IO ()
94+pong sock = do
95+ bs <- recv sock 8
96+ -- putStrLn $ "server received " ++ unpack bs
97+ when (BS.length bs > 0) $ do
98+ send sock bs
99+ pong sock
100+
101+-- | Wrapper around NBS.recv (for profiling)
102+recv :: Socket -> Int -> IO ByteString
103+recv = NBS.recv
104+
105+-- | Wrapper around NBS.send (for profiling)
106+send :: Socket -> ByteString -> IO Int
107+send = NBS.send
benchmarks/JustPingOneRecv.hs+4−2
@@ -95,8 +95,10 @@ pong sock = do
95-- | Wrapper around NBS.recv (for profiling)
95-- | Wrapper around NBS.recv (for profiling)
96recv :: Socket -> Int -> IO ByteString
96recv :: Socket -> Int -> IO ByteString
97recv sock i = do
97recv sock i = do
98− headerAndPayload <- NBS.recv sock (4 + i)
98+ (header, payload) <- BS.splitAt 4 `fmap` NBS.recv sock (4 + i)
99− return (BS.drop 4 headerAndPayload)
99+ case Ser.decode header :: Either String Int32 of
100+ Left _ -> error "Could not decode header"
101+ Right _ -> return payload
100
102
101-- | Wrapper around NBS.send (for profiling)
103-- | Wrapper around NBS.send (for profiling)
102send :: Socket -> ByteString -> IO ()
104send :: Socket -> ByteString -> IO ()
benchmarks/Makefile.JustPing+16−2
@@ -6,8 +6,10 @@ NUMPINGS=100000
6run: JustPingC.data \
6run: JustPingC.data \
7 JustPingHaskell.data \
7 JustPingHaskell.data \
8 JustPingHaskell2.data \
8 JustPingHaskell2.data \
9+ JustPingForkClient.data \
9 JustPingNaiveHeader.data \
10 JustPingNaiveHeader.data \
10− JustPingOneRecv.data
11+ JustPingOneRecv.data \
12+ JustPingCacheHeader.data
11 gnuplot ./JustPing.gnuplot
13 gnuplot ./JustPing.gnuplot
12
14
13JustPingC.data: JustPingC
15JustPingC.data: JustPingC
@@ -19,12 +21,18 @@ JustPingHaskell.data: JustPingHaskell
19JustPingHaskell2.data: JustPingHaskell2
21JustPingHaskell2.data: JustPingHaskell2
20 time ./JustPingHaskell2 $(NUMPINGS) 2>JustPingHaskell2.data
22 time ./JustPingHaskell2 $(NUMPINGS) 2>JustPingHaskell2.data
21
23
24+JustPingForkClient.data: JustPingForkClient
25+ time ./JustPingForkClient $(NUMPINGS) 2>JustPingForkClient.data
26+
22JustPingNaiveHeader.data: JustPingNaiveHeader
27JustPingNaiveHeader.data: JustPingNaiveHeader
23 time ./JustPingNaiveHeader $(NUMPINGS) 2>JustPingNaiveHeader.data
28 time ./JustPingNaiveHeader $(NUMPINGS) 2>JustPingNaiveHeader.data
24
29
25JustPingOneRecv.data: JustPingOneRecv
30JustPingOneRecv.data: JustPingOneRecv
26 time ./JustPingOneRecv $(NUMPINGS) 2>JustPingOneRecv.data
31 time ./JustPingOneRecv $(NUMPINGS) 2>JustPingOneRecv.data
27
32
33+JustPingCacheHeader.data: JustPingCacheHeader
34+ time ./JustPingCacheHeader $(NUMPINGS) 2>JustPingCacheHeader.data
35+
28JustPingC: JustPingC.c
36JustPingC: JustPingC.c
29 gcc -o JustPingC -O2 -std=c99 JustPingC.c
37 gcc -o JustPingC -O2 -std=c99 JustPingC.c
30
38
@@ -34,14 +42,20 @@ JustPingHaskell: JustPingHaskell.hs
34JustPingHaskell2: JustPingHaskell.hs
42JustPingHaskell2: JustPingHaskell.hs
35 ghc -o JustPingHaskell2 -O2 -threaded JustPingHaskell.hs
43 ghc -o JustPingHaskell2 -O2 -threaded JustPingHaskell.hs
36
44
45+JustPingForkClient: JustPingForkClient.hs
46+ ghc -o JustPingForkClient -O2 -threaded JustPingForkClient.hs
47+
37JustPingNaiveHeader: JustPingNaiveHeader.hs
48JustPingNaiveHeader: JustPingNaiveHeader.hs
38 ghc -o JustPingNaiveHeader -O2 -threaded JustPingNaiveHeader.hs
49 ghc -o JustPingNaiveHeader -O2 -threaded JustPingNaiveHeader.hs
39
50
40JustPingOneRecv: JustPingOneRecv.hs
51JustPingOneRecv: JustPingOneRecv.hs
41 ghc -o JustPingOneRecv -O2 -threaded JustPingOneRecv.hs
52 ghc -o JustPingOneRecv -O2 -threaded JustPingOneRecv.hs
42
53
54+JustPingCacheHeader: JustPingCacheHeader.hs
55+ ghc -o JustPingCacheHeader -O2 -threaded JustPingCacheHeader.hs
56+
43.PHONY: clean
57.PHONY: clean
44clean:
58clean:
45− rm -f *.data *.ps *.pdf JustPingC JustPingHaskell JustPingHaskell2 JustPingNaiveHeader
59+ rm -f *.data *.ps *.pdf JustPingC JustPingHaskell JustPingHaskell2 JustPingForkClient JustPingNaiveHeader JustPingOneRecv JustPingCacheHeader
46
60
47# vi:set noexpandtab:
61# vi:set noexpandtab: