Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Loading…

Replace use of deprecated QSem with MVar #1108

Merged
merged 1 commit into from

5 participants

@bgamari

If my reading of the MVar documentation is correct, this should be safe
as we are accounting for the case where two threads can putMVar
simultaneously. Would someone like to confirm this? Otherwise it compiles and appears to work correctly (although testing is hampered by the brokenness of my GHC 7.7 tree at the moment).

@tibbe
Owner

@23Skidoo Can you take a look?

cabal-install/Distribution/Client/JobControl.hs
((11 lines not shown))
withJobLimit :: JobLimit -> IO a -> IO a
withJobLimit (JobLimit sem) =
- bracket_ (waitQSem sem) (signalQSem sem)
+ bracket_ takeJob putJob
+ where
+ takeJob = do n <- takeMVar sem
@tibbe Owner
tibbe added a note

Shouldn't we be using modifyMVar_?

@bgamari
bgamari added a note
@tibbe Owner
tibbe added a note

What about asynchronous exceptions (e.g. if someone tries to kill this thread).

@bgamari
bgamari added a note
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
@23Skidoo
Collaborator

Can't we just use the SafeSemaphore package as recommended in Control.Concurrent.QSem docs? If we don't want to add a new dependency, we can just add the Control.Concurrent.MSem module to our tree.

@bgamari

@23Skidoo, I for one would be opposed to wholesale copying of entire modules where three lines of fairly standard MVar code appears to suffice. I asked whether we could use SafeSemphore, but tibbe is understandably against growing the build dependency list.

@bgamari

@tibbe, Here I have mask_'d exceptions in both put and take operations. I believe this should now be safe against asynchronous exceptions. As far as I can tell, the only other exceptions that could sneak in are from bottom showing up in the count, which really shouldn't be possible. Have I missed anything here?

@bgamari

@23Skidoo, does this address your concern about the take-before-modify that the last approach suffered from?

@23Skidoo
Collaborator

@bgamari IMO, the fact that people spent so much time on getting semaphores right shows that this stuff is not straightforward. In general, I prefer re-using standard components to reimplementing them. The Control.Concurrent.MSem module is fairly small (if we don't take comments into account) and self-contained.

@tibbe
Owner

We can't depend on SafeSemaphore since it's not in the platform.

@23Skidoo
Collaborator

@tibbe What about just adding the relevant module to the source tree?

@bgamari

After struggling to get this right (thanks to @23Skidoo for his critiques), I must say that I'm beginning to agree that this is non-trivial enough where we might just want to steal SafeSemaphore's implementation. I'm not at all convinced that my current code is safe.

@tibbe
Owner

@23Skidoo That'd be fine (add it to Compat). Make sure that the license information is kept and that it's compatible with the Cabal license.

@23Skidoo
Collaborator

Added MSem to Distribution.Compat in ea1f338.

@23Skidoo 23Skidoo closed this
@simonmar
Owner
@23Skidoo
Collaborator

@simonmar There is an STM-based semaphore in SafeSemaphore, but I'm not sure whether it's OK to add a dependency on stm to cabal-install.

@bgamari

@simonmar, I suggested the possibility of adding a dependency on stm to @tibbe, who at the time said the task didn't require it (which I at the time agreed with, not realizing the true depth of the problem). Given that stm is in the Haskell Platform, however, it seems it would be mildly more acceptable to add a dependency on it than SafeSemaphore. @tibbe, has this discussion changed your opinion on stm or should we just copy MSem into the tree and move on?

@tibbe
Owner

Here are my thoughts.

I think it was wrong to remove semaphores from base. They're a basic concurrency construct and we should have a working implementation. If the previous implementation was broken we should have fixed it. As @simonmar correctly points out, this stuff is hard to get right, so we should get it right once instead of relying on people on Hackage figuring it out themselves in multiple different packages.

Now, since the damage is already done an we no longer have semaphores in base we need to decide what to do. I don't particularly like any of the options. STM is a big hammer (with a complex implementation and harder operational reasoning) than semaphores. It would also require adding more dependencies, which is generally a pain, especially when bootstrapping. Since I don't see any good solutions I don't feel very strongly about this, thus I'm in favor of the status quo; include a semaphore implementation in Cabal.

@dcoutts what do you think?

@feuerbach

I think it was wrong to remove semaphores from base. They're a basic concurrency construct and we should have a working implementation.

This is an argument to have it in the platform, not in base.

we should get it right once instead of relying on people on Hackage figuring it out themselves in multiple different packages

I don't quite get this contraposition of «we» and «people on Hackage». Could you explain?

@tibbe
Owner

@feuerbach I want @simonmar to write it. :)

