Commit ee3e75b5 authored by simonmar's avatar simonmar

[project @ 2001-01-29 17:23:40 by simonmar]

Remove the old Hugs CAF code, install our own (minimal, somewhat
cryptic, but better commented) CAF reversion story.  See
Storage.c:newCaf() for the details.
parent 489aed06
/* ----------------------------------------------------------------------------
* $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
*
......@@ -47,19 +47,17 @@
#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
*
......@@ -186,18 +186,13 @@ typedef struct {
} 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
*
......@@ -21,8 +21,8 @@ STGFUN(stg_IND_OLDGEN_entry);
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);
......@@ -97,8 +97,8 @@ extern DLL_IMPORT_RTS const StgInfoTable stg_IND_OLDGEN_info;
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
*
......@@ -61,6 +61,16 @@
}
#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) \
{ \
......@@ -160,6 +170,11 @@ extern void awakenBlockedQueue(StgTSO *q);
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
*
......@@ -26,73 +26,69 @@ StgWord16 closure_flags[] = {
/* 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
*
......@@ -164,6 +164,11 @@ static void scavenge_mut_once_list ( generation *g );
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
......@@ -385,6 +390,10 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc )
}
}
#ifdef GHCI
scavengeCAFs();
#endif
/* follow all the roots that the application knows about.
*/
evac_gen = 0;
......@@ -773,8 +782,8 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc )
/* 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
......@@ -1392,8 +1401,6 @@ loop:
case CONSTR:
case IND_PERM:
case IND_OLDGEN_PERM:
case CAF_UNENTERED:
case CAF_ENTERED:
case WEAK:
case FOREIGN:
case STABLE_NAME:
......@@ -1466,10 +1473,6 @@ loop:
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;
......@@ -1484,7 +1487,6 @@ loop:
case THUNK_STATIC:
case THUNK_SELECTOR:
/* aargh - do recursively???? */
case CAF_UNENTERED:
case CAF_BLACKHOLE:
case SE_CAF_BLACKHOLE:
case SE_BLACKHOLE:
......@@ -1523,9 +1525,17 @@ loop:
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;
......@@ -1979,37 +1989,6 @@ scavenge(step *stp)
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) {
......@@ -2273,7 +2252,6 @@ scavenge_one(StgClosure *p)
case FOREIGN:
case IND_PERM:
case IND_OLDGEN_PERM:
case CAF_UNENTERED:
{
StgPtr q, end;
......@@ -2434,35 +2412,6 @@ scavenge_mut_once_list(generation *gen)
}
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));
......@@ -3057,7 +3006,6 @@ zero_static_object_list(StgClosure* first_static)
* 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 )
......@@ -3070,43 +3018,37 @@ 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.
......@@ -3288,16 +3230,20 @@ threadSqueezeStack(StgTSO *tso)
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
*
......@@ -151,7 +151,6 @@ static int ocResolve_PEi386 ( ObjectCode* oc );
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.
*
......@@ -145,32 +145,6 @@ void printClosure( StgClosure *obj )
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);
......@@ -563,8 +537,6 @@ static char *closure_type_names[] = {
"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
*
......@@ -282,14 +282,12 @@ checkClosure( StgClosure* p )
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
*
......@@ -228,7 +228,6 @@ STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_7_entry);
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:
......@@ -369,34 +368,6 @@ STGFUN(stg_IND_OLDGEN_PERM_entry)
FE_
}
/* -----------------------------------------------------------------------------
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.
......@@ -592,7 +563,7 @@ STGFUN(stg_CAF_BLACKHOLE_entry)
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 */
......@@ -843,7 +814,7 @@ STGFUN(stg_forceIO_ret_entry)
}
#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
*
......@@ -198,6 +198,43 @@ exitStorage (void)
/* -----------------------------------------------------------------------------
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
......@@ -212,30 +249,20 @@ newCAF(StgClosure* caf)
*/