Commit c7720145 authored by simonmar's avatar simonmar
Browse files

[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.
parent 86024676
......@@ -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.
......
......@@ -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);
}
// ------------------------------------------------------------------------
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment