X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FUpdates.h;h=4bc619949310f07febf35e75ab4e75a87f2951c3;hb=f9f5235fce1fb043b0738d86190a4e50386e5dcc;hp=208c9f00d11527275328587abdbbbaa686e72176;hpb=423d477bfecd490de1449c59325c8776f91d7aac;p=ghc-hetmet.git diff --git a/ghc/includes/Updates.h b/ghc/includes/Updates.h index 208c9f0..4bc6199 100644 --- a/ghc/includes/Updates.h +++ b/ghc/includes/Updates.h @@ -40,11 +40,15 @@ * impedence matching: */ #ifdef CMINUSMINUS +#define BLOCK_BEGIN +#define BLOCK_END #define DECLARE_IPTR(info) W_ info #define FCALL foreign "C" #define INFO_PTR(info) info #define ARG_PTR "ptr" #else +#define BLOCK_BEGIN { +#define BLOCK_END } #define DECLARE_IPTR(info) const StgInfoTable *(info) #define FCALL /* nothing */ #define INFO_PTR(info) &info @@ -56,43 +60,39 @@ /* UPD_IND actually does a PERM_IND if TICKY_TICKY is on; if you *really* need an IND use UPD_REAL_IND */ -#define UPD_REAL_IND(updclosure, ind_info, heapptr, and_then) \ - DECLARE_IPTR(info); \ - info = GET_INFO(updclosure); \ - AWAKEN_BQ(info,updclosure); \ - updateWithIndirection(GET_INFO(updclosure), ind_info, \ - updclosure, \ - heapptr, \ - and_then); +#define UPD_REAL_IND(updclosure, ind_info, heapptr, and_then) \ + BLOCK_BEGIN \ + DECLARE_IPTR(info); \ + info = GET_INFO(updclosure); \ + updateWithIndirection(ind_info, \ + updclosure, \ + heapptr, \ + and_then); \ + BLOCK_END #if defined(PROFILING) || defined(TICKY_TICKY) #define UPD_PERM_IND(updclosure, heapptr) \ - DECLARE_IPTR(info); \ - info = GET_INFO(updclosure); \ - AWAKEN_BQ(info,updclosure); \ - updateWithPermIndirection(info, \ - updclosure, \ - heapptr); + BLOCK_BEGIN \ + updateWithPermIndirection(updclosure, \ + heapptr); \ + BLOCK_END #endif #if defined(RTS_SUPPORTS_THREADS) # ifdef TICKY_TICKY # define UPD_IND_NOLOCK(updclosure, heapptr) \ - DECLARE_IPTR(info); \ - info = GET_INFO(updclosure); \ - AWAKEN_BQ_NOLOCK(info,updclosure); \ - updateWithPermIndirection(info, \ - updclosure, \ - heapptr) + BLOCK_BEGIN \ + updateWithPermIndirection(updclosure, \ + heapptr); \ + BLOCK_END # else -# define UPD_IND_NOLOCK(updclosure, heapptr) \ - DECLARE_IPTR(info); \ - info = GET_INFO(updclosure); \ - AWAKEN_BQ_NOLOCK(info,updclosure); \ - updateWithIndirection(info,stg_IND_info, \ - updclosure, \ - heapptr,); +# define UPD_IND_NOLOCK(updclosure, heapptr) \ + BLOCK_BEGIN \ + updateWithIndirection(INFO_PTR(stg_IND_info), \ + updclosure, \ + heapptr,); \ + BLOCK_END # endif #else @@ -155,33 +155,9 @@ extern void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node); DO_AWAKEN_BQ(((StgBlockingQueue *)closure)->blocking_queue, closure); \ } - -#else /* !GRAN && !PAR */ - -#define DO_AWAKEN_BQ(closure) \ - FCALL awakenBlockedQueue(StgBlockingQueue_blocking_queue(closure) ARG_PTR); - -#define AWAKEN_BQ(info,closure) \ - if (info == INFO_PTR(stg_BLACKHOLE_BQ_info)) { \ - DO_AWAKEN_BQ(closure); \ - } - -#define AWAKEN_STATIC_BQ(info,closure) \ - if (info == INFO_PTR(stg_BLACKHOLE_BQ_STATIC_info)) { \ - DO_AWAKEN_BQ(closure); \ - } - -#ifdef RTS_SUPPORTS_THREADS -#define DO_AWAKEN_BQ_NOLOCK(closure) \ - FCALL awakenBlockedQueueNoLock(StgBlockingQueue_blocking_queue(closure) ARG_PTR); - -#define AWAKEN_BQ_NOLOCK(info,closure) \ - if (info == INFO_PTR(stg_BLACKHOLE_BQ_info)) { \ - DO_AWAKEN_BQ_NOLOCK(closure); \ - } -#endif #endif /* GRAN || PAR */ + /* ----------------------------------------------------------------------------- Updates: lower-level macros which update a closure with an indirection to another closure. @@ -209,8 +185,13 @@ extern void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node); * to point to itself, and the closure being updated should not * already have been updated (the mutable list will get messed up * otherwise). + * + * NB. We do *not* do this in SMP mode, because when we have the + * possibility of multiple threads entering the same closure, zeroing + * the slop in one of the threads would have a disastrous effect on + * the other (seen in the wild!). */ -#if !defined(DEBUG) +#if !defined(DEBUG) || defined(SMP) #define DEBUG_FILL_SLOP(p) /* nothing */ @@ -218,24 +199,28 @@ extern void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node); #ifdef CMINUSMINUS -#define DEBUG_FILL_SLOP(p) \ - W_ inf; \ - W_ np; \ - W_ nw; \ - W_ i; \ - inf = %GET_STD_INFO(p); \ - np = TO_W_(%INFO_PTRS(inf)); \ - nw = TO_W_(%INFO_NPTRS(inf)); \ - if (%INFO_TYPE(inf) != THUNK_SELECTOR::I16) { \ - i = 0; \ - for: \ - if (i < np + nw) { \ - StgClosure_payload(p,i) = 0; \ - i = i + 1; \ - goto for; \ - } \ - } - +#define DEBUG_FILL_SLOP(p) \ + W_ inf; \ + W_ sz; \ + W_ i; \ + inf = %GET_STD_INFO(p); \ + if (%INFO_TYPE(inf) == HALF_W_(THUNK_SELECTOR)) { \ + StgThunk_payload(p,0) = 0; \ + } else { \ + if (%INFO_TYPE(inf) != HALF_W_(BLACKHOLE)) { \ + if (%INFO_TYPE(inf) == HALF_W_(AP_STACK)) { \ + sz = StgAP_STACK_size(p) + BYTES_TO_WDS(SIZEOF_StgAP_STACK_NoHdr); \ + } else { \ + sz = TO_W_(%INFO_PTRS(inf)) + TO_W_(%INFO_NPTRS(inf)); \ + } \ + i = 0; \ + for: \ + if (i < sz) { \ + StgThunk_payload(p,i) = 0; \ + i = i + 1; \ + goto for; \ + } \ + } } #else /* !CMINUSMINUS */ @@ -243,12 +228,25 @@ INLINE_HEADER void DEBUG_FILL_SLOP(StgClosure *p) { StgInfoTable *inf = get_itbl(p); - nat np = inf->layout.payload.ptrs, - nw = inf->layout.payload.nptrs, i; - if (inf->type != THUNK_SELECTOR) { - for (i = 0; i < np + nw; i++) { - ((StgClosure *)p)->payload[i] = 0; - } + nat i, sz; + + switch (inf->type) { + case BLACKHOLE: + return; + case AP_STACK: + sz = ((StgAP_STACK *)p)->size + sizeofW(StgAP_STACK) - sizeofW(StgHeader); + break; + case THUNK_SELECTOR: +#ifdef SMP + ((StgSelector *)p)->selectee = 0; +#endif + return; + default: + sz = inf->layout.payload.ptrs + inf->layout.payload.nptrs; + break; + } + for (i = 0; i < sz; i++) { + ((StgThunk *)p)->payload[i] = 0; } } @@ -267,27 +265,23 @@ DEBUG_FILL_SLOP(StgClosure *p) */ #ifdef CMINUSMINUS #define generation(n) (W_[generations] + n*SIZEOF_generation) -#define updateWithIndirection(info, ind_info, p1, p2, and_then) \ +#define updateWithIndirection(ind_info, p1, p2, and_then) \ W_ bd; \ \ /* ASSERT( p1 != p2 && !closure_IND(p1) ); \ */ LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1); \ - bd = Bdescr(p1); \ - if (bdescr_gen_no(bd) == 0) { \ +/* foreign "C" cas(p1 "ptr", 0, stg_WHITEHOLE_info); \ + */ bd = Bdescr(p1); \ + if (bdescr_gen_no(bd) == 0 :: CInt) { \ StgInd_indirectee(p1) = p2; \ SET_INFO(p1, ind_info); \ LDV_RECORD_CREATE(p1); \ TICK_UPD_NEW_IND(); \ and_then; \ } else { \ - if (info != stg_BLACKHOLE_BQ_info) { \ - DEBUG_FILL_SLOP(p1); \ - W_ __mut_once_list; \ - __mut_once_list = generation(bdescr_gen_no(bd)) + \ - OFFSET_generation_mut_once_list; \ - StgMutClosure_mut_link(p1) = W_[__mut_once_list]; \ - W_[__mut_once_list] = p1; \ - } \ + DEBUG_FILL_SLOP(p1); \ + foreign "C" recordMutableGenLock(p1 "ptr", \ + generation(TO_W_(bdescr_gen_no(bd))) "ptr"); \ StgInd_indirectee(p1) = p2; \ SET_INFO(p1, stg_IND_OLDGEN_info); \ LDV_RECORD_CREATE(p1); \ @@ -295,10 +289,11 @@ DEBUG_FILL_SLOP(StgClosure *p) and_then; \ } #else -#define updateWithIndirection(_info, ind_info, p1, p2, and_then) \ +#define updateWithIndirection(ind_info, p1, p2, and_then) \ { \ bdescr *bd; \ \ + /* cas(p1, 0, &stg_WHITEHOLE_info); */ \ ASSERT( (P_)p1 != (P_)p2 && !closure_IND(p1) ); \ LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1); \ bd = Bdescr((P_)p1); \ @@ -309,12 +304,9 @@ DEBUG_FILL_SLOP(StgClosure *p) TICK_UPD_NEW_IND(); \ and_then; \ } else { \ - if (_info != &stg_BLACKHOLE_BQ_info) { \ - DEBUG_FILL_SLOP(p1); \ - ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list; \ - generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1; \ - } \ - ((StgIndOldGen *)p1)->indirectee = p2; \ + DEBUG_FILL_SLOP(p1); \ + recordMutableGenLock(p1, &generations[bd->gen_no]); \ + ((StgInd *)p1)->indirectee = p2; \ SET_INFO(p1, &stg_IND_OLDGEN_info); \ TICK_UPD_OLD_IND(); \ and_then; \ @@ -327,36 +319,38 @@ DEBUG_FILL_SLOP(StgClosure *p) */ #ifndef CMINUSMINUS INLINE_HEADER void -updateWithPermIndirection(const StgInfoTable *info, - StgClosure *p1, +updateWithPermIndirection(StgClosure *p1, StgClosure *p2) { bdescr *bd; ASSERT( p1 != p2 && !closure_IND(p1) ); - // @LDV profiling - // Destroy the old closure. - // Nb: LDV_* stuff cannot mix with ticky-ticky + /* + * @LDV profiling + * Destroy the old closure. + * Nb: LDV_* stuff cannot mix with ticky-ticky + */ LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1); bd = Bdescr((P_)p1); if (bd->gen_no == 0) { ((StgInd *)p1)->indirectee = p2; SET_INFO(p1, &stg_IND_PERM_info); - // @LDV profiling - // We have just created a new closure. + /* + * @LDV profiling + * We have just created a new closure. + */ LDV_RECORD_CREATE(p1); TICK_UPD_NEW_PERM_IND(p1); } else { - if (info != &stg_BLACKHOLE_BQ_info) { - ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list; - generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1; - } - ((StgIndOldGen *)p1)->indirectee = p2; + recordMutableGenLock(p1, &generations[bd->gen_no]); + ((StgInd *)p1)->indirectee = p2; SET_INFO(p1, &stg_IND_OLDGEN_PERM_info); - // @LDV profiling - // We have just created a new closure. + /* + * @LDV profiling + * We have just created a new closure. + */ LDV_RECORD_CREATE(p1); TICK_UPD_OLD_PERM_IND(); }