8c065e4 · distributed-process

git.iko.soy/distributed-process

on master help sign in

minor: make writes use strict bytestrings to reduce interleaving

8c065e4Ryan Newton15 years ago

examples/DemoTransport.hs+3−2

compare with master

unifiedsplit

@@ -37,7 +37,7 @@ demo0 mktrans = do

37 mapM_ (\n -> send sourceEnd [BS.pack ("hello " ++ show n)]) [1 .. 10]

38 threadDelay 100000

40− closeTransport trans

40+-- closeTransport trans

42-- | Check endpoint serialization and deserialization.

43demo1 :: IO Transport -> IO ()

@@ -136,6 +136,7 @@ logServer name targetEnd = forever $ do

136runWAllTranports :: (IO Transport -> IO ()) -> Int -> IO ()

137runWAllTranports demo offset = do

138 putStrLn "------------------------------------------------------------"

139+{-

139 putStrLn " MVAR transport:"

140 putStrLn " MVAR transport:"

140 demo Network.Transport.MVar.mkTransport

141 demo Network.Transport.MVar.mkTransport

141

142

@@ -144,7 +145,7 @@ runWAllTranports demo offset = do

144 demo$ do cnt <- readIORef cntr

145 demo$ do cnt <- readIORef cntr

145 writeIORef cntr (cnt+1)

146 writeIORef cntr (cnt+1)

146 mkTransport (TCPConfig undefined "127.0.0.1" (show (8080 + offset + cnt)))

147 mkTransport (TCPConfig undefined "127.0.0.1" (show (8080 + offset + cnt)))

147−

148+-}

148 putStrLn "\n PIPES transport:"

149 putStrLn "\n PIPES transport:"

149 demo Network.Transport.Pipes.mkTransport

150 demo Network.Transport.Pipes.mkTransport

150 putStrLn "\n"

151 putStrLn "\n"

network-transport/src/Network/Transport/Pipes.hs+10−6

@@ -13,7 +13,7 @@ import Data.Word

13import Data.Int

14import Data.IORef

15import qualified Data.IntMap as IntMap

16−-- import qualified Data.ByteString.Char8 as BS

16+import qualified Data.ByteString.Char8 as BSS

17import qualified Data.ByteString.Lazy.Char8 as BS

19import Data.Binary (encode,decode)

@@ -80,10 +80,11 @@ mkTransport = do

80 -- Note: Linux fifo semantics are NOT to block on open-RW, but this is not Posix standard.

81 --

82 -- We may protect from blocking other threads by running on a separate (OS) thread:

83− mv <- onOSThread$ PIO.openFd filename PIO.ReadWrite Nothing PIO.defaultFileFlags

83+-- mv <- onOSThread$ PIO.openFd filename PIO.ReadWrite Nothing PIO.defaultFileFlags

84-- fd <- PIO.openFd filename PIO.ReadWrite Nothing PIO.defaultFileFlags

85−-- fd <- PIO.openFd filename PIO.WriteOnly Nothing PIO.defaultFileFlags

85+ fd <- PIO.openFd filename PIO.WriteOnly Nothing PIO.defaultFileFlags

86− fd <- takeMVar mv

86+-- fd <- takeMVar mv

87+ dbgprint1$ "GOT WRITING END OPEN ... "

88 return $

89 return $

89 -- Write to the named pipe. If the message is less than

90 -- Write to the named pipe. If the message is less than

@@ -130,7 +131,10 @@ mkTransport = do

130

131

131 let spinread :: Int64 -> IO BS.ByteString

132 let spinread :: Int64 -> IO BS.ByteString

132 spinread desired = do

133 spinread desired = do

134+#ifdef DEBUG

133-- hPutStr stderr "."

135-- hPutStr stderr "."

136+ BSS.hPutStr stdout (BSS.pack$ " "++show desired)

137+#endif

134 (bytes,len) <- oneread desired

138 (bytes,len) <- oneread desired

135 case len of

139 case len of

136 n | n == desired -> return bytes

140 n | n == desired -> return bytes

@@ -151,8 +155,8 @@ mkTransport = do

151 }

155 }

152

156

153#ifdef DEBUG

157#ifdef DEBUG

158+dbgprint1 s = BSS.hPutStrLn stderr (BSS.pack s)

154−dbgprint2 = hPutStrLn stdout

159+dbgprint2 s = BSS.hPutStrLn stdout (BSS.pack s)

155−dbgprint1 = hPutStrLn stderr

156#else

160#else

157dbgprint1 _ = return ()

161dbgprint1 _ = return ()

158dbgprint2 _ = return ()

162dbgprint2 _ = return ()