check-ignore resource pool

Much like check-attr before.

diff --git a/Annex.hs b/Annex.hs
index ea4338fd779547eb0fc2bc4cf907cd7c7e3484e5..14890c58c0fb8567fa2657d72f9fe25ff71b7cda 100644 (file)
--- a/Annex.hs
+++ b/Annex.hs
@@ -120,7 +120,7 @@ data AnnexState = AnnexState
        , catfilehandles :: CatFileHandles
        , hashobjecthandle :: Maybe HashObjectHandle
        , checkattrhandle :: Maybe (ResourcePool CheckAttrHandle)
-       , checkignorehandle :: Maybe CheckIgnoreHandle
+       , checkignorehandle :: Maybe (ResourcePool CheckIgnoreHandle)
        , forcebackend :: Maybe String
        , globalnumcopies :: Maybe NumCopies
        , forcenumcopies :: Maybe NumCopies

diff --git a/Annex/CheckAttr.hs b/Annex/CheckAttr.hs
index c459a35d368847d64990d9c341e160c6e6b937da..f88f9d9a8ee16a0933402dcb93c58e2a3b202bd1 100644 (file)
--- a/Annex/CheckAttr.hs
+++ b/Annex/CheckAttr.hs
@@ -16,7 +16,7 @@ import qualified Git.CheckAttr as Git
 import qualified Annex
 import Utility.ResourcePool
 import Types.Concurrency
-import GHC.Conc
+import Annex.Concurrent.Utility
 
 {- All gitattributes used by git-annex. -}
 annexAttrs :: [Git.Attr]
@@ -54,13 +54,7 @@ mkConcurrentCheckAttrHandle c =
  - while respecting the -Jn value.
  -}
 maxCheckAttrs :: Concurrency -> IO Int
-maxCheckAttrs c = do
-       let cn = case c of
-               Concurrent n -> n
-               NonConcurrent -> 1
-               ConcurrentPerCpu -> 1
-       pn <- liftIO getNumProcessors
-       return (min cn pn)
+maxCheckAttrs = concurrencyUpToCpus
 
 checkAttrStop :: Annex ()
 checkAttrStop = maybe noop stop =<< Annex.getState Annex.checkattrhandle

