git.iko.soy/distributed-process
on master help sign in
Minor modifications to improve profiling
94a1dd5Edsko de Vries
benchmarks/Makefile+1−1
compare with master
unifiedsplit
@@ -9,7 +9,7 @@ trials = 1
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
11# Enable for profiling
12−PROFILING=-prof -fprof-auto
12+# PROFILING=-prof -fprof-auto
13
13
14ifeq ($(GHC),)
14ifeq ($(GHC),)
15 GHC=ghc
15 GHC=ghc
benchmarks/PingTCP.hs+12−4
@@ -109,15 +109,23 @@ ping sock pings = go [] pings
109 putStrLn $ "client did " ++ show pings ++ " pings"
109 putStrLn $ "client did " ++ show pings ++ " pings"
110 go rtl !i = do
110 go rtl !i = do
111 before <- getCurrentTime
111 before <- getCurrentTime
112− NBS.send sock pingMessage
112+ send sock pingMessage
113− bs <- NBS.recv sock 8
113+ bs <- recv sock 8
114 after <- getCurrentTime
114 after <- getCurrentTime
115 let latency = (1e6 :: Double) * realToFrac (diffUTCTime after before)
115 let latency = (1e6 :: Double) * realToFrac (diffUTCTime after before)
116 latency `seq` go (latency : rtl) (i - 1)
116 latency `seq` go (latency : rtl) (i - 1)
117
117
118pong :: Socket -> IO ()
118pong :: Socket -> IO ()
119pong sock = do
119pong sock = do
120− bs <- NBS.recv sock 8
120+ bs <- recv sock 8
121 when (BS.length bs > 0) $ do
121 when (BS.length bs > 0) $ do
122− NBS.sendAll sock bs
122+ send sock bs
123 pong sock
123 pong sock
124+
125+-- | Wrapper around NBS.recv (for profiling)
126+recv :: Socket -> Int -> IO ByteString
127+recv = NBS.recv
128+
129+-- | Wrapper around NBS.send (for profiling)
130+send :: Socket -> ByteString -> IO Int
131+send = NBS.send
benchmarks/PingTCPTransport.hs+11−8
@@ -53,7 +53,8 @@ decode :: Ser.Serialize a => BS.ByteString -> Either String a
53main :: IO ()
53main :: IO ()
54main = do
54main = do
55 [pingsStr] <- getArgs
55 [pingsStr] <- getArgs
56+ serverAddr <- newEmptyMVar
56− serverReady <- newEmptyMVar
57+ clientAddr <- newEmptyMVar
57
58
58 -- Start the server
59 -- Start the server
59 forkIO $ do
60 forkIO $ do
@@ -63,19 +64,19 @@ main = do
63 -- create ping end
64 -- create ping end
64 putStrLn "server: creating ping end"
65 putStrLn "server: creating ping end"
65 (sourceAddrPing, targetEndPing) <- newConnection transport
66 (sourceAddrPing, targetEndPing) <- newConnection transport
66− putMVar serverReady sourceAddrPing
67+ putMVar serverAddr sourceAddrPing
67
68
68 -- create pong end
69 -- create pong end
69 putStrLn "server: creating pong end"
70 putStrLn "server: creating pong end"
70− [sourceAddrPongBS] <- receive targetEndPing
71+ sourceAddrPong <- takeMVar clientAddr
71− sourceEndPong <- connect . fromJust $ deserialize transport sourceAddrPongBS
72+ sourceEndPong <- connect sourceAddrPong
72
73
73 -- always respond to a ping with a pong
74 -- always respond to a ping with a pong
74 putStrLn "server: awaiting pings"
75 putStrLn "server: awaiting pings"
75 pong targetEndPing sourceEndPong
76 pong targetEndPing sourceEndPong
76
77
77 -- Client
78 -- Client
78− sourceAddr <- takeMVar serverReady
79+ sourceAddr <- takeMVar serverAddr
79 let pings = read pingsStr
80 let pings = read pingsStr
80 -- establish transport
81 -- establish transport
81 transport <- mkTransport $ TCPConfig defaultHints "127.0.0.1" "8081"
82 transport <- mkTransport $ TCPConfig defaultHints "127.0.0.1" "8081"
@@ -85,7 +86,7 @@ main = do
85
86
86 -- create pong end
87 -- create pong end
87 (sourceAddrPong, targetEndPong) <- newConnection transport
88 (sourceAddrPong, targetEndPong) <- newConnection transport
88− send sourceEndPing [serialize sourceAddrPong]
89+ putMVar clientAddr sourceAddrPong
89
90
90 ping sourceEndPing targetEndPong pings
91 ping sourceEndPing targetEndPong pings
91 putStrLn "Done with all ping/pongs."
92 putStrLn "Done with all ping/pongs."
@@ -97,8 +98,9 @@ pingMessage = BS.pack "ping123"
97-- | Keep replying to pings (send pongs)
98-- | Keep replying to pings (send pongs)
98pong :: TargetEnd -> SourceEnd -> IO ()
99pong :: TargetEnd -> SourceEnd -> IO ()
99pong targetEndPing sourceEndPong = do
100pong targetEndPing sourceEndPong = do
100− bs <- receive targetEndPing
101+ [bs] <- receive targetEndPing
102+ -- putStrLn $ "server got " ++ BS.unpack bs
101− send sourceEndPong bs
103+ send sourceEndPong [bs]
102 pong targetEndPing sourceEndPong
104 pong targetEndPing sourceEndPong
103
105
104-- | Send a number of pings
106-- | Send a number of pings
@@ -113,6 +115,7 @@ ping sourceEndPing targetEndPong pings = go [] pings
113 before <- getCurrentTime
115 before <- getCurrentTime
114 send sourceEndPing [pingMessage]
116 send sourceEndPing [pingMessage]
115 [bs] <- receive targetEndPong
117 [bs] <- receive targetEndPong
118+ -- putStrLn $ "client got " ++ BS.unpack bs
116 after <- getCurrentTime
119 after <- getCurrentTime
117 let latency = (1e6 :: Double) * realToFrac (diffUTCTime after before)
120 let latency = (1e6 :: Double) * realToFrac (diffUTCTime after before)
118 latency `seq` go (latency : rtl) (i - 1)
121 latency `seq` go (latency : rtl) (i - 1)