TMVar's are great but fail under ghc 6.10.1 windows

Control.Concurrent.STM.TMVar's combine the best of MVars and TVars: -Unlike TVars, they permit blocking/early retry when the TMVar is being used by other process, so that complete processes are not retried at the end when happens that the TVars have been modified in the meantime. - Unlike MVars, they have no deadlocks, specially when a process is trying to adquire exclusive access to more than one TMVar. however, It happens that fails in my windows box with ghc 6.10.1 , single core here is the code and the results: -----------begin code: module Main where import Control.Concurrent.STM import Control.Concurrent import System.IO.Unsafe import GHC.Conc mtxs= unsafePerformIO $ mapM newTMVarIO $ take 5 $ repeat 0 proc i= atomically $ do unsafeIOToSTM $ putStr $ "init of process "++ show i++"\n" xs<- mapM takeTMVar mtxs mapM (\(mtx,x) ->putTMVar mtx (x+1)) $ zip mtxs xs xs' <- mapM readTMVar mtxs unsafeIOToSTM $ putStr $ "End of processs "++show i ++ " result= "++ show xs'++"\n" main=do mapM (forkIO . proc) [1..5] threadDelay 100000000 -------------end code the rigth result must be (occasionally with some "init of process x" repeated) init of process 1 init of process 2 End of processs 1 result= [1,1,1,1,1] init of process 2 -- retried End of processs 2 result= [2,2,2,2,2] init of process 3 End of processs 3 result= [3,3,3,3,3] init of process 4 End of processs 4 result= [4,4,4,4,4] init of process 5 End of processs 5 result= [5,5,5,5,5] under windows the program produces strange results for example init of process 1 init of process 2 init of process 3 init of process 4 init of process 5 End of processs 1 result= [1,1,1,1,1] End of processs 2 result= [1,1,1,1,1] (deadlock) or this other: init of process 1 init of process 2 init of process 3 init of process 4 init of process 5 End of processs 1 result= [1,1,1,1,1] End of processs 2 result= [1,1,1,1,1] init of process 3 init of process 4 init of process 5 init of process 2 End of processs 4 result= [2,2,2,2,2] End of processs 3 result= [2,2,2,2,2] End of processs 5 result= [2,2,2,2,2] End of processs 2 result= [2,2,2,2,2] init of process 3 init of process 5 init of process 2 End of processs 3 result= [3,3,3,3,3] End of processs 5 result= [3,3,3,3,3]

