/* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.56 1999/03/25 13:14:05 simonm Exp $
+ * $Id: GC.c,v 1.62 1999/09/15 13:45:16 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
#include "GC.h"
#include "BlockAlloc.h"
#include "Main.h"
-#include "DebugProf.h"
+#include "ProfHeap.h"
#include "SchedAPI.h"
#include "Weak.h"
#include "StablePriv.h"
/* restore enclosing cost centre */
#ifdef PROFILING
+ heapCensus();
CCCS = prev_CCS;
#endif
StgClosure *
isAlive(StgClosure *p)
{
- StgInfoTable *info;
+ const StgInfoTable *info;
while (1) {
}
step = bd->step->to;
}
+#ifdef DEBUG
+ else step = NULL; /* make sure copy() will crash if HEAP_ALLOCED is wrong */
+#endif
/* make sure the info pointer is into text space */
ASSERT(q && (LOOKS_LIKE_GHC_INFO(GET_INFO(q))
|| IS_HUGS_CONSTR_INFO(GET_INFO(q))));
-
info = get_itbl(q);
+
switch (info -> type) {
case BCO:
return copy(q,sizeW_fromITBL(info),step);
case CAF_BLACKHOLE:
+ case SE_CAF_BLACKHOLE:
+ case SE_BLACKHOLE:
case BLACKHOLE:
return copyPart(q,BLACKHOLE_sizeW(),sizeofW(StgHeader),step);
/* aargh - do recursively???? */
case CAF_UNENTERED:
case CAF_BLACKHOLE:
+ case SE_CAF_BLACKHOLE:
+ case SE_BLACKHOLE:
case BLACKHOLE:
case BLACKHOLE_BQ:
/* not evaluated yet */
break;
default:
- barf("evacuate: THUNK_SELECTOR: strange selectee");
+ barf("evacuate: THUNK_SELECTOR: strange selectee %d",
+ (int)(selectee_info->type));
}
}
return copy(q,THUNK_SELECTOR_sizeW(),step);
return q;
default:
- barf("evacuate: strange closure type");
+ barf("evacuate: strange closure type %d", (int)(info->type));
}
barf("evacuate");
break;
default:
- barf("relocate_TSO");
+ barf("relocate_TSO %d", (int)(get_itbl(su)->type));
}
break;
}
If the SRT entry hasn't got bit 0 set, the SRT entry points to a
closure that's fixed at link-time, and no extra magic is required.
*/
-#ifdef HAVE_WIN32_DLL_SUPPORT
+#ifdef ENABLE_WIN32_DLL_SUPPORT
if ( stgCast(unsigned long,*srt) & 0x1 ) {
evacuate(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)));
} else {
break;
case CAF_BLACKHOLE:
+ case SE_CAF_BLACKHOLE:
+ case SE_BLACKHOLE:
case BLACKHOLE:
p += BLACKHOLE_sizeW();
break;
evac_gen = 0;
/* chase the link field for any TSOs on the same queue */
(StgClosure *)tso->link = evacuate((StgClosure *)tso->link);
- if (tso->blocked_on) {
- tso->blocked_on = evacuate(tso->blocked_on);
+ if ( tso->why_blocked == BlockedOnMVar
+ || tso->why_blocked == BlockedOnBlackHole) {
+ tso->block_info.closure = evacuate(tso->block_info.closure);
}
/* scavenge this thread's stack */
scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
static rtsBool
scavenge_one(StgClosure *p)
{
- StgInfoTable *info;
+ const StgInfoTable *info;
rtsBool no_luck;
ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO(p))
}
case CAF_BLACKHOLE:
+ case SE_CAF_BLACKHOLE:
+ case SE_BLACKHOLE:
case BLACKHOLE:
break;
static void
scavenge_mut_once_list(generation *gen)
{
- StgInfoTable *info;
+ const StgInfoTable *info;
StgMutClosure *p, *next, *new_list;
p = gen->mut_once_list;
default:
/* shouldn't have anything else on the mutables list */
- barf("scavenge_mut_once_list: strange object?");
+ barf("scavenge_mut_once_list: strange object? %d", (int)(info->type));
}
}
static void
scavenge_mutable_list(generation *gen)
{
- StgInfoTable *info;
+ const StgInfoTable *info;
StgMutClosure *p, *next;
p = gen->saved_mut_list;
StgTSO *tso = (StgTSO *)p;
(StgClosure *)tso->link = evacuate((StgClosure *)tso->link);
- if (tso->blocked_on) {
- tso->blocked_on = evacuate(tso->blocked_on);
+ if ( tso->why_blocked == BlockedOnMVar
+ || tso->why_blocked == BlockedOnBlackHole) {
+ tso->block_info.closure = evacuate(tso->block_info.closure);
}
scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
default:
/* shouldn't have anything else on the mutables list */
- barf("scavenge_mut_list: strange object?");
+ barf("scavenge_mut_list: strange object? %d", (int)(info->type));
}
}
}
*/
while (p < stack_end) {
- q = *stgCast(StgPtr*,p);
+ q = *(P_ *)p;
/* If we've got a tag, skip over that many words on the stack */
- if (IS_ARG_TAG(stgCast(StgWord,q))) {
+ if (IS_ARG_TAG((W_)q)) {
p += ARG_SIZE(q);
p++; continue;
}
/* Is q a pointer to a closure?
*/
-
- if (! LOOKS_LIKE_GHC_INFO(q)) {
+ if (! LOOKS_LIKE_GHC_INFO(q) ) {
#ifdef DEBUG
if ( 0 && LOOKS_LIKE_STATIC_CLOSURE(q) ) { /* Is it a static closure? */
ASSERT(closure_STATIC(stgCast(StgClosure*,q)));
* record. All activation records have 'bitmap' style layout
* info.
*/
- info = get_itbl(stgCast(StgClosure*,p));
+ info = get_itbl((StgClosure *)p);
switch (info->type) {
/* Dynamic bitmap: the mask is stored on the stack */
case RET_DYN:
bitmap = ((StgRetDyn *)p)->liveness;
- p = (P_)((StgRetDyn *)p)->payload[0];
+ p = (P_)&((StgRetDyn *)p)->payload[0];
goto small_bitmap;
/* probably a slow-entry point return address: */
recordMutable((StgMutClosure *)to);
continue;
default:
+ /* will never be SE_{,CAF_}BLACKHOLE, since we
+ don't push an update frame for single-entry thunks. KSW 1999-01. */
barf("scavenge_stack: UPDATE_FRAME updatee");
}
}
tso = (StgTSO *)p;
/* chase the link field for any TSOs on the same queue */
(StgClosure *)tso->link = evacuate((StgClosure *)tso->link);
- if (tso->blocked_on) {
- tso->blocked_on = evacuate(tso->blocked_on);
+ if ( tso->why_blocked == BlockedOnMVar
+ || tso->why_blocked == BlockedOnBlackHole) {
+ tso->block_info.closure = evacuate(tso->block_info.closure);
}
/* scavenge this thread's stack */
scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
if (bh->header.info != &BLACKHOLE_BQ_info &&
bh->header.info != &CAF_BLACKHOLE_info) {
+#if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
+ fprintf(stderr,"Unexpected lazy BHing required at 0x%04x\n",(int)bh);
+#endif
SET_INFO(bh,&BLACKHOLE_info);
}
* slower --SDM
*/
#if 0 /* do it properly... */
- if (GET_INFO(updatee_bypass) == BLACKHOLE_BQ_info) {
+# if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
+# error Unimplemented lazy BH warning. (KSW 1999-01)
+# endif
+ if (GET_INFO(updatee_bypass) == BLACKHOLE_BQ_info
+ || GET_INFO(updatee_bypass) == CAF_BLACKHOLE_info
+ ) {
/* Sigh. It has one. Don't lose those threads! */
if (GET_INFO(updatee_keep) == BLACKHOLE_BQ_info) {
/* Urgh. Two queues. Merge them. */
#endif
TICK_UPD_SQUEEZED();
+ /* wasn't there something about update squeezing and ticky to be sorted out?
+ * oh yes: we aren't counting each enter properly in this case. See the log somewhere.
+ * KSW 1999-04-21 */
UPD_IND(updatee_bypass, updatee_keep); /* this wakes the threads up */
sp = (P_)frame - 1; /* sp = stuff to slide */
StgBlockingQueue *bh = (StgBlockingQueue *)frame->updatee;
if (bh->header.info != &BLACKHOLE_BQ_info &&
bh->header.info != &CAF_BLACKHOLE_info) {
+#if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
+ fprintf(stderr,"Unexpected lazy BHing required at 0x%04x\n",(int)bh);
+#endif
SET_INFO(bh,&BLACKHOLE_info);
}
}
projects / ghc-hetmet.git / blobdiff