git.iko.soy/distributed-process
on master help sign in
Add header, see what slows down
99fe9c4Edsko de Vries
benchmarks/.gitignorenew file+2
compare with master
unifiedsplit
@@ -0,0 +1,2 @@
1+*.swp
2+*.exe
benchmarks/JustPing.gnuplot+9−7
@@ -1,10 +1,12 @@
1set title "Roundtrip (us)"
1set title "Roundtrip (us)"
2−set yrange [0:300]
2+set yrange [0:200]
3−plot "JustPingHaskell.data" every 400::200 title "JustPingHaskell", \
3+plot "JustPingHaskell.data" smooth bezier with lines title "JustPingHaskell", \
4− "JustPingHaskell2.data" every 400::100 title "JustPingHaskell (-threaded)", \
4+ "JustPingHaskell2.data" smooth bezier with lines title "JustPingHaskell (-threaded)", \
5+ "JustPingNaiveHeader.data" smooth bezier with lines title "JustPingNaiveHeader", \
5− "JustPingC.data" every 400::0 title "JustPingC"
6+ "JustPingC.data" smooth bezier with lines title "JustPingC"
6set terminal postscript color
7set terminal postscript color
7set output "JustPing.ps"
8set output "JustPing.ps"
8−plot "JustPingHaskell.data" every 400::200 title "JustPingHaskell", \
9+plot "JustPingHaskell.data" smooth bezier with lines title "JustPingHaskell", \
9− "JustPingHaskell2.data" every 400::100 title "JustPingHaskell (-threaded)", \
10+ "JustPingHaskell2.data" smooth bezier with lines title "JustPingHaskell (-threaded)", \
11+ "JustPingNaiveHeader.data" smooth bezier with lines title "JustPingNaiveHeader", \
10− "JustPingC.data" every 400::0 title "JustPingC"
12+ "JustPingC.data" smooth bezier with lines title "JustPingC"
benchmarks/JustPingNaiveHeader.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+
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 _ = do
98+ header <- NBS.recv sock 4
99+ let Right length = Ser.decode header
100+ NBS.recv sock (fromIntegral (length :: Int32))
101+
102+-- | Wrapper around NBS.send (for profiling)
103+send :: Socket -> ByteString -> IO ()
104+send sock bs = do
105+ let length :: Int32
106+ length = fromIntegral $ BS.length bs
107+ NBS.sendMany sock [Ser.encode length, bs]
benchmarks/Makefile.JustPing+12−3
@@ -3,7 +3,10 @@
3NUMPINGS=100000
3NUMPINGS=100000
4
4
5.PHONY: showgraph
5.PHONY: showgraph
6+run: JustPingC.data \
7+ JustPingHaskell.data \
6−run: JustPingC.data JustPingHaskell.data JustPingHaskell2.data
8+ JustPingHaskell2.data \
9+ JustPingNaiveHeader.data
7 gnuplot ./JustPing.gnuplot
10 gnuplot ./JustPing.gnuplot
8
11
9JustPingC.data: JustPingC
12JustPingC.data: JustPingC
@@ -15,6 +18,9 @@ JustPingHaskell.data: JustPingHaskell
15JustPingHaskell2.data: JustPingHaskell2
18JustPingHaskell2.data: JustPingHaskell2
16 time ./JustPingHaskell2 $(NUMPINGS) 2>JustPingHaskell2.data
19 time ./JustPingHaskell2 $(NUMPINGS) 2>JustPingHaskell2.data
17
20
21+JustPingNaiveHeader.data: JustPingNaiveHeader
22+ time ./JustPingNaiveHeader $(NUMPINGS) 2>JustPingNaiveHeader.data
23+
18JustPingC: JustPingC.c
24JustPingC: JustPingC.c
19 gcc -o JustPingC -O2 -std=c99 JustPingC.c
25 gcc -o JustPingC -O2 -std=c99 JustPingC.c
20
26
@@ -22,10 +28,13 @@ JustPingHaskell: JustPingHaskell.hs
22 ghc -o JustPingHaskell -O2 JustPingHaskell.hs
28 ghc -o JustPingHaskell -O2 JustPingHaskell.hs
23
29
24JustPingHaskell2: JustPingHaskell.hs
30JustPingHaskell2: JustPingHaskell.hs
25− ghc -o JustPingHaskell2 -O2 -threaded JustPingHaskell2.hs
31+ ghc -o JustPingHaskell2 -O2 -threaded JustPingHaskell.hs
32+
33+JustPingNaiveHeader: JustPingNaiveHeader.hs
34+ ghc -o JustPingNaiveHeader -O2 -threaded JustPingNaiveHeader.hs
26
35
27.PHONY: clean
36.PHONY: clean
28clean:
37clean:
29− rm -f JustPingC JustPingHaskell JustPingHaskell2 *.data JustPing.ps
38+ rm -f *.data *.ps *.pdf JustPingC JustPingHaskell JustPingHaskell2 JustPingNaiveHeader
30
39
31# vi:set noexpandtab:
40# vi:set noexpandtab:
examples/.gitignorenew file+1
@@ -0,0 +1 @@
1+*.exe