[commit: ghc] ghc-lwc2: FairShare scheduling can either be on concrete time or counts (e80c0c8)

[Sivaramakrishnan Krishnamoorthy Chandrasekaran]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : ghc-lwc2

https://github.com/ghc/ghc/commit/e80c0c817fcd8b4b3fcdc6462519683fb8fb1fc2

>---------------------------------------------------------------

commit e80c0c817fcd8b4b3fcdc6462519683fb8fb1fc2
Author: KC Sivaramakrishnan <chandras at cs.purdue.edu>
Date:   Mon May 13 16:25:04 2013 -0400

    FairShare scheduling can either be on concrete time or counts

>---------------------------------------------------------------

 rts/PrimOps.cmm                                        |  1 +
 rts/Schedule.c                                         |  6 ++++++
 tests/Benchmarks/ChameneosRedux/FairShare.hs           | 18 +++++++++++++++++-
 tests/Benchmarks/ChameneosRedux/Makefile               |  2 +-
 tests/Benchmarks/ChameneosRedux/chameneos-redux-lwc.hs |  4 ++--
 5 files changed, 27 insertions(+), 4 deletions(-)

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 4ebb79a..fbfa669 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -881,6 +881,7 @@ stg_newSContzh ( gcptr closure )
         RtsFlags_GcFlags_initialStkSize(RtsFlags),
         closure "ptr");
   StgTSO_why_blocked (threadid) = Yielded::I16;
+  Capability_context_switch(MyCapability()) = 1 :: CInt;
 
   return (threadid);
 }
diff --git a/rts/Schedule.c b/rts/Schedule.c
index eb57408..8bb1c7f 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -339,6 +339,12 @@ more_upcalls:
          */
         if (!emptyUpcallQueue(cap)) {
             t = prepareUpcallThread (cap, t);
+            //If there are other runnable threads, append the upcall thread to
+            //the scheduler.
+            if (!emptyRunQueue (cap)) {
+              appendToRunQueue (cap, t);
+              continue;
+            }
         }
         else {
             t = restoreCurrentThreadIfNecessary (cap, t);
diff --git a/tests/Benchmarks/ChameneosRedux/FairShare.hs b/tests/Benchmarks/ChameneosRedux/FairShare.hs
index bf47555..2863f6f 100644
--- a/tests/Benchmarks/ChameneosRedux/FairShare.hs
+++ b/tests/Benchmarks/ChameneosRedux/FairShare.hs
@@ -43,6 +43,7 @@ import qualified Data.PQueue.Min as PQ
 
 #include "profile.h"
 
+
 newtype State = State (PVar Int, PVar ClockTime, PVar Int)
                 deriving (Typeable)
 
@@ -50,6 +51,12 @@ newtype State = State (PVar Int, PVar ClockTime, PVar Int)
 -- SCont Accounting
 -------------------------------------------------------------------------------
 
+#define ACCOUNT_COUNT
+
+#ifdef ACCOUNT_COUNT
+#undef ACCOUNT_TIME
+#endif
+
 -- |Returns the time difference in microseconds (potentially returning maxBound
 -- <= the real difference)
 timeDiffToMicroSec :: TimeDiff -> Int
@@ -64,20 +71,29 @@ timeDiffToMicroSec (TimeDiff _ _ _ _ _ sec picosec) =
 _INL_(startClock)
 startClock :: SCont -> PTM ()
 startClock sc = do
+#ifdef ACCOUNT_TIME
   sls <- getSLS sc
   let State (_,st,_) = fromJust $ fromDynamic sls
   time <- unsafeIOToPTM $ getClockTime
   writePVar st $ time
+#else
+  return ()
+#endif
 
 _INL_(stopClock)
 stopClock :: SCont -> PTM ()
 stopClock sc = do
   sls <- getSLS sc
   let State (_,st,acc) = fromJust $ fromDynamic sls
+#ifdef ACCOUNT_TIME
   startTime <- readPVar st
   endTime <- unsafeIOToPTM $ getClockTime
+  let diff = timeDiffToMicroSec (diffClockTimes endTime startTime)
+#else
+  let diff = 1
+#endif
   sum <- readPVar acc
-  let newSum = sum + timeDiffToMicroSec (diffClockTimes endTime startTime)
+  let newSum = sum + diff
   writePVar acc newSum
   where
 
diff --git a/tests/Benchmarks/ChameneosRedux/Makefile b/tests/Benchmarks/ChameneosRedux/Makefile
index 29d8ca2..0fd7851 100644
--- a/tests/Benchmarks/ChameneosRedux/Makefile
+++ b/tests/Benchmarks/ChameneosRedux/Makefile
@@ -4,7 +4,7 @@ include ../../config.mk
 
 TOP := ../../../
 EXTRA_LIBS=/scratch/chandras/install
-GHC_OPTS_EXTRA=-threaded -XDeriveDataTypeable -XBangPatterns -XCPP -XGeneralizedNewtypeDeriving -funbox-strict-fields -ipqueue-1.2.1 -O2 -debug
+GHC_OPTS_EXTRA=-threaded -XDeriveDataTypeable -XBangPatterns -XCPP -XGeneralizedNewtypeDeriving -funbox-strict-fields -ipqueue-1.2.1 -O2
 
 PROFILE_FLAGS := -DPROFILE_ENABLED -prof -fprof-auto -auto -auto-all
 
diff --git a/tests/Benchmarks/ChameneosRedux/chameneos-redux-lwc.hs b/tests/Benchmarks/ChameneosRedux/chameneos-redux-lwc.hs
index 6c3792d..7bcf25d 100644
--- a/tests/Benchmarks/ChameneosRedux/chameneos-redux-lwc.hs
+++ b/tests/Benchmarks/ChameneosRedux/chameneos-redux-lwc.hs
@@ -15,9 +15,9 @@
    -}
 
 import LwConc.Substrate
--- import FairShare
+import FairShare
 -- import LwConc.RunQueue
-import ConcurrentList
+-- import ConcurrentList
 import MVarList
 import Control.Monad
 import Data.Char