[project @ 2005-10-26 10:42:54 by simonmar]

- change the type of StgRun(): now we return the Capability that the
  thread currently holds.  The return status of the thread is now
  stored in cap->r.rRet (a new slot in the reg table).

  This was necessary because on return from StgRun(), the current
  TSO may be blocked, so it no longer belongs to us.  If it is a bound
  thread, then the Task may have been already woken up on another
  Capability, so the scheduler can't use task->cap to find the
  capability it currently owns.

- when shutting down, allow a bound thread to remove its TSO from
  the run queue when exiting (eliminates an error condition in
  releaseCapability()).

diff --git a/ghc/includes/Regs.h b/ghc/includes/Regs.h
index b65d242..f1b8597 100644 (file)
--- a/ghc/includes/Regs.h
+++ b/ghc/includes/Regs.h
@@ -98,11 +98,10 @@ typedef struct StgRegTable_ {
   MP_INT          rmp_tmp2;      
   MP_INT          rmp_result1;
   MP_INT          rmp_result2;
+  StgWord         rRet;  // holds the return code of the thread
 #if defined(SMP) || defined(PAR)
   StgSparkPool    rSparks;     /* per-task spark pool */
 #endif
-    // If this flag is set, we are running Haskell code.  Used to detect
-    // uses of 'foreign import unsafe' that should be 'safe'.
 } StgRegTable;
 
 #if IN_STG_CODE

diff --git a/ghc/includes/mkDerivedConstants.c b/ghc/includes/mkDerivedConstants.c
index d782d04..e94cbbf 100644 (file)
--- a/ghc/includes/mkDerivedConstants.c
+++ b/ghc/includes/mkDerivedConstants.c
@@ -242,6 +242,7 @@ main(int argc, char *argv[])
     field_offset(StgRegTable, rCurrentTSO);
     field_offset(StgRegTable, rCurrentNursery);
     field_offset(StgRegTable, rHpAlloc);
+    struct_field(StgRegTable, rRet);
 
     // Needed for SMP builds
     field_offset(StgRegTable, rmp_tmp_w);

diff --git a/ghc/rts/HeapStackCheck.cmm b/ghc/rts/HeapStackCheck.cmm
index ea2d64f..cf70e34 100644 (file)
--- a/ghc/rts/HeapStackCheck.cmm
+++ b/ghc/rts/HeapStackCheck.cmm
@@ -42,6 +42,11 @@
  * at all, it won't yield.  Hopefully this won't be a problem in practice.
  */
  
+#define PRE_RETURN(why,what_next)                      \
+  StgTSO_what_next(CurrentTSO) = what_next::I16;       \
+  StgRegTable_rRet(BaseReg) = why;                     \
+  R1 = BaseReg;
+
 /* Remember that the return address is *removed* when returning to a
  * ThreadRunGHC thread.
  */
@@ -69,13 +74,9 @@
         R1 = StackOverflow;                                    \
     }                                                          \
   sched:                                                       \
-    StgTSO_what_next(CurrentTSO) = ThreadRunGHC::I16;          \
+    PRE_RETURN(R1,ThreadRunGHC);                               \
     jump stg_returnToSched;
 
-#define PRE_RETURN(why,what_next)                      \
-  StgTSO_what_next(CurrentTSO) = what_next::I16;       \
-  R1 = why;
-
 #define HP_GENERIC                             \
    PRE_RETURN(HeapOverflow, ThreadRunGHC)      \
   jump stg_returnToSched;

diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c
index 0ad2b6e..f007c4a 100644 (file)
--- a/ghc/rts/Interpreter.c
+++ b/ghc/rts/Interpreter.c
@@ -58,12 +58,14 @@
    SAVE_STACK_POINTERS;                                \
    cap->r.rCurrentTSO->what_next = (todo);     \
    threadPaused(cap->r.rCurrentTSO);           \
-   return (retcode);
+   cap->r.rRet = (retcode);                    \
+   return cap;
 
 #define RETURN_TO_SCHEDULER_NO_PAUSE(todo,retcode)     \
-   SAVE_STACK_POINTERS;                                \
-   cap->r.rCurrentTSO->what_next = (todo);     \
-   return (retcode);
+   SAVE_STACK_POINTERS;                                        \
+   cap->r.rCurrentTSO->what_next = (todo);             \
+   cap->r.rRet = (retcode);                            \
+   return cap;
 
 
 STATIC_INLINE StgPtr
@@ -170,7 +172,7 @@ static StgWord app_ptrs_itbl[] = {
     (W_)&stg_ap_pppppp_info,
 };
 
