@@ -112,9 +112,10 @@ mkTransport = do
112112 -- OPTION (1)
113113 -- Here we protect from blocking other threads by running on a separate (OS) thread:
114114-- mv <- onOSThread$ PIO.openFd filename PIO.ReadWrite Nothing fileFlags
115+ dbgprint1$ "About to try opening writing end:"
115116 mv <- onOSThread$ tryUntilNoIOErr $
116117 PIO.openFd filename PIO.WriteOnly Nothing fileFlags
117− fd <- takeMVar mv
118+-- fd <- takeMVar mv
118119
119120 -- OPTION (2) / (3)
120121-- spinTillThere filename
@@ -143,7 +144,7 @@ mkTransport = do
143144 dbgprint1$ " Final send msg: " ++ show finalmsg
144145
145146 -- OPTION 2: Speculative file opening, plus this synchronnization:
146−-- fd <- readMVar mv
147+ fd <- readMVar mv
147148 ----------------------------------------
148149 cnt <- PIO.fdWrite fd (fromBS finalmsg) -- inefficient to use String here!
149150 unless (fromIntegral cnt == BS.length finalmsg) $
@@ -163,6 +164,7 @@ mkTransport = do
163164 dbgprint2$ " (got lock)"
164165
165166 spinTillThere filename
167+ -- Opening the file on the reader side should always succeed:
166168 fd <- PIO.openFd filename PIO.ReadOnly Nothing fileFlags
167169-- fd <- PIO.openFd filename PIO.ReadWrite Nothing fileFlags
168170-- mv <- onOSThread$ PIO.openFd filename PIO.ReadWrite Nothing fileFlags
@@ -224,47 +226,38 @@ mkTransport = do
224226
225227spinTillThere :: String -> IO ()
226228spinTillThere filename =
227− do dbgprint2$ " Spinning till file present: "++ filename
228− loop 1
229+ do dbgprint2$ " Spinning till file present: "++ filename
230+ mkBackoff >>= loop
229231 where
230− maxwait = 10 * 1000
231− loop t | t > maxwait = loop maxwait
232− loop t = do b <- doesFileExist filename
233− unless b $ do
234−#ifdef DEBUG
235− hPutStr stderr "?"
236−#endif
237− threadDelay t
238− loop (2 * t)
239−-- loop $ round (fromIntegral t * 1.5)
240−
241−data InfIO = InfIO (IO (InfIO))
232+ loop bkoff = do b <- doesFileExist filename
233+ unless b $ do bkoff; loop bkoff
242234
243−-- mkBackoff :: IO (IO ())
244235
236+mkBackoff :: IO (IO ())
245237mkBackoff =
246238 do tref <- newIORef 1
247239 return$ do t <- readIORef tref
248− writeIORef tref (min (10 * 1000) (2 * t))
240+ writeIORef tref (min maxwait (2 * t))
249241 threadDelay t
242+ where
243+ maxwait = 50 * 1000
250244
251245tryUntilNoIOErr :: IO a -> IO a
252246tryUntilNoIOErr action = mkBackoff >>= loop
253247 where
254248 loop bkoff =
255− handle (\ (e :: IOException) -> bkoff >> loop bkoff) $
249+ handle (\ (e :: IOException) ->
250+ do bkoff
251+ dbgprint2$ " got IO exn: " ++ show e
252+ loop bkoff) $
256253 action
257254
258−
259−-- loop (InfIO bkoff) =
260−-- handle (\ (e :: IOException) ->
261−-- do InfIO nxt <- bkoff
262−-- loop nxt) $
263−-- action
264−
265−
266−
267−
255+-- Execute an action on its own OS thread. Return an MVar to synchronize on.
256+onOSThread :: IO a -> IO (MVar a)
257+onOSThread action = do
258+ mv <- newEmptyMVar
259+ forkOS (action >>= putMVar mv )
260+ return mv
268261
269262#ifdef DEBUG
270263dbgprint1 s = do BSS.hPutStrLn stderr (BSS.pack s); hFlush stderr;
@@ -274,11 +267,3 @@ dbgprint1 _ = return ()
274267dbgprint2 _ = return ()
275268#endif
276269
277−
278−-- Execute an action on its own OS thread. Return an MVar to synchronize on.
279−onOSThread :: IO a -> IO (MVar a)
280−onOSThread action = do
281− mv <- newEmptyMVar
282− forkOS (action >>= putMVar mv )
283− return mv
284−-- [2012.02.19] This didn't seem to help.