diff --git a/library/SlaveThread.hs b/library/SlaveThread.hs
--- a/library/SlaveThread.hs
+++ b/library/SlaveThread.hs
@@ -41,6 +41,8 @@
 import BasePrelude hiding (forkFinally)
 import Control.Monad.Trans.Reader
 import Control.Monad.Morph
+import GHC.IO (IO(IO))
+import GHC.Exts (Int(I#), fork#, forkOn#)
 import qualified STMContainers.Multimap as Multimap
 import qualified PartialHandler
 import qualified ListT
@@ -71,32 +73,29 @@
 {-# INLINABLE forkFinally #-}
 forkFinally :: IO a -> IO b -> IO ThreadId
 forkFinally finalizer computation =
-  do
+  mask $ \unmask -> do
     masterThread <- myThreadId
-    -- Ensures that the thread gets registered before this function returns.
-    semaphore <- newEmptyMVar
+    -- Ensures that the thread gets registered before being unregistered
+    registrationPass <- newEmptyMVar
     slaveThread <-
-      mask $ \restore -> forkIO $ do
+      forkIOWithoutHandler $ do
         slaveThread <- myThreadId
-        atomically $ Multimap.insert slaveThread masterThread slaves
-        putMVar semaphore ()
-        r <- try $ restore computation
+        catch (void $ unmask computation) $
+          PartialHandler.totalizeRethrowingTo_ masterThread $ 
+            PartialHandler.onThreadKilled (return ())
         -- Context management:
         killSlaves slaveThread
         waitForSlavesToDie slaveThread
-        -- Finalization and rethrowing of exceptions into the master thread:
-        forM_ (left r) $ 
-          PartialHandler.totalizeRethrowingTo_ masterThread $ 
-            PartialHandler.onThreadKilled (return ())
-        try finalizer >>= \r ->
-          forM_ (left r) $ PartialHandler.totalizeRethrowingTo_ masterThread $ mempty
+        -- Finalization:
+        catch (void finalizer) $
+          PartialHandler.totalizeRethrowingTo_ masterThread $ mempty
         -- Unregister from the global state,
         -- thus informing the master of this thread's death.
+        takeMVar registrationPass
         atomically $ Multimap.delete slaveThread masterThread slaves
-    takeMVar semaphore
+    atomically $ Multimap.insert slaveThread masterThread slaves
+    putMVar registrationPass ()
     return slaveThread
-  where
-    left = either Just (const Nothing)
 
 killSlaves :: ThreadId -> IO ()
 killSlaves thread =
@@ -106,6 +105,12 @@
 waitForSlavesToDie thread =
   atomically $ do
     null <- ListT.null $ Multimap.streamByKey thread slaves
-    if null
-      then return ()
-      else retry
+    when (not null) retry
+
+-- |
+-- A more efficient version of 'forkIO', 
+-- which does not install a default exception handler on the forked thread.
+{-# INLINE forkIOWithoutHandler #-}
+forkIOWithoutHandler :: IO () -> IO ThreadId
+forkIOWithoutHandler action = 
+  IO $ \s -> case (fork# action s) of (# s', tid #) -> (# s', ThreadId tid #)
diff --git a/slave-thread.cabal b/slave-thread.cabal
--- a/slave-thread.cabal
+++ b/slave-thread.cabal
@@ -1,7 +1,7 @@
 name:
   slave-thread
 version:
-  0.1.1
+  0.1.2
 synopsis:
   A solution to ghost threads and silent exceptions
 description:
diff --git a/tests/Main.hs b/tests/Main.hs
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -13,9 +13,9 @@
 
 
 test_forkedThreadsRunFine = 
-  replicateM 100 $ do
-    var <- newIORef 0
-    let increment = modifyIORef var (+1)
+  replicateM 100000 $ do
+    var <- newMVar 0
+    let increment = modifyMVar_ var (return . succ)
     semaphore <- SSem.new 0
     S.fork $ do
       increment
@@ -29,58 +29,62 @@
       SSem.wait semaphore'
       SSem.signal semaphore
     SSem.wait semaphore
-    assertEqual 3 =<< readIORef var
+    assertEqual 3 =<< readMVar var
 
 test_killingAThreadKillsDeepSlaves = 
-  replicateM 100 $ do
-    var <- newIORef 0
-    let increment = modifyIORef var (+1)
+  replicateM 100000 $ do
+    var <- newMVar 0
     semaphore <- SSem.new 0
     thread <- 
       S.forkFinally (SSem.signal semaphore) $ do
-        w <- forkWait $ do
-          w <- forkWait $ do
-            threadDelay $ 20*10^3
-            increment
-          w
-        w
+        join $ forkWait $ do
+          join $ forkWait $ do
+            w <- forkWait $ do
+              threadDelay $ 10^6
+              modifyMVar_ var (return . succ)
+            threadDelay $ 10^6
+            modifyMVar_ var (return . succ)
+            w
     killThread thread
     SSem.wait semaphore
-    assertEqual 0 =<< readIORef var
+    assertEqual 0 =<< readMVar var
 
 test_dyingNormallyKillsSlaves = 
-  replicateM 100 $ do
+  replicateM 100000 $ do
     var <- newIORef 0
     let increment = modifyIORef var (+1)
     semaphore <- SSem.new 0
     S.forkFinally (SSem.signal semaphore) $ do
       S.fork $ do
-        threadDelay $ 10^4
+        threadDelay $ 10^6
         increment
       S.fork $ do
-        threadDelay $ 10^4
+        threadDelay $ 10^6
         increment
     SSem.wait semaphore
     assertEqual 0 =<< readIORef var
 
 test_finalizationOrder = 
-  replicateM 1000 $ do
-    var <- newIORef 0
+  replicateM 100000 $ do
+    var <- newMVar []
     semaphore <- SSem.new 0
-    S.forkFinally (modifyIORef var (*2) >> SSem.signal semaphore) $ do
-      S.forkFinally (modifyIORef var (+1)) $ return ()
-      S.forkFinally (modifyIORef var (+1)) $ return ()
+    S.forkFinally (uninterruptibleMask_ (modifyMVar_ var (return . (1:)) >> SSem.signal semaphore)) $ do
+      semaphore' <- SSem.new 0
+      S.forkFinally (uninterruptibleMask_ (modifyMVar_ var (return . (2:)) >> SSem.signal semaphore')) $ do
+        S.forkFinally (uninterruptibleMask_ (modifyMVar_ var (return . (3:)))) $ return ()
+        S.forkFinally (uninterruptibleMask_ (modifyMVar_ var (return . (3:)))) $ return ()
+      SSem.wait semaphore'
     SSem.wait semaphore
-    assertEqual 4 =<< readIORef var
+    assertEqual [1,2,3,3] =<< readMVar var
 
 test_exceptionsDontGetLost = 
-  replicateM 100 $ do
+  replicateM 100000 $ do
     assertThrowsSomeIO $ do
       S.fork $ do
         S.fork $ do
           error "!"
-        threadDelay $ 10^4
-      threadDelay $ 10^4
+        threadDelay $ 10^6
+      threadDelay $ 10^6
 
 forkWait :: IO a -> IO (IO ())
 forkWait io =