Add api to pause single threaded RTSwip/ghc-debug-sched

Improve Implementation of pausing the single threaded RTS

Stop abusing mutexes

3 files changed, 74 insertions, 17 deletions

diff --git a/includes/RtsAPI.h b/includes/RtsAPI.h
index 6ab7116a7c..1812e53551 100644
--- a/includes/RtsAPI.h
+++ b/includes/RtsAPI.h
@@ -20,6 +20,7 @@ extern "C" {
 #include "rts/Time.h"
 #include "rts/Task.h"
 #include "rts/EventLogWriter.h"
+#include "rts/OSThreads.h"
 
 /*
  * Running the scheduler
@@ -453,8 +454,19 @@ typedef struct RtsPaused_ {
     Capability *capabilities;
 } RtsPaused;
 
-RtsPaused rts_pause (void);
-void rts_unpause (RtsPaused paused);
+
+#if !defined(THREADED_RTS)
+struct{
+    // Number of debuggers that want rts to pause
+    size_t pauseRequests;
+    enum {RUNNING, PAUSING, PAUSED, STARTING} state;
+    Mutex pauseLock;
+    Condition stateChange;
+} nonThreadedPause;
+#endif
+
+void rts_pause (/* out */ RtsPaused *paused);
+void rts_unpause (/* in */ RtsPaused *paused);
 
 // List all live threads. Must be done while RTS is paused.
 typedef void (*ListThreadsCb)(void *user, StgTSO *);
diff --git a/rts/RtsAPI.c b/rts/RtsAPI.c
index 5cb7d29f27..7fd1ddadeb 100644
--- a/rts/RtsAPI.c
+++ b/rts/RtsAPI.c
@@ -19,6 +19,7 @@
 #include "Threads.h"
 #include "Weak.h"
 #include "StableName.h"
+#include "assert.h"
 
 /* ----------------------------------------------------------------------------
    Building Haskell objects from C datatypes.
@@ -651,20 +652,18 @@ static bool rts_paused = false;
 // Halt execution of all Haskell threads.
 // It is different to rts_lock because it pauses all capabilities. rts_lock
 // only pauses a single capability.
-RtsPaused rts_pause (void)
+void rts_pause (RtsPaused * paused)
 {
-    struct RtsPaused_ paused;
-    paused.pausing_task = newBoundTask();
-    stopAllCapabilities(&paused.capabilities, paused.pausing_task);
+    paused->pausing_task = newBoundTask();
+    stopAllCapabilities(&paused->capabilities, paused->pausing_task);
     rts_paused = true;
-    return paused;
 }
 
-void rts_unpause (RtsPaused  paused)
+void rts_unpause (RtsPaused * paused)
 {
     rts_paused = false;
-    releaseAllCapabilities(n_capabilities, paused.capabilities, paused.pausing_task);
-    freeTask(paused.pausing_task);
+    releaseAllCapabilities(n_capabilities, paused->capabilities, paused->pausing_task);
+    freeTask(paused->pausing_task);
 }
 
 
@@ -702,17 +701,36 @@ void rts_listMiscRoots (ListRootsCb cb, void *user)
     threadStablePtrTable(&list_roots_helper, (void *)&ctx);
 }
 
-#else
-RtsPaused rts_pause (void)
+#else  // !DEFINED(THREADED_RTS)
+void rts_pause (RtsPaused * paused STG_UNUSED)
 {
-    struct RtsPaused_ paused;
-    paused.pausing_task = NULL;
-    paused.capabilities = NULL;
-    return paused;
+    ACQUIRE_LOCK(&nonThreadedPause.pauseLock);
+
+    // Wait until all previous pausers have unpaused the rts
+    while(nonThreadedPause.state != RUNNING){
+        waitCondition(&nonThreadedPause.stateChange, &nonThreadedPause.pauseLock);
+    }
+
+    ++nonThreadedPause.pauseRequests;
+    nonThreadedPause.state = PAUSING;
+
+    // Wait for rts to actually pause
+    while(nonThreadedPause.state != PAUSED){
+        waitCondition(&nonThreadedPause.stateChange, &nonThreadedPause.pauseLock);
+    }
+
+    RELEASE_LOCK(&nonThreadedPause.pauseLock);
 }
 
-void rts_unpause (RtsPaused  paused STG_UNUSED)
+void rts_unpause (RtsPaused * paused STG_UNUSED)
 {
+    ACQUIRE_LOCK(&NonTreadedPause.pauseLock);
+    assert(nonThreadedPause.state == PAUSED);
+    --nonThreadedPause.pauseRequests;
+    if (!nonThreadedPause.pauseRequests){
+        nonThreadedPause.state = STARTING;
+    }
+    RELEASE_LOCK(&nonThreadedPause.pauseRequestMutex);
 }
 
 
diff --git a/rts/Schedule.c b/rts/Schedule.c
index e1e4a1ec92..206c981099 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -17,6 +17,7 @@
 #include "Interpreter.h"
 #include "Printer.h"
 #include "RtsSignals.h"
+#include "RtsAPI.h"
 #include "sm/Sanity.h"
 #include "Stats.h"
 #include "STM.h"
@@ -256,6 +257,27 @@ schedule (Capability *initialCapability, Task *task)
     //   * We might be left with threads blocked in foreign calls,
     //     we should really attempt to kill these somehow (TODO).
 
+    #if !defined(THREADED_RTS)
+    if(nonThreadedPause.state == PAUSING){
+        ACQUIRE_LOCK(&nonThreadedPause.pauseLock);
+        if(nonThreadedPause.state == PAUSING){
+
+            nonThreadedPause.state = PAUSED;
+            broadcastCondition(&nonThreadedPause.stateChange);
+
+            while(nonThreadedPause.state != STARTING){
+                waitCondition(&nonThreadedPause.stateChange,
+                        &nonThreadedPause.pauseLock);
+            }
+
+            nonThreadedPause.state = RUNNING;
+            broadcastCondition(&nonThreadedPause.stateChange);
+        }
+
+        RELEASE_LOCK(&nonThreadedPause.pauseLock);
+    }
+    #endif
+
     switch (sched_state) {
     case SCHED_RUNNING:
         break;
@@ -2662,6 +2684,11 @@ initScheduler(void)
   blocked_queue_hd  = END_TSO_QUEUE;
   blocked_queue_tl  = END_TSO_QUEUE;
   sleeping_queue    = END_TSO_QUEUE;
+
+  initMutex(&nonThreadedPause.pauseLock);
+  initCondition(&nonThreadedPause.stateChange);
+  nonThreadedPause.pauseRequests = 0;
+  nonThreadedPause.state         = RUNNING;
 #endif
 
   sched_state    = SCHED_RUNNING;