a050b8a · distributed-process

benchmarks/JustPing.gnuplot+2−2

compare with master

unifiedsplit

@@ -2,7 +2,7 @@ set title "Roundtrip (us)"

2set yrange [0:200]

3plot "JustPingHaskell.data" smooth bezier with lines title "JustPingHaskell (NOT -threaded)", \

4 "JustPingHaskell2.data" smooth bezier with lines title "JustPingHaskell", \

5− "JustPingNaiveHeader.data" smooth bezier with lines title "JustPingNaiveHeader", \

5+ "JustPingWithHeader.data" smooth bezier with lines title "JustPingWithHeader", \

6 "JustPingOneRecv.data" smooth bezier with lines title "JustPingOneRecv", \

7 "JustPingCacheHeader.data" smooth bezier with lines title "JustPingCacheHeader", \

8 "JustPingC.data" smooth bezier with lines title "JustPingC"

@@ -10,7 +10,7 @@ set terminal postscript color

10set output "JustPing.ps"

11plot "JustPingHaskell.data" smooth bezier with lines title "JustPingHaskell (NOT -threaded)", \

12 "JustPingHaskell2.data" smooth bezier with lines title "JustPingHaskell", \

13− "JustPingNaiveHeader.data" smooth bezier with lines title "JustPingNaiveHeader", \

13+ "JustPingWithHeader.data" smooth bezier with lines title "JustPingWithHeader", \

14 "JustPingOneRecv.data" smooth bezier with lines title "JustPingOneRecv", \

15 "JustPingCacheHeader.data" smooth bezier with lines title "JustPingCacheHeader", \

16 "JustPingC.data" smooth bezier with lines title "JustPingC"

benchmarks/JustPingCacheHeader.hs+24−6

@@ -5,8 +5,6 @@ module Main where

5import Control.Monad

6

7import Data.Int

8−import qualified Data.Serialize as Ser

9−import Data.Word (Word8)

10import Network.Socket

8import Network.Socket