-StgThreadReturnCode
+Capability *
 interpretBCO (Capability* cap)
 {
     // Use of register here is primarily to make it clear to compilers

diff --git a/ghc/rts/Interpreter.h b/ghc/rts/Interpreter.h
index 063c9f5..d66e636 100644 (file)
--- a/ghc/rts/Interpreter.h
+++ b/ghc/rts/Interpreter.h
@@ -9,6 +9,6 @@
 #ifndef INTERPRETER_H
 #define INTERPRETER_H
 
-extern StgThreadReturnCode interpretBCO (Capability* cap);
+extern Capability *interpretBCO (Capability* cap);
 
 #endif /* INTERPRETER_H */

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 5cad5b2..fe50cd4 100644 (file)
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -367,10 +367,6 @@ schedule (Capability *initialCapability, Task *task)
 
   while (TERMINATION_CONDITION) {
 
-      ASSERT(cap->running_task == task);
-      ASSERT(task->cap == cap);
-      ASSERT(myTask() == task);
-
 #if defined(GRAN)
       /* Choose the processor with the next event */
       CurrentProc = event->proc;
@@ -388,6 +384,10 @@ schedule (Capability *initialCapability, Task *task)
          yieldCapability(&cap, task);
       }
 #endif
+      
+      ASSERT(cap->running_task == task);
+      ASSERT(task->cap == cap);
+      ASSERT(myTask() == task);
 
     // Check whether we have re-entered the RTS from Haskell without
     // going via suspendThread()/resumeThread (i.e. a 'safe' foreign
@@ -408,11 +408,6 @@ schedule (Capability *initialCapability, Task *task)
        deleteRunQueue(cap);
        if (shutting_down_scheduler) {
            IF_DEBUG(scheduler, sched_belch("shutting down"));
-           if (task->tso) { // we are bound
-               task->stat = Interrupted;
-               task->ret  = NULL;
-           }
-           return cap;
        } else {
            IF_DEBUG(scheduler, sched_belch("interrupted"));
        }
@@ -574,32 +569,47 @@ run_thread:
     recent_activity = ACTIVITY_YES;
 
     switch (prev_what_next) {
-
+       
     case ThreadKilled:
     case ThreadComplete:
        /* Thread already finished, return to scheduler. */
        ret = ThreadFinished;
        break;
-
+       
     case ThreadRunGHC:
-       ret = StgRun((StgFunPtr) stg_returnToStackTop, &cap->r);
+    {
+       StgRegTable *r;
+       r = StgRun((StgFunPtr) stg_returnToStackTop, &cap->r);
+       cap = regTableToCapability(r);
+       ret = r->rRet;
        break;
-
+    }
+    
     case ThreadInterpret:
-       ret = interpretBCO(cap);
+       cap = interpretBCO(cap);
+       ret = cap->r.rRet;
        break;
-
+       
     default:
-      barf("schedule: invalid what_next field");
+       barf("schedule: invalid what_next field");
     }
 
-    // in SMP mode, we might return with a different capability than
-    // we started with, if the Haskell thread made a foreign call.  So
-    // let's find out what our current Capability is:
-    cap = task->cap;
-
     cap->in_haskell = rtsFalse;
 
+#ifdef SMP
+    // If ret is ThreadBlocked, and this Task is bound to the TSO that
+    // blocked, we are in limbo - the TSO is now owned by whatever it
+    // is blocked on, and may in fact already have been woken up,
+    // perhaps even on a different Capability.  It may be the case
+    // that task->cap != cap.  We better yield this Capability
+    // immediately and return to normaility.
+    if (ret == ThreadBlocked) continue;
+#endif
+
+    ASSERT(cap->running_task == task);
+    ASSERT(task->cap == cap);
+    ASSERT(myTask() == task);
+
     // The TSO might have moved, eg. if it re-entered the RTS and a GC
     // happened.  So find the new location:
     t = cap->r.rCurrentTSO;

diff --git a/ghc/rts/StgCRun.c b/ghc/rts/StgCRun.c
index 89fde5c..fc08b50 100644 (file)
--- a/ghc/rts/StgCRun.c
+++ b/ghc/rts/StgCRun.c
@@ -82,7 +82,7 @@ register double fake_f9 __asm__("$f9");
    any architecture (using miniinterpreter)
    -------------------------------------------------------------------------- */
 
-StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg STG_UNUSED)
+StgRegTable * StgRun(StgFunPtr f, StgRegTable *basereg STG_UNUSED)
 {
     while (f) {
        IF_DEBUG(interpreter,
@@ -92,7 +92,7 @@ StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg STG_UNUSED)
            );
        f = (StgFunPtr) (f)();
     }
-    return (StgThreadReturnCode)R1.i;
+    return (StgRegTable *)R1.p;
 }
 
 StgFunPtr StgReturn(void)
@@ -120,11 +120,11 @@ StgFunPtr StgReturn(void)
 #define STG_GLOBAL ".global "
 #endif
 
