diff --git a/Control/Concurrent/STM/Stats.hs b/Control/Concurrent/STM/Stats.hs
--- a/Control/Concurrent/STM/Stats.hs
+++ b/Control/Concurrent/STM/Stats.hs
@@ -76,15 +76,21 @@
         -- the exception.
     , warnFunction :: String -> IO ()
         -- ^ Function to call when a warning is to be emitted.
+    , warnInSTMFunction :: String -> IO ()
+        -- ^ Function to call when a warning is to be emitted during an STM
+        -- transaction. This is possibly dangerous, see the documentation to
+        -- 'unsafeIOToSTM', but can be useful to detect transactions that keep
+        -- retrying forever.
     }
 
 -- | The default settings are:
 --
 -- > defaultTrackSTMConf = TrackSTMConf
--- >    { tryThreshold =   Just 10
--- >    , globalTheshold = Just 3000
--- >    , exception =      True
--- >    , warnFunction =   hPutStrLn stderr
+-- >    { tryThreshold =      Just 10
+-- >    , globalTheshold =    Just 3000
+-- >    , exception =         True
+-- >    , warnFunction =      hPutStrLn stderr
+-- >    , warnInSTMFunction = \_ -> return ()
 -- >    }
 defaultTrackSTMConf :: TrackSTMConf
 defaultTrackSTMConf = TrackSTMConf 
@@ -92,6 +98,7 @@
     , globalTheshold = Just 3000
     , extendException = True
     , warnFunction = hPutStrLn stderr
+    , warnInSTMFunction = \_ -> return ()
     }
 
 -- | A drop-in replacement for 'atomically'. The statistics will list this, and
@@ -128,17 +135,13 @@
     counter <- newIORef 0
     let wrappedTx =
             do  unsafeIOToSTM $ do
-                    atomicModifyIORef counter incCounter
-                    -- This is disabled, because the documentation to
-                    -- unsafeIOToSTM says that using handles in unsafeIOToSTM
-                    -- can cause deadlocks:
-                    --
-                    -- when (warnPred i) $
-                    --  warnFunction $ msgPrefix ++ " reached try count of " ++ show i
+                    i <- atomicModifyIORef counter incCounter
+                    when (warnPred i) $
+                        warnInSTMFunction $ msgPrefix ++ " reached try count of " ++ show i
                 txm
     res <- if extendException
           then atomically wrappedTx
-              `catch` (\(e::BlockedIndefinitelyOnSTM) ->
+              `catch` (\(_::BlockedIndefinitelyOnSTM) ->
                        throwIO (BlockedIndefinitelyOnNamedSTM name))
           else atomically wrappedTx
     i <- readIORef counter
@@ -153,21 +156,19 @@
     incCounter i = let j = i + 1 in (j, j)
     warnPred j = case tryThreshold of
         Nothing -> False
-        Just n  -> j >= 2*n && (j >= 4 * n || j `mod` 2 * n == 0)
+        Just n  -> j >= 2*n && (j >= 4 * n || j `mod` (2 * n) == 0)
     msgPrefix = "STM transaction " ++ name
     incGlobalRetryCount i = do
-        k <- atomicModifyIORef globalRetryCountMap $ \m -> 
+        (k,k') <- atomicModifyIORef globalRetryCountMap $ \m -> 
                 let (oldVal, m') = M.insertLookupWithKey'
                                     (\_ (a1,b1) (a2,b2) -> ((,) $! a1+a2) $! b1+b2)
                                     name
                                     (1,i)
                                     m
-                in (m', case oldVal of
-                             Nothing -> i
-                             Just (_,j) -> j+i)
+                in (m', let j = maybe 0 snd oldVal in (j,j+i))
         doMB globalTheshold $ \globalRetryThreshold -> 
-            when (k > 0 && k `mod` globalRetryThreshold == 0) $
-                warnFunction $ msgPrefix ++ "reached global retry count of " ++ show k
+            when (k `div` globalRetryThreshold /= k' `div` globalRetryThreshold) $
+                warnFunction $ msgPrefix ++ " reached global retry count of " ++ show k'
 
 -- | If 'extendException' is set (which is the case with 'trackNamedSTM'), an
 -- occurrence of 'BlockedIndefinitelyOnSTM' is replaced by
@@ -197,8 +198,8 @@
     stats <- getSTMStats
     time <- show <$> getCurrentTime
     hPutStrLn stderr $ "STM transaction statistics (" ++ time ++ "):"
-    hPrintf stderr "%-12s %10s %10s %10s\n" "Transaction" "Commits" "Retries" "Ratio"
-    sequence_
+    sequence_ $
+        hPrintf stderr "%-12s %10s %10s %10s\n" "Transaction" "Commits" "Retries" "Ratio" :
         [ hPrintf stderr "%-12s %10d %10d %10.2f\n" name commits retries ratio
         | (name,(commits,retries)) <- M.toList stats
         , commits > 0 -- safeguard
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,5 @@
 Copyright (c) 2011 David Leuschner
+Copyright (c) 2011 Stefan Wehr
 Copyright (c) 2011 Joachim Breitner
 
 All rights reserved.
diff --git a/stm-stats.cabal b/stm-stats.cabal
--- a/stm-stats.cabal
+++ b/stm-stats.cabal
@@ -1,5 +1,5 @@
 Name:           stm-stats
-Version:        0.1.0.0
+Version:        0.2.0.0
 Synopsis:       retry statistics for STM transactions
 Description:    This module provides functions that can replace calls to
                 'atomically' and count how often the transaction was retried
@@ -11,9 +11,23 @@
                 transaction-related exceptions such as
                 'BlockedIndefinitelyOnSTM' are replaced by variants that
                 indicate which transaction caused the exception.
+                .
+                /Changelog:/
+                .
+                [0.2.0.0] (2011-10-10)
+                .
+                [ ] Added 'warnInSTMFunction' to 'TrackSTMConf'.
+                .
+                [ ] Bugfix with the global retry count warning.
+                .
+                [0.1.0.0] (2011-10-09)
+                .
+                [ ] Initial Release
+
 License:        BSD3
 License-file:   LICENSE
 Author:         David Leuschner <leuschner@factisresearch.com>,
+                Stefan Wehr <wehr@factisresearch.com>,
                 Joachim Breitner <mail@joachim-breitner.de>
 Maintainer:     Joachim Breitner <mail@joachim-breitner.de>
 Category:       Concurrency