[Haskell-cafe] Spurious program crashes

[Tomasz Zielonka]

On Mon, Nov 21, 2005 at 10:41:38PM +0000, Joel Reymont wrote:
> STM would complicate things too much for me. At least I think so. I  
> would love to use STM but I would need to fit it into "type  
> ScriptState = ErrorT String (StateT World IO)" just to use the  
> logger. I'm not THAT comfortable with monads.

I am talking about Software Transactional Memory, which is in
Control.Concurrent.STM. I think you confused it with State
Transformer Monad.

In your case STM would allow you to wait simultaneously on (T)MVar and
(T)Chan. It would look like this:

    logger :: TMVar () -> IO ()
    logger die =
        join $ atomically $
            (do x <- readTChan parent
                return $ do
                    putStrLn x
                    logger die)
            `orElse`
            (do takeTMVar die
                return (return ()))

but you have to modify the rest of code to use STM. I modified your
Conc.hs to use STM, but using the greater guarantees of STM you
could surely simplify it further (see the attached patch).

> Let me see if I understand you correctly... Are you saying that I  
> should be using getChanContents in the code below?

I am not proposing to use getChanContents. You are busy-waiting
on MVar and Chan. I just proposed a solution to stuff messages
and die-request into the same concurrency primitive, so you
can wait for both events using a single operation.

But you are right (below) that this bug doesn't explain the behaviour of
your program. It is "only" a performance bug.
 
> logger :: Handle -> MVar () -> IO ()
> logger h die =
>     do empty <- isEmptyChan parent
>        unless empty $ do x <- readChan parent
>                          putStrLn x
>                          hPutStrLn h x
>        alive <- isEmptyMVar die
>        when (alive || not empty) $ logger h die

> I think using Maybe is a great trick but I'm curious why so few  
> messages actually get taken out of the channel in the code above?

Actually, I am not sure. I just noticed that your code uses a bad
coding practice and could be improved. If I find some time I'll try to 
examine it more closely.

> Are  you saing that with all the checking it does not get to pull
> messages  out?

As it is, you code can impose a big performance penalty, but indeed
it shouldn't change the semantics. Perhaps I miss something.

> I see clearly how using Maybe with getChanContents will work out  
> perfectly. I don't understand why the above code is inefficient to  
> the point of printing just a few messages (out of hundreds) out on  
> Windows. I would like to understand it to avoid such mistakes in the  
> future.

Yes, this is strange. Perhaps we're both missing something obvious.

Best regards
Tomasz
-------------- next part --------------

New patches:

[Use STM in Conc.hs
Tomasz Zielonka <tomasz.zielonka at gmail.com>**20051122065752] {
hunk ./Conc.hs 6
+import Control.Concurrent.STM
hunk ./Conc.hs 15
-children = unsafePerformIO $ newMVar []
+children = unsafePerformIO $ atomically $ newMVar []
hunk ./Conc.hs 20
-parent = unsafePerformIO newChan
+parent = unsafePerformIO $ atomically newChan
hunk ./Conc.hs 28
-       writeChan parent $ stamp ++ ": " ++ (show tid) ++ ": " ++ a
+       atomically $ writeChan parent $ stamp ++ ": " ++ (show tid) ++ ": " ++ a
hunk ./Conc.hs 46
-    do empty <- isEmptyChan parent
-       unless empty $ do x <- readChan parent
-                         putStrLn x
-       alive <- isEmptyMVar die
-       when (alive || not empty) $ logger die
+    join $ atomically $
+        (do x <- readChan parent
+            return $ do
+                putStrLn x
+                logger die)
+        `orElse`
+        (do takeMVar die
+            return (return ()))
hunk ./Conc.hs 58
-       logDie <- newEmptyMVar
-       logDead <- newEmptyMVar
-       l <- forkIO (logger logDie `finally` putMVar logDead ())
+       logDie <- atomically newEmptyMVar
+       logDead <- atomically newEmptyMVar
+       l <- forkIO (logger logDie `finally` atomically (putMVar logDead ()))
hunk ./Conc.hs 63
-              do cs <- takeMVar children
+              do cs <- atomically (takeMVar children)
hunk ./Conc.hs 65
-                         []   -> do putMVar die ()
-                                    takeMVar dead
+                         []   -> do atomically $ do
+                                        putMVar die ()
+                                        takeMVar dead
hunk ./Conc.hs 69
-                         m:ms -> do putMVar children ms
-                                    takeMVar m
+                         m:ms -> do atomically $ do
+                                        putMVar children ms
+                                        takeMVar m
hunk ./Conc.hs 76
-    do mvar <- newEmptyMVar
-       childs <- takeMVar children
-       putMVar children (mvar:childs)
-       forkIO (io `finally` putMVar mvar ())
+    do mvar <- atomically newEmptyMVar
+       atomically $ do
+           childs <- takeMVar children
+           putMVar children (mvar:childs)
+       forkIO (io `finally` atomically (putMVar mvar ()))
hunk ./Conc.hs 84
+
replace ./Conc.hs [A-Za-z_0-9] Chan TChan
replace ./Conc.hs [A-Za-z_0-9] MVar TMVar
replace ./Conc.hs [A-Za-z_0-9] newChan newTChan
replace ./Conc.hs [A-Za-z_0-9] newEmptyMVar newEmptyTMVar
replace ./Conc.hs [A-Za-z_0-9] newMVar newTMVar
replace ./Conc.hs [A-Za-z_0-9] putMVar putTMVar
replace ./Conc.hs [A-Za-z_0-9] readChan readTChan
replace ./Conc.hs [A-Za-z_0-9] takeMVar takeTMVar
replace ./Conc.hs [A-Za-z_0-9] writeChan writeTChan
}

Context:

[free ssl handle, read chan 1 item/time, trace excepts
joelr at well.com**20051119135750] 
[added crash dumps to readme
joelr at well.com**20051119023717] 
[readme update
joelr at well.com**20051119013400] 
[server.pem
joelr at well.com**20051119011324] 
[updated readme
joelr at well.com**20051119010300] 
[really small readme 
joelr at well.com**20051119005259] 
[launch 5000 clients, ulimit -n is your friend!
joelr at well.com**20051119004928] 
[small comment
joelr at well.com**20051119003032] 
[fully working
joelr at well.com**20051119000227] 
[ssl handshake working, client blocking indefinitely
joelr at well.com**20051118230017] 
[base
joelr at well.com**20051118145241] 
Patch bundle hash:
663bcce41b9368ca66e8f674d7c8e6f4df3c3892