From 03b9341356c8d4eabfec5864957a4e49e7fcac67 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@fischer.debian.org>
Date: Tue, 19 Jun 2012 04:52:55 +0000
Subject: fix scheduling

Handle kevent interruptions in the haskell code, so it can yield to other threads
---
 Utility/Kqueue.hs   | 17 ++++++++++++-----
 Utility/libkqueue.c | 14 ++++----------
 2 files changed, 16 insertions(+), 15 deletions(-)

(limited to 'Utility')

diff --git a/Utility/Kqueue.hs b/Utility/Kqueue.hs
index da43a2d86..1f65b2dba 100644
--- a/Utility/Kqueue.hs
+++ b/Utility/Kqueue.hs
@@ -24,11 +24,13 @@ import Utility.Types.DirWatcher
 
 import System.Posix.Types
 import Foreign.C.Types
+import Foreign.C.Error
 import Foreign.Ptr
 import Foreign.Marshal
 import qualified Data.Map as M
 import qualified Data.Set as S
 import qualified System.Posix.Files as Files
+import Control.Concurrent
 
 data Change
 	= Deleted FilePath
@@ -146,9 +148,14 @@ stopKqueue (Kqueue h _ _) = closeFd h
 waitChange :: Kqueue -> IO (Kqueue, [Change])
 waitChange kq@(Kqueue h dirmap _) = do
 	changedfd <- c_waitchange_kqueue h
-	case M.lookup changedfd dirmap of
-		Nothing -> return (kq, [])
-		Just info -> handleChange kq changedfd info
+	if changedfd == -1
+		then ifM ((==) eINTR <$> getErrno)
+			(yield >> waitChange kq, nochange)
+		else case M.lookup changedfd dirmap of
+			Nothing -> nochange
+			Just info -> handleChange kq changedfd info
+	where
+		nochange = return (kq, [])
 
 {- The kqueue interface does not tell what type of change took place in
  - the directory; it could be an added file, a deleted file, a renamed
@@ -212,9 +219,9 @@ runHooks kq hooks = do
 			| Files.isSymbolicLink s = callhook addSymlinkHook (Just s) change
 			| Files.isDirectory s = print $ "TODO: recursive directory add: " ++ show change
 			| Files.isRegularFile s = callhook addHook (Just s) change
-			| otherwise = noop
+			| otherwise = print "not a file??"
 		callhook h s change = case h hooks of
-			Nothing -> noop
+			Nothing -> print "missing hook??"
 			Just a -> a (changedFile change) s
 		withstatus change a = maybe noop (a change) =<<
 			(catchMaybeIO (getSymbolicLinkStatus (changedFile change)))
diff --git a/Utility/libkqueue.c b/Utility/libkqueue.c
index b7f9595dc..643a63b97 100644
--- a/Utility/libkqueue.c
+++ b/Utility/libkqueue.c
@@ -17,6 +17,8 @@
 /* The specified fds are added to the set of fds being watched for changes.
  * Fds passed to prior calls still take effect, so it's most efficient to
  * not pass the same fds repeatedly.
+ *
+ * Returns the fd that changed, or -1 on error.
  */
 signed int helper(const int kq, const int fdcnt, const int *fdlist, int nodelay) {
 	int i, nev;
@@ -32,12 +34,7 @@ signed int helper(const int kq, const int fdcnt, const int *fdlist, int nodelay)
 			0, 0);
 	}
 
-	while ((nev = kevent(kq, chlist, fdcnt, evlist, 1, timeout))) {
-		if (!(nev == -1 && errno == EINTR)) {
-			break;
-		}
-	}
-
+	nev = kevent(kq, chlist, fdcnt, evlist, 1, timeout);
 	if (nev == 1)
 		return evlist[0].ident;
 	else
@@ -59,10 +56,7 @@ void addfds_kqueue(const int kq, const int fdcnt, const int *fdlist) {
 	helper(kq, fdcnt, fdlist, 1);
 }
 
-/* Waits for a change event on a kqueue.
- *
- * Returns the fd that changed, or -1 on error.
- */
+/* Waits for a change event on a kqueue. */
 signed int waitchange_kqueue(const int kq) {
 	return helper(kq, 0, NULL, 0);
 }
-- 
cgit v1.2.3