From c77201452748a299caa3c0254bd7a76ba0c64bee Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Mon, 11 Jul 2005 15:57:39 +0000
Subject: [PATCH] [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.
---
 ghc/rts/HeapStackCheck.cmm |   30 +++++++++++++++++++-----------
 ghc/rts/Interpreter.c      |   18 ++++++++++++------
 ghc/rts/StgStartup.cmm     |   10 ++++++++++
 3 files changed, 41 insertions(+), 17 deletions(-)

diff --git a/ghc/rts/HeapStackCheck.cmm b/ghc/rts/HeapStackCheck.cmm
index 27e8f44..55ef704 100644
--- 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
--- 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
--- 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
-- 
1.7.10.4