-StgThreadReturnCode
+StgRegTable *
 StgRun(StgFunPtr f, StgRegTable *basereg) {
 
     unsigned char space[ RESERVED_C_STACK_BYTES + 4*sizeof(void *) ];
-    StgThreadReturnCode r;
+    StgRegTable * r;
 
     __asm__ volatile (
        /*
@@ -201,7 +201,7 @@ StgRun(StgFunPtr f, StgRegTable *basereg) {
 
 #ifdef x86_64_HOST_ARCH
 
-extern StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg);
+extern StgRegTable * StgRun(StgFunPtr f, StgRegTable *basereg);
 
 static void StgRunIsImplementedInAssembler(void)
 {
@@ -321,7 +321,7 @@ static void StgRunIsImplementedInAssembler(void)
 
 #ifdef sparc_HOST_ARCH
 
-StgThreadReturnCode
+StgRegTable *
 StgRun(StgFunPtr f, StgRegTable *basereg) {
 
     unsigned char space[RESERVED_C_STACK_BYTES];
@@ -354,7 +354,7 @@ StgRun(StgFunPtr f, StgRegTable *basereg) {
     __asm__ volatile ("ld %1,%0"
                      : "=r" (i7) : "m" (((void **)(space))[100]));
 #endif
-    return (StgThreadReturnCode)R1.i;
+    return (StgRegTable *)R1.i;
 }
 
 #endif
@@ -389,7 +389,7 @@ StgRun(StgFunPtr f, StgRegTable *basereg) {
 
 #ifdef alpha_HOST_ARCH
 
-StgThreadReturnCode
+StgRegTable *
 StgRun(StgFunPtr f, StgRegTable *basereg)
 {
     register long   real_ra __asm__("$26"); volatile long   save_ra;
@@ -418,7 +418,7 @@ StgRun(StgFunPtr f, StgRegTable *basereg)
 
     register StgFunPtr real_pv __asm__("$27");
 
-    StgThreadReturnCode ret;
+    StgRegTable * ret;
 
     save_ra = real_ra;
     save_gp = real_gp;
@@ -491,11 +491,11 @@ StgRun(StgFunPtr f, StgRegTable *basereg)
 
 #ifdef hppa1_1_HOST_ARCH
 
-StgThreadReturnCode
+StgRegTable *
 StgRun(StgFunPtr f, StgRegTable *basereg)
 {
     StgChar space[RESERVED_C_STACK_BYTES+16*sizeof(long)+10*sizeof(double)];
-    StgThreadReturnCode ret;
+    StgRegTable * ret;
 
     __asm__ volatile ("ldo %0(%%r30),%%r19\n"
                      "\tstw %%r3, 0(0,%%r19)\n"
@@ -587,7 +587,7 @@ StgRun(StgFunPtr f, StgRegTable *basereg)
 
 #ifdef powerpc_HOST_ARCH
 
-extern StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg);
+extern StgRegTable * StgRun(StgFunPtr f, StgRegTable *basereg);
 
 #ifdef darwin_HOST_OS
 static void StgRunIsImplementedInAssembler(void)
@@ -705,7 +705,7 @@ static void StgRunIsImplementedInAssembler(void)
 #ifdef powerpc64_HOST_ARCH
 
 #ifdef linux_HOST_OS
-extern StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg);
+extern StgRegTable * StgRun(StgFunPtr f, StgRegTable *basereg);
 
 static void StgRunIsImplementedInAssembler(void)
 {

diff --git a/ghc/rts/StgRun.h b/ghc/rts/StgRun.h
index 2ea64cd..da376b4 100644 (file)
--- a/ghc/rts/StgRun.h
+++ b/ghc/rts/StgRun.h
@@ -9,7 +9,7 @@
 #ifndef STGRUN_H
 #define STGRUN_H
 
-extern StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg);
+extern StgRegTable * StgRun(StgFunPtr f, StgRegTable *basereg);
 
 RTS_FUN(StgReturn);
 

diff --git a/ghc/rts/StgStartup.cmm b/ghc/rts/StgStartup.cmm
index ece080b..eff3761 100644 (file)
--- a/ghc/rts/StgStartup.cmm
+++ b/ghc/rts/StgStartup.cmm
@@ -92,8 +92,9 @@ INFO_TABLE_RET( stg_stop_thread, STOP_THREAD_WORDS, STOP_THREAD_BITMAP,
 
     SAVE_THREAD_STATE();
 
-    /* R1 contains the return value of the thread */
-    R1 = ThreadFinished;
+    /* The return code goes in BaseReg->rRet, and BaseReg is returned in R1 */
+    StgRegTable_rRet(BaseReg) = ThreadFinished;
+    R1 = BaseReg;
 
     jump StgReturn;
 }