diff --git a/Annex/CheckIgnore.hs b/Annex/CheckIgnore.hs
index 474547068727931802d3214428dc68514e27bf07..916b8b0d9c78f0c834d45081b93f03b6ce3ae257 100644 (file)
--- a/Annex/CheckIgnore.hs
+++ b/Annex/CheckIgnore.hs
@@ -1,37 +1,57 @@
 {- git check-ignore interface, with handle automatically stored in
  - the Annex monad
  -
- - Copyright 2013 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
 module Annex.CheckIgnore (
        checkIgnored,
-       checkIgnoreHandle,
-       checkIgnoreStop
+       checkIgnoreStop,
+       mkConcurrentCheckIgnoreHandle,
 ) where
 
 import Annex.Common
 import qualified Git.CheckIgnore as Git
 import qualified Annex
+import Utility.ResourcePool
+import Types.Concurrency
+import Annex.Concurrent.Utility
 
 checkIgnored :: FilePath -> Annex Bool
-checkIgnored file = go =<< checkIgnoreHandle
-  where
-       go h = liftIO $ Git.checkIgnored h file
+checkIgnored file = withCheckIgnoreHandle $ \h ->
+       liftIO $ Git.checkIgnored h file
 
-checkIgnoreHandle :: Annex Git.CheckIgnoreHandle
-checkIgnoreHandle = maybe startup return =<< Annex.getState Annex.checkignorehandle
+withCheckIgnoreHandle :: (Git.CheckIgnoreHandle -> Annex a) -> Annex a
+withCheckIgnoreHandle a =
+       maybe mkpool go =<< Annex.getState Annex.checkignorehandle
   where
-       startup = do
-               h <- inRepo Git.checkIgnoreStart
-               Annex.changeState $ \s -> s { Annex.checkignorehandle = Just h }
-               return h
+       go p = withResourcePool p start a
+       start = inRepo Git.checkIgnoreStart
+       mkpool = do
+               -- This only runs in non-concurrent code paths;
+               -- a concurrent pool is set up earlier when needed.
+               p <- mkResourcePoolNonConcurrent start
+               Annex.changeState $ \s -> s { Annex.checkignorehandle = Just p }
+               go p
+
+mkConcurrentCheckIgnoreHandle :: Concurrency -> Annex (ResourcePool Git.CheckIgnoreHandle)
+mkConcurrentCheckIgnoreHandle c =
+       Annex.getState Annex.checkignorehandle >>= \case
+               Just p@(ResourcePool {}) -> return p
+               _ -> mkResourcePool =<< liftIO (maxCheckIgnores c)
+
+{- git check-ignore is typically CPU bound, and is not likely to be the main
+ - bottleneck for any command. So limit to the number of CPU cores, maximum,
+ - while respecting the -Jn value.
+ -}
+maxCheckIgnores :: Concurrency -> IO Int
+maxCheckIgnores = concurrencyUpToCpus
 
 checkIgnoreStop :: Annex ()
 checkIgnoreStop = maybe noop stop =<< Annex.getState Annex.checkignorehandle
   where
-       stop h = do
-               liftIO $ Git.checkIgnoreStop h
+       stop p = do
+               liftIO $ freeResourcePool p Git.checkIgnoreStop
                Annex.changeState $ \s -> s { Annex.checkignorehandle = Nothing }

diff --git a/Annex/Concurrent.hs b/Annex/Concurrent.hs
index 7379dcb3e4d69f818e54cd6a11410f3d71d410b7..bbd925aaa320e4961a8ebcdcf01f1618c32b641f 100644 (file)
--- a/Annex/Concurrent.hs
+++ b/Annex/Concurrent.hs
@@ -15,6 +15,7 @@ import Types.Concurrency
 import Types.WorkerPool
 import Types.CatFileHandles
 import Annex.CheckAttr
+import Annex.CheckIgnore
 import Remote.List
 
 import Control.Concurrent
@@ -31,10 +32,12 @@ setConcurrency c = do
                CatFileHandlesNonConcurrent _ -> liftIO catFileHandlesPool
                CatFileHandlesPool _ -> pure cfh
        cah <- mkConcurrentCheckAttrHandle c
+       cih <- mkConcurrentCheckIgnoreHandle c
        Annex.changeState $ \s -> s
                { Annex.concurrency = c
                , Annex.catfilehandles = cfh'
                , Annex.checkattrhandle = Just cah
+               , Annex.checkignorehandle = Just cih
                }
 
 {- Allows forking off a thread that uses a copy of the current AnnexState
@@ -79,8 +82,6 @@ dupState = do
        return $ st'
                -- each thread has its own repoqueue
                { Annex.repoqueue = Nothing
-               -- avoid sharing open file handles
-               , Annex.checkignorehandle = Nothing
                }
 
 {- Merges the passed AnnexState into the current Annex state.

diff --git a/Annex/Concurrent/Utility.hs b/Annex/Concurrent/Utility.hs
new file mode 100644 (file)
index 0000000..0521f6b
--- /dev/null
+++ b/Annex/Concurrent/Utility.hs
@@ -0,0 +1,23 @@
+{- git-annex concurrency utilities
+ -
+ - Copyright 2020 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module Annex.Concurrent.Utility where
+
+import Types.Concurrency
+
+import GHC.Conc
+
+{- Honor the requested level of concurrency, but only up to the number of
+ - CPU cores. Useful for things that are known to be CPU bound. -}
+concurrencyUpToCpus :: Concurrency -> IO Int
+concurrencyUpToCpus c = do
+       let cn = case c of
+               Concurrent n -> n
+               NonConcurrent -> 1
+               ConcurrentPerCpu -> 1
+       pn <- getNumProcessors
+       return (min cn pn)

diff --git a/CHANGELOG b/CHANGELOG
index 69da4eea11b8ba5b3f0a4db3964ad27f76bb3f11..8ee3e6d2fd0a4566a4ea0baee485b39cec89d066 100644 (file)
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -17,8 +17,8 @@ git-annex (8.20200331) UNRELEASED; urgency=medium
     and -J is used.
   * Avoid running a large number of git cat-file child processes when run
     with a large -J value.
-  * Avoid running with more git check-attr processes than there are CPUs
-    cores when run with a large -J value.
+  * Avoid running with more git check-attr and check-ignore processes than
+    there are CPU cores when run with a large -J value.
 
  -- Joey Hess <id@joeyh.name>  Mon, 30 Mar 2020 15:58:34 -0400
 

diff --git a/git-annex.cabal b/git-annex.cabal
index 5ff0b9e727ba8c22c6d6d104f7e79e4fc04de537..3930b8926b51f453da8a073375da457a029e171c 100644 (file)
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -619,6 +619,7 @@ Executable git-annex
     Annex.CheckIgnore
     Annex.Common
     Annex.Concurrent
+    Annex.Concurrent.Utility
     Annex.Content
     Annex.Content.LowLevel
     Annex.Content.PointerFile