From 0671ef05dd65137d501cb97f0e42be3b78d4004d Mon Sep 17 00:00:00 2001 From: simonmar Date: Thu, 8 Nov 2001 12:46:31 +0000 Subject: [PATCH] [project @ 2001-11-08 12:46:31 by simonmar] Fix the large block allocation bug (Yay!) ----------------------------------------- In order to do this, I had to 1. in each heap-check failure branch, return the amount of heap actually requested, in a known location (I added another slot in StgRegTable called HpAlloc for this purpose). This is useful for other reasons - in particular it makes it possible to get accurate allocation statistics. 2. In the scheduler, if a heap check fails and we wanted more than BLOCK_SIZE_W words, then allocate a special large block and place it in the nursery. The nursery now has to be double-linked so we can insert the new block in the middle. 3. The garbage collector has to be able to deal with multiple objects in a large block. It turns out that this isn't a problem as long as the large blocks only occur in the nursery, because we always copy objects from the nursery during GC. One small change had to be made: in evacuate(), we may need to follow the link field from the block descriptor to get to the block descriptor for the head of a large block. 4. Various other parts of the storage manager had to be modified to cope with a nursery containing a mixture of block sizes. Point (3) causes a slight pessimization in the garbage collector. I don't see a way to avoid this. Point (1) causes some code bloat (a rough measurement is around 5%), so to offset this I made the following change which I'd been meaning to do for some time: - Store the values of some commonly-used absolute addresses (eg. stg_update_PAP) in the register table. This lets us use shorter instruction forms for some absolute jumps and saves some code space. - The type of Capability is no longer the same as an StgRegTable. MainRegTable renamed to MainCapability. See Regs.h for details. Other minor changes: - remove individual declarations for the heap-check-failure jump points, and declare them all in StgMiscClosures.h instead. Remove HeapStackCheck.h. Updates to the native code generator to follow. --- ghc/includes/Regs.h | 81 +++++++++++++++++++++++--- ghc/includes/StgMacros.h | 34 +++++------ ghc/includes/StgMiscClosures.h | 59 ++++++++++++++++++- ghc/includes/StgStorage.h | 4 +- ghc/includes/Updates.h | 6 +- ghc/includes/mkNativeHdr.c | 19 ++++++- ghc/rts/GC.c | 10 +++- ghc/rts/HeapStackCheck.h | 64 --------------------- ghc/rts/HeapStackCheck.hc | 15 ++--- ghc/rts/Interpreter.c | 38 ++++++------- ghc/rts/Linker.c | 32 +++++------ ghc/rts/PrimOps.hc | 3 +- ghc/rts/RtsStartup.c | 8 +-- ghc/rts/Schedule.c | 123 +++++++++++++++++++++++++++++----------- ghc/rts/Schedule.h | 9 +-- ghc/rts/StgMiscClosures.hc | 3 +- ghc/rts/StgStdThunks.hc | 7 +-- ghc/rts/Storage.c | 72 +++++++++++++---------- ghc/rts/StoragePriv.h | 4 +- ghc/rts/Updates.hc | 5 +- 20 files changed, 373 insertions(+), 223 deletions(-) delete mode 100644 ghc/rts/HeapStackCheck.h diff --git a/ghc/includes/Regs.h b/ghc/includes/Regs.h index 4c2f911..001e2ca 100644 --- a/ghc/includes/Regs.h +++ b/ghc/includes/Regs.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Regs.h,v 1.9 2000/03/23 17:45:31 simonpj Exp $ + * $Id: Regs.h,v 1.10 2001/11/08 12:46:31 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -32,6 +32,13 @@ typedef struct StgSparkPool_ { StgClosure **tl; } StgSparkPool; +typedef struct { + StgFunPtr stgChk0; + StgFunPtr stgChk1; + StgFunPtr stgGCEnter1; + StgFunPtr stgUpdatePAP; +} StgFunTable; + typedef struct StgRegTable_ { StgUnion rR1; StgUnion rR2; @@ -41,8 +48,8 @@ typedef struct StgRegTable_ { StgUnion rR6; StgUnion rR7; StgUnion rR8; - StgUnion rR9; /* used occasionally by heap/stack checks */ - StgUnion rR10; /* used occasionally by heap/stack checks */ + StgUnion rR9; // used occasionally by heap/stack checks + StgUnion rR10; // used occasionally by heap/stack checks StgFloat rF1; StgFloat rF2; StgFloat rF3; @@ -58,19 +65,31 @@ typedef struct StgRegTable_ { StgTSO *rCurrentTSO; struct _bdescr *rNursery; struct _bdescr *rCurrentNursery; + StgWord rHpAlloc; // number of words being allocated in heap #if defined(SMP) || defined(PAR) - StgSparkPool rSparks; /* per-task spark pool */ + StgSparkPool rSparks; // per-task spark pool #endif #if defined(SMP) - struct StgRegTable_ *link; /* per-task register tables are linked together */ + struct StgRegTable_ *link; // per-task register tables are linked together #endif } StgRegTable; + +/* A capability is a combination of a FunTable and a RegTable. In STG + * code, BaseReg normally points to the RegTable portion of this + * structure, so that we can index both forwards and backwards to take + * advantage of shorter instruction forms on some archs (eg. x86). + */ +typedef struct { + StgFunTable f; + StgRegTable r; +} Capability; + /* No such thing as a MainRegTable under SMP - each thread must * have its own MainRegTable. */ #ifndef SMP -extern DLL_IMPORT_RTS StgRegTable MainRegTable; +extern DLL_IMPORT_RTS Capability MainCapability; #endif #if IN_STG_CODE @@ -113,6 +132,7 @@ extern DLL_IMPORT_RTS StgRegTable MainRegTable; #define SAVE_CurrentTSO (BaseReg->rCurrentTSO) #define SAVE_CurrentNursery (BaseReg->rCurrentNursery) +#define SAVE_HpAlloc (BaseReg->rHpAlloc) #if defined(SMP) || defined(PAR) #define SAVE_SparkHd (BaseReg->rSparks.hd) #define SAVE_SparkTl (BaseReg->rSparks.tl) @@ -275,7 +295,7 @@ GLOBAL_REG_DECL(StgRegTable *,BaseReg,REG_Base) #ifdef SMP #error BaseReg must be in a register for SMP #endif -#define BaseReg (&MainRegTable) +#define BaseReg (&MainCapability.r) #endif #ifdef REG_Sp @@ -320,6 +340,12 @@ GLOBAL_REG_DECL(bdescr *,CurrentNursery,REG_CurrentNursery) #define CurrentNursery (BaseReg->rCurrentNursery) #endif +#ifdef REG_HpAlloc +GLOBAL_REG_DECL(bdescr *,HpAlloc,REG_HpAlloc) +#else +#define HpAlloc (BaseReg->rHpAlloc) +#endif + #ifdef REG_SparkHd GLOBAL_REG_DECL(bdescr *,SparkHd,REG_SparkHd) #else @@ -345,6 +371,39 @@ GLOBAL_REG_DECL(bdescr *,SparkLim,REG_SparkLim) #endif /* ----------------------------------------------------------------------------- + Get absolute function pointers from the register table, to save + code space. On x86, + + jmp *-12(%ebx) + + is shorter than + + jmp absolute_address + + as long as the offset is within the range of a signed byte + (-128..+127). So we pick some common absolute_addresses and put + them in the register table. As a bonus, linking time should also + be reduced. + + Other possible candidates in order of importance: + + stg_upd_frame_info + stg_CAF_BLACKHOLE_info + stg_IND_STATIC_info + + anything else probably isn't worth the effort. + + -------------------------------------------------------------------------- */ + + +#define FunReg ((StgFunTable *)((void *)BaseReg - sizeof(StgFunTable))) + +#define stg_chk_0 (FunReg->stgChk0) +#define stg_chk_1 (FunReg->stgChk1) +#define stg_gc_enter_1 (FunReg->stgGCEnter1) +#define stg_update_PAP (FunReg->stgUpdatePAP) + +/* ----------------------------------------------------------------------------- For any registers which are denoted "caller-saves" by the C calling convention, we have to emit code to save and restore them across C calls. @@ -553,6 +612,14 @@ GLOBAL_REG_DECL(bdescr *,SparkLim,REG_SparkLim) #define CALLER_RESTORE_CurrentNursery /* nothing */ #endif +#ifdef CALLER_SAVES_HpAlloc +#define CALLER_SAVE_HpAlloc SAVE_HpAlloc = HpAlloc; +#define CALLER_RESTORE_HpAlloc HpAlloc = SAVE_HpAlloc; +#else +#define CALLER_SAVE_HpAlloc /* nothing */ +#define CALLER_RESTORE_HpAlloc /* nothing */ +#endif + #ifdef CALLER_SAVES_SparkHd #define CALLER_SAVE_SparkHd SAVE_SparkHd = SparkHd; #define CALLER_RESTORE_SparkHd SparkHd = SAVE_SparkHd; diff --git a/ghc/includes/StgMacros.h b/ghc/includes/StgMacros.h index 9a01309..6f35a55 100644 --- a/ghc/includes/StgMacros.h +++ b/ghc/includes/StgMacros.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: StgMacros.h,v 1.38 2001/07/24 06:31:35 ken Exp $ + * $Id: StgMacros.h,v 1.39 2001/11/08 12:46:31 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -132,7 +132,6 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define STK_CHK(headroom,ret,r,layout,tag_assts) \ if (Sp - headroom < SpLim) { \ - EXTFUN_RTS(stg_chk_##layout); \ tag_assts \ (r) = (P_)ret; \ JMP_(stg_chk_##layout); \ @@ -141,7 +140,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define HP_CHK(headroom,ret,r,layout,tag_assts) \ DO_GRAN_ALLOCATE(headroom) \ if ((Hp += headroom) > HpLim) { \ - EXTFUN_RTS(stg_chk_##layout); \ + HpAlloc = (headroom); \ tag_assts \ (r) = (P_)ret; \ JMP_(stg_chk_##layout); \ @@ -150,7 +149,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define HP_STK_CHK(stk_headroom,hp_headroom,ret,r,layout,tag_assts) \ DO_GRAN_ALLOCATE(hp_headroom) \ if (Sp - stk_headroom < SpLim || (Hp += hp_headroom) > HpLim) { \ - EXTFUN_RTS(stg_chk_##layout); \ + HpAlloc = (hp_headroom); \ tag_assts \ (r) = (P_)ret; \ JMP_(stg_chk_##layout); \ @@ -177,7 +176,6 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define STK_CHK_NP(headroom,ptrs,tag_assts) \ if ((Sp - (headroom)) < SpLim) { \ - EXTFUN_RTS(stg_gc_enter_##ptrs); \ tag_assts \ JMP_(stg_gc_enter_##ptrs); \ } @@ -185,7 +183,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define HP_CHK_NP(headroom,ptrs,tag_assts) \ DO_GRAN_ALLOCATE(headroom) \ if ((Hp += (headroom)) > HpLim) { \ - EXTFUN_RTS(stg_gc_enter_##ptrs); \ + HpAlloc = (headroom); \ tag_assts \ JMP_(stg_gc_enter_##ptrs); \ } @@ -193,7 +191,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define HP_CHK_SEQ_NP(headroom,ptrs,tag_assts) \ DO_GRAN_ALLOCATE(headroom) \ if ((Hp += (headroom)) > HpLim) { \ - EXTFUN_RTS(stg_gc_seq_##ptrs); \ + HpAlloc = (headroom); \ tag_assts \ JMP_(stg_gc_seq_##ptrs); \ } @@ -201,7 +199,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define HP_STK_CHK_NP(stk_headroom, hp_headroom, ptrs, tag_assts) \ DO_GRAN_ALLOCATE(hp_headroom) \ if ((Sp - (stk_headroom)) < SpLim || (Hp += (hp_headroom)) > HpLim) { \ - EXTFUN_RTS(stg_gc_enter_##ptrs); \ + HpAlloc = (hp_headroom); \ tag_assts \ JMP_(stg_gc_enter_##ptrs); \ } @@ -213,6 +211,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } DO_GRAN_ALLOCATE(headroom) \ if ((Hp += (headroom)) > HpLim) { \ EXTFUN_RTS(lbl); \ + HpAlloc = (headroom); \ tag_assts \ JMP_(lbl); \ } @@ -294,7 +293,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define HP_CHK_GEN(headroom,liveness,reentry,tag_assts) \ if ((Hp += (headroom)) > HpLim ) { \ - EXTFUN_RTS(stg_gen_chk); \ + HpAlloc = (headroom); \ tag_assts \ R9.w = (W_)LIVENESS_MASK(liveness); \ R10.w = (W_)reentry; \ @@ -307,7 +306,6 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define STK_CHK_GEN(headroom,liveness,reentry,tag_assts) \ if ((Sp - (headroom)) < SpLim) { \ - EXTFUN_RTS(stg_gen_chk); \ tag_assts \ R9.w = (W_)LIVENESS_MASK(liveness); \ R10.w = (W_)reentry; \ @@ -316,7 +314,6 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define MAYBE_GC(liveness,reentry) \ if (doYouWantToGC()) { \ - EXTFUN_RTS(stg_gen_hp); \ R9.w = (W_)LIVENESS_MASK(liveness); \ R10.w = (W_)reentry; \ JMP_(stg_gen_hp); \ @@ -787,17 +784,20 @@ LoadThreadState (void) * Suspending/resuming threads for doing external C-calls (_ccall_GC). * These functions are defined in rts/Schedule.c. */ -StgInt suspendThread ( StgRegTable *cap ); -StgRegTable * resumeThread ( StgInt ); +StgInt suspendThread ( Capability *cap ); +Capability * resumeThread ( StgInt ); #define SUSPEND_THREAD(token) \ SaveThreadState(); \ - token = suspendThread(BaseReg); + token = suspendThread((Capability *)((void *)BaseReg - sizeof(StgFunTable))); #ifdef SMP -#define RESUME_THREAD(token) \ - BaseReg = resumeThread(token); \ - LoadThreadState(); +#define RESUME_THREAD(token) \ + { Capability c; \ + c = resumeThread(token); \ + BaseReg = &c.r; \ + LoadThreadState(); \ + } #else #define RESUME_THREAD(token) \ (void)resumeThread(token); \ diff --git a/ghc/includes/StgMiscClosures.h b/ghc/includes/StgMiscClosures.h index eeaaf3a..a4281c8 100644 --- a/ghc/includes/StgMiscClosures.h +++ b/ghc/includes/StgMiscClosures.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: StgMiscClosures.h,v 1.39 2001/07/09 19:45:16 sof Exp $ + * $Id: StgMiscClosures.h,v 1.40 2001/11/08 12:46:31 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -238,3 +238,60 @@ EXTINFO_RTS stg_ap_6_upd_info; EXTINFO_RTS stg_ap_7_upd_info; EXTINFO_RTS stg_ap_8_upd_info; +/* standard GC & stack check entry points */ + +EXTFUN(stg_gc_entertop); +EXTFUN(stg_gc_enter_1_hponly); +EXTFUN(__stg_gc_enter_1); +EXTFUN(stg_gc_enter_2); +EXTFUN(stg_gc_enter_3); +EXTFUN(stg_gc_enter_4); +EXTFUN(stg_gc_enter_5); +EXTFUN(stg_gc_enter_6); +EXTFUN(stg_gc_enter_7); +EXTFUN(stg_gc_enter_8); +EXTFUN(stg_gc_seq_1); + +EI_(stg_gc_noregs_ret_info); +EF_(stg_gc_noregs); + +EI_(stg_gc_unpt_r1_ret_info); +EF_(stg_gc_unpt_r1); + +EI_(stg_gc_unbx_r1_ret_info); +EF_(stg_gc_unbx_r1); + +EI_(stg_gc_f1_ret_info); +EF_(stg_gc_f1); + +EI_(stg_gc_d1_ret_info); +EF_(stg_gc_d1); + +EI_(stg_gc_ut_1_0_ret_info); +EF_(stg_gc_ut_1_0); + +EI_(stg_gc_ut_0_1_ret_info); +EF_(stg_gc_ut_0_1); + +EXTFUN(__stg_chk_0); +EXTFUN(__stg_chk_1); +EXTFUN(stg_chk_1n); +EXTFUN(stg_chk_2); +EXTFUN(stg_chk_3); +EXTFUN(stg_chk_4); +EXTFUN(stg_chk_5); +EXTFUN(stg_chk_6); +EXTFUN(stg_chk_7); +EXTFUN(stg_chk_8); +EXTFUN(stg_gen_chk_ret); +EXTFUN(stg_gen_chk); +EXTFUN(stg_gen_hp); +EXTFUN(stg_gen_yield); +EXTFUN(stg_yield_noregs); +EXTFUN(stg_yield_to_interpreter); +EXTFUN(stg_gen_block); +EXTFUN(stg_block_noregs); +EXTFUN(stg_block_1); +EXTFUN(stg_block_takemvar); +EXTFUN(stg_block_putmvar); + diff --git a/ghc/includes/StgStorage.h b/ghc/includes/StgStorage.h index 3af566d..11cca70 100644 --- a/ghc/includes/StgStorage.h +++ b/ghc/includes/StgStorage.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: StgStorage.h,v 1.10 2001/07/24 16:36:44 simonmar Exp $ + * $Id: StgStorage.h,v 1.11 2001/11/08 12:46:31 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -104,7 +104,7 @@ typedef struct _generation { #define OpenNursery(hp,hplim) \ (hp = CurrentNursery->free-1, \ - hplim = CurrentNursery->start + BLOCK_SIZE_W - 1) + hplim = CurrentNursery->start + CurrentNursery->blocks*BLOCK_SIZE_W - 1) #define CloseNursery(hp) (CurrentNursery->free = (P_)(hp)+1) diff --git a/ghc/includes/Updates.h b/ghc/includes/Updates.h index b29fcc2..d203324 100644 --- a/ghc/includes/Updates.h +++ b/ghc/includes/Updates.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Updates.h,v 1.24 2001/03/22 03:51:09 hwloidl Exp $ + * $Id: Updates.h,v 1.25 2001/11/08 12:46:31 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -239,13 +239,13 @@ extern void newCAF(StgClosure*); Update-related prototypes -------------------------------------------------------------------------- */ +EXTFUN_RTS(__stg_update_PAP); + DLL_IMPORT_RTS extern STGFUN(stg_upd_frame_entry); extern DLL_IMPORT_RTS const StgInfoTable stg_PAP_info; DLL_IMPORT_RTS STGFUN(stg_PAP_entry); -EXTFUN_RTS(stg_update_PAP); - extern DLL_IMPORT_RTS const StgInfoTable stg_AP_UPD_info; DLL_IMPORT_RTS STGFUN(stg_AP_UPD_entry); diff --git a/ghc/includes/mkNativeHdr.c b/ghc/includes/mkNativeHdr.c index 282864d..7b2bebd 100644 --- a/ghc/includes/mkNativeHdr.c +++ b/ghc/includes/mkNativeHdr.c @@ -1,5 +1,5 @@ /* -------------------------------------------------------------------------- - * $Id: mkNativeHdr.c,v 1.5 2000/08/17 14:30:26 simonmar Exp $ + * $Id: mkNativeHdr.c,v 1.6 2001/11/08 12:46:31 simonmar Exp $ * * (c) The GHC Team, 1992-1998 * @@ -35,6 +35,14 @@ #define OFFSET_HpLim OFFSET(RegTable, RegTable.rHpLim) #define OFFSET_CurrentTSO OFFSET(RegTable, RegTable.rCurrentTSO) #define OFFSET_CurrentNursery OFFSET(RegTable, RegTable.rCurrentNursery) +#define OFFSET_HpAlloc OFFSET(RegTable, RegTable.rHpAlloc) + +#define FUN_OFFSET(sym) ((StgPtr)&cap.f.sym - (StgPtr)&cap.r) + +#define OFFSET_stgChk0 FUN_OFFSET(stgChk0) +#define OFFSET_stgChk1 FUN_OFFSET(stgChk1) +#define OFFSET_stgGCEnter1 FUN_OFFSET(stgGCEnter1) +#define OFFSET_stgUpdatePAP FUN_OFFSET(stgUpdatePAP) #define TSO_SP OFFSET(tso, tso.sp) #define TSO_SU OFFSET(tso, tso.su) @@ -44,6 +52,9 @@ #define BDESCR_FREE OFFSET(bd, bd.free) StgRegTable RegTable; + +Capability cap; + StgTSO tso; bdescr bd; @@ -80,6 +91,12 @@ main() printf("#define OFFSET_HpLim %d\n", OFFSET_HpLim); printf("#define OFFSET_CurrentTSO %d\n", OFFSET_CurrentTSO); printf("#define OFFSET_CurrentNursery %d\n", OFFSET_CurrentNursery); + printf("#define OFFSET_HpAlloc %d\n", OFFSET_HpAlloc); + + printf("#define OFFSET_stgChk0 (%d)\n", OFFSET_stgChk0); + printf("#define OFFSET_stgChk1 (%d)\n", OFFSET_stgChk1); + printf("#define OFFSET_stgGCEnter1 (%d)\n", OFFSET_stgGCEnter1); + printf("#define OFFSET_stgUpdatePAP (%d)\n", OFFSET_stgUpdatePAP); printf("\n-- Storage Manager offsets for the Native Code Generator\n"); diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index 16712d4..3ecde2b 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: GC.c,v 1.125 2001/10/19 09:41:11 sewardj Exp $ + * $Id: GC.c,v 1.126 2001/11/08 12:46:31 simonmar Exp $ * * (c) The GHC Team 1998-1999 * @@ -920,6 +920,11 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) } resizeNursery((nat)blocks); + + } else { + // we might have added extra large blocks to the nursery, so + // resize back to minAllocAreaSize again. + resizeNursery(RtsFlags.GcFlags.minAllocAreaSize); } } @@ -1467,6 +1472,9 @@ loop: if (HEAP_ALLOCED(q)) { bd = Bdescr((P_)q); + // not a group head: find the group head + if (bd->blocks == 0) { bd = bd->link; } + if (bd->gen_no > N) { /* Can't evacuate this object, because it's in a generation * older than the ones we're collecting. Let's hope that it's diff --git a/ghc/rts/HeapStackCheck.h b/ghc/rts/HeapStackCheck.h deleted file mode 100644 index 1bbccd7..0000000 --- a/ghc/rts/HeapStackCheck.h +++ /dev/null @@ -1,64 +0,0 @@ -/* ----------------------------------------------------------------------------- - * $Id: HeapStackCheck.h,v 1.7 2001/07/06 14:11:38 simonmar Exp $ - * - * (c) The GHC Team, 1998-1999 - * - * Prototypes for functions in HeapStackCheck.hc - * - * ---------------------------------------------------------------------------*/ - - -EXTFUN(stg_gc_entertop); -EXTFUN(stg_gc_enter_1_hponly); -EXTFUN(stg_gc_enter_1); -EXTFUN(stg_gc_enter_2); -EXTFUN(stg_gc_enter_3); -EXTFUN(stg_gc_enter_4); -EXTFUN(stg_gc_enter_5); -EXTFUN(stg_gc_enter_6); -EXTFUN(stg_gc_enter_7); -EXTFUN(stg_gc_enter_8); -EXTFUN(stg_gc_seq_1); - -EI_(stg_gc_noregs_ret_info); -EF_(stg_gc_noregs); - -EI_(stg_gc_unpt_r1_ret_info); -EF_(stg_gc_unpt_r1); - -EI_(stg_gc_unbx_r1_ret_info); -EF_(stg_gc_unbx_r1); - -EI_(stg_gc_f1_ret_info); -EF_(stg_gc_f1); - -EI_(stg_gc_d1_ret_info); -EF_(stg_gc_d1); - -EI_(stg_gc_ut_1_0_ret_info); -EF_(stg_gc_ut_1_0); - -EI_(stg_gc_ut_0_1_ret_info); -EF_(stg_gc_ut_0_1); - -EXTFUN(stg_chk_0); -EXTFUN(stg_chk_1); -EXTFUN(stg_chk_1n); -EXTFUN(stg_chk_2); -EXTFUN(stg_chk_3); -EXTFUN(stg_chk_4); -EXTFUN(stg_chk_5); -EXTFUN(stg_chk_6); -EXTFUN(stg_chk_7); -EXTFUN(stg_chk_8); -EXTFUN(stg_gen_chk_ret); -EXTFUN(stg_gen_chk); -EXTFUN(stg_gen_hp); -EXTFUN(stg_gen_yield); -EXTFUN(stg_yield_noregs); -EXTFUN(stg_yield_to_interpreter); -EXTFUN(stg_gen_block); -EXTFUN(stg_block_noregs); -EXTFUN(stg_block_1); -EXTFUN(stg_block_takemvar); -EXTFUN(stg_block_putmvar); diff --git a/ghc/rts/HeapStackCheck.hc b/ghc/rts/HeapStackCheck.hc index 72ca553..5fa5f10 100644 --- a/ghc/rts/HeapStackCheck.hc +++ b/ghc/rts/HeapStackCheck.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: HeapStackCheck.hc,v 1.17 2001/07/06 14:11:38 simonmar Exp $ + * $Id: HeapStackCheck.hc,v 1.18 2001/11/08 12:46:31 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -12,7 +12,6 @@ #include "Storage.h" /* for CurrentTSO */ #include "StgRun.h" /* for StgReturn and register saving */ #include "Schedule.h" /* for context_switch */ -#include "HeapStackCheck.h" /* Stack/Heap Check Failure * ------------------------ @@ -51,7 +50,8 @@ #define GC_GENERIC \ if (Hp > HpLim) { \ - if (ExtendNursery(Hp,HpLim)) { \ + Hp -= HpAlloc; \ + if (HpAlloc <= BLOCK_SIZE_W && ExtendNursery(Hp,HpLim)) {\ if (context_switch) { \ R1.i = ThreadYielding; \ } else { \ @@ -70,7 +70,8 @@ #define GC_ENTER \ if (Hp > HpLim) { \ - if (ExtendNursery(Hp,HpLim)) { \ + Hp -= HpAlloc; \ + if (HpAlloc <= BLOCK_SIZE_W && ExtendNursery(Hp,HpLim)) {\ if (context_switch) { \ R1.i = ThreadYielding; \ } else { \ @@ -151,7 +152,7 @@ EXTFUN(stg_gc_entertop) There are canned sequences for 'n' pointer values in registers. -------------------------------------------------------------------------- */ -EXTFUN(stg_gc_enter_1) +EXTFUN(__stg_gc_enter_1) { FB_ Sp -= 1; @@ -880,7 +881,7 @@ EXTFUN(stg_gc_ut_0_1) /*- 0 Regs -------------------------------------------------------------------*/ -EXTFUN(stg_chk_0) +EXTFUN(__stg_chk_0) { FB_ Sp -= 1; @@ -891,7 +892,7 @@ EXTFUN(stg_chk_0) /*- 1 Reg --------------------------------------------------------------------*/ -EXTFUN(stg_chk_1) +EXTFUN(__stg_chk_1) { FB_ Sp -= 2; diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c index deb42fb..27c3c5c 100644 --- a/ghc/rts/Interpreter.c +++ b/ghc/rts/Interpreter.c @@ -5,8 +5,8 @@ * Copyright (c) 1994-2000. * * $RCSfile: Interpreter.c,v $ - * $Revision: 1.30 $ - * $Date: 2001/08/14 13:40:09 $ + * $Revision: 1.31 $ + * $Date: 2001/11/08 12:46:31 $ * ---------------------------------------------------------------------------*/ #include "PosixSource.h" @@ -56,15 +56,15 @@ #define BCO_ITBL(n) itbls[n] #define LOAD_STACK_POINTERS \ - iSp = cap->rCurrentTSO->sp; \ - iSu = cap->rCurrentTSO->su; \ + iSp = cap->r.rCurrentTSO->sp; \ + iSu = cap->r.rCurrentTSO->su; \ /* We don't change this ... */ \ - iSpLim = cap->rCurrentTSO->stack + RESERVED_STACK_WORDS; + iSpLim = cap->r.rCurrentTSO->stack + RESERVED_STACK_WORDS; #define SAVE_STACK_POINTERS \ - cap->rCurrentTSO->sp = iSp; \ - cap->rCurrentTSO->su = iSu; + cap->r.rCurrentTSO->sp = iSp; \ + cap->r.rCurrentTSO->su = iSu; #define RETURN(retcode) \ SAVE_STACK_POINTERS; return retcode; @@ -196,10 +196,10 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) // checkSanity(1); // iSp--; StackWord(0) = obj; - // checkStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu); + // checkStack(iSp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu); // iSp++; - printStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu); + printStack(iSp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu); fprintf(stderr, "\n\n"); ); @@ -373,7 +373,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) /* Heap check */ if (doYouWantToGC()) { iSp--; StackWord(0) = (W_)bco; - cap->rCurrentTSO->what_next = ThreadEnterInterp; + cap->r.rCurrentTSO->what_next = ThreadEnterInterp; RETURN(HeapOverflow); } @@ -381,7 +381,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) if (iSp - (INTERP_STACK_CHECK_THRESH+1) < iSpLim) { iSp--; StackWord(0) = (W_)obj; - cap->rCurrentTSO->what_next = ThreadEnterInterp; + cap->r.rCurrentTSO->what_next = ThreadEnterInterp; RETURN(StackOverflow); } @@ -389,7 +389,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) if (context_switch) { iSp--; StackWord(0) = (W_)obj; - cap->rCurrentTSO->what_next = ThreadEnterInterp; + cap->r.rCurrentTSO->what_next = ThreadEnterInterp; RETURN(ThreadYielding); } @@ -404,7 +404,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) IF_DEBUG(evaluator, //if (do_print_stack) { //fprintf(stderr, "\n-- BEGIN stack\n"); - //printStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu); + //printStack(iSp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu); //fprintf(stderr, "-- END stack\n\n"); //} do_print_stack = 1; @@ -416,7 +416,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) fprintf(stderr, "%d %p\n", i, (StgPtr)(*(iSp+i))); fprintf(stderr,"\n"); } - //if (do_print_stack) checkStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu); + //if (do_print_stack) checkStack(iSp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu); ); # ifdef INTERP_STATS @@ -436,7 +436,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) if (iSp - stk_words_reqd < iSpLim) { iSp--; StackWord(0) = (W_)obj; - cap->rCurrentTSO->what_next = ThreadEnterInterp; + cap->r.rCurrentTSO->what_next = ThreadEnterInterp; RETURN(StackOverflow); } goto nextInsn; @@ -480,7 +480,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) fprintf(stderr,"\tBuilt "); printObj((StgClosure*)pap); ); - cap->rCurrentTSO->what_next = ThreadEnterGHC; + cap->r.rCurrentTSO->what_next = ThreadEnterGHC; RETURN(ThreadYielding); } case bci_PUSH_L: { @@ -750,7 +750,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) StgInfoTable* magic_itbl = BCO_ITBL(o_itoc_itbl); if (magic_itbl != NULL) { StackWord(0) = (W_)magic_itbl; - cap->rCurrentTSO->what_next = ThreadRunGHC; + cap->r.rCurrentTSO->what_next = ThreadRunGHC; RETURN(ThreadYielding); } else { /* Special case -- returning a VoidRep to @@ -759,7 +759,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) tag and enter the itbl. */ ASSERT(StackWord(0) == (W_)NULL); iSp ++; - cap->rCurrentTSO->what_next = ThreadRunGHC; + cap->r.rCurrentTSO->what_next = ThreadRunGHC; RETURN(ThreadYielding); } } @@ -819,7 +819,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) printObj(obj); ); iSp--; StackWord(0) = (W_)obj; - cap->rCurrentTSO->what_next = ThreadEnterGHC; + cap->r.rCurrentTSO->what_next = ThreadEnterGHC; RETURN(ThreadYielding); } } /* switch on object kind */ diff --git a/ghc/rts/Linker.c b/ghc/rts/Linker.c index 8cd1b02..aed20ee 100644 --- a/ghc/rts/Linker.c +++ b/ghc/rts/Linker.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Linker.c,v 1.72 2001/10/26 11:33:13 sewardj Exp $ + * $Id: Linker.c,v 1.73 2001/11/08 12:46:31 simonmar Exp $ * * (c) The GHC Team, 2000, 2001 * @@ -158,22 +158,22 @@ typedef struct _RtsSymbolVal { Sym(StgReturn) \ Sym(__stginit_PrelGHC) \ Sym(init_stack) \ - Sym(stg_chk_0) \ - Sym(stg_chk_1) \ + SymX(__stg_chk_0) \ + SymX(__stg_chk_1) \ Sym(stg_enterStackTop) \ - Sym(stg_gc_d1) \ - Sym(stg_gc_enter_1) \ - Sym(stg_gc_f1) \ - Sym(stg_gc_noregs) \ - Sym(stg_gc_seq_1) \ - Sym(stg_gc_unbx_r1) \ - Sym(stg_gc_unpt_r1) \ - Sym(stg_gc_ut_0_1) \ - Sym(stg_gc_ut_1_0) \ - Sym(stg_gen_chk) \ - Sym(stg_yield_to_interpreter) \ + SymX(stg_gc_d1) \ + SymX(__stg_gc_enter_1) \ + SymX(stg_gc_f1) \ + SymX(stg_gc_noregs) \ + SymX(stg_gc_seq_1) \ + SymX(stg_gc_unbx_r1) \ + SymX(stg_gc_unpt_r1) \ + SymX(stg_gc_ut_0_1) \ + SymX(stg_gc_ut_1_0) \ + SymX(stg_gen_chk) \ + SymX(stg_yield_to_interpreter) \ SymX(ErrorHdrHook) \ - SymX(MainRegTable) \ + SymX(MainCapability) \ SymX(MallocFailHook) \ SymX(NoRunnableThreadsHook) \ SymX(OnExitHook) \ @@ -314,7 +314,7 @@ typedef struct _RtsSymbolVal { SymX(stg_sel_9_upd_info) \ SymX(stg_seq_frame_info) \ SymX(stg_upd_frame_info) \ - SymX(stg_update_PAP) \ + SymX(__stg_update_PAP) \ SymX(suspendThread) \ SymX(takeMVarzh_fast) \ SymX(timesIntegerzh_fast) \ diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc index 364e20a..d36c18e 100644 --- a/ghc/rts/PrimOps.hc +++ b/ghc/rts/PrimOps.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.hc,v 1.83 2001/08/08 10:50:37 simonmar Exp $ + * $Id: PrimOps.hc,v 1.84 2001/11/08 12:46:31 simonmar Exp $ * * (c) The GHC Team, 1998-2000 * @@ -18,7 +18,6 @@ #include "Storage.h" #include "BlockAlloc.h" /* tmp */ #include "StablePriv.h" -#include "HeapStackCheck.h" #include "StgRun.h" #include "Itimer.h" #include "Prelude.h" diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c index 8e64ecb..87c804f 100644 --- a/ghc/rts/RtsStartup.c +++ b/ghc/rts/RtsStartup.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: RtsStartup.c,v 1.54 2001/10/31 10:34:29 simonmar Exp $ + * $Id: RtsStartup.c,v 1.55 2001/11/08 12:46:31 simonmar Exp $ * * (c) The GHC Team, 1998-2000 * @@ -228,7 +228,7 @@ initModules ( void (*init_root)(void) ) #ifdef SMP Capability cap; #else -#define cap MainRegTable +#define cap MainCapability #endif init_sp = 0; @@ -239,8 +239,8 @@ initModules ( void (*init_root)(void) ) init_stack[init_sp++] = (F_)init_root; } - cap.rSp = (P_)(init_stack + init_sp); - StgRun((StgFunPtr)stg_init, &cap); + cap.r.rSp = (P_)(init_stack + init_sp); + StgRun((StgFunPtr)stg_init, &cap.r); } /* ----------------------------------------------------------------------------- diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c index 35b9b79..3371bad 100644 --- a/ghc/rts/Schedule.c +++ b/ghc/rts/Schedule.c @@ -1,5 +1,5 @@ /* --------------------------------------------------------------------------- - * $Id: Schedule.c,v 1.104 2001/10/31 10:34:29 simonmar Exp $ + * $Id: Schedule.c,v 1.105 2001/11/08 12:46:31 simonmar Exp $ * * (c) The GHC Team, 1998-2000 * @@ -225,13 +225,10 @@ StgThreadID next_thread_id = 1; * Locks required: sched_mutex. */ #ifdef SMP -//@cindex free_capabilities -//@cindex n_free_capabilities Capability *free_capabilities; /* Available capabilities for running threads */ nat n_free_capabilities; /* total number of available capabilities */ #else -//@cindex MainRegTable -Capability MainRegTable; /* for non-SMP, we have one global capability */ +Capability MainCapability; /* for non-SMP, we have one global capability */ #endif #if defined(GRAN) @@ -460,7 +457,8 @@ schedule( void ) } } -#else +#else // not SMP + # if defined(PAR) /* in GUM do this only on the Main PE */ if (IAmMainThread) @@ -527,7 +525,7 @@ schedule( void ) pthread_cond_signal(&thread_ready_cond); } } -#endif /* SMP */ +#endif // SMP /* check for signals each time around the scheduler */ #ifndef mingw32_TARGET_OS @@ -902,6 +900,9 @@ schedule( void ) */ ASSERT(run_queue_hd != END_TSO_QUEUE); t = POP_RUN_QUEUE(); + + // Sanity check the thread we're about to run. This can be + // expensive if there is lots of thread switching going on... IF_DEBUG(sanity,checkTSO(t)); #endif @@ -913,10 +914,10 @@ schedule( void ) free_capabilities = cap->link; n_free_capabilities--; #else - cap = &MainRegTable; + cap = &MainCapability; #endif - cap->rCurrentTSO = t; + cap->r.rCurrentTSO = t; /* context switches are now initiated by the timer signal, unless * the user specified "context switch as often as possible", with @@ -938,17 +939,17 @@ schedule( void ) /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */ /* Run the current thread */ - switch (cap->rCurrentTSO->what_next) { + switch (cap->r.rCurrentTSO->what_next) { case ThreadKilled: case ThreadComplete: /* Thread already finished, return to scheduler. */ ret = ThreadFinished; break; case ThreadEnterGHC: - ret = StgRun((StgFunPtr) stg_enterStackTop, cap); + ret = StgRun((StgFunPtr) stg_enterStackTop, &cap->r); break; case ThreadRunGHC: - ret = StgRun((StgFunPtr) stg_returnToStackTop, cap); + ret = StgRun((StgFunPtr) stg_returnToStackTop, &cap->r); break; case ThreadEnterInterp: ret = interpretBCO(cap); @@ -970,7 +971,7 @@ schedule( void ) #elif !defined(GRAN) && !defined(PAR) IF_DEBUG(scheduler,fprintf(stderr,"scheduler: ");); #endif - t = cap->rCurrentTSO; + t = cap->r.rCurrentTSO; #if defined(PAR) /* HACK 675: if the last thread didn't yield, make sure to print a @@ -983,14 +984,65 @@ schedule( void ) switch (ret) { case HeapOverflow: #if defined(GRAN) - IF_DEBUG(gran, - DumpGranEvent(GR_DESCHEDULE, t)); + IF_DEBUG(gran, DumpGranEvent(GR_DESCHEDULE, t)); globalGranStats.tot_heapover++; #elif defined(PAR) - // IF_DEBUG(par, - //DumpGranEvent(GR_DESCHEDULE, t); globalParStats.tot_heapover++; #endif + + // did the task ask for a large block? + if (cap->r.rHpAlloc > BLOCK_SIZE_W) { + // if so, get one and push it on the front of the nursery. + bdescr *bd; + nat blocks; + + blocks = (nat)BLOCK_ROUND_UP(cap->r.rHpAlloc * sizeof(W_)) / BLOCK_SIZE; + + IF_DEBUG(scheduler,belch("--<< thread %ld (%p; %s) stopped: requesting a large block (size %d)", + t->id, t, + whatNext_strs[t->what_next], blocks)); + + // don't do this if it would push us over the + // alloc_blocks_lim limit; we'll GC first. + if (alloc_blocks + blocks < alloc_blocks_lim) { + + alloc_blocks += blocks; + bd = allocGroup( blocks ); + + // link the new group into the list + bd->link = cap->r.rCurrentNursery; + bd->u.back = cap->r.rCurrentNursery->u.back; + if (cap->r.rCurrentNursery->u.back != NULL) { + cap->r.rCurrentNursery->u.back->link = bd; + } else { + ASSERT(g0s0->blocks == cap->r.rCurrentNursery && + g0s0->blocks == cap->r.rNursery); + cap->r.rNursery = g0s0->blocks = bd; + } + cap->r.rCurrentNursery->u.back = bd; + + // initialise it as a nursery block + bd->step = g0s0; + bd->gen_no = 0; + bd->flags = 0; + bd->free = bd->start; + + // don't forget to update the block count in g0s0. + g0s0->n_blocks += blocks; + ASSERT(countBlocks(g0s0->blocks) == g0s0->n_blocks); + + // now update the nursery to point to the new block + cap->r.rCurrentNursery = bd; + + // we might be unlucky and have another thread get on the + // run queue before us and steal the large block, but in that + // case the thread will just end up requesting another large + // block. + PUSH_ON_RUN_QUEUE(t); + break; + } + } + /* make all the running tasks block on a condition variable, * maybe set context_switch and wait till they all pile in, * then have them wait on a GC condition variable. @@ -1240,24 +1292,20 @@ schedule( void ) G_CURR_THREADQ(0)); #endif /* GRAN */ } + #if defined(GRAN) next_thread: IF_GRAN_DEBUG(unused, print_eventq(EventHd)); event = get_next_event(); - #elif defined(PAR) next_thread: /* ToDo: wait for next message to arrive rather than busy wait */ - -#else /* GRAN */ - /* not any more - next_thread: - t = take_off_run_queue(END_TSO_QUEUE); - */ #endif /* GRAN */ + } /* end of while(1) */ + IF_PAR_DEBUG(verbose, belch("== Leaving schedule() after having received Finish")); } @@ -1315,14 +1363,14 @@ suspendThread( Capability *cap ) ACQUIRE_LOCK(&sched_mutex); IF_DEBUG(scheduler, - sched_belch("thread %d did a _ccall_gc", cap->rCurrentTSO->id)); + sched_belch("thread %d did a _ccall_gc", cap->r.rCurrentTSO->id)); - threadPaused(cap->rCurrentTSO); - cap->rCurrentTSO->link = suspended_ccalling_threads; - suspended_ccalling_threads = cap->rCurrentTSO; + threadPaused(cap->r.rCurrentTSO); + cap->r.rCurrentTSO->link = suspended_ccalling_threads; + suspended_ccalling_threads = cap->r.rCurrentTSO; /* Use the thread ID as the token; it should be unique */ - tok = cap->rCurrentTSO->id; + tok = cap->r.rCurrentTSO->id; #ifdef SMP cap->link = free_capabilities; @@ -1366,10 +1414,10 @@ resumeThread( StgInt tok ) free_capabilities = cap->link; n_free_capabilities--; #else - cap = &MainRegTable; + cap = &MainCapability; #endif - cap->rCurrentTSO = tso; + cap->r.rCurrentTSO = tso; RELEASE_LOCK(&sched_mutex); return cap; @@ -1738,7 +1786,15 @@ term_handler(int sig STG_UNUSED) } #endif -//@cindex initScheduler +static void +initCapability( Capability *cap ) +{ + cap->f.stgChk0 = (F_)__stg_chk_0; + cap->f.stgChk1 = (F_)__stg_chk_1; + cap->f.stgGCEnter1 = (F_)__stg_gc_enter_1; + cap->f.stgUpdatePAP = (F_)__stg_update_PAP; +} + void initScheduler(void) { @@ -1795,6 +1851,7 @@ initScheduler(void) prev = NULL; for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) { cap = stgMallocBytes(sizeof(Capability), "initScheduler:capabilities"); + initCapability(cap); cap->link = prev; prev = cap; } @@ -1803,6 +1860,8 @@ initScheduler(void) } IF_DEBUG(scheduler,fprintf(stderr,"scheduler: Allocated %d capabilities\n", n_free_capabilities);); +#else + initCapability(&MainCapability); #endif #if defined(SMP) || defined(PAR) diff --git a/ghc/rts/Schedule.h b/ghc/rts/Schedule.h index 00b4de1..71e84ce 100644 --- a/ghc/rts/Schedule.h +++ b/ghc/rts/Schedule.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Schedule.h,v 1.22 2001/03/22 03:51:10 hwloidl Exp $ + * $Id: Schedule.h,v 1.23 2001/11/08 12:46:31 simonmar Exp $ * * (c) The GHC Team 1998-1999 * @@ -124,11 +124,6 @@ extern rtsBool interrupted; extern nat timestamp; extern nat ticks_since_timestamp; -//@cindex Capability -/* Capability type - */ -typedef StgRegTable Capability; - /* Free capability list. * Locks required: sched_mutex. */ @@ -136,7 +131,7 @@ typedef StgRegTable Capability; extern Capability *free_capabilities; extern nat n_free_capabilities; #else -extern Capability MainRegTable; +extern Capability MainCapability; #endif /* Thread queues. diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc index 06286a0..de36bea 100644 --- a/ghc/rts/StgMiscClosures.hc +++ b/ghc/rts/StgMiscClosures.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: StgMiscClosures.hc,v 1.68 2001/08/10 09:41:17 simonmar Exp $ + * $Id: StgMiscClosures.hc,v 1.69 2001/11/08 12:46:31 simonmar Exp $ * * (c) The GHC Team, 1998-2000 * @@ -12,7 +12,6 @@ #include "RtsUtils.h" #include "RtsFlags.h" #include "StgMiscClosures.h" -#include "HeapStackCheck.h" /* for stg_gen_yield */ #include "Storage.h" #include "StoragePriv.h" #include "Profiling.h" diff --git a/ghc/rts/StgStdThunks.hc b/ghc/rts/StgStdThunks.hc index ce56a01..9373dab 100644 --- a/ghc/rts/StgStdThunks.hc +++ b/ghc/rts/StgStdThunks.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: StgStdThunks.hc,v 1.16 2001/05/31 10:59:14 simonmar Exp $ + * $Id: StgStdThunks.hc,v 1.17 2001/11/08 12:46:31 simonmar Exp $ * * (c) The GHC Team, 1998-2000 * @@ -10,7 +10,6 @@ #include "Stg.h" #include "Rts.h" #include "StoragePriv.h" -#include "HeapStackCheck.h" /* ----------------------------------------------------------------------------- The code for a thunk that simply extracts a field from a @@ -159,7 +158,7 @@ FN_(stg_ap_8_upd_entry); * in the compiler that means stg_ap_1 is generated occasionally (ToDo) */ -INFO_TABLE_SRT(stg_ap_1_upd_info,stg_ap_1_upd_entry,1,1,0,0,0,THUNK,,EF_,"stg_ap_1_upd_info","stg_ap_1_upd_info"); +INFO_TABLE_SRT(stg_ap_1_upd_info,stg_ap_1_upd_entry,1,1,0,0,0,THUNK_1_0,,EF_,"stg_ap_1_upd_info","stg_ap_1_upd_info"); FN_(stg_ap_1_upd_entry) { FB_ STK_CHK_NP(sizeofW(StgUpdateFrame),1,); @@ -172,7 +171,7 @@ FN_(stg_ap_1_upd_entry) { FE_ } -INFO_TABLE_SRT(stg_ap_2_upd_info,stg_ap_2_upd_entry,2,0,0,0,0,THUNK,,EF_,"stg_ap_2_upd_info","stg_ap_2_upd_info"); +INFO_TABLE_SRT(stg_ap_2_upd_info,stg_ap_2_upd_entry,2,0,0,0,0,THUNK_2_0,,EF_,"stg_ap_2_upd_info","stg_ap_2_upd_info"); FN_(stg_ap_2_upd_entry) { FB_ STK_CHK_NP(sizeofW(StgUpdateFrame)+1,1,); diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c index 6b4333d..9080bf6 100644 --- a/ghc/rts/Storage.c +++ b/ghc/rts/Storage.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Storage.c,v 1.52 2001/10/18 14:41:01 simonmar Exp $ + * $Id: Storage.c,v 1.53 2001/11/08 12:46:31 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -23,10 +23,6 @@ #include "Schedule.h" #include "StoragePriv.h" -#ifndef SMP -nat nursery_blocks; /* number of blocks in the nursery */ -#endif - StgClosure *caf_list = NULL; bdescr *small_alloc_list; /* allocate()d small objects */ @@ -323,13 +319,12 @@ allocNurseries( void ) */ } #else /* SMP */ - nursery_blocks = RtsFlags.GcFlags.minAllocAreaSize; - g0s0->blocks = allocNursery(NULL, nursery_blocks); - g0s0->n_blocks = nursery_blocks; + g0s0->blocks = allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize); + g0s0->n_blocks = RtsFlags.GcFlags.minAllocAreaSize; g0s0->to_blocks = NULL; g0s0->n_to_blocks = 0; - MainRegTable.rNursery = g0s0->blocks; - MainRegTable.rCurrentNursery = g0s0->blocks; + MainCapability.r.rNursery = g0s0->blocks; + MainCapability.r.rCurrentNursery = g0s0->blocks; /* hp, hpLim, hp_bd, to_space etc. aren't used in G0S0 */ #endif } @@ -360,41 +355,49 @@ resetNurseries( void ) ASSERT(bd->step == g0s0); IF_DEBUG(sanity,memset(bd->start, 0xaa, BLOCK_SIZE)); } - MainRegTable.rNursery = g0s0->blocks; - MainRegTable.rCurrentNursery = g0s0->blocks; + MainCapability.r.rNursery = g0s0->blocks; + MainCapability.r.rCurrentNursery = g0s0->blocks; #endif } bdescr * -allocNursery (bdescr *last_bd, nat blocks) +allocNursery (bdescr *tail, nat blocks) { bdescr *bd; nat i; - /* Allocate a nursery */ + // Allocate a nursery: we allocate fresh blocks one at a time and + // cons them on to the front of the list, not forgetting to update + // the back pointer on the tail of the list to point to the new block. for (i=0; i < blocks; i++) { bd = allocBlock(); - bd->link = last_bd; + bd->link = tail; + // double-link the nursery: we might need to insert blocks + if (tail != NULL) { + tail->u.back = bd; + } bd->step = g0s0; bd->gen_no = 0; bd->flags = 0; bd->free = bd->start; - last_bd = bd; + tail = bd; } - return last_bd; + tail->u.back = NULL; + return tail; } void resizeNursery ( nat blocks ) { bdescr *bd; + nat nursery_blocks; #ifdef SMP barf("resizeNursery: can't resize in SMP mode"); #endif + nursery_blocks = g0s0->n_blocks; if (nursery_blocks == blocks) { - ASSERT(g0s0->n_blocks == blocks); return; } @@ -409,15 +412,25 @@ resizeNursery ( nat blocks ) IF_DEBUG(gc, fprintf(stderr, "Decreasing size of nursery to %d blocks\n", blocks)); - for (bd = g0s0->blocks; nursery_blocks > blocks; nursery_blocks--) { - next_bd = bd->link; - freeGroup(bd); - bd = next_bd; + + bd = g0s0->blocks; + while (nursery_blocks > blocks) { + next_bd = bd->link; + next_bd->u.back = NULL; + nursery_blocks -= bd->blocks; // might be a large block + freeGroup(bd); + bd = next_bd; } g0s0->blocks = bd; + // might have gone just under, by freeing a large block, so make + // up the difference. + if (nursery_blocks < blocks) { + g0s0->blocks = allocNursery(g0s0->blocks, blocks-nursery_blocks); + } } - g0s0->n_blocks = nursery_blocks = blocks; + g0s0->n_blocks = blocks; + ASSERT(countBlocks(g0s0->blocks) == g0s0->n_blocks); } /* ----------------------------------------------------------------------------- @@ -642,9 +655,9 @@ calcAllocated( void ) } #else /* !SMP */ - bdescr *current_nursery = MainRegTable.rCurrentNursery; + bdescr *current_nursery = MainCapability.r.rCurrentNursery; - allocated = (nursery_blocks * BLOCK_SIZE_W) + allocated_bytes(); + allocated = (g0s0->n_blocks * BLOCK_SIZE_W) + allocated_bytes(); for ( bd = current_nursery->link; bd != NULL; bd = bd->link ) { allocated -= BLOCK_SIZE_W; } @@ -790,7 +803,8 @@ memInventory(void) ASSERT(total_blocks + free_blocks == mblocks_allocated * BLOCKS_PER_MBLOCK); } -static nat + +nat countBlocks(bdescr *bd) { nat n; @@ -813,13 +827,13 @@ checkSanity( void ) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { for (s = 0; s < generations[g].n_steps; s++) { - if (g == 0 && s == 0) { continue; } - checkHeap(generations[g].steps[s].blocks); - checkChain(generations[g].steps[s].large_objects); ASSERT(countBlocks(generations[g].steps[s].blocks) == generations[g].steps[s].n_blocks); ASSERT(countBlocks(generations[g].steps[s].large_objects) == generations[g].steps[s].n_large_blocks); + if (g == 0 && s == 0) { continue; } + checkHeap(generations[g].steps[s].blocks); + checkChain(generations[g].steps[s].large_objects); if (g > 0) { checkMutableList(generations[g].mut_list, g); checkMutOnceList(generations[g].mut_once_list, g); diff --git a/ghc/rts/StoragePriv.h b/ghc/rts/StoragePriv.h index 0b0907f..033b06c 100644 --- a/ghc/rts/StoragePriv.h +++ b/ghc/rts/StoragePriv.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: StoragePriv.h,v 1.18 2001/10/19 09:41:11 sewardj Exp $ + * $Id: StoragePriv.h,v 1.19 2001/11/08 12:46:31 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -40,7 +40,6 @@ extern StgPtr alloc_HpLim; extern bdescr *nursery; -extern nat nursery_blocks; extern nat alloc_blocks; extern nat alloc_blocks_lim; @@ -77,6 +76,7 @@ dbl_link_onto(bdescr *bd, bdescr **list) #ifdef DEBUG extern void memInventory(void); extern void checkSanity(void); +extern nat countBlocks(bdescr *); #endif /* diff --git a/ghc/rts/Updates.hc b/ghc/rts/Updates.hc index 6f0250f..989ce2f 100644 --- a/ghc/rts/Updates.hc +++ b/ghc/rts/Updates.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Updates.hc,v 1.34 2001/07/24 06:31:36 ken Exp $ + * $Id: Updates.hc,v 1.35 2001/11/08 12:46:31 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -11,7 +11,6 @@ #include "Rts.h" #include "RtsUtils.h" #include "RtsFlags.h" -#include "HeapStackCheck.h" #include "Storage.h" #if defined(GRAN) || defined(PAR) # include "FetchMe.h" @@ -230,7 +229,7 @@ STGFUN(stg_PAP_entry) This function is called whenever an argument satisfaction check fails. -------------------------------------------------------------------------- */ -EXTFUN(stg_update_PAP) +EXTFUN(__stg_update_PAP) { nat Words, PapSize; #ifdef PROFILING -- 1.7.10.4