[project @ 2005-07-11 15:57:38 by simonmar]

Avoid calling threadPaused() on exit from STG land if we're just
switching to the interpreter, and conversely call threadPaused() in
the interpreter if we're returing to the scheduler for anything other
than switching to STG.

This will probably fix the recent slowdown in GHCi (ioref001 test, for
example).  It was broken when we moved the threadPaused() call into
STG from the scheduler, so it only affects the HEAD.

diff --git a/ghc/rts/HeapStackCheck.cmm b/ghc/rts/HeapStackCheck.cmm
index 27e8f44..55ef704 100644 (file)
--- a/ghc/rts/HeapStackCheck.cmm
+++ b/ghc/rts/HeapStackCheck.cmm
@@ -72,22 +72,30 @@
     StgTSO_what_next(CurrentTSO) = ThreadRunGHC::I16;          \
     jump stg_returnToSched;
 
-#define RETURN_TO_SCHED(why,what_next)                 \
+#define PRE_RETURN(why,what_next)                      \
   StgTSO_what_next(CurrentTSO) = what_next::I16;       \
-  R1 = why;                                            \
+  R1 = why;
+
+#define HP_GENERIC                             \
+   PRE_RETURN(HeapOverflow, ThreadRunGHC)      \
   jump stg_returnToSched;
 
-#define RETURN_TO_SCHED_BUT_FIRST(why,what_next,cont)  \
-  StgTSO_what_next(CurrentTSO) = what_next::I16;       \
-  R1 = why;                                            \
-  R2 = cont;                                           \
+#define BLOCK_GENERIC                          \
+   PRE_RETURN(ThreadBlocked,  ThreadRunGHC)    \
+  jump stg_returnToSched;
+
+#define YIELD_GENERIC                          \
+  PRE_RETURN(ThreadYielding, ThreadRunGHC)     \
+  jump stg_returnToSched;
+
+#define BLOCK_BUT_FIRST(c)                     \
+  PRE_RETURN(ThreadYielding, ThreadRunGHC)     \
+  R2 = c;                                      \
   jump stg_returnToSchedButFirst;
 
-#define HP_GENERIC           RETURN_TO_SCHED(HeapOverflow,   ThreadRunGHC)
-#define YIELD_GENERIC        RETURN_TO_SCHED(ThreadYielding, ThreadRunGHC)
-#define YIELD_TO_INTERPRETER RETURN_TO_SCHED(ThreadYielding, ThreadInterpret)
-#define BLOCK_GENERIC        RETURN_TO_SCHED(ThreadBlocked,  ThreadRunGHC)
-#define BLOCK_BUT_FIRST(c)   RETURN_TO_SCHED_BUT_FIRST(ThreadBlocked, ThreadRunGHC, c)
+#define YIELD_TO_INTERPRETER                   \
+  PRE_RETURN(ThreadYielding, ThreadInterpret)  \
+  jump stg_returnToSchedNotPaused;
 
 /* -----------------------------------------------------------------------------
    Heap checks in thunks/functions.

diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c
index 72e6506..95759d0 100644 (file)
--- a/ghc/rts/Interpreter.c
+++ b/ghc/rts/Interpreter.c
@@ -55,8 +55,14 @@
     cap->r.rCurrentTSO->sp = Sp
 
 #define RETURN_TO_SCHEDULER(todo,retcode)      \
-   SAVE_STACK_POINTERS;                        \
-   cap->r.rCurrentTSO->what_next = (todo);      \
+   SAVE_STACK_POINTERS;                                \
+   cap->r.rCurrentTSO->what_next = (todo);     \
+   threadPaused(cap->r.rCurrentTSO);           \
+   return (retcode);
+
+#define RETURN_TO_SCHEDULER_NO_PAUSE(todo,retcode)     \
+   SAVE_STACK_POINTERS;                                \
+   cap->r.rCurrentTSO->what_next = (todo);     \
    return (retcode);
 
 
@@ -334,7 +340,7 @@ eval_obj:
        Sp -= 2;
        Sp[1] = (W_)obj;
        Sp[0] = (W_)&stg_enter_info;
-       RETURN_TO_SCHEDULER(ThreadRunGHC, ThreadYielding);
+       RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
     }
     }
 
@@ -429,7 +435,7 @@ do_return:
        Sp -= 2;
        Sp[1] = (W_)obj;
        Sp[0] = (W_)&stg_enter_info;
-       RETURN_TO_SCHEDULER(ThreadRunGHC, ThreadYielding);
+       RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
     }
     }
 
@@ -489,7 +495,7 @@ do_return_unboxed:
                     debugBelch("returning to unknown frame -- yielding to sched\n"); 
                     printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
                );
-           RETURN_TO_SCHEDULER(ThreadRunGHC, ThreadYielding);
+           RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
        }
        }
     }
@@ -618,7 +624,7 @@ do_apply:
            Sp -= 2;
            Sp[1] = (W_)obj;
            Sp[0] = (W_)&stg_enter_info;
-           RETURN_TO_SCHEDULER(ThreadRunGHC, ThreadYielding);
+           RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
     }
 
     // ------------------------------------------------------------------------

diff --git a/ghc/rts/StgStartup.cmm b/ghc/rts/StgStartup.cmm
index d727cb5..ece080b 100644 (file)
--- a/ghc/rts/StgStartup.cmm
+++ b/ghc/rts/StgStartup.cmm
@@ -121,6 +121,16 @@ stg_returnToSched
   jump StgReturn;
 }
 
+// A variant of stg_returntToSched that doesn't call threadPaused() on the
+// current thread.  This is used for switching from compiled execution to the
+// interpreter, where calling threadPaused() on every switch would be too
+// expensive.
+stg_returnToSchedNotPaused
+{
+  SAVE_THREAD_STATE();
+  jump StgReturn;
+}
+
 // A variant of stg_returnToSched, but instead of returning directly to the
 // scheduler, we jump to the code fragment pointed to by R2.  This lets us
 // perform some final actions after making the thread safe, such as unlocking