git.iko.soy/distributed-process
on master help sign in
minor: make writes use strict bytestrings to reduce interleaving
commit8c065e46e76a888f0952bd933cce32dfeab2c5b1 authorRyan Newton <rrnewton@gmail.com> dateMon 20 Feb 2012, 14:51 (15 years ago) parentcc13eec
2 files changed+13−8
compare with master
unifiedsplit
examples/DemoTransport.hs+3−2 network-transport/src/Network/Transport/Pipes.hs+10−6
examples/DemoTransport.hs+3−2
@@ -37,7 +37,7 @@ demo0 mktrans = do
3737 mapM_ (\n -> send sourceEnd [BS.pack ("hello " ++ show n)]) [1 .. 10]
3838 threadDelay 100000
3939
40− closeTransport trans
40+-- closeTransport trans
4141
4242-- | Check endpoint serialization and deserialization.
4343demo1 :: IO Transport -> IO ()
@@ -136,6 +136,7 @@ logServer name targetEnd = forever $ do
136136runWAllTranports :: (IO Transport -> IO ()) -> Int -> IO ()
137137runWAllTranports demo offset = do
138138 putStrLn "------------------------------------------------------------"
139+{-
139140 putStrLn " MVAR transport:"
140141 demo Network.Transport.MVar.mkTransport
141142
@@ -144,7 +145,7 @@ runWAllTranports demo offset = do
144145 demo$ do cnt <- readIORef cntr
145146 writeIORef cntr (cnt+1)
146147 mkTransport (TCPConfig undefined "127.0.0.1" (show (8080 + offset + cnt)))
147−
148+-}
148149 putStrLn "\n PIPES transport:"
149150 demo Network.Transport.Pipes.mkTransport
150151 putStrLn "\n"
network-transport/src/Network/Transport/Pipes.hs+10−6
@@ -13,7 +13,7 @@ import Data.Word
1313import Data.Int
1414import Data.IORef
1515import qualified Data.IntMap as IntMap
16−-- import qualified Data.ByteString.Char8 as BS
16+import qualified Data.ByteString.Char8 as BSS
1717import qualified Data.ByteString.Lazy.Char8 as BS
1818
1919import Data.Binary (encode,decode)
@@ -80,10 +80,11 @@ mkTransport = do
8080 -- Note: Linux fifo semantics are NOT to block on open-RW, but this is not Posix standard.
8181 --
8282 -- 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
8484-- fd <- PIO.openFd filename PIO.ReadWrite Nothing PIO.defaultFileFlags
85−-- fd <- PIO.openFd filename PIO.WriteOnly Nothing PIO.defaultFileFlags
86− fd <- takeMVar mv
85+ fd <- PIO.openFd filename PIO.WriteOnly Nothing PIO.defaultFileFlags
86+-- fd <- takeMVar mv
87+ dbgprint1$ "GOT WRITING END OPEN ... "
8788
8889 return $
8990 -- Write to the named pipe. If the message is less than
@@ -130,7 +131,10 @@ mkTransport = do
130131
131132 let spinread :: Int64 -> IO BS.ByteString
132133 spinread desired = do
134+#ifdef DEBUG
133135-- hPutStr stderr "."
136+ BSS.hPutStr stdout (BSS.pack$ " "++show desired)
137+#endif
134138 (bytes,len) <- oneread desired
135139 case len of
136140 n | n == desired -> return bytes
@@ -151,8 +155,8 @@ mkTransport = do
151155 }
152156
153157#ifdef DEBUG
154−dbgprint2 = hPutStrLn stdout
155−dbgprint1 = hPutStrLn stderr
158+dbgprint1 s = BSS.hPutStrLn stderr (BSS.pack s)
159+dbgprint2 s = BSS.hPutStrLn stdout (BSS.pack s)
156160#else
157161dbgprint1 _ = return ()
158162dbgprint2 _ = return ()