git.iko.soy/distributed-process
on master help sign in
Skeleton
5674553Edsko de Vries
benchmarks/Indirection.gnuplotnew file+8
compare with master
unifiedsplit
@@ -0,0 +1,8 @@
1+set title "Roundtrip (us)"
2+set yrange [0:150]
3+plot "JustPingWithHeader.data" smooth bezier with lines title "JustPingWithHeader", \
4+ "JustPingThroughChan.data" smooth bezier with lines title "JustPingThroughChan"
5+set terminal postscript color
6+set output "Headers.ps"
7+plot "JustPingWithHeader.data" smooth bezier with lines title "JustPingWithHeader", \
8+ "JustPingThroughChan.data" smooth bezier with lines title "JustPingThroughChan"
benchmarks/JustPingThroughChan.hsnew file+131
@@ -0,0 +1,131 @@
1+{-# LANGUAGE CPP, BangPatterns #-}
2+
3+module Main where
4+
5+import Control.Monad
6+
7+import Data.Int
8+import Network.Socket
9+ ( AddrInfoFlag (AI_PASSIVE), HostName, ServiceName, Socket
10+ , SocketType (Stream), SocketOption (ReuseAddr)
11+ , accept, addrAddress, addrFlags, addrFamily, bindSocket, defaultProtocol
12+ , defaultHints
13+ , getAddrInfo, listen, setSocketOption, socket, sClose, withSocketsDo )
14+import System.Environment (getArgs, withArgs)
15+import Data.Time (getCurrentTime, diffUTCTime, NominalDiffTime)
16+import System.IO (withFile, IOMode(..), hPutStrLn, Handle, stderr)
17+import Control.Concurrent (forkIO)
18+import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)
19+import qualified Network.Socket as N
20+import Debug.Trace
21+import Data.ByteString (ByteString)
22+import Data.ByteString.Char8 (pack, unpack)
23+import qualified Data.ByteString as BS
24+import qualified Network.Socket.ByteString as NBS
25+import Data.Time (getCurrentTime, diffUTCTime, NominalDiffTime)
26+import Data.ByteString.Internal as BSI
27+import Foreign.Storable (pokeByteOff, peekByteOff)
28+import Foreign.C (CInt(..))
29+import Foreign.ForeignPtr (withForeignPtr)
30+
31+foreign import ccall unsafe "htonl" htonl :: CInt -> CInt
32+foreign import ccall unsafe "ntohl" ntohl :: CInt -> CInt
33+
34+main :: IO ()
35+main = do
36+ [pingsStr] <- getArgs
37+ serverReady <- newEmptyMVar
38+ clientDone <- newEmptyMVar
39+
40+ -- Start the server
41+ forkIO $ do
42+ putStrLn "server: creating TCP connection"
43+ serverAddrs <- getAddrInfo
44+ (Just (defaultHints { addrFlags = [AI_PASSIVE] } ))
45+ Nothing
46+ (Just "8080")
47+ let serverAddr = head serverAddrs
48+ sock <- socket (addrFamily serverAddr) Stream defaultProtocol
49+ setSocketOption sock ReuseAddr 1
50+ bindSocket sock (addrAddress serverAddr)
51+
52+ putStrLn "server: awaiting client connection"
53+ putMVar serverReady ()
54+ listen sock 1
55+ (clientSock, clientAddr) <- accept sock
56+
57+ putStrLn "server: listening for pings"
58+ pong clientSock
59+
60+ -- Start the client
61+ forkIO $ do
62+ takeMVar serverReady
63+ let pings = read pingsStr
64+ serverAddrs <- getAddrInfo
65+ Nothing
66+ (Just "127.0.0.1")
67+ (Just "8080")
68+ let serverAddr = head serverAddrs
69+ sock <- socket (addrFamily serverAddr) Stream defaultProtocol
70+
71+ N.connect sock (addrAddress serverAddr)
72+
73+ ping sock pings
74+ putMVar clientDone ()
75+
76+ -- Wait for the client to finish
77+ takeMVar clientDone
78+
79+pingMessage :: ByteString
80+pingMessage = pack "ping123"
81+
82+ping :: Socket -> Int -> IO ()
83+ping sock pings = go pings
84+ where
85+ go :: Int -> IO ()
86+ go 0 = do
87+ putStrLn $ "client did " ++ show pings ++ " pings"
88+ go !i = do
89+ before <- getCurrentTime
90+ send sock pingMessage
91+ bs <- recv sock 8
92+ after <- getCurrentTime
93+ -- putStrLn $ "client received " ++ unpack bs
94+ let latency = (1e6 :: Double) * realToFrac (diffUTCTime after before)
95+ hPutStrLn stderr $ show i ++ " " ++ show latency
96+ go (i - 1)
97+
98+pong :: Socket -> IO ()
99+pong sock = do
100+ bs <- recv sock 8
101+ -- putStrLn $ "server received " ++ unpack bs
102+ when (BS.length bs > 0) $ do
103+ send sock bs
104+ pong sock
105+
106+-- | Wrapper around NBS.recv (for profiling)
107+recv :: Socket -> Int -> IO ByteString
108+recv sock _ = do
109+ header <- NBS.recv sock 4
110+ length <- decodeLength header
111+ NBS.recv sock (fromIntegral (length :: Int32))
112+
113+-- | Wrapper around NBS.send (for profiling)
114+send :: Socket -> ByteString -> IO ()
115+send sock bs = do
116+ length <- encodeLength (fromIntegral (BS.length bs))
117+ NBS.sendMany sock [length, bs]
118+
119+-- | Encode length (manual for now)
120+encodeLength :: Int32 -> IO ByteString
121+encodeLength i32 =
122+ BSI.create 4 $ \p ->
123+ pokeByteOff p 0 (htonl (fromIntegral i32))
124+
125+-- | Decode length (manual for now)
126+decodeLength :: ByteString -> IO Int32
127+decodeLength bs =
128+ let (fp, _, _) = BSI.toForeignPtr bs in
129+ withForeignPtr fp $ \p -> do
130+ w32 <- peekByteOff p 0
131+ return (fromIntegral (ntohl w32))
benchmarks/Makefile.JustPing+19−40
@@ -2,53 +2,32 @@
2
2
3NUMPINGS=100000
3NUMPINGS=100000
4
4
5−.PHONY: showgraph
5+Indirection.ps: JustPingWithHeader.data \
6+ JustPingThroughChan.data
7+ gnuplot ./Indirection.gnuplot
8+
6−run: JustPingC.data \
9+Headers.ps: JustPingC.data \
7− JustPingHaskell.data \
10+ JustPingHaskell.data \
8− JustPingHaskell2.data \
11+ JustPingHaskell2.data \
9− JustPingWithHeader.data \
12+ JustPingWithHeader.data \
10− JustPingOneRecv.data \
13+ JustPingOneRecv.data \
11− JustPingCacheHeader.data
14+ JustPingCacheHeader.data
12 gnuplot ./Headers.gnuplot
15 gnuplot ./Headers.gnuplot
13
16
14−JustPingC.data: JustPingC
17+JustPingC.exe: JustPingC.c
15− time ./JustPingC $(NUMPINGS) 2>JustPingC.data
18+ gcc -o JustPingC.exe -O2 -std=c99 JustPingC.c
16
19
17−JustPingHaskell.data: JustPingHaskell
20+JustPingHaskell.exe: JustPingHaskell.hs
18− time ./JustPingHaskell $(NUMPINGS) 2>JustPingHaskell.data
21+ ghc -o JustPingHaskell.exe -O2 JustPingHaskell.hs
19
22
20−JustPingHaskell2.data: JustPingHaskell2
23+%.data : %.exe
21− time ./JustPingHaskell2 $(NUMPINGS) 2>JustPingHaskell2.data
24+ time ./$< $(NUMPINGS) 2>$@
22
25
23−JustPingWithHeader.data: JustPingWithHeader
26+%.exe :: %.hs
24− time ./JustPingWithHeader $(NUMPINGS) 2>JustPingWithHeader.data
25−
26−JustPingOneRecv.data: JustPingOneRecv
27− time ./JustPingOneRecv $(NUMPINGS) 2>JustPingOneRecv.data
28−
29−JustPingCacheHeader.data: JustPingCacheHeader
30− time ./JustPingCacheHeader $(NUMPINGS) 2>JustPingCacheHeader.data
31−
32−JustPingC: JustPingC.c
33− gcc -o JustPingC -O2 -std=c99 JustPingC.c
34−
35−JustPingHaskell: JustPingHaskell.hs
36− ghc -o JustPingHaskell -O2 JustPingHaskell.hs
37−
38−JustPingHaskell2: JustPingHaskell.hs
39− ghc -o JustPingHaskell2 -O2 -threaded JustPingHaskell.hs
40−
41−JustPingWithHeader: JustPingWithHeader.hs
42− ghc -o JustPingWithHeader -O2 -threaded JustPingWithHeader.hs
43−
44−JustPingOneRecv: JustPingOneRecv.hs
45− ghc -o JustPingOneRecv -O2 -threaded JustPingOneRecv.hs
27+ ghc -o $@ -O2 -threaded $<
46−
47−JustPingCacheHeader: JustPingCacheHeader.hs
48− ghc -o JustPingCacheHeader -O2 -threaded JustPingCacheHeader.hs
49
28
50.PHONY: clean
29.PHONY: clean
51clean:
30clean:
52− rm -f *.data *.ps *.pdf *.o *.hi JustPingC JustPingHaskell JustPingHaskell2 JustPingWithHeader JustPingOneRecv JustPingCacheHeader
31+ rm -f *.data *.ps *.pdf *.o *.hi *.exe
53
32
54# vi:set noexpandtab:
33# vi:set noexpandtab: