From ee3e75b51e5a86dda79bb990a83bfaa49915a22a Mon Sep 17 00:00:00 2001 From: simonmar Date: Mon, 29 Jan 2001 17:23:41 +0000 Subject: [PATCH] [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. --- ghc/includes/ClosureTypes.h | 26 +++--- ghc/includes/Closures.h | 19 ++--- ghc/includes/StgMiscClosures.h | 6 +- ghc/includes/Updates.h | 17 +++- ghc/rts/ClosureFlags.c | 134 +++++++++++++++---------------- ghc/rts/GC.c | 174 ++++++++++++++-------------------------- ghc/rts/Linker.c | 3 +- ghc/rts/Printer.c | 30 +------ ghc/rts/Sanity.c | 8 +- ghc/rts/StgMiscClosures.hc | 35 +------- ghc/rts/Storage.c | 121 +++++++++++----------------- ghc/rts/Storage.h | 5 +- 12 files changed, 220 insertions(+), 358 deletions(-) diff --git a/ghc/includes/ClosureTypes.h b/ghc/includes/ClosureTypes.h index 0fea250..d9f092d 100644 --- a/ghc/includes/ClosureTypes.h +++ b/ghc/includes/ClosureTypes.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $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 diff --git a/ghc/includes/Closures.h b/ghc/includes/Closures.h index 2c38541..c4fcce9 100644 --- a/ghc/includes/Closures.h +++ b/ghc/includes/Closures.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $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; diff --git a/ghc/includes/StgMiscClosures.h b/ghc/includes/StgMiscClosures.h index e92f4fe..385d111 100644 --- a/ghc/includes/StgMiscClosures.h +++ b/ghc/includes/StgMiscClosures.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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; diff --git a/ghc/includes/Updates.h b/ghc/includes/Updates.h index 77a18d1..9c17466 100644 --- a/ghc/includes/Updates.h +++ b/ghc/includes/Updates.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 */ /* ------------------------------------------------------------------------- diff --git a/ghc/rts/ClosureFlags.c b/ghc/rts/ClosureFlags.c index 89e98e4..492eb39 100644 --- a/ghc/rts/ClosureFlags.c +++ b/ghc/rts/ClosureFlags.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 ) }; diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index f4493ca..073dc2c 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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); diff --git a/ghc/rts/Linker.c b/ghc/rts/Linker.c index 07924a0..bbfdc37 100644 --- a/ghc/rts/Linker.c +++ b/ghc/rts/Linker.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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) \ diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c index 389dd80..b163389 100644 --- a/ghc/rts/Printer.c +++ b/ghc/rts/Printer.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 */ diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c index cf0a8fd..bd5d96a 100644 --- a/ghc/rts/Sanity.c +++ b/ghc/rts/Sanity.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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: diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc index 27e881b..23a0caf 100644 --- a/ghc/rts/StgMiscClosures.hc +++ b/ghc/rts/StgMiscClosures.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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: @@ -370,34 +369,6 @@ STGFUN(stg_IND_OLDGEN_PERM_entry) } /* ----------------------------------------------------------------------------- - 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 @@ -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_ diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c index 1119519..caca81c 100644 --- a/ghc/rts/Storage.c +++ b/ghc/rts/Storage.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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) */ 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); @@ -253,58 +280,6 @@ markCafs( void ) } #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. -------------------------------------------------------------------------- */ diff --git a/ghc/rts/Storage.h b/ghc/rts/Storage.h index e32e9ad..b834df4 100644 --- a/ghc/rts/Storage.h +++ b/ghc/rts/Storage.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -534,9 +534,6 @@ static __inline__ StgOffset THUNK_SELECTOR_sizeW ( void ) static __inline__ StgOffset BLACKHOLE_sizeW ( void ) { return sizeofW(StgHeader) + MIN_UPD_SIZE; } -static __inline__ StgOffset CAF_sizeW ( void ) -{ return sizeofW(StgCAF); } - /* -------------------------------------------------------------------------- * Sizes of closures * ------------------------------------------------------------------------*/ -- 1.7.10.4