X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FException.hc;h=817d6c2c5bdf889e2196c454f22f08e989fcac85;hb=a704ee9c4180bf19a431e507f5d32a1f787c5c47;hp=fecdd608e02540f8ea9c4c13b6964d5166d95f71;hpb=1060b59bec219335e4f54e991044027c12b70678;p=ghc-hetmet.git diff --git a/ghc/rts/Exception.hc b/ghc/rts/Exception.hc index fecdd60..817d6c2 100644 --- a/ghc/rts/Exception.hc +++ b/ghc/rts/Exception.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Exception.hc,v 1.16 2000/11/14 12:52:55 simonmar Exp $ + * $Id: Exception.hc,v 1.23 2001/12/05 17:35:15 sewardj Exp $ * * (c) The GHC Team, 1998-2000 * @@ -7,6 +7,7 @@ * * ---------------------------------------------------------------------------*/ +#include "Stg.h" #include "Rts.h" #include "Exception.h" #include "Schedule.h" @@ -75,12 +76,12 @@ FN_(stg_unblockAsyncExceptionszh_ret_entry) 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 @@ -211,6 +212,17 @@ FN_(killThreadzh_fast) FE_ } + +FN_(myThreadIdzh_fast) +{ + /* no args. */ + FB_ + R1.p = (P_)CurrentTSO; + JMP_(ENTRY_CODE(Sp[0])); + FE_ +} + + /* ----------------------------------------------------------------------------- Catch frames -------------------------------------------------------------------------- */ @@ -259,8 +271,8 @@ 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 +#if defined(PROFILING) +#define CATCH_FRAME_BITMAP 15 #else #define CATCH_FRAME_BITMAP 3 #endif @@ -282,7 +294,7 @@ VEC_POLY_INFO_TABLE(stg_catch_frame, CATCH_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off * It is used in deleteThread when reverting blackholes. * -------------------------------------------------------------------------- */ -INFO_TABLE(stg_catch_info,catch_entry,2,0,FUN,,EF_,0,0); +INFO_TABLE(stg_catch_info,stg_catch_entry,2,0,FUN,,EF_,0,0); STGFUN(stg_catch_entry) { FB_ @@ -348,16 +360,14 @@ FN_(raisezh_fast) #if defined(PROFILING) - /* Debugging tool: on raising an exception, show where we are. */ /* ToDo: currently this is a hack. Would be much better if * the info was only displayed for an *uncaught* exception. */ if (RtsFlags.ProfFlags.showCCSOnException) { - STGCALL2(print_ccs,stderr,CCCS); + STGCALL2(fprintCCS,stderr,CCCS); } - #endif p = Su; @@ -366,9 +376,19 @@ FN_(raisezh_fast) * is the exception raise. It is used to overwrite all the * thunks which are currently under evaluataion. */ + /* + // @LDV profiling + // stg_raise_info has THUNK as its closure type. Since a THUNK takes at least + // MIN_UPD_SIZE words in its payload, MIN_UPD_SIZE is more approprate than 1. + // It seems that 1 does not cause any problem unless profiling is performed. + // However, when LDV profiling goes on, we need to linearly scan small object pool, + // where raise_closure is stored, so we should use MIN_UPD_SIZE. raise_closure = (StgClosure *)RET_STGCALL1(P_,allocate, sizeofW(StgClosure)+1); - raise_closure->header.info = &stg_raise_info; + */ + raise_closure = (StgClosure *)RET_STGCALL1(P_,allocate, + sizeofW(StgClosure)+MIN_UPD_SIZE); + SET_HDR(raise_closure, &stg_raise_info, CCCS); raise_closure->payload[0] = R1.cl; while (1) {