mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

avoid spawning new transfer thread until a slot becomes available

Browse source
This commit is contained in:
Joey Hess 2012-07-25 12:07:30 -04:00
parent 522f568450
commit 6107328a6b
2 changed files with 4 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Assistant/Threads/TransferScanner.hs
View file

@ -19,7 +19,7 @@ thisThread :: ThreadName
thisThread = "TransferScanner" thisThread = "TransferScanner"
{- This thread scans remotes, to find transfers that need to be made to {- This thread scans remotes, to find transfers that need to be made to
- keep their data in sync. The transfers are queued with lot priority. -} - keep their data in sync. The transfers are queued with low priority. -}
transferScannerThread :: ThreadState -> ScanRemoteMap -> TransferQueue -> IO () transferScannerThread :: ThreadState -> ScanRemoteMap -> TransferQueue -> IO ()
transferScannerThread st scanremotes transferqueue = do transferScannerThread st scanremotes transferqueue = do
runEvery (Seconds 2) $ do runEvery (Seconds 2) $ do

5
Assistant/TransferSlots.hs
View file

@ -29,9 +29,10 @@ newTransferSlots = newQSemN numSlots
{- Waits until a transfer slot becomes available, and runs a transfer {- Waits until a transfer slot becomes available, and runs a transfer
- action in the slot, in its own thread. -} - action in the slot, in its own thread. -}
inTransferSlot :: TransferSlots -> ThreadState -> Annex a -> IO ThreadId inTransferSlot :: TransferSlots -> ThreadState -> Annex a -> IO ThreadId
inTransferSlot s st a = forkIO $ bracket_ start done run inTransferSlot s st a = do
waitQSemN s 1
forkIO $ bracket_ noop done run
where where
start = waitQSemN s 1
done = transferComplete s done = transferComplete s
run = unsafeRunThreadState st a run = unsafeRunThreadState st a