11 ( AddrInfoFlag (AI_PASSIVE), HostName, ServiceName, Socket

9 ( AddrInfoFlag (AI_PASSIVE), HostName, ServiceName, Socket

12 , SocketType (Stream), SocketOption (ReuseAddr)

10 , SocketType (Stream), SocketOption (ReuseAddr)

@@ -25,6 +23,13 @@ import Data.ByteString.Char8 (pack, unpack)

25import qualified Data.ByteString as BS

23import qualified Data.ByteString as BS

26import qualified Network.Socket.ByteString as NBS

24import qualified Network.Socket.ByteString as NBS

27import Data.Time (getCurrentTime, diffUTCTime, NominalDiffTime)

25import 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

28

33

29main :: IO ()

34main :: IO ()

30main = do

35main = do

@@ -102,15 +107,28 @@ pong sock = do

102recv :: Socket -> Int -> IO ByteString

107recv :: Socket -> Int -> IO ByteString

103recv sock i = do

108recv sock i = do

104 (header, payload) <- BS.splitAt 4 `fmap` NBS.recv sock (4 + i)

109 (header, payload) <- BS.splitAt 4 `fmap` NBS.recv sock (4 + i)

105− case Ser.decode header :: Either String Int32 of

110+ -- Ignore header

106− Left _ -> error "Could not decode header"

107− Right _ -> return payload

111+ return payload

108

112

109-- | Cached header

113-- | Cached header

110header :: ByteString

114header :: ByteString

111−header = Ser.encode (8 :: Int32)

115+header = pack "fake"

112

116

113-- | Wrapper around NBS.send (for profiling)

117-- | Wrapper around NBS.send (for profiling)

114send :: Socket -> ByteString -> IO ()

118send :: Socket -> ByteString -> IO ()

115send sock bs = do

119send sock bs = do

116 NBS.sendMany sock [header, bs]

120 NBS.sendMany sock [header, bs]

121+

122+-- | Encode length (manual for now)

123+encodeLength :: Int32 -> IO ByteString

124+encodeLength i32 =

125+ BSI.create 4 $ \p ->

126+ pokeByteOff p 0 (htonl (fromIntegral i32))

127+

128+-- | Decode length (manual for now)

129+decodeLength :: ByteString -> IO Int32

130+decodeLength bs =

131+ let (fp, _, _) = BSI.toForeignPtr bs in

132+ withForeignPtr fp $ \p -> do

133+ w32 <- peekByteOff p 0

134+ return (fromIntegral (ntohl w32))

benchmarks/JustPingHaskell.hs−2

@@ -5,8 +5,6 @@ module Main where

5import Control.Monad

6

7import Data.Int

8−import qualified Data.Serialize as Ser

9−import Data.Word (Word8)

10import Network.Socket

8import Network.Socket

11 ( AddrInfoFlag (AI_PASSIVE), HostName, ServiceName, Socket

9 ( AddrInfoFlag (AI_PASSIVE), HostName, ServiceName, Socket

12 , SocketType (Stream), SocketOption (ReuseAddr)

10 , SocketType (Stream), SocketOption (ReuseAddr)

benchmarks/JustPingOneRecv.hs+25−8

@@ -5,8 +5,6 @@ module Main where

5import Control.Monad

6

7import Data.Int

8−import qualified Data.Serialize as Ser

9−import Data.Word (Word8)

10import Network.Socket

8import Network.Socket

11 ( AddrInfoFlag (AI_PASSIVE), HostName, ServiceName, Socket

9 ( AddrInfoFlag (AI_PASSIVE), HostName, ServiceName, Socket

12 , SocketType (Stream), SocketOption (ReuseAddr)

10 , SocketType (Stream), SocketOption (ReuseAddr)

@@ -25,6 +23,13 @@ import Data.ByteString.Char8 (pack, unpack)

25import qualified Data.ByteString as BS

23import qualified Data.ByteString as BS

26import qualified Network.Socket.ByteString as NBS

24import qualified Network.Socket.ByteString as NBS

27import Data.Time (getCurrentTime, diffUTCTime, NominalDiffTime)

25import 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

28

33

29main :: IO ()

34main :: IO ()

30main = do

35main = do

@@ -102,13 +107,25 @@ pong sock = do

102recv :: Socket -> Int -> IO ByteString

107recv :: Socket -> Int -> IO ByteString

103recv sock i = do

108recv sock i = do

104 (header, payload) <- BS.splitAt 4 `fmap` NBS.recv sock (4 + i)

109 (header, payload) <- BS.splitAt 4 `fmap` NBS.recv sock (4 + i)

105− case Ser.decode header :: Either String Int32 of

110+ length <- decodeLength header -- Ignored

106− Left _ -> error "Could not decode header"

107− Right _ -> return payload

111+ return payload

108

112

109-- | Wrapper around NBS.send (for profiling)

113-- | Wrapper around NBS.send (for profiling)

110send :: Socket -> ByteString -> IO ()

114send :: Socket -> ByteString -> IO ()

111send sock bs = do

115send sock bs = do

112− let length :: Int32

113− length = fromIntegral $ BS.length bs

116+ length <- encodeLength (fromIntegral (BS.length bs))

114− NBS.sendMany sock [Ser.encode 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/JustPingNaiveHeader.hs → benchmarks/JustPingWithHeader.hsrenamed+24−6

@@ -5,8 +5,6 @@ module Main where

5import Control.Monad

6

7import Data.Int

8−import qualified Data.Serialize as Ser

9−import Data.Word (Word8)

10import Network.Socket

8import Network.Socket

11 ( AddrInfoFlag (AI_PASSIVE), HostName, ServiceName, Socket

9 ( AddrInfoFlag (AI_PASSIVE), HostName, ServiceName, Socket

12 , SocketType (Stream), SocketOption (ReuseAddr)

10 , SocketType (Stream), SocketOption (ReuseAddr)

@@ -25,6 +23,13 @@ import Data.ByteString.Char8 (pack, unpack)

25import qualified Data.ByteString as BS

23import qualified Data.ByteString as BS

26import qualified Network.Socket.ByteString as NBS

24import qualified Network.Socket.ByteString as NBS

27import Data.Time (getCurrentTime, diffUTCTime, NominalDiffTime)

25import 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

28

33

29main :: IO ()

34main :: IO ()

30main = do

35main = do

@@ -102,12 +107,25 @@ pong sock = do

102recv :: Socket -> Int -> IO ByteString

107recv :: Socket -> Int -> IO ByteString

103recv sock _ = do

108recv sock _ = do

104 header <- NBS.recv sock 4

109 header <- NBS.recv sock 4

105− let Right length = Ser.decode header

110+ length <- decodeLength header

106 NBS.recv sock (fromIntegral (length :: Int32))

111 NBS.recv sock (fromIntegral (length :: Int32))

107

112

108-- | Wrapper around NBS.send (for profiling)

113-- | Wrapper around NBS.send (for profiling)

109send :: Socket -> ByteString -> IO ()

114send :: Socket -> ByteString -> IO ()

110send sock bs = do

115send sock bs = do

111− let length :: Int32

112− length = fromIntegral $ BS.length bs

116+ length <- encodeLength (fromIntegral (BS.length bs))

113− NBS.sendMany sock [Ser.encode 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+6−6

@@ -6,7 +6,7 @@ NUMPINGS=100000

6run: JustPingC.data \

7 JustPingHaskell.data \

8 JustPingHaskell2.data \

9− JustPingNaiveHeader.data \

9+ JustPingWithHeader.data \

10 JustPingOneRecv.data \

11 JustPingCacheHeader.data

12 gnuplot ./JustPing.gnuplot

@@ -20,8 +20,8 @@ JustPingHaskell.data: JustPingHaskell

20JustPingHaskell2.data: JustPingHaskell2

21 time ./JustPingHaskell2 $(NUMPINGS) 2>JustPingHaskell2.data

22

23−JustPingNaiveHeader.data: JustPingNaiveHeader

23+JustPingWithHeader.data: JustPingWithHeader

24− time ./JustPingNaiveHeader $(NUMPINGS) 2>JustPingNaiveHeader.data

24+ time ./JustPingWithHeader $(NUMPINGS) 2>JustPingWithHeader.data

25

26JustPingOneRecv.data: JustPingOneRecv

27 time ./JustPingOneRecv $(NUMPINGS) 2>JustPingOneRecv.data

@@ -38,8 +38,8 @@ JustPingHaskell: JustPingHaskell.hs

38JustPingHaskell2: JustPingHaskell.hs

39 ghc -o JustPingHaskell2 -O2 -threaded JustPingHaskell.hs

40

41−JustPingNaiveHeader: JustPingNaiveHeader.hs

41+JustPingWithHeader: JustPingWithHeader.hs

42− ghc -o JustPingNaiveHeader -O2 -threaded JustPingNaiveHeader.hs

42+ ghc -o JustPingWithHeader -O2 -threaded JustPingWithHeader.hs

43

44JustPingOneRecv: JustPingOneRecv.hs

45 ghc -o JustPingOneRecv -O2 -threaded JustPingOneRecv.hs

@@ -49,6 +49,6 @@ JustPingCacheHeader: JustPingCacheHeader.hs

49

50.PHONY: clean

51clean:

52− rm -f *.data *.ps *.pdf JustPingC JustPingHaskell JustPingHaskell2 JustPingNaiveHeader JustPingOneRecv JustPingCacheHeader

52+ rm -f *.data *.ps *.pdf *.o *.hi JustPingC JustPingHaskell JustPingHaskell2 JustPingWithHeader JustPingOneRecv JustPingCacheHeader

53

54# vi:set noexpandtab: