[commit: ghc] ghc-lwc2: Extending the safe-foreign call fix (previous commit) to ThreadSwitch. During a thread switch, if the source thread had been marked to release the scheduler, this flag is inherited by the target thread (thread being switched to). scheduleHandleThreadSwitch takes care of releasing the scheduler. (2374b6f)
Sivaramakrishnan Krishnamoorthy Chandrasekaran
t-sichan at microsoft.com
Sat May 4 20:39:09 CEST 2013
Repository : http://darcs.haskell.org/ghc.git/
On branch : ghc-lwc2
https://github.com/ghc/ghc/commit/2374b6f2c3013eb6b5a8510e54f42aa815f90268
>---------------------------------------------------------------
commit 2374b6f2c3013eb6b5a8510e54f42aa815f90268
Author: KC Sivaramakrishnan <chandras at cs.purdue.edu>
Date: Sat May 4 14:36:31 2013 -0400
Extending the safe-foreign call fix (previous commit) to ThreadSwitch.
During a thread switch, if the source thread had been marked to release
the scheduler, this flag is inherited by the target thread (thread being
switched to). scheduleHandleThreadSwitch takes care of releasing the
scheduler.
>---------------------------------------------------------------
rts/PrimOps.cmm | 21 +++++++++++++++++++--
rts/Schedule.c | 19 +++++++++++++------
rts/Schedule.h | 4 ++++
rts/Upcalls.c | 6 ++----
utils/deriveConstants/DeriveConstants.hs | 1 +
5 files changed, 39 insertions(+), 12 deletions(-)
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index d5cc41c..32821cf 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -587,6 +587,7 @@ again: MAYBE_GC(again);
*/
W_ frame_type, frame, trec, outer, valid, limit, q, next_invariant;
W_ cap;
+ I32 tmpReleaseULS;
#if defined(DEBUG) || defined (TRACING)
@@ -678,9 +679,11 @@ again: MAYBE_GC(again);
if (valid != 0) {
/* Transaction was valid: commit succeeded */
- //XXX KC -- operating on CurrentTSO is unsafe since the transaction has
+ //KC -- operating on CurrentTSO is unsafe since the transaction has
//been committed and mucking with CurrentTSO info violates atomicity.
+ //XXX KC -- Start unsafe section
+
if (CurrentTSO != tso) {
ASSERT (StgTSO_why_blocked(tso) != NotBlocked::I16); //Thread is blocked
@@ -711,6 +714,19 @@ again: MAYBE_GC(again);
StgTSO_trec(CurrentTSO) = NO_TREC;
StgStack_sp(StgTSO_stackobj(CurrentTSO)) = Sp;
+ /* Swap release ULS flag: If the current thread needs to give up the
+ * scheduler, we make sure that the target thread (thread being switched
+ * to), inherits that flag. When we enter the RTS schedule loop at the
+ * end of this block, scheduleHandleThreadSwitch takes care of releasing
+ * the scheduler. Swapping the flag to ensure that the requests are not
+ * lost in case both threads need to lose thier schedulers (Unlikely?).
+ */
+ tmpReleaseULS = StgTSO_release_ULS(CurrentTSO);
+ StgTSO_release_ULS(CurrentTSO) = StgTSO_release_ULS(tso);
+ StgTSO_release_ULS(tso) = tmpReleaseULS;
+
+ //XXX KC -- End unsafe section
+
CurrentTSO = tso;
StgTSO_why_blocked(CurrentTSO) = NotBlocked::I16;
("ptr" limit) = ccall tso_SpLim (tso "ptr");
@@ -722,7 +738,8 @@ again: MAYBE_GC(again);
// need to pass capability to correct task
// - task might have returned from a safe foreign call
// - Pending upcalls
- // - and more..
+ // - Pending messages
+ // - and more?
jump stg_switch_noregs [];
} else {
/* Transaction was not valid: try again */
diff --git a/rts/Schedule.c b/rts/Schedule.c
index 47f0dc6..3344edc 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -151,7 +151,7 @@ static rtsBool scheduleHandleHeapOverflow( Capability *cap, StgTSO *t );
static rtsBool scheduleHandleYield( Capability *cap, StgTSO *t,
nat prev_what_next );
static void scheduleHandleThreadBlocked( Capability* cap, StgTSO *t );
-static void scheduleHandleThreadSwitch( Capability* cap, StgTSO *t );
+static rtsBool scheduleHandleThreadSwitch( Capability* cap, StgTSO *t );
static rtsBool scheduleHandleThreadFinished( Capability *cap, Task *task,
StgTSO *t );
static rtsBool scheduleNeedHeapProfile(rtsBool ready_to_gc);
@@ -603,8 +603,9 @@ run_thread:
break;
case ThreadSwitch:
- scheduleHandleThreadSwitch (cap, t);
- goto more_upcalls;
+ if (scheduleHandleThreadSwitch (cap, t)) {
+ goto more_upcalls;
+ }
break;
default:
@@ -1352,10 +1353,16 @@ scheduleHandleThreadBlocked(Capability *cap, StgTSO *t)
* Handle a thread that returned to the scheduler with ThreadSwitch
* -------------------------------------------------------------------------- */
-static void
-scheduleHandleThreadSwitch( Capability* cap STG_UNUSED,
- StgTSO *t STG_UNUSED)
+static rtsBool
+scheduleHandleThreadSwitch(Capability* cap, StgTSO *t)
{
+ if (t->release_ULS) {
+ pushUpcallReturning (cap, getResumeThreadUpcall (cap, t));
+ t->why_blocked = Yielded;
+ t->release_ULS = rtsFalse;
+ return rtsFalse;
+ }
+ return rtsTrue;
}
diff --git a/rts/Schedule.h b/rts/Schedule.h
index fe8b2b3..dbaadbf 100644
--- a/rts/Schedule.h
+++ b/rts/Schedule.h
@@ -33,7 +33,11 @@ void scheduleThread (Capability *cap, StgTSO *tso);
// the desired Capability).
void scheduleThreadOn(Capability *cap, StgWord cpu, StgTSO *tso);
+#if defined(THREADED_RTS)
void scheduleThreadOnFreeCap (Capability *cap, StgTSO *tso);
+#else
+void scheduleThreadOnFreeCap (Capability *cap, StgTSO *tso) __attribute__ ((noreturn));
+#endif
/* wakeUpRts()
*
diff --git a/rts/Upcalls.c b/rts/Upcalls.c
index ef01d4d..bcf4d13 100644
--- a/rts/Upcalls.c
+++ b/rts/Upcalls.c
@@ -71,8 +71,6 @@ getSwitchToNextThreadUpcall (Capability* cap, StgTSO* t)
ASSERT (t->yield_control_action != (StgClosure*)defaultUpcall_closure);
if (t->release_ULS) {
- debugTrace (DEBUG_sched, "cap %d: returning dummy switch to next thread upcall",
- cap->no);
p = (StgClosure*)defaultUpcall_closure;
t->release_ULS = rtsFalse;
}
@@ -81,8 +79,8 @@ getSwitchToNextThreadUpcall (Capability* cap, StgTSO* t)
rts_mkSCont (cap, t));
}
- debugTrace (DEBUG_sched, "cap %d: getSwitchToNextThreadupcall(%p) for thread %d",
- cap->no, (void*)p, t->id);
+ debugTrace (DEBUG_sched, "cap %d: getSwitchToNextThreadupcall(%p) for thread %d%s",
+ cap->no, (void*)p, t->id, (p == (Upcall)defaultUpcall_closure)?" (DUMMY)":"");
return p;
}
diff --git a/utils/deriveConstants/DeriveConstants.hs b/utils/deriveConstants/DeriveConstants.hs
index 50dac9a..7e01e99 100644
--- a/utils/deriveConstants/DeriveConstants.hs
+++ b/utils/deriveConstants/DeriveConstants.hs
@@ -404,6 +404,7 @@ wanteds = concat
,closureField C "StgTSO" "tls"
,closureField C "StgTSO" "is_sleeping"
,closureField C "StgTSO" "is_upcall_thread"
+ ,closureField C "StgTSO" "release_ULS"
,closureField Both "StgStack" "sp"
,closureFieldOffset Both "StgStack" "stack"
More information about the ghc-commits
mailing list