/* ----------------------------------------------------------------------------
- * $Id: ClosureTypes.h,v 1.13 2000/04/05 14:26:31 panne Exp $
+ * $Id: ClosureTypes.h,v 1.14 2001/01/29 17:23:41 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
#define IND_PERM 31
#define IND_OLDGEN_PERM 32
#define IND_STATIC 33
-#define CAF_UNENTERED 34
-#define CAF_ENTERED 35
-#define CAF_BLACKHOLE 36
-#define RET_BCO 37
-#define RET_SMALL 38
-#define RET_VEC_SMALL 39
-#define RET_BIG 40
-#define RET_VEC_BIG 41
-#define RET_DYN 42
-#define UPDATE_FRAME 43
-#define CATCH_FRAME 44
-#define STOP_FRAME 45
-#define SEQ_FRAME 46
+#define RET_BCO 36
+#define RET_SMALL 37
+#define RET_VEC_SMALL 38
+#define RET_BIG 39
+#define RET_VEC_BIG 40
+#define RET_DYN 41
+#define UPDATE_FRAME 42
+#define CATCH_FRAME 43
+#define STOP_FRAME 44
+#define SEQ_FRAME 45
+#define CAF_BLACKHOLE 46
#define BLACKHOLE 47
#define BLACKHOLE_BQ 48
#define SE_BLACKHOLE 49
/* ----------------------------------------------------------------------------
- * $Id: Closures.h,v 1.24 2000/12/19 16:48:58 sewardj Exp $
+ * $Id: Closures.h,v 1.25 2001/01/29 17:23:41 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
} StgIndOldGen;
typedef struct {
- StgHeader header;
- StgClosure *indirectee;
- StgClosure *static_link;
-} StgIndStatic;
-
-typedef struct StgCAF_ {
StgHeader header;
- StgClosure *body;
- StgMutClosure *mut_link;
- StgClosure *value;
- struct StgCAF_ *link;
-} StgCAF;
+ StgClosure *indirectee;
+ StgClosure *static_link;
+#ifdef GHCI
+ struct _StgInfoTable *saved_info;
+#endif
+} StgIndStatic;
typedef struct {
StgHeader header;
/* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.h,v 1.32 2001/01/15 16:55:25 sewardj Exp $
+ * $Id: StgMiscClosures.h,v 1.33 2001/01/29 17:23:41 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
STGFUN(stg_IND_OLDGEN_PERM_entry);
STGFUN(stg_CAF_UNENTERED_entry);
STGFUN(stg_CAF_ENTERED_entry);
-STGFUN(stg_CAF_BLACKHOLE_entry);
STGFUN(stg_BLACKHOLE_entry);
+STGFUN(stg_CAF_BLACKHOLE_entry);
STGFUN(stg_BLACKHOLE_BQ_entry);
#ifdef SMP
STGFUN(stg_WHITEHOLE_entry);
extern DLL_IMPORT_RTS const StgInfoTable stg_IND_OLDGEN_PERM_info;
extern DLL_IMPORT_RTS const StgInfoTable stg_CAF_UNENTERED_info;
extern DLL_IMPORT_RTS const StgInfoTable stg_CAF_ENTERED_info;
-extern DLL_IMPORT_RTS const StgInfoTable stg_CAF_BLACKHOLE_info;
extern DLL_IMPORT_RTS const StgInfoTable stg_BLACKHOLE_info;
+extern DLL_IMPORT_RTS const StgInfoTable stg_CAF_BLACKHOLE_info;
extern DLL_IMPORT_RTS const StgInfoTable stg_BLACKHOLE_BQ_info;
#ifdef SMP
extern DLL_IMPORT_RTS const StgInfoTable stg_WHITEHOLE_info;
/* -----------------------------------------------------------------------------
- * $Id: Updates.h,v 1.21 2000/12/04 12:31:20 simonmar Exp $
+ * $Id: Updates.h,v 1.22 2001/01/29 17:23:41 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
}
#endif
+#define UPD_STATIC_IND(updclosure, heapptr) \
+ { \
+ const StgInfoTable *info; \
+ info = ((StgClosure *)updclosure)->header.info; \
+ AWAKEN_STATIC_BQ(info,updclosure); \
+ updateWithStaticIndirection(info, \
+ (StgClosure *)updclosure, \
+ (StgClosure *)heapptr); \
+ }
+
#if defined(PROFILING) || defined(TICKY_TICKY)
#define UPD_PERM_IND(updclosure, heapptr) \
{ \
DO_AWAKEN_BQ(closure); \
}
+#define AWAKEN_STATIC_BQ(info,closure) \
+ if (info == &stg_BLACKHOLE_BQ_STATIC_info) { \
+ DO_AWAKEN_BQ(closure); \
+ }
+
#endif /* GRAN || PAR */
/* -------------------------------------------------------------------------
/* -----------------------------------------------------------------------------
- * $Id: ClosureFlags.c,v 1.6 2000/01/13 14:34:02 hwloidl Exp $
+ * $Id: ClosureFlags.c,v 1.7 2001/01/29 17:23:40 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
/* 0 1 2 3 4 5 6 7 */
/* HNF BTM NS STA THU MUT UPT SRT */
-/* INVALID_OBJECT */ ( 0 ),
-/* CONSTR */ (_HNF| _NS ),
-/* CONSTR_1_0 */ (_HNF| _NS ),
-/* CONSTR_0_1 */ (_HNF| _NS ),
-/* CONSTR_2_0 */ (_HNF| _NS ),
-/* CONSTR_1_1 */ (_HNF| _NS ),
-/* CONSTR_0_2 */ (_HNF| _NS ),
-/* CONSTR_INTLIKE */ (_HNF| _NS|_STA ),
-/* CONSTR_CHARLIKE */ (_HNF| _NS|_STA ),
-/* CONSTR_STATIC */ (_HNF| _NS|_STA ),
-/* CONSTR_NOCAF_STATIC */ (_HNF| _NS|_STA ),
-/* FUN */ (_HNF| _NS| _SRT ),
-/* FUN_1_0 */ (_HNF| _NS ),
-/* FUN_0_1 */ (_HNF| _NS ),
-/* FUN_2_0 */ (_HNF| _NS ),
-/* FUN_1_1 */ (_HNF| _NS ),
-/* FUN_0_2 */ (_HNF| _NS ),
-/* FUN_STATIC */ (_HNF| _NS|_STA| _SRT ),
-/* THUNK */ ( _BTM| _THU| _SRT ),
-/* THUNK_1_0 */ ( _BTM| _THU| _SRT ),
-/* THUNK_0_1 */ ( _BTM| _THU| _SRT ),
-/* THUNK_2_0 */ ( _BTM| _THU| _SRT ),
-/* THUNK_1_1 */ ( _BTM| _THU| _SRT ),
-/* THUNK_0_2 */ ( _BTM| _THU| _SRT ),
-/* THUNK_STATIC */ ( _BTM| _STA|_THU| _SRT ),
-/* THUNK_SELECTOR */ ( _BTM| _THU| _SRT ),
-/* BCO */ (_HNF| _NS ),
-/* AP_UPD */ ( _BTM| _THU ),
-/* PAP */ (_HNF| _NS ),
-/* IND */ ( _NS ),
-/* IND_OLDGEN */ ( _NS ),
-/* IND_PERM */ ( _NS ),
-/* IND_OLDGEN_PERM */ ( _NS ),
-/* IND_STATIC */ ( _NS|_STA ),
-/* CAF_UNENTERED */ ( 0 ),
-/* CAF_ENTERED */ ( 0 ),
-/* CAF_BLACKHOLE */ ( _BTM|_NS| _MUT|_UPT ),
-/* RET_BCO */ ( _BTM ),
-/* RET_SMALL */ ( _BTM| _SRT),
-/* RET_VEC_SMALL */ ( _BTM| _SRT),
-/* RET_BIG */ ( _SRT),
-/* RET_VEC_BIG */ ( _SRT),
-/* RET_DYN */ ( _SRT),
-/* UPDATE_FRAME */ ( _BTM ),
-/* CATCH_FRAME */ ( _BTM ),
-/* STOP_FRAME */ ( _BTM ),
-/* SEQ_FRAME */ ( _BTM ),
-/* BLACKHOLE */ ( _NS| _MUT|_UPT ),
-/* BLACKHOLE_BQ */ ( _NS| _MUT|_UPT ),
-/* SE_BLACKHOLE */ ( _NS| _UPT ),
-/* SE_CAF_BLACKHOLE */ ( _NS| _UPT ),
-/* MVAR */ (_HNF| _NS| _MUT|_UPT ),
-/* ARR_WORDS */ (_HNF| _NS| _UPT ),
-/* MUT_ARR_PTRS */ (_HNF| _NS| _MUT|_UPT ),
-/* MUT_ARR_PTRS_FROZEN */ (_HNF| _NS| _MUT|_UPT ),
-/* MUT_VAR */ (_HNF| _NS| _MUT|_UPT ),
-/* WEAK */ (_HNF| _NS| _UPT ),
-/* FOREIGN */ (_HNF| _NS| _UPT ),
-/* STABLE_NAME */ (_HNF| _NS| _UPT ),
+[INVALID_OBJECT ] = ( 0 ),
+[CONSTR ] = (_HNF| _NS ),
+[CONSTR_1_0 ] = (_HNF| _NS ),
+[CONSTR_0_1 ] = (_HNF| _NS ),
+[CONSTR_2_0 ] = (_HNF| _NS ),
+[CONSTR_1_1 ] = (_HNF| _NS ),
+[CONSTR_0_2 ] = (_HNF| _NS ),
+[CONSTR_INTLIKE ] = (_HNF| _NS|_STA ),
+[CONSTR_CHARLIKE ] = (_HNF| _NS|_STA ),
+[CONSTR_STATIC ] = (_HNF| _NS|_STA ),
+[CONSTR_NOCAF_STATIC ] = (_HNF| _NS|_STA ),
+[FUN ] = (_HNF| _NS| _SRT ),
+[FUN_1_0 ] = (_HNF| _NS ),
+[FUN_0_1 ] = (_HNF| _NS ),
+[FUN_2_0 ] = (_HNF| _NS ),
+[FUN_1_1 ] = (_HNF| _NS ),
+[FUN_0_2 ] = (_HNF| _NS ),
+[FUN_STATIC ] = (_HNF| _NS|_STA| _SRT ),
+[THUNK ] = ( _BTM| _THU| _SRT ),
+[THUNK_1_0 ] = ( _BTM| _THU| _SRT ),
+[THUNK_0_1 ] = ( _BTM| _THU| _SRT ),
+[THUNK_2_0 ] = ( _BTM| _THU| _SRT ),
+[THUNK_1_1 ] = ( _BTM| _THU| _SRT ),
+[THUNK_0_2 ] = ( _BTM| _THU| _SRT ),
+[THUNK_STATIC ] = ( _BTM| _STA|_THU| _SRT ),
+[THUNK_SELECTOR ] = ( _BTM| _THU| _SRT ),
+[BCO ] = (_HNF| _NS ),
+[AP_UPD ] = ( _BTM| _THU ),
+[PAP ] = (_HNF| _NS ),
+[IND ] = ( _NS ),
+[IND_OLDGEN ] = ( _NS ),
+[IND_PERM ] = ( _NS ),
+[IND_OLDGEN_PERM ] = ( _NS ),
+[IND_STATIC ] = ( _NS|_STA ),
+[CAF_BLACKHOLE ] = ( _BTM|_NS| _MUT|_UPT ),
+[RET_BCO ] = ( _BTM ),
+[RET_SMALL ] = ( _BTM| _SRT),
+[RET_VEC_SMALL ] = ( _BTM| _SRT),
+[RET_BIG ] = ( _SRT),
+[RET_VEC_BIG ] = ( _SRT),
+[RET_DYN ] = ( _SRT),
+[UPDATE_FRAME ] = ( _BTM ),
+[CATCH_FRAME ] = ( _BTM ),
+[STOP_FRAME ] = ( _BTM ),
+[SEQ_FRAME ] = ( _BTM ),
+[BLACKHOLE ] = ( _NS| _MUT|_UPT ),
+[BLACKHOLE_BQ ] = ( _NS| _MUT|_UPT ),
+[SE_BLACKHOLE ] = ( _NS| _UPT ),
+[SE_CAF_BLACKHOLE ] = ( _NS| _UPT ),
+[MVAR ] = (_HNF| _NS| _MUT|_UPT ),
+[ARR_WORDS ] = (_HNF| _NS| _UPT ),
+[MUT_ARR_PTRS ] = (_HNF| _NS| _MUT|_UPT ),
+[MUT_ARR_PTRS_FROZEN ] = (_HNF| _NS| _MUT|_UPT ),
+[MUT_VAR ] = (_HNF| _NS| _MUT|_UPT ),
+[WEAK ] = (_HNF| _NS| _UPT ),
+[FOREIGN ] = (_HNF| _NS| _UPT ),
+[STABLE_NAME ] = (_HNF| _NS| _UPT ),
+[TSO ] = (_HNF| _NS| _MUT|_UPT ),
+[BLOCKED_FETCH ] = (_HNF| _NS| _MUT|_UPT ),
+[FETCH_ME ] = (_HNF| _NS| _MUT|_UPT ),
+[FETCH_ME_BQ ] = ( _NS| _MUT|_UPT ),
+[RBH ] = ( _NS| _MUT|_UPT ),
+[EVACUATED ] = ( 0 ),
-/* TSO */ (_HNF| _NS| _MUT|_UPT ),
-/* BLOCKED_FETCH */ (_HNF| _NS| _MUT|_UPT ),
-/* FETCH_ME */ (_HNF| _NS| _MUT|_UPT ),
-/* FETCH_ME_BQ */ ( _NS| _MUT|_UPT ),
-/* RBH */ ( _NS| _MUT|_UPT ),
-
-/* EVACUATED */ ( 0 ),
-
-/* N_CLOSURE_TYPES */ ( 0 )
+[N_CLOSURE_TYPES ] = ( 0 )
};
/* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.92 2001/01/16 11:50:30 simonmar Exp $
+ * $Id: GC.c,v 1.93 2001/01/29 17:23:40 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
static void gcCAFs ( void );
#endif
+#ifdef GHCI
+void revertCAFs ( void );
+void scavengeCAFs ( void );
+#endif
+
//@node Garbage Collect, Weak Pointers, Static function declarations
//@subsection Garbage Collect
}
}
+#ifdef GHCI
+ scavengeCAFs();
+#endif
+
/* follow all the roots that the application knows about.
*/
evac_gen = 0;
/* check for memory leaks if sanity checking is on */
IF_DEBUG(sanity, memInventory());
-#ifdef RTS_GTK_VISUALS
- if (RtsFlags.GcFlags.visuals) {
+#ifdef RTS_GTK_FRONTPANEL
+ if (RtsFlags.GcFlags.frontpanel) {
updateFrontPanelAfterGC( N, live );
}
#endif
case CONSTR:
case IND_PERM:
case IND_OLDGEN_PERM:
- case CAF_UNENTERED:
- case CAF_ENTERED:
case WEAK:
case FOREIGN:
case STABLE_NAME:
selectee = ((StgInd *)selectee)->indirectee;
goto selector_loop;
- case CAF_ENTERED:
- selectee = ((StgCAF *)selectee)->value;
- goto selector_loop;
-
case EVACUATED:
selectee = ((StgEvacuated *)selectee)->evacuee;
goto selector_loop;
case THUNK_STATIC:
case THUNK_SELECTOR:
/* aargh - do recursively???? */
- case CAF_UNENTERED:
case CAF_BLACKHOLE:
case SE_CAF_BLACKHOLE:
case SE_BLACKHOLE:
return q;
case IND_STATIC:
+#ifdef GHCI
+ /* a revertible CAF - it'll be on the CAF list, so don't do
+ * anything with it here (we'll scavenge it later).
+ */
+ if (((StgIndStatic *)q)->saved_info != NULL) {
+ return q;
+ }
+#endif
if (major_gc && IND_STATIC_LINK((StgClosure *)q) == NULL) {
- IND_STATIC_LINK((StgClosure *)q) = static_objects;
- static_objects = (StgClosure *)q;
+ IND_STATIC_LINK((StgClosure *)q) = static_objects;
+ static_objects = (StgClosure *)q;
}
return q;
p += sizeofW(StgIndOldGen);
break;
- case CAF_UNENTERED:
- {
- StgCAF *caf = (StgCAF *)p;
-
- caf->body = evacuate(caf->body);
- if (failed_to_evac) {
- failed_to_evac = rtsFalse;
- recordOldToNewPtrs((StgMutClosure *)p);
- } else {
- caf->mut_link = NULL;
- }
- p += sizeofW(StgCAF);
- break;
- }
-
- case CAF_ENTERED:
- {
- StgCAF *caf = (StgCAF *)p;
-
- caf->body = evacuate(caf->body);
- caf->value = evacuate(caf->value);
- if (failed_to_evac) {
- failed_to_evac = rtsFalse;
- recordOldToNewPtrs((StgMutClosure *)p);
- } else {
- caf->mut_link = NULL;
- }
- p += sizeofW(StgCAF);
- break;
- }
-
case MUT_VAR:
/* ignore MUT_CONSs */
if (((StgMutVar *)p)->header.info != &stg_MUT_CONS_info) {
case FOREIGN:
case IND_PERM:
case IND_OLDGEN_PERM:
- case CAF_UNENTERED:
{
StgPtr q, end;
}
continue;
- case CAF_ENTERED:
- {
- StgCAF *caf = (StgCAF *)p;
- caf->body = evacuate(caf->body);
- caf->value = evacuate(caf->value);
- if (failed_to_evac) {
- failed_to_evac = rtsFalse;
- p->mut_link = new_list;
- new_list = p;
- } else {
- p->mut_link = NULL;
- }
- }
- continue;
-
- case CAF_UNENTERED:
- {
- StgCAF *caf = (StgCAF *)p;
- caf->body = evacuate(caf->body);
- if (failed_to_evac) {
- failed_to_evac = rtsFalse;
- p->mut_link = new_list;
- new_list = p;
- } else {
- p->mut_link = NULL;
- }
- }
- continue;
-
default:
/* shouldn't have anything else on the mutables list */
barf("scavenge_mut_once_list: strange object? %d", (int)(info->type));
* It doesn't do any harm to zero all the mutable link fields on the
* mutable list.
*/
-//@cindex zero_mutable_list
static void
zero_mutable_list( StgMutClosure *first )
}
}
-//@node Reverting CAFs, Sanity code for CAF garbage collection, Scavenging
-//@subsection Reverting CAFs
-
/* -----------------------------------------------------------------------------
Reverting CAFs
-------------------------------------------------------------------------- */
-//@cindex RevertCAFs
-void RevertCAFs(void)
+#ifdef GHCI
+
+void
+revertCAFs( void )
{
-#ifdef INTERPRETER
- StgInt i;
-
- /* Deal with CAFs created by compiled code. */
- for (i = 0; i < usedECafTable; i++) {
- SET_INFO( (StgInd*)(ecafTable[i].closure), ecafTable[i].origItbl );
- ((StgInd*)(ecafTable[i].closure))->indirectee = 0;
- }
-
- /* Deal with CAFs created by the interpreter. */
- while (ecafList != END_ECAF_LIST) {
- StgCAF* caf = ecafList;
- ecafList = caf->link;
- ASSERT(get_itbl(caf)->type == CAF_ENTERED);
- SET_INFO(caf,&CAF_UNENTERED_info);
- caf->value = (StgClosure *)0xdeadbeef;
- caf->link = (StgCAF *)0xdeadbeef;
- }
-
- /* Empty out both the table and the list. */
- clearECafTable();
- ecafList = END_ECAF_LIST;
-#endif
+ StgIndStatic *c;
+
+ for (c = (StgIndStatic *)caf_list; c != NULL; c = (StgIndStatic *)c->static_link) {
+ c->header.info = c->saved_info;
+ c->saved_info = NULL;
+ /* could, but not necessary: c->static_link = NULL; */
+ }
+ caf_list = NULL;
+}
+
+void
+scavengeCAFs( void )
+{
+ StgIndStatic *c;
+
+ evac_gen = 0;
+ for (c = (StgIndStatic *)caf_list; c != NULL; c = (StgIndStatic *)c->static_link) {
+ c->indirectee = evacuate(c->indirectee);
+ }
}
-//@node Sanity code for CAF garbage collection, Lazy black holing, Reverting CAFs
-//@subsection Sanity code for CAF garbage collection
+#endif /* GHCI */
/* -----------------------------------------------------------------------------
Sanity code for CAF garbage collection.
frame, prev_frame);
})
switch (get_itbl(frame)->type) {
- case UPDATE_FRAME: upd_frames++;
- if (frame->updatee->header.info == &stg_BLACKHOLE_info)
- bhs++;
- break;
- case STOP_FRAME: stop_frames++;
- break;
- case CATCH_FRAME: catch_frames++;
- break;
- case SEQ_FRAME: seq_frames++;
- break;
+ case UPDATE_FRAME:
+ upd_frames++;
+ if (frame->updatee->header.info == &stg_BLACKHOLE_info)
+ bhs++;
+ break;
+ case STOP_FRAME:
+ stop_frames++;
+ break;
+ case CATCH_FRAME:
+ catch_frames++;
+ break;
+ case SEQ_FRAME:
+ seq_frames++;
+ break;
default:
barf("Found non-frame during stack squeezing at %p (prev frame was %p)\n",
frame, prev_frame);
/* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.14 2001/01/28 20:53:38 qrczak Exp $
+ * $Id: Linker.c,v 1.15 2001/01/29 17:23:41 simonmar Exp $
*
* (c) The GHC Team, 2000
*
SymX(stg_WEAK_info) \
SymX(stg_CHARLIKE_closure) \
SymX(stg_INTLIKE_closure) \
- SymX(stg_CAF_UNENTERED_entry) \
SymX(newCAF) \
SymX(newBCOzh_fast) \
SymX(mkApUpd0zh_fast) \
/* -----------------------------------------------------------------------------
- * $Id: Printer.c,v 1.33 2001/01/15 16:55:25 sewardj Exp $
+ * $Id: Printer.c,v 1.34 2001/01/29 17:23:41 simonmar Exp $
*
* (c) The GHC Team, 1994-2000.
*
fprintf(stderr,")\n");
break;
- case CAF_UNENTERED:
- {
- StgCAF* caf = stgCast(StgCAF*,obj);
- fprintf(stderr,"CAF_UNENTERED(");
- printPtr((StgPtr)caf->body);
- fprintf(stderr,", ");
- printPtr((StgPtr)caf->value); /* should be null */
- fprintf(stderr,", ");
- printPtr((StgPtr)caf->link);
- fprintf(stderr,")\n");
- break;
- }
-
- case CAF_ENTERED:
- {
- StgCAF* caf = stgCast(StgCAF*,obj);
- fprintf(stderr,"CAF_ENTERED(");
- printPtr((StgPtr)caf->body);
- fprintf(stderr,", ");
- printPtr((StgPtr)caf->value);
- fprintf(stderr,", ");
- printPtr((StgPtr)caf->link);
- fprintf(stderr,")\n");
- break;
- }
-
case CAF_BLACKHOLE:
fprintf(stderr,"CAF_BH(");
printPtr((StgPtr)stgCast(StgBlockingQueue*,obj)->blocking_queue);
"IND_PERM", /* 31 */
"IND_OLDGEN_PERM", /* 32 */
"IND_STATIC", /* 33 */
- "CAF_UNENTERED", /* 34 */
- "CAF_ENTERED", /* 35 */
"CAF_BLACKHOLE", /* 36 */
"RET_BCO", /* 37 */
"RET_SMALL", /* 38 */
/* -----------------------------------------------------------------------------
- * $Id: Sanity.c,v 1.24 2000/12/11 12:37:00 simonmar Exp $
+ * $Id: Sanity.c,v 1.25 2001/01/29 17:23:41 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
case IND_PERM:
case IND_OLDGEN:
case IND_OLDGEN_PERM:
- case CAF_UNENTERED:
- case CAF_ENTERED:
- case CAF_BLACKHOLE:
#ifdef TICKY_TICKY
- case SE_CAF_BLACKHOLE:
case SE_BLACKHOLE:
+ case SE_CAF_BLACKHOLE:
#endif
case BLACKHOLE:
+ case CAF_BLACKHOLE:
case FOREIGN:
case BCO:
case STABLE_NAME:
/* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.60 2001/01/16 12:44:34 sewardj Exp $
+ * $Id: StgMiscClosures.hc,v 1.61 2001/01/29 17:23:41 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
VEC_POLY_INFO_TABLE(stg_ctoi_ret_D1,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
-
/* The other way round: when the interpreter returns a value to
compiled code. The stack looks like this:
}
/* -----------------------------------------------------------------------------
- Entry code for CAFs
-
- This code assumes R1 is in a register for now.
- -------------------------------------------------------------------------- */
-
-INFO_TABLE(stg_CAF_UNENTERED_info,stg_CAF_UNENTERED_entry,1,3,CAF_UNENTERED,,EF_,0,0);
-STGFUN(stg_CAF_UNENTERED_entry)
-{
- FB_
- /* ToDo: implement directly in GHC */
- Sp -= 1;
- Sp[0] = R1.w;
- JMP_(stg_yield_to_interpreter);
- FE_
-}
-
-/* 0,4 is entirely bogus; _do not_ rely on this info */
-INFO_TABLE(stg_CAF_ENTERED_info,stg_CAF_ENTERED_entry,0,4,CAF_ENTERED,,EF_,0,0);
-STGFUN(stg_CAF_ENTERED_entry)
-{
- FB_
- R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */
- TICK_ENT_VIA_NODE();
- JMP_(GET_ENTRY(R1.cl));
- FE_
-}
-
-/* -----------------------------------------------------------------------------
Entry code for a black hole.
Entering a black hole normally causes a cyclic data dependency, but
CurrentTSO->block_info.closure = R1.cl;
/* closure is mutable since something has just been added to its BQ */
recordMutable((StgMutClosure *)R1.cl);
- /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ */
+ /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ_STATIC */
((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info;
/* PAR: dumping of event now done in blockThread -- HWL */
}
#else
INFO_TABLE_SRT_BITMAP(stg_forceIO_ret_info,stg_forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
-STGFUN(forceIO_ret_entry)
+STGFUN(stg_forceIO_ret_entry)
{
StgClosure *rval;
FB_
/* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.33 2001/01/24 15:46:19 simonmar Exp $
+ * $Id: Storage.c,v 1.34 2001/01/29 17:23:41 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
/* -----------------------------------------------------------------------------
CAF management.
+
+ The entry code for every CAF does the following:
+
+ - builds a CAF_BLACKHOLE in the heap
+ - pushes an update frame pointing to the CAF_BLACKHOLE
+ - invokes UPD_CAF(), which:
+ - calls newCaf, below
+ - updates the CAF with a static indirection to the CAF_BLACKHOLE
+
+ Why do we build a BLACKHOLE in the heap rather than just updating
+ the thunk directly? It's so that we only need one kind of update
+ frame - otherwise we'd need a static version of the update frame too.
+
+ newCaf() does the following:
+
+ - it puts the CAF on the oldest generation's mut-once list.
+ This is so that we can treat the CAF as a root when collecting
+ younger generations.
+
+ For GHCI, we have additional requirements when dealing with CAFs:
+
+ - we must *retain* all dynamically-loaded CAFs ever entered,
+ just in case we need them again.
+ - we must be able to *revert* CAFs that have been evaluated, to
+ their pre-evaluated form.
+
+ To do this, we use an additional CAF list. When newCaf() is
+ called on a dynamically-loaded CAF, we add it to the CAF list
+ instead of the old-generation mutable list, and save away its
+ old info pointer (in caf->saved_info) for later reversion.
+
+ To revert all the CAFs, we traverse the CAF list and reset the
+ info pointer to caf->saved_info, then throw away the CAF list.
+ (see GC.c:revertCAFs()).
+
+ -- SDM 29/1/01
+
-------------------------------------------------------------------------- */
void
*/
ACQUIRE_LOCK(&sm_mutex);
- ASSERT( ((StgMutClosure*)caf)->mut_link == NULL );
- ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
- oldest_gen->mut_once_list = (StgMutClosure *)caf;
-
#ifdef GHCI
- /* For dynamically-loaded code, we retain all the CAFs. There is no
- * way of knowing which ones we'll need in the future.
- */
if (is_dynamically_loaded_rwdata_ptr((StgPtr)caf)) {
- caf->payload[2] = caf_list; /* IND_STATIC_LINK2() */
+ ((StgIndStatic *)caf)->saved_info = (StgInfoTable *)caf->header.info;
+ ((StgIndStatic *)caf)->static_link = caf_list;
caf_list = caf;
+ } else {
+ ((StgIndStatic *)caf)->saved_info = NULL;
+ ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
+ oldest_gen->mut_once_list = (StgMutClosure *)caf;
}
-#endif
-
-#ifdef INTERPRETER
- /* If we're Hugs, we also have to put it in the CAF table, so that
- the CAF can be reverted. When reverting, CAFs created by compiled
- code are recorded in the CAF table, which lives outside the
- heap, in mallocville. CAFs created by interpreted code are
- chained together via the link fields in StgCAFs, and are not
- recorded in the CAF table.
- */
- ASSERT( get_itbl(caf)->type == THUNK_STATIC );
- addToECafTable ( caf, get_itbl(caf) );
+#else
+ ASSERT( ((StgMutClosure*)caf)->mut_link == NULL );
+ ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
+ oldest_gen->mut_once_list = (StgMutClosure *)caf;
#endif
RELEASE_LOCK(&sm_mutex);
}
#endif /* GHCI */
-#ifdef INTERPRETER
-void
-newCAF_made_by_Hugs(StgCAF* caf)
-{
- ACQUIRE_LOCK(&sm_mutex);
-
- ASSERT( get_itbl(caf)->type == CAF_ENTERED );
- recordOldToNewPtrs((StgMutClosure*)caf);
- caf->link = ecafList;
- ecafList = caf->link;
-
- RELEASE_LOCK(&sm_mutex);
-}
-#endif
-
-#ifdef INTERPRETER
-/* These initialisations are critical for correct operation
- on the first call of addToECafTable.
-*/
-StgCAF* ecafList = END_ECAF_LIST;
-StgCAFTabEntry* ecafTable = NULL;
-StgInt usedECafTable = 0;
-StgInt sizeECafTable = 0;
-
-
-void clearECafTable ( void )
-{
- usedECafTable = 0;
-}
-
-void addToECafTable ( StgClosure* closure, StgInfoTable* origItbl )
-{
- StgInt i;
- StgCAFTabEntry* et2;
- if (usedECafTable == sizeECafTable) {
- /* Make the initial table size be 8 */
- sizeECafTable *= 2;
- if (sizeECafTable == 0) sizeECafTable = 8;
- et2 = stgMallocBytes (
- sizeECafTable * sizeof(StgCAFTabEntry),
- "addToECafTable" );
- for (i = 0; i < usedECafTable; i++)
- et2[i] = ecafTable[i];
- if (ecafTable) free(ecafTable);
- ecafTable = et2;
- }
- ecafTable[usedECafTable].closure = closure;
- ecafTable[usedECafTable].origItbl = origItbl;
- usedECafTable++;
-}
-#endif
-
/* -----------------------------------------------------------------------------
Nursery management.
-------------------------------------------------------------------------- */
/* -----------------------------------------------------------------------------
- * $Id: Storage.h,v 1.24 2001/01/26 14:36:40 simonpj Exp $
+ * $Id: Storage.h,v 1.25 2001/01/29 17:23:41 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
static __inline__ StgOffset BLACKHOLE_sizeW ( void )
{ return sizeofW(StgHeader) + MIN_UPD_SIZE; }
-static __inline__ StgOffset CAF_sizeW ( void )
-{ return sizeofW(StgCAF); }
-
/* --------------------------------------------------------------------------
* Sizes of closures
* ------------------------------------------------------------------------*/
projects / ghc-hetmet.git / commitdiff