@feuerbach

Would it be a good fit for async then? That'd be ideal, since async is already in the platform.

@tibbe
Owner

@feuerbach I don't think so, given the description of the package (i.e. managing asynchronous tasks). base, next to Mvar and other very similar constructs would be a good place.

@simonmar
Owner
@simonmar
Owner
@tibbe
Owner

If someone is willing to try the stm approach I'd be happy to review the code. Note that cabal-install/bootstrap.sh will need to be updated to pull in stm (and any dependencies).

@tibbe
Owner

@simonmar So are you suggesting we use your stm-based semaphore implementation you linked to in the gist above?

@bgamari bgamari JobControl: Use STM-based QSem and add stm dependency
This is in place of the deprecated implementation from
Control.Concurrent. New implementation due to Simon Marlow. Note that
this has only been tested against stm-2.4 despite the permissive version
bounds given in the cabal file and bootstrap script.
b67e3aa
@bgamari

I pushed a new patch incorporating @simonmar's semaphore implementation, as well wiring the stm dependency into the bootstrap script and cabal file. It builds and seems to work on my machine. That being said, I only tested against stm-2.4, despite leaving the version bounds substantially wider.

@bgamari

I just noticed that @23Skidoo's patch with the SafeSempahore implementation has already been merged. How should we move forward?

@tibbe
Owner

@bgamari I haven't had time to review this yet, but if we think it's the way forward we'll replace the SafeSemaphore code that was merged.

@tibbe
Owner

@bgamari I can't see your patch.

@tibbe tibbe reopened this
@bgamari

@tibbe, are you sure? It's b67e3aa

@tibbe
Owner

@simonmar I get this warning:

