/* -----------------------------------------------------------------------------
- * $Id: Exception.hc,v 1.4 2000/01/14 11:45:21 hwloidl Exp $
+ * $Id: Exception.hc,v 1.20 2001/03/23 16:36:21 simonmar Exp $
*
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2000
*
* Exception support
*
* ---------------------------------------------------------------------------*/
+#include "Stg.h"
#include "Rts.h"
#include "Exception.h"
#include "Schedule.h"
#if defined(PAR)
# include "FetchMe.h"
#endif
+#if defined(PROFILING)
+# include "Profiling.h"
+#endif
/* -----------------------------------------------------------------------------
Exception Primitives
if (CurrentTSO->blocked_exceptions == NULL) {
CurrentTSO->blocked_exceptions = END_TSO_QUEUE;
- Sp--;
- Sp[0] = (W_)&unblockAsyncExceptionszh_ret_info;
+ /* avoid growing the stack unnecessarily */
+ if (Sp[0] == (W_)&stg_blockAsyncExceptionszh_ret_info) {
+ Sp++;
+ } else {
+ Sp--;
+ Sp[0] = (W_)&stg_unblockAsyncExceptionszh_ret_info;
+ }
}
Sp--;
Sp[0] = ARG_TAG(0);
FE_
}
-INFO_TABLE_SRT_BITMAP(unblockAsyncExceptionszh_ret_info, unblockAsyncExceptionszh_ret_entry, 0, 0, 0, 0, RET_SMALL, , EF_, 0, 0);
-FN_(unblockAsyncExceptionszh_ret_entry)
+INFO_TABLE_SRT_BITMAP(stg_unblockAsyncExceptionszh_ret_info, stg_unblockAsyncExceptionszh_ret_entry, 0, 0, 0, 0, RET_SMALL, , EF_, 0, 0);
+FN_(stg_unblockAsyncExceptionszh_ret_entry)
{
FB_
ASSERT(CurrentTSO->blocked_exceptions != NULL);
#if defined(GRAN)
awakenBlockedQueue(CurrentTSO->blocked_exceptions,
- CurrentTSO->block_info.closure);
+ (StgClosure*)NULL);
#elif defined(PAR)
- // is CurrentTSO->block_info.closure always set to the node
- // holding the blocking queue !? -- HWL
+ /* we don't need node info (2nd arg) in this case
+ (note that CurrentTSO->block_info.closure isn't always set) */
awakenBlockedQueue(CurrentTSO->blocked_exceptions,
- CurrentTSO->block_info.closure);
+ (StgClosure*)NULL);
#else
awakenBlockedQueue(CurrentTSO->blocked_exceptions);
#endif
CurrentTSO->blocked_exceptions = NULL;
+#ifdef REG_R1
Sp++;
JMP_(ENTRY_CODE(Sp[0]));
+#else
+ Sp[1] = Sp[0];
+ Sp++;
+ JMP_(ENTRY_CODE(Sp[1]));
+#endif
FE_
}
awakenBlockedQueue(CurrentTSO->blocked_exceptions);
#endif
CurrentTSO->blocked_exceptions = NULL;
- Sp--;
- Sp[0] = (W_)&blockAsyncExceptionszh_ret_info;
+
+ /* avoid growing the stack unnecessarily */
+ if (Sp[0] == (W_)&stg_unblockAsyncExceptionszh_ret_info) {
+ Sp++;
+ } else {
+ Sp--;
+ Sp[0] = (W_)&stg_blockAsyncExceptionszh_ret_info;
+ }
}
Sp--;
Sp[0] = ARG_TAG(0);
FE_
}
-INFO_TABLE_SRT_BITMAP(blockAsyncExceptionszh_ret_info, blockAsyncExceptionszh_ret_entry, 0, 0, 0, 0, RET_SMALL, , EF_, 0, 0);
-FN_(blockAsyncExceptionszh_ret_entry)
+INFO_TABLE_SRT_BITMAP(stg_blockAsyncExceptionszh_ret_info, stg_blockAsyncExceptionszh_ret_entry, 0, 0, 0, 0, RET_SMALL, , EF_, 0, 0);
+FN_(stg_blockAsyncExceptionszh_ret_entry)
{
FB_
ASSERT(CurrentTSO->blocked_exceptions == NULL);
CurrentTSO->blocked_exceptions = END_TSO_QUEUE;
+#ifdef REG_R1
Sp++;
JMP_(ENTRY_CODE(Sp[0]));
+#else
+ Sp[1] = Sp[0];
+ Sp++;
+ JMP_(ENTRY_CODE(Sp[1]));
+#endif
FE_
}
-
FN_(killThreadzh_fast)
{
FB_
/* args: R1.p = TSO to kill, R2.p = Exception */
- /* If the target thread is currently blocking async exceptions,
- * we'll have to block until it's ready to accept them.
+ /* This thread may have been relocated.
+ * (see Schedule.c:threadStackOverflow)
*/
- if (R1.t->blocked_exceptions != NULL) {
-
- /* ToDo (SMP): locking if destination thread is currently
- * running...
- */
- CurrentTSO->link = R1.t->blocked_exceptions;
- R1.t->blocked_exceptions = CurrentTSO;
+ while (R1.t->what_next == ThreadRelocated) {
+ R1.t = R1.t->link;
+ }
- CurrentTSO->why_blocked = BlockedOnException;
- CurrentTSO->block_info.tso = R1.t;
+ /* If the target thread is currently blocking async exceptions,
+ * we'll have to block until it's ready to accept them. The
+ * exception is interruptible threads - ie. those that are blocked
+ * on some resource.
+ */
+ if (R1.t->blocked_exceptions != NULL && !interruptible(R1.t) ) {
+
+ /* ToDo (SMP): locking if destination thread is currently
+ * running...
+ */
+ CurrentTSO->link = R1.t->blocked_exceptions;
+ R1.t->blocked_exceptions = CurrentTSO;
- BLOCK( R1_PTR | R2_PTR, killThreadzh_fast );
+ CurrentTSO->why_blocked = BlockedOnException;
+ CurrentTSO->block_info.tso = R1.t;
+
+ BLOCK( R1_PTR | R2_PTR, killThreadzh_fast );
}
/* Killed threads turn into zombies, which might be garbage
if (R1.t == CurrentTSO) {
SaveThreadState(); /* inline! */
STGCALL2(raiseAsync, R1.t, R2.cl);
- if (CurrentTSO->whatNext == ThreadKilled) {
- R1.w = ThreadYielding;
+ if (CurrentTSO->what_next == ThreadKilled) {
+ R1.w = ThreadFinished;
JMP_(StgReturn);
}
LoadThreadState();
- if (CurrentTSO->whatNext == ThreadEnterGHC) {
+ if (CurrentTSO->what_next == ThreadEnterGHC) {
R1.w = Sp[0];
Sp++;
JMP_(GET_ENTRY(R1.cl));
Catch frames
-------------------------------------------------------------------------- */
+#ifdef REG_R1
#define CATCH_FRAME_ENTRY_TEMPLATE(label,ret) \
FN_(label); \
FN_(label) \
JMP_(ret); \
FE_ \
}
+#else
+#define CATCH_FRAME_ENTRY_TEMPLATE(label,ret) \
+ FN_(label); \
+ FN_(label) \
+ { \
+ StgWord rval; \
+ FB_ \
+ rval = Sp[0]; \
+ Sp++; \
+ Su = ((StgCatchFrame *)Sp)->link; \
+ Sp += sizeofW(StgCatchFrame) - 1; \
+ Sp[0] = rval; \
+ JMP_(ret); \
+ FE_ \
+ }
+#endif
+
+#ifdef REG_R1
+#define SP_OFF 0
+#else
+#define SP_OFF 1
+#endif
-CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_entry,ENTRY_CODE(Sp[0]));
-CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_0_entry,RET_VEC(Sp[0],0));
-CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_1_entry,RET_VEC(Sp[0],1));
-CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_2_entry,RET_VEC(Sp[0],2));
-CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_3_entry,RET_VEC(Sp[0],3));
-CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_4_entry,RET_VEC(Sp[0],4));
-CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_5_entry,RET_VEC(Sp[0],5));
-CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_6_entry,RET_VEC(Sp[0],6));
-CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_7_entry,RET_VEC(Sp[0],7));
+CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_entry,ENTRY_CODE(Sp[SP_OFF]));
+CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_0_entry,RET_VEC(Sp[SP_OFF],0));
+CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_1_entry,RET_VEC(Sp[SP_OFF],1));
+CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_2_entry,RET_VEC(Sp[SP_OFF],2));
+CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_3_entry,RET_VEC(Sp[SP_OFF],3));
+CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_4_entry,RET_VEC(Sp[SP_OFF],4));
+CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_5_entry,RET_VEC(Sp[SP_OFF],5));
+CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_6_entry,RET_VEC(Sp[SP_OFF],6));
+CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_7_entry,RET_VEC(Sp[SP_OFF],7));
#ifdef PROFILING
#define CATCH_FRAME_BITMAP 7
* kind of return to the activation record underneath us on the stack.
*/
-VEC_POLY_INFO_TABLE(catch_frame, CATCH_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, CATCH_FRAME,, EF_);
+VEC_POLY_INFO_TABLE(stg_catch_frame, CATCH_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, CATCH_FRAME,, EF_);
/* -----------------------------------------------------------------------------
* The catch infotable
* It is used in deleteThread when reverting blackholes.
* -------------------------------------------------------------------------- */
-INFO_TABLE(catch_info,catch_entry,2,0,FUN,,EF_,0,0);
-STGFUN(catch_entry)
+INFO_TABLE(stg_catch_info,stg_catch_entry,2,0,FUN,,EF_,0,0);
+STGFUN(stg_catch_entry)
{
FB_
- R2.cl = payloadCPtr(R1.cl,1); /* h */
- R1.cl = payloadCPtr(R1.cl,0); /* x */
+ R2.cl = R1.cl->payload[1]; /* h */
+ R1.cl = R1.cl->payload[0]; /* x */
JMP_(catchzh_fast);
FE_
}
StgCatchFrame *fp;
FB_
- /* args: R1 = m, R2 = handler */
- STK_CHK_GEN(sizeofW(StgCatchFrame), R1_PTR | R2_PTR, catchzh_fast, );
+ /* args: R1 = m :: IO a, R2 = handler :: Exception -> IO a */
+ STK_CHK_GEN(sizeofW(StgCatchFrame) + 1, R1_PTR | R2_PTR, catchzh_fast, );
+
+ /* Set up the catch frame */
Sp -= sizeofW(StgCatchFrame);
fp = (StgCatchFrame *)Sp;
- SET_HDR(fp,(StgInfoTable *)&catch_frame_info,CCCS);
+ SET_HDR(fp,(StgInfoTable *)&stg_catch_frame_info,CCCS);
fp -> handler = R2.cl;
fp -> exceptions_blocked = (CurrentTSO->blocked_exceptions != NULL);
fp -> link = Su;
Su = (StgUpdateFrame *)fp;
TICK_CATCHF_PUSHED();
+
+ /* Push realworld token and enter R1. */
+ Sp--;
+ Sp[0] = ARG_TAG(0);
TICK_ENT_VIA_NODE();
JMP_(GET_ENTRY(R1.cl));
* It is used in raisezh_fast to update thunks on the update list
* -------------------------------------------------------------------------- */
-INFO_TABLE(raise_info,raise_entry,1,0,FUN,,EF_,0,0);
-STGFUN(raise_entry)
+INFO_TABLE(stg_raise_info,stg_raise_entry,1,0,THUNK,,EF_,0,0);
+STGFUN(stg_raise_entry)
{
FB_
R1.cl = R1.cl->payload[0];
StgUpdateFrame *p;
StgClosure *raise_closure;
FB_
- /* args : R1 = error */
+ /* args : R1 = exception */
#if defined(PROFILING)
*/
raise_closure = (StgClosure *)RET_STGCALL1(P_,allocate,
sizeofW(StgClosure)+1);
- raise_closure->header.info = &raise_info;
+ raise_closure->header.info = &stg_raise_info;
raise_closure->payload[0] = R1.cl;
while (1) {
break;
case STOP_FRAME:
- barf("raisezh_fast: STOP_FRAME");
-
+ /* We've stripped the entire stack, the thread is now dead. */
+ Sp = CurrentTSO->stack + CurrentTSO->stack_size - 1;
+ Sp[0] = R1.w; /* save the exception */
+ Su = (StgUpdateFrame *)(Sp+1);
+ CurrentTSO->what_next = ThreadKilled;
+ SaveThreadState(); /* inline! */
+ R1.w = ThreadFinished;
+ JMP_(StgReturn);
+
default:
barf("raisezh_fast: weird activation record");
}
Su = ((StgCatchFrame *)p)->link;
handler = ((StgCatchFrame *)p)->handler;
- Sp = (P_)p + sizeofW(StgCatchFrame) - 1;
+ Sp = (P_)p + sizeofW(StgCatchFrame);
/* Restore the blocked/unblocked state for asynchronous exceptions
* at the CATCH_FRAME.
* unblockAsyncExceptions_ret stack frame.
*/
if (! ((StgCatchFrame *)p)->exceptions_blocked) {
- *(Sp--) = (W_)&unblockAsyncExceptionszh_ret_info;
+ *(--Sp) = (W_)&stg_unblockAsyncExceptionszh_ret_info;
}
/* Ensure that async excpetions are blocked when running the handler.
CurrentTSO->blocked_exceptions = END_TSO_QUEUE;
}
- /* Enter the handler, passing the exception value as an argument.
+ /* Enter the handler, passing the exception value and a realworld
+ * token as arguments.
*/
- *Sp = R1.w;
+ Sp -= 2;
+ Sp[0] = R1.w;
+ Sp[1] = ARG_TAG(0);
TICK_ENT_VIA_NODE();
R1.cl = handler;
JMP_(GET_ENTRY(R1.cl));
projects / ghc-hetmet.git / blobdiff