Is it possible to rewrite this without unsafeIOToSTM? unsafeIOToSTM is insanely unsafe, and can cause otherwise working STM code to do unpredictable and terrible things to the runtime. Cheers, Sterl. On Mar 30, 2009, at 4:27 PM, Alberto G. Corona wrote:
Control.Concurrent.STM.TMVar's combine the best of MVars and TVars:
-Unlike TVars, they permit blocking/early retry when the TMVar is being used by other process, so that complete processes are not retried at the end when happens that the TVars have been modified in the meantime.
- Unlike MVars, they have no deadlocks, specially when a process is trying to adquire exclusive access to more than one TMVar.
however, It happens that fails in my windows box with ghc 6.10.1 , single core
here is the code and the results:
-----------begin code:
module Main where
import Control.Concurrent.STM
import Control.Concurrent import System.IO.Unsafe import GHC.Conc
mtxs= unsafePerformIO $ mapM newTMVarIO $ take 5 $ repeat 0
proc i= atomically $ do unsafeIOToSTM $ putStr $ "init of process "++ show i++"\n" xs<- mapM takeTMVar mtxs
mapM (\(mtx,x) ->putTMVar mtx (x+1)) $ zip mtxs xs
xs' <- mapM readTMVar mtxs unsafeIOToSTM $ putStr $ "End of processs "++show i ++ " result= "+ + show xs'++"\n"
main=do mapM (forkIO . proc) [1..5] threadDelay 100000000
-------------end code
the rigth result must be (occasionally with some "init of process x" repeated)
init of process 1 init of process 2 End of processs 1 result= [1,1,1,1,1] init of process 2 -- retried End of processs 2 result= [2,2,2,2,2] init of process 3 End of processs 3 result= [3,3,3,3,3] init of process 4 End of processs 4 result= [4,4,4,4,4] init of process 5 End of processs 5 result= [5,5,5,5,5]
under windows the program produces strange results for example
init of process 1 init of process 2 init of process 3 init of process 4 init of process 5 End of processs 1 result= [1,1,1,1,1] End of processs 2 result= [1,1,1,1,1] (deadlock)
or this other:
init of process 1 init of process 2 init of process 3 init of process 4 init of process 5 End of processs 1 result= [1,1,1,1,1] End of processs 2 result= [1,1,1,1,1] init of process 3 init of process 4 init of process 5 init of process 2 End of processs 4 result= [2,2,2,2,2] End of processs 3 result= [2,2,2,2,2] End of processs 5 result= [2,2,2,2,2] End of processs 2 result= [2,2,2,2,2] init of process 3 init of process 5 init of process 2 End of processs 3 result= [3,3,3,3,3] End of processs 5 result= [3,3,3,3,3] _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Alberto G. Corona wrote:
however, It happens that fails in my windows box with ghc 6.10.1 , single core
here is the code and the results:
-----------begin code: module Main where
import Control.Concurrent.STM
import Control.Concurrent import System.IO.Unsafe import GHC.Conc
mtxs= unsafePerformIO $ mapM newTMVarIO $ take 5 $ repeat 0
proc i= atomically $ do unsafeIOToSTM $ putStr $ "init of process "++ show i++"\n"
As Sterling points out, unsafeIOToSTM is really unsafe. A fundamental restriction is that the IO action used with unsafeIOToSTM may not block. However, putStr may block. It's actually possible to do the logging without blocking:
cut here >>> module Main where
import Control.Concurrent import Control.Concurrent.STM import GHC.Conc import Control.Concurrent.MVar import Data.IORef import Control.Monad data Logger = Logger (IORef [String]) (MVar ()) newLogger :: IO Logger newLogger = do ref <- newIORef [] wake <- newEmptyMVar return $ Logger ref wake logLogger :: Logger -> String -> IO () logLogger (Logger ref wake) msg = do atomicModifyIORef ref $ \msgs -> (msg:msgs, ()) tryPutMVar wake () return () dumpLogger :: Logger -> IO () dumpLogger (Logger ref wake) = forever $ do takeMVar wake msgs <- atomicModifyIORef ref $ \msgs -> ([], msgs) putStr $ unlines . reverse $ msgs proc log mtxs i = do let logSTM = unsafeIOToSTM . log xs' <- atomically $ do logSTM $ "init of process " ++ show i xs <- mapM takeTMVar mtxs mapM (\(mtx, x) -> putTMVar mtx (x+1)) $ zip mtxs xs xs' <- mapM readTMVar mtxs logSTM $ "End of processs " ++ show i ++ " result = " ++ show xs' return xs' log $ "Final result of process " ++ show i ++ " = " ++ show xs' main = do log <- newLogger forkIO $ dumpLogger log mtxs <- replicateM 5 $ newTMVarIO 0 mapM (forkIO . proc (logLogger log) mtxs) [1..5] threadDelay 1000000 <<< And that gives reasonable results, for example: init of process 1 End of processs 1 result= [1,1,1,1,1] Final result of process 1 = [1,1,1,1,1] init of process 2 End of processs 2 result= [2,2,2,2,2] Final result of process 2 = [2,2,2,2,2] init of process 3 init of process 4 End of processs 4 result= [3,3,3,3,3] Final result of process 4 = [3,3,3,3,3] init of process 5 End of processs 5 result= [4,4,4,4,4] Final result of process 5 = [4,4,4,4,4] End of processs 3 result= [3,3,3,3,3] init of process 3 End of processs 3 result= [5,5,5,5,5] Final result of process 3 = [5,5,5,5,5] HTH, Bertram
participants (3)
-
Alberto G. Corona
-
Bertram Felgenhauer
-
Sterling Clover