/Users/tibell/Downloads/Semaphore.hs:24:18:
    Warning: Defined but not used: `b1'

Is that intentional?

@tibbe tibbe merged commit b67e3aa into haskell:master
@simonmar
Owner
@23Skidoo
Collaborator

It turns out to be pretty hard to get right, if you want FIFO ordering for waking up blocked threads (is this important for your use case? If not we can use a very simple pure STM version).

No, it's not important. The worker threads are interchangeable.

It has poor performance when there are a lot of blocked threads (like 10k or more), due to a performance issue in the GC when there are many TVars, but I'm guessing this won't be an issue for you.

Yes, the number of threads is usually small (equal to the number of cores).

@simonmar
Owner
@23Skidoo
Collaborator

Incidentally, I'm interested in the use case: why do you need a semaphore

For controlling how many packages can be fetched and built simultaneously.

if you already limit the number of threads to the number of cores?

Sorry, I misled you - it worked that way in my original design. The current code starts a new thread for each package that is ready to be built, but builds at most N (usually equal to $numcores) packages simultaneously. The number of threads is still likely to be small (it depends on the degree of parallelism available in the graph), and non-FIFO ordering should still be acceptable (since we don't spawn threads for packages whose dependencies are not installed).

@tibbe
Owner

@simonmar I've updated the code in cabal-install/Distribution/Compat/Semaphore.hs to match your latest gist. If you find any more bugs, please make a pull request.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Nov 15, 2012
  1. @bgamari

    JobControl: Use STM-based QSem and add stm dependency

    bgamari authored
    This is in place of the deprecated implementation from
    Control.Concurrent. New implementation due to Simon Marlow. Note that
    this has only been tested against stm-2.4 despite the permissive version
    bounds given in the cabal file and bootstrap script.
This page is out of date. Refresh to see the latest.
View
3  cabal-install/Distribution/Client/JobControl.hs
@@ -28,8 +28,9 @@ module Distribution.Client.JobControl (
) where
import Control.Monad
-import Control.Concurrent
+import Control.Concurrent hiding (QSem, newQSem, waitQSem, signalQSem)
import Control.Exception
+import Distribution.Compat.Semaphore
data JobControl m a = JobControl {
spawnJob :: m a -> m (),
View
61 cabal-install/Distribution/Compat/Semaphore.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+module Distribution.Compat.Semaphore (
+ QSem, newQSem, waitQSem, signalQSem
+ ) where
+
+import Control.Concurrent hiding (QSem, newQSem, waitQSem, signalQSem)
+import Control.Concurrent.STM
+import Control.Monad
+import Data.Typeable
+import Control.Exception
+
+data QSem = QSem !(TVar Int) !(TVar [TVar Bool]) !(TVar [TVar Bool])
+ deriving (Eq, Typeable)
+
+newQSem :: Int -> IO QSem
+newQSem i = atomically $ do
+ q <- newTVar i
+ b1 <- newTVar []
+ b2 <- newTVar []
+ return (QSem q b1 b2)
+
+waitQSem :: QSem -> IO ()
+waitQSem (QSem q b1 b2) =
+ join $ atomically $ do
+ v <- readTVar q
+ if v == 0
+ then do b <- newTVar False
+ ys <- readTVar b2
+ writeTVar b2 (b:ys)
+ return (wait b)
+ else do writeTVar q $! v - 1
+ return (return ())
+
+wait t = atomically $ do
+ v <- readTVar t
+ when (not v) retry
+
+wake t = atomically $ writeTVar t True
+
+signalQSem :: QSem -> IO ()
+signalQSem (QSem q b1 b2) = mask_ $ join $ atomically $ do
+ -- join, so we don't force the reverse inside the txn
+ -- mask_ is needed so we don't lose a wakeup
+ v <- readTVar q
+ if v /= 0
+ then do writeTVar q $! v + 1
+ return (return ())
+ else do
+ xs <- readTVar b1
+ case xs of
+ [] -> do ys <- readTVar b2
+ case ys of
+ [] -> do writeTVar q 1
+ return (return ())
+ _ -> do let (z:zs) = reverse ys
+ writeTVar b1 zs
+ writeTVar b2 []
+ return (wake z)
+ (b:xs') -> do writeTVar b1 xs'
+ return (wake b)
View
3  cabal-install/bootstrap.sh
@@ -58,6 +58,7 @@ HTTP_VER="4000.2.4"; HTTP_VER_REGEXP="4000\.[012]\." # == 4000.0.* || 4000.1.*
ZLIB_VER="0.5.4.0"; ZLIB_VER_REGEXP="0\.[45]\." # == 0.4.* || == 0.5.*
TIME_VER="1.4.0.1" TIME_VER_REGEXP="1\.[1234]\.?" # >= 1.1 && < 1.5
RANDOM_VER="1.0.1.1" RANDOM_VER_REGEXP="1\.0\." # >= 1 && < 1.1
+STM_VER="2.4"; STM_VER_REGEXP="2\." # == 2.*
HACKAGE_URL="http://hackage.haskell.org/packages/archive"
@@ -198,6 +199,7 @@ info_pkg "time" ${TIME_VER} ${TIME_VER_REGEXP}
info_pkg "HTTP" ${HTTP_VER} ${HTTP_VER_REGEXP}
info_pkg "zlib" ${ZLIB_VER} ${ZLIB_VER_REGEXP}
info_pkg "random" ${RANDOM_VER} ${RANDOM_VER_REGEXP}
+info_pkg "stm" ${STM_VER} ${STM_VER_REGEXP}
do_pkg "Cabal" ${CABAL_VER} ${CABAL_VER_REGEXP}
do_pkg "transformers" ${TRANS_VER} ${TRANS_VER_REGEXP}
@@ -210,6 +212,7 @@ do_pkg "time" ${TIME_VER} ${TIME_VER_REGEXP}
do_pkg "HTTP" ${HTTP_VER} ${HTTP_VER_REGEXP}
do_pkg "zlib" ${ZLIB_VER} ${ZLIB_VER_REGEXP}
do_pkg "random" ${RANDOM_VER} ${RANDOM_VER_REGEXP}
+do_pkg "stm" ${STM_VER} ${STM_VER_REGEXP}
install_pkg "cabal-install"
View
3  cabal-install/cabal-install.cabal
@@ -119,7 +119,8 @@ Executable cabal
HTTP >= 4000.0.8 && < 4001,
zlib >= 0.4 && < 0.6,
time >= 1.1 && < 1.5,
- mtl >= 2.0 && < 3
+ mtl >= 2.0 && < 3,
+ stm >= 2.0 && < 3
if flag(old-base)
build-depends: base < 3
Something went wrong with that request. Please try again.