diff options
Diffstat (limited to 'ghc/runtime')
76 files changed, 4695 insertions, 5363 deletions
diff --git a/ghc/runtime/Jmakefile b/ghc/runtime/Jmakefile index ea1edaf7b3..84e38971f9 100644 --- a/ghc/runtime/Jmakefile +++ b/ghc/runtime/Jmakefile @@ -48,14 +48,7 @@ strictly speaking), it will probably work -- it is pinned onto GHC_OPTS, just for fun. */ -#if i386_TARGET_ARCH -# define __plat_specific -mtoggle-sp-mangling -#else -# define __plat_specific /*none*/ -#endif - -GHC_OPTS = -O2-for-C -optc-DFORCE_GC \ - __plat_specific $(EXTRA_HC_OPTS) +GHC_OPTS = -O2-for-C $(EXTRA_HC_OPTS) /* per-build options: shared with libraries */ #define rts_or_lib(r,l) r @@ -97,13 +90,13 @@ RTS_LC = \ gum/Unpack.lc \ main/GranSim.lc \ main/Itimer.lc \ - main/RednCounts.lc \ + main/Ticky.lc \ main/SMRep.lc \ main/Select.lc \ main/Signals.lc \ main/StgOverflow.lc \ - main/StgTrace.lc \ main/Threads.lc \ + main/RtsFlags.lc \ main/main.lc \ prims/PrimArith.lc \ prims/PrimMisc.lc \ @@ -111,9 +104,7 @@ RTS_LC = \ profiling/Hashing.lc \ profiling/HeapProfile.lc \ profiling/Indexing.lc \ - profiling/LifeProfile.lc \ profiling/Timer.lc \ - storage/Force_GC.lc \ storage/SM1s.lc \ storage/SM2s.lc \ storage/SMap.lc \ @@ -190,8 +181,8 @@ CLIB_LC = \ io/toLocalTime.lc \ io/toUTCTime.lc \ io/writeFile.lc \ - prims/ByteOps.lc \ - storage/SMalloc.lc __readline_cfile + main/Mallocs.lc \ + prims/ByteOps.lc __readline_cfile H_FILES = $(RTS_LH:.lh=.h) C_FILES = $(RTS_LC:.lc=.c) $(RTS_LHC:.lhc=.hc) $(CLIB_LC:.lc=.c) @@ -240,6 +231,8 @@ RTS_OBJS_l = $(RTS_LC:.lc=_l.o) $(RTS_LHC:.lhc=_l.o) RTS_OBJS_m = $(RTS_LC:.lc=_m.o) $(RTS_LHC:.lhc=_m.o) RTS_OBJS_n = $(RTS_LC:.lc=_n.o) $(RTS_LHC:.lhc=_n.o) RTS_OBJS_o = $(RTS_LC:.lc=_o.o) $(RTS_LHC:.lhc=_o.o) +RTS_OBJS_A = $(RTS_LC:.lc=_A.o) $(RTS_LHC:.lhc=_A.o) +RTS_OBJS_B = $(RTS_LC:.lc=_B.o) $(RTS_LHC:.lhc=_B.o) CLIB_OBJS = $(CLIB_LC:.lc=.o) @@ -303,10 +296,10 @@ CompileClibishly(io/toClockSec,) CompileClibishly(io/toLocalTime,) CompileClibishly(io/toUTCTime,) CompileClibishly(io/writeFile,) +CompileClibishly(main/Mallocs,) CompileClibishly(main/TopClosure,) /* NB */ CompileClibishly(main/TopClosure13,) /* ditto */ CompileClibishly(prims/ByteOps,) -CompileClibishly(storage/SMalloc,) #if GhcWithReadline == YES CompileClibishly(io/ghcReadline,) #endif @@ -327,9 +320,9 @@ install :: main/TopClosure.o main/TopClosure13.o # endif AllTarget(gum/SysMan) -gum/SysMan : gum/SysMan_mp.o gum/LLComms_mp.o +gum/SysMan : gum/SysMan_mp.o gum/LLComms_mp.o main/Mallocs.o hooks/OutOfVM.o $(RM) $@ - $(CC) gum/SysMan_mp.o gum/LLComms_mp.o -o $@ -L$$PVM_ROOT/lib/$$PVM_ARCH -lpvm3 -lgpvm3 __socket_libs + $(CC) -o $@ gum/SysMan_mp.o gum/LLComms_mp.o main/Mallocs.o hooks/OutOfVM.o -L$$PVM_ROOT/lib/$$PVM_ARCH -lpvm3 -lgpvm3 __socket_libs ExtraStuffToClean(gum/SysMan_mp.o gum/SysMan) # if DoInstallGHCSystem == YES install :: gum/SysMan @@ -409,6 +402,8 @@ IfGhcBuild_l(BigBuildTarget(_l, $(RTS_OBJS_l))) IfGhcBuild_m(BigBuildTarget(_m, $(RTS_OBJS_m))) IfGhcBuild_n(BigBuildTarget(_n, $(RTS_OBJS_n))) IfGhcBuild_o(BigBuildTarget(_o, $(RTS_OBJS_o))) +IfGhcBuild_A(BigBuildTarget(_A, $(RTS_OBJS_A))) +IfGhcBuild_B(BigBuildTarget(_B, $(RTS_OBJS_B))) /**************************************************************** @@ -449,19 +444,21 @@ IfGhcBuild_k(DoRtsFile(file,isuf,_k, flags $(GHC_OPTS_k))) \ IfGhcBuild_l(DoRtsFile(file,isuf,_l, flags $(GHC_OPTS_l))) \ IfGhcBuild_m(DoRtsFile(file,isuf,_m, flags $(GHC_OPTS_m))) \ IfGhcBuild_n(DoRtsFile(file,isuf,_n, flags $(GHC_OPTS_n))) \ -IfGhcBuild_o(DoRtsFile(file,isuf,_o, flags $(GHC_OPTS_o))) +IfGhcBuild_o(DoRtsFile(file,isuf,_o, flags $(GHC_OPTS_o))) \ +IfGhcBuild_A(DoRtsFile(file,isuf,_A, flags $(GHC_OPTS_A))) \ +IfGhcBuild_B(DoRtsFile(file,isuf,_B, flags $(GHC_OPTS_B))) /* here we go: */ CompileRTSishly(c-as-asm/CallWrap_C,.c,) CompileRTSishly(c-as-asm/FreeMallocPtr,.c,) CompileRTSishly(c-as-asm/HpOverflow,.c,) -CompileRTSishly(c-as-asm/PerformIO,.hc,-mtoggle-sp-mangling/*toggle it back*/) +CompileRTSishly(c-as-asm/PerformIO,.hc,-optcO-DIN_GHC_RTS=1) CompileRTSishly(c-as-asm/StablePtr,.c,) CompileRTSishly(c-as-asm/StablePtrOps,.c,) CompileRTSishly(c-as-asm/StgDebug,.c,) CompileRTSishly(c-as-asm/StgMiniInt,.c,) -CompileRTSishly(gum/FetchMe,.hc,-mtoggle-sp-mangling/*toggle it back*/) +CompileRTSishly(gum/FetchMe,.hc,-optcO-DIN_GHC_RTS=1) CompileRTSishly(gum/GlobAddr,.c,) CompileRTSishly(gum/HLComms,.c,) CompileRTSishly(gum/Hash,.c,) @@ -474,26 +471,24 @@ CompileRTSishly(gum/SysMan,.c,) /* NB: not in library */ CompileRTSishly(gum/Unpack,.c,) CompileRTSishly(main/GranSim,.c,) CompileRTSishly(main/Itimer,.c,) -CompileRTSishly(main/RednCounts,.c,) +CompileRTSishly(main/Ticky,.c,) CompileRTSishly(main/SMRep,.c,) CompileRTSishly(main/Select,.c,) CompileRTSishly(main/Signals,.c,) CompileRTSishly(main/StgOverflow,.c,) -CompileRTSishly(main/StgStartup,.hc,-mtoggle-sp-mangling/*toggle it back*/) -CompileRTSishly(main/StgThreads,.hc,-mtoggle-sp-mangling/*toggle it back*/) -CompileRTSishly(main/StgTrace,.c,) -CompileRTSishly(main/StgUpdate,.hc,-mtoggle-sp-mangling/*toggle it back*/) +CompileRTSishly(main/StgStartup,.hc,-optcO-DIN_GHC_RTS=1) +CompileRTSishly(main/StgThreads,.hc,-optcO-DIN_GHC_RTS=1) +CompileRTSishly(main/StgUpdate,.hc,-optcO-DIN_GHC_RTS=1) CompileRTSishly(main/Threads,.c,) +CompileRTSishly(main/RtsFlags,.c,) CompileRTSishly(main/main,.c,) CompileRTSishly(profiling/CostCentre,.c,) CompileRTSishly(profiling/Hashing,.c,) CompileRTSishly(profiling/HeapProfile,.c,) CompileRTSishly(profiling/Indexing,.c,) -CompileRTSishly(profiling/LifeProfile,.c,) CompileRTSishly(profiling/Timer,.c,) CompileRTSishly(prims/PrimArith,.c,) CompileRTSishly(prims/PrimMisc,.c,) -CompileRTSishly(storage/Force_GC,.c,) CompileRTSishly(storage/SM1s,.c,) CompileRTSishly(storage/SM2s,.c,) CompileRTSishly(storage/SMap,.c,) @@ -505,7 +500,7 @@ CompileRTSishly(storage/SMevac,.c,) CompileRTSishly(storage/SMextn,.c,) CompileRTSishly(storage/SMgen,.c,) CompileRTSishly(storage/SMinit,.c,) -CompileRTSishly(storage/SMmark,.hc,-optc-DMARK_REG_MAP) +CompileRTSishly(storage/SMmark,.hc,-optcO-DIN_GHC_RTS=1 -optc-DMARK_REG_MAP) CompileRTSishly(storage/SMmarking,.c,) CompileRTSishly(storage/SMscan,.c,) CompileRTSishly(storage/SMscav,.c,) diff --git a/ghc/runtime/c-as-asm/CallWrap_C.lc b/ghc/runtime/c-as-asm/CallWrap_C.lc index 259c4852b8..66591d1acf 100644 --- a/ghc/runtime/c-as-asm/CallWrap_C.lc +++ b/ghc/runtime/c-as-asm/CallWrap_C.lc @@ -52,7 +52,6 @@ callWrapper(STG_NO_ARGS) CALLER_SAVE_Hp CALLER_SAVE_HpLim CALLER_SAVE_Liveness - CALLER_SAVE_Activity CALLER_SAVE_Ret MAGIC_CALL @@ -82,7 +81,6 @@ callWrapper(STG_NO_ARGS) CALLER_RESTORE_Hp CALLER_RESTORE_HpLim CALLER_RESTORE_Liveness - CALLER_RESTORE_Activity CALLER_RESTORE_Ret /* These next two are restore-only */ @@ -108,7 +106,6 @@ callWrapper_safe(STG_NO_ARGS) CALLER_SAVE_Hp CALLER_SAVE_HpLim CALLER_SAVE_Liveness - CALLER_SAVE_Activity CALLER_SAVE_Ret MAGIC_CALL @@ -123,7 +120,6 @@ callWrapper_safe(STG_NO_ARGS) CALLER_RESTORE_Hp CALLER_RESTORE_HpLim CALLER_RESTORE_Liveness - CALLER_RESTORE_Activity CALLER_RESTORE_Ret /* These next two are restore-only */ @@ -160,22 +156,37 @@ ADR */ EXTFUN(EnterNodeCode); +void *__temp_esp, *__temp_eax; + void PerformGC_wrapper PROTO((W_)) WRAPPER_NAME(PerformGC); void PerformGC_wrapper(args) W_ args; { - WRAPPER_SETUP(PerformGC) +#if i386_TARGET_ARCH + void *ret_addr; + + WRAPPER_SETUP(PerformGC,ret_addr,args) +#else + WRAPPER_SETUP(PerformGC, ignore_me, ignore_me) +#endif PerformGC(args); WRAPPER_RETURN(0) } # ifdef CONCURRENT +void __DISCARD__ (STG_NO_ARGS) { /*nothing*/ } + void StackOverflow_wrapper PROTO((W_,W_)) WRAPPER_NAME(StackOverflow); void StackOverflow_wrapper(args1,args2) W_ args1, args2; { - WRAPPER_SETUP(StackOverflow) +#if i386_TARGET_ARCH + void *ret_addr, *ignore_me; + WRAPPER_SETUP(StackOverflow,ret_addr,ignore_me) +#else + WRAPPER_SETUP(StackOverflow, ignore_me, ignore_me) +#endif if(StackOverflow(args1,args2)) { WRAPPER_RETURN(1) } @@ -186,7 +197,12 @@ void Yield_wrapper PROTO((W_)) WRAPPER_NAME(Yield); void Yield_wrapper(args) W_ args; { - WRAPPER_SETUP(Yield) +#if i386_TARGET_ARCH + void *ret_addr, *ignore_me; + WRAPPER_SETUP(Yield, ret_addr, ignore_me) +#else + WRAPPER_SETUP(Yield, ignore_me, ignore_me) +#endif Yield(args); WRAPPER_RETURN(0) } @@ -200,7 +216,12 @@ void PerformReschedule_wrapper(liveness, always_reenter_node) W_ liveness; W_ always_reenter_node; { - WRAPPER_SETUP(PerformReschedule) +#if i386_TARGET_ARCH + void *ret_addr, *ignore_me; + WRAPPER_SETUP(PerformReschedule, ret_addr, ignore_me) +#else + WRAPPER_SETUP(PerformReschedule, ignore_me, ignore_me) +#endif PerformReschedule(liveness, always_reenter_node); WRAPPER_RETURN(0) } diff --git a/ghc/runtime/c-as-asm/HpOverflow.lc b/ghc/runtime/c-as-asm/HpOverflow.lc index 93235cab17..a9d559fc64 100644 --- a/ghc/runtime/c-as-asm/HpOverflow.lc +++ b/ghc/runtime/c-as-asm/HpOverflow.lc @@ -37,17 +37,11 @@ static void BlackHoleUpdateStack(STG_NO_ARGS); #endif /* CONCURRENT */ extern smInfo StorageMgrInfo; -extern void PrintRednCountInfo(STG_NO_ARGS); -extern I_ showRednCountStats; -extern I_ SM_word_heap_size; -extern I_ squeeze_upd_frames; +extern void PrintTickyInfo(STG_NO_ARGS); #if defined(GRAN_CHECK) && defined(GRAN) extern W_ debug; #endif -#ifdef GRAN -extern FILE *main_statsfile; /* Might be of general interest HWL */ -#endif /* the real work is done by this function --- see wrappers at end */ @@ -61,12 +55,12 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection) I_ num_ptr_roots = 0; /* we bump this counter as we store roots; de-bump it as we re-store them. */ -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) CostCentre Save_CCC; #endif /* stop the profiling timer --------------------- */ -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) /* STOP_TIME_PROFILER; */ #endif @@ -74,6 +68,11 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection) SAVE_Liveness = liveness; + /* + fprintf(stderr,"RealGC:liveness=0x%lx,reqsize=0x%lx,reenter=%lx,do_full=%d,context_switch=%ld\n", + liveness, reqsize,always_reenter_node,do_full_collection,context_switch); + */ + /* Even on a uniprocessor, we may have to reenter node after a context switch. Though it can't turn into a FetchMe, its shape @@ -86,7 +85,7 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection) return; } /* Set up to re-enter Node, so as to be sure it's really there. */ - assert(liveness & LIVENESS_R1); + ASSERT(liveness & LIVENESS_R1); TSO_SWITCH(CurrentTSO) = TSO_PC2(CurrentTSO); TSO_PC2(CurrentTSO) = EnterNodeCode; } @@ -94,7 +93,7 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection) SAVE_Hp -= reqsize; if (context_switch && !do_full_collection -# if defined(USE_COST_CENTRES) +# if defined(PROFILING) && !interval_expired # endif ) { @@ -102,7 +101,7 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection) TSO_ARG1(CurrentTSO) = reqsize; TSO_PC1(CurrentTSO) = CheckHeapCode; # ifdef PAR - if (do_gr_profile) { + if (RTSflags.ParFlags.granSimStats) { TSO_EXECTIME(CurrentTSO) += CURRENT_TIME - TSO_BLOCKEDAT(CurrentTSO); } # endif @@ -114,17 +113,19 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection) } /* Don't use SET_CCC, because we don't want to bump the sub_scc_count */ -# if defined(USE_COST_CENTRES) +# if defined(PROFILING) Save_CCC = CCC; # endif +# if defined(PAR) CCC = (CostCentre)STATIC_CC_REF(CC_GC); CCC->scc_count++; +# endif ReallyPerformThreadGC(reqsize, do_full_collection); #else /* !CONCURRENT */ -# if defined(USE_COST_CENTRES) +# if defined(PROFILING) /* Don't use SET_CCC, because we don't want to bump the sub_scc_count */ Save_CCC = CCC; CCC = (CostCentre)STATIC_CC_REF(CC_GC); @@ -152,8 +153,10 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection) * Before we garbage collect we may have to squeeze update frames and/or * black hole the update stack */ - if (squeeze_upd_frames) { - /* Squeeze and/or black hole update frames */ + if (! RTSflags.GcFlags.squeezeUpdFrames) { + BlackHoleUpdateStack(); + + } else { /* Squeeze and/or black hole update frames */ I_ displacement; displacement = SqueezeUpdateFrames(stackInfo.botB + BREL(1), MAIN_SpB, MAIN_SuB); @@ -162,13 +165,9 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection) MAIN_SpB += BREL(displacement); /* fprintf(stderr, "B size %d, squeezed out %d\n", MAIN_SpB - stackInfo.botB, displacement); */ - } /* note the conditional else clause below */ -# if defined(SM_DO_BH_UPDATE) - else - BlackHoleUpdateStack(); -# endif /* SM_DO_BH_UPDATE */ + } - assert(num_ptr_roots <= SM_MAXROOTS); + ASSERT(num_ptr_roots <= SM_MAXROOTS); StorageMgrInfo.rootno = num_ptr_roots; SAVE_Hp -= reqsize; @@ -189,7 +188,7 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection) GC_result = collectHeap(reqsize, &StorageMgrInfo, do_full_collection); if ( GC_result == GC_HARD_LIMIT_EXCEEDED ) { - OutOfHeapHook(reqsize * sizeof(W_), SM_word_heap_size * sizeof(W_)); /*msg*/ + OutOfHeapHook(reqsize * sizeof(W_)); /*msg*/ shutdownHaskell(); EXIT(EXIT_FAILURE); @@ -206,10 +205,8 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection) } else { /* This should not happen */ fprintf(stderr, "Panic: garbage collector returned %d please report it as a bug to glasgow-haskell-bugs@dcs.gla.ac.uk\n", GC_result ); -# if defined(DO_REDN_COUNTING) - if (showRednCountStats) { - PrintRednCountInfo(); - } +# if defined(TICKY_TICKY) + if (RTSflags.TickyFlags.showTickyStats) PrintTickyInfo(); # endif abort(); } @@ -241,13 +238,13 @@ RealPerformGC(liveness, reqsize, always_reenter_node, do_full_collection) __DEROOT_PTR_REG(IS_LIVE_R2(liveness),2); __DEROOT_PTR_REG(IS_LIVE_R1(liveness),1); - assert(num_ptr_roots == 0); /* we have put it all back */ + ASSERT(num_ptr_roots == 0); /* we have put it all back */ unblockUserSignals(); #endif /* !CONCURRENT */ -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) CCC = Save_CCC; RESTART_TIME_PROFILER; @@ -309,7 +306,7 @@ PerformReschedule(liveness, always_reenter_node) } /* Set up to re-enter Node, so as to be sure it's really there. */ - assert(liveness & LIVENESS_R1); + ASSERT(liveness & LIVENESS_R1); TSO_SWITCH(CurrentTSO) = TSO_PC2(CurrentTSO); TSO_PC2(CurrentTSO) = (void *) EnterNodeCode; } @@ -382,7 +379,7 @@ PruneSparks(STG_NO_ARGS) (SPARK_NODE(spark) == Nil_closure) ) { # if defined(GRAN_CHECK) && defined(GRAN) if ( debug & 0x40 ) - fprintf(main_statsfile,"PruneSparks: Warning: spark @ 0x%lx points to NULL or Nil_closure\n", spark); + fprintf(RTSflags.GcFlags.statsFile,"PruneSparks: Warning: spark @ 0x%lx points to NULL or Nil_closure\n", spark); # endif if (do_qp_prof) QP_Event0(threadId++, SPARK_NODE(spark)); @@ -418,7 +415,7 @@ PruneSparks(STG_NO_ARGS) SPARK_NEXT(prev) = NULL; PendingSparksTl[proc][pool] = prev; if (prunedSparks>0) - fprintf(main_statsfile,"Pruning and disposing %lu excess sparks (> %lu) on proc %ld in PruneSparks\n", + fprintf(RTSflags.GcFlags.statsFile,"Pruning and disposing %lu excess sparks (> %lu) on proc %ld in PruneSparks\n", prunedSparks,(W_) MAX_SPARKS,proc); } /* forall pool ... */ } /* forall proc ... */ @@ -477,7 +474,19 @@ rtsBool do_full_collection; as we re-store them. */ P_ stack, tso, next; - /* Discard the saved stack and TSO space */ + /* Discard the saved stack and TSO space. + What's going on here: TSOs and StkOs are on the mutables + list (mutable things in the old generation). Here, we change + them to immutable, so that the scavenger (which chks all + mutable objects) can detect their immutability and remove + them from the list. Setting to MUTUPLE_VHS as the size is + essentially saying "No pointers in here" (i.e., empty). + + Without this change of status, these + objects might not really die, probably with some horrible + disastrous consequence that we don't want to think about. + Will & Phil 95/10 + */ for(stack = AvailableStack; stack != Nil_closure; stack = next) { next = STKO_LINK(stack); @@ -509,7 +518,7 @@ rtsBool do_full_collection; # if defined(GRAN_CHECK) && defined(GRAN) if ( debug & 0x40 ) - fprintf(main_statsfile,"Saving RunnableThreadsHd %d (proc: %d) -- 0x%lx\n", + fprintf(RTSflags.GcFlags.statsFile,"Saving RunnableThreadsHd %d (proc: %d) -- 0x%lx\n", num_ptr_roots,proc,RunnableThreadsHd[proc]); # endif @@ -517,7 +526,7 @@ rtsBool do_full_collection; # if defined(GRAN_CHECK) && defined(GRAN) if ( debug & 0x40 ) - fprintf(main_statsfile,"Saving RunnableThreadsTl %d (proc: %d) -- 0x%lx\n", + fprintf(RTSflags.GcFlags.statsFile,"Saving RunnableThreadsTl %d (proc: %d) -- 0x%lx\n", num_ptr_roots,proc,RunnableThreadsTl[proc]); # endif StorageMgrInfo.roots[num_ptr_roots++] = RunnableThreadsTl[proc]; @@ -537,7 +546,7 @@ rtsBool do_full_collection; # if defined(GRAN_CHECK) && defined(GRAN) if ( debug & 0x40 ) - fprintf(main_statsfile,"Saving CurrentTSO %d -- 0x%lx\n", + fprintf(RTSflags.GcFlags.statsFile,"Saving CurrentTSO %d -- 0x%lx\n", num_ptr_roots,CurrentTSO); # endif @@ -553,12 +562,10 @@ rtsBool do_full_collection; if (collectHeap(reqsize, &StorageMgrInfo, do_full_collection) != GC_SUCCESS) { - OutOfHeapHook(reqsize * sizeof(W_), SM_word_heap_size * sizeof(W_)); /*msg*/ + OutOfHeapHook(reqsize * sizeof(W_)); /*msg*/ -# if defined(DO_REDN_COUNTING) - if (showRednCountStats) { - PrintRednCountInfo(); - } +# if defined(TICKY_TICKY) + if (RTSflags.TickyFlags.showTickyStats) PrintTickyInfo(); # endif EXIT(EXIT_FAILURE); } @@ -570,7 +577,7 @@ rtsBool do_full_collection; # if defined(GRAN_CHECK) && defined(GRAN) if ( debug & 0x40 ) - fprintf(main_statsfile,"Restoring CurrentTSO %d -- new: 0x%lx\n", + fprintf(RTSflags.GcFlags.statsFile,"Restoring CurrentTSO %d -- new: 0x%lx\n", num_ptr_roots-1,StorageMgrInfo.roots[num_ptr_roots-1]); # endif @@ -599,7 +606,7 @@ rtsBool do_full_collection; # if defined(GRAN_CHECK) && defined(GRAN) if ( debug & 0x40 ) - fprintf(main_statsfile,"Restoring RunnableThreadsTl %d (proc: %d) -- new: 0x%lx\n", + fprintf(RTSflags.GcFlags.statsFile,"Restoring RunnableThreadsTl %d (proc: %d) -- new: 0x%lx\n", num_ptr_roots-1,proc,StorageMgrInfo.roots[num_ptr_roots-1]); # endif @@ -607,7 +614,7 @@ rtsBool do_full_collection; # if defined(GRAN_CHECK) && defined(GRAN) if ( debug & 0x40 ) - fprintf(main_statsfile,"Restoring RunnableThreadsHd %d (proc: %d) -- new: 0x%lx\n", + fprintf(RTSflags.GcFlags.statsFile,"Restoring RunnableThreadsHd %d (proc: %d) -- new: 0x%lx\n", num_ptr_roots,proc,StorageMgrInfo.roots[num_ptr_roots]); # endif @@ -639,7 +646,7 @@ This routine rattles down the B stack, black-holing any pending updates to avoid space leaks from them. \begin{code} -#if !defined(CONCURRENT) && defined(SM_DO_BH_UPDATE) +#if !defined(CONCURRENT) static void @@ -647,7 +654,7 @@ BlackHoleUpdateStack(STG_NO_ARGS) { P_ PtrToUpdateFrame; - if (noBlackHoles) + if (! RTSflags.GcFlags.lazyBlackHoling) return; PtrToUpdateFrame = MAIN_SuB; @@ -663,17 +670,14 @@ BlackHoleUpdateStack(STG_NO_ARGS) PtrToUpdateFrame = GRAB_SuB(PtrToUpdateFrame); } } -#endif /* CONCURRENT && SM_DO_BH_UPDATE */ +#endif /* CONCURRENT */ \end{code} \begin{code} #if defined(CONCURRENT) && !defined(GRAN) void -PerformReschedule(liveness, always_reenter_node) - W_ liveness; - W_ always_reenter_node; - +PerformReschedule(W_ liveness, W_ always_reenter_node) { } #endif \end{code} diff --git a/ghc/runtime/c-as-asm/PerformIO.lhc b/ghc/runtime/c-as-asm/PerformIO.lhc index 1952d0c915..b9d050f6b5 100644 --- a/ghc/runtime/c-as-asm/PerformIO.lhc +++ b/ghc/runtime/c-as-asm/PerformIO.lhc @@ -77,12 +77,7 @@ STGFUN(startPerformIO) used to load the STG registers. */ -#if defined (DO_SPAT_PROFILING) - SET_ACTIVITY(ACT_REDN); /* init: do this first, so we count the restore insns */ -#endif - - /* Load up the real registers from the *_SAVE locns. - */ + /* Load up the real registers from the *_SAVE locns. */ RestoreAllStgRegs(); /* inline! */ /* ------- STG registers are now valid! -------------------------*/ @@ -148,10 +143,6 @@ STGFUN(startEnterInt) { FUNBEGIN; -#if defined (DO_SPAT_PROFILING) - SET_ACTIVITY(ACT_REDN); /* init: do this first so we count restore insns */ -#endif - /* Load up the real registers from the *_SAVE locns. */ #if defined(__STG_GCC_REGS__) RestoreAllStgRegs(); /* inline! */ @@ -211,10 +202,6 @@ STGFUN(startEnterFloat) { FUNBEGIN; -#if defined (DO_SPAT_PROFILING) - SET_ACTIVITY(ACT_REDN); /* init: do this first so we count restore insns */ -#endif - /* Load up the real registers from the *_SAVE locns. */ #if defined(__STG_GCC_REGS__) RestoreAllStgRegs(); /* inline! */ diff --git a/ghc/runtime/c-as-asm/StablePtrOps.lc b/ghc/runtime/c-as-asm/StablePtrOps.lc index 4730355956..dec93aa251 100644 --- a/ghc/runtime/c-as-asm/StablePtrOps.lc +++ b/ghc/runtime/c-as-asm/StablePtrOps.lc @@ -20,29 +20,17 @@ is even more dated.) extern StgPtr unstable_Closure; -#ifndef __STG_TAILJUMPS__ -extern int doSanityChks; -extern void checkAStack(STG_NO_ARGS); -#endif - void enterStablePtr(stableIndex, startCode) StgStablePtr stableIndex; StgFunPtr startCode; { - unstable_Closure = _deRefStablePointer(stableIndex, StorageMgrInfo.StablePointerTable); + unstable_Closure + = _deRefStablePointer(stableIndex, StorageMgrInfo.StablePointerTable); /* ToDo: Set arity to right value - if necessary */ -#if defined(__STG_TAILJUMPS__) - miniInterpret(startCode); -#else - if (doSanityChks) - miniInterpret_debug(startCode, checkAStack); - else miniInterpret(startCode); -#endif /* not tail-jumping */ - } \end{code} diff --git a/ghc/runtime/c-as-asm/StgDebug.lc b/ghc/runtime/c-as-asm/StgDebug.lc index 77b24d0083..3e5b2bc2be 100644 --- a/ghc/runtime/c-as-asm/StgDebug.lc +++ b/ghc/runtime/c-as-asm/StgDebug.lc @@ -63,10 +63,12 @@ Older code (less fancy ==> more reliable) DEBUG_UPDATES(frames) Print "frames" update frames DEBUG_REGS() Print register values DEBUG_MP() Print the MallocPtr Lists + DEBUG_TSO(tso) (CONCURRENT) Print a Thread State Object -\begin{code} -#if defined(RUNTIME_DEBUGGING) +Not yet implemented: + DEBUG_STKO(stko) (CONCURRENT) Print a STacK Object +\begin{code} #include "rtsdefs.h" \end{code} @@ -76,8 +78,8 @@ NB: this assumes a.out files - won't work on Alphas. ToDo: At least add some #ifdefs \begin{code} -#include <a.out.h> -#include <stab.h> +/* #include <a.out.h> */ +/* #include <stab.h> */ /* #include <nlist.h> */ #include <stdio.h> @@ -99,26 +101,26 @@ static int max_table_size; static int table_size; static struct entry* table; -static -void reset_table( int size ) +static void +reset_table( int size ) { max_table_size = size; table_size = 0; - table = (struct entry *) malloc( size * sizeof( struct entry ) ); + table = (struct entry *) stgMallocBytes(size * sizeof(struct entry), "reset_table"); } -static -void prepare_table() +static void +prepare_table() { /* Could sort it... */ } -static -void insert( unsigned value, int index, char *name ) +static void +insert( unsigned value, int index, char *name ) { if ( table_size >= max_table_size ) { fprintf( stderr, "Symbol table overflow\n" ); - exit( 1 ); + EXIT( 1 ); } table[table_size].value = value; table[table_size].index = index; @@ -126,8 +128,8 @@ void insert( unsigned value, int index, char *name ) table_size = table_size + 1; } -static -int lookup( unsigned value, int *result ) +static int +lookup( unsigned value, int *result ) { int i; for( i = 0; i < table_size && table[i].value != value; ++i ) { @@ -140,7 +142,8 @@ int lookup( unsigned value, int *result ) } } -static int lookup_name( char *name, unsigned *result ) +static int +lookup_name( char *name, unsigned *result ) { int i; for( i = 0; i < table_size && strcmp(name,table[i].name) != 0; ++i ) { @@ -339,11 +342,13 @@ static void printName( P_ addr ) } } +#if 0 /* OMIT load-symbol stuff cos it doesn't work on Alphas */ + /* Fairly ad-hoc piece of code that seems to filter out a lot of rubbish like the obj-splitting symbols */ -static -int isReal( unsigned char type, char *name ) +static int +isReal( unsigned char type, char *name ) { int external = type & N_EXT; int tp = type & N_TYPE; @@ -355,7 +360,8 @@ int isReal( unsigned char type, char *name ) } } -void DEBUG_LoadSymbols( char *name ) +void +DEBUG_LoadSymbols( char *name ) { FILE *binary; @@ -381,11 +387,11 @@ void DEBUG_LoadSymbols( char *name ) if (fread( &header, sizeof( struct exec ), 1, binary ) != 1) { fprintf( stderr, "Can't read symbol table header.\n" ); - exit( 1 ); + EXIT( 1 ); } if ( N_BADMAG( header ) ) { fprintf( stderr, "Bad magic number in symbol table header.\n" ); - exit( 1 ); + EXIT( 1 ); } @@ -395,41 +401,30 @@ void DEBUG_LoadSymbols( char *name ) num_syms = sym_size / sizeof( struct nlist ); fseek( binary, sym_offset, FROM_START ); - symbol_table = (struct nlist *) malloc( sym_size ); - if (symbol_table == NULL) { - fprintf( stderr, "Can't allocate symbol table of size %d\n", sym_size ); - exit( 1 ); - } - + symbol_table = (struct nlist *) stgMallocBytes(sym_size, "symbol table (DEBUG_LoadSymbols)"); printf("Reading %d symbols\n", num_syms); if (fread( symbol_table, sym_size, 1, binary ) != 1) { fprintf( stderr, "Can't read symbol table\n"); - exit( 1 ); + EXIT( 1 ); } - - str_offset = N_STROFF( header ); fseek( binary, str_offset, FROM_START ); if (fread( &str_size, 4, 1, binary ) != 1) { fprintf( stderr, "Can't read string table size\n"); - exit( 1 ); + EXIT( 1 ); } /* apparently the size of the string table includes the 4 bytes that * store the size... */ - string_table = (char *) malloc( str_size ); - if (string_table == NULL) { - fprintf( stderr, "Can't allocate string table of size %d\n", str_size ); - exit( 1 ); - } + string_table = (char *) stgMallocBytes(str_size, "string table (DEBUG_LoadSymbols)"); if (fread( string_table+4, str_size-4, 1, binary ) != 1) { fprintf( stderr, "Can't read string table\n"); - exit( 1 ); + EXIT( 1 ); } num_real_syms = 0; @@ -478,6 +473,7 @@ void DEBUG_LoadSymbols( char *name ) prepare_table(); } +#endif /* 0 */ \end{code} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -510,8 +506,7 @@ static int DEBUG_details = 2; \begin{code} /* Determine the size and number of pointers for this kind of closure */ -static -void +static void getClosureShape( P_ node, int *vhs, int *size, int *ptrs, char **type ) { /* The result is used for printing out closure contents. If the @@ -718,28 +713,26 @@ getClosureShape( P_ node, int *vhs, int *size, int *ptrs, char **type ) } } -static -void +static void printWord( W_ word ) { printf("0x%08lx", word); } -static -void +static void printAddress( P_ address ) { -#ifdef PAR +# ifdef CONCURRENT PP_ SpA = STKO_SpA(SAVE_StkO); PP_ SuA = STKO_SuA(SAVE_StkO); P_ SpB = STKO_SpB(SAVE_StkO); P_ SuB = STKO_SuB(SAVE_StkO); -#else +# else PP_ SpA = SAVE_SpA; PP_ SuA = SAVE_SuA; P_ SpB = SAVE_SpB; P_ SuB = SAVE_SuB; -#endif +# endif P_ Hp = SAVE_Hp; PP_ botA = stackInfo.botA; @@ -753,9 +746,13 @@ printAddress( P_ address ) /* The @-1@s in stack comparisions are because we sometimes use the address of just below the stack... */ +#if 0 if (lookupForName( address, &name )) { printZcoded( name ); - } else { + } + else +#endif + { if (DEBUG_details > 1) { printWord( (W_) address ); printf(" : "); @@ -773,8 +770,7 @@ printAddress( P_ address ) } } -static -void +static void printIndentation( int indentation ) { int i; @@ -782,15 +778,14 @@ printIndentation( int indentation ) } /* The weight parameter is used to (eventually) break cycles */ -static -void +static void printStandardShapeClosure( int indentation, int weight, P_ closure, int vhs, int size, int noPtrs ) { -#ifdef PAR +#ifdef CONCURRENT PP_ SpA = STKO_SpA(SAVE_StkO); PP_ SuA = STKO_SuA(SAVE_StkO); P_ SpB = STKO_SpB(SAVE_StkO); @@ -1013,7 +1008,8 @@ minimum(int a, int b) } } -void DEBUG_PrintA( int depth, int weight ) +void +DEBUG_PrintA( int depth, int weight ) { PP_ SpA = SAVE_SpA; PP_ SuA = SAVE_SuA; @@ -1034,7 +1030,8 @@ void DEBUG_PrintA( int depth, int weight ) } } -void DEBUG_PrintB( int depth, int weight ) +void +DEBUG_PrintB( int depth, int weight ) { PP_ SpA = SAVE_SpA; PP_ SuA = SAVE_SuA; @@ -1111,10 +1108,10 @@ ToDo: \begin{code} /* How many real stacks are there on SpA and SpB? */ -static -int numStacks( ) +static int +numStacks( ) { -#ifdef PAR +#ifdef CONCURRENT PP_ SpA = STKO_SpA(SAVE_StkO); PP_ SuA = STKO_SuA(SAVE_StkO); P_ SpB = STKO_SpB(SAVE_StkO); @@ -1136,8 +1133,8 @@ int numStacks( ) return depth; } -static -void printLocalAStack( int depth, int indentation, int weight, PP_ SpA, int size ) +static void +printLocalAStack( int depth, int indentation, int weight, PP_ SpA, int size ) { int i; @@ -1153,8 +1150,8 @@ void printLocalAStack( int depth, int indentation, int weight, PP_ SpA, int size } } -static -void printLocalBStack( int depth, int indentation, int weight, P_ SpB, int size ) +static void +printLocalBStack( int depth, int indentation, int weight, P_ SpB, int size ) { int i; @@ -1170,8 +1167,8 @@ void printLocalBStack( int depth, int indentation, int weight, P_ SpB, int size } } -static -void printEnvironment( int depth, int indentation, int weight, PP_ SpA, PP_ SuA, P_ SpB, P_ SuB ) +static void +printEnvironment( int depth, int indentation, int weight, PP_ SpA, PP_ SuA, P_ SpB, P_ SuB ) { int sizeA = SUBTRACT_A_STK(SpA, SuA); int sizeB = SUBTRACT_B_STK(SpB, SuB); @@ -1215,8 +1212,8 @@ ToDo: \begin{code} static int maxDepth = 5; -static -int printCases( int depth, int weight, PP_ SpA, PP_ SuA, P_ SpB, P_ SuB ) +static int +printCases( int depth, int weight, PP_ SpA, PP_ SuA, P_ SpB, P_ SuB ) { int indentation; @@ -1255,8 +1252,8 @@ int printCases( int depth, int weight, PP_ SpA, PP_ SuA, P_ SpB, P_ SuB ) /* ToDo: pay more attention to format of vector tables in SMupdate.lh */ -static -int isVTBLEntry( P_ entry ) +static int +isVTBLEntry( P_ entry ) { char *raw; @@ -1273,8 +1270,8 @@ int isVTBLEntry( P_ entry ) } } -static -void printVectorTable( int indentation, PP_ vtbl ) +static void +printVectorTable( int indentation, PP_ vtbl ) { if (isVTBLEntry( (P_) vtbl )) { /* Direct return */ printName( (P_) vtbl ); @@ -1290,8 +1287,8 @@ void printVectorTable( int indentation, PP_ vtbl ) } } -static -void printContinuations( int depth, int indentation, int weight, PP_ SpA, PP_ SuA, P_ SpB, P_ SuB ) +static void +printContinuations( int depth, int indentation, int weight, PP_ SpA, PP_ SuA, P_ SpB, P_ SuB ) { if (depth < maxDepth && SUBTRACT_B_STK(SuB, stackInfo.botB) >= 0) { PP_ nextSpA, nextSuA; @@ -1340,10 +1337,10 @@ void printContinuations( int depth, int indentation, int weight, PP_ SpA, PP_ Su } } - -void DEBUG_Where( int depth, int weight ) +void +DEBUG_Where( int depth, int weight ) { -#ifdef PAR +#ifdef CONCURRENT PP_ SpA = STKO_SpA(SAVE_StkO); PP_ SuA = STKO_SuA(SAVE_StkO); P_ SpB = STKO_SpB(SAVE_StkO); @@ -1380,11 +1377,9 @@ void DEBUG_Where( int depth, int weight ) \begin{code} -#if defined(RUNTIME_DEBUGGING) - void DEBUG_INFO_TABLE(node) -P_ node; + P_ node; { int vhs, size, ptrs; /* not used */ char *ip_type; @@ -1404,9 +1399,9 @@ P_ node; fprintf(stderr,"Enter Flush Entry: 0x%lx;\tExit Flush Entry: 0x%lx\n",INFO_FLUSHENT(info_ptr),INFO_FLUSH(info_ptr)); #endif /* PAR */ -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) fprintf(stderr,"Cost Centre: 0x%lx\n",INFO_CAT(info_ptr)); -#endif /* USE_COST_CENTRES */ +#endif /* PROFILING */ #if defined(_INFO_COPYING) fprintf(stderr,"Evacuate Entry: 0x%lx;\tScavenge Entry: 0x%lx\n", @@ -1428,7 +1423,7 @@ P_ node; void DEBUG_REGS() { -#ifdef PAR +#ifdef CONCURRENT PP_ SpA = STKO_SpA(SAVE_StkO); PP_ SuA = STKO_SuA(SAVE_StkO); P_ SpB = STKO_SpB(SAVE_StkO); @@ -1481,6 +1476,8 @@ DEBUG_REGS() fprintf(stderr,"Dble: %8g, %8g\n",DblReg1,DblReg2); } +#ifndef CONCURRENT + void DEBUG_MP() { @@ -1500,7 +1497,7 @@ DEBUG_MP() */ } -#if defined(GCap) || defined(GCgn) +# if defined(GCap) || defined(GCgn) fprintf(stderr,"\nOldMallocPtr List\n\n"); for(mp = StorageMgrInfo.OldMallocPtrList; @@ -1512,12 +1509,11 @@ DEBUG_MP() DEBUG_PRINT_NODE(mp); */ } -#endif /* GCap || GCgn */ +# endif /* GCap || GCgn */ fprintf(stderr, "\n"); } -#ifndef PAR void DEBUG_SPT(int weight) { @@ -1555,23 +1551,21 @@ DEBUG_SPT(int weight) fprintf(stderr, "\n\n"); } -#endif /* !PAR */ - +#endif /* !CONCURRENT */ /* These routines crawl over the A and B stacks, printing a maximum "lines" lines at the top of the stack. */ - #define STACK_VALUES_PER_LINE 5 -#if !defined(PAR) +#ifndef CONCURRENT /* (stack stuff is really different on parallel machines) */ void DEBUG_ASTACK(lines) -I_ lines; + I_ lines; { PP_ SpA = SAVE_SpA; PP_ SuA = SAVE_SuA; @@ -1599,10 +1593,9 @@ I_ lines; fprintf(stderr, "\n"); } - void DEBUG_BSTACK(lines) -I_ lines; + I_ lines; { PP_ SpA = SAVE_SpA; PP_ SuA = SAVE_SuA; @@ -1629,49 +1622,76 @@ I_ lines; } fprintf(stderr, "\n"); } -#endif /* not parallel */ +#endif /* not concurrent */ /* This should disentangle update frames from both stacks. */ -#if ! defined(PAR) +#ifndef CONCURRENT void DEBUG_UPDATES(limit) -I_ limit; + I_ limit; { PP_ SpA = SAVE_SpA; PP_ SuA = SAVE_SuA; P_ SpB = SAVE_SpB; P_ SuB = SAVE_SuB; - P_ updatee, retreg; - PP_ sua; - P_ sub; - PP_ spa = SuA; - P_ spb = SuB; - I_ count = 0; + P_ updatee, retreg; + PP_ sua, spa; + P_ sub, spb; + I_ count = 0; fprintf(stderr,"Update Frame Stack Dump:\n\n"); - for(spb = SuB; + for(spa = SuA, spb = SuB; SUBTRACT_B_STK(spb, stackInfo.botB) > 0 && count++ < limit; - /* re-init given explicitly */) - { + spa = GRAB_SuA(spb), spb = GRAB_SuB(spb) ) { + updatee = GRAB_UPDATEE(spb); /* Thing to be updated */ retreg = (P_) GRAB_RET(spb); /* Return vector below */ - fprintf(stderr,"SuA: 0x%08lx, SuB: 0x%08lx, Updatee 0x%08lx, RetReg 0x%x\n", + fprintf(stderr,"SuA: 0x%08lx, SuB: 0x%08lx, Updatee 0x%08lx (Info 0x%08lx), RetReg 0x%x\n", (W_) spa, (W_) spb, - (W_) updatee, (W_) retreg); + (W_) updatee, (W_) INFO_PTR(updatee), (W_) retreg); + } +} + +#endif /* not concurrent */ +\end{code} - spa = GRAB_SuA(spb); /* Next SuA, SuB */ - spb = GRAB_SuB(spb); +\begin{code} +#ifdef CONCURRENT + +void +DEBUG_TSO(P_ tso) +{ + STGRegisterTable *r = TSO_INTERNAL_PTR(tso); + W_ liveness = r->rLiveness; + I_ i; + + fprintf(stderr,"TSO:\ntso=%lx, regs=%lx, liveness=%lx\nlink=%lx,name=%lx,id=%lx,type=%lx,pc1=%lx,arg1=%lx,switch=%lx\n" + , tso + , r + , liveness + , TSO_LINK(tso) + , TSO_NAME(tso) + , TSO_ID(tso) + , TSO_TYPE(tso) + , TSO_PC1(tso) + , TSO_ARG1(tso) + , TSO_SWITCH(tso) + ); + + for (i = 0; liveness != 0; liveness >>= 1, i++) { + if (liveness & 1) { + fprintf(stderr, "live reg %d (%lx)\n",i, r->rR[i].p); + } else { + fprintf(stderr, "reg %d (%lx) not live\n", i, r->rR[i].p); + } } } -#endif /* not parallel */ - -#endif /* RUNTIME_DEBUGGING */ -#endif /* PAR || RUNTIME_DEBUGGING */ +#endif /* concurrent */ \end{code} diff --git a/ghc/runtime/c-as-asm/StgMiniInt.lc b/ghc/runtime/c-as-asm/StgMiniInt.lc index 2739ad7e83..eaa811f90c 100644 --- a/ghc/runtime/c-as-asm/StgMiniInt.lc +++ b/ghc/runtime/c-as-asm/StgMiniInt.lc @@ -43,12 +43,6 @@ less code. \begin{code} #if defined(__STG_TAILJUMPS__) && defined(__GNUC__) -#if i386_TARGET_ARCH || i486_TARGET_ARCH -/* All together now: "Hack me gently, hack me dead ..." */ -P_ SP_stack[8]; /* two/three? is all that is really needed, I think (WDP) */ -I_ SP_stack_ptr = -1; -#endif - void miniInterpret(start_cont) StgFunPtr start_cont; @@ -154,91 +148,6 @@ void miniInterpretEnd(STG_NO_ARGS) /* ToDo: save real register in something somewhere */ longjmp(jmp_environment, 1); } -\end{code} - -%************************************************************************ -%* * -\subsubsection[StgMiniInt-portable-debugging]{Debugging mini-interpreter for ``portable~C''} -%* * -%************************************************************************ - -See comments about @jmp_environment@ in section above. - -The debugging mini-interpreter, which is invoked if suitable RTS flags -are given, offers two extra ``features:'' -\begin{description} - -\item[Circular buffer of last @NUM_SAVED_CONTINUATIONS@ continuations:] -These are in @savedCont@, with @savedContCtr@ pointing to where the -last one was slotted in. - -Reference is frequently made to this buffer when \tr{gdb}-ing broken C -out of the compiler! - -\item[Hygiene-checking:] - -This version of the mini-interpreter can be given a hygiene-checking -function which will be invoked each time 'round the loop. Again, -given suitable RTS flags, we pass along a routine that walks over the -stack checking for Bad Stuff. An example might be: pointers from the -A stack into the wrong semi-space of the heap (indicating a -garbage-collection bug)... -\end{description} - -\begin{code} -extern I_ doSanityChks; /* ToDo: move tidily */ - -#define NUM_SAVED_CONTINUATIONS 32 /* For debug */ -I_ totalContCtr; -I_ savedContCtr; -StgFunPtr savedCont[NUM_SAVED_CONTINUATIONS]; - -void miniInterpret_debug(start_cont, hygiene) - StgFunPtr start_cont; - void (*hygiene)(); -{ - StgFunPtr continuation = (StgFunPtr) start_cont; - StgFunPtr next_continuation; - jmp_buf save_buf; - bcopy((char *) jmp_environment, (char *) save_buf, sizeof(jmp_buf)); - /* Save jmp_environment for previous call to miniInterpret */ - - if (setjmp(jmp_environment) == 0) { - - totalContCtr = 0; - savedContCtr = 0; - savedCont[0] = start_cont; - - while ( 1 ) { - next_continuation = (StgFunPtr) (continuation)(); - - totalContCtr += 1; - savedContCtr = (savedContCtr + 1) % NUM_SAVED_CONTINUATIONS; - savedCont[savedContCtr] = next_continuation; - - continuation = next_continuation; - - /* hygiene chk can't be at start of loop, because it's the - first continuation-thingy that loads up the registers. - */ - if (doSanityChks && hygiene) { - (hygiene)(); - } - } - } - /* Restore jmp_environment for previous call */ - bcopy((char *) save_buf, (char *) jmp_environment, sizeof(jmp_buf)); - - /* ToDo: restore real registers ... (see longjmp) */ - return; - /* - Note that on returning (after miniInterpretEnd is called) - the values variables declared as real machine registers - will be undefined. - */ -} - -/* debugging version uses same "miniInterpretEnd" as the regular one */ #endif /* ! __STG_TAILJUMPS__ */ \end{code} diff --git a/ghc/runtime/gum/FetchMe.lhc b/ghc/runtime/gum/FetchMe.lhc index 984751d251..05b9dc8b1f 100644 --- a/ghc/runtime/gum/FetchMe.lhc +++ b/ghc/runtime/gum/FetchMe.lhc @@ -55,7 +55,7 @@ STGFUN(FetchMe_entry) QP_Event1("GR", CurrentTSO); } - if(do_gr_profile) { + if (RTSflags.ParFlags.granSimStats) { /* Note that CURRENT_TIME may perform an unsafe call */ TIME now = CURRENT_TIME; TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO); @@ -124,7 +124,7 @@ STGFUN(FMBQ_entry) QP_Event1("GR", CurrentTSO); } - if(do_gr_profile) { + if (RTSflags.ParFlags.granSimStats) { /* Note that CURRENT_TIME may perform an unsafe call */ TIME now = CURRENT_TIME; TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO); diff --git a/ghc/runtime/gum/GlobAddr.lc b/ghc/runtime/gum/GlobAddr.lc index af690e3daf..9ab5360635 100644 --- a/ghc/runtime/gum/GlobAddr.lc +++ b/ghc/runtime/gum/GlobAddr.lc @@ -29,15 +29,13 @@ allocGALA(STG_NO_ARGS) if ((gl = freeGALAList) != NULL) { freeGALAList = gl->next; - } else if ((gl = (GALA *) malloc(GCHUNK * sizeof(GALA))) != NULL) { + } else { + gl = (GALA *) stgMallocBytes(GCHUNK * sizeof(GALA), "allocGALA"); + freeGALAList = gl + 1; for (p = freeGALAList; p < gl + GCHUNK - 1; p++) p->next = p + 1; p->next = NULL; - } else { - fflush(stdout); - fprintf(stderr, "VM exhausted\n"); - EXIT(EXIT_FAILURE); } return gl; } @@ -55,8 +53,7 @@ HashTable *taskIDtoPEtable = NULL; static int nextPE = 0; W_ -taskIDtoPE(gtid) -GLOBAL_TASK_ID gtid; +taskIDtoPE(GLOBAL_TASK_ID gtid) { return (W_) lookupHashTable(taskIDtoPEtable, gtid); } @@ -92,7 +89,7 @@ P_ addr; GALA *gala; /* We never look for GA's on indirections */ - ASSERT(INFO_PTR(addr) != (W_) Ind_info); + ASSERT(INFO_PTR(addr) != (W_) Ind_info_TO_USE); if ((gala = lookupHashTable(LAtoGALAtable, (W_) addr)) == NULL) return NULL; else @@ -119,7 +116,7 @@ P_ GALAlookup(ga) globalAddr *ga; { - W_ pga = PACK_GA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot); + W_ pga = PackGA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot); GALA *gala; P_ la; @@ -128,11 +125,12 @@ globalAddr *ga; else { la = gala->la; /* - * Bypass any indirections when returning a local closure to the caller. - * Note that we do not short-circuit the entry in the GALA tables right - * now, because we would have to do a hash table delete and insert in - * the LAtoGALAtable to keep that table up-to-date for preferred GALA pairs. - * That's probably a bit expensive. + * Bypass any indirections when returning a local closure to + * the caller. Note that we do not short-circuit the entry in + * the GALA tables right now, because we would have to do a + * hash table delete and insert in the LAtoGALAtable to keep + * that table up-to-date for preferred GALA pairs. That's + * probably a bit expensive. */ while (IS_INDIRECTION(INFO_PTR(la))) la = (P_) IND_CLOSURE_PTR(la); @@ -165,8 +163,7 @@ Allocate an indirection slot for the closure currently at address @addr@. \begin{code} static GALA * -allocIndirection(addr) -P_ addr; +allocIndirection(P_ addr) { GALA *gala; @@ -199,7 +196,7 @@ rtsBool preferred; { GALA *oldGALA = lookupHashTable(LAtoGALAtable, (W_) addr); GALA *newGALA = allocIndirection(addr); - W_ pga = PACK_GA(thisPE, newGALA->ga.loc.gc.slot); + W_ pga = PackGA(thisPE, newGALA->ga.loc.gc.slot); ASSERT(GALAlookup(&(newGALA->ga)) == NULL); @@ -241,7 +238,7 @@ rtsBool preferred; { GALA *oldGALA = lookupHashTable(LAtoGALAtable, (W_) addr); GALA *newGALA = allocGALA(); - W_ pga = PACK_GA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot); + W_ pga = PackGA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot); ASSERT(ga->loc.gc.gtid != mytid); ASSERT(ga->weight > 0); @@ -303,7 +300,7 @@ globalAddr * addWeight(ga) globalAddr *ga; { - W_ pga = PACK_GA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot); + W_ pga = PackGA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot); GALA *gala = (GALA *) lookupHashTable(pGAtoGALAtable, pga); #ifdef DEBUG_WEIGHT @@ -357,6 +354,36 @@ RebuildLAGAtable(STG_NO_ARGS) insertHashTable(LAtoGALAtable, (W_) gala->la, (void *) gala); } } +\end{code} + +\begin{code} +W_ +PackGA (pe, slot) + W_ pe; + int slot; +{ + int pe_shift = (BITS_IN(W_)*3)/4; + int pe_bits = BITS_IN(W_) - pe_shift; + + if ( pe_bits < 8 || slot >= (1L << pe_shift) ) { /* big trouble */ + fflush(stdout); + fprintf(stderr, "PackGA: slot# too big (%d) or not enough pe_bits (%d)\n",slot,pe_bits); + EXIT(EXIT_FAILURE); + } + + return((((W_)(pe)) << pe_shift) | ((W_)(slot))); + + /* the idea is to use 3/4 of the bits (e.g., 24) for indirection- + table "slot", and 1/4 for the pe# (e.g., 8). + + We check for too many bits in "slot", and double-check (at + compile-time?) that we have enough bits for "pe". We *don't* + check for too many bits in "pe", because SysMan enforces a + MAX_PEs limit at the very very beginning. + + Phil & Will 95/08 + */ +} #endif /* PAR -- whole file */ \end{code} diff --git a/ghc/runtime/gum/HLComms.lc b/ghc/runtime/gum/HLComms.lc index 8c561ddaf5..450fa0b97f 100644 --- a/ghc/runtime/gum/HLComms.lc +++ b/ghc/runtime/gum/HLComms.lc @@ -24,6 +24,15 @@ sends it. \begin{code} +static W_ *gumPackBuffer; + +void +InitMoreBuffers(STG_NO_ARGS) +{ + gumPackBuffer + = (W_ *) stgMallocWords(RTSflags.ParFlags.packBufferSize, "initMoreBuffers"); +} + void sendFetch(rga, lga, load) globalAddr *rga, *lga; @@ -52,9 +61,7 @@ int load; \begin{code} static void -unpackFetch(lga, rga, load) -globalAddr *lga, *rga; -int *load; +unpackFetch(globalAddr *lga, globalAddr *rga, int *load) { long buf[6]; @@ -105,9 +112,7 @@ P_ data; \begin{code} static void -blockFetch(bf, bh) -P_ bf; -P_ bh; +blockFetch(P_ bf, P_ bh) { switch (INFO_TYPE(INFO_PTR(bh))) { case INFO_BH_TYPE: @@ -117,8 +122,8 @@ P_ bh; #ifdef GC_MUT_REQUIRED /* - * If we modify a black hole in the old generation, we have to make sure it - * goes on the mutables list + * If we modify a black hole in the old generation, we have to + * make sure it goes on the mutables list */ if (bh <= StorageMgrInfo.OldLim) { @@ -171,10 +176,10 @@ processFetches() next = BF_LINK(bf); /* - * Find the target at the end of the indirection chain, and process it in - * much the same fashion as the original target of the fetch. Though we - * hope to find graph here, we could find a black hole (of any flavor) or - * even a FetchMe. + * Find the target at the end of the indirection chain, and + * process it in much the same fashion as the original target + * of the fetch. Though we hope to find graph here, we could + * find a black hole (of any flavor) or even a FetchMe. */ closure = BF_NODE(bf); while (IS_INDIRECTION(INFO_PTR(closure))) @@ -223,10 +228,7 @@ processFetches() \begin{code} static void -unpackResume(lga, nelem, data) -globalAddr *lga; -int *nelem; -StgWord *data; +unpackResume(globalAddr *lga, int *nelem, W_ *data) { long buf[3]; @@ -250,12 +252,13 @@ GLOBAL_TASK_ID task; int ngas; globalAddr *gagamap; { - long buffer[PACK_BUFFER_SIZE - PACK_HDR_SIZE]; + static long *buffer; long *p; int i; - CostCentre Save_CCC = CCC; + buffer = (long *) gumPackBuffer; + CCC = (CostCentre)STATIC_CC_REF(CC_MSG); CCC->scc_count++; @@ -286,9 +289,7 @@ Global addresses \begin{code} static void -unpackAck(ngas, gagamap) -int *ngas; -globalAddr *gagamap; +unpackAck(int *ngas, globalAddr *gagamap) { long GAarraysize; long buf[6]; @@ -345,9 +346,7 @@ fish. The history + hunger are not currently used. \begin{code} static void -unpackFish(origPE, age, history, hunger) -GLOBAL_TASK_ID *origPE; -int *age, *history, *hunger; +unpackFish(GLOBAL_TASK_ID *origPE, int *age, int *history, int *hunger) { long buf[4]; @@ -391,9 +390,7 @@ a data block. \begin{code} static void -unpackFree(nelem, data) -int *nelem; -W_ *data; +unpackFree(int *nelem, W_ *data) { long buf[1]; @@ -440,9 +437,7 @@ block (data). \begin{code} static void -unpackSchedule(nelem, data) -int *nelem; -W_ *data; +unpackSchedule(int *nelem, W_ *data) { long buf[1]; @@ -469,7 +464,6 @@ processFish(STG_NO_ARGS) unpackFish(&origPE, &age, &history, &hunger); - /* Ignore our own fish if we're busy; otherwise send it out after a delay */ if (origPE == mytid) { fishing = rtsFalse; } else { @@ -584,10 +578,11 @@ static void processFree(STG_NO_ARGS) { int nelem; - W_ freeBuffer[PACK_BUFFER_SIZE]; + static W_ *freeBuffer; int i; globalAddr ga; + freeBuffer = gumPackBuffer; unpackFree(&nelem, freeBuffer); #ifdef FREE_DEBUG fprintf(stderr, "Rcvd Free (%d GAs)\n", nelem / 2); @@ -614,16 +609,17 @@ which contains any newly allocated GAs. \begin{code} static void -processResume(sender) -GLOBAL_TASK_ID sender; +processResume(GLOBAL_TASK_ID sender) { int nelem; - W_ packBuffer[PACK_BUFFER_SIZE], nGAs; + W_ nGAs; + static W_ *packBuffer; P_ newGraph; P_ old; globalAddr lga; globalAddr *gagamap; + packBuffer = gumPackBuffer; unpackResume(&lga, &nelem, packBuffer); #ifdef RESUME_DEBUG @@ -634,8 +630,8 @@ GLOBAL_TASK_ID sender; /* * We always unpack the incoming graph, even if we've received the - * requested node in some other data packet (and already awakened the - * blocking queue). + * requested node in some other data packet (and already awakened + * the blocking queue). */ if (SAVE_Hp + packBuffer[0] >= SAVE_HpLim) { ReallyPerformThreadGC(packBuffer[0], rtsFalse); @@ -649,7 +645,7 @@ GLOBAL_TASK_ID sender; old = GALAlookup(&lga); - if (do_gr_profile) { + if (RTSflags.ParFlags.granSimStats) { P_ tso = NULL; if (INFO_TYPE(INFO_PTR(old)) == INFO_FMBQ_TYPE) { @@ -665,8 +661,8 @@ GLOBAL_TASK_ID sender; ASSERT(newGraph != NULL); /* - * Sometimes, unpacking will common up the resumee with the incoming graph, - * but if it hasn't, we'd better do so now. + * Sometimes, unpacking will common up the resumee with the + * incoming graph, but if it hasn't, we'd better do so now. */ if (INFO_TYPE(INFO_PTR(old)) == INFO_FMBQ_TYPE) @@ -687,16 +683,17 @@ which contains any newly allocated GAs. \begin{code} static void -processSchedule(sender) -GLOBAL_TASK_ID sender; +processSchedule(GLOBAL_TASK_ID sender) { int nelem; int space_required; rtsBool success; - W_ packBuffer[PACK_BUFFER_SIZE], nGAs; + static W_ *packBuffer; + W_ nGAs; P_ newGraph; globalAddr *gagamap; + packBuffer = gumPackBuffer; /* HWL */ unpackSchedule(&nelem, packBuffer); #ifdef SCHEDULE_DEBUG @@ -705,9 +702,9 @@ GLOBAL_TASK_ID sender; #endif /* - * For now, the graph is a closure to be sparked as an advisory spark, but in - * future it may be a complete spark with required/advisory status, priority - * etc. + * For now, the graph is a closure to be sparked as an advisory + * spark, but in future it may be a complete spark with + * required/advisory status, priority etc. */ space_required = packBuffer[0]; @@ -752,8 +749,9 @@ processAck(STG_NO_ARGS) #endif /* - * For each (oldGA, newGA) pair, set the GA of the corresponding thunk to the - * newGA, convert the thunk to a FetchMe, and return the weight from the oldGA. + * For each (oldGA, newGA) pair, set the GA of the corresponding + * thunk to the newGA, convert the thunk to a FetchMe, and return + * the weight from the oldGA. */ for (gaga = gagamap; gaga < gagamap + nGAs * 2; gaga += 2) { P_ old = GALAlookup(gaga); @@ -766,14 +764,15 @@ processAck(STG_NO_ARGS) convertToFetchMe(old, ga); } else { /* - * Oops...we've got this one already; update the RBH to point to - * the object we already know about, whatever it happens to be. + * Oops...we've got this one already; update the RBH to + * point to the object we already know about, whatever it + * happens to be. */ CommonUp(old, new); /* - * Increase the weight of the object by the amount just received - * in the second part of the ACK pair. + * Increase the weight of the object by the amount just + * received in the second part of the ACK pair. */ (void) addWeight(gaga + 1); } @@ -805,7 +804,7 @@ processMessages(STG_NO_ARGS) CCC = (CostCentre)STATIC_CC_REF(CC_MSG); do { - if (cc_profiling) { + if (RTSflags.CcFlags.doCostCentres) { CCC = (CostCentre)STATIC_CC_REF(CC_IDLE); CCC->scc_count++; @@ -956,9 +955,10 @@ PACKET packet; } break; - /* Anything we're not prepared to deal with. Note that ALL opcodes are discarded - during termination -- this helps prevent bizarre race conditions. - */ + /* Anything we're not prepared to deal with. Note that ALL + * opcodes are discarded during termination -- this helps + * prevent bizarre race conditions. + */ default: if (!GlobalStopPending) { @@ -1087,19 +1087,14 @@ prepareFreeMsgBuffers(STG_NO_ARGS) /* Allocate the freeMsg buffers just once and then hang onto them. */ if (freeMsgIndex == NULL) { - freeMsgIndex = (int *) malloc(nPEs * sizeof(int)); - freeMsgBuffer = (PP_) malloc(nPEs * sizeof(long *)); - if (freeMsgIndex == NULL || freeMsgBuffer == NULL) { - fflush(stdout); - fprintf(stderr, "VM exhausted\n"); - EXIT(EXIT_FAILURE); - } + + freeMsgIndex = (int *) stgMallocBytes(nPEs * sizeof(int), "prepareFreeMsgBuffers (Index)"); + freeMsgBuffer = (PP_) stgMallocBytes(nPEs * sizeof(long *), "prepareFreeMsgBuffers (Buffer)"); + for(i = 0; i < nPEs; i++) { - if(i != thisPE && - (freeMsgBuffer[i] = (P_) malloc(PACK_BUFFER_SIZE * sizeof(W_))) == NULL) { - fflush(stdout); - fprintf(stderr, "VM exhausted\n"); - EXIT(EXIT_FAILURE); + if (i != thisPE) { + freeMsgBuffer[i] = (P_) stgMallocWords(RTSflags.ParFlags.packBufferSize, + "prepareFreeMsgBuffers (Buffer #i)"); } } } @@ -1118,7 +1113,7 @@ globalAddr *ga; ASSERT(GALAlookup(ga) == NULL); - if ((i = freeMsgIndex[pe]) + 2 >= PACK_BUFFER_SIZE) { + if ((i = freeMsgIndex[pe]) + 2 >= RTSflags.ParFlags.packBufferSize) { #ifdef FREE_DEBUG fprintf(stderr, "Filled a free message buffer\n"); #endif diff --git a/ghc/runtime/gum/Hash.lc b/ghc/runtime/gum/Hash.lc index d4319e121d..71c53db4f8 100644 --- a/ghc/runtime/gum/Hash.lc +++ b/ghc/runtime/gum/Hash.lc @@ -56,9 +56,7 @@ next bucket to be split, re-hash using the larger table. \begin{code} static int -hash(table, key) -HashTable *table; -StgWord key; +hash(HashTable *table, W_ key) { int bucket; @@ -82,15 +80,9 @@ Allocate a new segment of the dynamically growing hash table. \begin{code} static void -allocSegment(table, segment) -HashTable *table; -int segment; +allocSegment(HashTable *table, int segment) { - if ((table->dir[segment] = (HashList **) malloc(HSEGSIZE * sizeof(HashList *))) == NULL) { - fflush(stdout); - fprintf(stderr, "VM exhausted\n"); - EXIT(EXIT_FAILURE); - } + table->dir[segment] = (HashList **) stgMallocBytes(HSEGSIZE * sizeof(HashList *), "allocSegment"); } \end{code} @@ -102,8 +94,7 @@ by @table->split@ is affected by the expansion. \begin{code} static void -expand(table) -HashTable *table; +expand(HashTable *table) { int oldsegment; int oldindex; @@ -201,22 +192,19 @@ allocHashList(STG_NO_ARGS) if ((hl = freeList) != NULL) { freeList = hl->next; - } else if ((hl = (HashList *) malloc(HCHUNK * sizeof(HashList))) != NULL) { + } else { + hl = (HashList *) stgMallocBytes(HCHUNK * sizeof(HashList), "allocHashList"); + freeList = hl + 1; for (p = freeList; p < hl + HCHUNK - 1; p++) p->next = p + 1; p->next = NULL; - } else { - fflush(stdout); - fprintf(stderr, "VM exhausted\n"); - EXIT(EXIT_FAILURE); } return hl; } static void -freeHashList(hl) -HashList *hl; +freeHashList(HashList *hl) { hl->next = freeList; freeList = hl; @@ -347,14 +335,13 @@ allocHashTable(STG_NO_ARGS) HashTable *table; HashList **hb; - if ((table = (HashTable *) malloc(sizeof(HashTable))) == NULL) { - fflush(stdout); - fprintf(stderr, "VM exhausted\n"); - EXIT(EXIT_FAILURE); - } + table = (HashTable *) stgMallocBytes(sizeof(HashTable),"allocHashTable"); + allocSegment(table, 0); + for (hb = table->dir[0]; hb < table->dir[0] + HSEGSIZE; hb++) *hb = NULL; + table->split = 0; table->max = HSEGSIZE; table->mask1 = HSEGSIZE - 1; diff --git a/ghc/runtime/gum/LLComms.lc b/ghc/runtime/gum/LLComms.lc index 8839bde065..d88f50d9fd 100644 --- a/ghc/runtime/gum/LLComms.lc +++ b/ghc/runtime/gum/LLComms.lc @@ -67,13 +67,13 @@ unsigned op; return ("Unknown PE Opcode"); } -void NullException(STG_NO_ARGS) +void +NullException(STG_NO_ARGS) { fprintf(stderr,"Null_Exception: called"); } -void (*ExceptionHandler)() = NullException; - +void (*ExceptionHandler)() = NullException; \end{code} @trace_SendOp@ handles the tracing of messages at the OS level. If @@ -87,10 +87,7 @@ last message sent was for a PE or an IMU. rtsBool PETrace = rtsFalse, IMUTrace = rtsFalse, SystemTrace = rtsFalse, ReplyTrace = rtsFalse; static void -trace_SendOp(op, dest, data1, data2) -OPCODE op; -GLOBAL_TASK_ID dest; -unsigned data1, data2; +trace_SendOp(OPCODE op, GLOBAL_TASK_ID dest, unsigned int data1, unsigned int data2) { char *OpName; @@ -164,28 +161,14 @@ For example, \end{verbatim} \begin{code} - -#ifdef __STDC__ void SendOpV(OPCODE op, GLOBAL_TASK_ID task, int n, ...) -#else -void -SendOpV(op, task, n, va_alist) -OPCODE op; -GLOBAL_TASK_ID task; -int n; -va_dcl -#endif { va_list ap; int i; StgWord arg; -#ifdef __STDC__ va_start(ap, n); -#else - va_start(ap); -#endif trace_SendOp(op, task, 0, 0); @@ -216,29 +199,14 @@ Important: The variable arguments must all be StgWords. \begin{code} -#ifdef __STDC__ void SendOpNV(OPCODE op, GLOBAL_TASK_ID task, int nelem, StgWord *datablock, int narg, ...) -#else -void -SendOpNV(op, task, nelem, datablock, narg, va_alist) -OPCODE op; -GLOBAL_TASK_ID task; -int nelem; -StgWord *datablock; -int narg; -va_dcl -#endif { va_list ap; int i; StgWord arg; -#ifdef __STDC__ va_start(ap, narg); -#else - va_start(ap); -#endif trace_SendOp(op, task, 0, 0); /* fprintf(stderr,"SendOpNV: op = %x, task = %x, narg = %d, nelem = %d\n",op,task,narg,nelem); */ @@ -368,28 +336,15 @@ synchronises with the other PEs. Finally it receives from Control the array of Global Task Ids. \begin{code} - -static char * -xmalloc(n) -unsigned n; -{ - char *p = malloc(n); - - if (p == NULL) { - fprintf(stderr, "Memory allocation of %u bytes failed\n", n); - EXIT(EXIT_FAILURE); - } - return p; -} - GLOBAL_TASK_ID * PEStartUp(nPEs) unsigned nPEs; { int i; PACKET addr; - long *buffer = (long *) xmalloc(sizeof(long) * nPEs); - GLOBAL_TASK_ID *PEs = (GLOBAL_TASK_ID *) xmalloc(sizeof(GLOBAL_TASK_ID) * nPEs); + long *buffer = (long *) stgMallocBytes(sizeof(long) * nPEs, "PEStartUp (buffer)"); + GLOBAL_TASK_ID *PEs + = (GLOBAL_TASK_ID *) stgMallocBytes(sizeof(GLOBAL_TASK_ID) * nPEs, "PEStartUp (PEs)"); mytid = _my_gtid; /* Initialise PVM and get task id into global * variable */ diff --git a/ghc/runtime/gum/Pack.lc b/ghc/runtime/gum/Pack.lc index f6f1dfc1b5..4290c8a9a7 100644 --- a/ghc/runtime/gum/Pack.lc +++ b/ghc/runtime/gum/Pack.lc @@ -22,7 +22,8 @@ system (GUM). Static data and code declarations. \begin{code} -static W_ PackBuffer[PACK_BUFFER_SIZE+PACK_HDR_SIZE]; +static W_ *PackBuffer = NULL; /* size: can be set via option */ + static W_ packlocn, clqsize, clqpos; static W_ unpackedsize; static W_ reservedPAsize; /*Space reserved for primitive arrays*/ @@ -66,6 +67,8 @@ W_ *packbuffersize; { /* Ensure enough heap for all possible RBH_Save closures */ + ASSERT(RTSflags.ParFlags.packBufferSize > 0); + if (SAVE_Hp + PACK_HEAP_REQUIRED > SAVE_HpLim) return NULL; @@ -80,7 +83,7 @@ W_ *packbuffersize; PackBuffer[0] = unpackedsize; /* Set the size parameter */ - ASSERT(packlocn <= PACK_BUFFER_SIZE); + ASSERT(packlocn <= RTSflags.ParFlags.packBufferSize); *packbuffersize = packlocn; DonePacking(); @@ -146,8 +149,8 @@ P_ closure; W_ size, ptrs, nonptrs, vhs; int i, clpacklocn; - while ((P_) INFO_PTR(closure) == Ind_info) { /* Don't pack indirection - * closures */ + while (IS_INDIRECTION(INFO_PTR(closure))) { + /* Don't pack indirection closures */ #ifdef PACK_DEBUG fprintf(stderr, "Shorted an indirection at %x", closure); #endif @@ -161,9 +164,10 @@ P_ closure; P_ info; /* - * PLCs reside on all of the PEs already. Just pack the address as a GA (a - * bit of a kludge, since an address may not fit in *any* of the individual - * GA fields). Const, charlike and small intlike closures are converted into + * PLCs reside on all of the PEs already. Just pack the + * address as a GA (a bit of a kludge, since an address may + * not fit in *any* of the individual GA fields). Const, + * charlike and small intlike closures are converted into * PLCs. */ switch (INFO_TYPE(INFO_PTR(closure))) { @@ -320,10 +324,10 @@ data into the pack buffer and increments the pack location. \begin{code} static void Pack(data) -W_ data; + W_ data; { - ASSERT(packlocn < PACK_BUFFER_SIZE); - PackBuffer[packlocn++] = data; + ASSERT(packlocn < RTSflags.ParFlags.packBufferSize); + PackBuffer[packlocn++] = data; } \end{code} @@ -400,9 +404,24 @@ static HashTable *offsettable; @InitPacking@ initialises the packing buffer etc. \begin{code} +void +InitPackBuffer(STG_NO_ARGS) +{ + if (PackBuffer == NULL) { /* not yet allocated */ + + PackBuffer = (W_ *) stgMallocWords(RTSflags.ParFlags.packBufferSize+PACK_HDR_SIZE, + "InitPackBuffer"); + + InitPendingGABuffer(RTSflags.ParFlags.packBufferSize); + AllocClosureQueue(RTSflags.ParFlags.packBufferSize); + } +} + static void InitPacking(STG_NO_ARGS) { + /* InitPackBuffer(); now done in ParInit HWL_ */ + packlocn = PACK_HDR_SIZE; unpackedsize = 0; reservedPAsize = 0; @@ -445,8 +464,7 @@ packed. \begin{code} static int -OffsetFor(closure) -P_ closure; +OffsetFor(P_ closure) { return (int) (W_) lookupHashTable(offsettable, (W_) closure); } @@ -480,7 +498,7 @@ W_ size, ptrs; { if (RoomInBuffer && (packlocn + reservedPAsize + size + - ((clqsize - clqpos) + ptrs) * PACK_FETCHME_SIZE >= PACK_BUFFER_SIZE)) { + ((clqsize - clqpos) + ptrs) * PACK_FETCHME_SIZE >= RTSflags.ParFlags.packBufferSize)) { #ifdef PACK_DEBUG fprintf(stderr, "Buffer full\n"); #endif @@ -500,16 +518,29 @@ These routines manage the closure queue. \begin{code} static W_ clqpos, clqsize; -static P_ ClosureQueue[PACK_BUFFER_SIZE]; + +static P_ *ClosureQueue = NULL; /* HWL: init in main */ \end{code} @InitClosureQueue@ initialises the closure queue. \begin{code} void +AllocClosureQueue(size) + W_ size; +{ + ASSERT(ClosureQueue == NULL); + ClosureQueue = (P_ *) stgMallocWords(size, "AllocClosureQueue"); +} + +void InitClosureQueue(STG_NO_ARGS) { clqpos = clqsize = 0; + + if ( ClosureQueue == NULL ) { + AllocClosureQueue(RTSflags.ParFlags.packBufferSize); + } } \end{code} @@ -531,7 +562,7 @@ void QueueClosure(closure) P_ closure; { - if(clqsize < PACK_BUFFER_SIZE) + if(clqsize < RTSflags.ParFlags.packBufferSize) ClosureQueue[clqsize++] = closure; else { diff --git a/ghc/runtime/gum/ParInit.lc b/ghc/runtime/gum/ParInit.lc index d1e29c0b98..780c676e80 100644 --- a/ghc/runtime/gum/ParInit.lc +++ b/ghc/runtime/gum/ParInit.lc @@ -49,13 +49,11 @@ Flag handling. \begin{code} rtsBool TraceSparks = rtsFalse; /* Enable the spark trace mode */ -rtsBool OutputDisabled = rtsFalse; /* Disable output for performance purposes */ rtsBool SparkLocally = rtsFalse; /* Use local threads if possible */ rtsBool DelaySparks = rtsFalse; /* Use delayed sparking */ rtsBool LocalSparkStrategy = rtsFalse; /* Either delayed threads or local threads */ rtsBool GlobalSparkStrategy = rtsFalse; /* Export all threads */ -rtsBool ParallelStats = rtsFalse; /* Gather parallel statistics */ rtsBool DeferGlobalUpdates = rtsFalse; /* Defer updating of global nodes */ rtsBool fishing = rtsFalse; /* We have no fish out in the stream */ \end{code} @@ -71,10 +69,9 @@ StgPtr program_closure; return; /* Show that we've started */ - if (IAmMainThread && !OutputDisabled) + if (IAmMainThread && ! RTSflags.ParFlags.outputDisabled) fprintf(stderr, "Starting main program...\n"); - /* Record the start time for statistics purposes. */ main_start_time = usertime(); /* fprintf(stderr, "Start time is %u\n", main_start_time); */ @@ -108,7 +105,7 @@ I_ n; else WaitForPEOp(PP_FINISH, SysManTask); PEShutDown(); - fprintf(stderr,"Processor %lx shutting down, %ld Threads run\n", mytid, threadId); + fprintf(stderr,"PE %lx shutting down, %ld Threads run, %ld Sparks Ignored\n", (W_) mytid, threadId, sparksIgnored); /* And actually terminate -- always with code 0 */ longjmp(exit_parallel_system, 1); @@ -122,17 +119,18 @@ time_t time PROTO((time_t *)); void initParallelSystem(STG_NO_ARGS) { - - /* Don't buffer standard channels... */ - setbuf(stdout,NULL); - setbuf(stderr,NULL); - - srand48(time(NULL) * getpid()); /*Initialise Random-number generator seed*/ - - OkToGC = rtsFalse; /* Must not GC till we have set up the environment */ - /* because C is hanging onto heap pointers */ - /* maybe bogus for the new RTS? -- KH */ - /* And for the GUM system? PWT */ + /* Don't buffer standard channels... */ + setbuf(stdout,NULL); + setbuf(stderr,NULL); + + srand48(time(NULL) * getpid()); /*Initialise Random-number generator seed*/ + + OkToGC = rtsFalse; /* Must not GC till we have set up the environment */ + /* because C is hanging onto heap pointers */ + /* maybe bogus for the new RTS? -- KH */ + /* And for the GUM system? PWT */ + InitPackBuffer(); + InitMoreBuffers(); } \end{code} diff --git a/ghc/runtime/gum/RBH.lc b/ghc/runtime/gum/RBH.lc index 5661671dbf..956dd5097b 100644 --- a/ghc/runtime/gum/RBH.lc +++ b/ghc/runtime/gum/RBH.lc @@ -13,7 +13,7 @@ #include "rtsdefs.h" \end{code} -Turn a closure into a revertable black hole. After the conversion, +Turn a closure into a revertible black hole. After the conversion, the first two words of the closure will be a link to the mutables list (if appropriate for the garbage collector), and a pointer to the blocking queue. The blocking queue is terminated by a 2-word diff --git a/ghc/runtime/gum/SysMan.lc b/ghc/runtime/gum/SysMan.lc index 830f19d227..e18aaad637 100644 --- a/ghc/runtime/gum/SysMan.lc +++ b/ghc/runtime/gum/SysMan.lc @@ -52,9 +52,7 @@ HandleException(STG_NO_ARGS) \end{code} \begin{code} -main(argc, argv) -int argc; -char **argv; +main(int argc, char **argv) { int rbufid; int opcode, nbytes; @@ -113,7 +111,22 @@ char **argv; #endif } - /* Join the PE sysman groups in order to allow barrier synchronisation */ + /* + SysMan joins PECTLGROUP, so that it can wait (at the + barrier sysnchronisation a few instructions later) for the + other PE-tasks to start. + + Other comments on PVM groupery: + + The manager group (MGRGROUP) is vestigial at the moment. It + may eventually include a statistics manager, garbage + collector manager. + + I suspect that you're [Kei Davis] right: Sysman shouldn't + be in PEGROUP, it's a hangover from GRIP. + + (Phil Trinder, 95/10) + */ checkerr(pvm_joingroup(PECTLGROUP)); #if 0 fprintf(stderr, "Joined PECTLGROUP /* PWT */\n"); @@ -232,6 +245,7 @@ char **argv; } } } + return(0); } \end{code} diff --git a/ghc/runtime/gum/Unpack.lc b/ghc/runtime/gum/Unpack.lc index 96a7d622bc..52b4cad8d2 100644 --- a/ghc/runtime/gum/Unpack.lc +++ b/ghc/runtime/gum/Unpack.lc @@ -23,7 +23,15 @@ EXTDATA_RO(FetchMe_info); Local Definitions. \begin{code} -static globalAddr PendingGABuffer[(PACK_BUFFER_SIZE-PACK_HDR_SIZE)*2]; +static globalAddr *PendingGABuffer; /* HWL; init in main; */ + +void +InitPendingGABuffer(size) +W_ size; +{ + PendingGABuffer + = (globalAddr *) stgMallocBytes((size-PACK_HDR_SIZE)*2*sizeof(globalAddr), "InitPendingGABuffer"); +} \end{code} @CommonUp@ commons up two closures which we have discovered to be @@ -31,9 +39,7 @@ variants of the same object. One is made an indirection to the other. \begin{code} void -CommonUp(src, dst) -P_ src; -P_ dst; +CommonUp(P_ src, P_ dst) { P_ bqe; @@ -95,8 +101,11 @@ W_ *nGAs; W_ pptr = 0, pptrs = 0, pvhs; int i; + globalAddr *gaga; + + InitPackBuffer(); /* in case it isn't already init'd */ - globalAddr *gaga = PendingGABuffer; + gaga = PendingGABuffer; InitClosureQueue(); @@ -169,7 +178,7 @@ W_ *nGAs; graph[FIXED_HS + i + vhs + ptrs] = *bufptr++; /* Indirections are never packed */ - ASSERT(INFO_PTR(graph) != (W_) Ind_info); + ASSERT(INFO_PTR(graph) != (W_) Ind_info_TO_USE); /* Add to queue for processing */ QueueClosure(graph); diff --git a/ghc/runtime/hooks/OutOfHeap.lc b/ghc/runtime/hooks/OutOfHeap.lc index 22d2b4a4e4..a1c6110489 100644 --- a/ghc/runtime/hooks/OutOfHeap.lc +++ b/ghc/runtime/hooks/OutOfHeap.lc @@ -2,10 +2,11 @@ #include "rtsdefs.h" void -OutOfHeapHook (request_size, heap_size) +OutOfHeapHook (request_size) W_ request_size; /* in bytes */ - W_ heap_size; /* in bytes */ { + W_ heap_size = RTSflags.GcFlags.heapSize * sizeof(W_); /* i.e., in bytes */ + fprintf(stderr, "Heap exhausted;\nwhile trying to allocate %lu bytes in a %lu-byte heap;\nuse `+RTS -H<size>' to increase the total heap size.\n", request_size, heap_size); diff --git a/ghc/runtime/hooks/OutOfVM.lc b/ghc/runtime/hooks/OutOfVM.lc index 9a33cec8ad..60345320ec 100644 --- a/ghc/runtime/hooks/OutOfVM.lc +++ b/ghc/runtime/hooks/OutOfVM.lc @@ -2,9 +2,10 @@ #include "rtsdefs.h" void -MallocFailHook (request_size) +MallocFailHook (request_size, msg) I_ request_size; /* in bytes */ + char *msg; { - fprintf(stderr, "malloc: failed on request for %lu bytes\n", request_size); + fprintf(stderr, "malloc: failed on request for %lu bytes; message: %s\n", request_size, msg); } \end{code} diff --git a/ghc/runtime/hooks/SizeHooks.lc b/ghc/runtime/hooks/SizeHooks.lc index 43059c11a4..acf0d2edcf 100644 --- a/ghc/runtime/hooks/SizeHooks.lc +++ b/ghc/runtime/hooks/SizeHooks.lc @@ -1,8 +1,15 @@ \begin{code} #include "rtsdefs.h" -#include "storage/SMinternal.h" /* DEFAULT_* here */ -I_ SM_word_heap_size = DEFAULT_HEAP_SIZE; -StgFloat SM_pc_free_heap = DEFAULT_PC_FREE; -I_ SM_word_stk_size = DEFAULT_STACKS_SIZE; +void +defaultsHook (void) +{ /* this is called *after* RTSflags has had + its defaults set, but *before* we start + processing the RTS command-line options. + + This default version does *nothing*. + The user may provide a more interesting + one. + */ +} \end{code} diff --git a/ghc/runtime/io/env.lc b/ghc/runtime/io/env.lc index 2e26595657..7ee20c1ceb 100644 --- a/ghc/runtime/io/env.lc +++ b/ghc/runtime/io/env.lc @@ -21,13 +21,15 @@ should continue to work properly. int dirtyEnv = 0; /* - * For some reason, OSF turns off the prototype for this if we're _POSIX_SOURCE. - * Seems to me that this ought to be an ANSI-ism rather than a POSIX-ism, - * but no matter. + * For some reason, OSF turns off the prototype for this if we're + * _POSIX_SOURCE. Seems to me that this ought to be an ANSI-ism + * rather than a POSIX-ism, but no matter. (JSM(?)) */ char * -strdup(const char *src) +strdup(char *src) /* should be "const char *" but then some + bozo OS (e.g., AIX) will come along and disagree. + The alt is to rename this routine (WDP 96/01) */ { int len = strlen(src) + 1; char *dst; diff --git a/ghc/runtime/io/getCPUTime.lc b/ghc/runtime/io/getCPUTime.lc index 9c8230784a..0a5d1a5c7f 100644 --- a/ghc/runtime/io/getCPUTime.lc +++ b/ghc/runtime/io/getCPUTime.lc @@ -50,10 +50,11 @@ * seconds to overflow 31 bits. */ -StgAddr -getCPUTime(STG_NO_ARGS) +StgByteArray +getCPUTime(cpuStruct) +StgByteArray cpuStruct; { - static StgInt cpu[4]; + StgInt *cpu=(StgInt *)cpuStruct; #if defined(HAVE_GETRUSAGE) && ! irix_TARGET_OS struct rusage t; @@ -84,7 +85,7 @@ getCPUTime(STG_NO_ARGS) return NULL; # endif #endif - return (StgAddr) cpu; + return (StgByteArray) cpuStruct; } \end{code} diff --git a/ghc/runtime/io/getDirectoryContents.lc b/ghc/runtime/io/getDirectoryContents.lc index da54d7d26a..025aae9751 100644 --- a/ghc/runtime/io/getDirectoryContents.lc +++ b/ghc/runtime/io/getDirectoryContents.lc @@ -27,9 +27,7 @@ /* For cleanup of partial answer on error */ static void -freeEntries(entries, count) - char **entries; - int count; +freeEntries(char **entries, int count) { int i; diff --git a/ghc/runtime/io/ghcReadline.lc b/ghc/runtime/io/ghcReadline.lc index 1d2133b8ec..ee8022b516 100644 --- a/ghc/runtime/io/ghcReadline.lc +++ b/ghc/runtime/io/ghcReadline.lc @@ -7,6 +7,8 @@ \begin{code} #include "rtsdefs.h" + +#include "ghcReadline.h" /* to make sure the code here agrees...*/ \end{code} Wrapper around the callback mechanism to allow Haskell side functions @@ -18,8 +20,7 @@ function. Before exiting, the Haskell function will deposit its result in the global variable $rl_return$. \begin{code} - -int current_narg, rl_return, current_kc; +I_ current_narg, rl_return, current_kc; char* rl_prompt_hack; @@ -27,7 +28,8 @@ StgStablePtr haskellRlEntry; StgStablePtr cbackList; -int genericRlCback (int narg,int kc) +I_ +genericRlCback (I_ narg, I_ kc) { current_narg = narg; current_kc = kc; diff --git a/ghc/runtime/io/showTime.lc b/ghc/runtime/io/showTime.lc index 79f66892cb..124dabd6d0 100644 --- a/ghc/runtime/io/showTime.lc +++ b/ghc/runtime/io/showTime.lc @@ -13,35 +13,36 @@ #endif StgAddr -showTime(size, d) +showTime(size, d, buf) StgInt size; StgByteArray d; +StgByteArray buf; { time_t t; struct tm *tm; - static char buf[32]; switch(size) { default: - return (StgAddr) "ClockTime.show{LibTime}: out of range"; + return (StgAddr)strcpy(buf, "ClockTime.show{LibTime}: out of range"); case 0: t = 0; break; case -1: t = - (time_t) ((StgInt *)d)[0]; if (t > 0) - return (StgAddr) "ClockTime.show{LibTime}: out of range"; + return + (StgAddr)strcpy(buf, "ClockTime.show{LibTime}: out of range"); break; case 1: t = (time_t) ((StgInt *)d)[0]; if (t < 0) - return (StgAddr) "ClockTime.show{LibTime}: out of range"; + return (StgAddr) strcpy(buf, "ClockTime.show{LibTime}: out of range"); break; } tm = localtime(&t); - if (tm != NULL && strftime(buf, sizeof(buf), "%a %b %d %T %Z %Y", tm) > 0) - return (StgAddr) buf; - return (StgAddr) "ClockTime.show{LibTime}: internal error"; + if (tm != NULL && strftime(buf, 32 /*Magic number*/, "%a %b %d %T %Z %Y", tm) > 0) + return (StgAddr)buf; + return (StgAddr)strcpy(buf, "ClockTime.show{LibTime}: internal error"); } \end{code} diff --git a/ghc/runtime/io/toClockSec.lc b/ghc/runtime/io/toClockSec.lc index d00da864c7..6ff42473a2 100644 --- a/ghc/runtime/io/toClockSec.lc +++ b/ghc/runtime/io/toClockSec.lc @@ -10,7 +10,7 @@ #include "timezone.h" StgAddr -toClockSec(year, mon, mday, hour, min, sec, tz) +toClockSec(year, mon, mday, hour, min, sec, tz, res) StgInt year; StgInt mon; StgInt mday; @@ -18,9 +18,10 @@ StgInt hour; StgInt min; StgInt sec; StgInt tz; +StgByteArray res; { struct tm tm; - static time_t t; + time_t t; tm.tm_year = year - 1900; tm.tm_mon = mon; @@ -41,8 +42,9 @@ StgInt tz; #endif if (t == (time_t) -1) return NULL; - else - return &t; + + *(time_t *)res = t; + return res; } \end{code} diff --git a/ghc/runtime/io/toLocalTime.lc b/ghc/runtime/io/toLocalTime.lc index 50a5a104c8..b930ae11ca 100644 --- a/ghc/runtime/io/toLocalTime.lc +++ b/ghc/runtime/io/toLocalTime.lc @@ -9,14 +9,14 @@ #include "stgio.h" #include "timezone.h" -StgAddr -toLocalTime(size, d) +StgAddr +toLocalTime(size, d, res) StgInt size; StgByteArray d; +StgByteArray res; { + struct tm *tm,*tmp=(struct tm *)res; time_t t; - struct tm *tm; - static struct tm cache_tm; switch(size) { default: @@ -40,8 +40,32 @@ StgByteArray d; if (tm == NULL) return NULL; - cache_tm = *tm; - return &cache_tm; + /* + localtime() may return a ptr to statically allocated storage, + so to make toLocalTime reentrant, we manually copy + the structure into the (struct tm *) passed in. + */ + tmp->tm_sec = tm->tm_sec; + tmp->tm_min = tm->tm_min; + tmp->tm_hour = tm->tm_hour; + tmp->tm_mday = tm->tm_mday; + tmp->tm_mon = tm->tm_mon; + tmp->tm_year = tm->tm_year; + tmp->tm_wday = tm->tm_wday; + tmp->tm_yday = tm->tm_yday; + tmp->tm_isdst = tm->tm_isdst; + /* + If you don't have tm_zone in (struct tm), but + you get at it via the shared tmzone[], you'll + lose. Same goes for the tm_gmtoff field. + + */ +#if HAVE_TM_ZONE + strcpy(tmp->tm_zone,tm->tm_zone); + tmp->tm_gmtoff = tm->tm_gmtoff; +#endif + + return (StgAddr)res; } \end{code} diff --git a/ghc/runtime/io/toUTCTime.lc b/ghc/runtime/io/toUTCTime.lc index 1442993ea0..e7555595a5 100644 --- a/ghc/runtime/io/toUTCTime.lc +++ b/ghc/runtime/io/toUTCTime.lc @@ -10,13 +10,13 @@ #include "timezone.h" StgAddr -toUTCTime(size, d) +toUTCTime(size, d, res) StgInt size; StgByteArray d; +StgByteArray res; { time_t t; - struct tm *tm; - static struct tm cache_tm; + struct tm *tm,*tmp=(struct tm *)res; switch(size) { default: @@ -40,8 +40,32 @@ StgByteArray d; if (tm == NULL) return NULL; - cache_tm = *tm; - return &cache_tm; + /* + gmtime() may return a ptr to statically allocated storage, + so to make toUTCTime reentrant, we manually copy + the structure into the (struct tm *) passed in. + */ + tmp->tm_sec = tm->tm_sec; + tmp->tm_min = tm->tm_min; + tmp->tm_hour = tm->tm_hour; + tmp->tm_mday = tm->tm_mday; + tmp->tm_mon = tm->tm_mon; + tmp->tm_year = tm->tm_year; + tmp->tm_wday = tm->tm_wday; + tmp->tm_yday = tm->tm_yday; + tmp->tm_isdst = tm->tm_isdst; + /* + If you don't have tm_zone in (struct tm), but + you get at it via the shared tmzone[], you'll + lose. Same goes for the tm_gmtoff field. + + */ +#if HAVE_TM_ZONE + strcpy(tmp->tm_zone,tm->tm_zone); + tmp->tm_gmtoff = tm->tm_gmtoff; +#endif + + return (StgAddr)res; } \end{code} diff --git a/ghc/runtime/main/GranSim.lc b/ghc/runtime/main/GranSim.lc index eb7d303f99..f4650c4a80 100644 --- a/ghc/runtime/main/GranSim.lc +++ b/ghc/runtime/main/GranSim.lc @@ -120,7 +120,7 @@ newevent(proc,creator,time,evttype,tso,node,spark) P_ tso, node; sparkq spark; { - eventq newentry = (eventq) xmalloc(sizeof(struct event)); + eventq newentry = (eventq) stgMallocBytes(sizeof(struct event), "newevent"); EVENT_PROC(newentry) = proc; EVENT_CREATOR(newentry) = creator; @@ -225,9 +225,9 @@ W_ id; void DumpGranEventAndNode(name, tso, node, proc) -enum gran_event_types name; -P_ tso, node; -PROC proc; + enum gran_event_types name; + P_ tso, node; + PROC proc; { PROC pe = CURRENT_PROC; W_ id; @@ -243,7 +243,7 @@ PROC proc; if (name > GR_EVENT_MAX) name = GR_EVENT_MAX; - if (do_gr_binary) { + if (RTSflags.ParFlags.granSimStats_Binary) { grputw(name); grputw(pe); abort(); /* die please: a single word doesn't represent long long times */ @@ -267,7 +267,7 @@ W_ id; ullong_format_string(CURRENT_TIME, time_string, rtsFalse/*no commas!*/); - if (do_gr_binary) { + if (RTSflags.ParFlags.granSimStats_Binary) { grputw(name); grputw(pe); abort(); /* die please: a single word doesn't represent long long times */ @@ -287,7 +287,7 @@ rtsBool mandatory_thread; char time_string[500]; /* ToDo: kill magic constant */ ullong_format_string(CURRENT_TIME, time_string, rtsFalse/*no commas!*/); - if (do_gr_binary) { + if (RTSflags.ParFlags.granSimStats_Binary) { grputw(GR_END); grputw(pe); abort(); /* die please: a single word doesn't represent long long times */ @@ -444,7 +444,7 @@ int prog_argc, rts_argc; I_ i; if (do_gr_sim) { - char *extension = do_gr_binary ? "gb" : "gr"; + char *extension = RTSflags.ParFlags.granSimStats_Binary ? "gb" : "gr"; sprintf(gr_filename, GR_FILENAME_FMT, prog_argv[0], extension); @@ -516,7 +516,7 @@ int prog_argc, rts_argc; gran_load_cost, gran_store_cost, gran_float_cost, gran_heapalloc_cost); fputs("\n\n++++++++++++++++++++\n\n", gr_file); } - if (do_gr_binary) + if (RTSflags.ParFlags.granSimStats_Binary) grputw(sizeof(TIME)); Idlers = max_proc; @@ -538,18 +538,16 @@ end_gr_simulation(STG_NO_ARGS) #ifdef PAR char gr_filename[STATS_FILENAME_MAXLEN]; -I_ do_gr_profile = 0; I_ do_sp_profile = 0; -I_ do_gr_binary = 0; void init_gr_profiling(rts_argc, rts_argv, prog_argc, prog_argv) -char *prog_argv[], *rts_argv[]; -int prog_argc, rts_argc; + char *prog_argv[], *rts_argv[]; + int prog_argc, rts_argc; { int i; - char *extension = do_gr_binary ? "gb" : "gr"; + char *extension = RTSflags.ParFlags.granSimStats_Binary ? "gb" : "gr"; sprintf(gr_filename, GR_FILENAME_FMT_GUM, prog_argv[0], thisPE, extension); @@ -584,7 +582,7 @@ int prog_argc, rts_argc; fprintf(gr_file, "PE %2u [%lu]: TIME\n", thisPE, (TIME) startTime); } - if (do_gr_binary) + if (RTSflags.ParFlags.granSimStats_Binary) grputw(sizeof(TIME)); } #endif /* PAR */ diff --git a/ghc/runtime/main/Itimer.lc b/ghc/runtime/main/Itimer.lc index 87c146064a..8847c7c39e 100644 --- a/ghc/runtime/main/Itimer.lc +++ b/ghc/runtime/main/Itimer.lc @@ -18,7 +18,7 @@ to support. So much for standards. \begin{code} -#if defined(USE_COST_CENTRES) || defined(CONCURRENT) +#if defined(PROFILING) || defined(CONCURRENT) # include "platform.h" @@ -79,6 +79,6 @@ int ms; } # endif -#endif /* USE_COST_CENTRES || CONCURRENT */ +#endif /* PROFILING || CONCURRENT */ \end{code} diff --git a/ghc/runtime/main/Mallocs.lc b/ghc/runtime/main/Mallocs.lc new file mode 100644 index 0000000000..5a8ed4b322 --- /dev/null +++ b/ghc/runtime/main/Mallocs.lc @@ -0,0 +1,40 @@ +%---------------------------------------------------------------* +% +\section{Wrappers around malloc} +% +%---------------------------------------------------------------* + +Routines that deal with memory allocation: + +A LONG-AGO WISH: All dynamic allocation must be done before the stacks +and heap are allocated. This allows us to use the lower level sbrk +routines if required. + +ANOTHER ONE: Should allow use of valloc to align on page boundary. + +\begin{code} +#include "rtsdefs.h" + +char * +stgMallocBytes(n, msg) + I_ n; + char *msg; +{ + char *space; + + if ((space = (char *) malloc((size_t) n)) == NULL) { + fflush(stdout); + MallocFailHook((W_) n, msg); /*msg*/ + EXIT(EXIT_FAILURE); + } + return space; +} + +char * +stgMallocWords(n, msg) + I_ n; + char *msg; +{ + return(stgMallocBytes(n * sizeof(W_), msg)); +} +\end{code} diff --git a/ghc/runtime/main/RednCounts.lc b/ghc/runtime/main/RednCounts.lc deleted file mode 100644 index 142dc8423c..0000000000 --- a/ghc/runtime/main/RednCounts.lc +++ /dev/null @@ -1,682 +0,0 @@ -% -% (c) The GRASP Project, Glasgow University, 1992-1993 -% -%************************************************************************ -%* * -\section[RednCounts.lc]{Stuff for ``ticky-ticky'' profiling} -%* * -%************************************************************************ - -Goes with \tr{imports/RednCounts.lh}; more documentation there. - -%************************************************************************ -%* * -\subsection[RednCounts-counters]{Declare all the counters} -%* * -%************************************************************************ - -\begin{code} -#define NULL_REG_MAP /* Not threaded */ - -#include "../storage/SMinternal.h" /* Bad boy, Will (ToDo) */ - -#if defined(DO_REDN_COUNTING) - -extern FILE *tickyfile; - -I_ ALLOC_HEAP_ctr = 0; -I_ ALLOC_HEAP_tot = 0; - -PP_ max_SpA; /* set in re_enterable_part_of_main */ -P_ max_SpB; - -/* not used at all -I_ A_STK_REUSE_ctr = 0; -I_ B_STK_REUSE_ctr = 0; -*/ -I_ A_STK_STUB_ctr = 0; - -I_ ALLOC_FUN_ctr = 0; -I_ ALLOC_FUN_adm = 0; -I_ ALLOC_FUN_gds = 0; -I_ ALLOC_FUN_slp = 0; -I_ ALLOC_FUN_hst[5] = {0,0,0,0,0}; -I_ ALLOC_THK_ctr = 0; -I_ ALLOC_THK_adm = 0; -I_ ALLOC_THK_gds = 0; -I_ ALLOC_THK_slp = 0; -I_ ALLOC_THK_hst[5] = {0,0,0,0,0}; -I_ ALLOC_CON_ctr = 0; -I_ ALLOC_CON_adm = 0; -I_ ALLOC_CON_gds = 0; -I_ ALLOC_CON_slp = 0; -I_ ALLOC_CON_hst[5] = {0,0,0,0,0}; -I_ ALLOC_TUP_ctr = 0; -I_ ALLOC_TUP_adm = 0; -I_ ALLOC_TUP_gds = 0; -I_ ALLOC_TUP_slp = 0; -I_ ALLOC_TUP_hst[5] = {0,0,0,0,0}; -I_ ALLOC_BH_ctr = 0; -I_ ALLOC_BH_adm = 0; -I_ ALLOC_BH_gds = 0; -I_ ALLOC_BH_slp = 0; -I_ ALLOC_BH_hst[5] = {0,0,0,0,0}; -/* -I_ ALLOC_PAP_ctr = 0; -I_ ALLOC_PAP_adm = 0; -I_ ALLOC_PAP_gds = 0; -I_ ALLOC_PAP_slp = 0; -I_ ALLOC_PAP_hst[5] = {0,0,0,0,0}; -*/ -I_ ALLOC_PRIM_ctr = 0; -I_ ALLOC_PRIM_adm = 0; -I_ ALLOC_PRIM_gds = 0; -I_ ALLOC_PRIM_slp = 0; -I_ ALLOC_PRIM_hst[5] = {0,0,0,0,0}; -/* -I_ ALLOC_UPD_CON_ctr = 0; -I_ ALLOC_UPD_CON_adm = 0; -I_ ALLOC_UPD_CON_gds = 0; -I_ ALLOC_UPD_CON_slp = 0; -I_ ALLOC_UPD_CON_hst[5] = {0,0,0,0,0}; -*/ -I_ ALLOC_UPD_PAP_ctr = 0; -I_ ALLOC_UPD_PAP_adm = 0; -I_ ALLOC_UPD_PAP_gds = 0; -I_ ALLOC_UPD_PAP_slp = 0; -I_ ALLOC_UPD_PAP_hst[5] = {0,0,0,0,0}; - -#ifdef CONCURRENT -I_ ALLOC_STK_ctr = 0; -I_ ALLOC_STK_adm = 0; -I_ ALLOC_STK_gds = 0; -I_ ALLOC_STK_slp = 0; -I_ ALLOC_STK_hst[5] = {0,0,0,0,0}; -I_ ALLOC_TSO_ctr = 0; -I_ ALLOC_TSO_adm = 0; -I_ ALLOC_TSO_gds = 0; -I_ ALLOC_TSO_slp = 0; -I_ ALLOC_TSO_hst[5] = {0,0,0,0,0}; - -#ifdef PAR -I_ ALLOC_FMBQ_ctr = 0; -I_ ALLOC_FMBQ_adm = 0; -I_ ALLOC_FMBQ_gds = 0; -I_ ALLOC_FMBQ_slp = 0; -I_ ALLOC_FMBQ_hst[5] = {0,0,0,0,0}; -I_ ALLOC_FME_ctr = 0; -I_ ALLOC_FME_adm = 0; -I_ ALLOC_FME_gds = 0; -I_ ALLOC_FME_slp = 0; -I_ ALLOC_FME_hst[5] = {0,0,0,0,0}; -I_ ALLOC_BF_ctr = 0; -I_ ALLOC_BF_adm = 0; -I_ ALLOC_BF_gds = 0; -I_ ALLOC_BF_slp = 0; -I_ ALLOC_BF_hst[5] = {0,0,0,0,0}; -#endif -#endif - -I_ ENT_VIA_NODE_ctr = 0; -I_ ENT_CON_ctr = 0; -I_ ENT_FUN_STD_ctr = 0; -I_ ENT_FUN_DIRECT_ctr = 0; -I_ ENT_IND_ctr = 0; -I_ ENT_PAP_ctr = 0; -I_ ENT_THK_ctr = 0; - -I_ RET_NEW_IN_HEAP_ctr = 0; -I_ RET_NEW_IN_REGS_ctr = 0; -I_ RET_OLD_IN_HEAP_ctr = 0; -I_ RET_OLD_IN_REGS_ctr = 0; -I_ RET_SEMI_BY_DEFAULT_ctr = 0; -I_ RET_SEMI_IN_HEAP_ctr = 0; -I_ RET_SEMI_IN_REGS_ctr = 0; -I_ VEC_RETURN_ctr = 0; - -I_ ReturnInRegsNodeValid = 0; /* i.e., False */ - -I_ UPDF_OMITTED_ctr = 0; -I_ UPDF_STD_PUSHED_ctr = 0; -I_ UPDF_CON_PUSHED_ctr = 0; -I_ UPDF_HOLE_PUSHED_ctr = 0; - -I_ UPDF_RCC_PUSHED_ctr = 0; -I_ UPDF_RCC_OMITTED_ctr = 0; - -I_ UPD_EXISTING_ctr = 0; -I_ UPD_CON_W_NODE_ctr = 0; -I_ UPD_CON_IN_PLACE_ctr = 0; -I_ UPD_CON_IN_NEW_ctr = 0; -I_ UPD_PAP_IN_PLACE_ctr = 0; -I_ UPD_PAP_IN_NEW_ctr = 0; - -I_ UPD_ENTERED_ctr = 0; -I_ UPD_ENTERED_AGAIN_ctr = 0; - -I_ UPD_NEW_IND_ctr = 0; -I_ UPD_NEW_IN_PLACE_PTRS_ctr = 0; -I_ UPD_NEW_IN_PLACE_NOPTRS_ctr = 0; -I_ UPD_OLD_IND_ctr = 0; -I_ UPD_OLD_IN_PLACE_PTRS_ctr = 0; -I_ UPD_OLD_IN_PLACE_NOPTRS_ctr = 0; - -I_ UPD_IN_PLACE_COPY_ctr = 0; -\end{code} - -\begin{code} -#if 0 -/* testing only */ -void -TICKY_PARANOIA(const char *file, I_ line) -{ - I_ tot_adm_wds = /* total number of admin words allocated */ - ALLOC_FUN_adm + ALLOC_THK_adm + ALLOC_CON_adm + ALLOC_TUP_adm + - ALLOC_BH_adm /*+ ALLOC_PAP_adm*/ /*+ ALLOC_UPD_CON_adm*/ + ALLOC_UPD_PAP_adm + - ALLOC_PRIM_adm; - I_ tot_gds_wds = /* total number of words of ``good stuff'' allocated */ - ALLOC_FUN_gds + ALLOC_THK_gds + ALLOC_CON_gds + ALLOC_TUP_gds + - ALLOC_BH_gds /*+ ALLOC_PAP_gds*/ /*+ ALLOC_UPD_CON_gds*/ + ALLOC_UPD_PAP_gds + - ALLOC_PRIM_gds; - I_ tot_slp_wds = /* total number of ``slop'' words allocated */ - ALLOC_FUN_slp + ALLOC_THK_slp + ALLOC_CON_slp + ALLOC_TUP_slp + - ALLOC_BH_slp /*+ ALLOC_PAP_slp*/ /*+ ALLOC_UPD_CON_slp*/ + ALLOC_UPD_PAP_slp + - ALLOC_PRIM_slp; - I_ tot_wds = /* total words */ - tot_adm_wds + tot_gds_wds + tot_slp_wds; - if (ALLOC_HEAP_tot != tot_wds) { - fprintf(stderr, "Eek! %ld != %ld, %s, %d\n",ALLOC_HEAP_tot, tot_wds, file, line); - } else { - fprintf(stderr, "OK. %ld != %ld, %s, %d\n",ALLOC_HEAP_tot, tot_wds, file, line); - } -} -#endif /* 0 */ -\end{code} - -%************************************************************************ -%* * -\subsection[RednCounts-print]{Print out all the counters} -%* * -%************************************************************************ - -\begin{code} -extern void printRegisteredCounterInfo (STG_NO_ARGS); /* fwd decl */ - -#define INTAVG(a,b) ((b == 0) ? 0.0 : ((StgDouble) (a) / (StgDouble) (b))) -#define PC(a) (100.0 * a) - -#define AVG(thing) \ - StgDouble CAT2(avg,thing) = INTAVG(CAT2(tot,thing),CAT2(ctr,thing)) - -void -PrintRednCountInfo() -{ - I_ tot_allocs = /* total number of things allocated */ - ALLOC_FUN_ctr + ALLOC_THK_ctr + ALLOC_CON_ctr + ALLOC_TUP_ctr + -#ifdef CONCURRENT - ALLOC_STK_ctr + ALLOC_TSO_ctr + -#ifdef PAR - ALLOC_FMBQ_ctr + ALLOC_FME_ctr + ALLOC_BF_ctr + -#endif -#endif - ALLOC_BH_ctr /*+ ALLOC_PAP_ctr*/ /*+ ALLOC_UPD_CON_ctr*/ + ALLOC_UPD_PAP_ctr + - ALLOC_PRIM_ctr; - I_ tot_adm_wds = /* total number of admin words allocated */ - ALLOC_FUN_adm + ALLOC_THK_adm + ALLOC_CON_adm + ALLOC_TUP_adm + -#ifdef CONCURRENT - ALLOC_STK_adm + ALLOC_TSO_adm + -#ifdef PAR - ALLOC_FMBQ_adm + ALLOC_FME_adm + ALLOC_BF_adm + -#endif -#endif - ALLOC_BH_adm /*+ ALLOC_PAP_adm*/ /*+ ALLOC_UPD_CON_adm*/ + ALLOC_UPD_PAP_adm + - ALLOC_PRIM_adm; - I_ tot_gds_wds = /* total number of words of ``good stuff'' allocated */ - ALLOC_FUN_gds + ALLOC_THK_gds + ALLOC_CON_gds + ALLOC_TUP_gds + -#ifdef CONCURRENT - ALLOC_STK_gds + ALLOC_TSO_gds + -#ifdef PAR - ALLOC_FMBQ_gds + ALLOC_FME_gds + ALLOC_BF_gds + -#endif -#endif - ALLOC_BH_gds /*+ ALLOC_PAP_gds*/ /*+ ALLOC_UPD_CON_gds*/ + ALLOC_UPD_PAP_gds + - ALLOC_PRIM_gds; - I_ tot_slp_wds = /* total number of ``slop'' words allocated */ - ALLOC_FUN_slp + ALLOC_THK_slp + ALLOC_CON_slp + ALLOC_TUP_slp + -#ifdef CONCURRENT - ALLOC_STK_slp + ALLOC_TSO_slp + -#ifdef PAR - ALLOC_FMBQ_slp + ALLOC_FME_slp + ALLOC_BF_slp + -#endif -#endif - ALLOC_BH_slp /*+ ALLOC_PAP_slp*/ /*+ ALLOC_UPD_CON_slp*/ + ALLOC_UPD_PAP_slp + - ALLOC_PRIM_slp; - I_ tot_wds = /* total words */ - tot_adm_wds + tot_gds_wds + tot_slp_wds; - - I_ tot_enters = - ENT_CON_ctr + ENT_FUN_DIRECT_ctr + - ENT_IND_ctr + ENT_PAP_ctr + ENT_THK_ctr; - I_ jump_direct_enters = - tot_enters - ENT_VIA_NODE_ctr; - I_ bypass_enters = - ENT_FUN_DIRECT_ctr - - (ENT_FUN_STD_ctr - UPD_PAP_IN_PLACE_ctr - UPD_PAP_IN_NEW_ctr); - - I_ tot_returns_in_regs = - RET_NEW_IN_REGS_ctr + RET_OLD_IN_REGS_ctr + RET_SEMI_IN_REGS_ctr; - I_ tot_returns_in_heap = - RET_NEW_IN_HEAP_ctr + RET_OLD_IN_HEAP_ctr + RET_SEMI_IN_HEAP_ctr + RET_SEMI_BY_DEFAULT_ctr/*???*/; - I_ tot_returns_of_new = - RET_NEW_IN_REGS_ctr + RET_NEW_IN_HEAP_ctr; - I_ tot_returns_of_old = /* NB: NOT USED ???! 94/05 WDP */ - RET_OLD_IN_REGS_ctr + RET_OLD_IN_HEAP_ctr + - RET_SEMI_BY_DEFAULT_ctr + RET_SEMI_IN_HEAP_ctr + RET_SEMI_IN_REGS_ctr /*???*/; - - I_ tot_returns = - tot_returns_in_regs + tot_returns_in_heap; - - I_ tot_upd_frames = - UPDF_STD_PUSHED_ctr + UPDF_CON_PUSHED_ctr; /*DBH*/ - - I_ con_updates = - UPD_CON_W_NODE_ctr + UPD_CON_IN_PLACE_ctr + UPD_CON_IN_NEW_ctr; - I_ pap_updates = - UPD_PAP_IN_PLACE_ctr + UPD_PAP_IN_NEW_ctr; - I_ tot_updates = - UPD_EXISTING_ctr + con_updates + pap_updates; - I_ tot_in_place_updates = - UPD_CON_IN_PLACE_ctr + UPD_PAP_IN_PLACE_ctr; - - I_ tot_new_updates = - UPD_NEW_IN_PLACE_NOPTRS_ctr + UPD_NEW_IN_PLACE_PTRS_ctr + UPD_NEW_IND_ctr; - I_ tot_old_updates = - UPD_OLD_IN_PLACE_NOPTRS_ctr + UPD_OLD_IN_PLACE_PTRS_ctr + UPD_OLD_IND_ctr; - I_ tot_gengc_updates = - tot_new_updates + tot_old_updates; - - fprintf(tickyfile,"\n\nALLOCATIONS: %ld (%ld words total: %ld admin, %ld goods, %ld slop)\n", - tot_allocs, tot_wds, tot_adm_wds, tot_gds_wds, tot_slp_wds); - fprintf(tickyfile,"\t\t\t\ttotal words:\t 2 3 4 5 6+\n"); - -#define ALLOC_HISTO_MAGIC(categ) \ - (PC(INTAVG(CAT3(ALLOC_,categ,_hst)[0], CAT3(ALLOC_,categ,_ctr)))), \ - (PC(INTAVG(CAT3(ALLOC_,categ,_hst)[1], CAT3(ALLOC_,categ,_ctr)))), \ - (PC(INTAVG(CAT3(ALLOC_,categ,_hst)[2], CAT3(ALLOC_,categ,_ctr)))), \ - (PC(INTAVG(CAT3(ALLOC_,categ,_hst)[3], CAT3(ALLOC_,categ,_ctr)))), \ - (PC(INTAVG(CAT3(ALLOC_,categ,_hst)[4], CAT3(ALLOC_,categ,_ctr)))) - - fprintf(tickyfile,"%7ld (%5.1f%%) function values", - ALLOC_FUN_ctr, - PC(INTAVG(ALLOC_FUN_ctr, tot_allocs))); - if (ALLOC_FUN_ctr != 0) - fprintf(tickyfile,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(FUN)); - - fprintf(tickyfile,"\n%7ld (%5.1f%%) thunks", - ALLOC_THK_ctr, - PC(INTAVG(ALLOC_THK_ctr, tot_allocs))); - if (ALLOC_THK_ctr != 0) - fprintf(tickyfile,"\t\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(THK)); - - fprintf(tickyfile,"\n%7ld (%5.1f%%) data values", - ALLOC_CON_ctr, - PC(INTAVG(ALLOC_CON_ctr, tot_allocs))); - if (ALLOC_CON_ctr != 0) - fprintf(tickyfile,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(CON)); - - fprintf(tickyfile,"\n%7ld (%5.1f%%) big tuples", - ALLOC_TUP_ctr, - PC(INTAVG(ALLOC_TUP_ctr, tot_allocs))); - if (ALLOC_TUP_ctr != 0) - fprintf(tickyfile,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(TUP)); - - fprintf(tickyfile,"\n%7ld (%5.1f%%) black holes", - ALLOC_BH_ctr, - PC(INTAVG(ALLOC_BH_ctr, tot_allocs))); - if (ALLOC_BH_ctr != 0) - fprintf(tickyfile,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(BH)); - - fprintf(tickyfile,"\n%7ld (%5.1f%%) prim things", - ALLOC_PRIM_ctr, - PC(INTAVG(ALLOC_PRIM_ctr, tot_allocs))); - if (ALLOC_PRIM_ctr != 0) - fprintf(tickyfile,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(PRIM)); - -#if 0 - fprintf(tickyfile,"\n%7ld (%5.1f%%) partial applications", - ALLOC_PAP_ctr, - PC(INTAVG(ALLOC_PAP_ctr, tot_allocs))); - if (ALLOC_PAP_ctr != 0) - fprintf(tickyfile,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(PAP)); -#endif /* 0 */ - - fprintf(tickyfile,"\n%7ld (%5.1f%%) partial applications", - ALLOC_UPD_PAP_ctr, - PC(INTAVG(ALLOC_UPD_PAP_ctr, tot_allocs))); - if (ALLOC_UPD_PAP_ctr != 0) - fprintf(tickyfile,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(UPD_PAP)); - -#if 0 - fprintf(tickyfile,"\n%7ld (%5.1f%%) data-value updates", - ALLOC_UPD_CON_ctr, - PC(INTAVG(ALLOC_UPD_CON_ctr, tot_allocs))); - if (ALLOC_UPD_CON_ctr != 0) - fprintf(tickyfile,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(UPD_CON)); -#endif /* 0 */ - -#ifdef CONCURRENT - fprintf(tickyfile,"\n%7ld (%5.1f%%) stack objects", - ALLOC_STK_ctr, - PC(INTAVG(ALLOC_STK_ctr, tot_allocs))); - if (ALLOC_STK_ctr != 0) - fprintf(tickyfile,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(STK)); - fprintf(tickyfile,"\n%7ld (%5.1f%%) thread state objects", - ALLOC_TSO_ctr, - PC(INTAVG(ALLOC_TSO_ctr, tot_allocs))); - if (ALLOC_TSO_ctr != 0) - fprintf(tickyfile,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(TSO)); -#ifdef PAR - fprintf(tickyfile,"\n%7ld (%5.1f%%) thread state objects", - ALLOC_FMBQ_ctr, - PC(INTAVG(ALLOC_FMBQ_ctr, tot_allocs))); - if (ALLOC_FMBQ_ctr != 0) - fprintf(tickyfile,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(FMBQ)); - fprintf(tickyfile,"\n%7ld (%5.1f%%) thread state objects", - ALLOC_FME_ctr, - PC(INTAVG(ALLOC_FME_ctr, tot_allocs))); - if (ALLOC_FME_ctr != 0) - fprintf(tickyfile,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(FME)); - fprintf(tickyfile,"\n%7ld (%5.1f%%) thread state objects", - ALLOC_BF_ctr, - PC(INTAVG(ALLOC_BF_ctr, tot_allocs))); - if (ALLOC_BF_ctr != 0) - fprintf(tickyfile,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(BF)); -#endif -#endif - fprintf(tickyfile,"\n"); - - fprintf(tickyfile,"\nTotal storage-manager allocations: %ld (%ld words)\n\t[%ld words lost to speculative heap-checks]\n", ALLOC_HEAP_ctr, ALLOC_HEAP_tot, ALLOC_HEAP_tot - tot_wds); - - fprintf(tickyfile,"\nSTACK USAGE:\n"); /* NB: some bits are direction sensitive */ - fprintf(tickyfile,"\tA stack slots stubbed: %ld\n", A_STK_STUB_ctr); -/* not used at all - fprintf(tickyfile,"\tA stack slots re-used: %ld\n", A_STK_REUSE_ctr); - fprintf(tickyfile,"\tB stack slots re-used: %ld\n", B_STK_REUSE_ctr); -*/ -#ifndef CONCURRENT - fprintf(tickyfile,"\tA stack max. depth: %ld words\n", - (I_) (stackInfo.botA - max_SpA)); - fprintf(tickyfile,"\tB stack max. depth: %ld words\n", - (I_) (max_SpB - stackInfo.botB)); /* And cheating, too (ToDo) */ -#endif - - fprintf(tickyfile,"\nENTERS: %ld of which %ld (%.1f%%) direct to the entry code\n\t\t [the rest indirected via Node's info ptr]\n", - tot_enters, - jump_direct_enters, - PC(INTAVG(jump_direct_enters,tot_enters))); - fprintf(tickyfile,"%7ld (%5.1f%%) thunks\n", - ENT_THK_ctr, - PC(INTAVG(ENT_THK_ctr,tot_enters))); - fprintf(tickyfile,"%7ld (%5.1f%%) data values\n", - ENT_CON_ctr, - PC(INTAVG(ENT_CON_ctr,tot_enters))); - fprintf(tickyfile,"%7ld (%5.1f%%) function values\n\t\t [of which %ld (%.1f%%) bypassed arg-satisfaction chk]\n", - ENT_FUN_DIRECT_ctr, - PC(INTAVG(ENT_FUN_DIRECT_ctr,tot_enters)), - bypass_enters, - PC(INTAVG(bypass_enters,ENT_FUN_DIRECT_ctr))); - fprintf(tickyfile,"%7ld (%5.1f%%) partial applications\n", - ENT_PAP_ctr, - PC(INTAVG(ENT_PAP_ctr,tot_enters))); - fprintf(tickyfile,"%7ld (%5.1f%%) indirections\n", - ENT_IND_ctr, - PC(INTAVG(ENT_IND_ctr,tot_enters))); - - fprintf(tickyfile,"\nRETURNS: %ld\n", tot_returns); - fprintf(tickyfile,"%7ld (%5.1f%%) in registers [the rest in the heap]\n", - tot_returns_in_regs, - PC(INTAVG(tot_returns_in_regs,tot_returns))); - fprintf(tickyfile,"%7ld (%5.1f%%) from entering a new constructor\n\t\t [the rest from entering an existing constructor]\n", - tot_returns_of_new, - PC(INTAVG(tot_returns_of_new,tot_returns))); - fprintf(tickyfile,"%7ld (%5.1f%%) vectored [the rest unvectored]\n", - VEC_RETURN_ctr, - PC(INTAVG(VEC_RETURN_ctr,tot_returns))); - - fprintf(tickyfile,"\nUPDATE FRAMES: %ld (%ld omitted from thunks)\n", - tot_upd_frames, - UPDF_OMITTED_ctr); - fprintf(tickyfile,"%7ld (%5.1f%%) standard frames\n", - UPDF_STD_PUSHED_ctr, - PC(INTAVG(UPDF_STD_PUSHED_ctr,tot_upd_frames))); - fprintf(tickyfile,"%7ld (%5.1f%%) constructor frames\n", - UPDF_CON_PUSHED_ctr, - PC(INTAVG(UPDF_CON_PUSHED_ctr,tot_upd_frames))); - fprintf(tickyfile,"\t\t [of which %ld (%.1f%%) were for black-holes]\n", - UPDF_HOLE_PUSHED_ctr, - PC(INTAVG(UPDF_HOLE_PUSHED_ctr,UPDF_CON_PUSHED_ctr))); /*DBH*/ - - if (UPDF_RCC_PUSHED_ctr != 0) - fprintf(tickyfile,"%7ld restore cost centre frames (%ld omitted)\n", - UPDF_RCC_PUSHED_ctr, - UPDF_RCC_OMITTED_ctr); - - fprintf(tickyfile,"\nUPDATES: %ld\n", tot_updates); - fprintf(tickyfile,"%7ld (%5.1f%%) data values\n\t\t [%ld in place, %ld allocated new space, %ld with Node]\n", - con_updates, - PC(INTAVG(con_updates,tot_updates)), - UPD_CON_IN_PLACE_ctr, UPD_CON_IN_NEW_ctr, UPD_CON_W_NODE_ctr); - fprintf(tickyfile,"%7ld (%5.1f%%) partial applications\n\t\t [%ld in place, %ld allocated new space]\n", - pap_updates, - PC(INTAVG(pap_updates,tot_updates)), - UPD_PAP_IN_PLACE_ctr, UPD_PAP_IN_NEW_ctr); - fprintf(tickyfile,"%7ld (%5.1f%%) updates to existing heap objects\n", - UPD_EXISTING_ctr, - PC(INTAVG(UPD_EXISTING_ctr,tot_updates))); - fprintf(tickyfile,"%7ld (%5.1f%%) in-place updates copied\n", - UPD_IN_PLACE_COPY_ctr, - PC(INTAVG(UPD_IN_PLACE_COPY_ctr,tot_in_place_updates))); - if (UPD_ENTERED_ctr != 0) { - fprintf(tickyfile,"%7ld (%5.1f%%) subsequently entered\n", - UPD_ENTERED_ctr, - PC(INTAVG(UPD_ENTERED_ctr,tot_updates))); - fprintf(tickyfile,"%7ld (%5.1f%%) subsequently entered more than once\n", - UPD_ENTERED_AGAIN_ctr, - PC(INTAVG(UPD_ENTERED_AGAIN_ctr,tot_updates))); - } - - if (tot_gengc_updates != 0) { - fprintf(tickyfile,"\nNEW GEN UPDATES: %ld (%5.1f%%)\n", - tot_new_updates, - PC(INTAVG(tot_new_updates,tot_gengc_updates))); - fprintf(tickyfile,"%7ld (%5.1f%%) indirections\n", - UPD_NEW_IND_ctr, - PC(INTAVG(UPD_NEW_IND_ctr,tot_gengc_updates))); - fprintf(tickyfile,"%7ld (%5.1f%%) inplace with ptrs\n", - UPD_NEW_IN_PLACE_PTRS_ctr, - PC(INTAVG(UPD_NEW_IN_PLACE_PTRS_ctr,tot_gengc_updates))); - fprintf(tickyfile,"%7ld (%5.1f%%) inplace without ptrs\n", - UPD_NEW_IN_PLACE_NOPTRS_ctr, - PC(INTAVG(UPD_NEW_IN_PLACE_NOPTRS_ctr,tot_gengc_updates))); - fprintf(tickyfile,"\nOLD GEN UPDATES: %ld (%5.1f%%)\n", - tot_old_updates, - PC(INTAVG(tot_old_updates,tot_gengc_updates))); - fprintf(tickyfile,"%7ld (%5.1f%%) indirections\n", - UPD_OLD_IND_ctr, - PC(INTAVG(UPD_OLD_IND_ctr,tot_gengc_updates))); - fprintf(tickyfile,"%7ld (%5.1f%%) inplace with ptrs\n", - UPD_OLD_IN_PLACE_PTRS_ctr, - PC(INTAVG(UPD_OLD_IN_PLACE_PTRS_ctr,tot_gengc_updates))); - fprintf(tickyfile,"%7ld (%5.1f%%) inplace without ptrs\n", - UPD_OLD_IN_PLACE_NOPTRS_ctr, - PC(INTAVG(UPD_OLD_IN_PLACE_NOPTRS_ctr,tot_gengc_updates))); - } - - printRegisteredCounterInfo(); - - fprintf(tickyfile,"\n**************************************************\n"); - fprintf(tickyfile,"%6ld ALLOC_HEAP_ctr\n", ALLOC_HEAP_ctr); - fprintf(tickyfile,"%6ld ALLOC_HEAP_tot\n", ALLOC_HEAP_tot); - -#ifndef CONCURRENT - fprintf(tickyfile,"%6ld HWM_SpA\n", (I_) (stackInfo.botA - max_SpA)); - fprintf(tickyfile,"%6ld HWM_SpB\n", (I_) (max_SpB - stackInfo.botB)); -#endif - - fprintf(tickyfile,"%6ld ALLOC_FUN_ctr\n", ALLOC_FUN_ctr); - fprintf(tickyfile,"%6ld ALLOC_FUN_adm\n", ALLOC_FUN_adm); - fprintf(tickyfile,"%6ld ALLOC_FUN_gds\n", ALLOC_FUN_gds); - fprintf(tickyfile,"%6ld ALLOC_FUN_slp\n", ALLOC_FUN_slp); - fprintf(tickyfile,"%6ld ALLOC_THK_ctr\n", ALLOC_THK_ctr); - fprintf(tickyfile,"%6ld ALLOC_THK_adm\n", ALLOC_THK_adm); - fprintf(tickyfile,"%6ld ALLOC_THK_gds\n", ALLOC_THK_gds); - fprintf(tickyfile,"%6ld ALLOC_THK_slp\n", ALLOC_THK_slp); - fprintf(tickyfile,"%6ld ALLOC_CON_ctr\n", ALLOC_CON_ctr); - fprintf(tickyfile,"%6ld ALLOC_CON_adm\n", ALLOC_CON_adm); - fprintf(tickyfile,"%6ld ALLOC_CON_gds\n", ALLOC_CON_gds); - fprintf(tickyfile,"%6ld ALLOC_CON_slp\n", ALLOC_CON_slp); - fprintf(tickyfile,"%6ld ALLOC_TUP_ctr\n", ALLOC_TUP_ctr); - fprintf(tickyfile,"%6ld ALLOC_TUP_adm\n", ALLOC_TUP_adm); - fprintf(tickyfile,"%6ld ALLOC_TUP_gds\n", ALLOC_TUP_gds); - fprintf(tickyfile,"%6ld ALLOC_TUP_slp\n", ALLOC_TUP_slp); - fprintf(tickyfile,"%6ld ALLOC_BH_ctr\n", ALLOC_BH_ctr); - fprintf(tickyfile,"%6ld ALLOC_BH_adm\n", ALLOC_BH_adm); - fprintf(tickyfile,"%6ld ALLOC_BH_gds\n", ALLOC_BH_gds); - fprintf(tickyfile,"%6ld ALLOC_BH_slp\n", ALLOC_BH_slp); -/* - fprintf(tickyfile,"%6ld ALLOC_PAP_ctr\n", ALLOC_PAP_ctr); - fprintf(tickyfile,"%6ld ALLOC_PAP_adm\n", ALLOC_PAP_adm); - fprintf(tickyfile,"%6ld ALLOC_PAP_gds\n", ALLOC_PAP_gds); - fprintf(tickyfile,"%6ld ALLOC_PAP_slp\n", ALLOC_PAP_slp); -*/ - fprintf(tickyfile,"%6ld ALLOC_PRIM_ctr\n", ALLOC_PRIM_ctr); - fprintf(tickyfile,"%6ld ALLOC_PRIM_adm\n", ALLOC_PRIM_adm); - fprintf(tickyfile,"%6ld ALLOC_PRIM_gds\n", ALLOC_PRIM_gds); - fprintf(tickyfile,"%6ld ALLOC_PRIM_slp\n", ALLOC_PRIM_slp); -/* - fprintf(tickyfile,"%6ld ALLOC_UPD_CON_ctr\n", ALLOC_UPD_CON_ctr); - fprintf(tickyfile,"%6ld ALLOC_UPD_CON_adm\n", ALLOC_UPD_CON_adm); - fprintf(tickyfile,"%6ld ALLOC_UPD_CON_gds\n", ALLOC_UPD_CON_gds); - fprintf(tickyfile,"%6ld ALLOC_UPD_CON_slp\n", ALLOC_UPD_CON_slp); -*/ - fprintf(tickyfile,"%6ld ALLOC_UPD_PAP_ctr\n", ALLOC_UPD_PAP_ctr); - fprintf(tickyfile,"%6ld ALLOC_UPD_PAP_adm\n", ALLOC_UPD_PAP_adm); - fprintf(tickyfile,"%6ld ALLOC_UPD_PAP_gds\n", ALLOC_UPD_PAP_gds); - fprintf(tickyfile,"%6ld ALLOC_UPD_PAP_slp\n", ALLOC_UPD_PAP_slp); - -#ifdef CONCURRENT - fprintf(tickyfile,"%6ld ALLOC_STK_ctr\n", ALLOC_STK_ctr); - fprintf(tickyfile,"%6ld ALLOC_STK_adm\n", ALLOC_STK_adm); - fprintf(tickyfile,"%6ld ALLOC_STK_gds\n", ALLOC_STK_gds); - fprintf(tickyfile,"%6ld ALLOC_STK_slp\n", ALLOC_STK_slp); - fprintf(tickyfile,"%6ld ALLOC_TSO_ctr\n", ALLOC_TSO_ctr); - fprintf(tickyfile,"%6ld ALLOC_TSO_adm\n", ALLOC_TSO_adm); - fprintf(tickyfile,"%6ld ALLOC_TSO_gds\n", ALLOC_TSO_gds); - fprintf(tickyfile,"%6ld ALLOC_TSO_slp\n", ALLOC_TSO_slp); -#ifdef PAR - fprintf(tickyfile,"%6ld ALLOC_FMBQ_ctr\n", ALLOC_FMBQ_ctr); - fprintf(tickyfile,"%6ld ALLOC_FMBQ_adm\n", ALLOC_FMBQ_adm); - fprintf(tickyfile,"%6ld ALLOC_FMBQ_gds\n", ALLOC_FMBQ_gds); - fprintf(tickyfile,"%6ld ALLOC_FMBQ_slp\n", ALLOC_FMBQ_slp); - fprintf(tickyfile,"%6ld ALLOC_FME_ctr\n", ALLOC_FME_ctr); - fprintf(tickyfile,"%6ld ALLOC_FME_adm\n", ALLOC_FME_adm); - fprintf(tickyfile,"%6ld ALLOC_FME_gds\n", ALLOC_FME_gds); - fprintf(tickyfile,"%6ld ALLOC_FME_slp\n", ALLOC_FME_slp); - fprintf(tickyfile,"%6ld ALLOC_BF_ctr\n", ALLOC_BF_ctr); - fprintf(tickyfile,"%6ld ALLOC_BF_adm\n", ALLOC_BF_adm); - fprintf(tickyfile,"%6ld ALLOC_BF_gds\n", ALLOC_BF_gds); - fprintf(tickyfile,"%6ld ALLOC_BF_slp\n", ALLOC_BF_slp); -#endif -#endif - - fprintf(tickyfile,"%6ld ENT_VIA_NODE_ctr\n", ENT_VIA_NODE_ctr); - fprintf(tickyfile,"%6ld ENT_CON_ctr\n", ENT_CON_ctr); - fprintf(tickyfile,"%6ld ENT_FUN_STD_ctr\n", ENT_FUN_STD_ctr); - fprintf(tickyfile,"%6ld ENT_FUN_DIRECT_ctr\n", ENT_FUN_DIRECT_ctr); - fprintf(tickyfile,"%6ld ENT_IND_ctr\n", ENT_IND_ctr); - fprintf(tickyfile,"%6ld ENT_PAP_ctr\n", ENT_PAP_ctr); - fprintf(tickyfile,"%6ld ENT_THK_ctr\n", ENT_THK_ctr); - - fprintf(tickyfile,"%6ld RET_NEW_IN_HEAP_ctr\n", RET_NEW_IN_HEAP_ctr); - fprintf(tickyfile,"%6ld RET_NEW_IN_REGS_ctr\n", RET_NEW_IN_REGS_ctr); - fprintf(tickyfile,"%6ld RET_OLD_IN_HEAP_ctr\n", RET_OLD_IN_HEAP_ctr); - fprintf(tickyfile,"%6ld RET_OLD_IN_REGS_ctr\n", RET_OLD_IN_REGS_ctr); - fprintf(tickyfile,"%6ld RET_SEMI_BY_DEFAULT_ctr\n", RET_SEMI_BY_DEFAULT_ctr); - fprintf(tickyfile,"%6ld RET_SEMI_IN_HEAP_ctr\n", RET_SEMI_IN_HEAP_ctr); - fprintf(tickyfile,"%6ld RET_SEMI_IN_REGS_ctr\n", RET_SEMI_IN_REGS_ctr); - fprintf(tickyfile,"%6ld VEC_RETURN_ctr\n", VEC_RETURN_ctr); - - fprintf(tickyfile,"%6ld UPDF_OMITTED_ctr\n", UPDF_OMITTED_ctr); - fprintf(tickyfile,"%6ld UPDF_STD_PUSHED_ctr\n", UPDF_STD_PUSHED_ctr); - fprintf(tickyfile,"%6ld UPDF_CON_PUSHED_ctr\n", UPDF_CON_PUSHED_ctr); - fprintf(tickyfile,"%6ld UPDF_HOLE_PUSHED_ctr\n", UPDF_HOLE_PUSHED_ctr); - - fprintf(tickyfile,"%6ld UPDF_RCC_PUSHED_ctr\n", UPDF_RCC_PUSHED_ctr); - fprintf(tickyfile,"%6ld UPDF_RCC_OMITTED_ctr\n", UPDF_RCC_OMITTED_ctr); - - fprintf(tickyfile,"%6ld UPD_EXISTING_ctr\n", UPD_EXISTING_ctr); - fprintf(tickyfile,"%6ld UPD_CON_W_NODE_ctr\n", UPD_CON_W_NODE_ctr); - fprintf(tickyfile,"%6ld UPD_CON_IN_PLACE_ctr\n", UPD_CON_IN_PLACE_ctr); - fprintf(tickyfile,"%6ld UPD_CON_IN_NEW_ctr\n", UPD_CON_IN_NEW_ctr); - fprintf(tickyfile,"%6ld UPD_PAP_IN_PLACE_ctr\n", UPD_PAP_IN_PLACE_ctr); - fprintf(tickyfile,"%6ld UPD_PAP_IN_NEW_ctr\n", UPD_PAP_IN_NEW_ctr); - fprintf(tickyfile,"%6ld UPD_ENTERED_ctr\n", UPD_ENTERED_ctr); - fprintf(tickyfile,"%6ld UPD_ENTERED_AGAIN_ctr\n",UPD_ENTERED_AGAIN_ctr); - - fprintf(tickyfile,"%6ld UPD_NEW_IND_ctr\n", UPD_NEW_IND_ctr); - fprintf(tickyfile,"%6ld UPD_NEW_IN_PLACE_PTRS_ctr\n", UPD_NEW_IN_PLACE_PTRS_ctr); - fprintf(tickyfile,"%6ld UPD_NEW_IN_PLACE_NOPTRS_ctr\n", UPD_NEW_IN_PLACE_NOPTRS_ctr); - fprintf(tickyfile,"%6ld UPD_OLD_IND_ctr\n", UPD_OLD_IND_ctr); - fprintf(tickyfile,"%6ld UPD_OLD_IN_PLACE_PTRS_ctr\n", UPD_OLD_IN_PLACE_PTRS_ctr); - fprintf(tickyfile,"%6ld UPD_OLD_IN_PLACE_NOPTRS_ctr\n", UPD_OLD_IN_PLACE_NOPTRS_ctr); -} -\end{code} - -%************************************************************************ -%* * -\subsection[RednCounts-ent-counters]{Handle named entry counters} -%* * -%************************************************************************ - -Data structure used in ``registering'' one of these counters. -\begin{code} -struct ent_counter *ListOfEntryCtrs = NULL; /* root of list of them */ -\end{code} - -To print out all the registered-counter info: -\begin{code} -void -printRegisteredCounterInfo ( STG_NO_ARGS ) -{ - struct ent_counter *p; - - if ( ListOfEntryCtrs != NULL ) { - fprintf(tickyfile,"\n**************************************************\n"); - } - - for (p = ListOfEntryCtrs; p != NULL; p = p->link) { - /* common stuff first; then the wrapper info if avail */ - fprintf(tickyfile, "%-40s%u\t%u\t%u\t%-16s%ld", - p->f_str, - p->arity, - p->Astk_args, - p->Bstk_args, - p->f_arg_kinds, - p->ctr); - - if ( p->wrap_str == NULL ) { - fprintf(tickyfile, "\n"); - - } else { - fprintf(tickyfile, "\t%s\t%s\n", - p->wrap_str, - p->wrap_arg_kinds); - } - } -} -\end{code} - -That's all, folks. -\begin{code} -#endif /* DO_REDN_COUNTING */ -\end{code} diff --git a/ghc/runtime/main/RtsFlags.lc b/ghc/runtime/main/RtsFlags.lc new file mode 100644 index 0000000000..1fb72e8526 --- /dev/null +++ b/ghc/runtime/main/RtsFlags.lc @@ -0,0 +1,1226 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1995 +% +\section{Runtime-system runtime flags} + +Everything to do with RTS runtime flags, including RTS parameters +that can be set by them, either directly or indirectly. + +@rtsFlags.lh@ defines the data structure that holds all of them. + +\begin{code} +#include "rtsdefs.h" + +struct RTS_FLAGS RTSflags; /* actually declare the data structure */ +struct ALL_FLAGS AllFlags; + +/* some fwd decls */ +static I_ decode(const char *); +static void bad_option(const char *); +static FILE * open_stats_file (I_ arg, + int argc, char *argv[], int rts_argc, char *rts_argv[], + const char *FILENAME_FMT); + +/* extern decls */ +long strtol PROTO((const char *, char **, int)); +\end{code} + +%************************************************************************ +%* * +\subsection{Initial default values for @RTSFlags@} +%* * +%************************************************************************ + +\begin{code} +void +initRtsFlagsDefaults (STG_NO_ARGS) +{ + RTSflags.GcFlags.statsFile = NULL; + RTSflags.GcFlags.giveStats = NO_GC_STATS; + + RTSflags.GcFlags.stksSize = 0x10002; /* 2^16 = 16Kwords = 64Kbytes */ + RTSflags.GcFlags.heapSize = 0x100002; /* 2^20 = 1Mwords = 4Mbytes */ + RTSflags.GcFlags.allocAreaSize = 0x4002; /* 2^14 = 16Kwords = 64Kbytes; + plus 2 cache-friendly words */ + RTSflags.GcFlags.allocAreaSizeGiven = rtsFalse; + RTSflags.GcFlags.specifiedOldGenSize= 0; /* means: use all heap available */ + RTSflags.GcFlags.pcFreeHeap = 3; /* 3% */ + /* minAllocAreaSize is derived; set in initSM, + after we know pcFreeHeap and heapSize */ + + RTSflags.GcFlags.force2s = rtsFalse; + RTSflags.GcFlags.forceGC = rtsFalse; + RTSflags.GcFlags.forcingInterval = 5000000; /* 5MB (or words?) */ + RTSflags.GcFlags.ringBell = rtsFalse; + RTSflags.GcFlags.trace = 0; /* not turned on */ + + RTSflags.GcFlags.lazyBlackHoling = rtsTrue; + RTSflags.GcFlags.doSelectorsAtGC = rtsTrue; + RTSflags.GcFlags.squeezeUpdFrames = rtsTrue; + +#if defined(PROFILING) || defined(PAR) + RTSflags.CcFlags.doCostCentres = 0; + RTSflags.CcFlags.sortBy = SORTCC_TIME; + + /* "ctxtSwitchTicks", "profilerTicks", & "msecsPerTick" are + derived info, so they are set after ctxtSwitchTime has been + determined. + */ +#endif /* PROFILING or PAR */ + +#ifdef PROFILING + RTSflags.ProfFlags.doHeapProfile = rtsFalse; +#endif /* PROFILING */ + +#ifdef CONCURRENT + RTSflags.ConcFlags.ctxtSwitchTime = CS_MIN_MILLISECS; /* In milliseconds */ + RTSflags.ConcFlags.maxThreads = 32; + RTSflags.ConcFlags.stkChunkSize = 1024; + RTSflags.ConcFlags.maxLocalSparks = 500; +#endif /* CONCURRENT */ + +#ifdef PAR + RTSflags.ParFlags.parallelStats = rtsFalse; + RTSflags.ParFlags.granSimStats = rtsFalse; + RTSflags.ParFlags.granSimStats_Binary = rtsFalse; + + RTSflags.ParFlags.outputDisabled = rtsFalse; + + RTSflags.ParFlags.packBufferSize = 1024; +#endif /* PAR */ + +#ifdef TICKY_TICKY + RTSflags.TickyFlags.showTickyStats = rtsFalse; + RTSflags.TickyFlags.tickyFile = NULL; + + AllFlags.doUpdEntryCounts = rtsTrue; /*ToDo:move? */ +#endif +} +\end{code} + +%************************************************************************ +%* * +\subsection{Usage message for runtime-system (RTS) flags} +%* * +%************************************************************************ + +\begin{code} +static const char * +usage_text[] = { +"", +"Usage: <prog> <args> [+RTS <rtsopts> | -RTS <args>] ... --RTS <args>", +"", +" +RTS Indicates run time system options follow", +" -RTS Indicates program arguments follow", +" --RTS Indicates that ALL subsequent arguments will be given to the", +" program (including any of these RTS flags)", +"", +"The following run time system options are available:", +"", +" -? -f Prints this message and exits; the program is not executed", +"", +" -K<size> Sets the stack size (default 64k) Egs: -K32k -K512k", +" -H<size> Sets the heap size (default 4M) -H512k -H16M", +" -s<file> Summary GC statistics (default file: <program>.stat)", +" -S<file> Detailed GC statistics (with -Sstderr going to stderr)", +"", +#if defined(GCap) +" -M<n>% Sets minimum size of alloc area as % of heap (default 3%)", +" -A<size> Fixes size of alloc area, overriding any minimum (-A gives 64k)", +" -G<size> Fixes size of major generation (default is dynamic threshold)", +" -F2s Forces program compiled for Appel gc to use 2s collection", +#else +# if defined(GCgn) +" -A<size> Specifies size of alloc area (default 64k)", +" -G<size> Fixes size of major generation (default is available heap)", +" -F2s Forces program compiled for Gen gc to use 2s collection", +# else +" -M<n>% Minimum % of heap which must be available (default 3%)", +" -A<size> Fixes size of heap area allocated between GCs (-A gives 64k)", +# endif +#endif +" -j<size> Forces major GC at every <size> bytes allocated", +#if defined(GCdu) +" -u<percent> Fixes residency threshold at which mode switches (range 0.0..0.95)", +#endif +"", +" -N No black-holing during GC (for use when a signal handler is present)", +" -Z Don't squeeze out update frames on stack overflow", +" -B Sound the bell at the start of each (major) garbage collection", +#if defined(PROFILING) || defined(PAR) +"", +" -p<sort> Produce cost centre time profile (output file <program>.prof)", +" sort: T = time (default), A = alloc, C = cost centre label", +" -P<sort> Produce serial time profile (output file <program>.time)", +" and a -p profile with detailed caf/enter/tick/alloc info", +# if defined(PROFILING) +"", +" -h<break-down> Heap residency profile (output file <program>.hp)", +" break-down: C = cost centre (default), M = module, G = group", +" D = closure description, Y = type description", +" T<ints>,<start> = time closure created", +" ints: no. of interval bands plotted (default 18)", +" start: seconds after which intervals start (default 0.0)", +" A subset of closures may be selected by the attached cost centre using:", +" -c{mod:lab,mod:lab...}, specific module:label cost centre(s)", +" -m{mod,mod...} all cost centres from the specified modules(s)", +" -g{grp,grp...} all cost centres from the specified group(s)", +" Selections can also be made by description, type, kind and age:", +" -d{des,des...} closures with specified closure descriptions", +" -y{typ,typ...} closures with specified type descriptions", +" -k{knd,knd...} closures of the specified kinds", +" -a<age> closures which survived <age> complete intervals", +" The selection logic used is summarised as follows:", +" ([-c] or [-m] or [-g]) and ([-d] or [-y] or [-k]) and [-a]", +" where an option is true if not specified", +# endif +"", +" -z<tbl><size> set hash table <size> for <tbl> (C, M, G, D or Y)", +"", +" -i<secs> Number of seconds in a profiling interval (default 1.0):", +" heap profile (-h) and/or serial time profile (-P) frequency", +#endif /* PROFILING or PAR */ +"", +#if defined(TICKY_TICKY) +" -r<file> Produce reduction profiling statistics (with -rstderr for stderr)", +"", +#endif +" -T<level> Trace garbage collection execution (debugging)", +#ifdef CONCURRENT +"", +# ifdef PAR +" -N<n> Use <n> PVMish processors in parallel (default: 2)", +/* NB: the -N<n> is implemented by the driver!! */ +# endif +" -C<secs> Context-switch interval in seconds", +" (0 or no argument means switch as often as possible)", +" the default is .01 sec; resolution is .01 sec", +" -e<size> Size of spark pools (default 100)", +# ifdef PAR +" -q Enable activity profile (output files in ~/<program>*.gr)", +" -qb Enable binary activity profile (output file /tmp/<program>.gb)", +" -Q<size> Set pack-buffer size (default: 1024)", +# else +" -q[v] Enable quasi-parallel profile (output file <program>.qp)", +# endif +" -t<num> Set maximum number of advisory threads per PE (default 32)", +" -o<num> Set stack chunk size (default 1024)", +# ifdef PAR +" -d Turn on PVM-ish debugging", +" -O Disable output for performance measurement", +# endif /* PAR */ +#endif /* CONCURRENT */ +"", +"Other RTS options may be available for programs compiled a different way.", +"The GHC User's Guide has full details.", +"", +0 +}; +\end{code} + +%************************************************************************ +%* * +\subsection{Processing command-line arguments to set @RTSFlags@} +%* * +%************************************************************************ + +\begin{code} +#define RTS 1 +#define PGM 0 + +#ifndef atof +extern double atof(); +/* no proto because some machines use const and some do not */ +#endif + +static __inline__ rtsBool +strequal(const char *a, const char * b) +{ + return(strcmp(a, b) == 0); +} + +void +setupRtsFlags(int *argc, char *argv[], int *rts_argc, char *rts_argv[]) +{ + rtsBool error = rtsFalse; + I_ mode; + I_ arg, total_arg; + char *last_slash; + + /* Remove directory from argv[0] -- default files in current directory */ + + if ((last_slash = (char *) strrchr(argv[0], '/')) != NULL) + strcpy(argv[0], last_slash+1); + + /* Split arguments (argv) into PGM (argv) and RTS (rts_argv) parts */ + /* argv[0] must be PGM argument -- leave in argv */ + + total_arg = *argc; + arg = 1; + + *argc = 1; + *rts_argc = 0; + + for (mode = PGM; arg < total_arg && ! strequal("--RTS", argv[arg]); arg++) { + if (strequal("+RTS", argv[arg])) { + mode = RTS; + } + else if (strequal("-RTS", argv[arg])) { + mode = PGM; + } + else if (mode == RTS && *rts_argc < MAX_RTS_ARGS-1) { + rts_argv[(*rts_argc)++] = argv[arg]; + } + else if (mode == PGM) { + argv[(*argc)++] = argv[arg]; + } + else { + fflush(stdout); + fprintf(stderr, "setupRtsFlags: Too many RTS arguments (max %d)\n", + MAX_RTS_ARGS-1); + EXIT(EXIT_FAILURE); + } + } + if (arg < total_arg) { + /* arg must be --RTS; process remaining program arguments */ + while (++arg < total_arg) { + argv[(*argc)++] = argv[arg]; + } + } + argv[*argc] = (char *) 0; + rts_argv[*rts_argc] = (char *) 0; + + /* Process RTS (rts_argv) part: mainly to determine statsfile */ + + for (arg = 0; arg < *rts_argc; arg++) { + if (rts_argv[arg][0] != '-') { + fflush(stdout); + fprintf(stderr, "setupRtsFlags: Unexpected RTS argument: %s\n", + rts_argv[arg]); + error = rtsTrue; + + } else { + switch(rts_argv[arg][1]) { + + /* process: general args, then PROFILING-only ones, + then CONCURRENT-only, PARallel-only, GRAN-only, + TICKY-only (same order as defined in RtsFlags.lh); + within those groups, mostly in case-insensitive + alphabetical order. + */ + +#ifdef TICKY_TICKY +# define TICKY_BUILD_ONLY(x) x +#else +# define TICKY_BUILD_ONLY(x) \ +fprintf(stderr, "setupRtsFlags: GHC not built for: ticky-ticky stats\n"); \ +error = rtsTrue; +#endif + +#if (defined(PROFILING) || defined(PAR)) +# define COST_CENTRE_USING_BUILD_ONLY(x) x +#else +# define COST_CENTRE_USING_BUILD_ONLY(x) \ +fprintf(stderr, "setupRtsFlags: GHC not built for: -prof or -parallel\n"); \ +error = rtsTrue; +#endif + +#ifdef PROFILING +# define PROFILING_BUILD_ONLY(x) +#else +# define PROFILING_BUILD_ONLY(x) \ +fprintf(stderr, "setupRtsFlags: GHC not built for: -prof\n"); \ +error = rtsTrue; +#endif + +#ifdef CONCURRENT +# define CONCURRENT_BUILD_ONLY(x) +#else +# define CONCURRENT_BUILD_ONLY(x) \ +fprintf(stderr, "setupRtsFlags: GHC not built for: -concurrent\n"); \ +error = rtsTrue; +#endif + +#ifdef PAR +# define PAR_BUILD_ONLY(x) +#else +# define PAR_BUILD_ONLY(x) \ +fprintf(stderr, "setupRtsFlags: GHC not built for: -parallel\n"); \ +error = rtsTrue; +#endif + +#ifdef GRAN +# define GRAN_BUILD_ONLY(x) +#else +# define GRAN_BUILD_ONLY(x) \ +fprintf(stderr, "setupRtsFlags: GHC not built for: -gransim\n"); \ +error = rtsTrue; +#endif + + /* =========== GENERAL ========================== */ + case '?': + case 'f': + error = rtsTrue; + break; + + case 'A': + RTSflags.GcFlags.allocAreaSize + = decode(rts_argv[arg]+2) / sizeof(W_); + RTSflags.GcFlags.allocAreaSizeGiven = rtsTrue; + break; + + case 'B': + RTSflags.GcFlags.ringBell = rtsTrue; + break; + + case 'F': + if (strequal(rts_argv[arg]+2, "2s")) { + RTSflags.GcFlags.force2s = rtsTrue; + } else { + bad_option( rts_argv[arg] ); + } + break; + + case 'G': + RTSflags.GcFlags.specifiedOldGenSize + = decode(rts_argv[arg]+2) / sizeof(W_); + break; + + case 'K': + RTSflags.GcFlags.stksSize = decode(rts_argv[arg]+2) / sizeof(W_); + + if (RTSflags.GcFlags.stksSize == 0) bad_option( rts_argv[arg] ); + break; + + case 'H': + RTSflags.GcFlags.heapSize = decode(rts_argv[arg]+2) / sizeof(W_); + /* user give size in *bytes* but "heapSize" is in *words* */ + + if (RTSflags.GcFlags.heapSize <= 0) bad_option(rts_argv[arg]); + break; + + case 'j': /* force GC option */ + RTSflags.GcFlags.forceGC = rtsTrue; + if (rts_argv[arg][2]) { + RTSflags.GcFlags.forcingInterval + = decode(rts_argv[arg]+2) / sizeof(W_); + } + break; + + case 'M': + RTSflags.GcFlags.pcFreeHeap = atof(rts_argv[arg]+2); + + if (RTSflags.GcFlags.pcFreeHeap < 0 || RTSflags.GcFlags.pcFreeHeap > 100) + bad_option( rts_argv[arg] ); + break; + + case 'N': + RTSflags.GcFlags.lazyBlackHoling = rtsFalse; + break; + + case 'n': + RTSflags.GcFlags.doSelectorsAtGC = rtsFalse; + break; + + case 'S': /* NB: no difference at present ! */ + case 's': + RTSflags.GcFlags.giveStats ++; /* will be VERBOSE_GC_STATS */ +#ifdef PAR + /* Opening all those files would almost certainly fail... */ + RTSflags.ParFlags.parallelStats = rtsTrue; + RTSflags.GcFlags.statsFile = stderr; /* temporary; ToDo: rm */ +#else + RTSflags.GcFlags.statsFile + = open_stats_file(arg, *argc, argv, + *rts_argc, rts_argv, STAT_FILENAME_FMT); + + if (RTSflags.GcFlags.statsFile == NULL) error = rtsTrue; +#endif + break; + + case 'T': + if (rts_argv[arg][2] != '\0') + RTSflags.GcFlags.trace + = (W_) strtol(rts_argv[arg]+2, (char **)NULL, 0); + else + RTSflags.GcFlags.trace = 1; /* slightly weird; why, really? */ + break; + + case 'Z': + RTSflags.GcFlags.squeezeUpdFrames = rtsFalse; + break; + + /* =========== PROFILING ========================== */ + + case 'P': /* detailed cost centre profiling (time/alloc) */ + COST_CENTRE_USING_BUILD_ONLY( + RTSflags.CcFlags.doCostCentres++; + ) + case 'p': /* cost centre profiling (time/alloc) */ + COST_CENTRE_USING_BUILD_ONLY( + { char ch; + RTSflags.CcFlags.doCostCentres++; + + for (ch = 2; rts_argv[arg][ch]; ch++) { + switch (rts_argv[arg][2]) { + case SORTCC_LABEL: + case SORTCC_TIME: + case SORTCC_ALLOC: + RTSflags.CcFlags.sortBy = rts_argv[arg][ch]; + break; + default: + fprintf(stderr, "Invalid profiling sort option %s\n", rts_argv[arg]); + error = 1; + }}} + ) break; + + case 'i': /* serial profiling -- initial timer interval */ + COST_CENTRE_USING_BUILD_ONLY( + interval_ticks = (I_) ((atof(rts_argv[arg]+2) * TICK_FREQUENCY)); + if (interval_ticks <= 0) + interval_ticks = 1; + ) break; + + case 'h': /* serial heap profile */ + PROFILING_BUILD_ONLY( + switch (rts_argv[arg][2]) { + case '\0': + case CCchar: + RTSflags.ProfFlags.doHeapProfile = HEAP_BY_CC; + break; + case MODchar: + RTSflags.ProfFlags.doHeapProfile = HEAP_BY_MOD; + break; + case GRPchar: + RTSflags.ProfFlags.doHeapProfile = HEAP_BY_GRP; + break; + case DESCRchar: + RTSflags.ProfFlags.doHeapProfile = HEAP_BY_DESCR; + break; + case TYPEchar: + RTSflags.ProfFlags.doHeapProfile = HEAP_BY_TYPE; + break; + case TIMEchar: + RTSflags.ProfFlags.doHeapProfile = HEAP_BY_TIME; + if (rts_argv[arg][3]) { + char *start_str = strchr(rts_argv[arg]+3, ','); + I_ intervals; + if (start_str) *start_str = '\0'; + + if ((intervals = decode(rts_argv[arg]+3)) != 0) { + time_intervals = (hash_t) intervals; + /* ToDo: and what if it *is* zero intervals??? */ + } + if (start_str) { + earlier_ticks = (I_)((atof(start_str + 1) * TICK_FREQUENCY)); + } + } + break; + default: + fprintf(stderr, "Invalid heap profile option: %s\n", + rts_argv[arg]); + error = 1; + } + ) break; + + case 'z': /* size of index tables */ + PROFILING_BUILD_ONLY( + switch (rts_argv[arg][2]) { + case CCchar: + max_cc_no = (hash_t) decode(rts_argv[arg]+3); + if (max_cc_no == 0) { + fprintf(stderr, "Bad number of cost centres %s\n", rts_argv[arg]); + error = 1; + } + break; + case MODchar: + max_mod_no = (hash_t) decode(rts_argv[arg]+3); + if (max_mod_no == 0) { + fprintf(stderr, "Bad number of modules %s\n", rts_argv[arg]); + error = 1; + } + break; + case GRPchar: + max_grp_no = (hash_t) decode(rts_argv[arg]+3); + if (max_grp_no == 0) { + fprintf(stderr, "Bad number of groups %s\n", rts_argv[arg]); + error = 1; + } + break; + case DESCRchar: + max_descr_no = (hash_t) decode(rts_argv[arg]+3); + if (max_descr_no == 0) { + fprintf(stderr, "Bad number of closure descriptions %s\n", rts_argv[arg]); + error = 1; + } + break; + case TYPEchar: + max_type_no = (hash_t) decode(rts_argv[arg]+3); + if (max_type_no == 0) { + fprintf(stderr, "Bad number of type descriptions %s\n", rts_argv[arg]); + error = 1; + } + break; + default: + fprintf(stderr, "Invalid index table size option: %s\n", + rts_argv[arg]); + error = 1; + } + ) break; + + case 'c': /* cost centre label select */ + case 'm': /* cost centre module select */ + case 'g': /* cost centre group select */ + case 'd': /* closure descr select */ + case 'y': /* closure type select */ + case 'k': /* closure kind select */ + PROFILING_BUILD_ONLY( + + left = strchr(rts_argv[arg], '{'); + right = strrchr(rts_argv[arg], '}'); + if (! left || ! right || + strrchr(rts_argv[arg], '{') != left || + strchr(rts_argv[arg], '}') != right) { + fprintf(stderr, "Invalid heap profiling selection bracketing\n %s\n", rts_argv[arg]); + error = 1; + } else { + *right = '\0'; + switch (rts_argv[arg][1]) { + case 'c': /* cost centre label select */ + select_cc = left + 1; + break; + case 'm': /* cost centre module select */ + select_mod = left + 1; + break; + case 'g': /* cost centre group select */ + select_grp = left + 1; + break; + case 'd': /* closure descr select */ + select_descr = left + 1; + break; + case 't': /* closure type select */ + select_type = left + 1; + break; + case 'k': /* closure kind select */ + select_kind = left + 1; + break; + } + } + ) break; + + /* =========== CONCURRENT ========================= */ + case 'C': /* context switch interval */ + CONCURRENT_BUILD_ONLY ( + if (rts_argv[arg][2] == '\0') + RTSflags.ConcFlags.ctxtSwitchTime = 0; + else { + I_ cst; /* tmp */ + + /* Convert to milliseconds */ + cst = (I_) ((atof(rts_argv[arg]+2) * 1000)); + cst = (cst / CS_MIN_MILLISECS) * CS_MIN_MILLISECS; + if (cst < CS_MIN_MILLISECS) + cst = CS_MIN_MILLISECS; + + RTSflags.ConcFlags.ctxtSwitchTime = cst; + } + ) break; + + case 't': + CONCURRENT_BUILD_ONLY( + if (rts_argv[arg][2] != '\0') { + RTSflags.ConcFlags.maxThreads + = strtol(rts_argv[arg]+2, (char **) NULL, 10); + } else { + fprintf(stderr, "setupRtsFlags: missing size for -t\n"); + error = rtsTrue; + } + ) break; + + case 'o': + CONCURRENT_BUILD_ONLY ( + if (rts_argv[arg][2] != '\0') { + I_ size = decode(rts_argv[arg]+2); + + if (size < MIN_STKO_CHUNK_SIZE) + size = MIN_STKO_CHUNK_SIZE; + + RTSflags.ConcFlags.stkChunkSize = size; + } else { + fprintf(stderr, "setupRtsFlags: missing size for -o\n"); + error = rtsTrue; + } + ) break; + + /* =========== PARALLEL =========================== */ + case 'e': + CONCURRENT_BUILD_ONLY( + if (rts_argv[arg][2] != '\0') { /* otherwise, stick w/ the default */ + + RTSflags.ConcFlags.maxLocalSparks + = strtol(rts_argv[arg]+2, (char **) NULL, 10); + + if (RTSflags.ConcFlags.maxLocalSparks <= 0) { + fprintf(stderr, "setupRtsFlags: bad value for -e\n"); + error = rtsTrue; + } + } + ) break; + + case 'O': + PAR_BUILD_ONLY( + RTSflags.ParFlags.outputDisabled = rtsTrue; + ) break; + + case 'q': /* activity profile option */ + PAR_BUILD_ONLY( + if (rts_argv[arg][2] == 'b') + RTSflags.ParFlags.granSimStats_Binary = rtsTrue; + else + RTSflags.ParFlags.granSimStats = rtsTrue; + ) break; + +#if 0 /* or??? */ + case 'q': /* quasi-parallel profile option */ + GRAN_BUILD_ONLY ( + if (rts_argv[arg][2] == 'v') + do_qp_prof = 2; + else + do_qp_prof++; + ) break; +#endif /* 0??? */ + + case 'Q': /* Set pack buffer size */ + PAR_BUILD_ONLY( + if (rts_argv[arg][2] != '\0') { + RTSflags.ParFlags.packBufferSize = decode(rts_argv[arg]+2); + } else { + fprintf(stderr, "setupRtsFlags: missing size of PackBuffer (for -Q)\n"); + error = rtsTrue; + } + ) break; + + /* =========== GRAN =============================== */ + + case 'b': + GRAN_BUILD_ONLY( + process_gran_option(); + ) break; + + /* =========== TICKY ============================== */ + + case 'r': /* Basic profiling stats */ + TICKY_BUILD_ONLY( + + RTSflags.TickyFlags.showTickyStats = rtsTrue; + RTSflags.TickyFlags.tickyFile + = open_stats_file(arg, *argc, argv, + *rts_argc, rts_argv, TICKY_FILENAME_FMT); + + if (RTSflags.TickyFlags.tickyFile == NULL) error = rtsTrue; + ) break; + + /* =========== OH DEAR ============================ */ + default: + fprintf(stderr, "setupRtsFlags: Unknown RTS option: %s\n",rts_argv[arg]); + error = rtsTrue; + break; + } + } + } + if (error) { + const char **p; + + fflush(stdout); + for (p = usage_text; *p; p++) + fprintf(stderr, "%s\n", *p); + EXIT(EXIT_FAILURE); + } + +} + +#ifdef GRAN +static void +process_gran_option() +{ + if (rts_argv[arg][2] != '\0') { + + /* Should we emulate hbcpp */ + if(strequal((rts_argv[arg]+2),"roken")) { + ++DoAlwaysCreateThreads; + strcpy(rts_argv[arg]+2,"oring"); + } + + /* or a ridiculously idealised simulator */ + if(strequal((rts_argv[arg]+2),"oring")) { + gran_latency = gran_fetchtime = gran_additional_latency = + gran_gunblocktime = gran_lunblocktime + = gran_threadcreatetime = gran_threadqueuetime + = gran_threadscheduletime = gran_threaddescheduletime + = gran_threadcontextswitchtime + = 0; + + gran_mpacktime = gran_munpacktime = 0; + + gran_arith_cost = gran_float_cost = gran_load_cost + = gran_store_cost = gran_branch_cost = 0; + + gran_heapalloc_cost = 1; + + /* ++DoFairSchedule; */ + ++DoStealThreadsFirst; + ++DoThreadMigration; + RTSflags.ParFlags.granSimStats = rtsTrue; + } + + /* or a ridiculously idealised simulator */ + if(strequal((rts_argv[arg]+2),"onzo")) { + gran_latency = gran_fetchtime = gran_additional_latency = + gran_gunblocktime = gran_lunblocktime + = gran_threadcreatetime = gran_threadqueuetime + = gran_threadscheduletime = gran_threaddescheduletime + = gran_threadcontextswitchtime + = 0; + + gran_mpacktime = gran_munpacktime = 0; + + /* Keep default values for these + gran_arith_cost = gran_float_cost = gran_load_cost + = gran_store_cost = gran_branch_cost = 0; + */ + + gran_heapalloc_cost = 1; + + /* ++DoFairSchedule; */ /* -b-R */ + /* ++DoStealThreadsFirst; */ /* -b-T */ + ++DoReScheduleOnFetch; /* -bZ */ + ++DoThreadMigration; /* -bM */ + RTSflags.ParFlags.granSimStats = rtsTrue; /* -bP */ +# if defined(GRAN_CHECK) && defined(GRAN) + debug = 0x20; /* print event statistics */ +# endif + } + + /* Communication and task creation cost parameters */ + else switch(rts_argv[arg][2]) { + case 'l': + if (rts_argv[arg][3] != '\0') + { + gran_gunblocktime = gran_latency = decode(rts_argv[arg]+3); + gran_fetchtime = 2* gran_latency; + } + else + gran_latency = LATENCY; + break; + + case 'a': + if (rts_argv[arg][3] != '\0') + gran_additional_latency = decode(rts_argv[arg]+3); + else + gran_additional_latency = ADDITIONAL_LATENCY; + break; + + case 'm': + if (rts_argv[arg][3] != '\0') + gran_mpacktime = decode(rts_argv[arg]+3); + else + gran_mpacktime = MSGPACKTIME; + break; + + case 'x': + if (rts_argv[arg][3] != '\0') + gran_mtidytime = decode(rts_argv[arg]+3); + else + gran_mtidytime = 0; + break; + + case 'r': + if (rts_argv[arg][3] != '\0') + gran_munpacktime = decode(rts_argv[arg]+3); + else + gran_munpacktime = MSGUNPACKTIME; + break; + + case 'f': + if (rts_argv[arg][3] != '\0') + gran_fetchtime = decode(rts_argv[arg]+3); + else + gran_fetchtime = FETCHTIME; + break; + + case 'n': + if (rts_argv[arg][3] != '\0') + gran_gunblocktime = decode(rts_argv[arg]+3); + else + gran_gunblocktime = GLOBALUNBLOCKTIME; + break; + + case 'u': + if (rts_argv[arg][3] != '\0') + gran_lunblocktime = decode(rts_argv[arg]+3); + else + gran_lunblocktime = LOCALUNBLOCKTIME; + break; + + /* Thread-related metrics */ + case 't': + if (rts_argv[arg][3] != '\0') + gran_threadcreatetime = decode(rts_argv[arg]+3); + else + gran_threadcreatetime = THREADCREATETIME; + break; + + case 'q': + if (rts_argv[arg][3] != '\0') + gran_threadqueuetime = decode(rts_argv[arg]+3); + else + gran_threadqueuetime = THREADQUEUETIME; + break; + + case 'c': + if (rts_argv[arg][3] != '\0') + gran_threadscheduletime = decode(rts_argv[arg]+3); + else + gran_threadscheduletime = THREADSCHEDULETIME; + + gran_threadcontextswitchtime = gran_threadscheduletime + + gran_threaddescheduletime; + break; + + case 'd': + if (rts_argv[arg][3] != '\0') + gran_threaddescheduletime = decode(rts_argv[arg]+3); + else + gran_threaddescheduletime = THREADDESCHEDULETIME; + + gran_threadcontextswitchtime = gran_threadscheduletime + + gran_threaddescheduletime; + break; + + /* Instruction Cost Metrics */ + case 'A': + if (rts_argv[arg][3] != '\0') + gran_arith_cost = decode(rts_argv[arg]+3); + else + gran_arith_cost = ARITH_COST; + break; + + case 'F': + if (rts_argv[arg][3] != '\0') + gran_float_cost = decode(rts_argv[arg]+3); + else + gran_float_cost = FLOAT_COST; + break; + + case 'B': + if (rts_argv[arg][3] != '\0') + gran_branch_cost = decode(rts_argv[arg]+3); + else + gran_branch_cost = BRANCH_COST; + break; + + case 'L': + if (rts_argv[arg][3] != '\0') + gran_load_cost = decode(rts_argv[arg]+3); + else + gran_load_cost = LOAD_COST; + break; + + case 'S': + if (rts_argv[arg][3] != '\0') + gran_store_cost = decode(rts_argv[arg]+3); + else + gran_store_cost = STORE_COST; + break; + + case 'H': + if (rts_argv[arg][3] != '\0') + gran_heapalloc_cost = decode(rts_argv[arg]+3); + else + gran_heapalloc_cost = 0; + break; + + case 'y': + if (rts_argv[arg][3] != '\0') + FetchStrategy = decode(rts_argv[arg]+3); + else + FetchStrategy = 4; /* default: fetch everything */ + break; + + /* General Parameters */ + case 'p': + if (rts_argv[arg][3] != '\0') + { + max_proc = decode(rts_argv[arg]+3); + if(max_proc > MAX_PROC || max_proc < 1) + { + fprintf(stderr,"setupRtsFlags: no more than %u processors allowed\n", MAX_PROC); + error = rtsTrue; + } + } + else + max_proc = MAX_PROC; + break; + + case 'C': + ++DoAlwaysCreateThreads; + ++DoThreadMigration; + break; + + case 'G': + ++DoGUMMFetching; + break; + + case 'M': + ++DoThreadMigration; + break; + + case 'R': + ++DoFairSchedule; + break; + + case 'T': + ++DoStealThreadsFirst; + ++DoThreadMigration; + break; + + case 'Z': + ++DoReScheduleOnFetch; + break; + + case 'z': + ++SimplifiedFetch; + break; + + case 'N': + ++PreferSparksOfLocalNodes; + break; + + case 'b': + RTSflags.ParFlags.granSimStats_Binary = rtsTrue; + break; + + case 'P': + RTSflags.ParFlags.granSimStats = rtsTrue; + break; + + case 's': + ++do_sp_profile; + break; + + case '-': + switch(rts_argv[arg][3]) { + + case 'C': + DoAlwaysCreateThreads=0; + DoThreadMigration=0; + break; + + case 'G': + DoGUMMFetching=0; + break; + + case 'M': + DoThreadMigration=0; + break; + + case 'R': + DoFairSchedule=0; + break; + + case 'T': + DoStealThreadsFirst=0; + DoThreadMigration=0; + break; + + case 'Z': + DoReScheduleOnFetch=0; + break; + + case 'N': + PreferSparksOfLocalNodes=0; + break; + + case 'P': + RTSflags.ParFlags.granSimStats = rtsFalse; + no_gr_profile=1; + break; + + case 's': + do_sp_profile=0; + break; + + case 'b': + RTSflags.ParFlags.granSimStats_Binary = rtsFalse; + break; + + default: + bad_option( rts_argv[arg] ); + break; + } + break; + +# if defined(GRAN_CHECK) && defined(GRAN) + case 'D': + switch(rts_argv[arg][3]) { + case 'e': /* event trace */ + fprintf(stderr,"Printing event trace.\n"); + ++event_trace; + break; + + case 'f': + fprintf(stderr,"Printing forwarding of FETCHNODES.\n"); + debug |= 0x2; /* print fwd messages */ + break; + + case 'z': + fprintf(stderr,"Check for blocked on fetch.\n"); + debug |= 0x4; /* debug non-reschedule-on-fetch */ + break; + + case 't': + fprintf(stderr,"Check for TSO asleep on fetch.\n"); + debug |= 0x10; /* debug TSO asleep for fetch */ + break; + + case 'E': + fprintf(stderr,"Printing event statistics.\n"); + debug |= 0x20; /* print event statistics */ + break; + + case 'F': + fprintf(stderr,"Prohibiting forward.\n"); + NoForward = 1; /* prohibit forwarding */ + break; + + case 'm': + fprintf(stderr,"Printing fetch misses.\n"); + PrintFetchMisses = 1; /* prohibit forwarding */ + break; + + case 'd': + fprintf(stderr,"Debug mode.\n"); + debug |= 0x40; + break; + + case 'D': + fprintf(stderr,"Severe debug mode.\n"); + debug |= 0x80; + break; + + case '\0': + debug = 1; + break; + + default: + bad_option( rts_argv[arg] ); + break; + } + break; +# endif + default: + bad_option( rts_argv[arg] ); + break; + } + } + do_gr_sim++; + RTSflags.ConcFlags.ctxtSwitchTime = 0; +} +#endif /* GRAN */ +\end{code} + +%************************************************************************ +%* * +\subsection{Profiling RTS Arguments} +%* * +%************************************************************************ + +\begin{code} +I_ MaxResidency = 0; /* in words; for stats only */ +I_ ResidencySamples = 0; /* for stats only */ + +void +initSM(void) +{ + RTSflags.GcFlags.minAllocAreaSize + = (I_) (RTSflags.GcFlags.heapSize * RTSflags.GcFlags.pcFreeHeap / 100); + /* + This needs to be here, in case the user changed some of these + values with a "hook". + */ +} +\end{code} + +%************************************************************************ +%* * +\subsection{Utility bits} +%* * +%************************************************************************ + +\begin{code} +static FILE * /* return NULL on error */ +open_stats_file ( + I_ arg, + int argc, char *argv[], + int rts_argc, char *rts_argv[], + const char *FILENAME_FMT) +{ + FILE *f = NULL; + + if (strequal(rts_argv[arg]+2, "stderr")) /* use real stderr */ + f = stderr; + else if (rts_argv[arg][2] != '\0') /* stats file specified */ + f = fopen(rts_argv[arg]+2,"w"); + else { + char stats_filename[STATS_FILENAME_MAXLEN]; /* default <program>.<ext> */ + sprintf(stats_filename, FILENAME_FMT, argv[0]); + f = fopen(stats_filename,"w"); + } + if (f == NULL) { + fprintf(stderr, "Can't open stats file %s\n", rts_argv[arg]+2); + } else { + /* Write argv and rtsv into start of stats file */ + I_ count; + for(count = 0; count < argc; count++) + fprintf(f, "%s ", argv[count]); + fprintf(f, "+RTS "); + for(count = 0; count < rts_argc; count++) + fprintf(f, "%s ", rts_argv[count]); + fprintf(f, "\n"); + } + + return(f); +} + +static I_ +decode(const char *s) +{ + I_ c; + StgDouble m; + + if (!*s) + return 0; + + m = atof(s); + c = s[strlen(s)-1]; + + if (c == 'g' || c == 'G') + m *= 1000*1000*1000; /* UNchecked! */ + else if (c == 'm' || c == 'M') + m *= 1000*1000; /* We do not use powers of 2 (1024) */ + else if (c == 'k' || c == 'K') /* to avoid possible bad effects on */ + m *= 1000; /* a direct-mapped cache. */ + else if (c == 'w' || c == 'W') + m *= sizeof(W_); + + return (I_)m; +} + +static void +bad_option(const char *s) +{ + fflush(stdout); + fprintf(stderr, "initSM: Bad RTS option: %s\n", s); + EXIT(EXIT_FAILURE); +} +\end{code} diff --git a/ghc/runtime/main/Select.lc b/ghc/runtime/main/Select.lc index 1f10c7ac85..4fdcaa45ec 100644 --- a/ghc/runtime/main/Select.lc +++ b/ghc/runtime/main/Select.lc @@ -27,14 +27,14 @@ # endif void -AwaitEvent(delta) -I_ delta; +AwaitEvent(I_ delta) { P_ tso, prev, next; rtsBool ready; fd_set rfd; I_ us; I_ min; + I_ maxfd=0; struct timeval tv; min = delta == 0 ? 0x7fffffff : 0; @@ -42,6 +42,9 @@ I_ delta; /* * Collect all of the fd's that we're interested in, and capture * the minimum waiting time for the delayed threads. + * + * (I_)TSO_EVENT(tso) < 0 => thread waiting on fd (-(I_)TSO_EVENT(tso)) + * */ FD_ZERO(&rfd); for(tso = WaitingThreadsHd; tso != Nil_closure; tso = TSO_LINK(tso)) { @@ -52,6 +55,7 @@ I_ delta; min = us; } else { /* Looking at a wait event */ + maxfd = ((-us)> maxfd) ? (-us) : maxfd; FD_SET((-us), &rfd); } } @@ -61,16 +65,16 @@ I_ delta; tv.tv_sec = min / 1000000; tv.tv_usec = min % 1000000; - while (select(FD_SETSIZE, &rfd, NULL, NULL, &tv) < 0) { + while (select((maxfd==0 ? 0 : (maxfd+1)), &rfd, NULL, NULL, &tv) < 0) { if (errno != EINTR) { fflush(stdout); fprintf(stderr, "AwaitEvent: select failed\n"); EXIT(EXIT_FAILURE); } } - + if (delta == 0) - delta = min; + delta=min; prev = NULL; for(tso = WaitingThreadsHd; tso != Nil_closure; tso = next) { diff --git a/ghc/runtime/main/Signals.lc b/ghc/runtime/main/Signals.lc index 3796f9965d..af2738eb42 100644 --- a/ghc/runtime/main/Signals.lc +++ b/ghc/runtime/main/Signals.lc @@ -19,7 +19,6 @@ Since they're pretty rudimentary, they shouldn't actually cause as much pain. \begin{code} - #include "platform.h" #if defined(sunos4_TARGET_OS) @@ -32,9 +31,10 @@ much pain. # define _OSF_SOURCE 1 #endif -#if defined(linuxaout_TARGET_OS) || defined(linux_TARGET_OS) - /* I have no idea why this works (WDP 95/03) */ -# define _BSD_SOURCE 1 +#if irix_TARGET_OS +/* SIGVTALRM not avail w/ POSIX_SOURCE, but worse things happen without */ +/* SIGH: triple SIGH (WDP 95/07) */ +# define SIGVTALRM 28 #endif #include "rtsdefs.h" @@ -46,11 +46,6 @@ much pain. #if defined(HAVE_SIGNAL_H) # include <signal.h> #endif -#if irix_TARGET_OS -/* SIGVTALRM not avail w/ POSIX_SOURCE, but worse things happen without */ -/* SIGH: triple SIGH (WDP 95/07) */ -# define SIGVTALRM 28 -#endif #if defined(HAVE_SIGINFO_H) /* DEC OSF1 seems to need this explicitly. Maybe others do as well? */ @@ -72,12 +67,9 @@ that it really was a stack overflow and not some random segmentation fault. \begin{code} - #if STACK_CHECK_BY_PAGE_FAULT extern P_ stks_space; /* Where the stacks live, from SMstacks.lc */ -extern I_ SM_word_stk_size; /* How big they are (ditto) */ - \end{code} SunOS 4.x is too old to have @SA_SIGINFO@ as a flag to @sigaction@, so @@ -86,20 +78,19 @@ to set up the handler to expect a different collection of arguments. Fun, eh? \begin{code} - -# if defined(sunos4_TARGET_OS) || defined(linuxaout_TARGET_OS) || defined(linux_TARGET_OS) +# if defined(sunos4_TARGET_OS) static void segv_handler(sig, code, scp, addr) int sig; - int code; + int code; /* NB: all except first argument are "implementation defined" */ struct sigcontext *scp; caddr_t addr; { extern void StackOverflow(STG_NO_ARGS) STG_NORETURN; if (addr >= (caddr_t) stks_space - && addr < (caddr_t) (stks_space + SM_word_stk_size)) + && addr < (caddr_t) (stks_space + RTSflags.GcFlags.stksSize)) StackOverflow(); fflush(stdout); @@ -108,9 +99,12 @@ segv_handler(sig, code, scp, addr) } int -install_segv_handler() +install_segv_handler(void) { - return (int) signal(SIGSEGV, segv_handler) == -1; + return ((int) signal(SIGSEGV, segv_handler) == SIG_ERR); + /* I think the "== SIG_ERR" is saying "there was no + handler for SIGSEGV before this one". WDP 95/12 + */ } # else /* Not SunOS 4 */ @@ -121,16 +115,15 @@ install_segv_handler() # endif static void -segv_handler(sig, sip) - int sig; - siginfo_t *sip; +segv_handler(int sig, siginfo_t *sip) + /* NB: the second "siginfo_t" argument is not really standard */ { fflush(stdout); if (sip == NULL) { fprintf(stderr, "Segmentation fault caught, address unknown\n"); } else { if (sip->si_addr >= (caddr_t) stks_space - && sip->si_addr < (caddr_t) (stks_space + SM_word_stk_size)) + && sip->si_addr < (caddr_t) (stks_space + RTSflags.GcFlags.stksSize)) StackOverflow(); fprintf(stderr, "Segmentation fault caught, address = %08lx\n", (W_) sip->si_addr); @@ -139,13 +132,14 @@ segv_handler(sig, sip) } int -install_segv_handler() +install_segv_handler(STG_NO_ARGS) { struct sigaction action; action.sa_handler = segv_handler; sigemptyset(&action.sa_mask); action.sa_flags = SA_SIGINFO; + return sigaction(SIGSEGV, &action, NULL); } @@ -167,27 +161,16 @@ the non-POSIX signal under SunOS 4.1.X, we adopt the same approach here. \begin{code} -#if (defined(USE_COST_CENTRES) || defined(CONCURRENT)) && !defined(GRAN) - -# if defined(USE_COST_CENTRES) -extern I_ heap_profiling_req; -# endif +#if (defined(PROFILING) || defined(CONCURRENT)) && !defined(GRAN) # ifdef CONCURRENT -# if defined(USE_COST_CENTRES) || defined(GUM) -I_ contextSwitchTicks; -I_ profilerTicks; -# endif - # ifdef PAR extern P_ CurrentTSO; # endif -extern I_ contextSwitchTime; static void -vtalrm_handler(sig) - int sig; +vtalrm_handler(int sig) { /* For the parallel world, currentTSO is set if there is any work @@ -195,38 +178,41 @@ vtalrm_handler(sig) in case other PEs have sent us messages which must be processed. */ -# if defined(USE_COST_CENTRES) || defined(GUM) +# if defined(PROFILING) || defined(PAR) static I_ csTicks = 0, pTicks = 0; if (time_profiling) { - if (++pTicks % profilerTicks == 0) { -# if ! defined(USE_COST_CENTRES) + if (++pTicks % RTSflags.CcFlags.profilerTicks == 0) { +# if ! defined(PROFILING) handle_tick_serial(); # else - if (cc_profiling > 1 || heap_profiling_req != HEAP_NO_PROFILING) + if (RTSflags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE + || RTSflags.ProfFlags.doHeapProfile) handle_tick_serial(); else handle_tick_noserial(); # endif } - if (++csTicks % contextSwitchTicks != 0) + if (++csTicks % RTSflags.CcFlags.ctxtSwitchTicks != 0) return; } # endif if (WaitingThreadsHd != Nil_closure) - AwaitEvent(contextSwitchTime); + AwaitEvent(RTSflags.ConcFlags.ctxtSwitchTime); # ifdef PAR if (PendingSparksTl[REQUIRED_POOL] == PendingSparksLim[REQUIRED_POOL] || PendingSparksTl[ADVISORY_POOL] == PendingSparksLim[ADVISORY_POOL]) { PruneSparks(); - if (PendingSparksTl[REQUIRED_POOL] == PendingSparksLim[REQUIRED_POOL]) + if (PendingSparksTl[REQUIRED_POOL] == PendingSparksLim[REQUIRED_POOL]) PendingSparksTl[REQUIRED_POOL] = PendingSparksBase[REQUIRED_POOL] + SparkLimit[REQUIRED_POOL] / 2; - if (PendingSparksTl[ADVISORY_POOL] == PendingSparksLim[ADVISORY_POOL]) + if (PendingSparksTl[ADVISORY_POOL] == PendingSparksLim[ADVISORY_POOL]) { PendingSparksTl[ADVISORY_POOL] = PendingSparksBase[ADVISORY_POOL] + SparkLimit[ADVISORY_POOL] / 2; + sparksIgnored += SparkLimit[REQUIRED_POOL] / 2; + } } if (CurrentTSO != NULL || @@ -242,22 +228,23 @@ vtalrm_handler(sig) # endif -# if defined(sunos4_TARGET_OS) || defined(linuxaout_TARGET_OS) || defined(linux_TARGET_OS) +# if defined(sunos4_TARGET_OS) int -install_vtalrm_handler() +install_vtalrm_handler(void) { void (*old)(); # ifdef CONCURRENT old = signal(SIGVTALRM, vtalrm_handler); # else - if (cc_profiling > 1 || heap_profiling_req != HEAP_NO_PROFILING) + if (RTSflags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE + || RTSflags.ProfFlags.doHeapProfile) old = signal(SIGVTALRM, handle_tick_serial); else old = signal(SIGVTALRM, handle_tick_noserial); # endif - return (int) old == -1; + return ((int) old == SIG_ERR); } static int vtalrm_mask; @@ -284,7 +271,8 @@ install_vtalrm_handler(STG_NO_ARGS) # ifdef CONCURRENT action.sa_handler = vtalrm_handler; # else - if (cc_profiling > 1 || heap_profiling_req != HEAP_NO_PROFILING) + if (RTSflags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE + || RTSflags.ProfFlags.doHeapProfile) action.sa_handler = handle_tick_serial; else action.sa_handler = handle_tick_noserial; @@ -318,9 +306,9 @@ unblockVtAlrmSignal(STG_NO_ARGS) (void) sigprocmask(SIG_UNBLOCK, &signals, NULL); } -# endif /* SunOS 4 */ +# endif /* ! SunOS 4 */ -#endif /* USE_COST_CENTRES || CONCURRENT (but not GRAN) */ +#endif /* PROFILING || CONCURRENT (but not GRAN) */ \end{code} @@ -333,13 +321,13 @@ parallel world. Sorry. #ifdef PAR void -blockUserSignals() +blockUserSignals(void) { return; } void -unblockUserSignals() +unblockUserSignals(void) { return; } @@ -371,8 +359,7 @@ static I_ *handlers = NULL; /* Dynamically grown array of signal handlers */ static I_ nHandlers = 0; /* Size of handlers array */ static void -more_handlers(sig) - I_ sig; +more_handlers(I_ sig) { I_ i; @@ -386,7 +373,7 @@ more_handlers(sig) if (handlers == NULL) { fflush(stdout); - fprintf(stderr, "VM exhausted\n"); + fprintf(stderr, "VM exhausted (in more_handlers)\n"); EXIT(EXIT_FAILURE); } for(i = nHandlers; i <= sig; i++) @@ -399,12 +386,12 @@ more_handlers(sig) # ifdef _POSIX_SOURCE static void -generic_handler(sig) +generic_handler(int sig) { sigset_t signals; SAVE_Hp = SAVE_HpLim; /* Just to be safe */ - if (initStacks(&StorageMgrInfo) != 0) { + if (! initStacks(&StorageMgrInfo)) { fflush(stdout); fprintf(stderr, "initStacks failed!\n"); EXIT(EXIT_FAILURE); @@ -420,19 +407,19 @@ static sigset_t userSignals; static sigset_t savedSignals; void -initUserSignals() +initUserSignals(void) { sigemptyset(&userSignals); } void -blockUserSignals() +blockUserSignals(void) { sigprocmask(SIG_SETMASK, &userSignals, &savedSignals); } void -unblockUserSignals() +unblockUserSignals(void) { sigprocmask(SIG_SETMASK, &savedSignals, NULL); } @@ -485,6 +472,7 @@ sig_install(sig, spi, mask) sigemptyset(&action.sa_mask); action.sa_flags = sig == SIGCHLD && nocldstop ? SA_NOCLDSTOP : 0; + if (sigaction(sig, &action, NULL) || sigprocmask(SIG_UNBLOCK, &signals, NULL)) { if (previous_spi) freeStablePointer(handlers[sig]); @@ -500,7 +488,7 @@ static void generic_handler(sig) { SAVE_Hp = SAVE_HpLim; /* Just to be safe */ - if (initStacks(&StorageMgrInfo) != 0) { + if (! initStacks(&StorageMgrInfo)) { fflush(stdout); fprintf(stderr, "initStacks failed!\n"); EXIT(EXIT_FAILURE); @@ -514,19 +502,19 @@ static int userSignals; static int savedSignals; void -initUserSignals() +initUserSignals(void) { userSignals = 0; } void -blockUserSignals() +blockUserSignals(void) { savedSignals = sigsetmask(userSignals); } void -unblockUserSignals() +unblockUserSignals(void) { sigsetmask(savedSignals); } @@ -538,7 +526,7 @@ sig_install(sig, spi) { I_ previous_spi; int mask; - void (*handler)(); + void (*handler)(int); /* Block the signal until we figure out what to do */ /* Count on this to fail if the signal number is invalid */ @@ -581,7 +569,7 @@ sig_install(sig, spi) return previous_spi; } -# endif /* POSIX */ +# endif /* !POSIX */ #endif /* PAR */ diff --git a/ghc/runtime/main/StgOverflow.lc b/ghc/runtime/main/StgOverflow.lc index 720f243f58..aac16e5465 100644 --- a/ghc/runtime/main/StgOverflow.lc +++ b/ghc/runtime/main/StgOverflow.lc @@ -10,8 +10,7 @@ #include "rtsdefs.h" -extern void PrintRednCountInfo(STG_NO_ARGS); -extern I_ showRednCountStats; +void PrintTickyInfo(STG_NO_ARGS); #ifdef __DO_ARITY_CHKS__ I_ ExpectedArity; @@ -24,10 +23,8 @@ ArityError(n) fprintf(stderr, "Arity error: called with %ld args, should have been %ld\n", ExpectedArity, n); -#if defined(DO_REDN_COUNTING) - if (showRednCountStats) { - PrintRednCountInfo(); - } +#if defined(TICKY_TICKY) + if (RTSflags.TickyFlags.showTickyStats) PrintTickyInfo(); #endif EXIT(EXIT_FAILURE); @@ -49,12 +46,10 @@ void StackOverflow(STG_NO_ARGS) { fflush(stdout); - StackOverflowHook(SM_word_stk_size * sizeof(W_)); /*msg*/ + StackOverflowHook(RTSflags.GcFlags.stksSize * sizeof(W_)); /*msg*/ -#if defined(DO_REDN_COUNTING) - if (showRednCountStats) { - PrintRednCountInfo(); - } +#if defined(TICKY_TICKY) + if (RTSflags.TickyFlags.showTickyStats) PrintTickyInfo(); #endif EXIT(EXIT_FAILURE); @@ -72,9 +67,6 @@ Code for squeezing out vacuous update frames. Updatees of squeezed frames are turned into indirections to the common black hole (or blocking queue). \begin{code} - -I_ squeeze_upd_frames = 1; /* now ON by default */ - I_ SqueezeUpdateFrames(bottom, top, frame) P_ bottom; @@ -93,8 +85,8 @@ P_ frame; return 0; if ((prev_frame = GRAB_SuB(frame)) <= bottom) { -#if !defined(CONCURRENT) && defined(SM_DO_BH_UPDATE) - if (!noBlackHoles) +#if !defined(CONCURRENT) + if ( RTSflags.GcFlags.lazyBlackHoling ) UPD_BH(GRAB_UPDATEE(frame), BH_UPD_info); #endif return 0; @@ -115,30 +107,31 @@ P_ frame; } /* - * Now, we're at the bottom. Frame points to the lowest update frame on the - * stack, and its saved SuB actually points to the frame above. We have to walk - * back up the stack, squeezing out empty update frames and turning the pointers - * back around on the way back up. + * Now, we're at the bottom. Frame points to the lowest update + * frame on the stack, and its saved SuB actually points to the + * frame above. We have to walk back up the stack, squeezing out + * empty update frames and turning the pointers back around on the + * way back up. */ /* - * The bottom-most frame has not been altered, and we never want to eliminate it - * anyway. Just black hole the updatee and walk one step up - * before starting to squeeze. When you get to the topmost frame, - * remember that there are still some words above it that might - * have to be moved. + * The bottom-most frame has not been altered, and we never want + * to eliminate it anyway. Just black hole the updatee and walk + * one step up before starting to squeeze. When you get to the + * topmost frame, remember that there are still some words above + * it that might have to be moved. */ -#if !defined(CONCURRENT) && defined(SM_DO_BH_UPDATE) - if (!noBlackHoles) +#if !defined(CONCURRENT) + if ( RTSflags.GcFlags.lazyBlackHoling ) UPD_BH(GRAB_UPDATEE(frame), BH_UPD_info); #endif prev_frame = frame; frame = next_frame; /* - * Loop through all of the middle frames (everything except the very - * bottom and the very top). + * Loop through all of the middle frames (everything except the + * very bottom and the very top). */ while ((next_frame = GRAB_SuB(frame)) != NULL) { P_ sp; @@ -155,7 +148,7 @@ P_ frame; /* fprintf(stderr, "squeezing frame at %lx, ret %lx\n", frame, GRAB_RET(frame)); - */ + */ #ifdef CONCURRENT /* Check for a blocking queue on the node that's going away */ @@ -182,15 +175,15 @@ P_ frame; } #endif - UPD_EXISTING(); /* ticky stuff (NB: nothing for spat-profiling) */ + UPD_SQUEEZED(); /* ticky stuff (NB: nothing for spat-profiling) */ UPD_IND(updatee_bypass, updatee_keep); sp = frame - BREL(1); /* Toss the current frame */ displacement += STD_UF_SIZE; } else { -#if !defined(CONCURRENT) && defined(SM_DO_BH_UPDATE) - if (!noBlackHoles) +#if !defined(CONCURRENT) + if ( RTSflags.GcFlags.lazyBlackHoling ) UPD_BH(GRAB_UPDATEE(frame), BH_UPD_info); #endif @@ -206,7 +199,7 @@ P_ frame; if (displacement > 0) { P_ next_frame_bottom = next_frame + BREL(STD_UF_SIZE); - /* + /* fprintf(stderr, "sliding [%lx, %lx] by %d\n", sp, next_frame_bottom, displacement); */ @@ -221,14 +214,14 @@ P_ frame; } /* - * Now handle the topmost frame. Patch SuB, black hole the updatee, - * and slide down. + * Now handle the topmost frame. Patch SuB, black hole the + * updatee, and slide down. */ PUSH_SuB(frame, prev_frame); -#if !defined(CONCURRENT) && defined(SM_DO_BH_UPDATE) - if (!noBlackHoles) +#if !defined(CONCURRENT) + if ( RTSflags.GcFlags.lazyBlackHoling ) UPD_BH(GRAB_UPDATEE(frame), BH_UPD_info); #endif @@ -246,7 +239,6 @@ P_ frame; } return displacement; } - \end{code} %************************************************************************ @@ -293,29 +285,35 @@ W_ args2; SET_TASK_ACTIVITY(ST_OVERHEAD); - /* - * fprintf(stderr,"StackOverflow:liveness=%lx,a=%lx,b=%lx\n", - * liveness,words_of_a,words_of_b); - */ + /*?/ + fprintf(stderr,"StackOverflow:liveness=%lx,a=%lx,b=%lx\n", + liveness,words_of_a,words_of_b); + /?*/ old_stko = SAVE_StkO; - /* - * fprintf(stderr, "SpA %lx SuA %lx SpB %lx SuB %lx\n", STKO_SpA(old_stko), - * STKO_SuA(old_stko), STKO_SpB(old_stko), STKO_SuB(old_stko)); - */ + /*?/ + fprintf(stderr, "stko: %lx SpA %lx SuA %lx SpB %lx SuB %lx\n", + old_stko, STKO_SpA(old_stko), + STKO_SuA(old_stko), STKO_SpB(old_stko), STKO_SuB(old_stko)); + /?*/ + + if (RTSflags.GcFlags.squeezeUpdFrames) { - if (squeeze_upd_frames) { i = SqueezeUpdateFrames(STKO_BSTK_BOT(old_stko), STKO_SpB(old_stko), - STKO_SuB(old_stko)); + STKO_SuB(old_stko)); + STKO_SuB(old_stko) += BREL(i); STKO_SpB(old_stko) += BREL(i); + + /*?/ fprintf(stderr, "Just squeezed; now: SpB %lx SuB %lx retval %d\n", STKO_SpB(old_stko), STKO_SuB(old_stko), i); /?*/ + if ((P_) STKO_SpA(old_stko) - AREL(headroom) > STKO_SpB(old_stko)) { - /* - * fprintf(stderr, "SpA %lx SpB %lx headroom %d\n", STKO_SpA(old_stko), - * STKO_SpB(old_stko), headroom); - */ + /*?/ + fprintf(stderr, "Squeezed; now: SpA %lx SpB %lx headroom %d\n", STKO_SpA(old_stko), + STKO_SpB(old_stko), headroom); + /?*/ /* We saved enough space to continue on the old StkO */ return 0; @@ -323,7 +321,10 @@ W_ args2; } SAVE_Liveness = liveness; + ASSERT(sanityChk_StkO(old_stko)); + /* Double the stack chunk size each time we grow the stack */ + /*?/ fprintf(stderr, "Stko %lx: about to double stk-chk size from %d...\n", old_stko, STKO_CLOSURE_CTS_SIZE(old_stko)); /?*/ cts_size = STKO_CLOSURE_CTS_SIZE(old_stko) * 2; if (SAVE_Hp + STKO_HS + cts_size > SAVE_HpLim) { @@ -332,11 +333,21 @@ W_ args2; * Even in the uniprocessor world, we may have to reenter node in case * node is a selector shorted out by GC. */ - assert(liveness & LIVENESS_R1); + ASSERT(liveness & LIVENESS_R1); TSO_PC2(CurrentTSO) = EnterNodeCode; really_reenter_node = 1; } + /*?/ fprintf(stderr, "StkO %lx: stk-chk GC: size %d...\n", old_stko, STKO_HS + cts_size);/?*/ ReallyPerformThreadGC(STKO_HS + cts_size, rtsFalse); + /* + now, GC semantics promise to have left SAVE_Hp with + the requested space *behind* it; as we will bump + SAVE_Hp just below, we had better first put it back. + (PS: Finding this was a two-day bug-hunting trip...) + Will & Phil 95/10 + */ + SAVE_Hp -= STKO_HS + cts_size; + old_stko = SAVE_StkO; } ALLOC_STK(STKO_HS, cts_size, 0); @@ -344,12 +355,16 @@ W_ args2; SAVE_Hp += STKO_HS + cts_size; SET_STKO_HDR(new_stko, StkO_info, CCC); + /*?/ fprintf(stderr, "New StkO now %lx...\n", new_stko); /?*/ + /* Initialize the StkO, as in NewThread */ STKO_SIZE(new_stko) = cts_size + STKO_VHS; STKO_SpB(new_stko) = STKO_SuB(new_stko) = STKO_BSTK_BOT(new_stko) + BREL(1); STKO_SpA(new_stko) = STKO_SuA(new_stko) = STKO_ASTK_BOT(new_stko) + AREL(1); STKO_LINK(new_stko) = old_stko; + /*?/ fprintf(stderr, "New StkO SpA = %lx...\n", STKO_SpA(new_stko) ); /?*/ + STKO_RETURN(new_stko) = SAVE_Ret; #ifdef PAR @@ -358,7 +373,7 @@ W_ args2; * When we fall off of the top stack segment, we will either be * returning an algebraic data type, in which case R2 holds a * valid info ptr, or we will be returning a primitive - * (e.g. int#), in which case R2 is garbage. If we need to perform + * (e.g. Int#), in which case R2 is garbage. If we need to perform * GC to pull in the lower stack segment (this should only happen * because of task migration), then we need to know the register * liveness for the algebraic returns. We get the liveness out of @@ -378,7 +393,7 @@ W_ args2; STKO_SpA(old_stko) += AREL(words_of_a); STKO_SpB(old_stko) += BREL(words_of_b); -#ifdef DO_REDN_COUNTING +#ifdef TICKY_TICKY /* Record the stack depths in chunks below the new stack object */ STKO_ADEP(new_stko) = STKO_ADEP(old_stko) + @@ -388,17 +403,17 @@ W_ args2; #endif if (STKO_SpB(old_stko) < STKO_BSTK_BOT(old_stko)) { - /* - * This _should_ only happen if PAP_entry fails a stack check and there is - * no update frame on the current stack. We can deal with this by storing a - * function's argument requirements in its info table, peering into the PAP - * (it had better be in R1) for the function pointer and taking only the - * necessary number of arguments, but this would be hard, so we haven't done - * it. + * This _should_ only happen if PAP_entry fails a stack check + * and there is no update frame on the current stack. We can + * deal with this by storing a function's argument + * requirements in its info table, peering into the PAP (it + * had better be in R1) for the function pointer and taking + * only the necessary number of arguments, but this would be + * hard, so we haven't done it. */ fflush(stdout); - fprintf(stderr, "StackOverflow too deep. Probably a PAP with no update frame.\n"); + fprintf(stderr, "StackOverflow too deep (SpB=%lx, Bstk bot=%lx). Probably a PAP with no update frame.\n", STKO_SpB(old_stko), STKO_BSTK_BOT(old_stko)); abort(); /* an 'abort' may be overkill WDP 95/04 */ } /* Move A stack words from old StkO to new StkO */ @@ -420,9 +435,9 @@ W_ args2; P_ frame = STKO_SuB(new_stko) - BREL(STD_UF_SIZE); /* - * fprintf(stderr, "Stolen update frame: (old %lx, new %lx) SuA %lx, SuB - * %lx, return %lx\n", old_stko, new_stko, GRAB_SuA(frame), GRAB_SuB(frame), - * GRAB_RET(frame)); + fprintf(stderr, "Stolen update frame: (old %lx, new %lx) SuA %lx, SuB + %lx, return %lx\n", old_stko, new_stko, GRAB_SuA(frame), GRAB_SuB(frame), + GRAB_RET(frame)); */ STKO_SuA(old_stko) = GRAB_SuA(frame); @@ -437,7 +452,11 @@ W_ args2; STKO_SuB(new_stko) = frame; } + + ASSERT(sanityChk_StkO(new_stko)); + SAVE_StkO = new_stko; + return really_reenter_node; } \end{code} diff --git a/ghc/runtime/main/StgStartup.lhc b/ghc/runtime/main/StgStartup.lhc index 9728711982..3bd53e8cd7 100644 --- a/ghc/runtime/main/StgStartup.lhc +++ b/ghc/runtime/main/StgStartup.lhc @@ -131,8 +131,8 @@ MallocPtr_ITBL(MallocPtr_info,MallocPtr_entry,UpdErr,0,INFO_OTHER_TAG,,,const,EF /* Ditto for the unused Stable Pointer info table. [ADR] */ -extern void raiseError PROTO((StgStablePtr)); -extern StgStablePtr errorHandler; +void raiseError PROTO((StgStablePtr)); +extern StgStablePtr errorHandler; /* NB: prone to magic-value-ery (WDP 95/12) */ /* Unused Stable Pointer (ie unused slot in a stable pointer table) */ STATICFUN(UnusedSP_entry) @@ -145,13 +145,23 @@ STATICFUN(UnusedSP_entry) FE_ } -STATIC_ITBL(UnusedSP_static_info,UnusedSP_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,IF_,CON_K,"UNUSED STABLE PTR","USP"); +STATIC_ITBL(UnusedSP_info,UnusedSP_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,IF_,CON_K,"UNUSED STABLE PTR","USP"); -SET_STATIC_HDR(UnusedSP_closure,UnusedSP_static_info,CC_SUBSUMED,,ED_RO_) +SET_STATIC_HDR(UnusedSP_closure,UnusedSP_info,CC_SUBSUMED,,ED_RO_) }; /* Entry point and Info table for Stable Pointer Table. */ +STATICFUN(EmptyStablePointerTable_entry) +{ + FB_ + /* Don't wrap the calls; we're done with STG land */ + fflush(stdout); + fprintf(stderr, "Entered *empty* stable pointer table---this shouldn't happen!\n"); + abort(); + FE_ +} + STATICFUN(StablePointerTable_entry) { FB_ @@ -162,7 +172,7 @@ STATICFUN(StablePointerTable_entry) FE_ } -STATIC_ITBL(EmptyStablePointerTable_static_info,StablePointerTable_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,IF_,SPT_K,"SP_TABLE","SP_TABLE"); +STATIC_ITBL(EmptyStablePointerTable_info,EmptyStablePointerTable_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,IF_,SPT_K,"SP_TABLE","SP_TABLE"); /* ToDo: could put a useful tag in there!!! */ DYN_ITBL(StablePointerTable_info,StablePointerTable_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,IF_,SPT_K,"SP_TABLE","SP_TABLE"); @@ -174,7 +184,7 @@ DYN_ITBL(StablePointerTable_info,StablePointerTable_entry,UpdErr,0,INFO_OTHER_TA overflow will trigger creation of a table of useful size. */ -SET_STATIC_HDR(EmptySPTable_closure,EmptyStablePointerTable_static_info,CC_SUBSUMED,,ED_RO_) +SET_STATIC_HDR(EmptySPTable_closure,EmptyStablePointerTable_info,CC_SUBSUMED,,ED_RO_) , (W_) DYN_VHS + 0 + 1 + 0 /* size = DYN_VHS + n + 1 + n with n = 0 */ , (W_) 0 /* number of ptrs */ , (W_) 0 /* top of stack */ @@ -207,10 +217,6 @@ STGFUN(startStgWorld) up to date, and is used to load the STG registers. */ -#if defined (DO_SPAT_PROFILING) - SET_ACTIVITY(ACT_REDN); /* init: do this first, so we count the restore insns */ -#endif - RestoreAllStgRegs(); /* inline! */ /* ------- STG registers are now valid! -------------------------*/ @@ -340,7 +346,7 @@ STGFUN(ErrorIO_innards) default: /* Don't wrap the calls; we're done with STG land */ fflush(stdout); - fprintf(stderr,"ErrorIO: %x unknown\n", TSO_TYPE(CurrentTSO)); + fprintf(stderr,"ErrorIO: %lx unknown\n", TSO_TYPE(CurrentTSO)); EXIT(EXIT_FAILURE); } @@ -353,7 +359,7 @@ STGFUN(ErrorIO_innards) STKO_LINK(StkOReg) = Nil_closure; STKO_RETURN(StkOReg) = NULL; -#ifdef DO_REDN_COUNTING +#ifdef TICKY_TICKY STKO_ADEP(StkOReg) = STKO_BDEP(StkOReg) = 0; #endif @@ -395,7 +401,7 @@ ErrorIO_innards(STG_NO_ARGS) SaveAllStgRegs(); /* inline! */ - if ( initStacks( &StorageMgrInfo ) != 0) { + if (! initStacks( &StorageMgrInfo )) { /* Don't wrap the calls; we're done with STG land */ fflush(stdout); fprintf(stderr, "initStacks failed!\n"); @@ -477,10 +483,10 @@ STGFUN(STK_STUB_entry) { } /* info table */ -STATIC_ITBL(STK_STUB_static_info,STK_STUB_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,EF_,INTERNAL_KIND,"STK_STUB","STK_STUB"); +STATIC_ITBL(STK_STUB_info,STK_STUB_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,EF_,INTERNAL_KIND,"STK_STUB","STK_STUB"); /* closure */ -SET_STATIC_HDR(STK_STUB_closure,STK_STUB_static_info,CC_SUBSUMED,,EXTDATA_RO) +SET_STATIC_HDR(STK_STUB_closure,STK_STUB_info,CC_SUBSUMED,,EXTDATA_RO) , (W_)0, (W_)0 }; \end{code} @@ -595,7 +601,7 @@ N.B. ALL prelude cost centres should be declared here as none will ToDo: Explicit cost centres in prelude for Input and Output costs. \begin{code} -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) STGFUN(startCcRegisteringWorld) { diff --git a/ghc/runtime/main/StgThreads.lhc b/ghc/runtime/main/StgThreads.lhc index b3f9f28d0c..ab63382739 100644 --- a/ghc/runtime/main/StgThreads.lhc +++ b/ghc/runtime/main/StgThreads.lhc @@ -111,7 +111,7 @@ STGFUN(BQ_entry) QP_Event1("GR", CurrentTSO); } #ifdef PAR - if(do_gr_profile) { + if(RTSflags.ParFlags.granSimStats) { /* Note that CURRENT_TIME may perform an unsafe call */ TIME now = CURRENT_TIME; TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO); @@ -182,7 +182,7 @@ STGFUN(RBH_entry) QP_Event1("GR", CurrentTSO); } - if(do_gr_profile) { + if(RTSflags.ParFlags.granSimStats) { /* Note that CURRENT_TIME may perform an unsafe call */ TIME now = CURRENT_TIME; TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO); @@ -211,22 +211,21 @@ STGFUN(RBH_entry) %* * %************************************************************************ -The normal way of entering a thread is through resumeThread, which -short-circuits and indirections to the TSO and StkO, sets up STG registers, -and jumps to the saved PC. +The normal way of entering a thread is through \tr{resumeThread}, +which short-circuits any indirections to the TSO and StkO, sets up STG +registers, and jumps to the saved PC. \begin{code} - STGFUN(resumeThread) { FB_ - while((P_) INFO_PTR(CurrentTSO) == Ind_info) { + while(IS_INDIRECTION(INFO_PTR(CurrentTSO))) { CurrentTSO = (P_) IND_CLOSURE_PTR(CurrentTSO); } #ifdef PAR - if (do_gr_profile) { + if (RTSflags.ParFlags.granSimStats) { TSO_QUEUE(CurrentTSO) = Q_RUNNING; /* Note that CURRENT_TIME may perform an unsafe call */ TSO_BLOCKEDAT(CurrentTSO) = CURRENT_TIME; @@ -235,18 +234,16 @@ STGFUN(resumeThread) CurrentRegTable = TSO_INTERNAL_PTR(CurrentTSO); - while((P_) INFO_PTR(SAVE_StkO) == Ind_info) { + while(IS_INDIRECTION(INFO_PTR(SAVE_StkO))) { SAVE_StkO = (P_) IND_CLOSURE_PTR(SAVE_StkO); } RestoreAllStgRegs(); SET_TASK_ACTIVITY(ST_REDUCING); - SET_ACTIVITY(ACT_REDN); /* back to normal reduction */ RESTORE_CCC(TSO_CCC(CurrentTSO)); JMP_(TSO_PC1(CurrentTSO)); FE_ } - \end{code} Since we normally context switch during a heap check, it is possible @@ -255,26 +252,22 @@ sufficient heap for the thread to continue. However, we have cleverly stashed away the heap requirements in @TSO_ARG1@ so that we can decide whether or not to perform a garbage collection before resuming the thread. The actual thread resumption address (either @EnterNodeCode@ -or elsewhere) is stashed in TSO_PC2. +or elsewhere) is stashed in @TSO_PC2@. \begin{code} - STGFUN(CheckHeapCode) { FB_ ALLOC_HEAP(TSO_ARG1(CurrentTSO)); /* ticky profiling */ - SET_ACTIVITY(ACT_HEAP_CHK); /* SPAT counting */ if ((Hp += TSO_ARG1(CurrentTSO)) > HpLim) { ReallyPerformThreadGC(TSO_ARG1(CurrentTSO), rtsFalse); JMP_(resumeThread); } SET_TASK_ACTIVITY(ST_REDUCING); - SET_ACTIVITY(ACT_REDN); /* back to normal reduction */ RESUME_(TSO_PC2(CurrentTSO)); FE_ } - \end{code} Often, a thread starts (or rather, resumes) by entering the closure @@ -283,7 +276,6 @@ The saved PC in the TSO can be set to @EnterNodeCode@ whenever we want this to happen upon resumption of the thread. \begin{code} - STGFUN(EnterNodeCode) { FB_ @@ -293,28 +285,26 @@ STGFUN(EnterNodeCode) JMP_(ENTRY_CODE(InfoPtr)); FE_ } - \end{code} -Then, there are the occasions when we just want to pick up where we left off. -We use RESUME_ here instead of JMP_, because when we return to a call site, -the alpha is going to try to load %gp from %ra rather than %pv, and JMP_ only -sets %pv. Resuming to the start of a function is currently okay, but an -extremely bad practice. As we add support for more architectures, we can expect -the difference between RESUME_ and JMP_ to become more acute. +Then, there are the occasions when we just want to pick up where we +left off. We use \tr{RESUME_} here instead of \tr{JMP_}, because when +we return to a call site, the Alpha is going to try to load \tr{%gp} +from \tr{%ra} rather than \tr{%pv}, and \tr{JMP_} only sets \tr{%pv}. +Resuming to the start of a function is currently okay, but an +extremely bad practice. As we add support for more architectures, we +can expect the difference between \tr{RESUME_} and \tr{JMP_} to become +more acute. \begin{code} - STGFUN(Continue) { FB_ SET_TASK_ACTIVITY(ST_REDUCING); - SET_ACTIVITY(ACT_REDN); /* back to normal reduction */ RESUME_(TSO_PC2(CurrentTSO)); FE_ } - \end{code} %************************************************************************ @@ -324,11 +314,7 @@ STGFUN(Continue) %************************************************************************ \begin{code} - -extern P_ AvailableStack; - #ifndef PAR - \end{code} On a uniprocessor, stack underflow causes us no great headaches. The @@ -388,6 +374,20 @@ STGFUN(CommonUnderflow) FB_ temp = STKO_LINK(StkOReg); + + /* fprintf(stderr,"Stk Underflow from: %lx to: %lx size abandoned: %d\n",StkOReg,temp,STKO_CLOSURE_CTS_SIZE(StkOReg)); */ + + /* change the guy we are abandoning into something + that will not be "interesting" on the mutables + list. (As long as it is there, it will be + scavenged in GC, and we cannot guarantee that + it is still a "sane" StkO object). (And, besides, + why continue to keep it [and all it pts to] alive?) + Will & Phil 95/10 + */ + FREEZE_MUT_HDR(StkOReg, ImMutArrayOfPtrs_info); + MUTUPLE_CLOSURE_SIZE(StkOReg) = MUTUPLE_VHS; + StkOReg = temp; /* ToDo: Fetch the remote stack object here! */ RestoreStackStgRegs(); diff --git a/ghc/runtime/main/StgTrace.lc b/ghc/runtime/main/StgTrace.lc deleted file mode 100644 index 0c4ab4ca33..0000000000 --- a/ghc/runtime/main/StgTrace.lc +++ /dev/null @@ -1,74 +0,0 @@ -\begin{code} - -#include "rtsdefs.h" - -#if defined(DO_RUNTIME_TRACE_UPDATES) - -/********** Debugging Tracing of Updates ***********/ - -/* These will only be called if StgUpdate.h macro calls - compiled with -DDO_RUNTIME_TRACE_UPDATES - */ - -extern I_ traceUpdates; /* a Bool, essentially */ - -void -TRACE_UPDATE_Ind(updclosure,heapptr) -P_ updclosure,heapptr; -{ -#if defined(GCap) - if (traceUpdates) { - fprintf(stderr,"Upd Ind %s Gen: 0x%lx -> 0x%lx\n", - (updclosure) <= StorageMgrInfo.OldLim ? "Old" : "New", - (W_) updclosure, (W_) heapptr); - } -#else - if (traceUpdates) { - fprintf(stderr,"Upd Ind: 0x%lx -> 0x%lx\n", - (W_) updclosure, (W_) heapptr); - } -#endif -} - -void -TRACE_UPDATE_Inplace_NoPtrs(updclosure) -P_ updclosure; -{ -#if defined(GCap) - if (traceUpdates) { - fprintf(stderr,"Upd Inplace %s Gen: 0x%lx\n", - (updclosure) <= StorageMgrInfo.OldLim ? "Old" : "New", - (W_) updclosure); - } -#else - if (traceUpdates) { - fprintf(stderr,"Upd Inplace: 0x%lx\n", (W_) updclosure); - } -#endif -} - -void -TRACE_UPDATE_Inplace_Ptrs(updclosure, hp) -P_ updclosure; -P_ hp; -{ -#if defined(GCap) - if (traceUpdates) { - if ((updclosure) <= StorageMgrInfo.OldLim) { - fprintf(stderr,"Upd Redirect Old Gen (Ptrs): 0x%lx -> 0x%lx\n", - (W_) updclosure, - (W_) (hp + 1)); - } else { - fprintf(stderr,"Upd Inplace New Gen (Ptrs): 0x%lx\n", (W_) updclosure); - } - } -#else - if (traceUpdates) { - fprintf(stderr,"Update Inplace: 0x%lx\n", (W_) updclosure); - } -#endif -} - -#endif /* DO_RUNTIME_TRACE_UPDATES */ - -\end{code} diff --git a/ghc/runtime/main/StgUpdate.lhc b/ghc/runtime/main/StgUpdate.lhc index 904f637124..e0cb2458b9 100644 --- a/ghc/runtime/main/StgUpdate.lhc +++ b/ghc/runtime/main/StgUpdate.lhc @@ -33,9 +33,8 @@ System-wide constants need to be included: EXTDATA(Nil_closure); -#if defined(DO_REDN_COUNTING) -extern void PrintRednCountInfo(STG_NO_ARGS); -extern I_ showRednCountStats; +#if defined(TICKY_TICKY) +void PrintTickyInfo(STG_NO_ARGS); #endif \end{code} @@ -51,7 +50,6 @@ STGFUN(Ind_entry) { FB_ ENT_IND(Node); /* Ticky-ticky profiling info */ - SET_ACTIVITY(ACT_INDIRECT); /* SPAT profiling */ Node = (P_) IND_CLOSURE_PTR((P_) Node); ENT_VIA_NODE(); @@ -61,7 +59,6 @@ STGFUN(Ind_entry) } IND_ITBL(Ind_info,Ind_entry,const,EF_); - \end{code} We also need a special @CAF@ indirection info table which is used to @@ -71,7 +68,6 @@ STGFUN(Caf_entry) /* same as Ind_entry */ { FB_ ENT_IND(Node); - SET_ACTIVITY(ACT_INDIRECT); /* SPAT profiling */ Node = (P_) IND_CLOSURE_PTR((P_) Node); ENT_VIA_NODE(); @@ -102,8 +98,8 @@ EXTFUN(EnterNodeCode); EXTFUN(StackUnderflowEnterNode); EXTDATA_RO(BQ_info); #else -extern StgStablePtr errorHandler; -extern void raiseError PROTO((StgStablePtr)); +void raiseError PROTO((StgStablePtr)); +extern StgStablePtr errorHandler; /* NB: prone to magic-value-ery (WDP 95/12) */ #endif STGFUN(BH_UPD_entry) @@ -113,16 +109,16 @@ STGFUN(BH_UPD_entry) (void) STGCALL1(int,(void *, FILE *),fflush,stdout); (void) STGCALL2(int,(),fprintf,stderr,"Entered a `black hole': the program has a cyclic data dependency.\n"); -# if defined(USE_COST_CENTRES) +# if defined(PROFILING) { CostCentre cc = (CostCentre) CC_HDR(Node); (void) STGCALL5(int,(),fprintf,stderr,"Cost Centre: %s Module: %s Group %s\n",cc->label, cc->module, cc->group); } # endif -# if defined(DO_REDN_COUNTING) - if (showRednCountStats) { - (void) STGCALL0(void,(),PrintRednCountInfo); +# if defined(TICKY_TICKY) + if (RTSflags.TickyFlags.showTickyStats) { + (void) STGCALL0(void,(),PrintTickyInfo); } # endif @@ -166,7 +162,7 @@ STGFUN(BH_UPD_entry) } # ifdef PAR - if(do_gr_profile) { + if(RTSflags.ParFlags.granSimStats) { TIME now = CURRENT_TIME; TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO); TSO_BLOCKCOUNT(CurrentTSO)++; @@ -184,6 +180,7 @@ STGFUN(BH_UPD_entry) # endif FE_ + #endif /* threads */ } @@ -197,16 +194,16 @@ STGFUN(BH_SINGLE_entry) (void) STGCALL2(int,(),fprintf,stderr,"either the compiler made a mistake on single-entryness,\n"); (void) STGCALL2(int,(),fprintf,stderr,"or the program has a cyclic data dependency.\n"); -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) { CostCentre cc = (CostCentre) CC_HDR(Node); (void) STGCALL5(int,(),fprintf,stderr, "Cost Centre: %s Module: %s Group %s\n",cc->label, cc->module, cc->group); } #endif -# if defined(DO_REDN_COUNTING) - if (showRednCountStats) { - (void) STGCALL0(void,(),PrintRednCountInfo); +# if defined(TICKY_TICKY) + if (RTSflags.TickyFlags.showTickyStats) { + (void) STGCALL0(void,(),PrintTickyInfo); } # endif @@ -303,27 +300,27 @@ vtbl_StdUpdFrame[] = { %* * %************************************************************************ -Here is the standard update code for objects that are returned in the heap -(or those which are initially returned in registers, but have already been -allocated in the heap earlier in the update chain.) In either case, Node -points to the heap object. The update code grabs the address of the updatee -out of the partial update frame (the return address has already been popped), -makes the updatee an indirection to Node, and returns according to the convention -for the constructor. +Here is the standard update code for objects that are returned in the +heap (or those which are initially returned in registers, but have +already been allocated in the heap earlier in the update chain). In +either case, @Node@ points to the heap object. The update code grabs +the address of the updatee out of the partial update frame (the return +address has already been popped), makes the updatee an indirection to +@Node@, and returns according to the convention for the constructor. \begin{code} -#define IND_UPD_TEMPLATE(label, retvector) \ - STGFUN(label) \ - { \ - FB_ \ - UPD_EXISTING(); /* Ticky-ticky profiling info */ \ - /* Update thing off stk with an indirection to Node */ \ - UPD_IND(GRAB_UPDATEE(SpB), Node); \ - /* Pop the standard update frame */ \ - POP_STD_UPD_FRAME() \ - \ - JMP_(retvector); \ - FE_ \ +#define IND_UPD_TEMPLATE(label, retvector) \ + STGFUN(label) \ + { \ + FB_ \ + UPD_EXISTING(); /* Ticky-ticky profiling info */ \ + /* Update thing off stk with an indirection to Node */ \ + UPD_IND(GRAB_UPDATEE(SpB), Node); \ + /* Pop the standard update frame */ \ + POP_STD_UPD_FRAME() \ + \ + JMP_(retvector); \ + FE_ \ } IND_UPD_TEMPLATE(IndUpdRetDir, DIRECT(((P_)RetReg))) @@ -335,7 +332,6 @@ IND_UPD_TEMPLATE(IndUpdRetV4, ((P_)RetReg)[RVREL(4)]) IND_UPD_TEMPLATE(IndUpdRetV5, ((P_)RetReg)[RVREL(5)]) IND_UPD_TEMPLATE(IndUpdRetV6, ((P_)RetReg)[RVREL(6)]) IND_UPD_TEMPLATE(IndUpdRetV7, ((P_)RetReg)[RVREL(7)]) - \end{code} %************************************************************************ @@ -385,8 +381,12 @@ the cost centre when entered. The heap profiler ignores the space occupied by it as it would not reside in the heap during normal execution. +In ticky-land: If we are trying to collect update-entry counts +(controlled by an RTS flag), then we must use permanent indirections +(the shorting-out of regular indirections loses the counts). + \begin{code} -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) || defined(TICKY_TICKY) STGFUN(Perm_Ind_entry) { @@ -394,15 +394,17 @@ STGFUN(Perm_Ind_entry) /* Don't add INDs to granularity cost */ - ENT_IND(Node); /* Ticky-ticky profiling info */ + /* Dont: ENT_IND(Node); for ticky-ticky; this ind is here only to help ticky */ /* Enter PAP cost centre -- lexical scoping only */ ENTER_CC_PAP_CL(Node); Node = (P_) IND_CLOSURE_PTR((P_) Node); - ENT_VIA_NODE(); /* Ticky-ticky profiling info */ + + /* Dont: ENT_VIA_NODE(); for ticky-ticky; as above */ InfoPtr=(D_)(INFO_PTR(Node)); + # if defined(GRAN) GRAN_EXEC(1,1,2,0,0); # endif @@ -412,7 +414,7 @@ STGFUN(Perm_Ind_entry) PERM_IND_ITBL(Perm_Ind_info,Perm_Ind_entry,const,EF_); -#endif /* USE_COST_CENTRES */ +#endif /* PROFILING or TICKY */ \end{code} %************************************************************************ @@ -443,7 +445,6 @@ stack chunk. \end{itemize} \begin{code} - STGFUN(UpdatePAP) { /* @@ -455,7 +456,7 @@ STGFUN(UpdatePAP) #define NPtrWords (R3.i) #define NArgWords (R4.i) #define PapSize (R5.i) -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) # define CC_pap ((CostCentre)(R7.p)) #endif @@ -472,8 +473,6 @@ STGFUN(UpdatePAP) ++nPAPs; #endif - SET_ACTIVITY(ACT_UPDATE_PAP); /* SPAT profiling */ - NPtrWords = AREL(SuA - SpA); NNonPtrWords = BREL(SuB - SpB); @@ -482,7 +481,7 @@ STGFUN(UpdatePAP) NArgWords = NPtrWords + NNonPtrWords + 1; /* +1 for Node */ -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) /* set "CC_pap" to go in the updatee (see Sansom thesis, p 183) */ CC_pap /*really cc_enter*/ = (CostCentre) CC_HDR(Node); @@ -516,8 +515,6 @@ STGFUN(UpdatePAP) /* Allocate PapClosure -- Only Node (R1) is live */ HEAP_CHK(LIVENESS_R1, PapSize, 0); - SET_ACTIVITY(ACT_UPDATE_PAP); /* back to it (for SPAT profiling) */ - PapClosure = Hp + 1 - PapSize; /* The new PapClosure */ SET_DYN_HDR(PapClosure, PAP_info, CC_pap, NArgWords + DYN_VHS, NPtrWords + 1); @@ -526,13 +523,14 @@ STGFUN(UpdatePAP) p = Hp; for (i = NNonPtrWords - 1; i >= 0; i--) *p-- = (W_) SpB[BREL(i)]; - for (i = NPtrWords - 1; i >= 0; i--) *p-- = (W_) SpA[AREL(i)]; + for (i = NPtrWords - 1; i >= 0; i--) *p-- = (W_) SpA[AREL(i)]; *p = (W_) Node; } /* - * Finished constructing PAP closure; now update the updatee. - * But wait! What if there is no updatee? Then we fall off the stack. + * Finished constructing PAP closure; now update the updatee. But + * wait! What if there is no updatee? Then we fall off the + * stack. */ #ifdef CONCURRENT @@ -558,12 +556,12 @@ STGFUN(UpdatePAP) UPD_IND(Updatee, PapClosure); /* Indirect Updatee to PapClosure */ if (NArgWords != 1) { - UPD_PAP_IN_NEW(); + UPD_PAP_IN_NEW(NArgWords); } else { UPD_PAP_IN_PLACE(); -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) /* * Lexical scoping requires a *permanent* indirection, and we * also have to set the cost centre for the indirection. @@ -571,10 +569,10 @@ STGFUN(UpdatePAP) INFO_PTR(Updatee) = (W_) Perm_Ind_info; SET_CC_HDR(Updatee, CC_pap); -#endif /* USE_COST_CENTRES */ +#endif /* PROFILING */ } -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) /* * Restore the Cost Centre too (if required); again see Sansom thesis p 183. * Take the CC out of the update frame if a CAF/DICT. @@ -582,7 +580,7 @@ STGFUN(UpdatePAP) CCC = (IS_CAF_OR_DICT_CC(CC_pap)) ? GRAB_COST_CENTRE(SuB) : CC_pap; -#endif /* USE_COST_CENTRES */ +#endif /* PROFILING */ /* Restore SuA, SuB, RetReg */ RetReg = GRAB_RET(SuB); @@ -615,7 +613,7 @@ STGFUN(UpdatePAP) #undef NPtrWords #undef NArgWords #undef PapSize -#ifdef USE_COST_CENTRES +#ifdef PROFILING # undef CC_pap #endif } @@ -631,11 +629,11 @@ STGFUN(PAP_entry) /* Use STG registers for these locals which must survive the STK_CHK */ #define NPtrWords (R2.i) #define NNonPtrWords (R3.i) -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) # define CC_pap ((CostCentre)(R7.p)) #endif - /* These locals don't have to survive a HEAP_CHK */ + /* These locals don't have to survive the STK_CHK */ P_ Updatee; P_ p; I_ i; @@ -643,8 +641,6 @@ STGFUN(PAP_entry) FB_ - SET_ACTIVITY(ACT_UPDATE_PAP); /* SPAT profiling */ - while (AREL(SuA - SpA) == 0 && BREL(SuB - SpB) == 0) { #ifdef CONCURRENT if (SuB < STKO_BSTK_BOT(StkOReg)) { @@ -660,16 +656,17 @@ STGFUN(PAP_entry) Updatee = GRAB_UPDATEE(SuB); UPD_IND(Updatee, Node); -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) /* - * Restore the Cost Centre too (if required); again see Sansom thesis p 183. - * Take the CC out of the update frame if a CAF/DICT. - */ + * Restore the Cost Centre too (if required); again see Sansom + * thesis p 183. Take the CC out of the update frame if a + * CAF/DICT. + */ CC_pap = (CostCentre) CC_HDR(Node); CCC = (IS_CAF_OR_DICT_CC(CC_pap)) ? GRAB_COST_CENTRE(SuB) : CC_pap; -#endif /* USE_COST_CENTRES */ +#endif /* PROFILING */ RetReg = GRAB_RET(SuB); SuA = GRAB_SuA(SuB); @@ -718,7 +715,7 @@ STGFUN(PAP_entry) #undef NPtrWords #undef NNonPtrWords -#ifdef USE_COST_CENTRES +#ifdef PROFILING # undef CC_pap #endif } diff --git a/ghc/runtime/main/Threads.lc b/ghc/runtime/main/Threads.lc index a5f175fc0d..4df5c8ecfb 100644 --- a/ghc/runtime/main/Threads.lc +++ b/ghc/runtime/main/Threads.lc @@ -40,7 +40,8 @@ static void init_qp_profiling(STG_NO_ARGS); /* forward decl */ @AvailableStack@ is used to determine whether an existing stack can be reused without new allocation, so reducing garbage collection, and stack setup time. At present, it is only used for the first stack -chunk of a thread, the one that's got @StkOChunkSize@ words. +chunk of a thread, the one that's got +@RTSflags.ConcFlags.stkChunkSize@ words. \begin{code} P_ AvailableStack = Nil_closure; @@ -58,7 +59,6 @@ which should be <= the length of a word in bits. -- HWL /* mattson thinks this is obsolete */ # if 0 && defined(GRAN) -extern FILE *main_statsfile; /* Might be of general interest HWL */ typedef unsigned long TIME; typedef unsigned char PROC; @@ -145,8 +145,6 @@ I_ nUPDs = 0, nUPDs_old = 0, nUPDs_new = 0, nUPDs_BQ = 0, nPAPs = 0, BQ_lens = 0; # endif -I_ do_gr_binary = 0; -I_ do_gr_profile = 0; /* Full .gr profile or only END events? */ I_ no_gr_profile = 0; /* Don't create any .gr file at all? */ I_ do_sp_profile = 0; I_ do_gr_migration = 0; @@ -297,7 +295,7 @@ static eventq getnextevent() if(EventHd == NULL) { fprintf(stderr,"No next event\n"); - exit(EXIT_FAILURE); /* ToDo: abort()? EXIT??? */ + exit(EXIT_FAILURE); /* ToDo: abort()? EXIT? */ } if(entry != NULL) @@ -361,8 +359,7 @@ EVTTYPE evttype; P_ tso, node; sparkq spark; { - extern P_ xmalloc(); - eventq newentry = (eventq) xmalloc(sizeof(struct event)); + eventq newentry = (eventq) stgMallocBytes(sizeof(struct event), "newevent"); EVENT_PROC(newentry) = proc; EVENT_CREATOR(newentry) = creator; @@ -395,7 +392,6 @@ PP_ PendingSparksTl[SPARK_POOLS]; static jmp_buf scheduler_loop; -I_ MaxThreads = DEFAULT_MAX_THREADS; I_ required_thread_count = 0; I_ advisory_thread_count = 0; @@ -405,27 +401,26 @@ P_ NewThread PROTO((P_, W_)); I_ context_switch = 0; -I_ contextSwitchTime = CS_MIN_MILLISECS; /* In milliseconds */ - #if !defined(GRAN) I_ threadId = 0; +I_ sparksIgnored =0; -I_ MaxLocalSparks = DEFAULT_MAX_LOCAL_SPARKS; I_ SparkLimit[SPARK_POOLS]; -extern I_ doSanityChks; -extern void checkAStack(STG_NO_ARGS); - rtsBool -initThreadPools(size) -I_ size; +initThreadPools(STG_NO_ARGS) { + I_ size = RTSflags.ConcFlags.maxLocalSparks; + SparkLimit[ADVISORY_POOL] = SparkLimit[REQUIRED_POOL] = size; + if ((PendingSparksBase[ADVISORY_POOL] = (PP_) malloc(size * sizeof(P_))) == NULL) return rtsFalse; + if ((PendingSparksBase[REQUIRED_POOL] = (PP_) malloc(size * sizeof(P_))) == NULL) return rtsFalse; + PendingSparksLim[ADVISORY_POOL] = PendingSparksBase[ADVISORY_POOL] + size; PendingSparksLim[REQUIRED_POOL] = PendingSparksBase[REQUIRED_POOL] + size; return rtsTrue; @@ -440,15 +435,17 @@ void ScheduleThreads(topClosure) P_ topClosure; { +#ifdef GRAN I_ i; +#endif P_ tso; -#if defined(USE_COST_CENTRES) || defined(GUM) - if (time_profiling || contextSwitchTime > 0) { - if (initialize_virtual_timer(tick_millisecs)) { +#if defined(PROFILING) || defined(PAR) + if (time_profiling || RTSflags.ConcFlags.ctxtSwitchTime > 0) { + if (initialize_virtual_timer(RTSflags.CcFlags.msecsPerTick)) { #else - if (contextSwitchTime > 0) { - if (initialize_virtual_timer(contextSwitchTime)) { + if (RTSflags.ConcFlags.ctxtSwitchTime > 0) { + if (initialize_virtual_timer(RTSflags.ConcFlags.ctxtSwitchTime)) { #endif fflush(stdout); fprintf(stderr, "Can't initialize virtual timer.\n"); @@ -486,8 +483,8 @@ P_ topClosure; init_qp_profiling(); /* - * We perform GC so that a signal handler can install a new TopClosure and start - * a new main thread. + * We perform GC so that a signal handler can install a new + * TopClosure and start a new main thread. */ #ifdef PAR if (IAmMainThread) { @@ -517,7 +514,7 @@ P_ topClosure; #endif #ifdef PAR - if (do_gr_profile) { + if (RTSflags.ParFlags.granSimStats) { DumpGranEvent(GR_START, tso); sameThread = rtsTrue; } @@ -574,33 +571,37 @@ P_ topClosure; fprintf(stderr, "No runnable threads!\n"); EXIT(EXIT_FAILURE); } - AwaitEvent(0); + AwaitEvent(RTSflags.ConcFlags.ctxtSwitchTime); } #else if (RunnableThreadsHd == Nil_closure) { - if (advisory_thread_count < MaxThreads && + if (advisory_thread_count < RTSflags.ConcFlags.maxThreads && (PendingSparksHd[REQUIRED_POOL] < PendingSparksTl[REQUIRED_POOL] || PendingSparksHd[ADVISORY_POOL] < PendingSparksTl[ADVISORY_POOL])) { /* - * If we're here (no runnable threads) and we have pending sparks, - * we must have a space problem. Get enough space to turn one of - * those pending sparks into a thread...ReallyPerformGC doesn't - * return until the space is available, so it may force global GC. - * ToDo: Is this unnecessary here? Duplicated in ReSchedule()? --JSM + * If we're here (no runnable threads) and we have pending + * sparks, we must have a space problem. Get enough space + * to turn one of those pending sparks into a + * thread... ReallyPerformGC doesn't return until the + * space is available, so it may force global GC. ToDo: + * Is this unnecessary here? Duplicated in ReSchedule()? + * --JSM */ ReallyPerformThreadGC(THREAD_SPACE_REQUIRED, rtsTrue); SAVE_Hp -= THREAD_SPACE_REQUIRED; } else { /* - * We really have absolutely no work. Send out a fish (there may be - * some out there already), and wait for something to arrive. We - * clearly can't run any threads until a SCHEDULE or RESUME arrives, - * and so that's what we're hoping to see. (Of course, we still have - * to respond to other types of messages.) + * We really have absolutely no work. Send out a fish + * (there may be some out there already), and wait for + * something to arrive. We clearly can't run any threads + * until a SCHEDULE or RESUME arrives, and so that's what + * we're hoping to see. (Of course, we still have to + * respond to other types of messages.) */ if (!fishing) sendFish(choosePE(), mytid, NEW_FISH_AGE, NEW_FISH_HISTORY, NEW_FISH_HUNGER); + processMessages(); } ReSchedule(0); @@ -614,7 +615,7 @@ P_ topClosure; } #ifdef PAR - if (do_gr_profile && !sameThread) + if (RTSflags.ParFlags.granSimStats && !sameThread) DumpGranEvent(GR_SCHEDULE, RunnableThreadsHd); #endif @@ -635,7 +636,7 @@ P_ topClosure; #endif /* If we're not running a timer, just leave the flag on */ - if (contextSwitchTime > 0) + if (RTSflags.ConcFlags.ctxtSwitchTime > 0) context_switch = 0; #if defined(GRAN_CHECK) && defined(GRAN) /* Just for testing */ @@ -661,14 +662,7 @@ P_ topClosure; } #endif -# if defined(__STG_TAILJUMPS__) miniInterpret((StgFunPtr)resumeThread); -# else - if (doSanityChks) - miniInterpret_debug((StgFunPtr)resumeThread, checkAStack); - else - miniInterpret((StgFunPtr)resumeThread); -# endif /* __STG_TAILJUMPS__ */ } \end{code} @@ -724,13 +718,13 @@ int what_next; /* Run the current thread again? */ /* This code does round-Robin, if preferred. */ if(DoFairSchedule && TSO_LINK(CurrentTSO) != Nil_closure) { - if(do_gr_profile) + if(RTSflags.ParFlags.granSimStats) DumpGranEvent(GR_DESCHEDULE,ThreadQueueHd); ThreadQueueHd = TSO_LINK(CurrentTSO); TSO_LINK(ThreadQueueTl) = CurrentTSO; ThreadQueueTl = CurrentTSO; TSO_LINK(CurrentTSO) = Nil_closure; - if (do_gr_profile) + if (RTSflags.ParFlags.granSimStats) DumpGranEvent(GR_SCHEDULE,ThreadQueueHd); CurrentTime[CurrentProc] += gran_threadcontextswitchtime; } @@ -747,7 +741,7 @@ int what_next; /* Run the current thread again? */ } #endif - if(do_gr_profile) + if(RTSflags.ParFlags.granSimStats) DumpGranEvent(GR_SCHEDULE,ThreadQueueHd); CurrentTSO = ThreadQueueHd; @@ -908,7 +902,7 @@ int what_next; /* Run the current thread again? */ ++TSO_FETCHCOUNT(EVENT_TSO(event)); TSO_FETCHTIME(EVENT_TSO(event)) += gran_fetchtime; - if (do_gr_profile) + if (RTSflags.ParFlags.granSimStats) DumpGranEventAndNode(GR_REPLY,EVENT_TSO(event), EVENT_NODE(event),EVENT_CREATOR(event)); @@ -926,7 +920,7 @@ int what_next; /* Run the current thread again? */ CONTINUETHREAD,Nil_closure,Nil_closure,NULL); TSO_BLOCKTIME(EVENT_TSO(event)) += CurrentTime[CurrentProc] - TSO_BLOCKEDAT(EVENT_TSO(event)); - if(do_gr_profile) + if(RTSflags.ParFlags.granSimStats) DumpGranEvent(GR_RESUME,EVENT_TSO(event)); continue; } else { @@ -991,7 +985,7 @@ int what_next; /* Run the current thread again? */ if(do_sp_profile) DumpSparkGranEvent(SP_PRUNED,spark); - assert(spark != NULL); + ASSERT(spark != NULL); SparkQueueHd = SPARK_NEXT(spark); if(SparkQueueHd == NULL) @@ -1058,7 +1052,7 @@ int what_next; /* Run the current thread again? */ newevent(CurrentProc,CurrentProc,CurrentTime[CurrentProc], STARTTHREAD,tso,Nil_closure,NULL); - assert(spark != NULL); + ASSERT(spark != NULL); SparkQueueHd = SPARK_NEXT(spark); if(SparkQueueHd == NULL) @@ -1128,11 +1122,11 @@ int again; /* Run the current thread again? */ #ifdef PAR /* * In the parallel world, we do unfair scheduling for the moment. - * Ultimately, this should all be merged with the more sophicticated - * GrAnSim scheduling options. (Of course, some provision should be - * made for *required* threads to make sure that they don't starve, - * but for now we assume that no one is running concurrent Haskell on - * a multi-processor platform.) + * Ultimately, this should all be merged with the more + * sophisticated GrAnSim scheduling options. (Of course, some + * provision should be made for *required* threads to make sure + * that they don't starve, but for now we assume that no one is + * running concurrent Haskell on a multi-processor platform.) */ sameThread = again; @@ -1186,7 +1180,7 @@ int again; /* Run the current thread again? */ if (RunnableThreadsHd == Nil_closure) { RunnableThreadsHd = tso; #ifdef PAR - if (do_gr_profile) { + if (RTSflags.ParFlags.granSimStats) { DumpGranEvent(GR_START, tso); sameThread = rtsTrue; } @@ -1194,7 +1188,7 @@ int again; /* Run the current thread again? */ } else { TSO_LINK(RunnableThreadsTl) = tso; #ifdef PAR - if (do_gr_profile) + if (RTSflags.ParFlags.granSimStats) DumpGranEvent(GR_STARTQ, tso); #endif } @@ -1224,14 +1218,14 @@ int again; /* Run the current thread again? */ (RunnableThreadsHd != Nil_closure || (required_thread_count == 0 && IAmMainThread)) || #endif - advisory_thread_count == MaxThreads || + advisory_thread_count == RTSflags.ConcFlags.maxThreads || (tso = NewThread(spark, T_ADVISORY)) == NULL) break; advisory_thread_count++; if (RunnableThreadsHd == Nil_closure) { RunnableThreadsHd = tso; #ifdef PAR - if (do_gr_profile) { + if (RTSflags.ParFlags.granSimStats) { DumpGranEvent(GR_START, tso); sameThread = rtsTrue; } @@ -1239,7 +1233,7 @@ int again; /* Run the current thread again? */ } else { TSO_LINK(RunnableThreadsTl) = tso; #ifdef PAR - if (do_gr_profile) + if (RTSflags.ParFlags.granSimStats) DumpGranEvent(GR_STARTQ, tso); #endif } @@ -1288,7 +1282,7 @@ enum gran_event_types event_type; CurrentTSO = ThreadQueueHd = ThreadQueueTl = EVENT_TSO(event); newevent(CurrentProc,CurrentProc,CurrentTime[CurrentProc]+gran_threadqueuetime, CONTINUETHREAD,Nil_closure,Nil_closure,NULL); - if(do_gr_profile) + if(RTSflags.ParFlags.granSimStats) DumpGranEvent(event_type,EVENT_TSO(event)); } else @@ -1299,7 +1293,7 @@ enum gran_event_types event_type; if(DoThreadMigration) ++SurplusThreads; - if(do_gr_profile) + if(RTSflags.ParFlags.granSimStats) DumpGranEvent(event_type+1,EVENT_TSO(event)); } @@ -1498,7 +1492,7 @@ PROC proc; MAKE_BUSY(proc); --SurplusThreads; - if(do_gr_profile) + if(RTSflags.ParFlags.granSimStats) DumpRawGranEvent(p,GR_STEALING,TSO_ID(thread)); CurrentTime[p] += 5l * gran_mtidytime; @@ -1543,7 +1537,7 @@ UNVEC(EXTFUN(stopThreadDirectReturn);,EXTDATA(vtbl_stopStgWorld);) #if defined(GRAN) -/* Slow but relatively reliable method uses xmalloc */ +/* Slow but relatively reliable method uses stgMallocBytes */ /* Eventually change that to heap allocated sparks. */ sparkq @@ -1551,8 +1545,8 @@ NewSpark(node,name,local) P_ node; I_ name, local; { - extern P_ xmalloc(); - sparkq newspark = (sparkq) xmalloc(sizeof(struct spark)); + sparkq newspark = (sparkq) stgMallocBytes(sizeof(struct spark), "NewSpark"); + SPARK_PREV(newspark) = SPARK_NEXT(newspark) = NULL; SPARK_NODE(newspark) = node; SPARK_NAME(newspark) = name; @@ -1594,8 +1588,6 @@ sparkq spark; #endif -I_ StkOChunkSize = DEFAULT_STKO_CHUNK_SIZE; - /* Create a new TSO, with the specified closure to enter and thread type */ P_ @@ -1622,7 +1614,9 @@ W_ type; } TSO_LINK(tso) = Nil_closure; +#ifdef PAR TSO_CCC(tso) = (CostCentre)STATIC_CC_REF(CC_MAIN); +#endif TSO_NAME(tso) = (P_) INFO_PTR(topClosure); /* A string would be nicer -- JSM */ TSO_ID(tso) = threadId++; TSO_TYPE(tso) = type; @@ -1630,7 +1624,7 @@ W_ type; TSO_ARG1(tso) = TSO_EVENT(tso) = 0; TSO_SWITCH(tso) = NULL; -#ifdef DO_REDN_COUNTING +#ifdef TICKY_TICKY TSO_AHWM(tso) = 0; TSO_BHWM(tso) = 0; #endif @@ -1672,15 +1666,15 @@ W_ type; SET_PROCS(stko,ThisPE); #endif AvailableStack = STKO_LINK(AvailableStack); - } else if (SAVE_Hp + STKO_HS + StkOChunkSize > SAVE_HpLim) { + } else if (SAVE_Hp + STKO_HS + RTSflags.ConcFlags.stkChunkSize > SAVE_HpLim) { return(NULL); } else { - ALLOC_STK(STKO_HS,StkOChunkSize,0); + ALLOC_STK(STKO_HS,RTSflags.ConcFlags.stkChunkSize,0); stko = SAVE_Hp + 1; - SAVE_Hp += STKO_HS + StkOChunkSize; + SAVE_Hp += STKO_HS + RTSflags.ConcFlags.stkChunkSize; SET_STKO_HDR(stko, StkO_info, CCC); } - STKO_SIZE(stko) = StkOChunkSize + STKO_VHS; + STKO_SIZE(stko) = RTSflags.ConcFlags.stkChunkSize + STKO_VHS; STKO_SpB(stko) = STKO_SuB(stko) = STKO_BSTK_BOT(stko) + BREL(1); STKO_SpA(stko) = STKO_SuA(stko) = STKO_ASTK_BOT(stko) + AREL(1); STKO_LINK(stko) = Nil_closure; @@ -1689,7 +1683,7 @@ W_ type; } # endif -#ifdef DO_REDN_COUNTING +#ifdef TICKY_TICKY STKO_ADEP(stko) = STKO_BDEP(stko) = 0; #endif @@ -1701,6 +1695,8 @@ W_ type; SAVE_Ret = (StgRetAddr) UNVEC(stopThreadDirectReturn,vtbl_stopStgWorld); SAVE_StkO = stko; + ASSERT(sanityChk_StkO(stko)); + if (DO_QP_PROF) { QP_Event1(do_qp_prof > 1 ? "*A" : "*G", tso); } @@ -1716,14 +1712,14 @@ EndThread(STG_NO_ARGS) #ifdef PAR TIME now = CURRENT_TIME; #endif -#ifdef DO_REDN_COUNTING - extern FILE *tickyfile; - - if (tickyfile != NULL) { - fprintf(tickyfile, "Thread %d (%lx)\n\tA stack max. depth: %ld words\n", - TSO_ID(CurrentTSO), TSO_NAME(CurrentTSO), TSO_AHWM(CurrentTSO)); - fprintf(tickyfile, "\tB stack max. depth: %ld words\n", - TSO_BHWM(CurrentTSO)); +#ifdef TICKY_TICKY + if (RTSflags.TickyFlags.showTickyStats) { + fprintf(RTSflags.TickyFlags.tickyFile, + "Thread %d (%lx)\n\tA stack max. depth: %ld words\n", + TSO_ID(CurrentTSO), TSO_NAME(CurrentTSO), TSO_AHWM(CurrentTSO)); + fprintf(RTSflags.TickyFlags.tickyFile, + "\tB stack max. depth: %ld words\n", + TSO_BHWM(CurrentTSO)); } #endif @@ -1732,7 +1728,7 @@ EndThread(STG_NO_ARGS) } #if defined(GRAN) - assert(CurrentTSO == ThreadQueueHd); + ASSERT(CurrentTSO == ThreadQueueHd); ThreadQueueHd = TSO_LINK(CurrentTSO); if(ThreadQueueHd == Nil_closure) @@ -1754,7 +1750,7 @@ EndThread(STG_NO_ARGS) /* make the job of bookkeeping the running, runnable, */ /* blocked threads easier for scripts like gr2ps -- HWL */ - if (do_gr_profile && !is_first) + if (RTSflags.ParFlags.granSimStats && !is_first) DumpRawGranEvent(i,GR_SCHEDULE, TSO_ID(RunnableThreadsHd[i])); if (!no_gr_profile) @@ -1790,19 +1786,19 @@ EndThread(STG_NO_ARGS) /* Note ThreadQueueHd is Nil when the main thread terminates */ if(ThreadQueueHd != Nil_closure) { - if (do_gr_profile && !no_gr_profile) + if (RTSflags.ParFlags.granSimStats && !no_gr_profile) DumpGranEvent(GR_SCHEDULE,ThreadQueueHd); CurrentTime[CurrentProc] += gran_threadscheduletime; } - else if (do_gr_binary && TSO_TYPE(CurrentTSO)==T_MAIN && + else if (RTSflags.ParFlags.granSimStats_Binary && TSO_TYPE(CurrentTSO)==T_MAIN && !no_gr_profile) grterminate(CurrentTime[CurrentProc]); } #endif /* GRAN */ #ifdef PAR - if (do_gr_profile) { + if (RTSflags.ParFlags.granSimStats) { TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO); DumpGranInfo(thisPE, CurrentTSO, TSO_TYPE(CurrentTSO) != T_ADVISORY); } @@ -1812,7 +1808,7 @@ EndThread(STG_NO_ARGS) case T_MAIN: required_thread_count--; #ifdef PAR - if (do_gr_binary) + if (RTSflags.ParFlags.granSimStats_Binary) grterminate(now); #endif @@ -1913,7 +1909,7 @@ AwakenBlockingQueue(bqe) QP_Event2(do_qp_prof > 1 ? "RA" : "RG", bqe, CurrentTSO); } # ifdef PAR - if (do_gr_profile) { + if (RTSflags.ParFlags.granSimStats) { DumpGranEvent(GR_RESUMEQ, bqe); switch (TSO_QUEUE(bqe)) { case Q_BLOCKED: @@ -1993,7 +1989,7 @@ AwakenBlockingQueue(node) while(tso != Nil_closure) { W_ proc; - assert(TSO_INTERNAL_PTR(tso)->rR[0].p == node); + ASSERT(TSO_INTERNAL_PTR(tso)->rR[0].p == node); # if defined(COUNT) ++BQ_lens; @@ -2028,14 +2024,14 @@ AwakenBlockingQueue(node) TSO_LINK(ThreadQueueTl) = tso; while(TSO_LINK(tso) != Nil_closure) { - assert(TSO_INTERNAL_PTR(tso)->rR[0].p == node); + ASSERT(TSO_INTERNAL_PTR(tso)->rR[0].p == node); if (DO_QP_PROF) { QP_Event2(do_qp_prof > 1 ? "RA" : "RG", tso, CurrentTSO); } tso = TSO_LINK(tso); } - assert(TSO_INTERNAL_PTR(tso)->rR[0].p == node); + ASSERT(TSO_INTERNAL_PTR(tso)->rR[0].p == node); if (DO_QP_PROF) { QP_Event2(do_qp_prof > 1 ? "RA" : "RG", tso, CurrentTSO); } @@ -2060,7 +2056,7 @@ W_ args; QP_Event1("GR", CurrentTSO); } #ifdef PAR - if (do_gr_profile) { + if (RTSflags.ParFlags.granSimStats) { /* Note that CURRENT_TIME may perform an unsafe call */ TSO_EXECTIME(CurrentTSO) += CURRENT_TIME - TSO_BLOCKEDAT(CurrentTSO); } @@ -2100,7 +2096,8 @@ FetchNode(node,from,to) P_ node; PROC from, to; { - assert(to==CurrentProc); + ASSERT(to==CurrentProc); + if (!IS_LOCAL_TO(PROCS(node),from) && !IS_LOCAL_TO(PROCS(node),to) ) return 1; @@ -2135,7 +2132,7 @@ PROC p; { /* start tso */ newevent(p,CurrentProc, CurrentTime[CurrentProc] /* +gran_latency */, - FETCHREPLY,tso,node,NULL); /* node needed ?? */ + FETCHREPLY,tso,node,NULL); /* node needed ? */ CurrentTime[CurrentProc] += gran_mtidytime; } else if (IS_LOCAL_TO(PROCS(node),CurrentProc) ) /* Is node still here? */ @@ -2146,7 +2143,7 @@ PROC p; newevent(p,CurrentProc, CurrentTime[CurrentProc]+gran_latency, - FETCHREPLY,tso,node,NULL); /* node needed ?? */ + FETCHREPLY,tso,node,NULL); /* node needed ? */ CurrentTime[CurrentProc] += gran_mtidytime; } @@ -2159,7 +2156,7 @@ PROC p; if (NoForward) { newevent(p,p_new, max(CurrentTime[p_new],CurrentTime[CurrentProc])+gran_latency, - FETCHREPLY,tso,node,NULL); /* node needed ?? */ + FETCHREPLY,tso,node,NULL); /* node needed ? */ CurrentTime[CurrentProc] += gran_mtidytime; return; } @@ -2205,7 +2202,7 @@ int prog_argc, rts_argc; if(do_gr_sim) { - char *extension = do_gr_binary? "gb": "gr"; + char *extension = RTSflags.ParFlags.granSimStats_Binary? "gb": "gr"; sprintf(gr_filename, GR_FILENAME_FMT, prog_argv[0],extension); if ((gr_file = fopen(gr_filename,"w")) == NULL ) @@ -2283,7 +2280,7 @@ int prog_argc, rts_argc; fputs("\n\n++++++++++++++++++++\n\n",gr_file); } - if(do_gr_binary) + if(RTSflags.ParFlags.granSimStats_Binary) grputw(sizeof(TIME)); Idlers = max_proc; @@ -2339,7 +2336,10 @@ init_qp_profiling(STG_NO_ARGS) fputc(' ', qp_file); fputs(prog_argv[i], qp_file); } - fprintf(qp_file, " +RTS -C%d -t%d\n", contextSwitchTime, MaxThreads); + fprintf(qp_file, " +RTS -C%d -t%d\n" + , RTSflags.ConcFlags.ctxtSwitchTime + , RTSflags.ConcFlags.maxThreads); + fputs(time_str(), qp_file); fputc('\n', qp_file); } @@ -2406,7 +2406,7 @@ ActivateNextThread () if(ThreadQueueHd==Nil_closure) { MAKE_IDLE(CurrentProc); ThreadQueueTl = Nil_closure; - } else if (do_gr_profile) { + } else if (RTSflags.ParFlags.granSimStats) { CurrentTime[CurrentProc] += gran_threadcontextswitchtime; DumpGranEvent(GR_SCHEDULE,ThreadQueueHd); } @@ -2526,7 +2526,7 @@ P_ node; -- assumes head of queue == CurrentTSO */ if(!DoFairSchedule) { - if(do_gr_profile) + if(RTSflags.ParFlags.granSimStats) DumpGranEventAndNode(GR_FETCH,CurrentTSO,node,p); ActivateNextThread(); @@ -2560,7 +2560,7 @@ P_ node; else /* !DoReScheduleOnFetch */ { /* Note: CurrentProc is still busy as it's blocked on fetch */ - if(do_gr_profile) + if(RTSflags.ParFlags.granSimStats) DumpGranEventAndNode(GR_FETCH,CurrentTSO,node,p); #if defined(GRAN_CHECK) && defined(GRAN) /* Just for testing */ @@ -2640,7 +2640,7 @@ I_ identifier; void GranSimBlock() { - if(do_gr_profile) + if(RTSflags.ParFlags.granSimStats) DumpGranEvent(GR_BLOCK,CurrentTSO); ++TSO_BLOCKCOUNT(CurrentTSO); @@ -2717,7 +2717,7 @@ I_ num_ptr_roots; { #if defined(GRAN_CHECK) && defined(GRAN) if ( debug & 0x40 ) - fprintf(main_statsfile,"Saving Spark Root %d(proc: %d; pool: %d) -- 0x%lx\n", + fprintf(RTSflags.GcFlags.statsFile,"Saving Spark Root %d(proc: %d; pool: %d) -- 0x%lx\n", num_ptr_roots,proc,i,SPARK_NODE(spark)); #endif StorageMgrInfo.roots[num_ptr_roots++] = SPARK_NODE(spark); @@ -2735,7 +2735,7 @@ I_ num_ptr_roots; } } /* forall spark ... */ if (prunedSparks>0) { - fprintf(main_statsfile,"Pruning and disposing %lu excess sparks (> %lu) on proc %d for GC purposes\n", + fprintf(RTSflags.GcFlags.statsFile,"Pruning and disposing %lu excess sparks (> %lu) on proc %d for GC purposes\n", prunedSparks,MAX_SPARKS,proc); if (disposeQ == PendingSparksHd[proc][i]) PendingSparksHd[proc][i] = NULL; @@ -2806,14 +2806,14 @@ I_ num_ptr_roots, sparkroots; SPARK_NODE(spark) = StorageMgrInfo.roots[--num_ptr_roots]; #if defined(GRAN_CHECK) && defined(GRAN) if ( debug & 0x40 ) - fprintf(main_statsfile,"Restoring Spark Root %d -- new: 0x%lx \n", + fprintf(RTSflags.GcFlags.statsFile,"Restoring Spark Root %d -- new: 0x%lx \n", num_ptr_roots,SPARK_NODE(spark)); #endif } else #if defined(GRAN_CHECK) && defined(GRAN) if ( debug & 0x40 ) - fprintf(main_statsfile,"Error in RestoreSpkRoots (%d; @ spark 0x%x): More than MAX_SPARKS (%d) sparks\n", + fprintf(RTSflags.GcFlags.statsFile,"Error in RestoreSpkRoots (%d; @ spark 0x%x): More than MAX_SPARKS (%d) sparks\n", num_ptr_roots,SPARK_NODE(spark),MAX_SPARKS); #endif @@ -2882,7 +2882,7 @@ PROC proc; if(name > GR_EVENT_MAX) name = GR_EVENT_MAX; - if(do_gr_binary) + if(RTSflags.ParFlags.granSimStats_Binary) { grputw(name); grputw(pe); @@ -2902,7 +2902,7 @@ W_ id; if(name > GR_EVENT_MAX) name = GR_EVENT_MAX; - if(do_gr_binary) + if(RTSflags.ParFlags.granSimStats_Binary) { grputw(name); grputw(pe); @@ -2919,7 +2919,7 @@ PROC pe; P_ tso; I_ mandatory_thread; { - if(do_gr_binary) + if(RTSflags.ParFlags.granSimStats_Binary) { grputw(GR_END); grputw(pe); @@ -3327,7 +3327,7 @@ P_ node; fprintf(stderr," [GA: 0x%lx]",GA(node)); #endif -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) fprintf(stderr," [CC: 0x%lx]",CC_HDR(node)); #endif @@ -3399,7 +3399,7 @@ P_ node; fprintf(stderr,"Enter Flush Entry: 0x%lx;\tExit Flush Entry: 0x%lx\n",INFO_FLUSHENT(info_ptr),INFO_FLUSH(info_ptr)); #endif -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) fprintf(stderr,"Cost Centre (???): 0x%lx\n",INFO_CAT(info_ptr)); #endif @@ -3659,7 +3659,10 @@ init_qp_profiling(STG_NO_ARGS) fputc(' ', qp_file); fputs(prog_argv[i], qp_file); } - fprintf(qp_file, "+RTS -C%ld -t%ld\n", contextSwitchTime, MaxThreads); + fprintf(qp_file, "+RTS -C%ld -t%ld\n" + , RTSflags.ConcFlags.ctxtSwitchTime + , RTSflags.ConcFlags.maxThreads); + fputs(time_str(), qp_file); fputc('\n', qp_file); } @@ -3700,35 +3703,24 @@ unsigned CurrentProc = 0; W_ IdleProcs = ~0l, Idlers = 32; void -GranSimAllocate(n,node,liveness) -I_ n; -P_ node; -W_ liveness; +GranSimAllocate(I_ n, P_ node, W_ liveness) { } void -GranSimUnallocate(n,node,liveness) -W_ n; -P_ node; -W_ liveness; +GranSimUnallocate(W_ n, P_ node, W_ liveness) { } - void -GranSimExec(ariths,branches,loads,stores,floats) -W_ ariths,branches,loads,stores,floats; +GranSimExec(W_ ariths, W_ branches, W_ loads, W_ stores, W_ floats) { } -I_ -GranSimFetch(node /* , liveness_mask */ ) -P_ node; +int +GranSimFetch(P_ node /* , liveness_mask */ ) /* I_ liveness_mask; */ -{ } +{ return(9999999); } void -GranSimSpark(local,node) -W_ local; -P_ node; +GranSimSpark(W_ local, P_ node) { } #if 0 @@ -3741,7 +3733,7 @@ I_ identifier; #endif void -GranSimBlock() +GranSimBlock(STG_NO_ARGS) { } #endif diff --git a/ghc/runtime/main/Ticky.lc b/ghc/runtime/main/Ticky.lc new file mode 100644 index 0000000000..d0276dc490 --- /dev/null +++ b/ghc/runtime/main/Ticky.lc @@ -0,0 +1,871 @@ +% +% (c) The GRASP Project, Glasgow University, 1992-1993 +% +%************************************************************************ +%* * +\section[Ticky.lc]{Stuff for ``ticky-ticky'' profiling} +%* * +%************************************************************************ + +Goes with \tr{imports/Ticky.lh}; more documentation there. + +%************************************************************************ +%* * +\subsection[Ticky-counters]{Declare all the counters} +%* * +%************************************************************************ + +\begin{code} +#define NULL_REG_MAP /* Not threaded */ + +#include "../storage/SMinternal.h" /* Bad boy, Will (ToDo) */ + +#if defined(TICKY_TICKY) + +I_ ALLOC_HEAP_ctr = 0; +I_ ALLOC_HEAP_tot = 0; + +PP_ max_SpA; /* set in re_enterable_part_of_main */ +P_ max_SpB; + +/* not used at all +I_ A_STK_REUSE_ctr = 0; +I_ B_STK_REUSE_ctr = 0; +*/ +I_ A_STK_STUB_ctr = 0; + +I_ ALLOC_FUN_ctr = 0; +I_ ALLOC_FUN_adm = 0; +I_ ALLOC_FUN_gds = 0; +I_ ALLOC_FUN_slp = 0; +I_ ALLOC_FUN_hst[5] = {0,0,0,0,0}; +I_ ALLOC_THK_ctr = 0; +I_ ALLOC_THK_adm = 0; +I_ ALLOC_THK_gds = 0; +I_ ALLOC_THK_slp = 0; +I_ ALLOC_THK_hst[5] = {0,0,0,0,0}; +I_ ALLOC_CON_ctr = 0; +I_ ALLOC_CON_adm = 0; +I_ ALLOC_CON_gds = 0; +I_ ALLOC_CON_slp = 0; +I_ ALLOC_CON_hst[5] = {0,0,0,0,0}; +I_ ALLOC_TUP_ctr = 0; +I_ ALLOC_TUP_adm = 0; +I_ ALLOC_TUP_gds = 0; +I_ ALLOC_TUP_slp = 0; +I_ ALLOC_TUP_hst[5] = {0,0,0,0,0}; +I_ ALLOC_BH_ctr = 0; +I_ ALLOC_BH_adm = 0; +I_ ALLOC_BH_gds = 0; +I_ ALLOC_BH_slp = 0; +I_ ALLOC_BH_hst[5] = {0,0,0,0,0}; +I_ ALLOC_PRIM_ctr = 0; +I_ ALLOC_PRIM_adm = 0; +I_ ALLOC_PRIM_gds = 0; +I_ ALLOC_PRIM_slp = 0; +I_ ALLOC_PRIM_hst[5] = {0,0,0,0,0}; +I_ ALLOC_UPD_PAP_ctr = 0; +I_ ALLOC_UPD_PAP_adm = 0; +I_ ALLOC_UPD_PAP_gds = 0; +I_ ALLOC_UPD_PAP_slp = 0; +I_ ALLOC_UPD_PAP_hst[5] = {0,0,0,0,0}; + +#ifdef CONCURRENT +I_ ALLOC_STK_ctr = 0; +I_ ALLOC_STK_adm = 0; +I_ ALLOC_STK_gds = 0; +I_ ALLOC_STK_slp = 0; +I_ ALLOC_STK_hst[5] = {0,0,0,0,0}; +I_ ALLOC_TSO_ctr = 0; +I_ ALLOC_TSO_adm = 0; +I_ ALLOC_TSO_gds = 0; +I_ ALLOC_TSO_slp = 0; +I_ ALLOC_TSO_hst[5] = {0,0,0,0,0}; + +# ifdef PAR +I_ ALLOC_FMBQ_ctr = 0; +I_ ALLOC_FMBQ_adm = 0; +I_ ALLOC_FMBQ_gds = 0; +I_ ALLOC_FMBQ_slp = 0; +I_ ALLOC_FMBQ_hst[5] = {0,0,0,0,0}; +I_ ALLOC_FME_ctr = 0; +I_ ALLOC_FME_adm = 0; +I_ ALLOC_FME_gds = 0; +I_ ALLOC_FME_slp = 0; +I_ ALLOC_FME_hst[5] = {0,0,0,0,0}; +I_ ALLOC_BF_ctr = 0; +I_ ALLOC_BF_adm = 0; +I_ ALLOC_BF_gds = 0; +I_ ALLOC_BF_slp = 0; +I_ ALLOC_BF_hst[5] = {0,0,0,0,0}; +# endif +#endif + +I_ ENT_VIA_NODE_ctr = 0; +I_ ENT_CON_ctr = 0; +I_ ENT_FUN_STD_ctr = 0; +I_ ENT_FUN_DIRECT_ctr = 0; +I_ ENT_IND_ctr = 0; +I_ ENT_PAP_ctr = 0; +I_ ENT_THK_ctr = 0; + +I_ RET_NEW_IN_HEAP_ctr = 0; +I_ RET_NEW_IN_REGS_ctr = 0; +I_ RET_OLD_IN_HEAP_ctr = 0; +I_ RET_OLD_IN_REGS_ctr = 0; +I_ RET_SEMI_BY_DEFAULT_ctr = 0; +I_ RET_SEMI_IN_HEAP_ctr = 0; +I_ RET_SEMI_IN_REGS_ctr = 0; +I_ RET_SEMI_FAILED_IND_ctr = 0; +I_ RET_SEMI_FAILED_UNEVAL_ctr = 0; +I_ VEC_RETURN_ctr = 0; + +I_ RET_NEW_IN_HEAP_hst[9] = {0,0,0,0,0,0,0,0,0}; +I_ RET_NEW_IN_REGS_hst[9] = {0,0,0,0,0,0,0,0,0}; +I_ RET_OLD_IN_HEAP_hst[9] = {0,0,0,0,0,0,0,0,0}; +I_ RET_OLD_IN_REGS_hst[9] = {0,0,0,0,0,0,0,0,0}; +/* no such thing: I_ RET_SEMI_BY_DEFAULT_hst[9] = {0,0,0,0,0,0,0,0,0}; */ +I_ RET_SEMI_IN_HEAP_hst[9] = {0,0,0,0,0,0,0,0,0}; +I_ RET_SEMI_IN_REGS_hst[9] = {0,0,0,0,0,0,0,0,0}; +I_ RET_VEC_RETURN_hst[9] = {0,0,0,0,0,0,0,0,0}; + +I_ RET_SEMI_loads_avoided = 0; + +I_ ReturnInRegsNodeValid = 0; /* i.e., False */ + +I_ UPDF_OMITTED_ctr = 0; +I_ UPDF_STD_PUSHED_ctr = 0; +I_ UPDF_CON_PUSHED_ctr = 0; +I_ UPDF_HOLE_PUSHED_ctr = 0; + +I_ UPDF_RCC_PUSHED_ctr = 0; +I_ UPDF_RCC_OMITTED_ctr = 0; + +I_ UPD_EXISTING_ctr = 0; +I_ UPD_SQUEEZED_ctr = 0; +I_ UPD_CON_W_NODE_ctr = 0; +I_ UPD_CON_IN_PLACE_ctr = 0; +I_ UPD_CON_IN_NEW_ctr = 0; +I_ UPD_PAP_IN_PLACE_ctr = 0; +I_ UPD_PAP_IN_NEW_ctr = 0; + +I_ UPD_CON_IN_PLACE_hst[9] = {0,0,0,0,0,0,0,0,0}; +I_ UPD_CON_IN_NEW_hst[9] = {0,0,0,0,0,0,0,0,0}; +I_ UPD_PAP_IN_NEW_hst[9] = {0,0,0,0,0,0,0,0,0}; + +I_ UPD_ENTERED_hst[9] = {0,0,0,0,0,0,0,0,0}; + +I_ UPD_NEW_IND_ctr = 0; +I_ UPD_NEW_IN_PLACE_PTRS_ctr = 0; +I_ UPD_NEW_IN_PLACE_NOPTRS_ctr = 0; +I_ UPD_OLD_IND_ctr = 0; +I_ UPD_OLD_IN_PLACE_PTRS_ctr = 0; +I_ UPD_OLD_IN_PLACE_NOPTRS_ctr = 0; + +I_ UPD_IN_PLACE_COPY_ctr = 0; + +I_ GC_SEL_ABANDONED_ctr = 0; +I_ GC_SEL_MINOR_ctr = 0; +I_ GC_SEL_MAJOR_ctr = 0; + +I_ GC_SHORT_IND_ctr = 0; +I_ GC_SHORT_CAF_ctr = 0; +I_ GC_COMMON_CHARLIKE_ctr = 0; +I_ GC_COMMON_INTLIKE_ctr = 0; +I_ GC_COMMON_INTLIKE_FAIL_ctr = 0; +I_ GC_COMMON_CONST_ctr = 0; +\end{code} + +%************************************************************************ +%* * +\subsection[Ticky-print]{Print out all the counters} +%* * +%************************************************************************ + +\begin{code} +static void printRegisteredCounterInfo (FILE *); /* fwd decl */ + +#define INTAVG(a,b) ((b == 0) ? 0.0 : ((StgDouble) (a) / (StgDouble) (b))) +#define PC(a) (100.0 * a) + +#define AVG(thing) \ + StgDouble CAT2(avg,thing) = INTAVG(CAT2(tot,thing),CAT2(ctr,thing)) + +void +PrintTickyInfo() +{ + I_ i; + I_ tot_allocs = /* total number of things allocated */ + ALLOC_FUN_ctr + ALLOC_THK_ctr + ALLOC_CON_ctr + ALLOC_TUP_ctr + +#ifdef CONCURRENT + ALLOC_STK_ctr + ALLOC_TSO_ctr + +# ifdef PAR + ALLOC_FMBQ_ctr + ALLOC_FME_ctr + ALLOC_BF_ctr + +# endif +#endif + ALLOC_BH_ctr + ALLOC_UPD_PAP_ctr + ALLOC_PRIM_ctr; + I_ tot_adm_wds = /* total number of admin words allocated */ + ALLOC_FUN_adm + ALLOC_THK_adm + ALLOC_CON_adm + ALLOC_TUP_adm + +#ifdef CONCURRENT + ALLOC_STK_adm + ALLOC_TSO_adm + +# ifdef PAR + ALLOC_FMBQ_adm + ALLOC_FME_adm + ALLOC_BF_adm + +# endif +#endif + ALLOC_BH_adm + ALLOC_UPD_PAP_adm + ALLOC_PRIM_adm; + I_ tot_gds_wds = /* total number of words of ``good stuff'' allocated */ + ALLOC_FUN_gds + ALLOC_THK_gds + ALLOC_CON_gds + ALLOC_TUP_gds + +#ifdef CONCURRENT + ALLOC_STK_gds + ALLOC_TSO_gds + +# ifdef PAR + ALLOC_FMBQ_gds + ALLOC_FME_gds + ALLOC_BF_gds + +# endif +#endif + ALLOC_BH_gds + ALLOC_UPD_PAP_gds + ALLOC_PRIM_gds; + I_ tot_slp_wds = /* total number of ``slop'' words allocated */ + ALLOC_FUN_slp + ALLOC_THK_slp + ALLOC_CON_slp + ALLOC_TUP_slp + +#ifdef CONCURRENT + ALLOC_STK_slp + ALLOC_TSO_slp + +# ifdef PAR + ALLOC_FMBQ_slp + ALLOC_FME_slp + ALLOC_BF_slp + +# endif +#endif + ALLOC_BH_slp + ALLOC_UPD_PAP_slp + ALLOC_PRIM_slp; + I_ tot_wds = /* total words */ + tot_adm_wds + tot_gds_wds + tot_slp_wds; + + I_ tot_enters = + ENT_CON_ctr + ENT_FUN_DIRECT_ctr + + ENT_IND_ctr + ENT_PAP_ctr + ENT_THK_ctr; + I_ jump_direct_enters = + tot_enters - ENT_VIA_NODE_ctr; + I_ bypass_enters = + ENT_FUN_DIRECT_ctr - + (ENT_FUN_STD_ctr - UPD_PAP_IN_PLACE_ctr - UPD_PAP_IN_NEW_ctr); + + I_ tot_returns_in_regs = + RET_NEW_IN_REGS_ctr + RET_OLD_IN_REGS_ctr + RET_SEMI_IN_REGS_ctr; + I_ tot_returns_in_heap = + RET_NEW_IN_HEAP_ctr + RET_OLD_IN_HEAP_ctr + RET_SEMI_IN_HEAP_ctr + RET_SEMI_BY_DEFAULT_ctr/*???*/; + I_ tot_returns_of_new = + RET_NEW_IN_REGS_ctr + RET_NEW_IN_HEAP_ctr; + I_ tot_returns_of_old = /* NB: NOT USED ???! 94/05 WDP */ + RET_OLD_IN_REGS_ctr + RET_OLD_IN_HEAP_ctr + + RET_SEMI_BY_DEFAULT_ctr + RET_SEMI_IN_HEAP_ctr + RET_SEMI_IN_REGS_ctr /*???*/; + + I_ tot_returns = + tot_returns_in_regs + tot_returns_in_heap; + + I_ tot_upd_frames = + UPDF_STD_PUSHED_ctr + UPDF_CON_PUSHED_ctr; /*DBH*/ + + I_ con_updates = + UPD_CON_W_NODE_ctr + UPD_CON_IN_PLACE_ctr + UPD_CON_IN_NEW_ctr; + I_ pap_updates = + UPD_PAP_IN_PLACE_ctr + UPD_PAP_IN_NEW_ctr; + I_ tot_updates = + UPD_EXISTING_ctr + UPD_SQUEEZED_ctr + con_updates + pap_updates; + I_ tot_in_place_updates = + UPD_CON_IN_PLACE_ctr + UPD_PAP_IN_PLACE_ctr; + + I_ tot_new_updates = + UPD_NEW_IN_PLACE_NOPTRS_ctr + UPD_NEW_IN_PLACE_PTRS_ctr + UPD_NEW_IND_ctr; + I_ tot_old_updates = + UPD_OLD_IN_PLACE_NOPTRS_ctr + UPD_OLD_IN_PLACE_PTRS_ctr + UPD_OLD_IND_ctr; + I_ tot_gengc_updates = + tot_new_updates + tot_old_updates; + + FILE *tf = RTSflags.TickyFlags.tickyFile; + + fprintf(tf,"\n\nALLOCATIONS: %ld (%ld words total: %ld admin, %ld goods, %ld slop)\n", + tot_allocs, tot_wds, tot_adm_wds, tot_gds_wds, tot_slp_wds); + fprintf(tf,"\t\t\t\ttotal words:\t 2 3 4 5 6+\n"); + +#define ALLOC_HISTO_MAGIC(categ) \ + (PC(INTAVG(CAT3(ALLOC_,categ,_hst)[0], CAT3(ALLOC_,categ,_ctr)))), \ + (PC(INTAVG(CAT3(ALLOC_,categ,_hst)[1], CAT3(ALLOC_,categ,_ctr)))), \ + (PC(INTAVG(CAT3(ALLOC_,categ,_hst)[2], CAT3(ALLOC_,categ,_ctr)))), \ + (PC(INTAVG(CAT3(ALLOC_,categ,_hst)[3], CAT3(ALLOC_,categ,_ctr)))), \ + (PC(INTAVG(CAT3(ALLOC_,categ,_hst)[4], CAT3(ALLOC_,categ,_ctr)))) + + fprintf(tf,"%7ld (%5.1f%%) function values", + ALLOC_FUN_ctr, + PC(INTAVG(ALLOC_FUN_ctr, tot_allocs))); + if (ALLOC_FUN_ctr != 0) + fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(FUN)); + + fprintf(tf,"\n%7ld (%5.1f%%) thunks", + ALLOC_THK_ctr, + PC(INTAVG(ALLOC_THK_ctr, tot_allocs))); + if (ALLOC_THK_ctr != 0) + fprintf(tf,"\t\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(THK)); + + fprintf(tf,"\n%7ld (%5.1f%%) data values", + ALLOC_CON_ctr, + PC(INTAVG(ALLOC_CON_ctr, tot_allocs))); + if (ALLOC_CON_ctr != 0) + fprintf(tf,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(CON)); + + fprintf(tf,"\n%7ld (%5.1f%%) big tuples", + ALLOC_TUP_ctr, + PC(INTAVG(ALLOC_TUP_ctr, tot_allocs))); + if (ALLOC_TUP_ctr != 0) + fprintf(tf,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(TUP)); + + fprintf(tf,"\n%7ld (%5.1f%%) black holes", + ALLOC_BH_ctr, + PC(INTAVG(ALLOC_BH_ctr, tot_allocs))); + if (ALLOC_BH_ctr != 0) + fprintf(tf,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(BH)); + + fprintf(tf,"\n%7ld (%5.1f%%) prim things", + ALLOC_PRIM_ctr, + PC(INTAVG(ALLOC_PRIM_ctr, tot_allocs))); + if (ALLOC_PRIM_ctr != 0) + fprintf(tf,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(PRIM)); + + fprintf(tf,"\n%7ld (%5.1f%%) partial applications", + ALLOC_UPD_PAP_ctr, + PC(INTAVG(ALLOC_UPD_PAP_ctr, tot_allocs))); + if (ALLOC_UPD_PAP_ctr != 0) + fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(UPD_PAP)); + +#ifdef CONCURRENT + fprintf(tf,"\n%7ld (%5.1f%%) stack objects", + ALLOC_STK_ctr, + PC(INTAVG(ALLOC_STK_ctr, tot_allocs))); + if (ALLOC_STK_ctr != 0) + fprintf(tf,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(STK)); + fprintf(tf,"\n%7ld (%5.1f%%) thread state objects", + ALLOC_TSO_ctr, + PC(INTAVG(ALLOC_TSO_ctr, tot_allocs))); + if (ALLOC_TSO_ctr != 0) + fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(TSO)); +# ifdef PAR + fprintf(tf,"\n%7ld (%5.1f%%) thread state objects", + ALLOC_FMBQ_ctr, + PC(INTAVG(ALLOC_FMBQ_ctr, tot_allocs))); + if (ALLOC_FMBQ_ctr != 0) + fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(FMBQ)); + fprintf(tf,"\n%7ld (%5.1f%%) thread state objects", + ALLOC_FME_ctr, + PC(INTAVG(ALLOC_FME_ctr, tot_allocs))); + if (ALLOC_FME_ctr != 0) + fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(FME)); + fprintf(tf,"\n%7ld (%5.1f%%) thread state objects", + ALLOC_BF_ctr, + PC(INTAVG(ALLOC_BF_ctr, tot_allocs))); + if (ALLOC_BF_ctr != 0) + fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(BF)); +# endif +#endif + fprintf(tf,"\n"); + + fprintf(tf,"\nTotal storage-manager allocations: %ld (%ld words)\n\t[%ld words lost to speculative heap-checks]\n", ALLOC_HEAP_ctr, ALLOC_HEAP_tot, ALLOC_HEAP_tot - tot_wds); + + fprintf(tf,"\nSTACK USAGE:\n"); /* NB: some bits are direction sensitive */ + fprintf(tf,"\tA stack slots stubbed: %ld\n", A_STK_STUB_ctr); +/* not used at all + fprintf(tf,"\tA stack slots re-used: %ld\n", A_STK_REUSE_ctr); + fprintf(tf,"\tB stack slots re-used: %ld\n", B_STK_REUSE_ctr); +*/ +#ifndef CONCURRENT + fprintf(tf,"\tA stack max. depth: %ld words\n", + (I_) (stackInfo.botA - max_SpA)); + fprintf(tf,"\tB stack max. depth: %ld words\n", + (I_) (max_SpB - stackInfo.botB)); /* And cheating, too (ToDo) */ +#endif + + fprintf(tf,"\nENTERS: %ld of which %ld (%.1f%%) direct to the entry code\n\t\t [the rest indirected via Node's info ptr]\n", + tot_enters, + jump_direct_enters, + PC(INTAVG(jump_direct_enters,tot_enters))); + fprintf(tf,"%7ld (%5.1f%%) thunks\n", + ENT_THK_ctr, + PC(INTAVG(ENT_THK_ctr,tot_enters))); + fprintf(tf,"%7ld (%5.1f%%) data values\n", + ENT_CON_ctr, + PC(INTAVG(ENT_CON_ctr,tot_enters))); + fprintf(tf,"%7ld (%5.1f%%) function values\n\t\t [of which %ld (%.1f%%) bypassed arg-satisfaction chk]\n", + ENT_FUN_DIRECT_ctr, + PC(INTAVG(ENT_FUN_DIRECT_ctr,tot_enters)), + bypass_enters, + PC(INTAVG(bypass_enters,ENT_FUN_DIRECT_ctr))); + fprintf(tf,"%7ld (%5.1f%%) partial applications\n", + ENT_PAP_ctr, + PC(INTAVG(ENT_PAP_ctr,tot_enters))); + fprintf(tf,"%7ld (%5.1f%%) indirections\n", + ENT_IND_ctr, + PC(INTAVG(ENT_IND_ctr,tot_enters))); + + fprintf(tf,"\nRETURNS: %ld\n", tot_returns); + fprintf(tf,"%7ld (%5.1f%%) in registers [the rest in the heap]\n", + tot_returns_in_regs, + PC(INTAVG(tot_returns_in_regs,tot_returns))); + fprintf(tf,"%7ld (%5.1f%%) from entering a new constructor\n\t\t [the rest from entering an existing constructor]\n", + tot_returns_of_new, + PC(INTAVG(tot_returns_of_new,tot_returns))); + fprintf(tf,"%7ld (%5.1f%%) vectored [the rest unvectored]\n", + VEC_RETURN_ctr, + PC(INTAVG(VEC_RETURN_ctr,tot_returns))); + +/* + fprintf(tf, "RET_xxx: %7ld: ", RET_xxx_ctr); + for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%", + PC(INTAVG(RET_xxx_hst[i],RET_xxx_ctr))); } + fprintf(tf, "\n"); +*/ + fprintf(tf, "\nRET_OLD_IN_REGS: %7ld: ", RET_OLD_IN_REGS_ctr); + for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%", + PC(INTAVG(RET_OLD_IN_REGS_hst[i],RET_OLD_IN_REGS_ctr))); } + fprintf(tf, "\n"); + fprintf(tf, "RET_NEW_IN_REGS: %7ld: ", RET_NEW_IN_REGS_ctr); + for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%", + PC(INTAVG(RET_NEW_IN_REGS_hst[i],RET_NEW_IN_REGS_ctr))); } + fprintf(tf, "\n"); + fprintf(tf, "RET_OLD_IN_HEAP: %7ld: ", RET_OLD_IN_HEAP_ctr); + for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%", + PC(INTAVG(RET_OLD_IN_HEAP_hst[i],RET_OLD_IN_HEAP_ctr))); } + fprintf(tf, "\n"); + fprintf(tf, "RET_NEW_IN_HEAP: %7ld: ", RET_NEW_IN_HEAP_ctr); + for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%", + PC(INTAVG(RET_NEW_IN_HEAP_hst[i],RET_NEW_IN_HEAP_ctr))); } + fprintf(tf, "\n"); + fprintf(tf, "\nRET_VEC_RETURN : %7ld: ", VEC_RETURN_ctr); + for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%", + PC(INTAVG(RET_VEC_RETURN_hst[i],VEC_RETURN_ctr))); } + fprintf(tf, "\n"); + + fprintf(tf,"\nUPDATE FRAMES: %ld (%ld omitted from thunks)\n", + tot_upd_frames, + UPDF_OMITTED_ctr); + fprintf(tf,"%7ld (%5.1f%%) standard frames\n", + UPDF_STD_PUSHED_ctr, + PC(INTAVG(UPDF_STD_PUSHED_ctr,tot_upd_frames))); + fprintf(tf,"%7ld (%5.1f%%) constructor frames\n", + UPDF_CON_PUSHED_ctr, + PC(INTAVG(UPDF_CON_PUSHED_ctr,tot_upd_frames))); + fprintf(tf,"\t\t [of which %ld (%.1f%%) were for black-holes]\n", + UPDF_HOLE_PUSHED_ctr, + PC(INTAVG(UPDF_HOLE_PUSHED_ctr,UPDF_CON_PUSHED_ctr))); /*DBH*/ + + if (UPDF_RCC_PUSHED_ctr != 0) + fprintf(tf,"%7ld restore cost centre frames (%ld omitted)\n", + UPDF_RCC_PUSHED_ctr, + UPDF_RCC_OMITTED_ctr); + + fprintf(tf,"\nUPDATES: %ld\n", tot_updates); + fprintf(tf,"%7ld (%5.1f%%) data values\n\t\t [%ld in place, %ld allocated new space, %ld with Node]\n", + con_updates, + PC(INTAVG(con_updates,tot_updates)), + UPD_CON_IN_PLACE_ctr, UPD_CON_IN_NEW_ctr, UPD_CON_W_NODE_ctr); + fprintf(tf,"%7ld (%5.1f%%) partial applications\n\t\t [%ld in place, %ld allocated new space]\n", + pap_updates, + PC(INTAVG(pap_updates,tot_updates)), + UPD_PAP_IN_PLACE_ctr, UPD_PAP_IN_NEW_ctr); + fprintf(tf,"%7ld (%5.1f%%) updates to existing heap objects (%ld by squeezing)\n", + UPD_EXISTING_ctr + UPD_SQUEEZED_ctr, + PC(INTAVG(UPD_EXISTING_ctr + UPD_SQUEEZED_ctr, tot_updates)), + UPD_SQUEEZED_ctr); + fprintf(tf,"%7ld (%5.1f%%) in-place updates copied\n", + UPD_IN_PLACE_COPY_ctr, + PC(INTAVG(UPD_IN_PLACE_COPY_ctr,tot_in_place_updates))); +#if 0 + if (UPD_ENTERED_ctr != 0) { + fprintf(tf,"%7ld (%5.1f%%) subsequently entered\n", + UPD_ENTERED_ctr, + PC(INTAVG(UPD_ENTERED_ctr,tot_updates))); + fprintf(tf,"%7ld (%5.1f%%) subsequently entered more than once\n", + UPD_ENTERED_AGAIN_ctr, + PC(INTAVG(UPD_ENTERED_AGAIN_ctr,tot_updates))); + } +#endif +/* + fprintf(tf, "UPD_xxx: %7ld: ", UPD_xxx_ctr); + for (i = 0; i < 9; i++) { fprintf(tf, "%7ld", UPD_xxx_hst[i]); } + fprintf(tf, "\n"); +*/ + fprintf(tf, "UPD_CON_IN_PLACE: %7ld: ", UPD_CON_IN_PLACE_ctr); + for (i = 0; i < 9; i++) { fprintf(tf, "%7ld", UPD_CON_IN_PLACE_hst[i]); } + fprintf(tf, "\n"); + fprintf(tf, "UPD_CON_IN_NEW: %7ld: ", UPD_CON_IN_NEW_ctr); + for (i = 0; i < 9; i++) { fprintf(tf, "%7ld", UPD_CON_IN_NEW_hst[i]); } + fprintf(tf, "\n"); + fprintf(tf, "UPD_PAP_IN_NEW: %7ld: ", UPD_PAP_IN_NEW_ctr); + for (i = 0; i < 9; i++) { fprintf(tf, "%7ld", UPD_PAP_IN_NEW_hst[i]); } + fprintf(tf, "\n"); + + if (tot_gengc_updates != 0) { + fprintf(tf,"\nNEW GEN UPDATES: %ld (%5.1f%%)\n", + tot_new_updates, + PC(INTAVG(tot_new_updates,tot_gengc_updates))); + fprintf(tf,"%7ld (%5.1f%%) indirections\n", + UPD_NEW_IND_ctr, + PC(INTAVG(UPD_NEW_IND_ctr,tot_gengc_updates))); + fprintf(tf,"%7ld (%5.1f%%) inplace with ptrs\n", + UPD_NEW_IN_PLACE_PTRS_ctr, + PC(INTAVG(UPD_NEW_IN_PLACE_PTRS_ctr,tot_gengc_updates))); + fprintf(tf,"%7ld (%5.1f%%) inplace without ptrs\n", + UPD_NEW_IN_PLACE_NOPTRS_ctr, + PC(INTAVG(UPD_NEW_IN_PLACE_NOPTRS_ctr,tot_gengc_updates))); + fprintf(tf,"\nOLD GEN UPDATES: %ld (%5.1f%%)\n", + tot_old_updates, + PC(INTAVG(tot_old_updates,tot_gengc_updates))); + fprintf(tf,"%7ld (%5.1f%%) indirections\n", + UPD_OLD_IND_ctr, + PC(INTAVG(UPD_OLD_IND_ctr,tot_gengc_updates))); + fprintf(tf,"%7ld (%5.1f%%) inplace with ptrs\n", + UPD_OLD_IN_PLACE_PTRS_ctr, + PC(INTAVG(UPD_OLD_IN_PLACE_PTRS_ctr,tot_gengc_updates))); + fprintf(tf,"%7ld (%5.1f%%) inplace without ptrs\n", + UPD_OLD_IN_PLACE_NOPTRS_ctr, + PC(INTAVG(UPD_OLD_IN_PLACE_NOPTRS_ctr,tot_gengc_updates))); + } + + printRegisteredCounterInfo(tf); + + fprintf(tf,"\n**************************************************\n"); + + /* here, we print out all the raw numbers; these are really + more useful when we want to snag them for subsequent + rdb-etc processing. WDP 95/11 + */ + +#define PR_CTR(ctr) \ + do { fprintf(tf,"%7ld " #ctr "\n", ctr); } while(0) +#define PR_HST(hst,i) \ + do { fprintf(tf,"%7ld " #hst "_" #i "\n", hst[i]); } while(0) + + PR_CTR(ALLOC_HEAP_ctr); + PR_CTR(ALLOC_HEAP_tot); + +#ifndef CONCURRENT + fprintf(tf,"%7ld HWM_SpA\n", (I_) (stackInfo.botA - max_SpA)); + fprintf(tf,"%7ld HWM_SpB\n", (I_) (max_SpB - stackInfo.botB)); +#endif + + PR_CTR(A_STK_STUB_ctr); + + PR_CTR(ALLOC_FUN_ctr); + PR_CTR(ALLOC_FUN_adm); + PR_CTR(ALLOC_FUN_gds); + PR_CTR(ALLOC_FUN_slp); + PR_HST(ALLOC_FUN_hst,0); + PR_HST(ALLOC_FUN_hst,1); + PR_HST(ALLOC_FUN_hst,2); + PR_HST(ALLOC_FUN_hst,3); + PR_HST(ALLOC_FUN_hst,4); + PR_CTR(ALLOC_THK_ctr); + PR_CTR(ALLOC_THK_adm); + PR_CTR(ALLOC_THK_gds); + PR_CTR(ALLOC_THK_slp); + PR_HST(ALLOC_THK_hst,0); + PR_HST(ALLOC_THK_hst,1); + PR_HST(ALLOC_THK_hst,2); + PR_HST(ALLOC_THK_hst,3); + PR_HST(ALLOC_THK_hst,4); + PR_CTR(ALLOC_CON_ctr); + PR_CTR(ALLOC_CON_adm); + PR_CTR(ALLOC_CON_gds); + PR_CTR(ALLOC_CON_slp); + PR_HST(ALLOC_CON_hst,0); + PR_HST(ALLOC_CON_hst,1); + PR_HST(ALLOC_CON_hst,2); + PR_HST(ALLOC_CON_hst,3); + PR_HST(ALLOC_CON_hst,4); + PR_CTR(ALLOC_TUP_ctr); + PR_CTR(ALLOC_TUP_adm); + PR_CTR(ALLOC_TUP_gds); + PR_CTR(ALLOC_TUP_slp); + PR_HST(ALLOC_TUP_hst,0); + PR_HST(ALLOC_TUP_hst,1); + PR_HST(ALLOC_TUP_hst,2); + PR_HST(ALLOC_TUP_hst,3); + PR_HST(ALLOC_TUP_hst,4); + PR_CTR(ALLOC_BH_ctr); + PR_CTR(ALLOC_BH_adm); + PR_CTR(ALLOC_BH_gds); + PR_CTR(ALLOC_BH_slp); + PR_HST(ALLOC_BH_hst,0); + PR_HST(ALLOC_BH_hst,1); + PR_HST(ALLOC_BH_hst,2); + PR_HST(ALLOC_BH_hst,3); + PR_HST(ALLOC_BH_hst,4); + PR_CTR(ALLOC_PRIM_ctr); + PR_CTR(ALLOC_PRIM_adm); + PR_CTR(ALLOC_PRIM_gds); + PR_CTR(ALLOC_PRIM_slp); + PR_HST(ALLOC_PRIM_hst,0); + PR_HST(ALLOC_PRIM_hst,1); + PR_HST(ALLOC_PRIM_hst,2); + PR_HST(ALLOC_PRIM_hst,3); + PR_HST(ALLOC_PRIM_hst,4); + PR_CTR(ALLOC_UPD_PAP_ctr); + PR_CTR(ALLOC_UPD_PAP_adm); + PR_CTR(ALLOC_UPD_PAP_gds); + PR_CTR(ALLOC_UPD_PAP_slp); + PR_HST(ALLOC_UPD_PAP_hst,0); + PR_HST(ALLOC_UPD_PAP_hst,1); + PR_HST(ALLOC_UPD_PAP_hst,2); + PR_HST(ALLOC_UPD_PAP_hst,3); + PR_HST(ALLOC_UPD_PAP_hst,4); + +#ifdef CONCURRENT + PR_CTR(ALLOC_STK_ctr); + PR_CTR(ALLOC_STK_adm); + PR_CTR(ALLOC_STK_gds); + PR_CTR(ALLOC_STK_slp); + PR_HST(ALLOC_STK_hst,0); + PR_HST(ALLOC_STK_hst,1); + PR_HST(ALLOC_STK_hst,2); + PR_HST(ALLOC_STK_hst,3); + PR_HST(ALLOC_STK_hst,4); + PR_CTR(ALLOC_TSO_ctr); + PR_CTR(ALLOC_TSO_adm); + PR_CTR(ALLOC_TSO_gds); + PR_CTR(ALLOC_TSO_slp); + PR_HST(ALLOC_TSO_hst,0); + PR_HST(ALLOC_TSO_hst,1); + PR_HST(ALLOC_TSO_hst,2); + PR_HST(ALLOC_TSO_hst,3); + PR_HST(ALLOC_TSO_hst,4); + +# ifdef PAR + PR_CTR(ALLOC_FMBQ_ctr); + PR_CTR(ALLOC_FMBQ_adm); + PR_CTR(ALLOC_FMBQ_gds); + PR_CTR(ALLOC_FMBQ_slp); + PR_HST(ALLOC_FMBQ_hst,0); + PR_HST(ALLOC_FMBQ_hst,1); + PR_HST(ALLOC_FMBQ_hst,2); + PR_HST(ALLOC_FMBQ_hst,3); + PR_HST(ALLOC_FMBQ_hst,4); + PR_CTR(ALLOC_FME_ctr); + PR_CTR(ALLOC_FME_adm); + PR_CTR(ALLOC_FME_gds); + PR_CTR(ALLOC_FME_slp); + PR_HST(ALLOC_FME_hst,0); + PR_HST(ALLOC_FME_hst,1); + PR_HST(ALLOC_FME_hst,2); + PR_HST(ALLOC_FME_hst,3); + PR_HST(ALLOC_FME_hst,4); + PR_CTR(ALLOC_BF_ctr); + PR_CTR(ALLOC_BF_adm); + PR_CTR(ALLOC_BF_gds); + PR_CTR(ALLOC_BF_slp); + PR_HST(ALLOC_BF_hst,0); + PR_HST(ALLOC_BF_hst,1); + PR_HST(ALLOC_BF_hst,2); + PR_HST(ALLOC_BF_hst,3); + PR_HST(ALLOC_BF_hst,4); +# endif +#endif + + PR_CTR(ENT_VIA_NODE_ctr); + PR_CTR(ENT_CON_ctr); + PR_CTR(ENT_FUN_STD_ctr); + PR_CTR(ENT_FUN_DIRECT_ctr); + PR_CTR(ENT_IND_ctr); + PR_CTR(ENT_PAP_ctr); + PR_CTR(ENT_THK_ctr); + + PR_CTR(RET_NEW_IN_HEAP_ctr); + PR_CTR(RET_NEW_IN_REGS_ctr); + PR_CTR(RET_OLD_IN_HEAP_ctr); + PR_CTR(RET_OLD_IN_REGS_ctr); + PR_CTR(RET_SEMI_BY_DEFAULT_ctr); + PR_CTR(RET_SEMI_IN_HEAP_ctr); + PR_CTR(RET_SEMI_IN_REGS_ctr); + PR_CTR(RET_SEMI_FAILED_IND_ctr); + PR_CTR(RET_SEMI_FAILED_UNEVAL_ctr); + PR_CTR(VEC_RETURN_ctr); + + PR_HST(RET_NEW_IN_HEAP_hst,0); + PR_HST(RET_NEW_IN_HEAP_hst,1); + PR_HST(RET_NEW_IN_HEAP_hst,2); + PR_HST(RET_NEW_IN_HEAP_hst,3); + PR_HST(RET_NEW_IN_HEAP_hst,4); + PR_HST(RET_NEW_IN_HEAP_hst,5); + PR_HST(RET_NEW_IN_HEAP_hst,6); + PR_HST(RET_NEW_IN_HEAP_hst,7); + PR_HST(RET_NEW_IN_HEAP_hst,8); + PR_HST(RET_NEW_IN_REGS_hst,0); + PR_HST(RET_NEW_IN_REGS_hst,1); + PR_HST(RET_NEW_IN_REGS_hst,2); + PR_HST(RET_NEW_IN_REGS_hst,3); + PR_HST(RET_NEW_IN_REGS_hst,4); + PR_HST(RET_NEW_IN_REGS_hst,5); + PR_HST(RET_NEW_IN_REGS_hst,6); + PR_HST(RET_NEW_IN_REGS_hst,7); + PR_HST(RET_NEW_IN_REGS_hst,8); + PR_HST(RET_OLD_IN_HEAP_hst,0); + PR_HST(RET_OLD_IN_HEAP_hst,1); + PR_HST(RET_OLD_IN_HEAP_hst,2); + PR_HST(RET_OLD_IN_HEAP_hst,3); + PR_HST(RET_OLD_IN_HEAP_hst,4); + PR_HST(RET_OLD_IN_HEAP_hst,5); + PR_HST(RET_OLD_IN_HEAP_hst,6); + PR_HST(RET_OLD_IN_HEAP_hst,7); + PR_HST(RET_OLD_IN_HEAP_hst,8); + PR_HST(RET_OLD_IN_REGS_hst,0); + PR_HST(RET_OLD_IN_REGS_hst,1); + PR_HST(RET_OLD_IN_REGS_hst,2); + PR_HST(RET_OLD_IN_REGS_hst,3); + PR_HST(RET_OLD_IN_REGS_hst,4); + PR_HST(RET_OLD_IN_REGS_hst,5); + PR_HST(RET_OLD_IN_REGS_hst,6); + PR_HST(RET_OLD_IN_REGS_hst,7); + PR_HST(RET_OLD_IN_REGS_hst,8); + PR_HST(RET_SEMI_IN_HEAP_hst,0); + PR_HST(RET_SEMI_IN_HEAP_hst,1); + PR_HST(RET_SEMI_IN_HEAP_hst,2); + PR_HST(RET_SEMI_IN_HEAP_hst,3); + PR_HST(RET_SEMI_IN_HEAP_hst,4); + PR_HST(RET_SEMI_IN_HEAP_hst,5); + PR_HST(RET_SEMI_IN_HEAP_hst,6); + PR_HST(RET_SEMI_IN_HEAP_hst,7); + PR_HST(RET_SEMI_IN_HEAP_hst,8); + PR_HST(RET_SEMI_IN_REGS_hst,0); + PR_HST(RET_SEMI_IN_REGS_hst,1); + PR_HST(RET_SEMI_IN_REGS_hst,2); + PR_HST(RET_SEMI_IN_REGS_hst,3); + PR_HST(RET_SEMI_IN_REGS_hst,4); + PR_HST(RET_SEMI_IN_REGS_hst,5); + PR_HST(RET_SEMI_IN_REGS_hst,6); + PR_HST(RET_SEMI_IN_REGS_hst,7); + PR_HST(RET_SEMI_IN_REGS_hst,8); + PR_HST(RET_VEC_RETURN_hst,0); + PR_HST(RET_VEC_RETURN_hst,1); + PR_HST(RET_VEC_RETURN_hst,2); + PR_HST(RET_VEC_RETURN_hst,3); + PR_HST(RET_VEC_RETURN_hst,4); + PR_HST(RET_VEC_RETURN_hst,5); + PR_HST(RET_VEC_RETURN_hst,6); + PR_HST(RET_VEC_RETURN_hst,7); + PR_HST(RET_VEC_RETURN_hst,8); + + PR_CTR(RET_SEMI_loads_avoided); + + PR_CTR(UPDF_OMITTED_ctr); + PR_CTR(UPDF_STD_PUSHED_ctr); + PR_CTR(UPDF_CON_PUSHED_ctr); + PR_CTR(UPDF_HOLE_PUSHED_ctr); + + PR_CTR(UPDF_RCC_PUSHED_ctr); + PR_CTR(UPDF_RCC_OMITTED_ctr); + + PR_CTR(UPD_EXISTING_ctr); + PR_CTR(UPD_SQUEEZED_ctr); + PR_CTR(UPD_CON_W_NODE_ctr); + PR_CTR(UPD_CON_IN_PLACE_ctr); + PR_CTR(UPD_CON_IN_NEW_ctr); + PR_CTR(UPD_PAP_IN_PLACE_ctr); + PR_CTR(UPD_PAP_IN_NEW_ctr); + + PR_HST(UPD_CON_IN_PLACE_hst,0); + PR_HST(UPD_CON_IN_PLACE_hst,1); + PR_HST(UPD_CON_IN_PLACE_hst,2); + PR_HST(UPD_CON_IN_PLACE_hst,3); + PR_HST(UPD_CON_IN_PLACE_hst,4); + PR_HST(UPD_CON_IN_PLACE_hst,5); + PR_HST(UPD_CON_IN_PLACE_hst,6); + PR_HST(UPD_CON_IN_PLACE_hst,7); + PR_HST(UPD_CON_IN_PLACE_hst,8); + PR_HST(UPD_CON_IN_NEW_hst,0); + PR_HST(UPD_CON_IN_NEW_hst,1); + PR_HST(UPD_CON_IN_NEW_hst,2); + PR_HST(UPD_CON_IN_NEW_hst,3); + PR_HST(UPD_CON_IN_NEW_hst,4); + PR_HST(UPD_CON_IN_NEW_hst,5); + PR_HST(UPD_CON_IN_NEW_hst,6); + PR_HST(UPD_CON_IN_NEW_hst,7); + PR_HST(UPD_CON_IN_NEW_hst,8); + PR_HST(UPD_PAP_IN_NEW_hst,0); + PR_HST(UPD_PAP_IN_NEW_hst,1); + PR_HST(UPD_PAP_IN_NEW_hst,2); + PR_HST(UPD_PAP_IN_NEW_hst,3); + PR_HST(UPD_PAP_IN_NEW_hst,4); + PR_HST(UPD_PAP_IN_NEW_hst,5); + PR_HST(UPD_PAP_IN_NEW_hst,6); + PR_HST(UPD_PAP_IN_NEW_hst,7); + PR_HST(UPD_PAP_IN_NEW_hst,8); + + PR_HST(UPD_ENTERED_hst,0); + PR_HST(UPD_ENTERED_hst,1); + PR_HST(UPD_ENTERED_hst,2); + PR_HST(UPD_ENTERED_hst,3); + PR_HST(UPD_ENTERED_hst,4); + PR_HST(UPD_ENTERED_hst,5); + PR_HST(UPD_ENTERED_hst,6); + PR_HST(UPD_ENTERED_hst,7); + PR_HST(UPD_ENTERED_hst,8); + + PR_CTR(UPD_NEW_IND_ctr); + PR_CTR(UPD_NEW_IN_PLACE_PTRS_ctr); + PR_CTR(UPD_NEW_IN_PLACE_NOPTRS_ctr); + PR_CTR(UPD_OLD_IND_ctr); + PR_CTR(UPD_OLD_IN_PLACE_PTRS_ctr); + PR_CTR(UPD_OLD_IN_PLACE_NOPTRS_ctr); + + PR_CTR(UPD_IN_PLACE_COPY_ctr); + + PR_CTR(GC_SEL_ABANDONED_ctr); + PR_CTR(GC_SEL_MINOR_ctr); + PR_CTR(GC_SEL_MAJOR_ctr); + PR_CTR(GC_SHORT_IND_ctr); + PR_CTR(GC_SHORT_CAF_ctr); + PR_CTR(GC_COMMON_CHARLIKE_ctr); + PR_CTR(GC_COMMON_INTLIKE_ctr); + PR_CTR(GC_COMMON_INTLIKE_FAIL_ctr); + PR_CTR(GC_COMMON_CONST_ctr); +} +\end{code} + +%************************************************************************ +%* * +\subsection[Ticky-ent-counters]{Handle named entry counters} +%* * +%************************************************************************ + +Data structure used in ``registering'' one of these counters. +\begin{code} +struct ent_counter *ListOfEntryCtrs = NULL; /* root of list of them */ +\end{code} + +To print out all the registered-counter info: +\begin{code} +static void +printRegisteredCounterInfo (FILE *tf) +{ + struct ent_counter *p; + + if ( ListOfEntryCtrs != NULL ) { + fprintf(tf,"\n**************************************************\n"); + } + + for (p = ListOfEntryCtrs; p != NULL; p = p->link) { + /* common stuff first; then the wrapper info if avail */ + fprintf(tf, "%-40s%u\t%u\t%u\t%-16s%ld", + p->f_str, + p->arity, + p->Astk_args, + p->Bstk_args, + p->f_arg_kinds, + p->ctr); + + if ( p->wrap_str == NULL ) { + fprintf(tf, "\n"); + + } else { + fprintf(tf, "\t%s\t%s\n", + p->wrap_str, + p->wrap_arg_kinds); + } + } +} +\end{code} + +That's all, folks. +\begin{code} +#endif /* TICKY_TICKY */ +\end{code} diff --git a/ghc/runtime/main/main.lc b/ghc/runtime/main/main.lc index 75a1bb3230..fd70cd623b 100644 --- a/ghc/runtime/main/main.lc +++ b/ghc/runtime/main/main.lc @@ -5,7 +5,7 @@ %****************************************************************/ \begin{code} -#if defined(USE_COST_CENTRES) || defined(GUM) || defined(CONCURRENT) +#if defined(PROFILING) || defined(PAR) || defined(CONCURRENT) #define NON_POSIX_SOURCE /* time things on Solaris -- sigh */ #endif @@ -18,17 +18,13 @@ # if !defined(STDC_HEADERS) && defined(HAVE_MEMORY_H) # include <memory.h> # endif /* not STDC_HEADERS and HAVE_MEMORY_H */ -# define index strchr -# define rindex strrchr -# define bcopy(s, d, n) memcpy ((d), (s), (n)) -# define bcmp(s1, s2, n) memcmp ((s1), (s2), (n)) -# define bzero(s, n) memset ((s), 0, (n)) + #else /* not STDC_HEADERS and not HAVE_STRING_H */ # include <strings.h> /* memory.h and strings.h conflict on some systems. */ #endif /* not STDC_HEADERS and not HAVE_STRING_H */ -#if defined(USE_COST_CENTRES) || defined(GUM) +#if defined(PROFILING) || defined(PAR) /* need some "time" things */ /* ToDo: This is a mess! Improve ? */ @@ -44,18 +40,17 @@ # ifdef HAVE_SYS_TIME_H # include <sys/time.h> # endif -#endif /* USE_COST_CENTRES || GUM */ +#endif /* PROFILING || PAR */ #ifndef PAR STGRegisterTable MainRegTable; #endif /* fwd decls */ -void setupRtsFlags PROTO((int *argc, char *argv[], I_ *rtsc, char *rtsv[])); void shutdownHaskell(STG_NO_ARGS); EXTFUN(startStgWorld); -extern void PrintRednCountInfo(STG_NO_ARGS); +extern void PrintTickyInfo(STG_NO_ARGS); extern void checkAStack(STG_NO_ARGS); /* a real nasty Global Variable */ @@ -66,22 +61,10 @@ P_ TopClosure = Main_mainPrimIO_closure; /* structure to carry around info about the storage manager */ smInfo StorageMgrInfo; -FILE *main_statsfile = NULL; -#if defined(DO_REDN_COUNTING) -FILE *tickyfile = NULL; -#endif -#if defined(SM_DO_BH_UPDATE) -I_ noBlackHoles = 0; -#endif -I_ doSanityChks = 0; -I_ showRednCountStats = 0; -I_ traceUpdates = 0; -extern I_ squeeze_upd_frames; - #ifdef PAR -extern I_ OkToGC, buckets, average_stats(); -extern rtsBool TraceSparks, OutputDisabled, DelaySparks, - DeferGlobalUpdates, ParallelStats; +extern I_ OkToGC, buckets; +extern rtsBool TraceSparks, DelaySparks, + DeferGlobalUpdates; extern void RunParallelSystem PROTO((P_)); extern void initParallelSystem(STG_NO_ARGS); @@ -100,11 +83,6 @@ extern void *stgAllocForGMP PROTO((size_t)); extern void *stgReallocForGMP PROTO ((void *, size_t, size_t)); extern void stgDeallocForGMP PROTO ((void *, size_t)); -#if defined (DO_SPAT_PROFILING) && sparc_TARGET_ARCH - /* NOTE: I, WDP, do not use this in my SPAT profiling */ -W_ KHHP, KHHPLIM, KHSPA, KHSPB; -#endif - /* NeXTs can't just reach out and touch "end", to use in distinguishing things in static vs dynamic (malloc'd) memory. */ @@ -112,9 +90,9 @@ W_ KHHP, KHHPLIM, KHSPA, KHSPB; void *get_end_result; #endif -I_ prog_argc; +int prog_argc; /* an "int" so as to match normal "argc" */ char **prog_argv; -I_ rts_argc; +int rts_argc; /* ditto */ char *rts_argv[MAX_RTS_ARGS]; #ifndef PAR @@ -125,14 +103,12 @@ jmp_buf restart_main; /* For restarting after a signal */ unsigned nPEs = 0, nIMUs = 0; #endif -#if defined(GUM) +#if defined(PAR) int nPEs = 0; #endif int /* return type of "main" is defined by the C standard */ -main(argc, argv) - int argc; - char *argv[]; +main(int argc, char *argv[]) { \end{code} @@ -140,9 +116,7 @@ The very first thing we do is grab the start time...just in case we're collecting timing statistics. \begin{code} - start_time(); - \end{code} The parallel system needs to be initialised and synchronised before @@ -153,19 +127,18 @@ Manager's requirements. \begin{code} #ifdef PAR /* - * Grab the number of PEs out of the argument vector, and eliminate it - * from further argument processing + * Grab the number of PEs out of the argument vector, and + * eliminate it from further argument processing. */ nPEs = atoi(argv[1]); argv[1] = argv[0]; argv++; argc--; -/* fprintf(stderr, "I'm alive, nPEs = %d \n", nPEs); */ SynchroniseSystem(); #endif -#if defined(USE_COST_CENTRES) || defined(GUM) +#if defined(PROFILING) || defined(PAR) /* setup string indicating time of run -- only used for profiling */ (void) time_str(); #endif @@ -175,12 +148,17 @@ Manager's requirements. #endif /* - divide the command-line args between pgm and RTS; - figure out what statsfile to use (if any); - [if so, write the whole cmd-line into it] + divide the command-line args between pgm and RTS; figure out + what statsfile to use (if any); [if so, write the whole + cmd-line into it] This is unlikely to work well in parallel! KH. */ + initRtsFlagsDefaults(); + defaultsHook(); /* the one supplied does nothing; + the user may have supplied a more interesting one. + */ + setupRtsFlags(&argc, argv, &rts_argc, rts_argv); prog_argc = argc; prog_argv = argv; @@ -190,15 +168,7 @@ Manager's requirements. initParallelSystem(); #endif /* PAR */ -#if defined(LIFE_PROFILE) - if (life_profile_init(rts_argv, prog_argv) != 0) { - fflush(stdout); - fprintf(stderr, "life_profile_init failed!\n"); - EXIT(EXIT_FAILURE); - } -#endif - -#if defined(USE_COST_CENTRES) || defined(GUM) +#if defined(PROFILING) || defined(PAR) if (init_cc_profiling(rts_argc, rts_argv, prog_argv) != 0) { fflush(stdout); fprintf(stderr, "init_cc_profiling failed!\n"); @@ -214,64 +184,41 @@ Manager's requirements. #endif #ifdef PAR - if (do_gr_profile) + if (RTSflags.ParFlags.granSimStats) init_gr_profiling(rts_argc, rts_argv, prog_argc, prog_argv); #endif - /* - initialize the storage manager - */ - if ( initSM(rts_argc, rts_argv, main_statsfile) != 0) { - fflush(stdout); - fprintf(stderr, "initSM failed!\n"); - EXIT(EXIT_FAILURE); - } + /* initialize the storage manager */ + initSM(); #ifndef PAR - if ( initStacks( &StorageMgrInfo ) != 0) { + if (! initStacks( &StorageMgrInfo )) { fflush(stdout); fprintf(stderr, "initStacks failed!\n"); EXIT(EXIT_FAILURE); } #endif - if ( initHeap( &StorageMgrInfo ) != 0) { + if (! initHeap( &StorageMgrInfo )) { fflush(stdout); - fprintf(stderr, "initHeap failed!\n"); EXIT(EXIT_FAILURE); + fprintf(stderr, "initHeap failed!\n"); + EXIT(EXIT_FAILURE); } #if defined(CONCURRENT) && !defined(GRAN) - if (!initThreadPools(MaxLocalSparks)) { + if (!initThreadPools()) { fflush(stdout); fprintf(stderr, "initThreadPools failed!\n"); EXIT(EXIT_FAILURE); } #endif -#if defined(USE_COST_CENTRES) || defined(GUM) +#if defined(PROFILING) || defined(PAR) /* call cost centre registering routine (after heap allocated) */ cc_register(); #endif -/* Information needed by runtime trace analysers -- don't even ask what it does! */ - /* NOTE: I, WDP, do not use this in my SPAT profiling */ -#if defined (DO_SPAT_PROFILING) && sparc_TARGET_ARCH - KHHPLIM = (W_) StorageMgrInfo.hplim; - KHHP = (W_) StorageMgrInfo.hp; - KHSPA = (W_) SAVE_SpA, - KHSPB = (W_) SAVE_SpB; - -/* fprintf(stderr,"Hp = %lx, HpLim = %lx, SpA = %lx, SpB = %lx\n",KHHP,KHHPLIM,KHSPA,KHSPB); */ - -/* NOT ME: - __asm__("sethi %%hi(_KHHP),%%o0\n\tld [%%o0+%%lo(_KHHP)],%%g0" : : : "%%o0"); - __asm__("sethi %%hi(_KHHPLIM),%%o0\n\tld [%%o0+%%lo(_KHHPLIM)],%%g0" : : : "%%o0"); - __asm__("sethi %%hi(_KHSPA),%%o0\n\tld [%%o0+%%lo(_KHSPA)],%%g0" : : : "%%o0"); - __asm__("sethi %%hi(_KHSPB),%%o0\n\tld [%%o0+%%lo(_KHSPB)],%%g0" : : : "%%o0"); -*/ -#endif - -#if defined(DO_REDN_COUNTING) +#if defined(TICKY_TICKY) max_SpA = MAIN_SpA; /* initial high-water marks */ max_SpB = MAIN_SpB; #endif @@ -282,7 +229,7 @@ Manager's requirements. /* Record initialization times */ end_init(); -#if defined(USE_COST_CENTRES) || defined(CONCURRENT) +#if defined(PROFILING) || defined(CONCURRENT) /* * Both the context-switcher and the cost-center profiler use * a virtual timer. @@ -292,24 +239,25 @@ Manager's requirements. fprintf(stderr, "Can't install VTALRM handler.\n"); EXIT(EXIT_FAILURE); } -#if (defined(CONCURRENT) && defined(USE_COST_CENTRES)) || defined(GUM) - if (time_profiling) { - if (contextSwitchTime % (1000/TICK_FREQUENCY) == 0) - tick_millisecs = TICK_MILLISECS; +#if (defined(CONCURRENT) && defined(PROFILING)) || defined(PAR) + if (! time_profiling) + RTSflags.CcFlags.msecsPerTick = RTSflags.ConcFlags.ctxtSwitchTime; + else { + if (RTSflags.ConcFlags.ctxtSwitchTime % (1000/TICK_FREQUENCY) == 0) + RTSflags.CcFlags.msecsPerTick = TICK_MILLISECS; else - tick_millisecs = CS_MIN_MILLISECS; + RTSflags.CcFlags.msecsPerTick = CS_MIN_MILLISECS; - contextSwitchTicks = contextSwitchTime / tick_millisecs; - profilerTicks = TICK_MILLISECS / tick_millisecs; - } else - tick_millisecs = contextSwitchTime; + RTSflags.CcFlags.ctxtSwitchTicks = RTSflags.ConcFlags.ctxtSwitchTime / RTSflags.CcFlags.msecsPerTick; + RTSflags.CcFlags.profilerTicks = TICK_MILLISECS / RTSflags.CcFlags.msecsPerTick; + } #endif #ifndef CONCURRENT START_TIME_PROFILER; #endif -#endif /* USE_COST_CENTRES || CONCURRENT */ +#endif /* PROFILING || CONCURRENT */ #ifndef PAR setjmp(restart_main); @@ -345,14 +293,8 @@ Manager's requirements. #else /* not threaded (sequential) */ -# if defined(__STG_TAILJUMPS__) miniInterpret((StgFunPtr)startStgWorld); -# else - if (doSanityChks) - miniInterpret_debug((StgFunPtr)startStgWorld, checkAStack); - else - miniInterpret((StgFunPtr)startStgWorld); -# endif /* not tail-jumping */ + #endif /* !CONCURRENT */ shutdownHaskell(); @@ -373,29 +315,21 @@ shutdownHaskell(STG_NO_ARGS) { STOP_TIME_PROFILER; - if (exitSM(&StorageMgrInfo) != 0) { + if (! exitSM(&StorageMgrInfo)) { fflush(stdout); fprintf(stderr, "exitSM failed!\n"); EXIT(EXIT_FAILURE); } -#if defined(LIFE_PROFILE) - { - extern P_ hp_start; /* from the SM -- Hack! */ - life_profile_finish(StorageMgrInfo.hp - hp_start, prog_argv); - } -#endif -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) heap_profile_finish(); #endif -#if defined(USE_COST_CENTRES) || defined(GUM) +#if defined(PROFILING) || defined(PAR) report_cc_profiling(1 /* final */ ); #endif -#if defined(DO_REDN_COUNTING) - if (showRednCountStats) { - PrintRednCountInfo(); - } +#if defined(TICKY_TICKY) + if (RTSflags.TickyFlags.showTickyStats) PrintTickyInfo(); #endif #if defined(GRAN_CHECK) && defined(GRAN) @@ -430,861 +364,13 @@ shutdownHaskell(STG_NO_ARGS) } \end{code} -%/**************************************************************** -%* * -%* Getting default settings for RTS parameters * -%* * -%* +RTS indicates following arguments destined for RTS * -%* -RTS indicates following arguments destined for program * -%* * -%****************************************************************/ -\begin{code} - -char *flagtext[] = { -"", -"Usage: <prog> <args> [+RTS <rtsopts> | -RTS <args>] ... --RTS <args>", -"", -" +RTS Indicates run time system options follow", -" -RTS Indicates program arguments follow", -" --RTS Indicates that ALL subsequent arguments will be given to the", -" program (including any of these RTS flags)", -"", -"The following run time system options are available:", -"", -" -? -f Prints this message and exits; the program is not executed", -"", -" -K<size> Sets the stack size (default 64k) Egs: -K32k -K512k", -" -H<size> Sets the heap size (default 4M) -H512k -H16M", -" -s<file> Summary GC statistics (default file: <program>.stat)", -" -S<file> Detailed GC statistics (with -Sstderr going to stderr)", -"", -#if defined(GCap) -" -M<n>% Sets minimum size of alloc area as % of heap (default 3%)", -" -A<size> Fixes size of alloc area, overriding any minimum (-A gives 64k)", -" -G<size> Fixes size of major generation (default is dynamic threshold)", -" -F2s Forces program compiled for Appel gc to use 2s collection", -#else -# if defined(GCgn) -" -A<size> Specifies size of alloc area (default 64k)", -" -G<size> Fixes size of major generation (default is available heap)", -" -F2s Forces program compiled for Gen gc to use 2s collection", -# else -" -M<n>% Minimum % of heap which must be available (default 3%)", -" -A<size> Fixes size of heap area allocated between GCs (-A gives 64k)", -# endif -#endif -#if defined(FORCE_GC) -" -j<size> Forces major GC at every <size> bytes allocated", -#endif /* FORCE_GC */ -#if defined(GCdu) -" -u<percent> Fixes residency threshold at which mode switches (range 0.0..0.95)", -#endif -"", -#if defined(SM_DO_BH_UPDATE) -" -N No black-holing (for use when a signal handler is present)", -#endif -" -Z Don't squeeze out update frames on stack overflow", -" -B Sound the bell at the start of each (major) garbage collection", -#if defined(USE_COST_CENTRES) || defined(GUM) -"", -" -p<sort> Produce cost centre time profile (output file <program>.prof)", -" sort: T = time (default), A = alloc, C = cost centre label", -" -P<sort> Produce serial time profile (output file <program>.time)", -" and a -p profile with detailed caf/enter/tick/alloc info", -#if defined(USE_COST_CENTRES) -"", -" -h<break-down> Heap residency profile (output file <program>.hp)", -" break-down: C = cost centre (default), M = module, G = group", -" D = closure description, Y = type description", -" T<ints>,<start> = time closure created", -" ints: no. of interval bands plotted (default 18)", -" start: seconds after which intervals start (default 0.0)", -" A subset of closures may be selected by the attached cost centre using:", -" -c{mod:lab,mod:lab...}, specific module:label cost centre(s)", -" -m{mod,mod...} all cost centres from the specified modules(s)", -" -g{grp,grp...} all cost centres from the specified group(s)", -" Selections can also be made by description, type, kind and age:", -" -d{des,des...} closures with specified closure descriptions", -" -y{typ,typ...} closures with specified type descriptions", -" -k{knd,knd...} closures of the specified kinds", -" -a<age> closures which survived <age> complete intervals", -" The selection logic used is summarised as follows:", -" ([-c] or [-m] or [-g]) and ([-d] or [-y] or [-k]) and [-a]", -" where an option is true if not specified", -#endif -"", -" -z<tbl><size> set hash table <size> for <tbl> (C, M, G, D or Y)", -"", -" -i<secs> Number of seconds in a profiling interval (default 1.0):", -" heap profile (-h) and/or serial time profile (-P) frequency", -#endif /* USE_COST_CENTRES */ -#if defined(LIFE_PROFILE) -"", -" -l<res> Produce liftime and update profile (output file <program>.life)", -" res: the age resolution in bytes allocated (default 10,000)", -#endif /* LIFE_PROFILE */ -"", -#if defined(DO_REDN_COUNTING) -" -r<file> Produce reduction profiling statistics (with -rstderr for stderr)", -"", -#endif -" -I Use debugging miniInterpret with stack and heap sanity-checking.", -" -T<level> Trace garbage collection execution (debugging)", -#ifdef CONCURRENT -"", -# ifdef PAR -" -N<n> Use <n> PVMish processors in parallel (default: 2)", -/* NB: the -N<n> is implemented by the driver!! */ -# endif -" -C<secs> Context-switch interval in seconds", -" (0 or no argument means switch as often as possible)", -" the default is .01 sec; resolution is .01 sec", -" -e<size> Size of spark pools (default 100)", -# ifdef PAR -" -q Enable activity profile (output files in ~/<program>*.gr)", -" -qb Enable binary activity profile (output file /tmp/<program>.gb)", -#else -" -q[v] Enable quasi-parallel profile (output file <program>.qp)", -# endif -" -t<num> Set maximum number of advisory threads per PE (default 32)", -" -o<num> Set stack chunk size (default 1024)", -# ifdef PAR -" -d Turn on PVM-ish debugging", -" -O Disable output for performance measurement", -# endif /* PAR */ -#endif /* CONCURRENT */ -"", -"Other RTS options may be available for programs compiled a different way.", -"The GHC User's Guide has full details.", -"", -0 -}; - -#define RTS 1 -#define PGM 0 - -#ifndef atof -extern double atof(); -/* no proto because some machines use const and some do not */ -#endif - -void -setupRtsFlags(argc, argv, rts_argc, rts_argv) -int *argc; -I_ *rts_argc; -char *argv[], *rts_argv[]; -{ - I_ error = 0; - I_ mode; - I_ arg, total_arg; - char *last_slash; - - /* Remove directory from argv[0] -- default files in current directory */ - - if ((last_slash = (char *) rindex(argv[0], '/')) != NULL) - strcpy(argv[0], last_slash+1); - - /* Split arguments (argv) into PGM (argv) and RTS (rts_argv) parts */ - /* argv[0] must be PGM argument -- leave in argv */ - - total_arg = *argc; - arg = 1; - - *argc = 1; - *rts_argc = 0; - - for (mode = PGM; arg < total_arg && strcmp("--RTS", argv[arg]) != 0; arg++) { - if (strcmp("+RTS", argv[arg]) == 0) { - mode = RTS; - } - else if (strcmp("-RTS", argv[arg]) == 0) { - mode = PGM; - } - else if (mode == RTS && *rts_argc < MAX_RTS_ARGS-1) { - rts_argv[(*rts_argc)++] = argv[arg]; - } - else if (mode == PGM) { - argv[(*argc)++] = argv[arg]; - } - else { - fflush(stdout); - fprintf(stderr, "setupRtsFlags: Too many RTS arguments (max %d)\n", - MAX_RTS_ARGS-1); - EXIT(EXIT_FAILURE); - } - } - if (arg < total_arg) { - /* arg must be --RTS; process remaining program arguments */ - while (++arg < total_arg) { - argv[(*argc)++] = argv[arg]; - } - } - argv[*argc] = (char *) 0; - rts_argv[*rts_argc] = (char *) 0; - - /* Process RTS (rts_argv) part: mainly to determine statsfile */ - - for (arg = 0; arg < *rts_argc; arg++) { - if (rts_argv[arg][0] == '-') { - switch(rts_argv[arg][1]) { - case '?': - case 'f': - error = 1; - break; - - case 'Z': /* Don't squeeze out update frames */ - squeeze_upd_frames = 0; - break; - -#if defined(SM_DO_BH_UPDATE) - case 'N': - noBlackHoles++; - break; -#endif - - case 'I': - doSanityChks++; -#if defined(__STG_TAILJUMPS__) - /* Blech -- too many errors if run in parallel -- KH */ - fprintf(stderr, "setupRtsFlags: Using Tail Jumps: Sanity checks not possible: %s\n", rts_argv[arg]); - error = 1; -#endif - break; - - case 'U': - traceUpdates++; -#if ! defined(DO_RUNTIME_TRACE_UPDATES) - fprintf(stderr, "setupRtsFlags: Update Tracing not compiled in: %s\n", rts_argv[arg]); - error = 1; -#endif - break; - - case 'r': /* Basic profiling stats */ - showRednCountStats++; -#if ! defined(DO_REDN_COUNTING) - fprintf(stderr, "setupRtsFlags: Reduction counting not compiled in: %s\n", rts_argv[arg]); - error = 1; - -#else /* ticky-ticky! */ - if (strcmp(rts_argv[arg]+2, "stderr") == 0) /* use real stderr */ - tickyfile = stderr; - else if (rts_argv[arg][2] != '\0') /* ticky file specified */ - tickyfile = fopen(rts_argv[arg]+2,"w"); - else { - char stats_filename[STATS_FILENAME_MAXLEN]; /* default <program>.ticky */ - sprintf(stats_filename, TICKY_FILENAME_FMT, argv[0]); - tickyfile = fopen(stats_filename,"w"); - } - if (tickyfile == NULL) { - fprintf(stderr, "Can't open tickyfile %s\n", - rts_argv[arg]+2); - error = 1; - } else { - /* Write argv and rtsv into start of ticky file */ - I_ count; - for(count = 0; count < *argc; count++) - fprintf(tickyfile, "%s ", argv[count]); - fprintf(tickyfile, "+RTS "); - for(count = 0; count < *rts_argc; count++) - fprintf(tickyfile, "%s ", rts_argv[count]); - fprintf(tickyfile, "\n"); - } -#endif /* ticky-ticky! */ - break; - - case 's': /* Also used by GC -- open file here */ - case 'S': -#ifdef PAR - /* Opening all those files would almost certainly fail... */ - ParallelStats = rtsTrue; - main_statsfile = stderr; /* temporary; ToDo: rm */ -#else - if (strcmp(rts_argv[arg]+2, "stderr") == 0) /* use real stderr */ - main_statsfile = stderr; - else if (rts_argv[arg][2] != '\0') /* stats file specified */ - main_statsfile = fopen(rts_argv[arg]+2,"w"); - else { - char stats_filename[STATS_FILENAME_MAXLEN]; /* default <program>.stat */ - sprintf(stats_filename, STAT_FILENAME_FMT, argv[0]); - main_statsfile = fopen(stats_filename,"w"); - } - if (main_statsfile == NULL) { - fprintf(stderr, "Can't open statsfile %s\n", rts_argv[arg]+2); - error = 1; - } else { - /* Write argv and rtsv into start of stats file */ - I_ count; - for(count = 0; count < *argc; count++) - fprintf(main_statsfile, "%s ", argv[count]); - fprintf(main_statsfile, "+RTS "); - for(count = 0; count < *rts_argc; count++) - fprintf(main_statsfile, "%s ", rts_argv[count]); - fprintf(main_statsfile, "\n"); - } -#endif - break; - - case 'P': /* detailed cost centre profiling (time/alloc) */ - case 'p': /* cost centre profiling (time/alloc) */ - case 'i': /* serial profiling -- initial timer interval */ -#if ! (defined(USE_COST_CENTRES) || defined(GUM)) - fprintf(stderr, "setupRtsFlags: Not built for cost centre profiling: %s\n", rts_argv[arg]); - error = 1; -#endif /* ! (USE_COST_CENTRES || GUM) */ - break; - case 'h': /* serial heap profile */ - case 'z': /* size of index tables */ - case 'c': /* cost centre label select */ - case 'm': /* cost centre module select */ - case 'g': /* cost centre group select */ - case 'd': /* closure descr select */ - case 'y': /* closure type select */ - case 'k': /* closure kind select */ - case 'a': /* closure age select */ -#if ! defined(USE_COST_CENTRES) - fprintf(stderr, "setupRtsFlags: Not built for cost centre profiling: %s\n", rts_argv[arg]); - error = 1; -#endif /* ! USE_COST_CENTRES */ - break; - - case 'j': /* force GC option */ -#if defined(FORCE_GC) - force_GC++; - if (rts_argv[arg][2]) { - GCInterval = decode(rts_argv[arg]+2) / sizeof(W_); - } -#else /* ! FORCE_GC */ - fprintf(stderr, "setupRtsFlags: Not built for forcing GC: %s\n", rts_argv[arg]); - error = 1; -#endif /* ! FORCE_GC */ - break; - - case 'l': /* life profile option */ -#if defined(LIFE_PROFILE) - do_life_prof++; - if (rts_argv[arg][2]) { - LifeInterval = decode(rts_argv[arg]+2) / sizeof(W_); - } -#else /* ! LIFE_PROFILE */ - fprintf(stderr, "setupRtsFlags: Not built for lifetime profiling: %s\n", rts_argv[arg]); - error = 1; -#endif /* ! LIFE_PROFILE */ - break; - - /* Flags for the threaded RTS */ - -#ifdef CONCURRENT - case 'C': /* context switch interval */ - if (rts_argv[arg][2] != '\0') { - /* Convert to milliseconds */ - contextSwitchTime = (I_) ((atof(rts_argv[arg]+2) * 1000)); - contextSwitchTime = (contextSwitchTime / CS_MIN_MILLISECS) - * CS_MIN_MILLISECS; - if (contextSwitchTime < CS_MIN_MILLISECS) - contextSwitchTime = CS_MIN_MILLISECS; - } else - contextSwitchTime = 0; - break; -#if !defined(GRAN) - case 'e': - if (rts_argv[arg][2] != '\0') { - MaxLocalSparks = strtol(rts_argv[arg]+2, (char **) NULL, 10); - if (MaxLocalSparks <= 0) { - fprintf(stderr, "setupRtsFlags: bad value for -e\n"); - error = 1; - } - } else - MaxLocalSparks = DEFAULT_MAX_LOCAL_SPARKS; - break; -#endif -#ifdef PAR - case 'q': /* activity profile option */ - if (rts_argv[arg][2] == 'b') - do_gr_binary++; - else - do_gr_profile++; - break; -#else - case 'q': /* quasi-parallel profile option */ - if (rts_argv[arg][2] == 'v') - do_qp_prof = 2; - else - do_qp_prof++; - break; -#endif - case 't': - if (rts_argv[arg][2] != '\0') { - MaxThreads = strtol(rts_argv[arg]+2, (char **) NULL, 10); - } else { - fprintf(stderr, "setupRtsFlags: missing size for -t\n"); - error = 1; - } - break; - - case 'o': - if (rts_argv[arg][2] != '\0') { - StkOChunkSize = decode(rts_argv[arg]+2); - if (StkOChunkSize < MIN_STKO_CHUNK_SIZE) - StkOChunkSize = MIN_STKO_CHUNK_SIZE; - } else { - fprintf(stderr, "setupRtsFlags: missing size for -o\n"); - error = 1; - } - break; - -# ifdef PAR - case 'O': - OutputDisabled = rtsTrue; - break; - -# else /* PAR */ - -# if !defined(GRAN) - case 'b': /* will fall through to disaster */ -# else - case 'b': - if (rts_argv[arg][2] != '\0') { - - /* Should we emulate hbcpp */ - if(strcmp((rts_argv[arg]+2),"roken")==0) { - ++DoAlwaysCreateThreads; - strcpy(rts_argv[arg]+2,"oring"); - } - - /* or a ridiculously idealised simulator */ - if(strcmp((rts_argv[arg]+2),"oring")==0) { - gran_latency = gran_fetchtime = gran_additional_latency = - gran_gunblocktime = gran_lunblocktime - = gran_threadcreatetime = gran_threadqueuetime - = gran_threadscheduletime = gran_threaddescheduletime - = gran_threadcontextswitchtime - = 0; - - gran_mpacktime = gran_munpacktime = 0; - - gran_arith_cost = gran_float_cost = gran_load_cost - = gran_store_cost = gran_branch_cost = 0; - - gran_heapalloc_cost = 1; - - /* ++DoFairSchedule; */ - ++DoStealThreadsFirst; - ++DoThreadMigration; - ++do_gr_profile; - } - - /* or a ridiculously idealised simulator */ - if(strcmp((rts_argv[arg]+2),"onzo")==0) { - gran_latency = gran_fetchtime = gran_additional_latency = - gran_gunblocktime = gran_lunblocktime - = gran_threadcreatetime = gran_threadqueuetime - = gran_threadscheduletime = gran_threaddescheduletime - = gran_threadcontextswitchtime - = 0; - - gran_mpacktime = gran_munpacktime = 0; - - /* Keep default values for these - gran_arith_cost = gran_float_cost = gran_load_cost - = gran_store_cost = gran_branch_cost = 0; - */ - - gran_heapalloc_cost = 1; - - /* ++DoFairSchedule; */ /* -b-R */ - /* ++DoStealThreadsFirst; */ /* -b-T */ - ++DoReScheduleOnFetch; /* -bZ */ - ++DoThreadMigration; /* -bM */ - ++do_gr_profile; /* -bP */ -# if defined(GRAN_CHECK) && defined(GRAN) - debug = 0x20; /* print event statistics */ -# endif - } - - /* Communication and task creation cost parameters */ - else switch(rts_argv[arg][2]) { - case 'l': - if (rts_argv[arg][3] != '\0') - { - gran_gunblocktime = gran_latency = decode(rts_argv[arg]+3); - gran_fetchtime = 2* gran_latency; - } - else - gran_latency = LATENCY; - break; - - case 'a': - if (rts_argv[arg][3] != '\0') - gran_additional_latency = decode(rts_argv[arg]+3); - else - gran_additional_latency = ADDITIONAL_LATENCY; - break; - - case 'm': - if (rts_argv[arg][3] != '\0') - gran_mpacktime = decode(rts_argv[arg]+3); - else - gran_mpacktime = MSGPACKTIME; - break; - - case 'x': - if (rts_argv[arg][3] != '\0') - gran_mtidytime = decode(rts_argv[arg]+3); - else - gran_mtidytime = 0; - break; - - case 'r': - if (rts_argv[arg][3] != '\0') - gran_munpacktime = decode(rts_argv[arg]+3); - else - gran_munpacktime = MSGUNPACKTIME; - break; - - case 'f': - if (rts_argv[arg][3] != '\0') - gran_fetchtime = decode(rts_argv[arg]+3); - else - gran_fetchtime = FETCHTIME; - break; - - case 'n': - if (rts_argv[arg][3] != '\0') - gran_gunblocktime = decode(rts_argv[arg]+3); - else - gran_gunblocktime = GLOBALUNBLOCKTIME; - break; - - case 'u': - if (rts_argv[arg][3] != '\0') - gran_lunblocktime = decode(rts_argv[arg]+3); - else - gran_lunblocktime = LOCALUNBLOCKTIME; - break; - - /* Thread-related metrics */ - case 't': - if (rts_argv[arg][3] != '\0') - gran_threadcreatetime = decode(rts_argv[arg]+3); - else - gran_threadcreatetime = THREADCREATETIME; - break; - - case 'q': - if (rts_argv[arg][3] != '\0') - gran_threadqueuetime = decode(rts_argv[arg]+3); - else - gran_threadqueuetime = THREADQUEUETIME; - break; - - case 'c': - if (rts_argv[arg][3] != '\0') - gran_threadscheduletime = decode(rts_argv[arg]+3); - else - gran_threadscheduletime = THREADSCHEDULETIME; - - gran_threadcontextswitchtime = gran_threadscheduletime - + gran_threaddescheduletime; - break; - - case 'd': - if (rts_argv[arg][3] != '\0') - gran_threaddescheduletime = decode(rts_argv[arg]+3); - else - gran_threaddescheduletime = THREADDESCHEDULETIME; - - gran_threadcontextswitchtime = gran_threadscheduletime - + gran_threaddescheduletime; - break; - - /* Instruction Cost Metrics */ - case 'A': - if (rts_argv[arg][3] != '\0') - gran_arith_cost = decode(rts_argv[arg]+3); - else - gran_arith_cost = ARITH_COST; - break; - - case 'F': - if (rts_argv[arg][3] != '\0') - gran_float_cost = decode(rts_argv[arg]+3); - else - gran_float_cost = FLOAT_COST; - break; - - case 'B': - if (rts_argv[arg][3] != '\0') - gran_branch_cost = decode(rts_argv[arg]+3); - else - gran_branch_cost = BRANCH_COST; - break; - - case 'L': - if (rts_argv[arg][3] != '\0') - gran_load_cost = decode(rts_argv[arg]+3); - else - gran_load_cost = LOAD_COST; - break; - - case 'S': - if (rts_argv[arg][3] != '\0') - gran_store_cost = decode(rts_argv[arg]+3); - else - gran_store_cost = STORE_COST; - break; - - case 'H': - if (rts_argv[arg][3] != '\0') - gran_heapalloc_cost = decode(rts_argv[arg]+3); - else - gran_heapalloc_cost = 0; - break; - - case 'y': - if (rts_argv[arg][3] != '\0') - FetchStrategy = decode(rts_argv[arg]+3); - else - FetchStrategy = 4; /* default: fetch everything */ - break; - - /* General Parameters */ - case 'p': - if (rts_argv[arg][3] != '\0') - { - max_proc = decode(rts_argv[arg]+3); - if(max_proc > MAX_PROC || max_proc < 1) - { - fprintf(stderr,"setupRtsFlags: no more than %u processors allowed\n", MAX_PROC); - error = 1; - } - } - else - max_proc = MAX_PROC; - break; - - case 'C': - ++DoAlwaysCreateThreads; - ++DoThreadMigration; - break; - - case 'G': - ++DoGUMMFetching; - break; - - case 'M': - ++DoThreadMigration; - break; - - case 'R': - ++DoFairSchedule; - break; - - case 'T': - ++DoStealThreadsFirst; - ++DoThreadMigration; - break; - - case 'Z': - ++DoReScheduleOnFetch; - break; - - case 'z': - ++SimplifiedFetch; - break; - - case 'N': - ++PreferSparksOfLocalNodes; - break; - - case 'b': - ++do_gr_binary; - break; - - case 'P': - ++do_gr_profile; - break; - - case 's': - ++do_sp_profile; - break; - - case '-': - switch(rts_argv[arg][3]) { - - case 'C': - DoAlwaysCreateThreads=0; - DoThreadMigration=0; - break; - - case 'G': - DoGUMMFetching=0; - break; - - case 'M': - DoThreadMigration=0; - break; - - case 'R': - DoFairSchedule=0; - break; - - case 'T': - DoStealThreadsFirst=0; - DoThreadMigration=0; - break; - - case 'Z': - DoReScheduleOnFetch=0; - break; - - case 'N': - PreferSparksOfLocalNodes=0; - break; - - case 'P': - do_gr_profile=0; - no_gr_profile=1; - break; - - case 's': - do_sp_profile=0; - break; - - case 'b': - do_gr_binary=0; - break; - - default: - badoption( rts_argv[arg] ); - break; - } - break; - -# if defined(GRAN_CHECK) && defined(GRAN) - case 'D': - switch(rts_argv[arg][3]) { - case 'e': /* event trace */ - fprintf(stderr,"Printing event trace.\n"); - ++event_trace; - break; - - case 'f': - fprintf(stderr,"Printing forwarding of FETCHNODES.\n"); - debug |= 0x2; /* print fwd messages */ - break; - - case 'z': - fprintf(stderr,"Check for blocked on fetch.\n"); - debug |= 0x4; /* debug non-reschedule-on-fetch */ - break; - - case 't': - fprintf(stderr,"Check for TSO asleep on fetch.\n"); - debug |= 0x10; /* debug TSO asleep for fetch */ - break; - - case 'E': - fprintf(stderr,"Printing event statistics.\n"); - debug |= 0x20; /* print event statistics */ - break; - - case 'F': - fprintf(stderr,"Prohibiting forward.\n"); - NoForward = 1; /* prohibit forwarding */ - break; - - case 'm': - fprintf(stderr,"Printing fetch misses.\n"); - PrintFetchMisses = 1; /* prohibit forwarding */ - break; - - case 'd': - fprintf(stderr,"Debug mode.\n"); - debug |= 0x40; - break; - - case 'D': - fprintf(stderr,"Severe debug mode.\n"); - debug |= 0x80; - break; - - case '\0': - debug = 1; - break; - - default: - badoption( rts_argv[arg] ); - break; - } - break; -# endif - default: - badoption( rts_argv[arg] ); - break; - } - } - do_gr_sim++; - contextSwitchTime = 0; - break; -# endif - case 'J': - case 'Q': - case 'D': - case 'R': - case 'L': - case 'O': - fprintf(stderr, "setupRtsFlags: Not built for parallel execution: %s\n", rts_argv[arg]); - error = 1; -# endif /* PAR */ -#else /* CONCURRENT */ - case 't': - fprintf(stderr, "setupRtsFlags: Not built for threaded execution: %s\n", rts_argv[arg]); - error = 1; - -#endif /* CONCURRENT */ - case 'H': /* SM options -- ignore */ - case 'A': - case 'G': - case 'F': - case 'K': - case 'M': - case 'B': - case 'T': -#ifdef GCdu - case 'u': /* set dual mode threshold */ -#endif - break; - - default: /* Unknown option ! */ - fprintf(stderr, "setupRtsFlags: Unknown RTS option: %s\n", rts_argv[arg]); - error = 1; - break; - } - } - else { - fflush(stdout); - fprintf(stderr, "setupRtsFlags: Unexpected RTS argument: %s\n", - rts_argv[arg]); - error = 1; - } - } - if (error == 1) { - char **p; - fflush(stdout); - for (p = flagtext; *p; p++) - fprintf(stderr, "%s\n", *p); - EXIT(EXIT_FAILURE); - } -} -\end{code} - Sets up and returns a string indicating the date/time of the run. Successive calls simply return the same string again. Initially called by @main.lc@ to initialise the string at the start of the run. Only used for profiling. \begin{code} -#if defined(USE_COST_CENTRES) || defined(CONCURRENT) +#if defined(PROFILING) || defined(CONCURRENT) # include <time.h> char * @@ -1307,20 +393,23 @@ time_str(STG_NO_ARGS) ToDo: Will this work under threads? \begin{code} -StgStablePtr errorHandler = -1; +StgStablePtr errorHandler = -1; /* NB: prone to magic-value-ery (WDP 95/12) */ -StgInt getErrorHandler() +StgInt +getErrorHandler(STG_NO_ARGS) { return (StgInt) errorHandler; } #ifndef PAR -void raiseError( handler ) -StgStablePtr handler; +void +raiseError( handler ) + StgStablePtr handler; { - if (handler == -1) { + if (handler == -1) { /* beautiful magic value... (WDP 95/12) */ shutdownHaskell(); + EXIT(EXIT_FAILURE); } else { TopClosure = deRefStablePointer( handler ); longjmp(restart_main,1); @@ -1331,7 +420,7 @@ StgStablePtr handler; \begin{code} StgInt catchError( newErrorHandler ) -StgStablePtr newErrorHandler; + StgStablePtr newErrorHandler; { StgStablePtr oldErrorHandler = errorHandler; errorHandler = newErrorHandler; diff --git a/ghc/runtime/prims/ByteOps.lc b/ghc/runtime/prims/ByteOps.lc index d923511897..85d949b947 100644 --- a/ghc/runtime/prims/ByteOps.lc +++ b/ghc/runtime/prims/ByteOps.lc @@ -67,9 +67,7 @@ X2BYTES(double) #define BYTES2X(ctype,htype) \ I_ \ -CAT3(bytes2,ctype,__)(in, out) \ - P_ in; \ - htype *out; \ +CAT3(bytes2,ctype,__)(P_ in, htype *out) \ { \ union { \ ctype i; \ @@ -88,9 +86,7 @@ CAT3(bytes2,ctype,__)(in, out) \ static STG_INLINE void -assign_flt(p_dest, src) - W_ p_dest[]; - StgFloat src; +assign_flt(W_ p_dest[], StgFloat src) { float_thing y; y.f = src; @@ -100,9 +96,7 @@ assign_flt(p_dest, src) static STG_INLINE void -assign_dbl(p_dest, src) - W_ p_dest[]; - StgDouble src; +assign_dbl(W_ p_dest[], StgDouble src) { double_thing y; y.d = src; @@ -112,9 +106,7 @@ assign_dbl(p_dest, src) #define BYTES2FX(ctype,htype,assign_fx) \ I_ \ -CAT3(bytes2,ctype,__)(in, out) \ - P_ in; \ - htype *out; \ +CAT3(bytes2,ctype,__)(P_ in, htype *out) \ { \ union { \ ctype i; \ diff --git a/ghc/runtime/prims/PrimArith.lc b/ghc/runtime/prims/PrimArith.lc index cb76252d9b..7683ed838c 100644 --- a/ghc/runtime/prims/PrimArith.lc +++ b/ghc/runtime/prims/PrimArith.lc @@ -54,12 +54,7 @@ See \tr{imports/StgMacros.h} for more about these things. STG_INLINE void -#ifdef __STDC__ ASSIGN_DBL(W_ p_dest[], StgDouble src) -#else -ASSIGN_DBL(p_dest, src) - W_ p_dest[]; StgDouble src; -#endif { double_thing y; y.d = src; @@ -69,12 +64,7 @@ ASSIGN_DBL(p_dest, src) STG_INLINE StgDouble -#ifdef __STDC__ PK_DBL(W_ p_src[]) -#else -PK_DBL(p_src) - W_ p_src[]; -#endif { double_thing y; y.du.dhi = p_src[0]; @@ -84,12 +74,7 @@ PK_DBL(p_src) STG_INLINE void -#ifdef __STDC__ ASSIGN_FLT(W_ p_dest[], StgFloat src) -#else -ASSIGN_FLT(p_dest, src) - W_ p_dest[]; StgFloat src; -#endif { float_thing y; y.f = src; @@ -98,12 +83,7 @@ ASSIGN_FLT(p_dest, src) STG_INLINE StgFloat -#ifdef __STDC__ PK_FLT(W_ p_src[]) -#else -PK_FLT(p_src) - W_ p_src[]; -#endif { float_thing y; y.fu = *p_src; @@ -153,12 +133,7 @@ Encoding and decoding Doubles. Code based on the HBC code \begin{code} StgDouble -#if __STDC__ __encodeDouble (MP_INT *s, I_ e) /* result = s * 2^e */ -#else -__encodeDouble (s, e) - MP_INT *s; I_ e; -#endif /* ! __STDC__ */ { StgDouble r; I_ i; @@ -182,7 +157,7 @@ __encodeDouble (s, e) r = -r; /* - temp = xmalloc(mpz_sizeinbase(s,10)+2); + temp = stgMallocBytes(mpz_sizeinbase(s,10)+2); fprintf(stderr, "__encodeDouble(%s, %ld) => %g\n", mpz_get_str(temp,10,s), e, r); */ @@ -192,12 +167,7 @@ __encodeDouble (s, e) #if ! alpha_TARGET_ARCH /* On the alpha, Stg{Floats,Doubles} are the same */ StgFloat -#if __STDC__ __encodeFloat (MP_INT *s, I_ e) /* result = s * 2^e */ -#else -__encodeFloat (s, e) - MP_INT *s; I_ e; -#endif /* ! __STDC__ */ { StgFloat r; I_ i; @@ -219,14 +189,7 @@ __encodeFloat (s, e) #endif /* alpha */ void -#if __STDC__ __decodeDouble (MP_INT *man, I_ *exp, StgDouble dbl) -#else -__decodeDouble (man, exp, dbl) - MP_INT *man; - I_ *exp; - StgDouble dbl; -#endif /* ! __STDC__ */ { #if ! IEEE_FLOATING_POINT fprintf(stderr, "__decodeDouble: non-IEEE not yet supported\n"); @@ -287,7 +250,7 @@ __decodeDouble (man, exp, dbl) } /* - temp = xmalloc(mpz_sizeinbase(man,10)+2); + temp = stgMallocBytes(mpz_sizeinbase(man,10)+2); fprintf(stderr, "__decodeDouble(%g) => %s, %ld\n", dbl, mpz_get_str(temp,10,man), *exp); */ @@ -297,14 +260,7 @@ __decodeDouble (man, exp, dbl) #if ! alpha_TARGET_ARCH /* Again, on the alpha we do not have separate "StgFloat" routines */ void -#if __STDC__ __decodeFloat (MP_INT *man, I_ *exp, StgFloat flt) -#else -__decodeFloat (man, exp, flt) - MP_INT *man; - I_ *exp; - StgFloat flt; -#endif /* ! __STDC__ */ { #if ! IEEE_FLOATING_POINT fprintf(stderr, "__decodeFloat: non-IEEE not yet supported\n"); @@ -414,22 +370,15 @@ stgAllocForGMP (size_in_bytes) */ SAVE_Hp += total_size_in_words; -#if ! defined(DO_SPAT_PROFILING) - /* Note: ActivityReg is not defined in this .lc file */ - ALLOC_HEAP(total_size_in_words); /* ticky-ticky profiling */ /* ALLOC_CON(DATA_HS,data_size_in_words,0); */ ALLOC_PRIM(DATA_HS,data_size_in_words,0,total_size_in_words); -#endif /* ! DO_SPAT_PROFILING */ + CC_ALLOC(CCC,total_size_in_words,CON_K); /* cc profiling */ /* NB: HACK WARNING: The above line will do The WRONG THING if the CurrCostCentre reg is ever put in a Real Machine Register (TM). */ -#if defined(LIFE_PROFILE) /* HACK warning -- Bump HpLim (see also StgMacros.lh)*/ - SAVE_HpLim += 1; /* SET_DATA_HDR attempted HpLim++ in wrong window */ -#endif - /* and return what we said we would */ return(stuff_ptr); } diff --git a/ghc/runtime/profiling/CostCentre.lc b/ghc/runtime/profiling/CostCentre.lc index c7fe06af0a..01a801d695 100644 --- a/ghc/runtime/profiling/CostCentre.lc +++ b/ghc/runtime/profiling/CostCentre.lc @@ -4,15 +4,15 @@ #include "rtsdefs.h" \end{code} -Only have cost centres if @USE_COST_CENTRES@ defined (by the driver), -or if running CONCURRENT. +Only have cost centres if @PROFILING@ defined (by the driver), +or if running PAR. \begin{code} -#if defined(USE_COST_CENTRES) || defined(CONCURRENT) +#if defined(PROFILING) || defined(PAR) CC_DECLARE(CC_MAIN, "MAIN", "MAIN", "MAIN", CC_IS_BORING,/*not static*/); CC_DECLARE(CC_GC, "GC", "GC", "GC", CC_IS_BORING,/*not static*/); -# ifdef GUM +# ifdef PAR CC_DECLARE(CC_MSG, "MSG", "MSG", "MSG", CC_IS_BORING,/*not static*/); CC_DECLARE(CC_IDLE, "IDLE", "IDLE", "IDLE", CC_IS_BORING,/*not static*/); # endif @@ -25,23 +25,23 @@ would try to increment some @sub_scc_count@ of the @CCC@ (nothing!). \begin{code} CostCentre CCC; /* _not_ initialised */ -#endif /* defined(USE_COST_CENTRES) || defined(CONCURRENT) */ +#endif /* defined(PROFILING) || defined(PAR) */ \end{code} The rest is for real cost centres (not thread activities). \begin{code} -#if defined(USE_COST_CENTRES) || defined(GUM) +#if defined(PROFILING) || defined(PAR) \end{code} %************************************************************************ %* * -\subsection[initial-cost-centres]{Initial Cost Centres} +\subsection{Initial Cost Centres} %* * %************************************************************************ Cost centres which are always required: \begin{code} -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) CC_DECLARE(CC_OVERHEAD, "OVERHEAD_of", "PROFILING", "MAIN", CC_IS_CAF,/*not static*/); CC_DECLARE(CC_SUBSUMED, "SUBSUMED", "MAIN", "MAIN", CC_IS_SUBSUMED,/*not static*/); @@ -54,18 +54,14 @@ The list of registered cost centres, initially empty: CostCentre Registered_CC = REGISTERED_END; \end{code} + %************************************************************************ %* * -\subsection[profiling-arguments]{Profiling RTS Arguments} +\subsection{Profiling RTS Arguments} %* * %************************************************************************ \begin{code} -I_ cc_profiling = 0; /* 0 => not "cc_profiling" - >1 => do serial time profile - (other magic meanings, too, apparently) WDP 94/07 - */ -char cc_profiling_sort = SORTCC_TIME; I_ dump_intervals = 0; /* And for the report ... */ @@ -82,202 +78,47 @@ init_cc_profiling(rts_argc, rts_argv, prog_argv) I_ rts_argc; char *rts_argv[], *prog_argv[]; { - I_ arg, ch, error = 0; - I_ prof_req = 0; + I_ arg, ch; +#ifndef PAR char *select_cc = 0; char *select_mod = 0; char *select_grp = 0; char *select_descr = 0; char *select_type = 0; char *select_kind = 0; - I_ select_age = 0; char *left, *right; +#endif prog_argv_save = prog_argv; rts_argv_save = rts_argv; -#ifdef GUM +#ifdef PAR sprintf(prof_filename, PROF_FILENAME_FMT_GUM, prog_argv[0], thisPE); #else sprintf(prof_filename, PROF_FILENAME_FMT, prog_argv[0]); #endif - for (arg = 0; arg < rts_argc; arg++) { - if (rts_argv[arg][0] == '-') { - switch (rts_argv[arg][1]) { - case 'P': /* detailed cost centre profiling (time/alloc) */ - cc_profiling++; - case 'p': /* cost centre profiling (time/alloc) */ - cc_profiling++; - for (ch = 2; rts_argv[arg][ch]; ch++) { - switch (rts_argv[arg][2]) { - case SORTCC_LABEL: - case SORTCC_TIME: - case SORTCC_ALLOC: - cc_profiling_sort = rts_argv[arg][ch]; - break; - default: - fprintf(stderr, "Invalid profiling sort option %s\n", rts_argv[arg]); - error = 1; - }} - break; - -#if defined(USE_COST_CENTRES) - case 'h': /* serial heap profile */ - switch (rts_argv[arg][2]) { - case '\0': - case CCchar: - prof_req = HEAP_BY_CC; - break; - case MODchar: - prof_req = HEAP_BY_MOD; - break; - case GRPchar: - prof_req = HEAP_BY_GRP; - break; - case DESCRchar: - prof_req = HEAP_BY_DESCR; - break; - case TYPEchar: - prof_req = HEAP_BY_TYPE; - break; - case TIMEchar: - prof_req = HEAP_BY_TIME; - if (rts_argv[arg][3]) { - char *start_str = strchr(rts_argv[arg]+3, ','); - I_ intervals; - if (start_str) *start_str = '\0'; - - if ((intervals = decode(rts_argv[arg]+3)) != 0) { - time_intervals = (hash_t) intervals; - /* ToDo: and what if it *is* zero intervals??? */ - } - if (start_str) { - earlier_ticks = (I_)((atof(start_str + 1) * TICK_FREQUENCY)); - } - } - break; - default: - fprintf(stderr, "Invalid heap profile option: %s\n", - rts_argv[arg]); - error = 1; - } - break; - - case 'z': /* size of index tables */ - switch (rts_argv[arg][2]) { - case CCchar: - max_cc_no = (hash_t) decode(rts_argv[arg]+3); - if (max_cc_no == 0) { - fprintf(stderr, "Bad number of cost centres %s\n", rts_argv[arg]); - error = 1; - } - break; - case MODchar: - max_mod_no = (hash_t) decode(rts_argv[arg]+3); - if (max_mod_no == 0) { - fprintf(stderr, "Bad number of modules %s\n", rts_argv[arg]); - error = 1; - } - break; - case GRPchar: - max_grp_no = (hash_t) decode(rts_argv[arg]+3); - if (max_grp_no == 0) { - fprintf(stderr, "Bad number of groups %s\n", rts_argv[arg]); - error = 1; - } - break; - case DESCRchar: - max_descr_no = (hash_t) decode(rts_argv[arg]+3); - if (max_descr_no == 0) { - fprintf(stderr, "Bad number of closure descriptions %s\n", rts_argv[arg]); - error = 1; - } - break; - case TYPEchar: - max_type_no = (hash_t) decode(rts_argv[arg]+3); - if (max_type_no == 0) { - fprintf(stderr, "Bad number of type descriptions %s\n", rts_argv[arg]); - error = 1; - } - break; - default: - fprintf(stderr, "Invalid index table size option: %s\n", - rts_argv[arg]); - error = 1; - } - break; - - case 'c': /* cost centre label select */ - case 'm': /* cost centre module select */ - case 'g': /* cost centre group select */ - case 'd': /* closure descr select */ - case 'y': /* closure type select */ - case 'k': /* closure kind select */ - left = strchr(rts_argv[arg], '{'); - right = strrchr(rts_argv[arg], '}'); - if (! left || ! right || - strrchr(rts_argv[arg], '{') != left || - strchr(rts_argv[arg], '}') != right) { - fprintf(stderr, "Invalid heap profiling selection bracketing\n %s\n", rts_argv[arg]); - error = 1; - } else { - *right = '\0'; - switch (rts_argv[arg][1]) { - case 'c': /* cost centre label select */ - select_cc = left + 1; - break; - case 'm': /* cost centre module select */ - select_mod = left + 1; - break; - case 'g': /* cost centre group select */ - select_grp = left + 1; - break; - case 'd': /* closure descr select */ - select_descr = left + 1; - break; - case 't': /* closure type select */ - select_type = left + 1; - break; - case 'k': /* closure kind select */ - select_kind = left + 1; - break; - } - } - break; - - case 'a': /* closure age select */ - select_age = decode(rts_argv[arg]+2); - -#endif /* defined(USE_COST_CENTRES) */ - - case 'i': /* serial profiling -- initial timer interval */ - interval_ticks = (I_) ((atof(rts_argv[arg]+2) * TICK_FREQUENCY)); - if (interval_ticks <= 0) - interval_ticks = 1; - break; - } - } - } - if (error) return 1; - /* Now perform any work to initialise profiling ... */ - if (cc_profiling || prof_req != HEAP_NO_PROFILING) { + if (RTSflags.CcFlags.doCostCentres +#ifdef PROFILING + || RTSflags.ProfFlags.doHeapProfile +#endif + ) { time_profiling++; /* set dump_intervals: if heap profiling only dump every 10 intervals */ - if (prof_req == HEAP_NO_PROFILING) { - dump_intervals = 1; - } else { - dump_intervals = 10; - } +#ifdef PROFILING + dump_intervals = (RTSflags.ProfFlags.doHeapProfile) ? 10 : 1; +#else + dump_intervals = 1; +#endif - if (cc_profiling > 1) { + if (RTSflags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) { /* produce serial time profile */ -#ifdef GUM +#ifdef PAR sprintf(serial_filename, TIME_FILENAME_FMT_GUM, prog_argv[0], thisPE); #else sprintf(serial_filename, TIME_FILENAME_FMT, prog_argv[0]); @@ -296,7 +137,11 @@ init_cc_profiling(rts_argc, rts_argv, prog_argv) fprintf(serial_file, "DATE \"%s\"\n", time_str()); fprintf(serial_file, "SAMPLE_UNIT \"seconds\"\n"); +#ifdef PAR + fprintf(serial_file, "VALUE_UNIT \"percentage time\"\n"); +#else fprintf(serial_file, "VALUE_UNIT \"time ticks\"\n"); +#endif /* output initial 0 sample */ fprintf(serial_file, "BEGIN_SAMPLE 0.00\n"); @@ -304,10 +149,10 @@ init_cc_profiling(rts_argc, rts_argv, prog_argv) } } -#if defined(USE_COST_CENTRES) - if (heap_profile_init(prof_req, select_cc, select_mod, select_grp, - select_descr, select_type, select_kind, - select_age, prog_argv)) +#if defined(PROFILING) + if (heap_profile_init(select_cc, select_mod, select_grp, + select_descr, select_type, select_kind, + prog_argv)) return 1; #endif @@ -321,7 +166,6 @@ the area to hold the stack of modules still to register. \begin{code} extern P_ heap_space; /* pointer to the heap space */ StgFunPtr * register_stack; /* stack of register routines -- heap area used */ -extern I_ heap_profiling_req; EXTFUN(startCcRegisteringWorld); @@ -331,12 +175,12 @@ cc_register() REGISTER_CC(CC_MAIN); /* register cost centre CC_MAIN */ REGISTER_CC(CC_GC); /* register cost centre CC_GC */ -#if defined(GUM) +#if defined(PAR) REGISTER_CC(CC_MSG); /* register cost centre CC_MSG */ REGISTER_CC(CC_IDLE); /* register cost centre CC_MSG */ #endif -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) REGISTER_CC(CC_OVERHEAD); /* register cost centre CC_OVERHEAD */ REGISTER_CC(CC_DONTZuCARE); /* register cost centre CC_DONT_CARE Right??? ToDo */ #endif @@ -345,9 +189,9 @@ cc_register() CCC = (CostCentre)STATIC_CC_REF(CC_MAIN); CCC->scc_count++; -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) /* always register -- if we do not, we get warnings (WDP 94/12) */ -/* if (cc_profiling || heap_profiling_req != HEAP_NO_PROFILING) */ +/* if (RTSflags.CcFlags.doCostCentres || RTSflags.ProfFlags.doHeapProfile) */ register_stack = (StgFunPtr *) heap_space; miniInterpret((StgFunPtr) startCcRegisteringWorld); @@ -357,25 +201,48 @@ cc_register() %************************************************************************ %* * -\subsection[cost-centre-profiling]{Cost Centre Profiling Report} +\subsection{Cost Centre Profiling Report} %* * %************************************************************************ \begin{code} - static I_ dump_interval = 0; +rtsBool +cc_to_ignore (CostCentre cc) + /* return rtsTrue if it is one of the ones that + should not be reported normally (because it confuses + the users) + */ +{ +# if !defined(PROFILING) + /* in parallel land, everything is interesting (not ignorable) */ + return rtsFalse; + +# else + if ( cc == CC_OVERHEAD || cc == CC_DONTZuCARE || cc == CC_GC ) { + return rtsTrue; + } else { + return rtsFalse; + } +# endif /* PROFILING */ +} + void report_cc_profiling(final) -I_ final; + I_ final; { FILE *prof_file; CostCentre cc; I_ count; - char temp[32]; - W_ total_ticks = 0, total_alloc = 0, total_allocs = 0; + char temp[128]; /* sigh: magic constant */ + W_ total_ticks = 0, total_alloc = 0, total_allocs = 0; + W_ ignored_ticks = 0, ignored_alloc = 0, ignored_allocs = 0; +#ifdef PAR + I_ final_ticks = 0; /*No. ticks in last sample*/ +#endif - if (!cc_profiling) + if (!RTSflags.CcFlags.doCostCentres) return; blockVtAlrmSignal(); @@ -384,24 +251,41 @@ I_ final; StgFloat seconds = (previous_ticks + current_ticks) / (StgFloat) TICK_FREQUENCY; if (final) { - /* ignore partial sample at end of execution */ + fprintf(serial_file, "BEGIN_SAMPLE %0.2f\n", seconds); +#ifdef PAR + /*In the parallel world we're particularly interested in the last sample*/ + for (cc = Registered_CC; cc != REGISTERED_END; cc = cc->registered) { + if (! cc_to_ignore(cc)) + final_ticks += cc->time_ticks; + } - /* output final 0 sample */ - fprintf(serial_file, "BEGIN_SAMPLE %0.2f\n", seconds); + for (cc = Registered_CC; cc != REGISTERED_END; cc = cc->registered) { + if (cc->time_ticks != 0 && ! cc_to_ignore(cc)) + fprintf(serial_file, " %0.11s:%0.16s %3ld\n", + cc->module, cc->label, cc->time_ticks*100 / final_ticks); + } +#endif + /* In the sequential world, ignore partial sample at end of execution */ fprintf(serial_file, "END_SAMPLE %0.2f\n", seconds); fclose(serial_file); serial_file = NULL; } else { - /* output serail profile sample */ + /* output serial profile sample */ fprintf(serial_file, "BEGIN_SAMPLE %0.2f\n", seconds); for (cc = Registered_CC; cc != REGISTERED_END; cc = cc->registered) { ASSERT_IS_REGISTERED(cc, 0); - if (cc->time_ticks) { + if (cc->time_ticks != 0 && !cc_to_ignore(cc)) { +#ifdef PAR + /* Print _percentages_ in the parallel world */ + fprintf(serial_file, " %0.11s:%0.16s %3ld\n", + cc->module, cc->label, cc->time_ticks * 100/TICK_FREQUENCY); +#else fprintf(serial_file, " %0.11s:%0.16s %3ld\n", cc->module, cc->label, cc->time_ticks); +#endif } } @@ -415,13 +299,19 @@ I_ final; cc->prev_ticks += cc->time_ticks; cc->time_ticks = 0; - total_ticks += cc->prev_ticks; - total_alloc += cc->mem_alloc; - total_allocs += cc->mem_allocs; + if ( cc_to_ignore(cc) ) { /* reporting these just confuses users... */ + ignored_ticks += cc->prev_ticks; + ignored_alloc += cc->mem_alloc; + ignored_allocs += cc->mem_allocs; + } else { + total_ticks += cc->prev_ticks; + total_alloc += cc->mem_alloc; + total_allocs += cc->mem_allocs; + } } - if (total_ticks != current_ticks + previous_ticks) - fprintf(stderr, "Warning: Cost Centre tick inconsistency: total=%ld, current=%ld, previous=%ld\n", total_ticks, current_ticks, previous_ticks); + if (total_ticks + ignored_ticks != current_ticks + previous_ticks) + fprintf(stderr, "Warning: Cost Centre tick inconsistency: total=%ld, ignored=%ld, current=%ld, previous=%ld\n", total_ticks, ignored_ticks, current_ticks, previous_ticks); unblockVtAlrmSignal(); @@ -433,7 +323,7 @@ I_ final; dump_interval = 0; /* sort cost centres */ - cc_sort(&Registered_CC, cc_profiling_sort); + cc_sort(&Registered_CC, RTSflags.CcFlags.sortBy); /* open profiling output file */ if ((prof_file = fopen(prof_filename, "w")) == NULL) { @@ -466,7 +356,7 @@ I_ final; */ fprintf(prof_file, " %5s %5s %6s %6s", "scc", "subcc", "%time", "%alloc"); - if (cc_profiling > 1) + if (RTSflags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) fprintf(prof_file, " %11s %13s %8s %8s %8s (%5s %8s)", "cafcc", "thunks", "funcs", "PAPs", "closures", "ticks", "bytes"); fprintf(prof_file, "\n\n"); @@ -475,13 +365,15 @@ I_ final; /* Only print cost centres with non 0 data ! */ - if (cc->scc_count || cc->sub_scc_count || cc->prev_ticks || cc->mem_alloc - || (cc_profiling > 1 - && (cc->thunk_count || cc->function_count || cc->pap_count - || cc->cafcc_count || cc->sub_cafcc_count)) - || (cc_profiling > 2 - /* print all cost centres if -P -P */ ) - ) { + if ( (RTSflags.CcFlags.doCostCentres >= COST_CENTRES_ALL + /* force printing of *all* cost centres if -P -P */ ) + + || ( ! cc_to_ignore(cc) + && (cc->scc_count || cc->sub_scc_count || cc->prev_ticks || cc->mem_alloc + || (RTSflags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE + && (cc->thunk_count || cc->function_count || cc->pap_count + || cc->cafcc_count || cc->sub_cafcc_count)))) + ) { fprintf(prof_file, "%-16.16s %-11.11s", cc->label, cc->module); /* ToDo:group @@ -492,7 +384,7 @@ I_ final; total_ticks == 0 ? 0.0 : (cc->prev_ticks / (StgFloat) total_ticks * 100), total_alloc == 0 ? 0.0 : (cc->mem_alloc / (StgFloat) total_alloc * 100)); - if (cc_profiling > 1) + if (RTSflags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) fprintf(prof_file, " %8ld %-8ld %8ld %8ld %8ld %8ld (%5ld %8ld)", cc->cafcc_count, cc->sub_cafcc_count, cc->thunk_count, cc->function_count, cc->pap_count, @@ -509,7 +401,7 @@ I_ final; %************************************************************************ %* * -\subsection[profiling-misc]{Miscellanious Profiling Routines} +\subsection{Miscellaneous profiling routines} %* * %************************************************************************ @@ -519,8 +411,7 @@ insertion sort. First we need the different comparison routines. \begin{code} static I_ -cc_lt_label(cc1, cc2) - CostCentre cc1, cc2; +cc_lt_label(CostCentre cc1, CostCentre cc2) { I_ cmp; @@ -542,8 +433,7 @@ cc_lt_label(cc1, cc2) } static I_ -cc_gt_time(cc1, cc2) - CostCentre cc1, cc2; +cc_gt_time(CostCentre cc1, CostCentre cc2) { /* ToDo: normal then caf then dict (instead of scc at top) */ @@ -571,8 +461,7 @@ cc_gt_time(cc1, cc2) } static I_ -cc_gt_alloc(cc1, cc2) - CostCentre cc1, cc2; +cc_gt_alloc(CostCentre cc1, CostCentre cc2) { /* ToDo: normal then caf then dict (instead of scc at top) */ @@ -599,15 +488,8 @@ cc_gt_alloc(cc1, cc2) return (cc_lt_label(cc1, cc2)); /* all data equal: cmp labels */ } -#ifdef __STDC__ void cc_sort(CostCentre *sort, char sort_on) -#else -void -cc_sort(sort, sort_on) - CostCentre *sort; - char sort_on; -#endif { I_ (*cc_lt)(); CostCentre sorted, insert, *search, insert_rest; @@ -649,5 +531,5 @@ cc_sort(sort, sort_on) \end{code} \begin{code} -#endif /* USE_COST_CENTRES || GUM */ +#endif /* PROFILING || PAR */ \end{code} diff --git a/ghc/runtime/profiling/HeapProfile.lc b/ghc/runtime/profiling/HeapProfile.lc index 67c81cb664..514e8157c0 100644 --- a/ghc/runtime/profiling/HeapProfile.lc +++ b/ghc/runtime/profiling/HeapProfile.lc @@ -1,4 +1,4 @@ -Only have cost centres etc if @USE_COST_CENTRES@ defined +Only have cost centres etc if @PROFILING@ defined \begin{code} /* @@ -13,9 +13,9 @@ Only have cost centres etc if @USE_COST_CENTRES@ defined */ #define NULL_REG_MAP -#include "../storage/SMinternal.h" /* for xmalloc */ +#include "../storage/SMinternal.h" /* for ???? */ -#if defined (USE_COST_CENTRES) +#if defined (PROFILING) \end{code} %************************************************************************ @@ -50,13 +50,9 @@ etc words are disregarded. The profiling itself is considered an idealised process which should not affect the statistics gathered. \begin{code} - #define MAX_SELECT 10 -I_ heap_profiling_req - = HEAP_NO_PROFILING; /* type of heap profiling */ - -static char heap_profiling_char[] /* indexed by heap_profiling_req */ +static char heap_profiling_char[] /* indexed by RTSflags.ProfFlags.doHeapProfile */ = {'?', CCchar, MODchar, GRPchar, DESCRchar, TYPEchar, TIMEchar}; static I_ cc_select = 0; /* are we selecting on Cost Centre */ @@ -79,10 +75,7 @@ static I_ kind_select_no = 0; static I_ kind_selected[] = {0, 0, 0, 0, 0, 0}; static char *kind_select_strs[] = {"","CON","FN","PAP","THK","BH",0}; -static I_ age_select = 0; /* select ages greater than this */ - /* 0 indicates survived to the end of alloced interval */ - -I_ *resid = 0; /* residencies indexed by hashed feature */ +I_ *resid = 0; /* residencies indexed by hashed feature */ /* For production times we have a resid table of time_intervals */ /* And a seperate resid counter stuff produced earlier & later */ @@ -96,7 +89,8 @@ hash_t time_intervals = 18; /* No of time_intervals, also earlier & later */ static hash_t earlier_intervals; /* No of earlier intervals grouped together + 1*/ -hash_t dummy_index_time() +hash_t +dummy_index_time(STG_NO_ARGS) { return time_intervals; } @@ -114,27 +108,22 @@ hash_t (* init_index_fns[])() = { static char heap_filename[STATS_FILENAME_MAXLEN]; /* heap log file name = <program>.hp */ static FILE *heap_file = NULL; -extern I_ SM_force_gc; /* Set here if we force 2-space GC */ - I_ -heap_profile_init(prof, cc_select_str, mod_select_str, grp_select_str, +heap_profile_init(cc_select_str, mod_select_str, grp_select_str, descr_select_str, type_select_str, kind_select_str, - select_age, argv) - I_ prof; + argv) char *cc_select_str; char *mod_select_str; char *grp_select_str; char *descr_select_str; char *type_select_str; char *kind_select_str; - I_ select_age; char *argv[]; { hash_t count, max, first; + W_ heap_prof_style; - heap_profiling_req = prof; - - if (heap_profiling_req == HEAP_NO_PROFILING) + if (! RTSflags.ProfFlags.doHeapProfile) return 0; /* for now, if using a generational collector and trying @@ -142,15 +131,10 @@ heap_profile_init(prof, cc_select_str, mod_select_str, grp_select_str, WDP 94/07 */ #if defined(GCap) || defined(GCgn) - SM_force_gc = USE_2s; + RTSflags.GcFlags.force2s = rtsTrue; #endif -#if ! defined(HEAP_PROF_WITH_AGE) - if (heap_profiling_req == HEAP_BY_TIME || select_age) { - fprintf(stderr, "heap_profile_init: Heap Profiling not built with AGE field in closures\n"); - return 1; - } -#endif /* ! HEAP_PROF_WITH_AGE */ + heap_prof_style = RTSflags.ProfFlags.doHeapProfile; /* process select strings -- will break them into bits */ @@ -276,8 +260,6 @@ heap_profile_init(prof, cc_select_str, mod_select_str, grp_select_str, } clcat_select |= kind_select_no > 0; } - age_select = select_age; - /* open heap profiling log file */ @@ -290,8 +272,8 @@ heap_profile_init(prof, cc_select_str, mod_select_str, grp_select_str, /* write start of log file */ fprintf(heap_file, "JOB \"%s", argv[0]); - fprintf(heap_file, " +RTS -h%c", heap_profiling_char[heap_profiling_req]); - if (heap_profiling_req == HEAP_BY_TIME) { + fprintf(heap_file, " +RTS -h%c", heap_profiling_char[heap_prof_style]); + if (heap_prof_style == HEAP_BY_TIME) { fprintf(heap_file, "%ld", time_intervals); if (earlier_ticks) { fprintf(heap_file, ",%3.1f", @@ -342,9 +324,7 @@ heap_profile_init(prof, cc_select_str, mod_select_str, grp_select_str, } fprintf(heap_file, "}"); } - if (select_age) { - fprintf(heap_file, " -a%ld", age_select); - } + fprintf(heap_file, " -i%4.2f -RTS", interval_ticks/(StgFloat)TICK_FREQUENCY); for(count = 1; argv[count]; count++) fprintf(heap_file, " %s", argv[count]); @@ -362,9 +342,11 @@ heap_profile_init(prof, cc_select_str, mod_select_str, grp_select_str, /* initialise required heap profiling data structures & hashing */ earlier_intervals = (earlier_ticks / interval_ticks) + 1; - max = (* init_index_fns[heap_profiling_req])(); - resid = (I_ *) xmalloc(max * sizeof(I_)); - for (count = 0; count < max; count++) resid[count] = 0; + max = (* init_index_fns[heap_prof_style])(); + resid = (I_ *) stgMallocBytes(max * sizeof(I_), "heap_profile_init"); + + for (count = 0; count < max; count++) + resid[count] = 0; return 0; } @@ -385,7 +367,7 @@ Age selection is done for every closure -- not memoised. \begin{code} void -set_selected_ccs() /* set selection before we profile heap */ +set_selected_ccs(STG_NO_ARGS) /* set selection before we profile heap */ { I_ x; CostCentre cc; @@ -408,8 +390,7 @@ set_selected_ccs() /* set selection before we profile heap */ I_ -selected_clcat(clcat) - ClCategory clcat; +selected_clcat(ClCategory clcat) { I_ x; @@ -438,20 +419,16 @@ resident space counter by the size of the closure (less any profiling words). \begin{code} -#define NON_PROF_HS (FIXED_HS - PROF_FIXED_HDR - AGE_FIXED_HDR) +#define NON_PROF_HS (FIXED_HS - PROF_FIXED_HDR - TICKY_FIXED_HDR) void -profile_closure_none(closure,size) - P_ closure; - I_ size; +profile_closure_none(P_ closure, I_ size) { return; } void -profile_closure_cc(closure,size) - P_ closure; - I_ size; +profile_closure_cc(P_ closure, I_ size) { CostCentre cc = (CostCentre) CC_HDR(closure); resid[index_cc(cc)] += size + NON_PROF_HS; @@ -459,9 +436,7 @@ profile_closure_cc(closure,size) } void -profile_closure_cc_select(closure,size) - P_ closure; - I_ size; +profile_closure_cc_select(P_ closure, I_ size) { CostCentre cc; ClCategory clcat; @@ -470,32 +445,15 @@ profile_closure_cc_select(closure,size) return; /* all selected if ! cc_select */ clcat = (ClCategory) INFO_CAT(INFO_PTR(closure)); - if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */ + if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */ return; -#if defined(HEAP_PROF_WITH_AGE) - if (age_select) { - I_ age, ts = AGE_HDR(closure); - - if (ts == 0) { /* Set to 0 when alloced -- now set to current interval */ - AGE_HDR(closure) = (W_)current_interval; - age = - age_select; - } - else { - age = current_interval - ts - age_select; - } - if (age < 0) return; - } -#endif /* HEAP_PROF_WITH_AGE */ - resid[index_cc(cc)] += size + NON_PROF_HS; return; } void -profile_closure_mod(closure,size) - P_ closure; - I_ size; +profile_closure_mod(P_ closure, I_ size) { CostCentre cc = (CostCentre) CC_HDR(closure); resid[index_mod(cc)] += size + NON_PROF_HS; @@ -503,9 +461,7 @@ profile_closure_mod(closure,size) } void -profile_closure_mod_select(closure,size) - P_ closure; - I_ size; +profile_closure_mod_select(P_ closure, I_ size) { CostCentre cc; ClCategory clcat; @@ -514,41 +470,23 @@ profile_closure_mod_select(closure,size) return; clcat = (ClCategory) INFO_CAT(INFO_PTR(closure)); - if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */ + if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */ return; -#if defined(HEAP_PROF_WITH_AGE) - if (age_select) { - I_ age, ts = AGE_HDR(closure); - - if (ts == 0) { /* Set to 0 when alloced -- now set to current interval */ - AGE_HDR(closure) = (W_)current_interval; - age = - age_select; - } - else { - age = current_interval - ts - age_select; - } - if (age < 0) return; - } -#endif /* HEAP_PROF_WITH_AGE */ - resid[index_mod(cc)] += size + NON_PROF_HS; return; } void -profile_closure_grp(closure,size) - P_ closure; - I_ size; +profile_closure_grp(P_ closure, I_ size) { CostCentre cc = (CostCentre) CC_HDR(closure); resid[index_grp(cc)] += size + NON_PROF_HS; return; } + void -profile_closure_grp_select(closure,size) - P_ closure; - I_ size; +profile_closure_grp_select(P_ closure, I_ size) { CostCentre cc; ClCategory clcat; @@ -557,32 +495,15 @@ profile_closure_grp_select(closure,size) return; clcat = (ClCategory) INFO_CAT(INFO_PTR(closure)); - if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */ + if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */ return; -#if defined(HEAP_PROF_WITH_AGE) - if (age_select) { - I_ age, ts = AGE_HDR(closure); - - if (ts == 0) { /* Set to 0 when alloced -- now set to current interval */ - AGE_HDR(closure) = (W_)current_interval; - age = - age_select; - } - else { - age = current_interval - ts - age_select; - } - if (age < 0) return; - } -#endif /* HEAP_PROF_WITH_AGE */ - resid[index_grp(cc)] += size + NON_PROF_HS; return; } void -profile_closure_descr(closure,size) - P_ closure; - I_ size; +profile_closure_descr(P_ closure, I_ size) { ClCategory clcat = (ClCategory) INFO_CAT(INFO_PTR(closure)); resid[index_descr(clcat)] += size + NON_PROF_HS; @@ -590,9 +511,7 @@ profile_closure_descr(closure,size) } void -profile_closure_descr_select(closure,size) - P_ closure; - I_ size; +profile_closure_descr_select(P_ closure, I_ size) { CostCentre cc; ClCategory clcat; @@ -601,32 +520,15 @@ profile_closure_descr_select(closure,size) return; /* all selected if ! cc_select */ clcat = (ClCategory) INFO_CAT(INFO_PTR(closure)); - if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */ + if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */ return; -#if defined(HEAP_PROF_WITH_AGE) - if (age_select) { - I_ age, ts = AGE_HDR(closure); - - if (ts == 0) { /* Set to 0 when alloced -- now set to current interval */ - AGE_HDR(closure) = (W_)current_interval; - age = - age_select; - } - else { - age = current_interval - ts - age_select; - } - if (age < 0) return; - } -#endif /* HEAP_PROF_WITH_AGE */ - resid[index_descr(clcat)] += size + NON_PROF_HS; return; } void -profile_closure_type(closure,size) - P_ closure; - I_ size; +profile_closure_type(P_ closure, I_ size) { ClCategory clcat = (ClCategory) INFO_CAT(INFO_PTR(closure)); resid[index_type(clcat)] += size + NON_PROF_HS; @@ -634,9 +536,7 @@ profile_closure_type(closure,size) } void -profile_closure_type_select(closure,size) - P_ closure; - I_ size; +profile_closure_type_select(P_ closure, I_ size) { CostCentre cc; ClCategory clcat; @@ -648,95 +548,19 @@ profile_closure_type_select(closure,size) if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */ return; -#if defined(HEAP_PROF_WITH_AGE) - if (age_select) { - I_ age, ts = AGE_HDR(closure); - - if (ts == 0) { /* Set to 0 when alloced -- now set to current interval */ - AGE_HDR(closure) = (W_)current_interval; - age = - age_select; - } - else { - age = current_interval - ts - age_select; - } - if (age < 0) return; - } -#endif /* HEAP_PROF_WITH_AGE */ - resid[index_type(clcat)] += size + NON_PROF_HS; return; } void -profile_closure_time(closure,size) - P_ closure; - I_ size; +profile_closure_time(P_ closure, I_ size) { -#if defined(HEAP_PROF_WITH_AGE) - I_ ts = AGE_HDR(closure); - - if (ts == 0) { /* Set to 0 when alloced -- now set to current interval */ - AGE_HDR(closure) = (W_)current_interval; - ts = current_interval; - } - - ts -= earlier_intervals; - - if (ts < 0) { - resid_earlier += size + NON_PROF_HS; - } - else if (ts < time_intervals) { - resid[ts] += size + NON_PROF_HS; - } - else { - resid_later += size + NON_PROF_HS; - } -#endif /* HEAP_PROF_WITH_AGE */ - return; } void -profile_closure_time_select(closure,size) - P_ closure; - I_ size; +profile_closure_time_select(P_ closure, I_ size) { -#if defined(HEAP_PROF_WITH_AGE) - CostCentre cc; ClCategory clcat; I_ age, ts; - - cc = (CostCentre) CC_HDR(closure); - if (! cc->selected) /* selection determined before profile */ - return; /* all selected if ! cc_select */ - - clcat = (ClCategory) INFO_CAT(INFO_PTR(closure)); - if (clcat_select && ! selected_clcat(clcat)) /* selection memoised during profile */ - return; - - ts = AGE_HDR(closure); - if (ts == 0) { /* Set to 0 when alloced -- now set to current interval */ - AGE_HDR(closure) = (W_)current_interval; - ts = current_interval; - age = - age_select; - } - else { - age = current_interval - ts - age_select; - } - if (age < 0) - return; - - ts -= earlier_intervals; - - if (ts < 0) { - resid_earlier += size + NON_PROF_HS; - } - else if (ts < time_intervals) { - resid[ts] += size + NON_PROF_HS; - } - else { - resid_later += size + NON_PROF_HS; - } -#endif /* HEAP_PROF_WITH_AGE */ - return; } \end{code} @@ -776,37 +600,45 @@ void (* profiling_fns[]) PROTO((P_,I_)) = { void heap_profile_setup(STG_NO_ARGS) /* called at start of heap profile */ { - if (heap_profiling_req == HEAP_NO_PROFILING) + W_ heap_prof_style; + + if (! RTSflags.ProfFlags.doHeapProfile) return; - if (cc_select || clcat_select || age_select) { + heap_prof_style = RTSflags.ProfFlags.doHeapProfile; + + if (cc_select || clcat_select) { set_selected_ccs(); /* memoise cc selection */ - heap_profile_fn = profiling_fns_select[heap_profiling_req]; + heap_profile_fn = profiling_fns_select[heap_prof_style]; } else { - heap_profile_fn = profiling_fns[heap_profiling_req]; + heap_profile_fn = profiling_fns[heap_prof_style]; } } void heap_profile_done(STG_NO_ARGS) /* called at end of heap profile */ { - CostCentre cc; ClCategory clcat; hash_t ind, max; + CostCentre cc; + ClCategory clcat; + hash_t ind, max; StgFloat seconds; + W_ heap_prof_style; - if (heap_profiling_req == HEAP_NO_PROFILING) + if (! RTSflags.ProfFlags.doHeapProfile) return; + heap_prof_style = RTSflags.ProfFlags.doHeapProfile; heap_profile_fn = profile_closure_none; seconds = (previous_ticks + current_ticks) / (StgFloat)TICK_FREQUENCY; fprintf(heap_file, "BEGIN_SAMPLE %0.2f\n", seconds); - max = (* init_index_fns[heap_profiling_req])(); + max = (* init_index_fns[heap_prof_style])(); - switch (heap_profiling_req) { + switch (heap_prof_style) { case HEAP_BY_CC: for (ind = 0; ind < max; ind++) { - if ((cc = index_cc_table[ind]) != 0) { + if ((cc = index_cc_table[ind]) != 0 && ! cc_to_ignore(cc)) { fprintf(heap_file, " %0.11s:%0.16s %ld\n", cc->module, cc->label, resid[ind] * sizeof(W_)); } resid[ind] = 0; @@ -815,7 +647,7 @@ heap_profile_done(STG_NO_ARGS) /* called at end of heap profile */ case HEAP_BY_MOD: for (ind = 0; ind < max; ind++) { - if ((cc = index_mod_table[ind]) != 0) { + if ((cc = index_mod_table[ind]) != 0 && ! cc_to_ignore(cc)) { fprintf(heap_file, " %0.11s %ld\n", cc->module, resid[ind] * sizeof(W_)); } resid[ind] = 0; @@ -824,7 +656,7 @@ heap_profile_done(STG_NO_ARGS) /* called at end of heap profile */ case HEAP_BY_GRP: for (ind = 0; ind < max; ind++) { - if ((cc = index_grp_table[ind]) != 0) { + if ((cc = index_grp_table[ind]) != 0 && ! cc_to_ignore(cc)) { fprintf(heap_file, " %0.11s %ld\n", cc->group, resid[ind] * sizeof(W_)); } resid[ind] = 0; @@ -833,7 +665,7 @@ heap_profile_done(STG_NO_ARGS) /* called at end of heap profile */ case HEAP_BY_DESCR: for (ind = 0; ind < max; ind++) { - if ((clcat = index_descr_table[ind]) != 0) { + if ((clcat = index_descr_table[ind]) != 0 && ! cc_to_ignore(cc)) { fprintf(heap_file, " %0.28s %ld\n", clcat->descr, resid[ind] * sizeof(W_)); } resid[ind] = 0; @@ -842,42 +674,12 @@ heap_profile_done(STG_NO_ARGS) /* called at end of heap profile */ case HEAP_BY_TYPE: for (ind = 0; ind < max; ind++) { - if ((clcat = index_type_table[ind]) != 0) { + if ((clcat = index_type_table[ind]) != 0 && ! cc_to_ignore(cc)) { fprintf(heap_file, " %0.28s %ld\n", clcat->type, resid[ind] * sizeof(W_)); } resid[ind] = 0; } break; - -#if defined(HEAP_PROF_WITH_AGE) - case HEAP_BY_TIME: - { I_ resid_tot = 0; - if (resid_earlier) { - resid_tot += resid_earlier; - fprintf(heap_file, " before_%4.2fs %ld\n", - (earlier_intervals-1)*interval_ticks/(StgFloat)TICK_FREQUENCY, - resid_earlier * sizeof(StgWord)); - resid_earlier = 0; - } - for (ind = 0; ind < max; ind++) { - if (resid[ind]) { - resid_tot += resid[ind]; - fprintf(heap_file, " before_%4.2fs %ld\n", - (ind+earlier_intervals)*interval_ticks/(StgFloat)TICK_FREQUENCY, - resid[ind] * sizeof(StgWord)); - resid[ind] = 0; - } - } - if (resid_later) { - resid_tot += resid_later; - fprintf(heap_file, " later %ld\n", resid_later * sizeof(StgWord)); - resid_later = 0; - } - - if (resid_max < resid_tot) resid_max = resid_tot; - break; - } -#endif /* HEAP_PROF_WITH_AGE */ } fprintf(heap_file, "END_SAMPLE %0.2f\n", seconds); @@ -889,7 +691,7 @@ heap_profile_finish(STG_NO_ARGS) /* called at end of execution */ { StgFloat seconds; - if (heap_profiling_req == HEAP_NO_PROFILING) + if (! RTSflags.ProfFlags.doHeapProfile) return; seconds = (previous_ticks + current_ticks) / (StgFloat)TICK_FREQUENCY; @@ -902,5 +704,5 @@ heap_profile_finish(STG_NO_ARGS) /* called at end of execution */ \end{code} \begin{code} -#endif /* USE_COST_CENTRES */ +#endif /* PROFILING */ \end{code} diff --git a/ghc/runtime/profiling/Indexing.lc b/ghc/runtime/profiling/Indexing.lc index 927e19961e..f9bfeca12c 100644 --- a/ghc/runtime/profiling/Indexing.lc +++ b/ghc/runtime/profiling/Indexing.lc @@ -1,9 +1,9 @@ -Only have cost centres etc if @USE_COST_CENTRES@ defined +Only have cost centres etc if @PROFILING@ defined \begin{code} #define NULL_REG_MAP /* Not threaded */ -#include "../storage/SMinternal.h" /* for xmalloc */ -#if defined (USE_COST_CENTRES) +#include "../storage/SMinternal.h" /* for ??? */ +#if defined (PROFILING) \end{code} %************************************************************************ @@ -40,8 +40,10 @@ init_index_cc() max_cc_no = max2; mask_cc = max2 - 1; - index_cc_table = (CostCentre *) xmalloc(max2 * sizeof(CostCentre)); - for (count = 0; count < max2; count++) index_cc_table[count] = 0; + index_cc_table = (CostCentre *) stgMallocBytes(max2 * sizeof(CostCentre), "init_index_cc"); + + for (count = 0; count < max2; count++) + index_cc_table[count] = 0; return max2; } @@ -95,13 +97,16 @@ init_index_mod() max_mod_no = max2; mask_mod = max2 - 1; - index_mod_table = (CostCentre *) xmalloc(max2 * sizeof(CostCentre)); - for (count = 0; count < max2; count++) index_mod_table[count] = 0; + index_mod_table = (CostCentre *) stgMallocBytes(max2 * sizeof(CostCentre), "init_index_mod"); + + for (count = 0; count < max2; count++) + index_mod_table[count] = 0; return max2; } -hash_t index_mod(cc) +hash_t +index_mod(cc) CostCentre cc; { if (cc->index_val == UNHASHED) { @@ -152,13 +157,16 @@ init_index_grp() max_grp_no = max2; mask_grp = max2 - 1; - index_grp_table = (CostCentre *) xmalloc(max2 * sizeof(CostCentre)); - for (count = 0; count < max2; count++) index_grp_table[count] = 0; + index_grp_table = (CostCentre *) stgMallocBytes(max2 * sizeof(CostCentre), "init_index_grp"); + + for (count = 0; count < max2; count++) + index_grp_table[count] = 0; return max2; } -hash_t index_grp(cc) +hash_t +index_grp(cc) CostCentre cc; { if (cc->index_val == UNHASHED) { @@ -209,13 +217,16 @@ init_index_descr() max_descr_no = max2; mask_descr = max2 - 1; - index_descr_table = (ClCategory *) xmalloc(max2 * sizeof(ClCategory)); - for (count = 0; count < max2; count++) index_descr_table[count] = 0; + index_descr_table = (ClCategory *) stgMallocBytes(max2 * sizeof(ClCategory), "init_index_descr"); + + for (count = 0; count < max2; count++) + index_descr_table[count] = 0; return max2; } -hash_t index_descr(clcat) +hash_t +index_descr(clcat) ClCategory clcat; { if (clcat->index_val == UNHASHED) { @@ -266,8 +277,10 @@ init_index_type() max_type_no = max2; mask_type = max2 - 1; - index_type_table = (ClCategory *) xmalloc(max2 * sizeof(ClCategory)); - for (count = 0; count < max2; count++) index_type_table[count] = 0; + index_type_table = (ClCategory *) stgMallocBytes(max2 * sizeof(ClCategory), "init_index_type"); + + for (count = 0; count < max2; count++) + index_type_table[count] = 0; return max2; } @@ -297,5 +310,5 @@ hash_t index_type(clcat) \end{code} \begin{code} -#endif /* USE_COST_CENTRES */ +#endif /* PROFILING */ \end{code} diff --git a/ghc/runtime/profiling/LifeProfile.lc b/ghc/runtime/profiling/LifeProfile.lc deleted file mode 100644 index dc5b74b11c..0000000000 --- a/ghc/runtime/profiling/LifeProfile.lc +++ /dev/null @@ -1,299 +0,0 @@ -\section[LifeProfile.lc]{Code for Lifetime Profiling} - -\tr{life_profile} is the accumulated age at death profile. It is -calculated from the difference of the prev and cur age profiles. - -\tr{update_profile} is the accumulated age at update profile. - -\begin{code} -#include "rtsdefs.h" -\end{code} - -Only have lifetime profiling if @LIFE_PROFILE@ defined - -\begin{code} -#if defined(LIFE_PROFILE) -\end{code} - -Note: Heap Lookahead may cause age increment when no alloc occurs ! - -Could avoid it and assume space is available. If a closure was then -allocated it may be given a younger age. Subsequent Heap Check would -increment age. - -\begin{code} -I_ do_life_prof = 0; /* Global Flag */ -I_ CurrentTime = 0; /* Current time (in LifeIntervals) */ -I_ LifeInterval = DEFAULT_LIFE_INTERVAL; /* words alloced */ - -W_ closures_updated = 0; -W_ closures_alloced = 0; - -static W_ words_allocated = 0; - -static StgChar* prog; -static I_ over_alloc = 0; -static I_ progress = 999; -\end{code} - - -\tr{cur_age_profile} is a histogram of live words of each age. - -\tr{prev_age_profile} is a histogram of the live words at the last -profile expressed in the ages they wold be at the current profile. -When the current is copied into the previous it must be shifted along. -\tr{prev_age_profile[0]} is always 0! - -\begin{code} -static I_ intervals; /* No of active intervals -- report to 10Mb */ - -static W_ cur_age_profile[INTERVALS]; -static W_ cur_older = 0; -static W_ prev_age_profile[INTERVALS]; -static W_ prev_older = 0; - -static W_ life_profile[INTERVALS]; -static W_ life_older = 0; -static W_ update_profile[INTERVALS]; -static W_ update_older = 0; -\end{code} - -\begin{code} -I_ -life_profile_init(rts_argv, prog_argv) - StgChar *rts_argv[]; - StgChar *prog_argv[]; -{ - I_ i; - - if (! do_life_prof) - return 0; - - prog = prog_argv[0]; - - /* report up to 10Mb (2.5 Mwords) */ - intervals = 2500000 / LifeInterval; - if (intervals > INTERVALS) - intervals = INTERVALS; - - for (i = 0; i < intervals; i++) { - cur_age_profile[i] = 0; - prev_age_profile[i] = 0; - life_profile[i] = 0; - update_profile[i] = 0; - } - - return 0; -} - -void life_profile_setup(STG_NO_ARGS) -{ - return; -} - -I_ -life_profile_done(alloc, reqsize) - I_ alloc; - I_ reqsize; -{ - I_ i, actual_alloc, slop, shift_prev_age; - - life_profile[0] += cur_age_profile[0]; /* age 0 still alive */ - - for (i = 1; i < intervals; i++) { - life_profile[i] += prev_age_profile[i] - cur_age_profile[i]; - prev_age_profile[i] = cur_age_profile[i-1]; - cur_age_profile[i-1] = 0; - } - life_older += prev_older - cur_older; - prev_older = cur_age_profile[intervals-1] + cur_older; - cur_age_profile[intervals-1] = 0; - cur_older = 0; - - CurrentTime++; - - words_allocated += alloc; - - actual_alloc = words_allocated - closures_alloced; - slop = CurrentTime * LifeInterval - actual_alloc; - - shift_prev_age = 0; - while (slop < 0) { - /* over allocated due to large reqsize */ - CurrentTime++; - slop += LifeInterval; - over_alloc++; - shift_prev_age++; - } - if (shift_prev_age) { - /* shift prev age profile as we have skipped profiles */ - for (i = intervals - 1; i >= intervals - shift_prev_age; i--) { - prev_older += prev_age_profile[i]; - } - for (i = intervals - 1; i >= shift_prev_age; i--) { - prev_age_profile[i] = prev_age_profile[i-shift_prev_age]; - } - for (i = shift_prev_age - 1; i >= 0; i--) { - prev_age_profile[i] = 0; - } - } - - if (++progress == 1000 || do_life_prof > 1) { - fprintf(stderr, "%s: intervals %ld interval %ld alloc %ld slop %ld req %ld (over %ld)\n", - prog, CurrentTime, LifeInterval, actual_alloc, slop, reqsize, over_alloc); - progress = 0; - } - - if (slop + LifeInterval < reqsize) { - return(reqsize); - } else { - return(slop + LifeInterval); - } -} - -void -life_profile_finish(alloc, prog_argv) - I_ alloc; - StgChar *prog_argv[]; -{ - I_ report, i; - StgChar life_filename[STATS_FILENAME_MAXLEN]; - FILE *life_file; - W_ total_life, total_upd, total_interval, - accum_life, accum_upd; - - if (! do_life_prof) - return; - - total_interval = words_allocated + alloc - closures_alloced; - - /* convert age 0 still alive to age 0 died */ - life_profile[0] = closures_alloced - life_profile[0]; - - /* All the prev stuff just died ! */ - for (i = 1; i < intervals; i++) { - life_profile[i] += prev_age_profile[i]; - } - life_older += prev_older; - - /* Produce liftime reports */ - sprintf(life_filename, LIFE_FILENAME_FMT, prog_argv[0]); - if ( (life_file = fopen(life_filename,"w")) == NULL ) { - fprintf(stderr, "Can't open life profile report file %s\n", life_filename); - } - else { - for(i = 0, total_life = total_upd = 0; i < intervals; i++) { - total_life += life_profile[i]; - total_upd += update_profile[i]; - } - total_life += life_older; - total_upd += update_older; - - if (total_life != closures_alloced) { - fprintf(stderr, "Warning: Life Profile: %1lu closures in profile, %1lu allocated\n", - total_life, closures_alloced); - } - if (total_upd != closures_updated) { - fprintf(stderr, "Warning: Update Age Profile: %1lu closures in profile, %1lu updated\n", - total_upd, closures_updated); - } - - fprintf(life_file, "\tClosure Lifetime Profile (%s)\n", time_str()); - fprintf(life_file, "\n\t "); - for(i = 0; prog_argv[i]; i++) - fprintf(life_file, " %s", prog_argv[i]); - fprintf(life_file, "\n\n\ttotal closures alloced: %lu\n", - closures_alloced); - fprintf(life_file, "\ttotal closures updated: %lu\n", - closures_updated); - fprintf(life_file, "\ttotal bytes alloced: %lu\n", - total_interval*sizeof(W_)); - fprintf(life_file, "\n age (allocation) liftime age when updated\n"); - fprintf(life_file, " bytes %%total %%closures No %%updates No\n"); - - accum_life = 0; - accum_upd = 0; - - report = 0; - while (report < intervals) { - I_ life = 0; - I_ upd = 0; - - i = report; - report += GROUPED; - - while(i < report) { - life += life_profile[i]; - upd += update_profile[i]; - i++; - } - - accum_life += life; - accum_upd += upd; - - fprintf(life_file, " %8ld %7.3f %6.2f%9lu %6.2f%9lu\n", - (report)*LifeInterval*sizeof(W_), - (report)*LifeInterval/(StgFloat)total_interval*100, - accum_life/(StgFloat)closures_alloced*100, - life, - accum_upd/(StgFloat)closures_updated*100, - upd); - } - - fprintf(life_file, " older %6.2f%9lu %6.2f%9lu\n\n", - life_older/(StgFloat)closures_alloced*100, - life_older, - update_older/(StgFloat)closures_updated*100, - update_older); - - fprintf(life_file, "Raw Data: lifetime update\n"); - for(i = 0; i < intervals; i++) { - fprintf(life_file, " %8ld %9lu %9lu\n", - (i+1)*LifeInterval*sizeof(W_), life_profile[i], update_profile[i]); - } - - fclose(life_file); - } - return; -} - - -void -life_profile_closure(closure, size) - P_ closure; - I_ size; -{ - I_ age; - - age = CurrentTime - AGE_HDR(closure); - if (age < intervals) - cur_age_profile[age] += 1; - else - cur_older += 1; - return; -} - -extern void update_profile_closure(closure) - P_ closure; -{ - I_ age; - - if (! do_life_prof) - return; - - age = CurrentTime - AGE_HDR(closure); - if (age < intervals) - update_profile[age] += 1; - else - update_older += 1; - closures_updated++; - return; -} - -\end{code} - - -\begin{code} -#endif /* LIFE_PROFILE */ -\end{code} - diff --git a/ghc/runtime/profiling/Timer.lc b/ghc/runtime/profiling/Timer.lc index c76ad4aba1..3a0a2fbcbe 100644 --- a/ghc/runtime/profiling/Timer.lc +++ b/ghc/runtime/profiling/Timer.lc @@ -1,9 +1,9 @@ -Only have cost centres etc if @USE_COST_CENTRES@ defined +Only have cost centres etc if @PROFILING@ defined \begin{code} #include "rtsdefs.h" -#if defined (USE_COST_CENTRES) || defined(GUM) +#if defined (PROFILING) || defined(PAR) \end{code} %************************************************************************ @@ -26,13 +26,8 @@ I_ interval_ticks = DEFAULT_INTERVAL; /* No of ticks in an interval */ I_ previous_ticks = 0; /* ticks in previous intervals */ I_ current_ticks = 0; /* ticks in current interval */ -#ifdef CONCURRENT -I_ tick_millisecs; /* milliseconds per timer tick */ -#endif - void -set_profile_timer(ms) -I_ ms; +set_profile_timer(I_ ms) { if (initialize_virtual_timer(ms)) { fflush(stdout); @@ -47,14 +42,14 @@ handle_tick_serial(STG_NO_ARGS) CC_TICK(CCC); /* fprintf(stderr,"tick for %s\n", CCC->label); */ -#if defined(USE_COST_CENTRES) && defined(DEBUG) +#if defined(PROFILING) && defined(DEBUG) /* Why is this here? --JSM Debugging --WDP */ if (CCC == STATIC_CC_REF(CC_OVERHEAD)) abort(); #endif if (++current_ticks >= interval_ticks && CCC != STATIC_CC_REF(CC_GC)) { -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) interval_expired = 1; /* stop to process interval */ #else report_cc_profiling(0 /*partial*/); @@ -68,6 +63,7 @@ void handle_tick_noserial(STG_NO_ARGS) { CC_TICK(CCC); + ++current_ticks; return; } @@ -82,7 +78,7 @@ stop_time_profiler() void restart_time_profiler() { /* Restarts time profile */ -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) if (interval_expired) #endif { @@ -97,8 +93,8 @@ void start_time_profiler() { /* Starts time profile */ if (time_profiling) { -#ifdef CONCURRENT - set_profile_timer(tick_millisecs); +#ifdef PAR + set_profile_timer(RTSflags.CcFlags.msecsPerTick); #else set_profile_timer(TICK_MILLISECS); #endif @@ -107,5 +103,5 @@ start_time_profiler() \end{code} \begin{code} -#endif /* USE_COST_CENTRES || GUM */ +#endif /* PROFILING || PAR */ \end{code} diff --git a/ghc/runtime/storage/Force_GC.lc b/ghc/runtime/storage/Force_GC.lc deleted file mode 100644 index 0e5120a2d6..0000000000 --- a/ghc/runtime/storage/Force_GC.lc +++ /dev/null @@ -1,50 +0,0 @@ -\section[Force_GC.lc]{Code for Forcing Garbage Collections} - -\begin{code} -#include "rtsdefs.h" -\end{code} - -Only have GC forcing if @FORCE_GC@ defined - -- currently only works with appel GC -- in normal appel GC, if the force_gc flag is set *major* GC occurs - at the next scheduled minor GC if at least GCInterval word allocations have happened - since the last major GC. - (It also occurs when the normal conditions for a major GC is met) -- if the force2s and force_gc flags are set - (forcing appel GC to work as a 2 space GC) GC occurs - at least at every GCInterval word allocations - (it also occurs when the semi-space limit is reached). - Therefore it has no effect if the interval specified is >= semi-space. - - -\begin{code} -#if defined(FORCE_GC) -\end{code} - -\begin{code} -I_ force_GC = 0; /* Global Flag */ -I_ GCInterval = DEFAULT_GC_INTERVAL; /* words alloced */ -I_ alloc_since_last_major_GC = 0; /* words alloced since last major GC */ - - -#endif /* FORCE_GC */ -\end{code} - - - - - - - - - - - - - - - - - - diff --git a/ghc/runtime/storage/SM1s.lc b/ghc/runtime/storage/SM1s.lc index 51265e5959..85919b0eb5 100644 --- a/ghc/runtime/storage/SM1s.lc +++ b/ghc/runtime/storage/SM1s.lc @@ -29,22 +29,24 @@ P_ heap_space = 0; /* Address of first word of slab P_ hp_start; /* Value of Hp when reduction was resumed */ -I_ -initHeap( sm ) - smInfo *sm; +rtsBool +initHeap( smInfo *sm ) { if (heap_space == 0) { /* allocates if it doesn't already exist */ /* Allocate the roots space */ - sm->roots = (P_ *) xmalloc( SM_MAXROOTS * sizeof(W_) ); + sm->roots = (P_ *) stgMallocWords(SM_MAXROOTS, "initHeap (roots)"); /* Allocate the heap */ - heap_space = (P_) xmalloc((SM_word_heap_size + EXTRA_HEAP_WORDS) * sizeof(W_)); + heap_space = (P_) stgMallocWords(RTSflags.GcFlags.heapSize + EXTRA_HEAP_WORDS, + "initHeap (heap)"); - compactingInfo.bit_words = (SM_word_heap_size + BITS_IN(BitWord) - 1) / BITS_IN(BitWord); - compactingInfo.bits = (BitWord *)(heap_space + SM_word_heap_size) - compactingInfo.bit_words; + compactingInfo.bit_words + = (RTSflags.GcFlags.heapSize + BITS_IN(BitWord) - 1) / BITS_IN(BitWord); + compactingInfo.bits + = (BitWord *)(heap_space + RTSflags.GcFlags.heapSize) - compactingInfo.bit_words; - compactingInfo.heap_words = SM_word_heap_size - compactingInfo.bit_words; + compactingInfo.heap_words = RTSflags.GcFlags.heapSize - compactingInfo.bit_words; compactingInfo.base = HEAP_FRAME_BASE(heap_space, compactingInfo.heap_words); compactingInfo.lim = HEAP_FRAME_LIMIT(heap_space, compactingInfo.heap_words); @@ -53,16 +55,17 @@ initHeap( sm ) sm->hp = hp_start = compactingInfo.base - 1; - if (SM_alloc_size) { - sm->hplim = sm->hp + SM_alloc_size; - SM_alloc_min = 0; /* No min; alloc size specified */ + if (! RTSflags.GcFlags.allocAreaSizeGiven) { + sm->hplim = compactingInfo.lim; + } else { + sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize; + + RTSflags.GcFlags.minAllocAreaSize = 0; /* specified size takes precedence */ if (sm->hplim > compactingInfo.lim) { fprintf(stderr, "Not enough heap for requested alloc size\n"); - return -1; + return rtsFalse; } - } else { - sm->hplim = compactingInfo.lim; } sm->CAFlist = NULL; @@ -71,7 +74,7 @@ initHeap( sm ) initExtensions( sm ); #endif /* !PAR */ - if (SM_trace) { + if (RTSflags.GcFlags.trace) { fprintf(stderr, "COMPACTING Heap: Base 0x%lx, Lim 0x%lx, Bits 0x%lx, bit words 0x%lx\n", (W_) compactingInfo.base, (W_) compactingInfo.lim, (W_) compactingInfo.bits, (W_) compactingInfo.bit_words); @@ -81,7 +84,7 @@ initHeap( sm ) (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_)); } - return 0; + return rtsTrue; /* OK */ } I_ @@ -96,8 +99,7 @@ collectHeap(reqsize, sm, do_full_collection) SAVE_REGS(&ScanRegDump); /* Save registers */ - if (SM_trace) - { + if (RTSflags.GcFlags.trace) { fflush(stdout); /* Flush stdout at start of GC */ fprintf(stderr, "COMPACTING Start: base 0x%lx, lim 0x%lx\n hp 0x%lx, hplim 0x%lx, req %lu\n", (W_) compactingInfo.base, (W_) compactingInfo.lim, @@ -156,23 +158,23 @@ collectHeap(reqsize, sm, do_full_collection) resident = sm->hp - (compactingInfo.base - 1); DO_MAX_RESIDENCY(resident); /* stats only */ - if (SM_alloc_size) { - sm->hplim = sm->hp + SM_alloc_size; + if (! RTSflags.GcFlags.allocAreaSizeGiven) { + sm->hplim = compactingInfo.lim; + free_space = sm->hplim - sm->hp; + } else { + sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize; if (sm->hplim > compactingInfo.lim) { free_space = 0; } else { - free_space = SM_alloc_size; + free_space = RTSflags.GcFlags.allocAreaSize; } - } else { - sm->hplim = compactingInfo.lim; - free_space = sm->hplim - sm->hp; } hp_start = sm->hp; stat_endGC(alloc, compactingInfo.heap_words, resident, ""); - if (SM_trace) + if (RTSflags.GcFlags.trace) fprintf(stderr, "COMPACTING Done: base 0x%lx, lim 0x%lx\n hp 0x%lx, hplim 0x%lx, free %lu\n", (W_) compactingInfo.base, (W_) compactingInfo.lim, (W_) sm->hp, (W_) sm->hplim, (W_) (free_space * sizeof(W_))); @@ -185,7 +187,7 @@ collectHeap(reqsize, sm, do_full_collection) RESTORE_REGS(&ScanRegDump); /* Restore Registers */ - if ((SM_alloc_min > free_space) || (reqsize > free_space)) + if (free_space < RTSflags.GcFlags.minAllocAreaSize || free_space < reqsize) return GC_HARD_LIMIT_EXCEEDED; /* Heap exhausted */ else return GC_SUCCESS; /* Heap OK */ diff --git a/ghc/runtime/storage/SM2s.lc b/ghc/runtime/storage/SM2s.lc index 1a50a0e841..bdfa4150ce 100644 --- a/ghc/runtime/storage/SM2s.lc +++ b/ghc/runtime/storage/SM2s.lc @@ -24,18 +24,19 @@ P_ heap_space = 0; /* Address of first word of slab P_ hp_start; /* Value of Hp when reduction was resumed */ -I_ initHeap( sm ) - smInfo *sm; +rtsBool +initHeap(smInfo * sm) { if (heap_space == 0) { /* allocates if it doesn't already exist */ - I_ semispaceSize = SM_word_heap_size / 2; + I_ semispaceSize = RTSflags.GcFlags.heapSize / 2; /* Allocate the roots space */ - sm->roots = (P_ *) xmalloc( SM_MAXROOTS * sizeof(W_) ); + sm->roots = (P_ *) stgMallocWords(SM_MAXROOTS, "initHeap (roots)"); /* Allocate the heap */ - heap_space = (P_) xmalloc((SM_word_heap_size + EXTRA_HEAP_WORDS) * sizeof(W_)); + heap_space = (P_) stgMallocWords(RTSflags.GcFlags.heapSize + EXTRA_HEAP_WORDS, + "initHeap (heap)"); /* Define the semi-spaces */ semispaceInfo[0].base = HEAP_FRAME_BASE(heap_space, semispaceSize); @@ -52,35 +53,27 @@ I_ initHeap( sm ) sm->hp = hp_start = semispaceInfo[semispace].base - 1; sm->hardHpOverflowSize = 0; - if (SM_alloc_size) { - sm->hplim = sm->hp + SM_alloc_size; - SM_alloc_min = 0; /* No min; alloc size specified */ + if (! RTSflags.GcFlags.allocAreaSizeGiven) { + sm->hplim = semispaceInfo[semispace].lim; + } else { + sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize; + + RTSflags.GcFlags.minAllocAreaSize = 0; /* specified size takes precedence */ if (sm->hplim > semispaceInfo[semispace].lim) { fprintf(stderr, "Not enough heap for requested alloc size\n"); - return -1; + return rtsFalse; } - } else { - sm->hplim = semispaceInfo[semispace].lim; } -#if defined(FORCE_GC) - if (force_GC) { - if (sm->hplim > sm->hp + GCInterval) { - sm->hplim = sm->hp + GCInterval; - } - else { - force_GC = 0; /* forcing GC has no effect, as semi-space is smaller than GCInterval */ + if (RTSflags.GcFlags.forceGC) { + if (sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) { + sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval; + } else { + RTSflags.GcFlags.forceGC = rtsFalse; + /* forcing GC has no effect, as semi-space is smaller than forcingInterval */ } } -#endif /* FORCE_GC */ - -#if defined(LIFE_PROFILE) - sm->hplim = sm->hp + ((sm->hplim - sm->hp) / 2); /* space for HpLim incr */ - if (do_life_prof) { - sm->hplim = sm->hp + LifeInterval; - } -#endif /* LIFE_PROFILE */ sm->CAFlist = NULL; @@ -88,7 +81,7 @@ I_ initHeap( sm ) initExtensions( sm ); #endif /* !PAR */ - if (SM_trace) { + if (RTSflags.GcFlags.trace) { fprintf(stderr, "TWO SPACE Heap: 0base, 0lim, 1base, 1lim\n 0x%lx, 0x%lx, 0x%lx, 0x%lx\n", (W_) semispaceInfo[0].base, (W_) semispaceInfo[0].lim, (W_) semispaceInfo[1].base, (W_) semispaceInfo[1].lim); @@ -99,7 +92,7 @@ I_ initHeap( sm ) (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_)); } - return 0; + return rtsTrue; /* OK */ } I_ @@ -108,10 +101,6 @@ collectHeap(reqsize, sm, do_full_collection) smInfo *sm; rtsBool do_full_collection; /* ignored */ { -#if defined(LIFE_PROFILE) - I_ next_interval; /* if doing profile */ -#endif - I_ free_space, /* No of words of free space following GC */ alloc, /* Number of words allocated since last GC */ resident, /* Number of words remaining after GC */ @@ -122,15 +111,11 @@ collectHeap(reqsize, sm, do_full_collection) fflush(stdout); /* Flush stdout at start of GC */ SAVE_REGS(&ScavRegDump); /* Save registers */ -#if defined(LIFE_PROFILE) - if (do_life_prof) { life_profile_setup(); } -#endif /* LIFE_PROFILE */ - -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) if (interval_expired) { heap_profile_setup(); } -#endif /* USE_COST_CENTRES */ +#endif /* PROFILING */ - if (SM_trace) + if (RTSflags.GcFlags.trace) fprintf(stderr, "TWO SPACE Start: space %ld, base 0x%lx, lim 0x%lx\n hp 0x%lx, hplim 0x%lx, req %lu\n", semispace, (W_) semispaceInfo[semispace].base, (W_) semispaceInfo[semispace].lim, @@ -181,19 +166,19 @@ collectHeap(reqsize, sm, do_full_collection) resident = sm->hp - (semispaceInfo[semispace].base - 1); DO_MAX_RESIDENCY(resident); /* stats only */ - if (SM_alloc_size) { - sm->hplim = sm->hp + SM_alloc_size; + if (! RTSflags.GcFlags.allocAreaSizeGiven) { + sm->hplim = semispaceInfo[semispace].lim; + free_space = sm->hplim - sm->hp; + } else { + sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize; if (sm->hplim > semispaceInfo[semispace].lim) { free_space = 0; } else { - free_space = SM_alloc_size; + free_space = RTSflags.GcFlags.allocAreaSize; } - } else { - sm->hplim = semispaceInfo[semispace].lim; - free_space = sm->hplim - sm->hp; } - if (SM_stats_verbose) { + if (RTSflags.GcFlags.giveStats) { char comment_str[BIG_STRING_LEN]; #ifndef PAR sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu", @@ -208,40 +193,25 @@ collectHeap(reqsize, sm, do_full_collection) 0, 0, sm->rootno, caf_roots, extra_caf_words*sizeof(W_), 0, 0); #endif -#if defined(LIFE_PROFILE) - if (do_life_prof) { - strcat(comment_str, " life"); - } -#endif -#if defined(USE_COST_CENTRES) - if (interval_expired) { - strcat(comment_str, " prof"); - } +#if defined(PROFILING) + if (interval_expired) { strcat(comment_str, " prof"); } #endif - stat_endGC(alloc, SM_word_heap_size, resident, comment_str); + stat_endGC(alloc, RTSflags.GcFlags.heapSize, resident, comment_str); } else { - stat_endGC(alloc, SM_word_heap_size, resident, ""); + stat_endGC(alloc, RTSflags.GcFlags.heapSize, resident, ""); } -#if defined(LIFE_PROFILE) - free_space = free_space / 2; /* space for HpLim incr */ - if (do_life_prof) { - next_interval = life_profile_done(alloc, reqsize); - free_space -= next_interval; /* ensure interval available */ - } -#endif /* LIFE_PROFILE */ - -#if defined(USE_COST_CENTRES) || defined(GUM) +#if defined(PROFILING) || defined(PAR) if (interval_expired) { -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) heap_profile_done(); #endif report_cc_profiling(0 /*partial*/); } -#endif /* USE_COST_CENTRES */ +#endif /* PROFILING */ - if (SM_trace) + if (RTSflags.GcFlags.trace) fprintf(stderr, "TWO SPACE Done: space %ld, base 0x%lx, lim 0x%lx\n hp 0x%lx, hplim 0x%lx, free %lu\n", semispace, (W_) semispaceInfo[semispace].base, (W_) semispaceInfo[semispace].lim, @@ -257,35 +227,22 @@ collectHeap(reqsize, sm, do_full_collection) RESTORE_REGS(&ScavRegDump); /* Restore Registers */ - if ( (SM_alloc_min > free_space) || (reqsize > free_space) ) { + if (free_space < RTSflags.GcFlags.minAllocAreaSize || free_sapce < reqsize) return( GC_HARD_LIMIT_EXCEEDED ); /* Heap absolutely exhausted */ - } else { -#if defined(FORCE_GC) - if (force_GC) { - if (sm->hplim > sm->hp + GCInterval) { - sm->hplim = sm->hp + GCInterval; - } - } -#endif /* FORCE_GC */ -+ -#if defined(LIFE_PROFILE) - /* space for HpLim incr */ - sm->hplim = sm->hp + ((sm->hplim - sm->hp) / 2); - if (do_life_prof) { - /* set hplim for next life profile */ - sm->hplim = sm->hp + next_interval; - } -#endif /* LIFE_PROFILE */ - - if (reqsize + sm->hardHpOverflowSize > free_space) { - return( GC_SOFT_LIMIT_EXCEEDED ); /* Heap nearly exhausted */ - } else { - return( GC_SUCCESS ); /* Heap OK */ - } + else { + if (RTSflags.GcFlags.forceGC + && sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) { + sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval; + } + + if (reqsize + sm->hardHpOverflowSize > free_space) { + return( GC_SOFT_LIMIT_EXCEEDED ); /* Heap nearly exhausted */ + } else { + return( GC_SUCCESS ); /* Heap OK */ + } } } #endif /* GC2s */ - \end{code} diff --git a/ghc/runtime/storage/SMalloc.lc b/ghc/runtime/storage/SMalloc.lc deleted file mode 100644 index fa1bdab8e6..0000000000 --- a/ghc/runtime/storage/SMalloc.lc +++ /dev/null @@ -1,37 +0,0 @@ -[ - SMalloc seems a BAD choice of name. I expected this to be the routines I - could use to allocate memory, not those used by the storage manager internally. - - KH -] - -Routines that deal with memory allocation: - -All dynamic allocation must be done before the stacks and heap are -allocated. This allows us to use the lower level sbrk routines if -required. - -\begin{code} -#define NULL_REG_MAP -#include "SMinternal.h" - -/* Return a ptr to n StgWords (note: WORDS not BYTES!) or die miserably */ -/* ToDo: Should allow use of valloc to allign on page boundary */ - -char * -#ifdef __STDC__ -xmalloc(size_t n) -#else -xmalloc(n) - size_t n; -#endif -{ - char *space; - - if ((space = (char *) malloc(n)) == NULL) { - MallocFailHook((W_) n); /*msg*/ - EXIT(EXIT_FAILURE); - } - return space; -} -\end{code} diff --git a/ghc/runtime/storage/SMap.lc b/ghc/runtime/storage/SMap.lc index e82a986580..27ec2be0fa 100644 --- a/ghc/runtime/storage/SMap.lc +++ b/ghc/runtime/storage/SMap.lc @@ -30,14 +30,10 @@ P_ heap_space = 0; /* Address of first word of slab P_ hp_start; /* Value of Hp when reduction was resumed */ -#if defined(PROMOTION_DATA) /* For dead promote & premature promote data */ -P_ thisbase; /* Start of old gen before this minor collection */ -P_ prevbase; /* Start of old gen before previous minor collection */ -I_ prev_prom = 0; /* Promoted previous minor collection */ -I_ dead_prev_prom = 0; /* Dead words promoted previous minor */ -#endif /* PROMOTION_DATA */ - -#if defined(_GC_DEBUG) +static I_ allocd_since_last_major_GC = 0; + /* words alloced since last major GC; used when forcing GC */ + +#if defined(DEBUG) void debug_look_for (start, stop, villain) P_ start, stop, villain; @@ -51,21 +47,21 @@ debug_look_for (start, stop, villain) } #endif -I_ -initHeap( sm ) - smInfo *sm; +rtsBool +initHeap(smInfo * sm) { if (heap_space == 0) { /* allocates if it doesn't already exist */ /* Allocate the roots space */ - sm->roots = (P_ *) xmalloc( SM_MAXROOTS * sizeof(W_) ); + sm->roots = (P_ *) stgMallocWords(SM_MAXROOTS, "initHeap (roots)"); /* Allocate the heap */ - heap_space = (P_) xmalloc((SM_word_heap_size + EXTRA_HEAP_WORDS) * sizeof(W_)); + heap_space = (P_) stgMallocWords(RTSflags.GcFlags.heapSize + EXTRA_HEAP_WORDS, + "initHeap (heap)"); /* ToDo (ADR): trash entire heap contents */ - if (SM_force_gc == USE_2s) { + if (RTSflags.GcFlags.force2s) { stat_init("TWOSPACE(APPEL)", " No of Roots Caf Caf Astk Bstk", "Astk Bstk Reg No bytes bytes bytes"); @@ -77,8 +73,8 @@ initHeap( sm ) } sm->hardHpOverflowSize = 0; - if (SM_force_gc == USE_2s) { - I_ semi_space_words = SM_word_heap_size / 2; + if (RTSflags.GcFlags.force2s) { + I_ semi_space_words = RTSflags.GcFlags.heapSize / 2; appelInfo.space[0].base = HEAP_FRAME_BASE(heap_space, semi_space_words); appelInfo.space[1].base = HEAP_FRAME_BASE(heap_space + semi_space_words, semi_space_words); appelInfo.space[0].lim = HEAP_FRAME_LIMIT(heap_space, semi_space_words); @@ -88,37 +84,28 @@ initHeap( sm ) sm->hp = hp_start = appelInfo.space[appelInfo.semi_space].base - 1; - if (SM_alloc_size) { - sm->hplim = sm->hp + SM_alloc_size; - SM_alloc_min = 0; /* No min; alloc size specified */ + if (! RTSflags.GcFlags.allocAreaSizeGiven) { + sm->hplim = appelInfo.space[appelInfo.semi_space].lim; + } else { + sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize; + + RTSflags.GcFlags.minAllocAreaSize = 0; /* specified size takes precedence */ if (sm->hplim > appelInfo.space[appelInfo.semi_space].lim) { fprintf(stderr, "Not enough heap for requested alloc size\n"); - return -1; + return rtsFalse; } - } else { - sm->hplim = appelInfo.space[appelInfo.semi_space].lim; } -#if defined(FORCE_GC) - if (force_GC) { - if (sm->hplim > sm->hp + GCInterval) { - sm->hplim = sm->hp + GCInterval; - } - else { + if (RTSflags.GcFlags.forceGC) { + if (sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) { + sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval; + } else { /* no point in forcing GC, - as the semi-space is smaller than GCInterval */ - force_GC = 0; + as the semi-space is smaller than forcingInterval */ + RTSflags.GcFlags.forceGC = rtsFalse; } } -#endif /* FORCE_GC */ - -#if defined(LIFE_PROFILE) - sm->hplim = sm->hp + ((sm->hplim - sm->hp) / 2); /* space for HpLim incr */ - if (do_life_prof) { - sm->hplim = sm->hp + LifeInterval; - } -#endif /* LIFE_PROFILE */ sm->OldLim = appelInfo.oldlim; sm->CAFlist = NULL; @@ -127,55 +114,59 @@ initHeap( sm ) initExtensions( sm ); #endif - if (SM_trace) { + if (RTSflags.GcFlags.trace) { fprintf(stderr, "APPEL(2s) Heap: 0x%lx .. 0x%lx\n", - (W_) heap_space, (W_) (heap_space - 1 + SM_word_heap_size)); + (W_) heap_space, (W_) (heap_space - 1 + RTSflags.GcFlags.heapSize)); fprintf(stderr, "Initial: space %ld, base 0x%lx, lim 0x%lx\n hp 0x%lx, hplim 0x%lx, free %lu\n", appelInfo.semi_space, (W_) appelInfo.space[appelInfo.semi_space].base, (W_) appelInfo.space[appelInfo.semi_space].lim, (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_)); } - return 0; + return rtsTrue; } /* So not forced 2s */ - appelInfo.newlim = heap_space + SM_word_heap_size - 1; - if (SM_alloc_size) { - appelInfo.newfixed = SM_alloc_size; - appelInfo.newmin = SM_alloc_size; - appelInfo.newbase = heap_space + SM_word_heap_size - appelInfo.newfixed; + appelInfo.newlim = heap_space + RTSflags.GcFlags.heapSize - 1; + if (RTSflags.GcFlags.allocAreaSizeGiven) { + appelInfo.newfixed = RTSflags.GcFlags.allocAreaSize; + appelInfo.newmin = RTSflags.GcFlags.allocAreaSize; + appelInfo.newbase = heap_space + RTSflags.GcFlags.heapSize - appelInfo.newfixed; } else { appelInfo.newfixed = 0; - appelInfo.newmin = SM_alloc_min; - appelInfo.newbase = heap_space + (SM_word_heap_size / 2); + appelInfo.newmin = RTSflags.GcFlags.minAllocAreaSize; + appelInfo.newbase = heap_space + (RTSflags.GcFlags.heapSize / 2); } appelInfo.oldbase = heap_space; appelInfo.oldlim = heap_space - 1; appelInfo.oldlast = heap_space - 1; - appelInfo.oldmax = heap_space - 1 + SM_word_heap_size - 2*appelInfo.newmin; + appelInfo.oldmax = heap_space - 1 + RTSflags.GcFlags.heapSize - 2*appelInfo.newmin; if (appelInfo.oldbase > appelInfo.oldmax) { fprintf(stderr, "Not enough heap for requested/minimum allocation area\n"); - return -1; + fprintf(stderr, "heap_space=%ld\n", heap_space); + fprintf(stderr, "heapSize=%ld\n", RTSflags.GcFlags.heapSize); + fprintf(stderr, "newmin=%ld\n", appelInfo.newmin); + return rtsFalse; } - appelInfo.bit_words = (SM_word_heap_size + BITS_IN(BitWord) - 1) / BITS_IN(BitWord); + appelInfo.bit_words = (RTSflags.GcFlags.heapSize + BITS_IN(BitWord) - 1) / BITS_IN(BitWord); appelInfo.bits = (BitWord *)(appelInfo.newlim) - appelInfo.bit_words; + if (appelInfo.bit_words > appelInfo.newmin) - appelInfo.oldmax = heap_space - 1 + SM_word_heap_size - appelInfo.bit_words - appelInfo.newmin; + appelInfo.oldmax = heap_space - 1 + RTSflags.GcFlags.heapSize - appelInfo.bit_words - appelInfo.newmin; - if (SM_major_gen_size) { - appelInfo.oldthresh = heap_space -1 + SM_major_gen_size; + if (RTSflags.GcFlags.specifiedOldGenSize) { + appelInfo.oldthresh = heap_space -1 + RTSflags.GcFlags.specifiedOldGenSize; if (appelInfo.oldthresh > appelInfo.oldmax) { fprintf(stderr, "Not enough heap for requested major resid size\n"); - return -1; + return rtsFalse; } } else { - appelInfo.oldthresh = heap_space + SM_word_heap_size * 2 / 3; /* Initial threshold -- 2/3rds */ + appelInfo.oldthresh = heap_space + RTSflags.GcFlags.heapSize * 2 / 3; /* Initial threshold -- 2/3rds */ if (appelInfo.oldthresh > appelInfo.oldmax) appelInfo.oldthresh = appelInfo.oldmax; } @@ -183,11 +174,10 @@ initHeap( sm ) sm->hp = hp_start = appelInfo.newbase - 1; sm->hplim = appelInfo.newlim; -#if defined(FORCE_GC) - if (force_GC && (sm->hplim > sm->hp + GCInterval)) { - sm->hplim = sm->hp + GCInterval; - } -#endif /* FORCE_GC */ + if (RTSflags.GcFlags.forceGC + && sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) { + sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval; + } sm->OldLim = appelInfo.oldlim; @@ -201,14 +191,9 @@ initHeap( sm ) appelInfo.PromMutables = 0; -#if defined(PROMOTION_DATA) /* For dead promote & premature promote data */ - prevbase = appelInfo.oldlim + 1; - thisbase = appelInfo.oldlim + 1; -#endif /* PROMOTION_DATA */ - - if (SM_trace) { + if (RTSflags.GcFlags.trace) { fprintf(stderr, "APPEL Heap: 0x%lx .. 0x%lx\n", - (W_) heap_space, (W_) (heap_space - 1 + SM_word_heap_size)); + (W_) heap_space, (W_) (heap_space - 1 + RTSflags.GcFlags.heapSize)); fprintf(stderr, "Initial: newbase 0x%lx newlim 0x%lx; base 0x%lx lim 0x%lx thresh 0x%lx max 0x%lx\n hp 0x%lx, hplim 0x%lx\n", (W_) appelInfo.newbase, (W_) appelInfo.newlim, (W_) appelInfo.oldbase, (W_) appelInfo.oldlim, @@ -216,17 +201,12 @@ initHeap( sm ) (W_) sm->hp, (W_) sm->hplim); } - return 0; + return rtsTrue; /* OK */ } static I_ -collect2s(reqsize, sm) - W_ reqsize; - smInfo *sm; +collect2s(W_ reqsize, smInfo *sm) { -#if defined(LIFE_PROFILE) - I_ next_interval; /* if doing profile */ -#endif I_ free_space, /* No of words of free space following GC */ alloc, /* Number of words allocated since last GC */ resident, /* Number of words remaining after GC */ @@ -236,15 +216,11 @@ collect2s(reqsize, sm) SAVE_REGS(&ScavRegDump); /* Save registers */ -#if defined(LIFE_PROFILE) - if (do_life_prof) { life_profile_setup(); } -#endif /* LIFE_PROFILE */ - -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) if (interval_expired) { heap_profile_setup(); } -#endif /* USE_COST_CENTRES */ +#endif /* PROFILING */ - if (SM_trace) + if (RTSflags.GcFlags.trace) fprintf(stderr, "Start: space %ld, base 0x%lx, lim 0x%lx\n hp 0x%lx, hplim 0x%lx, req %lu\n", appelInfo.semi_space, (W_) appelInfo.space[appelInfo.semi_space].base, @@ -291,33 +267,32 @@ collect2s(reqsize, sm) resident = sm->hp - (appelInfo.space[appelInfo.semi_space].base - 1); DO_MAX_RESIDENCY(resident); /* stats only */ - if (SM_alloc_size) { - sm->hplim = sm->hp + SM_alloc_size; + if (! RTSflags.GcFlags.allocAreaSizeGiven) { + sm->hplim = appelInfo.space[appelInfo.semi_space].lim; + free_space = sm->hplim - sm->hp; + } else { + sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize; if (sm->hplim > appelInfo.space[appelInfo.semi_space].lim) { free_space = 0; } else { - free_space = SM_alloc_size; + free_space = RTSflags.GcFlags.allocAreaSize; } - } else { - sm->hplim = appelInfo.space[appelInfo.semi_space].lim; - free_space = sm->hplim - sm->hp; } -#if defined(FORCE_GC) - if (force_GC && (sm->hplim > sm->hp + GCInterval)) { - sm->hplim = sm->hp + GCInterval; - } -#endif /* FORCE_GC */ + if (RTSflags.GcFlags.forceGC + && sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) { + sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval; + } - if (SM_stats_verbose) { + if (RTSflags.GcFlags.giveStats) { char comment_str[BIG_STRING_LEN]; #ifndef PAR - sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu 2s", - (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1), + sprintf(comment_str, "%4lu %4ld %3ld %3ld %6lu %6lu %6lu 2s", + (W_) (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1), bstk_roots, sm->rootno, caf_roots, extra_caf_words*sizeof(W_), - (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1)*sizeof(W_), - (SUBTRACT_B_STK(MAIN_SpB, stackInfo.botB) + 1)*sizeof(W_)); + (W_) (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1)*sizeof(W_), + (W_) (SUBTRACT_B_STK(MAIN_SpB, stackInfo.botB) + 1)*sizeof(W_)); #else /* ToDo: come up with some interesting statistics for the parallel world */ sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu 2s", @@ -325,40 +300,25 @@ collect2s(reqsize, sm) #endif -#if defined(LIFE_PROFILE) - if (do_life_prof) { - strcat(comment_str, " life"); - } -#endif -#if defined(USE_COST_CENTRES) - if (interval_expired) { - strcat(comment_str, " prof"); - } +#if defined(PROFILING) + if (interval_expired) { strcat(comment_str, " prof"); } #endif - stat_endGC(alloc, SM_word_heap_size, resident, comment_str); + stat_endGC(alloc, RTSflags.GcFlags.heapSize, resident, comment_str); } else { - stat_endGC(alloc, SM_word_heap_size, resident, ""); + stat_endGC(alloc, RTSflags.GcFlags.heapSize, resident, ""); } -#if defined(LIFE_PROFILE) - free_space = free_space / 2; /* space for HpLim incr */ - if (do_life_prof) { - next_interval = life_profile_done(alloc, reqsize); - free_space -= next_interval; /* ensure interval available */ - } -#endif /* LIFE_PROFILE */ - -#if defined(USE_COST_CENTRES) || defined(GUM) +#if defined(PROFILING) || defined(PAR) if (interval_expired) { -# if defined(USE_COST_CENTRES) +# if defined(PROFILING) heap_profile_done(); # endif report_cc_profiling(0 /*partial*/); } -#endif /* USE_COST_CENTRES */ +#endif /* PROFILING */ - if (SM_trace) + if (RTSflags.GcFlags.trace) fprintf(stderr, "Done: space %ld, base 0x%lx, lim 0x%lx\n hp 0x%lx, hplim 0x%lx, free %lu\n", appelInfo.semi_space, (W_) appelInfo.space[appelInfo.semi_space].base, @@ -371,6 +331,7 @@ collect2s(reqsize, sm) we just came from. */ { I_ old_space = NEXT_SEMI_SPACE(appelInfo.semi_space); + TrashMem(appelInfo.space[old_space].base, appelInfo.space[old_space].lim); TrashMem(sm->hp+1, sm->hplim); } @@ -378,21 +339,9 @@ collect2s(reqsize, sm) RESTORE_REGS(&ScavRegDump); /* Restore Registers */ - if ( (SM_alloc_min > free_space) || (reqsize > free_space) ) { + if (free_space < RTSflags.GcFlags.minAllocAreaSize || free_space < reqsize) return( GC_HARD_LIMIT_EXCEEDED ); /* Heap absolutely exhausted */ - } else { - -#if defined(LIFE_PROFILE) - /* ToDo: this may not be right now (WDP 94/11) */ - - /* space for HpLim incr */ - sm->hplim = sm->hp + ((sm->hplim - sm->hp) / 2); - if (do_life_prof) { - /* set hplim for next life profile */ - sm->hplim = sm->hp + next_interval; - } -#endif /* LIFE_PROFILE */ - + else { if (reqsize + sm->hardHpOverflowSize > free_space) { return( GC_SOFT_LIMIT_EXCEEDED ); /* Heap nearly exhausted */ } else { @@ -409,40 +358,29 @@ collectHeap(reqsize, sm, do_full_collection) rtsBool do_full_collection; /* do a major collection regardless? */ { I_ bstk_roots, caf_roots, mutable, old_words; - P_ oldptr, old_start, mutptr, prevmut; + P_ old_start, mutptr, prevmut; P_ CAFptr, prevCAF; - P_ next; I_ alloc, /* Number of words allocated since last GC */ resident; /* Number of words remaining after GC */ -#if defined(PROMOTION_DATA) /* For dead promote & premature promote data */ - I_ promote, /* Promoted this minor collection */ - dead_prom, /* Dead words promoted this minor */ - dead_prev; /* Promoted words that died since previos minor collection */ - I_ root; - P_ base[2]; -#endif /* PROMOTION_DATA */ - fflush(stdout); /* Flush stdout at start of GC */ - if (SM_force_gc == USE_2s) { + if (RTSflags.GcFlags.force2s) { return collect2s(reqsize, sm); } SAVE_REGS(&ScavRegDump); /* Save registers */ - if (SM_trace) + if (RTSflags.GcFlags.trace) fprintf(stderr, "Start: newbase 0x%lx, newlim 0x%lx\n hp 0x%lx, hplim 0x%lx, req %lu\n", (W_) appelInfo.newbase, (W_) appelInfo.newlim, (W_) sm->hp, (W_) sm->hplim, reqsize * sizeof(W_)); alloc = sm->hp - hp_start; stat_startGC(alloc); -#ifdef FORCE_GC - alloc_since_last_major_GC += sm->hplim - hp_start; + allocd_since_last_major_GC += sm->hplim - hp_start; /* this is indeed supposed to be less precise than alloc above */ -#endif /* FORCE_GC */ /* COPYING COLLECTION */ @@ -481,6 +419,7 @@ collectHeap(reqsize, sm, do_full_collection) while ( mutptr ) { /* Scavenge the OldMutable */ + P_ orig_mutptr = mutptr; P_ info = (P_) INFO_PTR(mutptr); StgScavPtr scav_code = SCAV_CODE(info); Scav = mutptr; @@ -496,6 +435,7 @@ collectHeap(reqsize, sm, do_full_collection) prevmut = mutptr; mutptr = (P_) MUT_LINK(mutptr); } + mutable++; } @@ -559,11 +499,11 @@ collectHeap(reqsize, sm, do_full_collection) resident = appelInfo.oldlim - sm->OldLim; /* DONT_DO_MAX_RESIDENCY -- it is just a minor collection */ - if (SM_stats_verbose) { + if (RTSflags.GcFlags.giveStats) { char minor_str[BIG_STRING_LEN]; #ifndef PAR - sprintf(minor_str, "%4u %4ld %3ld %3ld %4ld Minor", - (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1), + sprintf(minor_str, "%4lu %4ld %3ld %3ld %4ld Minor", + (W_) (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1), bstk_roots, sm->rootno, caf_roots, mutable); /* oldnew_roots, old_words */ #else /* ToDo: come up with some interesting statistics for the parallel world */ @@ -577,41 +517,26 @@ collectHeap(reqsize, sm, do_full_collection) /* Note: if do_full_collection we want to force a full collection. [ADR] */ -#ifdef FORCE_GC - if (force_GC && (alloc_since_last_major_GC >= GCInterval)) { - do_full_collection = 1; + if (RTSflags.GcFlags.forceGC + && allocd_since_last_major_GC >= RTSflags.GcFlags.forcingInterval) { + do_full_collection = 1; } -#endif /* FORCE_GC */ - -#if defined(PROMOTION_DATA) /* For dead promote & premature promote data major required */ - - if (! SM_stats_verbose && - (appelInfo.oldlim < appelInfo.oldthresh) && - (reqsize + sm->hardHpOverflowSize <= appelInfo.newlim - appelInfo.newbase) && - (! do_full_collection) ) { - -#else /* ! PROMOTION_DATA */ if ((appelInfo.oldlim < appelInfo.oldthresh) && (reqsize + sm->hardHpOverflowSize <= appelInfo.newlim - appelInfo.newbase) && (! do_full_collection) ) { -#endif /* ! PROMOTION_DATA */ - sm->hp = hp_start = appelInfo.newbase - 1; sm->hplim = appelInfo.newlim; -#if defined(FORCE_GC) - if (force_GC && - (alloc_since_last_major_GC + (sm->hplim - hp_start) > GCInterval)) - { - sm->hplim = sm->hp + (GCInterval - alloc_since_last_major_GC); + if (RTSflags.GcFlags.forceGC + && (allocd_since_last_major_GC + (sm->hplim - hp_start) > RTSflags.GcFlags.forcingInterval)) { + sm->hplim = sm->hp + (RTSflags.GcFlags.forcingInterval - allocd_since_last_major_GC); } -#endif /* FORCE_GC */ sm->OldLim = appelInfo.oldlim; - if (SM_trace) { + if (RTSflags.GcFlags.trace) { fprintf(stderr, "Minor: newbase 0x%lx newlim 0x%lx; base 0x%lx lim 0x%lx thresh 0x%lx max 0x%lx\n hp 0x%lx, hplim 0x%lx, free %lu\n", (W_) appelInfo.newbase, (W_) appelInfo.newlim, (W_) appelInfo.oldbase, (W_) appelInfo.oldlim, @@ -632,20 +557,12 @@ collectHeap(reqsize, sm, do_full_collection) DEBUG_STRING("Major Collection Required"); -#ifdef FORCE_GC - alloc_since_last_major_GC = 0; -#endif /* FORCE_GC */ + allocd_since_last_major_GC = 0; stat_startGC(0); alloc = (appelInfo.oldlim - appelInfo.oldbase) + 1; -#if defined(PROMOTION_DATA) /* For dead promote & premature promote data */ - if (SM_stats_verbose) { - promote = appelInfo.oldlim - thisbase + 1; - } -#endif /* PROMOTION_DATA */ - appelInfo.bit_words = (alloc + BITS_IN(BitWord) - 1) / BITS_IN(BitWord); appelInfo.bits = (BitWord *)(appelInfo.newlim) - appelInfo.bit_words; /* For some reason, this doesn't seem to use the last @@ -691,63 +608,6 @@ collectHeap(reqsize, sm, do_full_collection) LinkCAFs(appelInfo.OldCAFlist); -#if defined(PROMOTION_DATA) /* For dead promote & premature promote data */ - /* What does this have to do with CAFs? -- JSM */ - if (SM_stats_verbose) { - base[0] = thisbase; - base[1] = prevbase; - - if (SM_trace) { - fprintf(stderr, "Promote Bases: lim 0x%lx this 0x%lx prev 0x%lx Actual: ", - appelInfo.oldlim + 1, thisbase, prevbase); - } - - /* search for first live closure for thisbase & prevbase */ - for (root = 0; root < 2; root++) { - P_ baseptr, search, scan_w_start; - I_ prev_words, bit_words, bit_rem; - BitWord *bit_array_ptr, *bit_array_end; - - baseptr = base[root]; - prev_words = (baseptr - appelInfo.oldbase); - bit_words = prev_words / BITS_IN(BitWord); - bit_rem = prev_words & (BITS_IN(BitWord) - 1); - - bit_array_ptr = appelInfo.bits + bit_words; - bit_array_end = appelInfo.bits + appelInfo.bit_words; - scan_w_start = baseptr - bit_rem; - - baseptr = 0; - while (bit_array_ptr < bit_array_end && !baseptr) { - BitWord w = *(bit_array_ptr++); - search = scan_w_start; - if (bit_rem) { - search += bit_rem; - w >>= bit_rem; - bit_rem = 0; - } - while (w && !baseptr) { - if (w & 0x1) { /* bit set -- found first closure */ - baseptr = search; - } else { - search++; /* look at next bit */ - w >>= 1; - } - } - scan_w_start += BITS_IN(BitWord); - } - if (SM_trace) { - fprintf(stderr, "0x%lx%s", baseptr, root == 2 ? "\n" : " "); - } - - base[root] = baseptr; - if (baseptr) { - LINK_LOCATION_TO_CLOSURE(base + root); - } - } - } -#endif /* PROMOTION_DATA */ - LinkRoots( sm->roots, sm->rootno ); #ifdef CONCURRENT LinkSparks(); @@ -785,7 +645,7 @@ collectHeap(reqsize, sm, do_full_collection) /* set major threshold, if not fixed */ /* next major collection when old gen occupies 2/3rds of the free space or exceeds oldmax */ - if (! SM_major_gen_size) { + if (! RTSflags.GcFlags.specifiedOldGenSize) { appelInfo.oldthresh = appelInfo.oldlim + (appelInfo.newlim - appelInfo.oldlim) * 2 / 3; if (appelInfo.oldthresh > appelInfo.oldmax) appelInfo.oldthresh = appelInfo.oldmax; @@ -794,70 +654,37 @@ collectHeap(reqsize, sm, do_full_collection) sm->hp = hp_start = appelInfo.newbase - 1; sm->hplim = appelInfo.newlim; -#if defined(FORCE_GC) - if (force_GC && (sm->hplim > sm->hp + GCInterval)) { - sm->hplim = sm->hp + GCInterval; - } -#endif /* FORCE_GC */ + if (RTSflags.GcFlags.forceGC + && sm->hplim > sm->hp + RTSflags.GcFlags.forcingInterval) { + sm->hplim = sm->hp + RTSflags.GcFlags.forcingInterval; + } sm->OldLim = appelInfo.oldlim; -#if defined(PROMOTION_DATA) /* For dead promote & premature promote data */ - if (SM_stats_verbose) { - /* restore moved thisbase & prevbase */ - thisbase = base[0] ? base[0] : appelInfo.oldlim + 1; - prevbase = base[1] ? base[1] : appelInfo.oldlim + 1; - - /* here are the numbers we want */ - dead_prom = promote - (appelInfo.oldlim + 1 - thisbase); - dead_prev = prev_prom - (thisbase - prevbase) - dead_prev_prom; - - if (SM_trace) { - fprintf(stderr, "Collect Bases: lim 0x%lx this 0x%lx prev 0x%lx\n", - appelInfo.oldlim + 1, thisbase, prevbase); - fprintf(stderr, "Promoted: %ld Dead: this %ld prev %ld + %ld\n", - promote, dead_prom, dead_prev_prom, dead_prev); - } - - /* save values for next collection */ - prev_prom = promote; - dead_prev_prom = dead_prom; - prevbase = thisbase; - thisbase = appelInfo.oldlim + 1; - } -#endif /* PROMOTION_DATA */ - #ifdef HAVE_VADVISE vadvise(VA_NORM); #endif - if (SM_stats_verbose) { + if (RTSflags.GcFlags.giveStats) { char major_str[BIG_STRING_LEN]; #ifndef PAR - sprintf(major_str, "%4u %4ld %3ld %3ld %4d %4d *Major* %4.1f%%", - (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1), + sprintf(major_str, "%4lu %4ld %3ld %3ld %4d %4d *Major* %4.1f%%", + (W_) (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1), bstk_roots, sm->rootno, appelInfo.OldCAFno, - 0, 0, resident / (StgFloat) SM_word_heap_size * 100); + 0, 0, resident / (StgDouble) RTSflags.GcFlags.heapSize * 100); #else /* ToDo: come up with some interesting statistics for the parallel world */ sprintf(major_str, "%4u %4ld %3ld %3ld %4d %4d *Major* %4.1f%%", 0, 0L, sm->rootno, appelInfo.OldCAFno, 0, 0, - resident / (StgFloat) SM_word_heap_size * 100); + resident / (StgDouble) RTSflags.GcFlags.heapSize * 100); #endif -#if defined(PROMOTION_DATA) /* For dead promote & premature promote data */ - { char *promote_str[BIG_STRING_LEN]; - sprintf(promote_str, " %6ld %6ld", dead_prom*sizeof(W_), dead_prev*sizeof(W_)); - strcat(major_str, promote_str); - } -#endif /* PROMOTION_DATA */ - stat_endGC(0, alloc, resident, major_str); } else { stat_endGC(0, alloc, resident, ""); } - if (SM_trace) { + if (RTSflags.GcFlags.trace) { fprintf(stderr, "Major: newbase 0x%lx newlim 0x%lx; base 0x%lx lim 0x%lx thresh 0x%lx max 0x%lx\n hp 0x%lx, hplim 0x%lx, free %lu\n", (W_) appelInfo.newbase, (W_) appelInfo.newlim, (W_) appelInfo.oldbase, (W_) appelInfo.oldlim, diff --git a/ghc/runtime/storage/SMcheck.lc b/ghc/runtime/storage/SMcheck.lc index 1318021f97..ba9f4138d2 100644 --- a/ghc/runtime/storage/SMcheck.lc +++ b/ghc/runtime/storage/SMcheck.lc @@ -14,7 +14,7 @@ required if we're tail-jumping (no mini-interpreter). #include "SMinternal.h" #define isHeapPtr(p) \ - ((p) >= heap_space && (p) < heap_space + SM_word_heap_size) + ((p) >= heap_space && (p) < heap_space + RTSflags.GcFlags.heapSize) #if nextstep2_TARGET_OS || nextstep3_TARGET_OS /* ToDo: use END_BY_FUNNY_MEANS or something */ #define validInfoPtr(i) \ @@ -48,7 +48,7 @@ required if we're tail-jumping (no mini-interpreter). /* Two cases needed, depending on whether the 2-space GC is forced SLPJ 17 June 93 */ #define validHeapPtr(p) \ - (SM_force_gc == USE_2s ? \ + (RTSflags.GcFlags.force2s ? \ ((p) >= appelInfo.space[appelInfo.semi_space].base && \ (p) <= appelInfo.space[appelInfo.semi_space].lim) : \ (((p) >= appelInfo.oldbase && (p) <= appelInfo.oldlim) || \ diff --git a/ghc/runtime/storage/SMcompacting.lc b/ghc/runtime/storage/SMcompacting.lc index 60942d3b41..96c7c0e31b 100644 --- a/ghc/runtime/storage/SMcompacting.lc +++ b/ghc/runtime/storage/SMcompacting.lc @@ -77,9 +77,7 @@ LinkSparks(STG_NO_ARGS) #ifdef PAR void -LinkLiveGAs(base, bits) -P_ base; -BitWord *bits; +LinkLiveGAs(P_ base, BitWord *bits) { GALA *gala; GALA *next; @@ -97,7 +95,7 @@ BitWord *bits; prev = gala; } else { /* Since we have all of the weight, this GA is no longer needed */ - W_ pga = PACK_GA(thisPE, gala->ga.loc.gc.slot); + W_ pga = PackGA(thisPE, gala->ga.loc.gc.slot); #ifdef FREE_DEBUG fprintf(stderr, "Freeing slot %d\n", gala->ga.loc.gc.slot); @@ -124,8 +122,7 @@ BitWord *bits; bit = 1L << (_hp_word & (BITS_IN(BitWord) - 1)); if (!(bits[bit_index] & bit)) { int pe = taskIDtoPE(gala->ga.loc.gc.gtid); - W_ pga = PACK_GA(pe, gala->ga.loc.gc.slot); - int i; + W_ pga = PackGA(pe, gala->ga.loc.gc.slot); (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala); freeRemoteGA(pe, &(gala->ga)); @@ -182,14 +179,12 @@ P_ botB; /* stackB points to topmost update frame */ DEBUG_STRING("Linking B Stack:"); for (updateFramePtr = stackB; - SUBTRACT_B_STK(updateFramePtr, botB) > 0; - /* re-initialiser given explicitly */ ) { + SUBTRACT_B_STK(updateFramePtr, botB) > 0; + updateFramePtr = GRAB_SuB(updateFramePtr)) { P_ updateClosurePtr = updateFramePtr + BREL(UF_UPDATEE); LINK_LOCATION_TO_CLOSURE(updateClosurePtr); - - updateFramePtr = GRAB_SuB(updateFramePtr); } } #endif /* not PAR */ @@ -197,8 +192,7 @@ P_ botB; /* stackB points to topmost update frame */ \begin{code} I_ -CountCAFs(CAFlist) -P_ CAFlist; +CountCAFs(P_ CAFlist) { I_ caf_no = 0; @@ -211,8 +205,7 @@ P_ CAFlist; \begin{code} void -LinkCAFs(CAFlist) -P_ CAFlist; +LinkCAFs(P_ CAFlist) { DEBUG_STRING("Linking CAF Ptr Locations:"); while(CAFlist != NULL) { @@ -222,13 +215,5 @@ P_ CAFlist; } } -\end{code} - -\begin{code} - -#ifdef PAR - -#endif /* PAR */ - #endif /* defined(_INFO_COMPACTING) */ \end{code} diff --git a/ghc/runtime/storage/SMcompacting.lh b/ghc/runtime/storage/SMcompacting.lh index 8740253057..fdb5b55c30 100644 --- a/ghc/runtime/storage/SMcompacting.lh +++ b/ghc/runtime/storage/SMcompacting.lh @@ -1,11 +1,14 @@ \section[SMcompacting-header]{Header file for SMcompacting} \begin{code} -extern void LinkRoots PROTO((P_ roots[], I_ rootno)); -extern void LinkAStack PROTO((PP_ stackA, PP_ botA)); -extern void LinkBStack PROTO((P_ stackB, P_ botB)); -extern I_ CountCAFs PROTO((P_ CAFlist)); +void LinkRoots PROTO((P_ roots[], I_ rootno)); +void LinkAStack PROTO((PP_ stackA, PP_ botA)); +void LinkBStack PROTO((P_ stackB, P_ botB)); +I_ CountCAFs PROTO((P_ CAFlist)); -extern void LinkCAFs PROTO((P_ CAFlist)); +void LinkCAFs PROTO((P_ CAFlist)); +#ifdef CONCURRENT +void LinkSparks(STG_NO_ARGS); +#endif \end{code} diff --git a/ghc/runtime/storage/SMcopying.lc b/ghc/runtime/storage/SMcopying.lc index 98b1b79a8d..736663ab2e 100644 --- a/ghc/runtime/storage/SMcopying.lc +++ b/ghc/runtime/storage/SMcopying.lc @@ -53,8 +53,7 @@ do { \ \begin{code} void -SetCAFInfoTables( CAFlist ) - P_ CAFlist; +SetCAFInfoTables(P_ CAFlist) { P_ CAFptr; @@ -70,9 +69,7 @@ SetCAFInfoTables( CAFlist ) \begin{code} void -EvacuateRoots( roots, rootno ) - P_ roots[]; - I_ rootno; +EvacuateRoots(P_ roots[], I_ rootno) { I_ root; @@ -109,9 +106,7 @@ don't have a single main stack. \begin{code} #ifndef PAR void -EvacuateAStack( stackA, botA ) - PP_ stackA; - PP_ botA; /* botA points to bottom-most word */ +EvacuateAStack(PP_ stackA, PP_ botA /* botA points to bottom-most word */) { PP_ stackptr; @@ -165,17 +160,15 @@ EvacuateBStack( stackB, botB, roots ) #endif /* not PAR */ \end{code} -When we do a copying collection, we want to evacuate all of the local entries -in the GALA table for which there are outstanding remote pointers (i.e. for -which the weight is not MAX_GA_WEIGHT.) +When we do a copying collection, we want to evacuate all of the local +entries in the GALA table for which there are outstanding remote +pointers (i.e. for which the weight is not MAX_GA_WEIGHT.) \begin{code} - #ifdef PAR void -EvacuateLocalGAs(full) -rtsBool full; +EvacuateLocalGAs(rtsBool full) { GALA *gala; GALA *next; @@ -196,7 +189,7 @@ rtsBool full; prev = gala; } else { /* Since we have all of the weight, this GA is no longer needed */ - W_ pga = PACK_GA(thisPE, gala->ga.loc.gc.slot); + W_ pga = PackGA(thisPE, gala->ga.loc.gc.slot); #ifdef FREE_DEBUG fprintf(stderr, "Freeing slot %d\n", gala->ga.loc.gc.slot); @@ -222,8 +215,7 @@ rtsBool full; EXTDATA_RO(Forward_Ref_info); void -RebuildGAtables(full) -rtsBool full; +RebuildGAtables(rtsBool full) { GALA *gala; GALA *next; @@ -259,8 +251,7 @@ rtsBool full; #endif if (INFO_PTR(closure) != (W_) Forward_Ref_info) { int pe = taskIDtoPE(gala->ga.loc.gc.gtid); - W_ pga = PACK_GA(pe, gala->ga.loc.gc.slot); - int i; + W_ pga = PackGA(pe, gala->ga.loc.gc.slot); (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala); freeRemoteGA(pe, &(gala->ga)); @@ -299,7 +290,7 @@ rtsBool full; \begin{code} void -Scavenge() +Scavenge(void) { DEBUG_SCAN("Scavenging Start", Scav, "ToHp", ToHp); while (Scav <= ToHp) (SCAV_CODE(INFO_PTR(Scav)))(); @@ -343,15 +334,12 @@ EvacAndScavengeCAFs( CAFlist, extra_words, roots ) CAFptr != NULL; CAFptr = (P_) IND_CLOSURE_LINK(CAFptr)) { - EVACUATE_CLOSURE(CAFptr); /* evac & upd OR return */ - caf_roots++; - - DEBUG_SCAN("Scavenging CAF", Scav, "ToHp", ToHp); - while (Scav <= ToHp) (SCAV_CODE(INFO_PTR(Scav)))(); - DEBUG_SCAN("Scavenging End", Scav, "ToHp", ToHp); + EVACUATE_CLOSURE(CAFptr); /* evac & upd OR return */ + caf_roots++; - /* this_extra_caf_words = ToHp - this_caf_start; */ - /* ToDo: Report individual CAF space */ + DEBUG_SCAN("Scavenging CAF", Scav, "ToHp", ToHp); + while (Scav <= ToHp) (SCAV_CODE(INFO_PTR(Scav)))(); + DEBUG_SCAN("Scavenging End", Scav, "ToHp", ToHp); } *extra_words = ToHp - caf_start; *roots = caf_roots; diff --git a/ghc/runtime/storage/SMcopying.lh b/ghc/runtime/storage/SMcopying.lh index f2fbf140d7..9587f7286b 100644 --- a/ghc/runtime/storage/SMcopying.lh +++ b/ghc/runtime/storage/SMcopying.lh @@ -1,11 +1,15 @@ \section[SMcopying-header]{Header file for SMcopying} \begin{code} -extern void SetCAFInfoTables PROTO(( P_ CAFlist )); -extern void EvacuateRoots PROTO(( P_ roots[], I_ rootno )); -extern void EvacuateAStack PROTO(( PP_ stackA, PP_ botA )); -extern void EvacuateBStack PROTO(( P_ stackB, P_ botB, I_ *roots )); -extern void Scavenge PROTO(()); +void SetCAFInfoTables PROTO(( P_ CAFlist )); +void EvacuateRoots PROTO(( P_ roots[], I_ rootno )); +void EvacuateAStack PROTO(( PP_ stackA, PP_ botA )); +void EvacuateBStack PROTO(( P_ stackB, P_ botB, I_ *roots )); +void Scavenge (STG_NO_ARGS); + +#ifdef CONCURRENT +void EvacuateSparks(STG_NO_ARGS); +#endif #ifdef GCdu extern void EvacuateCAFs PROTO(( P_ CAFlist )); diff --git a/ghc/runtime/storage/SMdu.lc b/ghc/runtime/storage/SMdu.lc index abd39230f6..3dbbd3946a 100644 --- a/ghc/runtime/storage/SMdu.lc +++ b/ghc/runtime/storage/SMdu.lc @@ -34,22 +34,22 @@ P_ heap_space = 0; /* Address of first word of slab P_ hp_start; /* Value of Hp when reduction was resumed */ -I_ -initHeap( sm ) - smInfo *sm; +rtsBool +initHeap(smInfo * sm) { if (heap_space == 0) { /* allocates if it doesn't already exist */ - I_ semispaceSize = SM_word_heap_size / 2; + I_ semispaceSize = RTSflags.GcFlags.heapSize / 2; /* Allocate the roots space */ - sm->roots = (P_ *) xmalloc( SM_MAXROOTS * sizeof(W_) ); + sm->roots = (P_ *) stgMallocWords(SM_MAXROOTS, "initHeap (roots)"); /* Allocate the heap */ - heap_space = (P_) xmalloc((SM_word_heap_size + EXTRA_HEAP_WORDS) * sizeof(W_)); + heap_space = (P_) stgMallocWords(RTSflags.GcFlags.heapSize + EXTRA_HEAP_WORDS, + "initHeap (heap)"); dualmodeInfo.modeinfo[TWO_SPACE_BOT].heap_words = - dualmodeInfo.modeinfo[TWO_SPACE_TOP].heap_words = SM_word_heap_size; + dualmodeInfo.modeinfo[TWO_SPACE_TOP].heap_words = RTSflags.GcFlags.heapSize; dualmodeInfo.modeinfo[TWO_SPACE_BOT].base = HEAP_FRAME_BASE(heap_space, semispaceSize); @@ -60,15 +60,15 @@ initHeap( sm ) dualmodeInfo.modeinfo[TWO_SPACE_TOP].lim = HEAP_FRAME_LIMIT(heap_space + semispaceSize, semispaceSize); - dualmodeInfo.bit_words = (SM_word_heap_size + BITS_IN(BitWord) - 1) / BITS_IN(BitWord); - dualmodeInfo.bits = (BitWord *)(heap_space + SM_word_heap_size) - dualmodeInfo.bit_words; + dualmodeInfo.bit_words = (RTSflags.GcFlags.heapSize + BITS_IN(BitWord) - 1) / BITS_IN(BitWord); + dualmodeInfo.bits = (BitWord *)(heap_space + RTSflags.GcFlags.heapSize) - dualmodeInfo.bit_words; dualmodeInfo.modeinfo[COMPACTING].heap_words = - SM_word_heap_size - dualmodeInfo.bit_words; + RTSflags.GcFlags.heapSize - dualmodeInfo.bit_words; dualmodeInfo.modeinfo[COMPACTING].base = - HEAP_FRAME_BASE(heap_space, SM_word_heap_size - dualmodeInfo.bit_words); + HEAP_FRAME_BASE(heap_space, RTSflags.GcFlags.heapSize - dualmodeInfo.bit_words); dualmodeInfo.modeinfo[COMPACTING].lim = - HEAP_FRAME_LIMIT(heap_space, SM_word_heap_size - dualmodeInfo.bit_words); + HEAP_FRAME_LIMIT(heap_space, RTSflags.GcFlags.heapSize - dualmodeInfo.bit_words); stat_init("DUALMODE", "Collection", " Mode "); } @@ -77,11 +77,12 @@ initHeap( sm ) if (SM_alloc_size) { sm->hplim = sm->hp + SM_alloc_size; - SM_alloc_min = 0; /* No min; alloc size specified */ + + RTSflags.GcFlags.minAllocAreaSize = 0; /* specified size takes precedence */ if (sm->hplim > dualmodeInfo.modeinfo[dualmodeInfo.mode].lim) { fprintf(stderr, "Not enough heap for requested alloc size\n"); - return -1; + return rtsFalse; } } else { sm->hplim = dualmodeInfo.modeinfo[dualmodeInfo.mode].lim; @@ -93,7 +94,7 @@ initHeap( sm ) initExtensions( sm ); #endif /* !PAR */ - if (SM_trace) { + if (RTSflags.GcFlags.trace) { fprintf(stderr, "DUALMODE Heap: TS base, TS lim, TS base, TS lim, CM base, CM lim, CM bits, bit words\n 0x%lx, 0x%lx, 0x%lx, 0x%lx, 0x%lx, 0x%lx, 0x%lx, 0x%lx\n", (W_) dualmodeInfo.modeinfo[TWO_SPACE_BOT].base, (W_) dualmodeInfo.modeinfo[TWO_SPACE_BOT].lim, @@ -109,7 +110,7 @@ initHeap( sm ) (W_) sm->hp, (W_) sm->hplim, (W_) (sm->hplim - sm->hp) * sizeof(W_)); } - return 0; + return rtsTrue; /* OK */ } I_ @@ -129,7 +130,7 @@ collectHeap(reqsize, sm, do_full_collection) fflush(stdout); /* Flush stdout at start of GC */ SAVE_REGS(&ScavRegDump); /* Save registers */ - if (SM_trace) + if (RTSflags.GcFlags.trace) fprintf(stderr, "DUALMODE Start: mode %ld, base 0x%lx, lim 0x%lx\n hp 0x%lx, hplim 0x%lx, req %lu\n", dualmodeInfo.mode, (W_) dualmodeInfo.modeinfo[dualmodeInfo.mode].base, @@ -227,7 +228,7 @@ collectHeap(reqsize, sm, do_full_collection) /* Use residency to determine if a change in mode is required */ resident = sm->hp - (dualmodeInfo.modeinfo[dualmodeInfo.mode].base - 1); - residency = resident / (StgFloat) SM_word_heap_size; + residency = resident / (StgFloat) RTSflags.GcFlags.heapSize; DO_MAX_RESIDENCY(resident); /* stats only */ if ((start_mode == TWO_SPACE_TOP) && @@ -264,7 +265,7 @@ collectHeap(reqsize, sm, do_full_collection) stat_endGC(alloc, dualmodeInfo.modeinfo[start_mode].heap_words, resident, dualmodeInfo.modeinfo[start_mode].name); - if (SM_trace) + if (RTSflags.GcFlags.trace) fprintf(stderr, "DUALMODE Done: mode %ld, base 0x%lx, lim 0x%lx\n hp 0x%lx, hplim 0x%lx, free %lu\n", dualmodeInfo.mode, (W_) dualmodeInfo.modeinfo[dualmodeInfo.mode].base, @@ -279,7 +280,7 @@ collectHeap(reqsize, sm, do_full_collection) RESTORE_REGS(&ScavRegDump); /* Restore Registers */ - if ((SM_alloc_min > free_space) || (reqsize > free_space)) + if (free_space < RTSflags.GcFlags.minAllocAreaSize || free_space < reqsize) return GC_HARD_LIMIT_EXCEEDED; /* Heap exhausted */ else return GC_SUCCESS; /* Heap OK */ diff --git a/ghc/runtime/storage/SMevac.lc b/ghc/runtime/storage/SMevac.lc index 0eab98b906..6cf5e80c14 100644 --- a/ghc/runtime/storage/SMevac.lc +++ b/ghc/runtime/storage/SMevac.lc @@ -51,106 +51,106 @@ See SMscav.lhc for calling convention documentation. /*** DEBUGGING MACROS ***/ -#if defined(_GC_DEBUG) +#if defined(DEBUG) #define DEBUG_EVAC(sizevar) \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Evac: 0x%lx -> 0x%lx, info 0x%lx, size %ld\n", \ evac, ToHp, INFO_PTR(evac), sizevar) #define DEBUG_EVAC_DYN \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Evac: 0x%lx -> 0x%lx, Dyn info 0x%lx, size %lu\n", \ evac, ToHp, INFO_PTR(evac), DYN_CLOSURE_SIZE(evac)) #define DEBUG_EVAC_TUPLE \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Evac: 0x%lx -> 0x%lx, Tuple info 0x%lx, size %lu\n", \ evac, ToHp, INFO_PTR(evac), TUPLE_CLOSURE_SIZE(evac)) #define DEBUG_EVAC_MUTUPLE \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Evac: 0x%lx -> 0x%lx, MuTuple info 0x%lx, size %lu\n", \ evac, ToHp, INFO_PTR(evac), MUTUPLE_CLOSURE_SIZE(evac)) #define DEBUG_EVAC_DATA \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Evac: 0x%lx -> 0x%lx, Data info 0x%lx, size %lu\n", \ evac, ToHp, INFO_PTR(evac), DATA_CLOSURE_SIZE(evac)) #define DEBUG_EVAC_BH(sizevar) \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Evac: 0x%lx -> 0x%lx, BH info 0x%lx, size %ld\n", \ evac, ToHp, INFO_PTR(evac), sizevar) #define DEBUG_EVAC_FORWARD \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Evac: Forward 0x%lx -> 0x%lx, info 0x%lx\n", \ evac, FORWARD_ADDRESS(evac), INFO_PTR(evac)) #define DEBUG_EVAC_IND1 \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Evac: Indirection 0x%lx -> Evac(0x%lx), info 0x%lx\n", \ evac, IND_CLOSURE_PTR(evac), INFO_PTR(evac)) #define DEBUG_EVAC_IND2 \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Evac: Indirection Done -> 0x%lx\n", evac) #define DEBUG_EVAC_PERM_IND \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Evac: Permanent Indirection 0x%lx -> Evac(0x%lx), info 0x%lx\n", \ evac, IND_CLOSURE_PTR(evac), INFO_PTR(evac)) #define DEBUG_EVAC_CAF_EVAC1 \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Evac: Caf 0x%lx -> Evac(0x%lx), info 0x%lx\n", \ evac, IND_CLOSURE_PTR(evac), INFO_PTR(evac)) #define DEBUG_EVAC_CAF_EVAC2 \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Evac: Caf Done -> 0x%lx\n", evac) #define DEBUG_EVAC_CAF_RET \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Evac: Caf 0x%lx -> 0x%lx, info 0x%lx\n", \ evac, IND_CLOSURE_PTR(evac), INFO_PTR(evac)) #define DEBUG_EVAC_STAT \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Evac: Static 0x%lx -> 0x%lx, info 0x%lx\n", \ evac, evac, INFO_PTR(evac)) #define DEBUG_EVAC_CONST \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Evac: Const 0x%lx -> 0x%lx, info 0x%lx\n", \ evac, CONST_STATIC_CLOSURE(INFO_PTR(evac)), INFO_PTR(evac)) #define DEBUG_EVAC_CHARLIKE \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Evac: CharLike (%lx) 0x%lx -> 0x%lx, info 0x%lx\n", \ evac, CHARLIKE_VALUE(evac), CHARLIKE_CLOSURE(CHARLIKE_VALUE(evac)), INFO_PTR(evac)) #define DEBUG_EVAC_INTLIKE_TO_STATIC \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Evac: IntLike to Static (%ld) 0x%lx -> 0x%lx, info 0x%lx\n", \ INTLIKE_VALUE(evac), evac, INTLIKE_CLOSURE(INTLIKE_VALUE(evac)), INFO_PTR(evac)) #define DEBUG_EVAC_TO_OLD \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Old ") #define DEBUG_EVAC_TO_NEW \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "New ") #define DEBUG_EVAC_OLD_TO_NEW(oldind, evac, new) \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, " OldRoot: 0x%lx -> Old 0x%lx (-> New 0x%lx)\n", \ evac, oldind, newevac) #define DEBUG_EVAC_OLDROOT_FORWARD \ - if (SM_trace & 2) { \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) { \ fprintf(stderr, "Evac: OldRoot Forward 0x%lx -> Old 0x%lx ", evac, FORWARD_ADDRESS(evac)); \ if (! InOldGen(Scav)) fprintf(stderr, "-> New 0x%lx ", IND_CLOSURE_PTR(FORWARD_ADDRESS(evac))); \ fprintf(stderr, "info 0x%lx\n", INFO_PTR(evac)); \ @@ -158,23 +158,23 @@ See SMscav.lhc for calling convention documentation. #ifdef CONCURRENT #define DEBUG_EVAC_BQ \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \ fprintf(stderr, "Evac: 0x%lx -> 0x%lx, BQ info 0x%lx, size %lu\n", \ evac, ToHp, INFO_PTR(evac), BQ_CLOSURE_SIZE(evac)) #define DEBUG_EVAC_TSO(size) \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \ fprintf(stderr, "Evac TSO: 0x%lx -> 0x%lx, size %ld\n", \ evac, ToHp, size) #define DEBUG_EVAC_STKO(a,b) \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \ fprintf(stderr, "Evac StkO: 0x%lx -> 0x%lx, size %ld (A), %ld (B)\n", \ evac, ToHp, a, b) # ifdef PAR # define DEBUG_EVAC_BF \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \ fprintf(stderr, "Evac: 0x%lx -> 0x%lx, BF info 0x%lx, size %lu\n", \ evac, ToHp, INFO_PTR(evac), BF_CLOSURE_SIZE(dummy)) # endif @@ -214,7 +214,7 @@ See SMscav.lhc for calling convention documentation. # endif #endif -#endif /* not _GC_DEBUG */ +#endif /* not DEBUG */ #if defined(GCgn) @@ -285,9 +285,7 @@ extern P_ _Evacuate_Old_to_New(); FORWARD_ADDRESS(closure) = (W_)(forw) -P_ -_Evacuate_Old_Forward_Ref(evac) -P_ evac; +EVAC_FN(Old_Forward_Ref) { /* Forward ref to old generation -- just return */ DEBUG_EVAC_FORWARD; @@ -296,9 +294,7 @@ P_ evac; return(evac); } -P_ -_Evacuate_New_Forward_Ref(evac) -P_ evac; +EVAC_FN(New_Forward_Ref) { /* Forward ref to new generation -- check scavenged from the old gen */ DEBUG_EVAC_FORWARD; @@ -311,9 +307,7 @@ P_ evac; return(evac); } -P_ -_Evacuate_OldRoot_Forward(evac) -P_ evac; +EVAC_FN(OldRoot_Forward) { /* Forward ref to old generation root -- return old root or new gen closure */ DEBUG_EVAC_OLDROOT_FORWARD; @@ -353,11 +347,11 @@ P_ newevac, evac; DEBUG_EVAC_OLD_TO_NEW(oldind, evac, newevac); - INFO_PTR(evac) = (W_) OldRoot_Forward_Ref_info; - FORWARD_ADDRESS(evac) = (W_)oldind; + INFO_PTR(evac) = (W_) OldRoot_Forward_Ref_info; + FORWARD_ADDRESS(evac) = (W_)oldind; - INFO_PTR(oldind) = (W_) OldRoot_info; - IND_CLOSURE_PTR(oldind) = (W_) newevac; + INFO_PTR(oldind) = (W_) OldRoot_info; + IND_CLOSURE_PTR(oldind) = (W_) newevac; IND_CLOSURE_LINK(oldind) = (W_) genInfo.OldInNew; genInfo.OldInNew = oldind; genInfo.OldInNewno++; @@ -387,9 +381,7 @@ P_ newevac, evac; /*** Real Evac Code -- simply passed closure ***/ -#define EVAC_FN(suffix) \ - P_ CAT2(_Evacuate_,suffix)(evac) \ - P_ evac; +#define EVAC_FN(suffix) P_ CAT2(_Evacuate_,suffix)(P_ evac) /*** FORWARD REF STUFF ***/ @@ -511,7 +503,7 @@ BIG_SPEC_EVAC_FN(12) \end{code} -A @SPEC_RBH@ must be at least size @MIN_UPD_SIZE@ (Who are we fooling? +A @SPEC_RBH@ must be at least size @MIN_UPD_SIZE@ (Whom are we fooling? This means 2), and the first word after the fixed header is a @MUT_LINK@. The second word is a pointer to a blocking queue. Remaining words are the same as the underlying @SPEC@ closure. Unlike @@ -527,19 +519,24 @@ turns you on. #ifdef PAR -#define SPEC_RBH_EVAC_FN(n) \ -EVAC_FN(CAT2(RBH_,n)) \ -{ \ - int i; \ - START_ALLOC(n); \ - DEBUG_EVAC(n); \ - COPY_FIXED_HDR; \ - for (i = 0; i < n - 1; i++) { COPY_WORD(SPEC_RBH_HS + i); } \ - SET_FORWARD_REF(evac,ToHp); \ - evac = ToHp; \ - FINISH_ALLOC(n); \ - PROMOTE_MUTABLE(evac);\ - return(evac); \ +#define SPEC_RBH_EVAC_FN(n) \ +EVAC_FN(CAT2(RBH_,n)) \ +{ \ + I_ count = FIXED_HS - 1; \ + I_ size = SPEC_RBH_VHS + (n); \ + START_ALLOC(size); \ + DEBUG_EVAC(size); \ + COPY_FIXED_HDR; \ + while (++count <= size + (FIXED_HS - 1)) { \ + COPY_WORD(count); \ + } \ + SET_FORWARD_REF(evac,ToHp); \ + evac = ToHp; \ + FINISH_ALLOC(size); \ + \ + PROMOTE_MUTABLE(evac); \ + \ + return(evac); \ } /* instantiate for 2--12 */ @@ -560,11 +557,12 @@ SPEC_RBH_EVAC_FN(12) #ifndef PAR EVAC_FN(MallocPtr) { - START_ALLOC(MallocPtr_SIZE); - DEBUG_EVAC(MallocPtr_SIZE); + I_ size = MallocPtr_SIZE; + START_ALLOC(size); + DEBUG_EVAC(size); -#if defined(_GC_DEBUG) - if (SM_trace & 16) { +#if defined(DEBUG) + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MALLOCPTRS) { printf("DEBUG: Evacuating MallocPtr(%x)=<%x,_,%x,%x>", evac, evac[0], evac[2], evac[3]); printf(" Data = %x, Next = %x\n", MallocPtr_CLOSURE_DATA(evac), MallocPtr_CLOSURE_LINK(evac) ); @@ -577,8 +575,8 @@ EVAC_FN(MallocPtr) MallocPtr_CLOSURE_DATA(ToHp) = MallocPtr_CLOSURE_DATA(evac); MallocPtr_CLOSURE_LINK(ToHp) = MallocPtr_CLOSURE_LINK(evac); -#if defined(_GC_DEBUG) - if (SM_trace & 16) { +#if defined(DEBUG) + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MALLOCPTRS) { printf("DEBUG: Evacuated MallocPtr(%x)=<%x,_,%x,%x>", ToHp, ToHp[0], ToHp[2], ToHp[3]); printf(" Data = %x, Next = %x\n", MallocPtr_CLOSURE_DATA(ToHp), MallocPtr_CLOSURE_LINK(ToHp) ); @@ -586,7 +584,7 @@ EVAC_FN(MallocPtr) #endif evac = ToHp; - FINISH_ALLOC(MallocPtr_SIZE); + FINISH_ALLOC(size); return(evac); } #endif /* !PAR */ @@ -733,86 +731,103 @@ EVAC_FN(Data) Evac already contains this address -- just return */ /* Scavenging: Static closures should never be scavenged */ -P_ -_Evacuate_Static(evac) -P_ evac; +EVAC_FN(Static) { DEBUG_EVAC_STAT; return(evac); } -void -_Scavenge_Static(STG_NO_ARGS) -{ - fprintf(stderr,"Called _Scavenge_Static: Closure %lx Info %lx\nShould never occur!\n", (W_) Scav, INFO_PTR(Scav)); - abort(); -} - - /*** BLACK HOLE CODE ***/ EVAC_FN(BH_U) { - START_ALLOC(MIN_UPD_SIZE); - DEBUG_EVAC_BH(MIN_UPD_SIZE); + START_ALLOC(BH_U_SIZE); + DEBUG_EVAC_BH(BH_U_SIZE); COPY_FIXED_HDR; SET_FORWARD_REF(evac,ToHp); evac = ToHp; - FINISH_ALLOC(MIN_UPD_SIZE); + FINISH_ALLOC(BH_U_SIZE); return(evac); } EVAC_FN(BH_N) { - START_ALLOC(MIN_NONUPD_SIZE); - DEBUG_EVAC_BH(MIN_NONUPD_SIZE); + START_ALLOC(BH_N_SIZE); + DEBUG_EVAC_BH(BH_N_SIZE); COPY_FIXED_HDR; SET_FORWARD_REF(evac,ToHp); evac = ToHp; - FINISH_ALLOC(MIN_NONUPD_SIZE); + FINISH_ALLOC(BH_N_SIZE); return(evac); } /*** INDIRECTION CODE ***/ -/* Evacuation: Evacuate closure pointed to */ +/* permanent indirections first */ +#if defined(PROFILING) || defined(TICKY_TICKY) +#undef PI -P_ -_Evacuate_Ind(evac) -P_ evac; +EVAC_FN(PI) /* used for ticky in case just below... */ +{ +#ifdef TICKY_TICKY + if (! AllFlags.doUpdEntryCounts) { + DEBUG_EVAC_IND1; + GC_SHORT_IND(); /* ticky: record that we shorted an indirection */ + + evac = (P_) IND_CLOSURE_PTR(evac); + +# if defined(GCgn) || defined(GCap) + if (evac > OldGen) /* Only evacuate new gen with generational collector */ + evac = EVACUATE_CLOSURE(evac); +# else + evac = EVACUATE_CLOSURE(evac); +# endif + + DEBUG_EVAC_IND2; + } else { +#endif + + /* *not* shorting one out... */ + START_ALLOC(IND_CLOSURE_SIZE(dummy)); + DEBUG_EVAC_PERM_IND; + COPY_FIXED_HDR; + COPY_WORD(IND_HS); + SET_FORWARD_REF(evac,ToHp); + evac = ToHp; + FINISH_ALLOC(IND_CLOSURE_SIZE(dummy)); + +#ifdef TICKY_TICKY + } +#endif + return(evac); +} +#endif /* PROFILING or TICKY */ + +EVAC_FN(Ind) /* Indirections are shorted-out; if doing weird ticky + stuff, we will have used *permanent* indirections + for overwriting updatees... + */ { DEBUG_EVAC_IND1; + GC_SHORT_IND(); /* ticky: record that we shorted an indirection */ + evac = (P_) IND_CLOSURE_PTR(evac); -#if defined(GCgn) || defined(GCap) +# if defined(GCgn) || defined(GCap) if (evac > OldGen) /* Only evacuate new gen with generational collector */ evac = EVACUATE_CLOSURE(evac); -#else +# else evac = EVACUATE_CLOSURE(evac); -#endif +# endif DEBUG_EVAC_IND2; - return(evac); /* This will generate a stack of returns for a chain of indirections! However chains can only be 2 long. - */ -} + */ -#ifdef USE_COST_CENTRES -#undef PI -EVAC_FN(PI) -{ - START_ALLOC(MIN_UPD_SIZE); - DEBUG_EVAC_PERM_IND; - COPY_FIXED_HDR; - COPY_WORD(IND_HS); - SET_FORWARD_REF(evac,ToHp); - evac = ToHp; - FINISH_ALLOC(MIN_UPD_SIZE); return(evac); } -#endif /*** SELECTORS CODE (much like an indirection) ***/ @@ -830,30 +845,70 @@ EVAC_FN(PI) the n'th field is. ToDo: what if the constructor is a Gen thing? + + "selector_depth" stuff below: (WDP 95/12) + + It is possible to have a *very* considerable number of selectors + all chained together, which will cause the code here to chew up + enormous C stack space (very deeply nested set of calls), which + can crash the program. + + Various solutions are possible, but we opt for a simple one -- + we run a "selector_depth" counter, and we stop doing the + selections if we get beyond that depth. The main nice property + is that it doesn't affect (or slow down) any of the rest of the + GC. + + What should the depth be? For SPARC friendliness, it should + probably be very small (e.g., 8 or 16), to avoid register-window + spillage. However, that would increase the chances that + selectors are left undone and lots of junk is promoted to the + old generation. So we set it quite a bit higher -- we'd like to + do all the selections except in the most extreme circumstances. */ +static int selector_depth = 0; +#define MAX_SELECTOR_DEPTH 100 /* reasonably arbitrary */ + static P_ -_EvacuateSelector_n(evac, n) - P_ evac; - I_ n; +_EvacuateSelector_n(P_ evac, I_ n) { P_ maybe_con = (P_) evac[_FHS]; /* must be a SPEC 2 1 closure */ ASSERT(MIN_UPD_SIZE == 2); /* otherwise you are hosed */ -#if defined(_GC_DEBUG) - if (SM_trace & 2) - fprintf(stderr, "Evac Selector: 0x%lx, info 0x%lx, maybe_con 0x%lx, info 0x%lx, tag %ld\n", - evac, INFO_PTR(evac), maybe_con, +#ifdef TICKY_TICKY + /* if a thunk, its update-entry count must be zero */ + ASSERT(TICKY_HDR(evac) == 0); +#endif + + selector_depth++; /* see story above */ + +#if defined(DEBUG) + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) + fprintf(stderr, "Evac Selector (depth %ld): 0x%lx, info 0x%lx, maybe_con 0x%lx, info 0x%lx, tag %ld\n", + selector_depth, evac, INFO_PTR(evac), maybe_con, INFO_PTR(maybe_con), INFO_TAG(INFO_PTR(maybe_con))); #endif - if (INFO_TAG(INFO_PTR(maybe_con)) < 0) /* not in WHNF */ + if (INFO_TAG(INFO_PTR(maybe_con)) < 0 /* not in WHNF */ +#if !defined(CONCURRENT) + || (! RTSflags.GcFlags.lazyBlackHoling) /* see "price of laziness" paper */ +#endif + || selector_depth > MAX_SELECTOR_DEPTH + || (! RTSflags.GcFlags.doSelectorsAtGC) + ) { +#ifdef TICKY_TICKY + if (INFO_TAG(INFO_PTR(maybe_con)) >= 0) { /* we *could* have done it */ + GC_SEL_ABANDONED(); + } +#endif /* Evacuate as normal (it is size *2* because of MIN_UPD_SIZE) */ return( _Evacuate_2(evac) ); + } -#if defined(_GC_DEBUG) - if (SM_trace & 2) +#if defined(DEBUG) + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) fprintf(stderr, "Evac Selector:shorting: 0x%lx -> 0x%lx\n", evac, maybe_con[_FHS + n]); #endif @@ -861,6 +916,8 @@ _EvacuateSelector_n(evac, n) /* Ha! Short it out */ evac = (P_) (maybe_con[_FHS + n]); /* evac now has the result of the selection */ + GC_SEL_MINOR(); /* ticky-ticky */ + #if defined(GCgn) || defined(GCap) if (evac > OldGen) /* Only evacuate new gen with generational collector */ evac = EVACUATE_CLOSURE(evac); @@ -868,6 +925,8 @@ _EvacuateSelector_n(evac, n) evac = EVACUATE_CLOSURE(evac); #endif + selector_depth--; /* see story above */ + return(evac); } @@ -893,7 +952,7 @@ DEF_SEL_EVAC(12) #ifdef CONCURRENT EVAC_FN(BQ) { - START_ALLOC(MIN_UPD_SIZE); + START_ALLOC(BQ_CLOSURE_SIZE(dummy)); DEBUG_EVAC_BQ; COPY_FIXED_HDR; @@ -901,7 +960,7 @@ EVAC_FN(BQ) SET_FORWARD_REF(evac,ToHp); evac = ToHp; - FINISH_ALLOC(MIN_UPD_SIZE); + FINISH_ALLOC(BQ_CLOSURE_SIZE(dummy)); /* Add to OldMutables list (if evacuated to old generation) */ PROMOTE_MUTABLE(evac); @@ -912,9 +971,10 @@ EVAC_FN(BQ) EVAC_FN(TSO) { I_ count; + I_ size = TSO_VHS + TSO_CTS_SIZE; - START_ALLOC(TSO_VHS + TSO_CTS_SIZE); - DEBUG_EVAC_TSO(TSO_VHS + TSO_CTS_SIZE); + START_ALLOC(size); + DEBUG_EVAC_TSO(size); COPY_FIXED_HDR; for (count = FIXED_HS; count < FIXED_HS + TSO_VHS; count++) { @@ -925,7 +985,7 @@ EVAC_FN(TSO) SET_FORWARD_REF(evac, ToHp); evac = ToHp; - FINISH_ALLOC(TSO_VHS + TSO_CTS_SIZE); + FINISH_ALLOC(size); /* Add to OldMutables list (if evacuated to old generation) */ PROMOTE_MUTABLE(evac); @@ -936,17 +996,19 @@ EVAC_FN(TSO) EVAC_FN(StkO) { I_ count; - I_ size = STKO_CLOSURE_SIZE(evac); + I_ size = STKO_CLOSURE_SIZE(evac); I_ spa_offset = STKO_SpA_OFFSET(evac); I_ spb_offset = STKO_SpB_OFFSET(evac); I_ sub_offset = STKO_SuB_OFFSET(evac); I_ offset; + ASSERT(sanityChk_StkO(evac)); + START_ALLOC(size); DEBUG_EVAC_STKO(STKO_CLOSURE_CTS_SIZE(evac) - spa_offset + 1, spb_offset); COPY_FIXED_HDR; -#ifdef DO_REDN_COUNTING +#ifdef TICKY_TICKY COPY_WORD(STKO_ADEP_LOCN); COPY_WORD(STKO_BDEP_LOCN); #endif @@ -1018,8 +1080,9 @@ EVAC_FN(FetchMe) EVAC_FN(BF) { I_ count; + I_ size = BF_CLOSURE_SIZE(evac); - START_ALLOC(BF_CLOSURE_SIZE(evac)); + START_ALLOC(size); DEBUG_EVAC_BF; COPY_FIXED_HDR; @@ -1034,7 +1097,7 @@ EVAC_FN(BF) SET_FORWARD_REF(evac, ToHp); evac = ToHp; - FINISH_ALLOC(BF_CLOSURE_SIZE(evac)); + FINISH_ALLOC(size); /* Add to OldMutables list (if evacuated to old generation) */ PROMOTE_MUTABLE(evac); @@ -1047,30 +1110,28 @@ EVAC_FN(BF) /*** SPECIAL CAF CODE ***/ /* Evacuation: Return closure pointed to (already explicitly evacuated) */ -/* Scavenging: Should not be scavenged */ -P_ -_Evacuate_Caf(evac) -P_ evac; +EVAC_FN(Caf) { DEBUG_EVAC_CAF_RET; + GC_SHORT_CAF(); /* ticky: record that we shorted an indirection */ + evac = (P_) IND_CLOSURE_PTR(evac); return(evac); } /* In addition we need an internal Caf indirection which evacuates, - updates and returns the indirection. Before GC is started the + updates and returns the indirection. Before GC is started, the @CAFlist@ must be traversed and the info tables set to this. */ -P_ -_Evacuate_Caf_Evac_Upd(evac) - P_ evac; +EVAC_FN(Caf_Evac_Upd) { P_ closure = evac; DEBUG_EVAC_CAF_EVAC1; - INFO_PTR(evac) = (W_) Caf_info; /* Change to return CAF */ + + INFO_PTR(evac) = (W_) Caf_info; /* Change back to Caf_info */ evac = (P_) IND_CLOSURE_PTR(evac); /* Grab reference and evacuate */ @@ -1095,44 +1156,56 @@ _Evacuate_Caf_Evac_Upd(evac) /*** CONST CLOSURE CODE ***/ /* Evacuation: Just return address of the static closure stored in the info table */ -/* Scavenging: Const closures should never be scavenged */ -P_ -_Evacuate_Const(evac) -P_ evac; +EVAC_FN(Const) { +#ifdef TICKY_TICKY + if (AllFlags.doUpdEntryCounts) { + /* evacuate as if a closure of size 0 + (there is no _Evacuate_0 to call) + */ + START_ALLOC(0); + DEBUG_EVAC(0); + COPY_FIXED_HDR; + SET_FORWARD_REF(evac,ToHp); + evac = ToHp; + FINISH_ALLOC(0); + + } else { +#endif + DEBUG_EVAC_CONST; + GC_COMMON_CONST(); /* ticky */ + evac = CONST_STATIC_CLOSURE(INFO_PTR(evac)); - return(evac); -} -void -_Scavenge_Const(STG_NO_ARGS) -{ - fprintf(stderr,"Called _Scavenge_Const: Closure %lx Info %lx\nShould never occur!\n", (W_) Scav, INFO_PTR(Scav)); - abort(); +#ifdef TICKY_TICKY + } +#endif + return(evac); } - /*** CHARLIKE CLOSURE CODE ***/ /* Evacuation: Just return address of the static closure stored fixed array */ -/* Scavenging: CharLike closures should never be scavenged */ -P_ -_Evacuate_CharLike(evac) -P_ evac; +EVAC_FN(CharLike) { +#ifdef TICKY_TICKY + if (AllFlags.doUpdEntryCounts) { + evac = _Evacuate_1(evac); /* evacuate closure of size 1 */ + } else { +#endif + DEBUG_EVAC_CHARLIKE; + GC_COMMON_CHARLIKE(); /* ticky */ + evac = (P_) CHARLIKE_CLOSURE(CHARLIKE_VALUE(evac)); - return(evac); -} -void -_Scavenge_CharLike(STG_NO_ARGS) -{ - fprintf(stderr,"Called _Scavenge_CharLike: Closure %lx Info %lx\nShould never occur!\n", (W_) Scav, INFO_PTR(Scav)); - abort(); +#ifdef TICKY_TICKY + } +#endif + return(evac); } \end{code} @@ -1141,8 +1214,6 @@ _Scavenge_CharLike(STG_NO_ARGS) Evacuation: Return address of the static closure if available Otherwise evacuate converting to aux closure. -Scavenging: IntLike closures should never be scavenged. - There are some tricks here: \begin{enumerate} \item @@ -1158,19 +1229,25 @@ EVAC_FN(IntLike) { I_ val = INTLIKE_VALUE(evac); - if ((val <= MAX_INTLIKE) && (val >= MIN_INTLIKE)) { /* in range of static closures */ + if (val >= MIN_INTLIKE /* in range of static closures */ + && val <= MAX_INTLIKE +#ifdef TICKY_TICKY + && !AllFlags.doUpdEntryCounts +#endif + ) { DEBUG_EVAC_INTLIKE_TO_STATIC; - evac = (P_) INTLIKE_CLOSURE(val); /* return appropriate static closure */ + GC_COMMON_INTLIKE(); /* ticky */ + + evac = (P_) INTLIKE_CLOSURE(val); /* return appropriate static closure */ } else { - START_ALLOC(1); /* evacuate closure of size 1 */ - DEBUG_EVAC(1); - COPY_FIXED_HDR; - SPEC_COPY_FREE_VAR(1); - SET_FORWARD_REF(evac,ToHp); - evac = ToHp; - FINISH_ALLOC(1); + evac = _Evacuate_1(evac); /* evacuate closure of size 1 */ + +#ifdef TICKY_TICKY + if (!AllFlags.doUpdEntryCounts) GC_COMMON_INTLIKE_FAIL(); +#endif } + return(evac); } diff --git a/ghc/runtime/storage/SMextn.lc b/ghc/runtime/storage/SMextn.lc index bd39ae4169..48e024d33f 100644 --- a/ghc/runtime/storage/SMextn.lc +++ b/ghc/runtime/storage/SMextn.lc @@ -63,7 +63,7 @@ TrashMem(from, to) { /* assertion overly strong - if free_mem == 0, sm->hp == sm->hplim */ /* ASSERT( from <= to ); */ - if (SM_trace) + if (RTSflags.GcFlags.trace) printf("Trashing from 0x%lx to 0x%lx inclusive\n", (W_) from, (W_) to); while (from <= to) { *from++ = DEALLOCATED_TRASH; @@ -113,10 +113,11 @@ themselves, we'll trash its contents when we're done with it. void Trash_MallocPtr_Closure(mptr) P_ mptr; -{ int i; - for( i = 0; i != MallocPtr_SIZE + _FHS; i++ ) { - mptr[ i ] = DEALLOCATED_TRASH; - } +{ + int i; + for( i = 0; i < MallocPtr_SIZE + _FHS; i++ ) { + mptr[ i ] = DEALLOCATED_TRASH; + } } \end{code} @@ -160,7 +161,7 @@ void Trace_MallocPtr( MPptr ) P_ MPptr; { - if (SM_trace & 16) { + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MALLOCPTRS) { printf("DEBUG: MallocPtr(%lx)=<%lx,_,%lx,%lx,%lx>\n", (W_) MPptr, (W_) MPptr[0], (W_) MPptr[1], (W_) MPptr[2], (W_) MPptr[3]); printf(" Data = %lx, Next = %lx\n", (W_) MallocPtr_CLOSURE_DATA(MPptr), (W_) MallocPtr_CLOSURE_LINK(MPptr) ); @@ -170,7 +171,7 @@ Trace_MallocPtr( MPptr ) void Trace_MPdies() { - if (SM_trace & 16) { + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MALLOCPTRS) { printf(" dying\n"); } } @@ -178,8 +179,8 @@ Trace_MPdies() void Trace_MPlives() { - if (SM_trace & 16) { - printf(" lived to tell the tale \n"); + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MALLOCPTRS) { + printf(" lived to tell the tale\n"); } } @@ -187,7 +188,7 @@ void Trace_MPforwarded( MPPtr, newAddress ) P_ MPPtr, newAddress; { - if (SM_trace & 16) { + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MALLOCPTRS) { printf(" forwarded to %lx\n", (W_) newAddress); } } diff --git a/ghc/runtime/storage/SMextn.lh b/ghc/runtime/storage/SMextn.lh index ed2e3a86e6..4c096a0922 100644 --- a/ghc/runtime/storage/SMextn.lh +++ b/ghc/runtime/storage/SMextn.lh @@ -3,38 +3,36 @@ \begin{code} #ifndef PAR -extern void initExtensions PROTO((smInfo *sm)); +void initExtensions PROTO((smInfo *sm)); -#if defined(_INFO_COPYING) +# if defined(_INFO_COPYING) -extern void evacSPTable PROTO((smInfo *sm)); -extern void reportDeadMallocPtrs PROTO((StgPtr oldMPList, StgPtr new, StgPtr *newMPLust)); +void evacSPTable PROTO((smInfo *sm)); +void reportDeadMallocPtrs PROTO((StgPtr oldMPList, StgPtr new, StgPtr *newMPLust)); -#endif /* _INFO_COPYING */ +# endif /* _INFO_COPYING */ -#if defined(_INFO_COMPACTING) +# if defined(_INFO_COMPACTING) -extern void sweepUpDeadMallocPtrs PROTO(( - P_ MallocPtrList, - P_ base, - BitWord *bits - )); +void sweepUpDeadMallocPtrs PROTO((P_ MallocPtrList, + P_ base, + BitWord *bits + )); -#endif /* _INFO_COMPACTING */ +# endif /* _INFO_COMPACTING */ -extern void TrashMem PROTO(( P_ from, P_ to )); +void TrashMem PROTO(( P_ from, P_ to )); -#if defined(DEBUG) +# if defined(DEBUG) -extern void Trash_MallocPtr_Closure PROTO((P_ mptr)); -extern void Validate_MallocPtrList PROTO(( P_ MallocPtrList )); +void Trash_MallocPtr_Closure PROTO((P_ mptr)); +void Validate_MallocPtrList PROTO(( P_ MallocPtrList )); -extern void Trace_MPdies PROTO((void)); -extern void Trace_MPlives PROTO((void)); -extern void Trace_MPforwarded PROTO(( P_ MPPtr, P_ newAddress )); +void Trace_MPdies PROTO((void)); +void Trace_MPlives PROTO((void)); +void Trace_MPforwarded PROTO(( P_ MPPtr, P_ newAddress )); - -#endif /* DEBUG */ +# endif /* DEBUG */ #endif /* !PAR */ \end{code} diff --git a/ghc/runtime/storage/SMgen.lc b/ghc/runtime/storage/SMgen.lc index 302ee640f4..d53914909a 100644 --- a/ghc/runtime/storage/SMgen.lc +++ b/ghc/runtime/storage/SMgen.lc @@ -57,9 +57,8 @@ P_ heap_space = 0; /* Address of first word of slab P_ hp_start; /* Value of Hp when reduction was resumed */ /* Always allocbase - 1 */ -I_ -initHeap( sm ) - smInfo *sm; +rtsBool +initHeap(smInfo * sm) { I_ heap_error = 0; I_ bit_words; @@ -70,12 +69,13 @@ initHeap( sm ) if (heap_space == 0) { /* allocates if it doesn't already exist */ /* Allocate the roots space */ - sm->roots = (P_ *) xmalloc( SM_MAXROOTS * sizeof(W_) ); + sm->roots = (P_ *) stgMallocWords(SM_MAXROOTS, "initHeap (roots)"); /* Allocate the heap */ - heap_space = (P_) xmalloc((SM_word_heap_size + EXTRA_HEAP_WORDS) * sizeof(W_)); + heap_space = (P_) stgMallocWords(SM_word_heap_size + EXTRA_HEAP_WORDS, + "initHeap (heap)"); - if (SM_force_gc == USE_2s) { + if (RTSflags.GcFlags.force2s) { stat_init("TWOSPACE(GEN)", " No of Roots Caf Caf Astk Bstk", "Astk Bstk Reg No bytes bytes bytes"); @@ -86,8 +86,8 @@ initHeap( sm ) } } - if (SM_force_gc == USE_2s) { - genInfo.semi_space = SM_word_heap_size / 2; + if (RTSflags.GcFlags.force2s) { + genInfo.semi_space = RTSflags.GcFlags.heapSize / 2; genInfo.space[0].base = HEAP_FRAME_BASE(heap_space, genInfo.semi_space); genInfo.space[1].base = HEAP_FRAME_BASE(heap_space + genInfo.semi_space, genInfo.semi_space); genInfo.space[0].lim = HEAP_FRAME_LIMIT(heap_space, genInfo.semi_space); @@ -97,16 +97,17 @@ initHeap( sm ) sm->hp = hp_start = genInfo.space[genInfo.semi_space].base - 1; - if (SM_alloc_size) { - sm->hplim = sm->hp + SM_alloc_size; - SM_alloc_min = 0; /* No min; alloc size specified */ + if (! RTSflags.GcFlags.allocAreaSizeGiven) { + sm->hplim = genInfo.space[genInfo.semi_space].lim; + } else { + sm->hplim = sm->hp + RTSflags.GcFlags.allocAreaSize; + + RTSflags.GcFlags.minAllocAreaSize = 0; /* specified size takes precedence */ if (sm->hplim > genInfo.space[genInfo.semi_space].lim) { fprintf(stderr, "Not enough heap for requested alloc size\n"); - return -1; + return rtsFalse; } - } else { - sm->hplim = genInfo.space[genInfo.semi_space].lim; } sm->OldLim = genInfo.oldlim; @@ -116,25 +117,23 @@ initHeap( sm ) initExtensions( sm ); #endif - if (SM_trace) { + if (RTSflags.GcFlags.trace) { fprintf(stderr, "GEN(2s) Heap: 0x%lx .. 0x%lx\n", - (W_) heap_space, (W_) (heap_space - 1 + SM_word_heap_size)); + (W_) heap_space, (W_) (heap_space - 1 + RTSflags.GcFlags.heapSize)); fprintf(stderr, "Initial: space %ld, base 0x%lx, lim 0x%lx\n hp 0x%lx, hplim 0x%lx, free %ld\n", genInfo.semi_space, (W_) genInfo.space[genInfo.semi_space].base, (W_) genInfo.space[genInfo.semi_space].lim, (W_) sm->hp, (W_) sm->hplim, (I_) (sm->hplim - sm->hp)); } - return 0; + return rtsTrue; } - if (SM_alloc_size == 0) SM_alloc_size = DEFAULT_ALLOC_SIZE; - - genInfo.alloc_words = SM_alloc_size; - genInfo.new_words = SM_alloc_size; + genInfo.alloc_words = RTSflags.GcFlags.allocAreaSize; + genInfo.new_words = RTSflags.GcFlags.allocAreaSize; - genInfo.allocbase = heap_space + SM_word_heap_size - genInfo.alloc_words; - genInfo.alloclim = heap_space + SM_word_heap_size - 1; + genInfo.allocbase = heap_space + RTSflags.GcFlags.heapSize - genInfo.alloc_words; + genInfo.alloclim = heap_space + RTSflags.GcFlags.heapSize - 1; genInfo.newgen[0].newbase = genInfo.allocbase - genInfo.new_words; genInfo.newgen[0].newlim = genInfo.newgen[0].newbase - 1; @@ -144,8 +143,8 @@ initHeap( sm ) genInfo.oldbase = heap_space; - if (SM_major_gen_size) { - genInfo.old_words = SM_major_gen_size; + if (RTSflags.GcFlags.specifiedOldGenSize) { + genInfo.old_words = RTSflags.GcFlags.specifiedOldGenSize; genInfo.oldend = heap_space + genInfo.old_words - 1; genInfo.oldthresh = genInfo.oldend - genInfo.new_words; /* ToDo: extra old ind words not accounted for ! */ @@ -161,7 +160,7 @@ initHeap( sm ) if (genInfo.bit_vect + bit_words >= (BitWord *) genInfo.newgen[1].newbase) heap_error = 1; } } else { - genInfo.old_words = SM_word_heap_size - genInfo.alloc_words - 2 * genInfo.new_words; + genInfo.old_words = RTSflags.GcFlags.heapSize - genInfo.alloc_words - 2 * genInfo.new_words; genInfo.oldend = heap_space + genInfo.old_words - 1; genInfo.oldthresh = genInfo.oldend - genInfo.new_words; /* ToDo: extra old ind words not accounted for ! */ @@ -182,7 +181,7 @@ initHeap( sm ) } if (heap_error) { - fprintf(stderr, "initHeap: Requested heap size: %ld\n", SM_word_heap_size); + fprintf(stderr, "initHeap: Requested heap size: %ld\n", RTSflags.GcFlags.heapSize); fprintf(stderr, " Alloc area %ld Delay area %ld Old area %ld Bit area %ld\n", genInfo.alloc_words, genInfo.new_words * 2, genInfo.old_words, genInfo.bit_vect == (BitWord *) genInfo.allocbase ? 0 : bit_words); @@ -216,9 +215,9 @@ initHeap( sm ) initExtensions( sm ); #endif - if (SM_trace) { + if (RTSflags.GcFlags.trace) { fprintf(stderr, "GEN Heap: 0x%lx .. 0x%lx\n", - (W_) heap_space, (W_) (heap_space + SM_word_heap_size - 1)); + (W_) heap_space, (W_) (heap_space + RTSflags.GcFlags.heapSize - 1)); fprintf(stderr, " alloc %ld, new %ld, old %ld, bit %ld\n", genInfo.alloc_words, genInfo.new_words, genInfo.old_words, bit_words); fprintf(stderr, " allocbase 0x%lx, alloclim 0x%lx\n", @@ -249,7 +248,7 @@ collect2s(reqsize, sm) SAVE_REGS(&ScavRegDump); /* Save registers */ - if (SM_trace) + if (RTSflags.GcFlags.trace) fprintf(stderr, "Start: space %ld, base 0x%lx, lim 0x%lx\n hp 0x%lx, hplim 0x%lx, req %lu\n", genInfo.semi_space, (W_) genInfo.space[genInfo.semi_space].base, @@ -344,7 +343,7 @@ collect2s(reqsize, sm) /* DONT_DO_MAX_RESIDENCY -- because this collector is utterly hosed */ free_space = sm->hplim - sm->hp; - if (SM_stats_verbose) { + if (RTSflags.GcFlags.giveStats) { char comment_str[BIG_STRING_LEN]; #ifndef PAR sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu 2s", @@ -358,12 +357,12 @@ collect2s(reqsize, sm) sprintf(comment_str, "%4u %4ld %3ld %3ld %6lu %6lu %6lu 2s", 0, 0, sm->rootno, caf_roots, extra_caf_words*sizeof(W_), 0, 0); #endif - stat_endGC(alloc, SM_word_heap_size, resident, comment_str); + stat_endGC(alloc, RTSflags.GcFlags.heapSize, resident, comment_str); } else { - stat_endGC(alloc, SM_word_heap_size, resident, ""); + stat_endGC(alloc, RTSflags.GcFlags.heapSize, resident, ""); } - if (SM_trace) + if (RTSflags.GcFlags.trace) fprintf(stderr, "Done: space %ld, base 0x%lx, lim 0x%lx\n hp 0x%lx, hplim 0x%lx, free %lu\n", genInfo.semi_space, (W_) genInfo.space[genInfo.semi_space].base, @@ -378,7 +377,7 @@ collect2s(reqsize, sm) RESTORE_REGS(&ScavRegDump); /* Restore Registers */ - if ((SM_alloc_size > free_space) || (reqsize > free_space)) + if ((RTSflags.GcFlags.allocAreaSize > free_space) || (reqsize > free_space)) return(-1); /* Heap exhausted */ return(0); /* Heap OK */ @@ -409,7 +408,7 @@ collectHeap(reqsize, sm) fflush(stdout); /* Flush stdout at start of GC */ - if (SM_force_gc == USE_2s) { + if (RTSflags.GcFlags.force2s) { return collect2s(reqsize, sm); } @@ -423,7 +422,8 @@ collectHeap(reqsize, sm) SAVE_REGS(&ScavRegDump); /* Save registers */ - if (SM_trace) fprintf(stderr, "GEN Start: hp 0x%lx, hplim 0x%lx, req %ld Minor\n", + if (RTSflags.GcFlags.trace) + fprintf(stderr, "GEN Start: hp 0x%lx, hplim 0x%lx, req %ld Minor\n", (W_) sm->hp, (W_) sm->hplim, (I_) (reqsize * sizeof(W_))); alloc = sm->hp - hp_start; @@ -632,7 +632,7 @@ collectHeap(reqsize, sm) sm->MallocPtrList = NULL; /* all (new) MallocPtrs have been promoted */ #endif /* PAR */ - if (SM_stats_verbose) { + if (RTSflags.GcFlags.giveStats) { char minor_str[BIG_STRING_LEN]; #ifndef PAR sprintf(minor_str, "%6lu %4lu %4lu %4ld %3ld %3ld %4ld %3ld %3ld %6ld Minor", @@ -660,7 +660,7 @@ collectHeap(reqsize, sm) sm->hplim = genInfo.alloclim; sm->OldLim = genInfo.oldlim; - if (SM_trace) + if (RTSflags.GcFlags.trace) fprintf(stderr, "GEN End: oldbase 0x%lx, oldlim 0x%lx, oldthresh 0x%lx, newbase 0x%lx, newlim 0x%lx\n hp 0x%lx, hplim 0x%lx, free %lu\n", (W_) genInfo.oldbase, (W_) genInfo.oldlim, (W_) genInfo.oldthresh, (W_) genInfo.newgen[genInfo.curnew].newbase, @@ -786,26 +786,26 @@ collectHeap(reqsize, sm) genInfo.oldwas = genInfo.oldlim; genInfo.minor_since_major = 0; - if (SM_stats_verbose) { + if (RTSflags.GcFlags.giveStats) { char major_str[BIG_STRING_LEN]; #ifndef PAR sprintf(major_str, "%6d %4ld %4u %4ld %3ld %3ld %4d %3d %3d %6.6s *Major* %4.1f%%", 0, genInfo.OldInNewno, (SUBTRACT_A_STK(MAIN_SpA, stackInfo.botA) + 1), bstk_roots, sm->rootno, genInfo.NewCAFno + genInfo.OldCAFno, - 0, 0, 0, "", total_resident / (StgFloat) SM_word_heap_size * 100); + 0, 0, 0, "", total_resident / (StgDouble) RTSflags.GcFlags.heapSize * 100); #else sprintf(major_str, "%6d %4ld %4u %4ld %3ld %3ld %4d %3d %3d %6.6s *Major* %4.1f%%", 0, genInfo.OldInNewno, 0, 0, sm->rootno, genInfo.NewCAFno + genInfo.OldCAFno, - 0, 0, 0, "", total_resident / (StgFloat) SM_word_heap_size * 100); + 0, 0, 0, "", total_resident / (StgDouble) RTSflags.GcFlags.heapSize * 100); #endif stat_endGC(0, alloc, resident, major_str); } else { stat_endGC(0, alloc, resident, ""); } - if (SM_trace) + if (RTSflags.GcFlags.trace) fprintf(stderr, "GEN Major: oldbase 0x%lx, oldlim 0x%lx, oldthresh 0x%lx, newbase 0x%lx, newlim 0x%lx\n hp 0x%lx, hplim 0x%lx, free %lu\n", (W_) genInfo.oldbase, (W_) genInfo.oldlim, (W_) genInfo.oldthresh, (W_) genInfo.newgen[genInfo.curnew].newbase, diff --git a/ghc/runtime/storage/SMinit.lc b/ghc/runtime/storage/SMinit.lc index 6b1ec5f944..4224c9a2b9 100644 --- a/ghc/runtime/storage/SMinit.lc +++ b/ghc/runtime/storage/SMinit.lc @@ -15,172 +15,16 @@ A filehandle to which any storage-manager statistics should be written. \begin{code} #define NULL_REG_MAP #include "SMinternal.h" - -/* global vars to hold some storage-mgr details; */ -/* decls for these are in SMinternal.h */ -I_ SM_force_gc = 0; -I_ SM_alloc_size = 0; -I_ SM_alloc_min = 0; -I_ SM_major_gen_size = 0; -FILE *SM_statsfile = NULL; -I_ SM_trace = 0; -I_ SM_stats_summary = 0; -I_ SM_stats_verbose = 0; -I_ SM_ring_bell = 0; - -/*To SizeHooks: I_ SM_word_heap_size = DEFAULT_HEAP_SIZE; */ -/*To SizeHooks: StgFloat SM_pc_free_heap = DEFAULT_PC_FREE; */ -extern I_ SM_word_stk_size; /*To SizeHooks: = DEFAULT_STACKS_SIZE; */ - -I_ MaxResidency = 0; /* in words; for stats only */ -I_ ResidencySamples = 0; /* for stats only */ - -#ifndef atof -extern double atof(); -/* no proto because some machines use const and some do not */ -#endif - -I_ -decode(s) - char *s; -{ - I_ c; - StgDouble m; - if (!*s) - return 0; - m = atof(s); - c = s[strlen(s)-1]; - if (c == 'g' || c == 'G') - m *= 1000*1000*1000; /* UNchecked! */ - else if (c == 'm' || c == 'M') - m *= 1000*1000; /* We do not use powers of 2 (1024) */ - else if (c == 'k' || c == 'K') /* to avoid possible bad effects on */ - m *= 1000; /* a direct-mapped cache. */ - else if (c == 'w' || c == 'W') - m *= sizeof(W_); - return (I_)m; -} - -static void -badoption(s) - char *s; -{ - fflush(stdout); - fprintf(stderr, "initSM: Bad RTS option: %s\n", s); - EXIT(EXIT_FAILURE); -} - -extern long strtol PROTO((const char *, char **, int)); /* ToDo: properly? */ - -I_ -initSM(rts_argc, rts_argv, statsfile) - I_ rts_argc; - char **rts_argv; - FILE *statsfile; -{ - I_ arg; - - /* save statsfile info */ - SM_statsfile = statsfile; - - /* slurp through RTS args */ - - for (arg = 0; arg < rts_argc; arg++) { - if (rts_argv[arg][0] == '-') { - switch(rts_argv[arg][1]) { - case 'H': - SM_word_heap_size = decode(rts_argv[arg]+2) / sizeof(W_); - - if (SM_word_heap_size <= 0) badoption( rts_argv[arg] ); - break; - - case 'M': - SM_pc_free_heap = atof(rts_argv[arg]+2); - - if ((SM_pc_free_heap < 0) || (SM_pc_free_heap > 100)) - badoption( rts_argv[arg] ); - break; - - case 'A': - SM_alloc_size = decode(rts_argv[arg]+2) / sizeof(W_); - - if (SM_alloc_size == 0) SM_alloc_size = DEFAULT_ALLOC_SIZE; - break; - - case 'G': - SM_major_gen_size = decode(rts_argv[arg]+2) / sizeof(W_); - break; - - case 'F': - if (strcmp(rts_argv[arg]+2, "2s") == 0) { - SM_force_gc = USE_2s; - } else if (strcmp(rts_argv[arg]+2, "1s") == 0) { - badoption( rts_argv[arg] ); /* ToDo ! */ - } else { - badoption( rts_argv[arg] ); - } - break; - - case 'K': - SM_word_stk_size = decode(rts_argv[arg]+2) / sizeof(W_); - - if (SM_word_stk_size == 0) badoption( rts_argv[arg] ); - break; - - case 'S': - SM_stats_verbose++; - /* statsfile has already been determined */ - break; - case 's': - SM_stats_summary++; - /* statsfile has already been determined */ - break; - case 'B': - SM_ring_bell++; - break; - - case 'T': - if (rts_argv[arg][2] != '\0') - SM_trace = (I_) strtol(rts_argv[arg]+2, (char **)NULL, 0); - else - SM_trace = 1; - break; - -#ifdef GCdu - case 'u': - dualmodeInfo.resid_to_compact = atof(rts_argv[arg]+2); - dualmodeInfo.resid_from_compact = dualmodeInfo.resid_from_compact + 0.05; - if (dualmodeInfo.resid_from_compact < 0.0 || - dualmodeInfo.resid_to_compact > 1.0) { - badoption( rts_argv[arg] ); - } -#endif - - default: - /* otherwise none of my business */ - break; - } - } - /* else none of my business */ - } - - SM_alloc_min = (I_) (SM_word_heap_size * SM_pc_free_heap / 100); - - return(0); /* all's well */ -} \end{code} - \section[storage-manager-exit]{Winding up the storage manager} \begin{code} - -I_ -exitSM (sm_info) - smInfo *sm_info; +rtsBool +exitSM (smInfo *sm_info) { stat_exit(sm_info->hp - hp_start); - return(0); /* I'm happy */ + return rtsTrue; /* I'm happy */ } \end{code} diff --git a/ghc/runtime/storage/SMinternal.lh b/ghc/runtime/storage/SMinternal.lh index 697933787c..ddbb20cf73 100644 --- a/ghc/runtime/storage/SMinternal.lh +++ b/ghc/runtime/storage/SMinternal.lh @@ -22,29 +22,13 @@ This stuff needs to be documented. KH #include <sys/vadvise.h> #endif -extern I_ SM_force_gc; -#define USE_2s 1 -#define USE_1s 2 - -extern I_ SM_word_heap_size; /* all defined in SMinit.lc */ -extern I_ SM_alloc_min; -extern StgFloat SM_pc_free_heap; -extern I_ SM_alloc_size; -extern I_ SM_major_gen_size; -/*moved: extern I_ SM_word_stk_size; */ -extern FILE *SM_statsfile; -extern I_ SM_trace; -extern I_ SM_stats_summary; -extern I_ SM_stats_verbose; -extern I_ SM_ring_bell; - extern P_ heap_space; extern P_ hp_start; -extern void stat_init PROTO((char *collector, char *c1, char *c2)); -extern void stat_startGC PROTO((I_ alloc)); -extern void stat_endGC PROTO((I_ alloc, I_ collect, I_ live, char *comment)); -extern void stat_exit PROTO((I_ alloc)); +void stat_init PROTO((char *collector, char *c1, char *c2)); +void stat_startGC PROTO((I_ alloc)); +void stat_endGC PROTO((I_ alloc, I_ collect, I_ live, char *comment)); +void stat_exit PROTO((I_ alloc)); extern I_ MaxResidency; /* in words; for stats only */ extern I_ ResidencySamples; /* for stats only */ @@ -58,35 +42,20 @@ extern I_ ResidencySamples; /* for stats only */ } \ } while (0) -extern StgFunPtr _Dummy_entry(STG_NO_ARGS); -extern char *xmalloc PROTO((size_t)); +StgFunPtr _Dummy_entry(STG_NO_ARGS); -#if defined(_GC_DEBUG) +#if defined(DEBUG) #define DEBUG_SCAN(str, pos, to, topos) \ - if (SM_trace & 2) fprintf(stderr, "%s: 0x%lx, %s 0x%lx\n", str, pos, to, topos) + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ + fprintf(stderr, "%s: 0x%lx, %s 0x%lx\n", str, pos, to, topos) #define DEBUG_STRING(str) \ - if (SM_trace & 2) fprintf(stderr, "%s\n", str) + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ + fprintf(stderr, "%s\n", str) #else #define DEBUG_SCAN(str, pos, to, topos) #define DEBUG_STRING(str) #endif -/************************ Default HEAP and STACK sizes **********************/ - -/* A user can change these main defaults with a - "hooks" file equiv to runtime/hooks/SizeHooks.lc. -*/ - -#define DEFAULT_STACKS_SIZE 0x10002 /* 2^16 = 16Kwords = 64Kbytes */ - -#define DEFAULT_HEAP_SIZE 0x100002 /* 2^20 = 1Mwords = 4Mbytes */ -#define DEFAULT_ALLOC_SIZE 0x4002 /* 2^14 = 16k words = 64k bytes */ -#define DEFAULT_PC_FREE 3 /* 3% */ - -/* I added a couple of extra words above, to be more sure of avoiding - bad effects on direct-mapped caches. (WDP) -*/ - #define NEXT_SEMI_SPACE(space) ((space + 1) % 2) /************************ Random stuff **********************/ @@ -262,8 +231,8 @@ extern genData genInfo; #define EVAC_CODE(infoptr) ((StgEvacPtr) ((P_)(INFO_RTBL(infoptr)))[COPY_INFO_OFFSET]) #define SCAV_CODE(infoptr) ((StgScavPtr) ((P_)(INFO_RTBL(infoptr)))[COPY_INFO_OFFSET+1]) -extern void Scavenge(STG_NO_ARGS); -extern void _Scavenge_Forward_Ref(STG_NO_ARGS); +void Scavenge(STG_NO_ARGS); +void _Scavenge_Forward_Ref(STG_NO_ARGS); /* Note: any change to FORWARD_ADDRESS should be reflected in layout of MallocPtrs (includes/SMClosures.lh) @@ -294,7 +263,7 @@ MAYBE_DECLARE_RTBL(,_Evacuate_Forward_Ref,) const W_ MK_REP_LBL(,evac_forward,)[] = { \ INCLUDE_TYPE_INFO(INTERNAL) \ INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED) \ - INCLUDE_PAR_INFO \ + INCLUDE_PAR_INFO \ INCLUDE_COPYING_INFO(evac_forward,_Scavenge_Forward_Ref)\ INCLUDE_COMPACTING_INFO(INFO_UNUSED,INFO_UNUSED,INFO_UNUSED,INFO_UNUSED) \ } @@ -317,7 +286,7 @@ MAYBE_DECLARE_RTBL(Caf_Evac_Upd,,) const W_ MK_REP_LBL(Caf_Evac_Upd,,)[] = { \ INCLUDE_TYPE_INFO(INTERNAL) \ INCLUDE_SIZE_INFO(MIN_UPD_SIZE,INFO_UNUSED) \ - INCLUDE_PAR_INFO \ + INCLUDE_PAR_INFO \ INCLUDE_COPYING_INFO(_Evacuate_Caf_Evac_Upd,_Scavenge_Caf) \ INCLUDE_COMPACTING_INFO(INFO_UNUSED,INFO_UNUSED,INFO_UNUSED,INFO_UNUSED) \ } @@ -332,8 +301,8 @@ MAYBE_DECLARE_RTBL(Caf_Evac_Upd,,) #if defined(_INFO_MARKING) -extern I_ markHeapRoots PROTO((smInfo *sm, P_ cafs1, P_ cafs2, - P_ base, P_ lim, BitWord *bit_array)); +I_ markHeapRoots PROTO((smInfo *sm, P_ cafs1, P_ cafs2, + P_ base, P_ lim, BitWord *bit_array)); #define PRMARK_CODE(infoptr) \ (((FP_)(INFO_RTBL(infoptr)))[COMPACTING_INFO_OFFSET+1]) @@ -381,12 +350,12 @@ MAYBE_DECLARE_RTBL(,_PRMarking_MarkNextSpark,) MAYBE_DECLARE_RTBL(,_PRMarking_MarkNextRoot,) MAYBE_DECLARE_RTBL(,_PRMarking_MarkNextCAF,) -#define DUMMY_PRRETURN_RTBL(prreturn_code,dummy_code) \ - const W_ MK_REP_LBL(,prreturn_code,)[] = { \ - INCLUDE_TYPE_INFO(INTERNAL) \ - INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED) \ - INCLUDE_PAR_INFO \ - INCLUDE_COPYING_INFO(dummy_code,dummy_code) \ +#define DUMMY_PRRETURN_RTBL(prreturn_code,dummy_code) \ + const W_ MK_REP_LBL(,prreturn_code,)[] = { \ + INCLUDE_TYPE_INFO(INTERNAL) \ + INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED) \ + INCLUDE_PAR_INFO \ + INCLUDE_COPYING_INFO(dummy_code,dummy_code) \ INCLUDE_COMPACTING_INFO(dummy_code,dummy_code,dummy_code,prreturn_code) \ } @@ -477,11 +446,11 @@ MAYBE_DECLARE_RTBL(OldRoot,,) #endif /* ! GCgn */ -#if defined(_GC_DEBUG) +#if defined(DEBUG) #if defined(GCgn) #define DEBUG_LINK_LOCATION(location, closure, linklim) \ - if (SM_trace & 4) { \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MAJOR_GC) { \ if (DYNAMIC_CLOSURE(closure) && (closure <= linklim)) \ fprintf(stderr, " Link Loc: 0x%lx to 0x%lx\n", location, closure); \ else if (! DYNAMIC_CLOSURE(closure)) \ @@ -491,7 +460,7 @@ MAYBE_DECLARE_RTBL(OldRoot,,) } #else /* ! GCgn */ #define DEBUG_LINK_LOCATION(location, closure) \ - if (SM_trace & 4) { \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MAJOR_GC) { \ if (DYNAMIC_CLOSURE(closure)) \ fprintf(stderr, " Link Loc: 0x%lx to 0x%lx\n", location, closure); \ else \ @@ -500,15 +469,15 @@ MAYBE_DECLARE_RTBL(OldRoot,,) #endif /* ! GCgn */ #define DEBUG_UNLINK_LOCATION(location, closure, newlocation) \ - if (SM_trace & 4) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MAJOR_GC) \ fprintf(stderr, " UnLink Loc: 0x%lx, 0x%lx -> 0x%lx\n", location, closure, newlocation) #define DEBUG_LINK_CAF(caf) \ - if (SM_trace & 4) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MAJOR_GC) \ fprintf(stderr, "Caf: 0x%lx Closure: 0x%lx\n", caf, IND_CLOSURE_PTR(caf)) #define DEBUG_SET_MARK(closure, hp_word) \ - if (SM_trace & 8) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) \ fprintf(stderr, " Set Mark Bit: 0x%lx, word %ld, bit_word %ld, bit %d\n", closure, hp_word, hp_word / BITS_IN(BitWord), hp_word & (BITS_IN(BitWord) - 1)) #else diff --git a/ghc/runtime/storage/SMmark.lhc b/ghc/runtime/storage/SMmark.lhc index ae6a3fab8e..13b55c9f8e 100644 --- a/ghc/runtime/storage/SMmark.lhc +++ b/ghc/runtime/storage/SMmark.lhc @@ -747,6 +747,8 @@ STGFUN(_PRStart_Ind) { FUNBEGIN; DEBUG_PR_IND; + GC_SHORT_IND(); /* ticky: record that we shorted an indirection */ + Mark = (P_) IND_CLOSURE_PTR(Mark); JUMP_MARK; FUNEND; @@ -756,29 +758,25 @@ STGFUN(_PRStart_Ind) ``Permanent indirection''---used in profiling. Works basically like @_PRStart_1@ (one pointer). \begin{code} -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) || defined(TICKY_TICKY) + STGFUN(_PRStart_PI) { FUNBEGIN; -/* This test would be here if it really was like a PRStart_1. - But maybe it is not needed because a PI cannot have two - things pointing at it (so no need to mark it), because - they are only created in exactly one place in UpdatePAP. - ??? WDP 95/07 if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; JUMP_MARK_RETURN; } else { -*/ INIT_MARK_NODE("PI ",1); /* the "1" above is dodgy (i.e. wrong), but it is never used except in debugging info. ToDo??? WDP 95/07 */ INIT_MSTACK(PERM_IND_CLOSURE_PTR); -/* } */ + } FUNEND; } + STGFUN(_PRIn_PI) { FUNBEGIN; @@ -788,7 +786,8 @@ STGFUN(_PRIn_PI) */ FUNEND; } -#endif + +#endif /* PROFILING or TICKY */ \end{code} Marking a ``selector closure'': This is a size-2 SPEC thunk that @@ -800,39 +799,26 @@ unevaluated, then we behave {\em exactly as for a SPEC-2 thunk}. or ``on the way back up'' (\tr{_PRIn_Selector})?} Answer: probably on the way down. Downside: we are flummoxed by indirections, so we'll have to wait until the {\em next} major GC to do the selections (after -the indirections are sorted out in this GC). But the downside of +the indirections are shorted out in this GC). But the downside of doing selections on the way back up is that we are then in a world of reversed pointers, and selecting a reversed pointer---we've see this on selectors for very recursive structures---is a total disaster. (WDP 94/12) \begin{code} -#if defined(_GC_DEBUG) +#if defined(DEBUG) #define IF_GC_DEBUG(x) x #else #define IF_GC_DEBUG(x) /*nothing*/ #endif -/* _PRStartSelector_<n> is a (very) glorified _PRStart_1 */ +#if !defined(CONCURRENT) +# define NOT_BLACKHOLING (! RTSflags.GcFlags.lazyBlackHoling) +#else +# define NOT_BLACKHOLING 0 +#endif -#if 0 -/* testing */ -#define MARK_SELECTOR(n) \ -STGFUN(CAT2(_PRStartSelector_,n)) \ -{ \ - P_ maybe_con; \ - FUNBEGIN; \ - \ - /* must be a SPEC 2 1 closure */ \ - ASSERT(INFO_SIZE(INFO_PTR(Mark)) == 2); \ - ASSERT(INFO_NoPTRS(INFO_PTR(Mark)) == 1); \ - ASSERT(MIN_UPD_SIZE == 2); /* otherwise you are hosed */ \ - \ - JMP_(_PRStart_1); \ - \ - FUNEND; \ -} -#endif /* 0 */ +/* _PRStartSelector_<n> is a (very) glorified _PRStart_1 */ #define MARK_SELECTOR(n) \ STGFUN(CAT2(_PRStartSelector_,n)) \ @@ -853,8 +839,8 @@ STGFUN(CAT2(_PRStartSelector_,n)) \ maybe_con = (P_) *(Mark + _FHS); \ \ IF_GC_DEBUG( \ - if (SM_trace & 2) { \ - fprintf(stderr, "Start Selector %d: 0x%lx, info 0x%lx, size %ld, ptrs %ld, maybe_con 0x%lx, marked? 0x%%lx, info 0x%lx", \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) { \ + fprintf(stderr, "Start Selector %d: 0x%lx, info 0x%lx, size %ld, ptrs %ld, maybe_con 0x%lx, info 0x%lx", \ (n), Mark, INFO_PTR(Mark), INFO_SIZE(INFO_PTR(Mark)), \ INFO_NoPTRS(INFO_PTR(Mark)), \ maybe_con, /*danger:IS_MARK_BIT_SET(maybe_con),*/ \ @@ -864,10 +850,6 @@ STGFUN(CAT2(_PRStartSelector_,n)) \ INFO_SIZE(INFO_PTR(maybe_con)), \ INFO_NoPTRS(INFO_PTR(maybe_con))); \ if (INFO_TAG(INFO_PTR(maybe_con)) >=0) { \ - /* int i; */ \ - /* for (i = 0; i < INFO_SIZE(INFO_PTR(maybe_con)); i++) { */ \ - /* fprintf(stderr, ", 0x%lx", maybe_con[_FHS + i]); */ \ - /*}*/ \ fprintf(stderr, "=> 0x%lx", maybe_con[_FHS + (n)]); \ } \ fprintf(stderr, "\n"); \ @@ -875,7 +857,9 @@ STGFUN(CAT2(_PRStartSelector_,n)) \ \ if (IS_STATIC(INFO_PTR(maybe_con)) /* static: cannot chk mark bit */\ || IS_MARK_BIT_SET(maybe_con) /* been here: may be mangled */ \ - || INFO_TAG(INFO_PTR(maybe_con)) < 0) /* not in WHNF */ \ + || INFO_TAG(INFO_PTR(maybe_con)) < 0 /* not in WHNF */ \ + || NOT_BLACKHOLING /* see "price of laziness" paper */ \ + || (! RTSflags.GcFlags.doSelectorsAtGC )) \ /* see below for OLD test we used here (WDP 95/04) */ \ /* ToDo: decide WHNFness another way? */ \ JMP_(_PRStart_1); \ @@ -885,6 +869,7 @@ STGFUN(CAT2(_PRStartSelector_,n)) \ /* ASSERT((n) < INFO_SIZE(INFO_PTR(maybe_con))); not true if static */ \ \ /* OK, it is evaluated: behave just like an indirection */ \ + GC_SEL_MAJOR(); /* ticky-ticky */ \ \ Mark = (P_) (maybe_con[_FHS + (n)]); \ /* Mark now has the result of the selection */ \ @@ -932,7 +917,27 @@ STGFUN(_PRStart_Const) { FUNBEGIN; DEBUG_PR_CONST; + +#ifndef TICKY_TICKY + /* normal stuff */ Mark = (P_) CONST_STATIC_CLOSURE(INFO_PTR(Mark)); + +#else /* TICKY */ + if (IS_MARK_BIT_SET(Mark)) { + DEBUG_PR_MARKED; + } else { + if (!AllFlags.doUpdEntryCounts) { + + GC_COMMON_CONST(); /* ticky */ + + Mark = (P_) CONST_STATIC_CLOSURE(INFO_PTR(Mark)); + + } else { /* no commoning */ + INIT_MARK_NODE("CONST ",0); + } + } +#endif /* TICKY */ + JUMP_MARK_RETURN; FUNEND; } @@ -945,9 +950,37 @@ closure. \begin{code} STGFUN(_PRStart_CharLike) { + I_ val; + FUNBEGIN; + DEBUG_PR_CHARLIKE; + +#ifndef TICKY_TICKY + /* normal stuff */ + Mark = (P_) CHARLIKE_CLOSURE(CHARLIKE_VALUE(Mark)); + +#else /* TICKY */ + + if (IS_MARK_BIT_SET(Mark)) { + DEBUG_PR_MARKED; + } else { + val = CHARLIKE_VALUE(Mark); + + if (!AllFlags.doUpdEntryCounts) { + GC_COMMON_CHARLIKE(); /* ticky */ + + INFO_PTR(Mark) = (W_) Ind_info; + IND_CLOSURE_PTR(Mark) = (W_) CHARLIKE_CLOSURE(val); + Mark = (P_) IND_CLOSURE_PTR(Mark); + + } else { /* no commoning */ + INIT_MARK_NODE("CHAR ",0); + } + } +#endif /* TICKY */ + JUMP_MARK_RETURN; FUNEND; } @@ -966,57 +999,34 @@ STGFUN(_PRStart_IntLike) if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; } else { - val = INTLIKE_VALUE(Mark); + val = INTLIKE_VALUE(Mark); + + if (val >= MIN_INTLIKE + && val <= MAX_INTLIKE +#ifdef TICKY_TICKY + && !AllFlags.doUpdEntryCounts +#endif + ) { + DEBUG_PR_INTLIKE_TO_STATIC; + GC_COMMON_INTLIKE(); /* ticky */ - if ((val <= MAX_INTLIKE) && (val >= MIN_INTLIKE)) { - DEBUG_PR_INTLIKE_TO_STATIC; INFO_PTR(Mark) = (W_) Ind_info; IND_CLOSURE_PTR(Mark) = (W_) INTLIKE_CLOSURE(val); Mark = (P_) IND_CLOSURE_PTR(Mark); - } else { - /* out of range of static closures */ - DEBUG_PR_INTLIKE_IN_HEAP; + + } else { /* out of range of static closures */ + DEBUG_PR_INTLIKE_IN_HEAP; +#ifdef TICKY_TICKY + if (!AllFlags.doUpdEntryCounts) GC_COMMON_INTLIKE_FAIL(); +#endif INIT_MARK_NODE("INT ",0); - } + } } JUMP_MARK_RETURN; FUNEND; } \end{code} -CHANGE THIS FOR THE @COMMON_ITBLS@ WORLD! - -\begin{code} -#if defined(GCgn) - -/* Marking an OldGen root -- treat as indirection if it references the old generation */ - -STGFUN(_PRStart_OldRoot) -{ - P_ oldroot; - - FUNBEGIN; - oldroot = (P_) IND_CLOSURE_PTR(Mark); - - if (oldroot <= HeapLim) /* does the root reference the old generation ? */ - { - DEBUG_PR_OLDIND; - Mark = oldroot; /* short circut if the old generation root */ - JUMP_MARK; /* references an old generation closure */ - } - - else - { - INIT_MARK_NODE("OldRoot",1); /* oldroot to new generation */ - INIT_MSTACK(SPEC_CLOSURE_PTR); /* treat as _PRStart_1 */ - } - FUNEND; -} - -#endif /* GCgn */ - -\end{code} - Special error routine, used for closures which should never call their ``in'' code. @@ -1232,6 +1242,9 @@ STGFUN(_PRStart_StkO) I_ cts_size; FUNBEGIN; + + /* ToDo: ASSERT(sanityChk_StkO(Mark)); ??? */ + if (IS_MARK_BIT_SET(Mark)) { DEBUG_PR_MARKED; JUMP_MARK_RETURN; @@ -1323,7 +1336,7 @@ STGFUN(_PRIn_StkO) % %**************************************************************************** -A CAF is shorted out as if it is an indirection. +A CAF is shorted out as if it were an indirection. The CAF reference is explicitly updated by the garbage collector. \begin{code} @@ -1331,89 +1344,12 @@ STGFUN(_PRStart_Caf) { FUNBEGIN; DEBUG_PR_CAF; - Mark = (P_) IND_CLOSURE_PTR(Mark); - JUMP_MARK; - FUNEND; -} - -#if 0 /* Code to avoid explicit updating of CAF references */ - /* We need auxiliary mark and update reference info table */ - -CAF_MARK_UPD_ITBL(Caf_Mark_Upd_info,const); - -/* Start marking a CAF -- special mark upd info table */ -/* Change to marking state and mark reference */ - -STGFUN(_PRStart_Caf) -{ - FUNBEGIN; - if (IS_MARK_BIT_SET(Mark)) { - DEBUG_PR_MARKED; - JUMP_MARK_RETURN; - } else { - INIT_MARK_NODE("CAF ",1); - INIT_MSTACK(IND_CLOSURE_PTR2); - } - FUNEND; -} + GC_SHORT_CAF(); /* ticky */ -/* Completed marking a CAF -- special mark upd info table */ -/* Change info table back to normal CAF info, return reference (Mark) */ - -STGFUN(_PRInLast_Caf) -{ - P_ temp; - - FUNBEGIN; - DEBUG_PRLAST_CAF; - SET_INFO_PTR(MStack, Caf_info); /* normal marked CAF */ - - /* Like POP_MSTACK */ - temp = MStack; - MStack = (P_) IND_CLOSURE_PTR(temp); - IND_CLOSURE_PTR(temp) = (W_) Mark; - - /* Mark left unmodified so CAF reference is returned */ - JUMP_MARK_RETURN; - FUNEND; -} - -/* Marking a CAF currently being marked -- special mark upd info table */ -/* Just return CAF as if marked -- wont be shorted out */ -/* Marking once reference marked and updated -- normal CAF info table */ -/* Return reference to short CAF out */ - -STGFUN(_PRStart_Caf) -{ - FUNBEGIN; - if (IS_MARK_BIT_SET(Mark)) { - DEBUG_PR_MARKING_CAF; - JUMP_MARK_RETURN; - } else { - DEBUG_PR_MARKED_CAF; Mark = (P_) IND_CLOSURE_PTR(Mark); - JUMP_MARK_RETURN; - } + JUMP_MARK; FUNEND; } - -#define DEBUG_PR_MARKED_CAF \ - if (SM_trace & 8) \ - fprintf(stderr, "PRMark CAF (Marked): 0x%lx -> 0x%lx, info 0x%lx\n", \ - Mark, IND_CLOSURE_PTR(Mark), INFO_PTR(Mark)) - -#define DEBUG_PR_MARKING_CAF \ - if (SM_trace & 8) \ - fprintf(stderr, "PRMark CAF (Marking): 0x%lx -> 0x%lx, info 0x%lx\n", \ - Mark, Mark, INFO_PTR(Mark)) - -#define DEBUG_PRLAST_CAF \ - if (SM_trace & 8) \ - fprintf(stderr, "PRRet Last (CAF ): 0x%lx -> 0x%lx, info 0x%lx -> 0x%lx ptrs 1\n", \ - MStack, Mark, INFO_PTR(MStack), Caf_info) - -#endif /* 0 */ - \end{code} %**************************************************************************** @@ -1432,10 +1368,24 @@ STGFUN(_Dummy_PRReturn_entry) FUNBEGIN; fprintf(stderr,"Called _Dummy_PRReturn_entry\nShould never occur!\n"); abort(); - return(0); /* won't happen; quiets compiler warnings */ FUNEND; } +/* various ways to call _Dummy_PRReturn_entry: */ + +INTFUN(_PRMarking_MarkNextRoot_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; } +#ifdef CONCURRENT +INTFUN(_PRMarking_MarkNextSpark_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; } +#endif +#ifdef PAR +INTFUN(_PRMarking_MarkNextGA_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; } +#endif +INTFUN(_PRMarking_MarkNextAStack_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; } +INTFUN(_PRMarking_MarkNextBStack_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; } +INTFUN(_PRMarking_MarkNextCAF_entry) { FB_; JMP_(_Dummy_PRReturn_entry); FE_; } + +/* end of various ways to call _Dummy_PRReturn_entry */ + EXTFUN(_PRMarking_MarkNextRoot); EXTFUN(_PRMarking_MarkNextCAF); @@ -1456,42 +1406,42 @@ CAT_DECLARE(Dummy_PrReturn,INTERNAL_KIND,"DUMMY_PRRETURN","DUMMY_PRRETURN") DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextRoot_closure, _PRMarking_MarkNextRoot_info, _PRMarking_MarkNextRoot, - _Dummy_PRReturn_entry); + _PRMarking_MarkNextRoot_entry); #ifdef CONCURRENT DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextSpark_closure, _PRMarking_MarkNextSpark_info, _PRMarking_MarkNextSpark, - _Dummy_PRReturn_entry); + _PRMarking_MarkNextSpark_entry); #endif #ifdef PAR DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextGA_closure, _PRMarking_MarkNextGA_info, _PRMarking_MarkNextGA, - _Dummy_PRReturn_entry); + _PRMarking_MarkNextGA_entry); #else DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextAStack_closure, _PRMarking_MarkNextAStack_info, _PRMarking_MarkNextAStack, - _Dummy_PRReturn_entry); + _PRMarking_MarkNextAStack_entry); DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextBStack_closure, _PRMarking_MarkNextBStack_info, _PRMarking_MarkNextBStack, - _Dummy_PRReturn_entry); + _PRMarking_MarkNextBStack_entry); #endif /* PAR */ DUMMY_PRRETURN_CLOSURE(_PRMarking_MarkNextCAF_closure, _PRMarking_MarkNextCAF_info, _PRMarking_MarkNextCAF, - _Dummy_PRReturn_entry); + _PRMarking_MarkNextCAF_entry); + +extern P_ sm_roots_end; /* &roots[rootno] -- one beyond the end */ STGFUN(_PRMarking_MarkNextRoot) { - extern P_ sm_roots_end; /* &roots[rootno] -- one beyond the end */ - FUNBEGIN; /* Update root -- may have short circuited Ind */ *MRoot = (W_) Mark; @@ -1506,10 +1456,10 @@ STGFUN(_PRMarking_MarkNextRoot) } #ifdef CONCURRENT +extern P_ sm_roots_end; /* PendingSparksTl[pool] */ + STGFUN(_PRMarking_MarkNextSpark) { - extern P_ sm_roots_end; /* PendingSparksTl[pool] */ - FUNBEGIN; /* Update root -- may have short circuited Ind */ *MRoot = (W_) Mark; @@ -1587,7 +1537,8 @@ Mark the next CAF in the CAF list. STGFUN(_PRMarking_MarkNextCAF) { FUNBEGIN; - /* Update root -- may have short circuted Ind */ + + /* Update root -- may have short circuited Ind */ IND_CLOSURE_PTR(MRoot) = (W_) Mark; MRoot = (P_) IND_CLOSURE_LINK(MRoot); @@ -1596,29 +1547,12 @@ STGFUN(_PRMarking_MarkNextCAF) if (MRoot == 0) RESUME_(miniInterpretEnd); - Mark = (P_) IND_CLOSURE_PTR(MRoot); - JUMP_MARK; - FUNEND; -} -\end{code} - -\begin{code} -#if 0 /* Code to avoid explicit updating of CAF references */ + GC_SHORT_CAF(); /* ticky (ToDo: wrong?) */ -STGFUN(_PRMarking_MarkNextCAF) -{ - FUNBEGIN; - MRoot = (P_) IND_CLOSURE_LINK(MRoot); - - /* Is the next CAF the end of the list */ - if (MRoot == 0) - RESUME_(miniInterpretEnd); - - Mark = MRoot; + Mark = (P_) IND_CLOSURE_PTR(MRoot); JUMP_MARK; FUNEND; } -#endif /* 0 */ \end{code} Multi-slurp protection. diff --git a/ghc/runtime/storage/SMmarkDefs.lh b/ghc/runtime/storage/SMmarkDefs.lh index fccce1aaa2..259429c570 100644 --- a/ghc/runtime/storage/SMmarkDefs.lh +++ b/ghc/runtime/storage/SMmarkDefs.lh @@ -239,65 +239,65 @@ a closure. Define some debugging macros. \begin{code} -#if defined(_GC_DEBUG) +#if defined(DEBUG) #define DEBUG_PRSTART(type, ptrsvar) \ - if (SM_trace & 8) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) \ fprintf(stderr, "PRMark Start (%s): 0x%lx, info 0x%lx ptrs %ld\n", \ type, Mark, INFO_PTR(Mark), ptrsvar) #define DEBUG_PRIN(type, posvar) \ - if (SM_trace & 8) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) \ fprintf(stderr, "PRRet In (%s): 0x%lx, info 0x%lx pos %ld\n", \ type, MStack, INFO_PTR(MStack), posvar) #define DEBUG_PRLAST(type, ptrvar) \ - if (SM_trace & 8) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) \ fprintf(stderr, "PRRet Last (%s): 0x%lx, info 0x%lx ptrs %ld\n", \ type, MStack, INFO_PTR(MStack), ptrvar) #define DEBUG_PR_MARKED \ - if (SM_trace & 8) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) \ fprintf(stderr, "PRMark Marked : 0x%lx, info 0x%lx\n", \ Mark, INFO_PTR(Mark)) #define DEBUG_PR_STAT \ - if (SM_trace & 8) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) \ fprintf(stderr, "PRMark Static : 0x%lx, info 0x%lx\n", \ Mark, INFO_PTR(Mark)) #define DEBUG_PR_IND \ - if (SM_trace & 8) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) \ fprintf(stderr, "PRMark Ind : 0x%lx -> PRMark(0x%lx), info 0x%lx\n", \ Mark, IND_CLOSURE_PTR(Mark), INFO_PTR(Mark)) #define DEBUG_PR_CAF \ - if (SM_trace & 8) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) \ fprintf(stderr, "PRMark Caf : 0x%lx -> PRMark(0x%lx), info 0x%lx\n", \ Mark, IND_CLOSURE_PTR(Mark), INFO_PTR(Mark)) #define DEBUG_PR_CONST \ - if (SM_trace & 8) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) \ fprintf(stderr, "PRMark Const : 0x%lx -> 0x%lx, info 0x%lx\n", \ Mark, CONST_STATIC_CLOSURE(INFO_PTR(Mark)), INFO_PTR(Mark)) #define DEBUG_PR_CHARLIKE \ - if (SM_trace & 8) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) \ fprintf(stderr, "PRMark CharLike (%lx) : 0x%lx -> 0x%lx, info 0x%lx\n", \ CHARLIKE_VALUE(Mark), Mark, CHARLIKE_CLOSURE(CHARLIKE_VALUE(Mark)), INFO_PTR(Mark)) #define DEBUG_PR_INTLIKE_TO_STATIC \ - if (SM_trace & 8) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) \ fprintf(stderr, "PRMark IntLike to Static (%ld) : 0x%lx -> 0x%lx, info 0x%lx\n", \ INTLIKE_VALUE(Mark), Mark, INTLIKE_CLOSURE(INTLIKE_VALUE(Mark)), INFO_PTR(Mark)) #define DEBUG_PR_INTLIKE_IN_HEAP \ - if (SM_trace & 8) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) \ fprintf(stderr, "PRMark IntLike in Heap (%ld) : 0x%lx, info 0x%lx\n", \ INTLIKE_VALUE(Mark), Mark, INFO_PTR(Mark)) #define DEBUG_PR_OLDIND \ - if (SM_trace & 8) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MARKING) \ fprintf(stderr, "PRMark OldRoot Ind : 0x%lx -> PRMark(0x%lx), info 0x%lx\n", \ Mark, IND_CLOSURE_PTR(Mark), INFO_PTR(Mark)) diff --git a/ghc/runtime/storage/SMmarking.lc b/ghc/runtime/storage/SMmarking.lc index 33d366ea68..ae92832b48 100644 --- a/ghc/runtime/storage/SMmarking.lc +++ b/ghc/runtime/storage/SMmarking.lc @@ -9,8 +9,6 @@ #define MARK_REG_MAP #include "SMinternal.h" -extern I_ doSanityChks; /* ToDo: move tidily */ - #if defined(_INFO_MARKING) #if defined (__STG_GCC_REGS__) /* If we are using registers load _SAVE */ @@ -62,37 +60,6 @@ markHeapRoots(sm, cafs1, cafs2, base, lim, bit_array) int pool; #endif -#if 0 /* Code to avoid explicit updating of CAF references */ - - /* Before marking have to modify CAFs to auxillary info table */ - P_ CAFptr; - DEBUG_STRING("Setting Mark & Upd CAFs:"); - for (CAFptr = cafs1; CAFptr; - CAFptr = (P_) IND_CLOSURE_LINK(CAFptr)) { - INFO_PTR(CAFptr) = (W_) Caf_Mark_Upd_info; - } - for (CAFptr = cafs2; CAFptr; - CAFptr = (P_) IND_CLOSURE_LINK(CAFptr)) { - INFO_PTR(CAFptr) = (W_) Caf_Mark_Upd_info; - } - DEBUG_STRING("Marking CAFs:"); - if (cafs1) { - MRoot = (P_) cafs1; - Mark = (P_) MRoot; - MStack = (P_) _PRMarking_MarkNextCAF_closure; - /*ToDo: debugify */ - miniInterpret((StgFunPtr)_startMarkWorld); - } - if (cafs2) { - MRoot = (P_) cafs2; - Mark = (P_) MRoot; - MStack = (P_) _PRMarking_MarkNextCAF_closure; - /*ToDo: debugify */ - miniInterpret((StgFunPtr)_startMarkWorld); - } - -#endif /* 0 */ - BitArray = bit_array; HeapBase = base; HeapLim = lim; @@ -103,14 +70,8 @@ markHeapRoots(sm, cafs1, cafs2, base, lim, bit_array) MRoot = (P_) sm->roots; Mark = (P_) *MRoot; MStack = (P_) _PRMarking_MarkNextRoot_closure; -#if defined(__STG_TAILJUMPS__) - miniInterpret((StgFunPtr)_startMarkWorld); -#else - if (doSanityChks) - miniInterpret_debug((StgFunPtr)_startMarkWorld, NULL); - else + miniInterpret((StgFunPtr)_startMarkWorld); -#endif /* ! tail-jumping */ } #ifdef CONCURRENT @@ -120,14 +81,8 @@ markHeapRoots(sm, cafs1, cafs2, base, lim, bit_array) MRoot = (P_) PendingSparksHd[pool]; Mark = (P_) *MRoot; MStack = (P_) _PRMarking_MarkNextSpark_closure; -#if defined(__STG_TAILJUMPS__) - miniInterpret((StgFunPtr)_startMarkWorld); -#else - if (doSanityChks) - miniInterpret_debug((StgFunPtr)_startMarkWorld, NULL); - else + miniInterpret((StgFunPtr)_startMarkWorld); -#endif /* ! tail-jumping */ } } #endif @@ -140,14 +95,8 @@ markHeapRoots(sm, cafs1, cafs2, base, lim, bit_array) if (MRoot != NULL) { Mark = ((GALA *)MRoot)->la; MStack = (P_) _PRMarking_MarkNextGA_closure; -#if defined(__STG_TAILJUMPS__) + miniInterpret((StgFunPtr) _startMarkWorld); -#else - if (doSanityChks) - miniInterpret_debug((StgFunPtr) _startMarkWorld, NULL); - else - miniInterpret((StgFunPtr) _startMarkWorld); -#endif /* ! tail-jumping */ } #else /* Note: no *external* stacks in parallel world */ @@ -156,14 +105,8 @@ markHeapRoots(sm, cafs1, cafs2, base, lim, bit_array) MRoot = (P_) MAIN_SpA; Mark = (P_) *MRoot; MStack = (P_) _PRMarking_MarkNextAStack_closure; -#if defined(__STG_TAILJUMPS__) - miniInterpret((StgFunPtr)_startMarkWorld); -#else - if (doSanityChks) - miniInterpret_debug((StgFunPtr)_startMarkWorld, NULL); - else + miniInterpret((StgFunPtr)_startMarkWorld); -#endif /* ! tail-jumping */ } DEBUG_STRING("Marking B Stack:"); @@ -177,37 +120,25 @@ markHeapRoots(sm, cafs1, cafs2, base, lim, bit_array) DEBUG_STRING("Marking & Updating CAFs:"); if (cafs1) { - MRoot = cafs1; - Mark = (P_) IND_CLOSURE_PTR(MRoot); + MRoot = cafs1; + Mark = (P_) IND_CLOSURE_PTR(MRoot); MStack = (P_) _PRMarking_MarkNextCAF_closure; -#if defined(__STG_TAILJUMPS__) - miniInterpret((StgFunPtr)_startMarkWorld); -#else - if (doSanityChks) - miniInterpret_debug((StgFunPtr)_startMarkWorld, NULL); - else + miniInterpret((StgFunPtr)_startMarkWorld); -#endif /* ! tail-jumping */ } if (cafs2) { - MRoot = cafs2; - Mark = (P_) IND_CLOSURE_PTR(MRoot); + MRoot = cafs2; + Mark = (P_) IND_CLOSURE_PTR(MRoot); MStack = (P_) _PRMarking_MarkNextCAF_closure; -#if defined(__STG_TAILJUMPS__) - miniInterpret((StgFunPtr)_startMarkWorld); -#else - if (doSanityChks) - miniInterpret_debug((StgFunPtr)_startMarkWorld, NULL); - else + miniInterpret((StgFunPtr)_startMarkWorld); -#endif /* ! tail-jumping */ } + return 0; } #endif /* _INFO_MARKING */ - \end{code} diff --git a/ghc/runtime/storage/SMscan.lc b/ghc/runtime/storage/SMscan.lc index 35f1b056e6..35534bb41d 100644 --- a/ghc/runtime/storage/SMscan.lc +++ b/ghc/runtime/storage/SMscan.lc @@ -61,7 +61,8 @@ Inplace_Compaction(base, lim, scanbase, scanlim, bit_array, bit_array_words #endif { BitWord *bit_array_ptr, *bit_array_end; - P_ scan_w_start, info; I_ size; + P_ scan_w_start, info; + I_ size; LinkLim = lim; /* Only checked for generational collection */ @@ -118,12 +119,6 @@ Inplace_Compaction(base, lim, scanbase, scanlim, bit_array, bit_array_words info = next; } INFO_PTR(Scan) = (W_) info; -/* -if (SM_trace & 8) { - fprintf(stderr, " Marked: word %ld, val 0x%lx, cur 0x%lx, Scan_w 0x%lx, Scan 0x%lx, Info 0x%lx, Code 0x%lx\n", - (bit_array_ptr-1) - bit_array, *(bit_array_ptr-1), w, scan_w_start, Scan, info, - SCAN_LINK_CODE(info)); }; -*/ size = (*SCAN_LINK_CODE(info))(); @@ -175,29 +170,17 @@ if (SM_trace & 8) { w >>= 1; } else { /* Bit Set -- Enter ScanMove for closure*/ -/*HACK if (SM_trace&8) {fprintf(stderr,"Scan=%x\n",Scan);} */ info = (P_) INFO_PTR(Scan); -/*HACK if (SM_trace&8) {fprintf(stderr,"info=%x\n",info);} */ while (MARKED_LOCATION(info)) { P_ next; info = UNMARK_LOCATION(info); next = (P_) *info; -/*HACK if (SM_trace&8) {fprintf(stderr,"next=%x\n",next);} */ DEBUG_UNLINK_LOCATION(info, Scan, New); -/*HACK if (SM_trace&8) {fprintf(stderr,"New=%x\n",New);} */ *info = (W_) New; info = next; -/*HACK if (SM_trace&8) {fprintf(stderr,"*info=%x,info=%x\n",*info,info);} */ } -/*HACK if (SM_trace&8) {fprintf(stderr,"preNew info=%x\n",info);} */ INFO_PTR(New) = (W_) info; -/* -if (SM_trace & 8) { - fprintf(stderr, " Marked: word %ld, cur 0x%lx, Scan_w 0x%lx, Scan 0x%lx, Info 0x%lx, Code 0x%lx\n", - (bit_array_ptr-1) - bit_array, w, scan_w_start, Scan, info, SCAN_MOVE_CODE(info)); }; -*/ - size = (*SCAN_MOVE_CODE(info))(); New += size; /* set New address of next closure */ Scan += size; /* skip size bits */ @@ -356,15 +339,15 @@ LinkLim -- The limit of the heap requiring to be linked & moved #endif -#if defined(_GC_DEBUG) +#if defined(DEBUG) #define DEBUG_SCAN_LINK(type, sizevar, ptrvar) \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Scan Link (%s): 0x%lx -> 0x%lx, info 0x%lx, size %ld, ptrs %ld\n", \ type, Scan, New, INFO_PTR(Scan), sizevar, ptrvar) #define DEBUG_SCAN_MOVE(type, sizevar) \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Scan Move (%s): 0x%lx -> 0x%lx, info 0x%lx, size %ld\n", \ type, Scan, New, INFO_PTR(New), sizevar) @@ -378,106 +361,128 @@ LinkLim -- The limit of the heap requiring to be linked & moved /*** LINKING CLOSURES ***/ +#ifdef TICKY_TICKY I_ -_ScanLink_1_0(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SPEC", 1, 0); - return(FIXED_HS + 1); /* SPEC_VHS is defined to be 0, so "size" really is 1 */ +_ScanLink_0_0(STG_NO_ARGS) { + I_ size = 0; /* NB: SPEC_VHS is *defined* to be zero */ + DEBUG_SCAN_LINK("SPEC", size, 0); + return(FIXED_HS + size); } +#endif + I_ -_ScanLink_2_0(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SPEC", 2, 0); - return(FIXED_HS + 2); +_ScanLink_1_0(STG_NO_ARGS) { + I_ size = 1; /* NB: SPEC_VHS is *defined* to be zero */ + DEBUG_SCAN_LINK("SPEC", size, 0); + return(FIXED_HS + size); } I_ -_ScanLink_3_0(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SPEC", 3, 0); - return(FIXED_HS + 3); +_ScanLink_1_1(STG_NO_ARGS) { + I_ size = 1; + DEBUG_SCAN_LINK("SPEC", size, 1); + SPEC_LINK_LOCATION(1); + return(FIXED_HS + size); } I_ -_ScanLink_4_0(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SPEC", 4, 0); - return(FIXED_HS + 4); +_ScanLink_2_0(STG_NO_ARGS) { + I_ size = 2; + DEBUG_SCAN_LINK("SPEC", size, 0); + return(FIXED_HS + size); } I_ -_ScanLink_5_0(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SPEC", 5, 0); - return(FIXED_HS + 5); -} - -I_ _ScanLink_2_1(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SPEC", 2, 1); + I_ size = 2; + DEBUG_SCAN_LINK("SPEC", size, 1); SPEC_LINK_LOCATION(1); - return(FIXED_HS + 2); + return(FIXED_HS + size); } I_ -_ScanLink_3_1(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SPEC", 3, 1); +_ScanLink_2_2(STG_NO_ARGS) { + I_ size = 2; + DEBUG_SCAN_LINK("SPEC", size, 2); SPEC_LINK_LOCATION(1); - return(FIXED_HS + 3); + SPEC_LINK_LOCATION(2); + return(FIXED_HS + size); } I_ -_ScanLink_3_2(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SPEC", 3, 2); - SPEC_LINK_LOCATION(1); - SPEC_LINK_LOCATION(2); - return(FIXED_HS + 3); +_ScanLink_3_0(STG_NO_ARGS) { + I_ size = 3; + DEBUG_SCAN_LINK("SPEC", size, 0); + return(FIXED_HS + size); } - I_ -_ScanLink_1_1(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SPEC", 1, 1); +_ScanLink_3_1(STG_NO_ARGS) { + I_ size = 3; + DEBUG_SCAN_LINK("SPEC", size, 1); SPEC_LINK_LOCATION(1); - return(FIXED_HS + 1); + return(FIXED_HS + size); } I_ -_ScanLink_2_2(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SPEC", 2, 2); +_ScanLink_3_2(STG_NO_ARGS) { + I_ size = 3; + DEBUG_SCAN_LINK("SPEC", size, 2); SPEC_LINK_LOCATION(1); SPEC_LINK_LOCATION(2); - return(FIXED_HS + 2); + return(FIXED_HS + size); } I_ _ScanLink_3_3(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SPEC", 3, 3); + I_ size = 3; + DEBUG_SCAN_LINK("SPEC", size, 3); SPEC_LINK_LOCATION(1); SPEC_LINK_LOCATION(2); SPEC_LINK_LOCATION(3); - return(FIXED_HS + 3); + return(FIXED_HS + size); +} +I_ +_ScanLink_4_0(STG_NO_ARGS) { + I_ size = 4; + DEBUG_SCAN_LINK("SPEC", size, 0); + return(FIXED_HS + size); } I_ _ScanLink_4_4(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SPEC", 4, 4); + I_ size = 4; + DEBUG_SCAN_LINK("SPEC", size, 4); SPEC_LINK_LOCATION(1); SPEC_LINK_LOCATION(2); SPEC_LINK_LOCATION(3); SPEC_LINK_LOCATION(4); - return(FIXED_HS + 4); + return(FIXED_HS + size); +} +I_ +_ScanLink_5_0(STG_NO_ARGS) { + I_ size = 5; + DEBUG_SCAN_LINK("SPEC", size, 0); + return(FIXED_HS + size); } I_ _ScanLink_5_5(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SPEC", 5, 5); + I_ size = 5; + DEBUG_SCAN_LINK("SPEC", size, 5); SPEC_LINK_LOCATION(1); SPEC_LINK_LOCATION(2); SPEC_LINK_LOCATION(3); SPEC_LINK_LOCATION(4); SPEC_LINK_LOCATION(5); - return(FIXED_HS + 5); + return(FIXED_HS + size); } I_ _ScanLink_6_6(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SPEC", 6, 6); + I_ size = 6; + DEBUG_SCAN_LINK("SPEC", size, 6); SPEC_LINK_LOCATION(1); SPEC_LINK_LOCATION(2); SPEC_LINK_LOCATION(3); SPEC_LINK_LOCATION(4); SPEC_LINK_LOCATION(5); SPEC_LINK_LOCATION(6); - return(FIXED_HS + 6); + return(FIXED_HS + size); } I_ _ScanLink_7_7(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SPEC", 7, 7); + I_ size = 7; + DEBUG_SCAN_LINK("SPEC", size, 7); SPEC_LINK_LOCATION(1); SPEC_LINK_LOCATION(2); SPEC_LINK_LOCATION(3); @@ -485,11 +490,12 @@ _ScanLink_7_7(STG_NO_ARGS) { SPEC_LINK_LOCATION(5); SPEC_LINK_LOCATION(6); SPEC_LINK_LOCATION(7); - return(FIXED_HS + 7); + return(FIXED_HS + size); } I_ _ScanLink_8_8(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SPEC", 8, 8); + I_ size = 8; + DEBUG_SCAN_LINK("SPEC", size, 8); SPEC_LINK_LOCATION(1); SPEC_LINK_LOCATION(2); SPEC_LINK_LOCATION(3); @@ -498,11 +504,12 @@ _ScanLink_8_8(STG_NO_ARGS) { SPEC_LINK_LOCATION(6); SPEC_LINK_LOCATION(7); SPEC_LINK_LOCATION(8); - return(FIXED_HS + 8); + return(FIXED_HS + size); } I_ _ScanLink_9_9(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SPEC", 9, 9); + I_ size = 9; + DEBUG_SCAN_LINK("SPEC", size, 9); SPEC_LINK_LOCATION(1); SPEC_LINK_LOCATION(2); SPEC_LINK_LOCATION(3); @@ -512,11 +519,12 @@ _ScanLink_9_9(STG_NO_ARGS) { SPEC_LINK_LOCATION(7); SPEC_LINK_LOCATION(8); SPEC_LINK_LOCATION(9); - return(FIXED_HS + 9); + return(FIXED_HS + size); } I_ _ScanLink_10_10(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SPEC", 10, 10); + I_ size = 10; + DEBUG_SCAN_LINK("SPEC", size, 10); SPEC_LINK_LOCATION(1); SPEC_LINK_LOCATION(2); SPEC_LINK_LOCATION(3); @@ -527,11 +535,12 @@ _ScanLink_10_10(STG_NO_ARGS) { SPEC_LINK_LOCATION(8); SPEC_LINK_LOCATION(9); SPEC_LINK_LOCATION(10); - return(FIXED_HS + 10); + return(FIXED_HS + size); } I_ _ScanLink_11_11(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SPEC", 11, 11); + I_ size = 11; + DEBUG_SCAN_LINK("SPEC", size, 11); SPEC_LINK_LOCATION(1); SPEC_LINK_LOCATION(2); SPEC_LINK_LOCATION(3); @@ -543,11 +552,12 @@ _ScanLink_11_11(STG_NO_ARGS) { SPEC_LINK_LOCATION(9); SPEC_LINK_LOCATION(10); SPEC_LINK_LOCATION(11); - return(FIXED_HS + 11); + return(FIXED_HS + size); } I_ _ScanLink_12_12(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SPEC", 12, 12); + I_ size = 12; + DEBUG_SCAN_LINK("SPEC", size, 12); SPEC_LINK_LOCATION(1); SPEC_LINK_LOCATION(2); SPEC_LINK_LOCATION(3); @@ -560,7 +570,7 @@ _ScanLink_12_12(STG_NO_ARGS) { SPEC_LINK_LOCATION(10); SPEC_LINK_LOCATION(11); SPEC_LINK_LOCATION(12); - return(FIXED_HS + 12); + return(FIXED_HS + size); } \end{code} @@ -572,94 +582,95 @@ Scan-linking revertible black holes with underlying @SPEC@ closures. I_ _ScanLink_RBH_2_1(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SRBH", 2, 1); + I_ size = 2 + SPEC_RBH_VHS; + DEBUG_SCAN_LINK("SRBH", size, 1); LINK_LOCATION(SPEC_RBH_BQ_LOCN); - return(FIXED_HS + 2); /* ???? but SPEC_RBH_VHS is *not* zero! */ + return(FIXED_HS + size); } - I_ _ScanLink_RBH_3_1(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SRBH", 3, 1); + I_ size = 3 + SPEC_RBH_VHS; + DEBUG_SCAN_LINK("SRBH", size, 1); LINK_LOCATION(SPEC_RBH_BQ_LOCN); - return(FIXED_HS + 3); + return(FIXED_HS + size); } - I_ _ScanLink_RBH_3_3(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SRBH", 3, 3); + I_ size = 3 + SPEC_RBH_VHS; + DEBUG_SCAN_LINK("SRBH", size, 3); LINK_LOCATION(SPEC_RBH_BQ_LOCN); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1); - return(FIXED_HS + 3); + return(FIXED_HS + size); } - I_ _ScanLink_RBH_4_1(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SRBH", 4, 1); + I_ size = 4 + SPEC_RBH_VHS; + DEBUG_SCAN_LINK("SRBH", size, 1); LINK_LOCATION(SPEC_RBH_BQ_LOCN); - return(FIXED_HS + 4); + return(FIXED_HS + size); } - I_ _ScanLink_RBH_4_4(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SRBH", 4, 4); + I_ size = 4 + SPEC_RBH_VHS; + DEBUG_SCAN_LINK("SRBH", size, 4); LINK_LOCATION(SPEC_RBH_BQ_LOCN); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2); - return(FIXED_HS + 4); + return(FIXED_HS + size); } - I_ _ScanLink_RBH_5_1(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SRBH", 5, 1); + I_ size = 5 + SPEC_RBH_VHS; + DEBUG_SCAN_LINK("SRBH", size, 1); LINK_LOCATION(SPEC_RBH_BQ_LOCN); - return(FIXED_HS + 5); + return(FIXED_HS + size); } - I_ _ScanLink_RBH_5_5(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SRBH", 5, 5); + I_ size = 5 + SPEC_RBH_VHS; + DEBUG_SCAN_LINK("SRBH", size, 5); LINK_LOCATION(SPEC_RBH_BQ_LOCN); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 3); - return(FIXED_HS + 5); + return(FIXED_HS + size); } - I_ _ScanLink_RBH_6_6(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SRBH", 6, 6); + I_ size = 6 + SPEC_RBH_VHS; + DEBUG_SCAN_LINK("SRBH", size, 6); LINK_LOCATION(SPEC_RBH_BQ_LOCN); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 3); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 4); - return(FIXED_HS + 6); + return(FIXED_HS + size); } - I_ _ScanLink_RBH_7_7(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SRBH", 7, 7); + I_ size = 7 + SPEC_RBH_VHS; + DEBUG_SCAN_LINK("SRBH", size, 7); LINK_LOCATION(SPEC_RBH_BQ_LOCN); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 3); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 4); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 5); - return(FIXED_HS + 7); + return(FIXED_HS + size); } - I_ _ScanLink_RBH_8_8(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SRBH", 8, 8); + I_ size = 8 + SPEC_RBH_VHS; + DEBUG_SCAN_LINK("SRBH", size, 8); LINK_LOCATION(SPEC_RBH_BQ_LOCN); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2); @@ -667,13 +678,13 @@ _ScanLink_RBH_8_8(STG_NO_ARGS) LINK_LOCATION(SPEC_RBH_BQ_LOCN + 4); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 5); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 6); - return(FIXED_HS + 8); + return(FIXED_HS + size); } - I_ _ScanLink_RBH_9_9(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SRBH", 9, 9); + I_ size = 9 + SPEC_RBH_VHS; + DEBUG_SCAN_LINK("SRBH", size, 9); LINK_LOCATION(SPEC_RBH_BQ_LOCN); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2); @@ -682,13 +693,13 @@ _ScanLink_RBH_9_9(STG_NO_ARGS) LINK_LOCATION(SPEC_RBH_BQ_LOCN + 5); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 6); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 7); - return(FIXED_HS + 9); + return(FIXED_HS + size); } - I_ _ScanLink_RBH_10_10(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SRBH", 10, 10); + I_ size = 10 + SPEC_RBH_VHS; + DEBUG_SCAN_LINK("SRBH", size, 10); LINK_LOCATION(SPEC_RBH_BQ_LOCN); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2); @@ -698,13 +709,13 @@ _ScanLink_RBH_10_10(STG_NO_ARGS) LINK_LOCATION(SPEC_RBH_BQ_LOCN + 6); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 7); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 8); - return(FIXED_HS + 10); + return(FIXED_HS + size); } - I_ _ScanLink_RBH_11_11(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SRBH", 11, 11); + I_ size = 11 + SPEC_RBH_VHS; + DEBUG_SCAN_LINK("SRBH", size, 11); LINK_LOCATION(SPEC_RBH_BQ_LOCN); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2); @@ -715,13 +726,13 @@ _ScanLink_RBH_11_11(STG_NO_ARGS) LINK_LOCATION(SPEC_RBH_BQ_LOCN + 7); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 8); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 9); - return(FIXED_HS + 11); + return(FIXED_HS + size); } - I_ _ScanLink_RBH_12_12(STG_NO_ARGS) { - DEBUG_SCAN_LINK("SRBH", 12, 12); + I_ size = 12 + SPEC_RBH_VHS; + DEBUG_SCAN_LINK("SRBH", size, 12); LINK_LOCATION(SPEC_RBH_BQ_LOCN); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 1); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 2); @@ -733,10 +744,9 @@ _ScanLink_RBH_12_12(STG_NO_ARGS) LINK_LOCATION(SPEC_RBH_BQ_LOCN + 8); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 9); LINK_LOCATION(SPEC_RBH_BQ_LOCN + 10); - return(FIXED_HS + 12); + return(FIXED_HS + size); } #endif - \end{code} Scan-linking a MallocPtr is straightforward: exactly the same as @@ -744,10 +754,11 @@ Scan-linking a MallocPtr is straightforward: exactly the same as \begin{code} #ifndef PAR -StgInt +I_ _ScanLink_MallocPtr(STG_NO_ARGS) { - DEBUG_SCAN_LINK("MallocPtr", MallocPtr_SIZE, 0); - return(FIXED_HS + MallocPtr_SIZE); + I_ size = MallocPtr_SIZE; + DEBUG_SCAN_LINK("MallocPtr", size, 0); + return(FIXED_HS + size); } #endif /* !PAR */ \end{code} @@ -758,54 +769,69 @@ Back to the main feature... /*** MOVING CLOSURES ***/ +#ifdef TICKY_TICKY +I_ +_ScanMove_0(STG_NO_ARGS) { + I_ size = 0; /* NB: SPEC_VHS defined to be zero, so 0 really is the "size" */ + DEBUG_SCAN_MOVE("CONST", size); + SLIDE_FIXED_HDR; + return(FIXED_HS + size); +} +#endif I_ _ScanMove_1(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SPEC", 1); + I_ size = 1; /* NB: SPEC_VHS defined to be zero, so 1 really is the "size" */ + DEBUG_SCAN_MOVE("SPEC", size); SLIDE_FIXED_HDR; SPEC_SLIDE_WORD(1); - return(FIXED_HS + 1); /* NB: SPEC_VHS defined to be zero, so 1 really is the "size" */ + return(FIXED_HS + size); } I_ _ScanMove_2(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SPEC", 2); + I_ size = 2; + DEBUG_SCAN_MOVE("SPEC", size); SLIDE_FIXED_HDR; SPEC_SLIDE_WORD(1); SPEC_SLIDE_WORD(2); - return(FIXED_HS + 2); + return(FIXED_HS + size); } I_ _ScanMove_3(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SPEC", 3); + I_ size = 3; + DEBUG_SCAN_MOVE("SPEC", size); SLIDE_FIXED_HDR; SPEC_SLIDE_WORD(1); SPEC_SLIDE_WORD(2); SPEC_SLIDE_WORD(3); - return(FIXED_HS + 3); + return(FIXED_HS + size); } I_ _ScanMove_4(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SPEC", 4); + I_ size = 4; + DEBUG_SCAN_MOVE("SPEC", size); SLIDE_FIXED_HDR; SPEC_SLIDE_WORD(1); SPEC_SLIDE_WORD(2); SPEC_SLIDE_WORD(3); SPEC_SLIDE_WORD(4); - return(FIXED_HS + 4); + return(FIXED_HS + size); } I_ _ScanMove_5(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SPEC", 5); + I_ size = 5; + DEBUG_SCAN_MOVE("SPEC", size); SLIDE_FIXED_HDR; SPEC_SLIDE_WORD(1); SPEC_SLIDE_WORD(2); SPEC_SLIDE_WORD(3); SPEC_SLIDE_WORD(4); SPEC_SLIDE_WORD(5); - return(FIXED_HS + 5); + return(FIXED_HS + size); } I_ _ScanMove_6(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SPEC", 6); + I_ size = 6; + DEBUG_SCAN_MOVE("SPEC", size); SLIDE_FIXED_HDR; SPEC_SLIDE_WORD(1); SPEC_SLIDE_WORD(2); @@ -813,11 +839,12 @@ _ScanMove_6(STG_NO_ARGS) { SPEC_SLIDE_WORD(4); SPEC_SLIDE_WORD(5); SPEC_SLIDE_WORD(6); - return(FIXED_HS + 6); + return(FIXED_HS + size); } I_ _ScanMove_7(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SPEC", 7); + I_ size = 7; + DEBUG_SCAN_MOVE("SPEC", size); SLIDE_FIXED_HDR; SPEC_SLIDE_WORD(1); SPEC_SLIDE_WORD(2); @@ -826,11 +853,12 @@ _ScanMove_7(STG_NO_ARGS) { SPEC_SLIDE_WORD(5); SPEC_SLIDE_WORD(6); SPEC_SLIDE_WORD(7); - return(FIXED_HS + 7); + return(FIXED_HS + size); } I_ _ScanMove_8(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SPEC", 8); + I_ size = 8; + DEBUG_SCAN_MOVE("SPEC", size); SLIDE_FIXED_HDR; SPEC_SLIDE_WORD(1); SPEC_SLIDE_WORD(2); @@ -840,11 +868,12 @@ _ScanMove_8(STG_NO_ARGS) { SPEC_SLIDE_WORD(6); SPEC_SLIDE_WORD(7); SPEC_SLIDE_WORD(8); - return(FIXED_HS + 8); + return(FIXED_HS + size); } I_ _ScanMove_9(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SPEC", 9); + I_ size = 9; + DEBUG_SCAN_MOVE("SPEC", size); SLIDE_FIXED_HDR; SPEC_SLIDE_WORD(1); SPEC_SLIDE_WORD(2); @@ -855,11 +884,12 @@ _ScanMove_9(STG_NO_ARGS) { SPEC_SLIDE_WORD(7); SPEC_SLIDE_WORD(8); SPEC_SLIDE_WORD(9); - return(FIXED_HS + 9); + return(FIXED_HS + size); } I_ _ScanMove_10(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SPEC", 10); + I_ size = 10; + DEBUG_SCAN_MOVE("SPEC", size); SLIDE_FIXED_HDR; SPEC_SLIDE_WORD(1); SPEC_SLIDE_WORD(2); @@ -871,11 +901,12 @@ _ScanMove_10(STG_NO_ARGS) { SPEC_SLIDE_WORD(8); SPEC_SLIDE_WORD(9); SPEC_SLIDE_WORD(10); - return(FIXED_HS + 10); + return(FIXED_HS + size); } I_ _ScanMove_11(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SPEC", 11); + I_ size = 11; + DEBUG_SCAN_MOVE("SPEC", size); SLIDE_FIXED_HDR; SPEC_SLIDE_WORD(1); SPEC_SLIDE_WORD(2); @@ -888,11 +919,12 @@ _ScanMove_11(STG_NO_ARGS) { SPEC_SLIDE_WORD(9); SPEC_SLIDE_WORD(10); SPEC_SLIDE_WORD(11); - return(FIXED_HS + 11); + return(FIXED_HS + size); } I_ _ScanMove_12(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SPEC", 12); + I_ size = 12; + DEBUG_SCAN_MOVE("SPEC", size); SLIDE_FIXED_HDR; SPEC_SLIDE_WORD(1); SPEC_SLIDE_WORD(2); @@ -906,13 +938,14 @@ _ScanMove_12(STG_NO_ARGS) { SPEC_SLIDE_WORD(10); SPEC_SLIDE_WORD(11); SPEC_SLIDE_WORD(12); - return(FIXED_HS + 12); + return(FIXED_HS + size); } #if defined(PAR) && defined(GC_MUT_REQUIRED) I_ _ScanMove_RBH_2(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SRBH", 2); + I_ size = 2 + SPEC_RBH_VHS; + DEBUG_SCAN_MOVE("SRBH", size); SLIDE_FIXED_HDR; SLIDE_WORD(SPEC_RBH_HS + 0); @@ -920,11 +953,12 @@ _ScanMove_RBH_2(STG_NO_ARGS) { MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables; StorageMgrInfo.OldMutables = (P_) New; - return(FIXED_HS + 2); /* ???? SPEC_RBH_VHS is *not* zero! */ + return(FIXED_HS + size); } I_ _ScanMove_RBH_3(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SRBH", 3); + I_ size = 3 + SPEC_RBH_VHS; + DEBUG_SCAN_MOVE("SRBH", size); SLIDE_FIXED_HDR; SLIDE_WORD(SPEC_RBH_HS + 0); SLIDE_WORD(SPEC_RBH_HS + 1); @@ -933,11 +967,12 @@ _ScanMove_RBH_3(STG_NO_ARGS) { MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables; StorageMgrInfo.OldMutables = (P_) New; - return(FIXED_HS + 3); + return(FIXED_HS + size); } I_ _ScanMove_RBH_4(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SRBH", 4); + I_ size = 4 + SPEC_RBH_VHS; + DEBUG_SCAN_MOVE("SRBH", size); SLIDE_FIXED_HDR; SLIDE_WORD(SPEC_RBH_HS + 0); SLIDE_WORD(SPEC_RBH_HS + 1); @@ -947,11 +982,12 @@ _ScanMove_RBH_4(STG_NO_ARGS) { MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables; StorageMgrInfo.OldMutables = (P_) New; - return(FIXED_HS + 4); + return(FIXED_HS + size); } I_ _ScanMove_RBH_5(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SRBH", 5); + I_ size = 5 + SPEC_RBH_VHS; + DEBUG_SCAN_MOVE("SRBH", size); SLIDE_FIXED_HDR; SLIDE_WORD(SPEC_RBH_HS + 0); SLIDE_WORD(SPEC_RBH_HS + 1); @@ -962,11 +998,12 @@ _ScanMove_RBH_5(STG_NO_ARGS) { MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables; StorageMgrInfo.OldMutables = (P_) New; - return(FIXED_HS + 5); + return(FIXED_HS + size); } I_ _ScanMove_RBH_6(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SRBH", 6); + I_ size = 6 + SPEC_RBH_VHS; + DEBUG_SCAN_MOVE("SRBH", size); SLIDE_FIXED_HDR; SLIDE_WORD(SPEC_RBH_HS + 0); SLIDE_WORD(SPEC_RBH_HS + 1); @@ -978,11 +1015,12 @@ _ScanMove_RBH_6(STG_NO_ARGS) { MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables; StorageMgrInfo.OldMutables = (P_) New; - return(FIXED_HS + 6); + return(FIXED_HS + size); } I_ _ScanMove_RBH_7(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SRBH", 7); + I_ size = 7 + SPEC_RBH_VHS; + DEBUG_SCAN_MOVE("SRBH", size); SLIDE_FIXED_HDR; SLIDE_WORD(SPEC_RBH_HS + 0); SLIDE_WORD(SPEC_RBH_HS + 1); @@ -995,11 +1033,12 @@ _ScanMove_RBH_7(STG_NO_ARGS) { MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables; StorageMgrInfo.OldMutables = (P_) New; - return(FIXED_HS + 7); + return(FIXED_HS + size); } I_ _ScanMove_RBH_8(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SRBH", 8); + I_ size = 8 + SPEC_RBH_VHS; + DEBUG_SCAN_MOVE("SRBH", size); SLIDE_FIXED_HDR; SLIDE_WORD(SPEC_RBH_HS + 0); SLIDE_WORD(SPEC_RBH_HS + 1); @@ -1013,11 +1052,12 @@ _ScanMove_RBH_8(STG_NO_ARGS) { MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables; StorageMgrInfo.OldMutables = (P_) New; - return(FIXED_HS + 8); + return(FIXED_HS + size); } I_ _ScanMove_RBH_9(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SRBH", 9); + I_ size = 9 + SPEC_RBH_VHS; + DEBUG_SCAN_MOVE("SRBH", size); SLIDE_FIXED_HDR; SLIDE_WORD(SPEC_RBH_HS + 0); SLIDE_WORD(SPEC_RBH_HS + 1); @@ -1032,11 +1072,12 @@ _ScanMove_RBH_9(STG_NO_ARGS) { MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables; StorageMgrInfo.OldMutables = (P_) New; - return(FIXED_HS + 9); + return(FIXED_HS + size); } I_ _ScanMove_RBH_10(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SRBH", 10); + I_ size = 10 + SPEC_RBH_VHS; + DEBUG_SCAN_MOVE("SRBH", size); SLIDE_FIXED_HDR; SLIDE_WORD(SPEC_RBH_HS + 0); SLIDE_WORD(SPEC_RBH_HS + 1); @@ -1052,11 +1093,12 @@ _ScanMove_RBH_10(STG_NO_ARGS) { MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables; StorageMgrInfo.OldMutables = (P_) New; - return(FIXED_HS + 10); + return(FIXED_HS + size); } I_ _ScanMove_RBH_11(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SRBH", 11); + I_ size = 11 + SPEC_RBH_VHS; + DEBUG_SCAN_MOVE("SRBH", size); SLIDE_FIXED_HDR; SLIDE_WORD(SPEC_RBH_HS + 0); SLIDE_WORD(SPEC_RBH_HS + 1); @@ -1073,11 +1115,12 @@ _ScanMove_RBH_11(STG_NO_ARGS) { MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables; StorageMgrInfo.OldMutables = (P_) New; - return(FIXED_HS + 11); + return(FIXED_HS + size); } I_ _ScanMove_RBH_12(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("SRBH", 12); + I_ size = 12 + SPEC_RBH_VHS; + DEBUG_SCAN_MOVE("SRBH", size); SLIDE_FIXED_HDR; SLIDE_WORD(SPEC_RBH_HS + 0); SLIDE_WORD(SPEC_RBH_HS + 1); @@ -1095,7 +1138,7 @@ _ScanMove_RBH_12(STG_NO_ARGS) { MUT_LINK(New) = (W_) StorageMgrInfo.OldMutables; StorageMgrInfo.OldMutables = (P_) New; - return(FIXED_HS + 12); + return(FIXED_HS + size); } #endif \end{code} @@ -1106,12 +1149,13 @@ new MallocPtr list. \begin{code} #ifndef PAR -StgInt +I_ _ScanMove_MallocPtr(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("MallocPtr", MallocPtr_SIZE); + I_ size = MallocPtr_SIZE; + DEBUG_SCAN_MOVE("MallocPtr", size); -#if defined(_GC_DEBUG) - if (SM_trace & 16) { +#if defined(DEBUG) + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MALLOCPTRS) { printf("Moving MallocPtr(%x)=<%x,%x,%x>", Scan, Scan[0], Scan[1], Scan[2]); printf(" Data = %x, Next = %x\n", MallocPtr_CLOSURE_DATA(Scan), MallocPtr_CLOSURE_LINK(Scan) ); @@ -1122,8 +1166,8 @@ _ScanMove_MallocPtr(STG_NO_ARGS) { MallocPtr_SLIDE_DATA; MallocPtr_RELINK; -#if defined(_GC_DEBUG) - if (SM_trace & 16) { +#if defined(DEBUG) + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MALLOCPTRS) { printf("Moved MallocPtr(%x)=<%x,_,%x,%x,%x>", New, New[0], New[1], New[2], New[3]); printf(" Data = %x, Next = %x", MallocPtr_CLOSURE_DATA(New), MallocPtr_CLOSURE_LINK(New) ); @@ -1131,7 +1175,7 @@ _ScanMove_MallocPtr(STG_NO_ARGS) { } #endif - return(FIXED_HS + MallocPtr_SIZE); + return(FIXED_HS + size); } #endif /* !PAR */ \end{code} @@ -1373,48 +1417,50 @@ _ScanMove_Data(STG_NO_ARGS) { I_ _ScanLink_BH_U(STG_NO_ARGS) { - DEBUG_SCAN_LINK("BH ", MIN_UPD_SIZE, 0); - return(FIXED_HS + BH_U_SIZE); /* size includes _VHS */ - /* NB: pretty intimate knowledge about BH closure layout */ + I_ size = BH_U_SIZE; + DEBUG_SCAN_LINK("BH ", size, 0); + return(FIXED_HS + size); } I_ _ScanMove_BH_U(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("BH ", MIN_UPD_SIZE); + I_ size = BH_U_SIZE; + DEBUG_SCAN_MOVE("BH ", size); SLIDE_FIXED_HDR; - return(FIXED_HS + BH_U_SIZE); - /* ditto */ + return(FIXED_HS + size); } I_ _ScanLink_BH_N(STG_NO_ARGS) { - DEBUG_SCAN_LINK("BH N", MIN_NONUPD_SIZE, 0); - return(FIXED_HS + BH_N_SIZE); /* size includes _VHS */ - /* NB: pretty intimate knowledge about BH closure layout */ + I_ size = BH_N_SIZE; + DEBUG_SCAN_LINK("BH N", size, 0); + return(FIXED_HS + size); } I_ _ScanMove_BH_N(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("BH N",MIN_NONUPD_SIZE); + I_ size = BH_N_SIZE; + DEBUG_SCAN_MOVE("BH N", size); SLIDE_FIXED_HDR; - return(FIXED_HS + BH_N_SIZE); - /* ditto */ + return(FIXED_HS + size); } -#ifdef USE_COST_CENTRES +#if defined(PROFILING) || defined(TICKY_TICKY) I_ _ScanLink_PI(STG_NO_ARGS) { - DEBUG_SCAN_LINK("PI ", IND_CLOSURE_SIZE(dummy), 1); + I_ size = IND_CLOSURE_SIZE(dummy); + DEBUG_SCAN_LINK("PI ", size, 1); LINK_LOCATION(IND_HS); - return(FIXED_HS + IND_CLOSURE_SIZE(dummy) /*MIN_UPD_SIZE*/); + return(FIXED_HS + size); } I_ _ScanMove_PI(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("PI ", IND_CLOSURE_SIZE(dummy)); + I_ size = IND_CLOSURE_SIZE(dummy); + DEBUG_SCAN_MOVE("PI ", size); SLIDE_FIXED_HDR; SLIDE_WORD(IND_HS); - return(FIXED_HS + IND_CLOSURE_SIZE(dummy) /*MIN_UPD_SIZE*/); + return(FIXED_HS + size); } #endif @@ -1430,13 +1476,15 @@ Linking and Marking Routines for FetchMes and stack objects. I_ _ScanLink_FetchMe(STG_NO_ARGS) { - DEBUG_SCAN_LINK("FME ", MIN_UPD_SIZE, 0); - return(FIXED_HS + FETCHME_CLOSURE_SIZE(dummy) /*MIN_UPD_SIZE*/); + I_ size = FETCHME_CLOSURE_SIZE(dummy); + DEBUG_SCAN_LINK("FME ", size, 0); + return(FIXED_HS + size); } I_ _ScanMove_FetchMe(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("FME ",MIN_UPD_SIZE); + I_ size = FETCHME_CLOSURE_SIZE(dummy); + DEBUG_SCAN_MOVE("FME ", size); SLIDE_FIXED_HDR; SLIDE_WORD(FETCHME_GA_LOCN); ASSERT(GALAlookup(FETCHME_GA(New)) != NULL); @@ -1447,23 +1495,25 @@ _ScanMove_FetchMe(STG_NO_ARGS) { StorageMgrInfo.OldMutables = (P_) New; #endif - return(FIXED_HS + FETCHME_CLOSURE_SIZE(dummy) /*MIN_UPD_SIZE*/); + return(FIXED_HS + size); } I_ _ScanLink_BF(STG_NO_ARGS) { - DEBUG_SCAN_LINK("BF", BF_HS, 2 /*possibly wrong (WDP 95/07)*/); + I_ size = BF_CLOSURE_SIZE(dummy); + DEBUG_SCAN_LINK("BF", size, 2); LINK_LOCATION(BF_LINK_LOCN); LINK_LOCATION(BF_NODE_LOCN); - return(FIXED_HS + BF_CLOSURE_SIZE(dummy)); + return(FIXED_HS + size); } I_ _ScanMove_BF(STG_NO_ARGS) { I_ count; + I_ size = BF_CLOSURE_SIZE(dummy); SLIDE_FIXED_HDR; for (count = FIXED_HS; count < FIXED_HS + BF_VHS; count++) { @@ -1481,21 +1531,23 @@ _ScanMove_BF(STG_NO_ARGS) StorageMgrInfo.OldMutables = (P_) New; #endif - return(FIXED_HS + BF_CLOSURE_SIZE(dummy)); + return(FIXED_HS + size); } #endif /* PAR */ I_ _ScanLink_BQ(STG_NO_ARGS) { - DEBUG_SCAN_LINK("BQ ", BQ_CLOSURE_SIZE(dummy), BQ_CLOSURE_NoPTRS(Scan)); + I_ size = BQ_CLOSURE_SIZE(dummy); + DEBUG_SCAN_LINK("BQ ", size, BQ_CLOSURE_NoPTRS(Scan)); LINK_LOCATION(BQ_HS); - return(FIXED_HS + BQ_CLOSURE_SIZE(dummy)); + return(FIXED_HS + size); } I_ _ScanMove_BQ(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("BQ ", BQ_CLOSURE_SIZE(dummy)); + I_ size = BQ_CLOSURE_SIZE(dummy); + DEBUG_SCAN_MOVE("BQ ", size); SLIDE_FIXED_HDR; SLIDE_WORD(BQ_HS); @@ -1506,7 +1558,7 @@ _ScanMove_BQ(STG_NO_ARGS) { StorageMgrInfo.OldMutables = (P_) New; #endif - return(FIXED_HS + BQ_CLOSURE_SIZE(dummy)); + return(FIXED_HS + size); } I_ @@ -1515,8 +1567,9 @@ _ScanLink_TSO(STG_NO_ARGS) STGRegisterTable *r = TSO_INTERNAL_PTR(Scan); W_ liveness = r->rLiveness; I_ i; + I_ size = TSO_VHS + TSO_CTS_SIZE; - DEBUG_SCAN_LINK("TSO", TSO_HS + TSO_CTS_SIZE, 0/*wrong*/); + DEBUG_SCAN_LINK("TSO", size, 0/*wrong*/); LINK_LOCATION(TSO_LINK_LOCN); LINK_LOCATION(((P_) &r->rStkO) - Scan); @@ -1525,13 +1578,14 @@ _ScanLink_TSO(STG_NO_ARGS) LINK_LOCATION(((P_) &r->rR[i].p) - Scan) } } - return(TSO_HS + TSO_CTS_SIZE); + return(FIXED_HS + size); } I_ _ScanMove_TSO(STG_NO_ARGS) { I_ count; + I_ size = TSO_VHS + TSO_CTS_SIZE; SLIDE_FIXED_HDR; for (count = FIXED_HS; count < FIXED_HS + TSO_VHS; count++) { @@ -1548,7 +1602,7 @@ _ScanMove_TSO(STG_NO_ARGS) StorageMgrInfo.OldMutables = (P_) New; #endif - return(TSO_HS + TSO_CTS_SIZE); + return(FIXED_HS + size); } I_ @@ -1562,7 +1616,7 @@ _ScanLink_StkO(STG_NO_ARGS) { LINK_LOCATION(STKO_LINK_LOCN); /* Link the locations in the A stack */ - DEBUG_SCAN_LINK("STKO", size, cts_size - STKO_SpA_OFFSET(SCAN) + 1); + DEBUG_SCAN_LINK("STKO", size, cts_size - STKO_SpA_OFFSET(Scan) + 1); for (count = STKO_SpA_OFFSET(Scan); count <= cts_size; count++) { STKO_LINK_LOCATION(count); } @@ -1576,10 +1630,8 @@ _ScanLink_StkO(STG_NO_ARGS) { sub = STKO_CLOSURE_OFFSET(Scan, subptr); } - /* - I assume what's wanted is the size of the object - rather the number of pointers in the object. KH - */ + ASSERT(sanityChk_StkO(Scan)); + return(FIXED_HS + size); } @@ -1600,7 +1652,7 @@ _ScanMove_StkO(STG_NO_ARGS) { DEBUG_SCAN_MOVE("STKO", size); SLIDE_FIXED_HDR; -#ifdef DO_REDN_COUNTING +#ifdef TICKY_TICKY SLIDE_WORD(STKO_ADEP_LOCN); SLIDE_WORD(STKO_BDEP_LOCN); #endif @@ -1640,6 +1692,8 @@ _ScanMove_StkO(STG_NO_ARGS) { StorageMgrInfo.OldMutables = (P_) New; #endif + /* ToDo: ASSERT(sanityChk_StkO(Scan or New)); ??? */ + return(FIXED_HS + size); } @@ -1648,19 +1702,6 @@ _ScanMove_StkO(STG_NO_ARGS) { \end{code} \begin{code} -#if defined(GCgn) -I_ -_ScanMove_OldRoot(STG_NO_ARGS) { - DEBUG_SCAN_MOVE("OLDR", 2); - SLIDE_FIXED_HDR; - IND_CLOSURE_PTR(New) = IND_CLOSURE_PTR(Scan); - IND_CLOSURE_LINK(New) = (W_) genInfo.OldInNew; - genInfo.OldInNew = New; - genInfo.OldInNewno++; - return(IND_HS + MIN_UPD_SIZE); /* this looks wrong (WDP 95/07) */ -} -#endif /* GCgn */ - /*** Dummy Entries -- Should not be entered ***/ /* Should not be in a .lc file either... --JSM */ @@ -1691,5 +1732,4 @@ STGFUN(_Dummy_CharLike_entry) { } #endif /* _INFO_COMPACTING */ - \end{code} diff --git a/ghc/runtime/storage/SMscav.lc b/ghc/runtime/storage/SMscav.lc index 2bc6ab2ebe..118a8a0227 100644 --- a/ghc/runtime/storage/SMscav.lc +++ b/ghc/runtime/storage/SMscav.lc @@ -125,77 +125,82 @@ RegisterTable ScavRegTable; /*** DEBUGGING MACROS ***/ -#if defined(_GC_DEBUG) +#if defined(DEBUG) #define DEBUG_SCAV(s,p) \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Scav: 0x%lx, info 0x%lx, size %ld, ptrs %ld\n", \ Scav, INFO_PTR(Scav), s, p) #define DEBUG_SCAV_GEN(s,p) \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Scav: 0x%lx, Gen info 0x%lx, size %ld, ptrs %ld\n", \ Scav, INFO_PTR(Scav), s, p) #define DEBUG_SCAV_DYN \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Scav: 0x%lx, Dyn info 0x%lx, size %ld, ptrs %ld\n", \ Scav, INFO_PTR(Scav), DYN_CLOSURE_SIZE(Scav), DYN_CLOSURE_NoPTRS(Scav)) #define DEBUG_SCAV_TUPLE \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Scav: 0x%lx, Tuple info 0x%lx, size %ld, ptrs %ld\n", \ Scav, INFO_PTR(Scav), TUPLE_CLOSURE_SIZE(Scav), TUPLE_CLOSURE_NoPTRS(Scav)) #define DEBUG_SCAV_MUTUPLE \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Scav: 0x%lx, MuTuple info 0x%lx, size %ld, ptrs %ld\n", \ Scav, INFO_PTR(Scav), MUTUPLE_CLOSURE_SIZE(Scav), MUTUPLE_CLOSURE_NoPTRS(Scav)) #define DEBUG_SCAV_DATA \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Scav: 0x%lx, Data info 0x%lx, size %ld\n", \ Scav, INFO_PTR(Scav), DATA_CLOSURE_SIZE(Scav)) #define DEBUG_SCAV_BH(s) \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Scav: 0x%lx, BH info 0x%lx, size %ld\n", \ Scav, INFO_PTR(Scav), s) #define DEBUG_SCAV_IND \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Scav: 0x%lx, IND info 0x%lx, size %ld\n", \ Scav, INFO_PTR(Scav), IND_CLOSURE_SIZE(Scav)) #define DEBUG_SCAV_PERM_IND \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Scav: 0x%lx, PI info 0x%lx, size %ld\n", \ Scav, INFO_PTR(Scav), IND_CLOSURE_SIZE(Scav)) #define DEBUG_SCAV_OLDROOT(s) \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_MINOR_GC) \ fprintf(stderr, "Scav: OLDROOT 0x%lx, info 0x%lx, size %ld\n", \ Scav, INFO_PTR(Scav), s) #ifdef CONCURRENT #define DEBUG_SCAV_BQ \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \ fprintf(stderr, "Scav: 0x%lx, BQ info 0x%lx, size %ld, ptrs %ld\n", \ Scav, INFO_PTR(Scav), BQ_CLOSURE_SIZE(Scav), BQ_CLOSURE_NoPTRS(Scav)) #define DEBUG_SCAV_TSO \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \ fprintf(stderr, "Scav TSO: 0x%lx\n", \ Scav) #define DEBUG_SCAV_STKO \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \ fprintf(stderr, "Scav StkO: 0x%lx\n", \ Scav) # ifdef PAR +# define DEBUG_SCAV_RBH(s,p) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \ + fprintf(stderr, "Scav RBH: 0x%lx, info 0x%lx, size %ld, ptrs %ld\n", \ + Scav, INFO_PTR(Scav), s, p) + # define DEBUG_SCAV_BF \ - if (SM_trace & 2) \ + if (RTSflags.GcFlags.trace & DEBUG_TRACE_CONCURRENT) \ fprintf(stderr, "Scav: 0x%lx, BF info 0x%lx, size %ld, ptrs %ld\n", \ Scav, INFO_PTR(Scav), BF_CLOSURE_SIZE(dummy), 0) # endif @@ -219,6 +224,7 @@ RegisterTable ScavRegTable; # define DEBUG_SCAV_TSO # define DEBUG_SCAV_STKO # ifdef PAR +# define DEBUG_SCAV_RBH(s,p) # define DEBUG_SCAV_BF # endif #endif @@ -226,52 +232,46 @@ RegisterTable ScavRegTable; #endif #define PROFILE_CLOSURE(closure,size) \ - HEAP_PROFILE_CLOSURE(closure,size); \ - LIFE_PROFILE_CLOSURE(closure,size) + HEAP_PROFILE_CLOSURE(closure,size) /*** SPECIALISED CODE ***/ +#ifdef TICKY_TICKY void -_Scavenge_1_0(STG_NO_ARGS) +_Scavenge_0_0(STG_NO_ARGS) { - DEBUG_SCAV(1,0); - PROFILE_CLOSURE(Scav,1); - NEXT_Scav(1); /* because "size" is defined to be 1 (size SPEC_VHS == 0) */ - return; -} -void -_Scavenge_2_0(STG_NO_ARGS) -{ - DEBUG_SCAV(2,0); - PROFILE_CLOSURE(Scav,2); - NEXT_Scav(2); + DEBUG_SCAV(0,0); + PROFILE_CLOSURE(Scav,0); + NEXT_Scav(0); /* because "size" is defined to be 0 (size SPEC_VHS == 0) */ return; } +#endif + void -_Scavenge_3_0(STG_NO_ARGS) +_Scavenge_1_0(STG_NO_ARGS) { - DEBUG_SCAV(3,0); - PROFILE_CLOSURE(Scav,3); - NEXT_Scav(3); + DEBUG_SCAV(1,0); + PROFILE_CLOSURE(Scav,1); + NEXT_Scav(1); /* because "size" is defined to be 1 (size SPEC_VHS == 0) */ return; } void -_Scavenge_4_0(STG_NO_ARGS) +_Scavenge_1_1(STG_NO_ARGS) { - DEBUG_SCAV(4,0); - PROFILE_CLOSURE(Scav,4); - NEXT_Scav(4); + DEBUG_SCAV(1,1); + PROFILE_CLOSURE(Scav,1); + SPEC_DO_EVACUATE(1); + NEXT_Scav(1); return; } void -_Scavenge_5_0(STG_NO_ARGS) +_Scavenge_2_0(STG_NO_ARGS) { - DEBUG_SCAV(5,0); - PROFILE_CLOSURE(Scav,5); - NEXT_Scav(5); + DEBUG_SCAV(2,0); + PROFILE_CLOSURE(Scav,2); + NEXT_Scav(2); return; } - void _Scavenge_2_1(STG_NO_ARGS) { @@ -281,44 +281,41 @@ _Scavenge_2_1(STG_NO_ARGS) NEXT_Scav(2); return; } - void -_Scavenge_3_1(STG_NO_ARGS) +_Scavenge_2_2(STG_NO_ARGS) { - DEBUG_SCAV(3,1); - PROFILE_CLOSURE(Scav,3); + DEBUG_SCAV(2,2); + PROFILE_CLOSURE(Scav,2); SPEC_DO_EVACUATE(1); - NEXT_Scav(3); + SPEC_DO_EVACUATE(2); + NEXT_Scav(2); return; } void -_Scavenge_3_2(STG_NO_ARGS) +_Scavenge_3_0(STG_NO_ARGS) { - DEBUG_SCAV(3,2); + DEBUG_SCAV(3,0); PROFILE_CLOSURE(Scav,3); - SPEC_DO_EVACUATE(1); - SPEC_DO_EVACUATE(2); NEXT_Scav(3); return; } - void -_Scavenge_1_1(STG_NO_ARGS) +_Scavenge_3_1(STG_NO_ARGS) { - DEBUG_SCAV(1,1); - PROFILE_CLOSURE(Scav,1); + DEBUG_SCAV(3,1); + PROFILE_CLOSURE(Scav,3); SPEC_DO_EVACUATE(1); - NEXT_Scav(1); + NEXT_Scav(3); return; } void -_Scavenge_2_2(STG_NO_ARGS) +_Scavenge_3_2(STG_NO_ARGS) { - DEBUG_SCAV(2,2); - PROFILE_CLOSURE(Scav,2); + DEBUG_SCAV(3,2); + PROFILE_CLOSURE(Scav,3); SPEC_DO_EVACUATE(1); SPEC_DO_EVACUATE(2); - NEXT_Scav(2); + NEXT_Scav(3); return; } void @@ -333,6 +330,14 @@ _Scavenge_3_3(STG_NO_ARGS) return; } void +_Scavenge_4_0(STG_NO_ARGS) +{ + DEBUG_SCAV(4,0); + PROFILE_CLOSURE(Scav,4); + NEXT_Scav(4); + return; +} +void _Scavenge_4_4(STG_NO_ARGS) { DEBUG_SCAV(4,4); @@ -345,6 +350,14 @@ _Scavenge_4_4(STG_NO_ARGS) return; } void +_Scavenge_5_0(STG_NO_ARGS) +{ + DEBUG_SCAV(5,0); + PROFILE_CLOSURE(Scav,5); + NEXT_Scav(5); + return; +} +void _Scavenge_5_5(STG_NO_ARGS) { DEBUG_SCAV(5,5); @@ -491,31 +504,33 @@ closures. void \ CAT3(_Scavenge_RBH_,n,_1)(STG_NO_ARGS) \ { \ + I_ size = n + SPEC_RBH_VHS; \ P_ save_Scav; \ - DEBUG_SCAV(n,1); \ + DEBUG_SCAV_RBH(size,1); \ save_Scav = Scav; \ Scav = OldGen + 1; \ DO_EVACUATE(save_Scav, SPEC_RBH_BQ_LOCN); \ Scav = save_Scav; \ - PROFILE_CLOSURE(Scav,n); \ - NEXT_Scav(n); /* ToDo: dodgy size WDP 95/07 */ \ + PROFILE_CLOSURE(Scav,size); \ + NEXT_Scav(size); \ } # define SCAVENGE_SPEC_RBH_N_N(n) \ void \ CAT4(_Scavenge_RBH_,n,_,n)(STG_NO_ARGS) \ { \ + I_ size = n + SPEC_RBH_VHS; \ int i; \ P_ save_Scav; \ - DEBUG_SCAV(n,n-1); \ + DEBUG_SCAV_RBH(size,size-1); \ save_Scav = Scav; \ Scav = OldGen + 1; \ for(i = 0; i < n - 1; i++) { \ DO_EVACUATE(save_Scav, SPEC_RBH_BQ_LOCN + i); \ } \ Scav = save_Scav; \ - PROFILE_CLOSURE(Scav,n); \ - NEXT_Scav(n); \ + PROFILE_CLOSURE(Scav,size); \ + NEXT_Scav(size); \ } # else @@ -524,23 +539,25 @@ CAT4(_Scavenge_RBH_,n,_,n)(STG_NO_ARGS) \ void \ CAT3(_Scavenge_RBH_,n,_1)(STG_NO_ARGS) \ { \ - DEBUG_SCAV(n,1); \ + I_ size = n + SPEC_RBH_VHS; \ + DEBUG_SCAV_RBH(size,1); \ DO_EVACUATE(Scav, SPEC_RBH_BQ_LOCN);\ - PROFILE_CLOSURE(Scav,n); \ - NEXT_Scav(n); \ + PROFILE_CLOSURE(Scav,size); \ + NEXT_Scav(size); \ } # define SCAVENGE_SPEC_RBH_N_N(n) \ void \ CAT4(_Scavenge_RBH_,n,_,n)(STG_NO_ARGS) \ { \ + I_ size = n + SPEC_RBH_VHS; \ int i; \ - DEBUG_SCAV(n,n-1); \ + DEBUG_SCAV_RBH(size,size-1); \ for(i = 0; i < n - 1; i++) { \ DO_EVACUATE(Scav, SPEC_RBH_BQ_LOCN + i); \ } \ - PROFILE_CLOSURE(Scav,n); \ - NEXT_Scav(n); \ + PROFILE_CLOSURE(Scav,size); \ + NEXT_Scav(size); \ } # endif @@ -580,9 +597,10 @@ SCAVENGE_SPEC_RBH_N_N(12) void _Scavenge_MallocPtr(STG_NO_ARGS) { - DEBUG_SCAV(MallocPtr_SIZE,0); - PROFILE_CLOSURE(Scav,MallocPtr_SIZE); - NEXT_Scav(MallocPtr_SIZE); + I_ size = MallocPtr_SIZE; + DEBUG_SCAV(size,0); + PROFILE_CLOSURE(Scav,size); + NEXT_Scav(size); return; } #endif /* !PAR */ @@ -766,44 +784,51 @@ _Scavenge_MuTuple(STG_NO_ARGS) void _Scavenge_BH_U(STG_NO_ARGS) { - DEBUG_SCAV_BH(BH_U_SIZE); - PROFILE_CLOSURE(Scav,BH_U_SIZE); - NEXT_Scav(BH_U_SIZE); + I_ size = BH_U_SIZE; + DEBUG_SCAV_BH(size); + PROFILE_CLOSURE(Scav,size); + NEXT_Scav(size); return; } void _Scavenge_BH_N(STG_NO_ARGS) { - DEBUG_SCAV_BH(BH_N_SIZE); - PROFILE_CLOSURE(Scav,BH_N_SIZE); - NEXT_Scav(BH_N_SIZE); + I_ size = BH_N_SIZE; + DEBUG_SCAV_BH(size); + PROFILE_CLOSURE(Scav,size); + NEXT_Scav(size); return; } -/* This is needed for scavenging the indirections on the OldMutables list */ - +/* This is needed for scavenging indirections that "hang around"; + e.g., because they are on the OldMutables list, or + because we have "turned off" shorting-out of indirections + (in SMevac.lc). +*/ void _Scavenge_Ind(STG_NO_ARGS) { + I_ size = IND_CLOSURE_SIZE(dummy); DEBUG_SCAV_IND; - PROFILE_CLOSURE(Scav,IND_CLOSURE_SIZE(dummy)); + PROFILE_CLOSURE(Scav,size); DO_EVACUATE(Scav, IND_HS); - NEXT_Scav(IND_CLOSURE_SIZE(dummy)); + NEXT_Scav(size); return; } void _Scavenge_Caf(STG_NO_ARGS) { + I_ size = IND_CLOSURE_SIZE(dummy); DEBUG_SCAV_IND; - PROFILE_CLOSURE(Scav,IND_CLOSURE_SIZE(dummy)); + PROFILE_CLOSURE(Scav,size); DO_EVACUATE(Scav, IND_HS); - NEXT_Scav(IND_CLOSURE_SIZE(dummy)); + NEXT_Scav(size); return; } -#if defined(USE_COST_CENTRES) +#if defined(PROFILING) || defined(TICKY_TICKY) /* Special permanent indirection for lexical scoping. As for _Scavenge_Ind but no PROFILE_CLOSURE. @@ -812,19 +837,21 @@ _Scavenge_Caf(STG_NO_ARGS) void _Scavenge_PI(STG_NO_ARGS) { + I_ size = IND_CLOSURE_SIZE(dummy); DEBUG_SCAV_PERM_IND; - /* PROFILE_CLOSURE(Scav,IND_CLOSURE_SIZE(dummy)); */ + /* PROFILE_CLOSURE(Scav,size); */ DO_EVACUATE(Scav, IND_HS); - NEXT_Scav(IND_CLOSURE_SIZE(dummy)); + NEXT_Scav(size); return; } -#endif /* USE_COST_CENTRES */ +#endif /* PROFILING or TICKY */ #ifdef CONCURRENT void _Scavenge_BQ(STG_NO_ARGS) { + I_ size = BQ_CLOSURE_SIZE(dummy); #if defined(GCgn) P_ save_Scav; #endif @@ -843,14 +870,15 @@ _Scavenge_BQ(STG_NO_ARGS) DO_EVACUATE(Scav, BQ_HS); #endif /* GCgn */ - PROFILE_CLOSURE(Scav,BQ_CLOSURE_SIZE(dummy)); - NEXT_Scav(BQ_CLOSURE_SIZE(dummy)); + PROFILE_CLOSURE(Scav,size); + NEXT_Scav(size); return; } void _Scavenge_TSO(STG_NO_ARGS) { + I_ size = TSO_VHS + TSO_CTS_SIZE; #if defined(GCgn) P_ save_Scav; #endif @@ -861,38 +889,74 @@ _Scavenge_TSO(STG_NO_ARGS) DEBUG_SCAV_TSO; #if defined(GCgn) - /* No old generation roots should be created for mutable */ - /* pointer fields as they will be explicitly collected */ - /* Ensure this by pointing Scav at the new generation */ - save_Scav = Scav; - Scav = OldGen + 1; - - DO_EVACUATE(save_Scav, TSO_LINK_LOCN); - DO_EVACUATE(save_Scav, ((P_) &r->rStkO) - save_Scav); - for(i = 0; liveness != 0; liveness >>= 1, i++) { - if (liveness & 1) { - DO_EVACUATE(save_Scav, ((P_) &r->rR[i].p) - save_Scav) - } - } - Scav = save_Scav; + /* old and probably wrong -- deleted (WDP 95/12) */ #else DO_EVACUATE(Scav, TSO_LINK_LOCN); + DO_EVACUATE(Scav, ((P_) &r->rStkO) - Scav); - for(i = 0; liveness != 0; liveness >>= 1, i++) { + + for (i = 0; liveness != 0; liveness >>= 1, i++) { if (liveness & 1) { DO_EVACUATE(Scav, ((P_) &r->rR[i].p) - Scav) - } + } } #endif - PROFILE_CLOSURE(Scav, TSO_VHS + TSO_CTS_SIZE) - NEXT_Scav(TSO_VHS + TSO_CTS_SIZE); + PROFILE_CLOSURE(Scav, size); + NEXT_Scav(size); return; } +int /* ToDo: move? */ +sanityChk_StkO(P_ stko) +{ + I_ size = STKO_CLOSURE_SIZE(stko); + I_ cts_size = STKO_CLOSURE_CTS_SIZE(stko); + I_ count; + I_ sub = STKO_SuB_OFFSET(stko); /* Offset of first update frame in B stack */ + I_ prev_sub; + P_ begin_stko = STKO_CLOSURE_ADDR(stko, 0); + P_ beyond_stko = STKO_CLOSURE_ADDR(stko, cts_size+1); + + /*fprintf(stderr, "stko=%lx; SpA offset=%ld; first SuB=%ld, size=%ld; next=%lx\n",stko,STKO_SpA_OFFSET(stko),sub,STKO_CLOSURE_CTS_SIZE(stko),STKO_LINK(stko));*/ + + /* Evacuate the locations in the A stack */ + for (count = STKO_SpA_OFFSET(stko); count <= cts_size; count++) { + ASSERT(count >= 0); + } + + while(sub > 0) { + P_ subptr; + P_ suaptr; + P_ updptr; + P_ retptr; + + ASSERT(sub >= 1); + ASSERT(sub <= cts_size); + + retptr = GRAB_RET(STKO_CLOSURE_ADDR(stko,sub)); + subptr = GRAB_SuB(STKO_CLOSURE_ADDR(stko,sub)); + suaptr = GRAB_SuA(STKO_CLOSURE_ADDR(stko,sub)); + updptr = GRAB_UPDATEE(STKO_CLOSURE_ADDR(stko,sub)); + + ASSERT(subptr >= begin_stko); + ASSERT(subptr < beyond_stko); + + ASSERT(suaptr >= begin_stko); + ASSERT(suaptr <= beyond_stko); + + /* ToDo: would be nice to chk that retptr is in text space */ + + sub = STKO_CLOSURE_OFFSET(stko, subptr); + } + + return 1; +} + void _Scavenge_StkO(STG_NO_ARGS) { + I_ size = STKO_CLOSURE_SIZE(Scav); #if defined(GCgn) P_ save_Scav; #endif @@ -902,31 +966,10 @@ _Scavenge_StkO(STG_NO_ARGS) DEBUG_SCAV_STKO; #if defined(GCgn) - /* No old generation roots should be created for mutable */ - /* pointer fields as they will be explicitly collected */ - /* Ensure this by pointing Scav at the new generation */ - save_Scav = Scav; - Scav = OldGen + 1; - - /* Evacuate the link */ - DO_EVACUATE(save_Scav, STKO_LINK_LOCN); - - /* Evacuate the locations in the A stack */ - for (count = STKO_SpA_OFFSET(save_Scav); - count <= STKO_CLOSURE_CTS_SIZE(save_Scav); count++) { - STKO_DO_EVACUATE(count); - } - - /* Now evacuate the updatees in the update stack */ - while(sub > 0) { - P_ subptr; - - STKO_DO_EVACUATE(sub + BREL(UF_UPDATEE)); - subptr = GRAB_SuB(STKO_CLOSURE_ADDR(save_Scav,sub)); - sub = STKO_CLOSURE_OFFSET(save_Scav, subptr); - } - Scav = save_Scav; + /* deleted; probably wrong */ #else + ASSERT(sanityChk_StkO(Scav)); + /* Evacuate the link */ DO_EVACUATE(Scav, STKO_LINK_LOCN); @@ -941,11 +984,13 @@ _Scavenge_StkO(STG_NO_ARGS) STKO_DO_EVACUATE(sub + BREL(UF_UPDATEE)); subptr = GRAB_SuB(STKO_CLOSURE_ADDR(Scav,sub)); + sub = STKO_CLOSURE_OFFSET(Scav, subptr); } + #endif - PROFILE_CLOSURE(Scav, STKO_CLOSURE_SIZE(Scav)) - NEXT_Scav(STKO_CLOSURE_SIZE(Scav)); + PROFILE_CLOSURE(Scav, size); + NEXT_Scav(size); return; } @@ -954,15 +999,17 @@ _Scavenge_StkO(STG_NO_ARGS) void _Scavenge_FetchMe(STG_NO_ARGS) { - DEBUG_SCAV(2,0); - PROFILE_CLOSURE(Scav,2); - NEXT_Scav(2); + I_ size = FETCHME_CLOSURE_SIZE(dummy); + DEBUG_SCAV(size,0); + PROFILE_CLOSURE(Scav,size); + NEXT_Scav(size); return; } void _Scavenge_BF(STG_NO_ARGS) { + I_ size = BF_CLOSURE_SIZE(dummy); #if defined(GCgn) P_ save_Scav; #endif @@ -984,8 +1031,8 @@ _Scavenge_BF(STG_NO_ARGS) DO_EVACUATE(Scav, BF_NODE_LOCN); #endif - PROFILE_CLOSURE(Scav, BF_CLOSURE_SIZE(dummy)) - NEXT_Scav(BF_CLOSURE_SIZE(dummy)); + PROFILE_CLOSURE(Scav, size); + NEXT_Scav(size); return; } @@ -1001,8 +1048,9 @@ _Scavenge_BF(STG_NO_ARGS) void _Scavenge_OldRoot(STG_NO_ARGS) { - DEBUG_SCAV_OLDROOT(MIN_UPD_SIZE); /* dodgy size (WDP 95/07) */ - NEXT_Scav(MIN_UPD_SIZE); + I_ size = ????? + DEBUG_SCAV_OLDROOT(size); + NEXT_Scav(size); return; } diff --git a/ghc/runtime/storage/SMstacks.lc b/ghc/runtime/storage/SMstacks.lc index dc7452b027..f00daa8496 100644 --- a/ghc/runtime/storage/SMstacks.lc +++ b/ghc/runtime/storage/SMstacks.lc @@ -16,42 +16,47 @@ EXTDATA_RO(StkO_static_info); P_ MainStkO; #endif -I_ -initStacks(sm) -smInfo *sm; +rtsBool +initStacks(smInfo *sm) { /* * Allocate them if they don't exist. One space does for both stacks, since they * grow towards each other */ if (stks_space == 0) { -#ifdef CONCURRENT - MainStkO = (P_) xmalloc((STKO_HS + SM_word_stk_size) * sizeof(W_)); +#ifndef CONCURRENT + stks_space = (P_) stgMallocWords(RTSflags.GcFlags.stksSize, "initStacks"); +#else + MainStkO = (P_) stgMallocWords(STKO_HS + RTSflags.GcFlags.stksSize, "initStacks"); stks_space = MainStkO + STKO_HS; SET_STKO_HDR(MainStkO, StkO_static_info, CC_SUBSUMED); - STKO_SIZE(MainStkO) = SM_word_stk_size + STKO_VHS; + STKO_SIZE(MainStkO) = RTSflags.GcFlags.stksSize + STKO_VHS; + STKO_SpB(MainStkO) = STKO_SuB(MainStkO) = STKO_BSTK_BOT(MainStkO) + BREL(1); + STKO_SpA(MainStkO) = STKO_SuA(MainStkO) = STKO_ASTK_BOT(MainStkO) + AREL(1); STKO_LINK(MainStkO) = Nil_closure; STKO_RETURN(MainStkO) = NULL; -#else - stks_space = (P_) xmalloc(SM_word_stk_size * sizeof(W_)); + + ASSERT(sanityChk_StkO(MainStkO)); #endif } + # if STACK_CHECK_BY_PAGE_FAULT - unmapMiddleStackPage((char *) stks_space, SM_word_stk_size * sizeof(W_)); + unmapMiddleStackPage((char *) stks_space, RTSflags.GcFlags.stksSize * sizeof(W_)); # endif /* Initialise Stack Info and pointers */ - stackInfo.botA = STK_A_FRAME_BASE(stks_space, SM_word_stk_size); - stackInfo.botB = STK_B_FRAME_BASE(stks_space, SM_word_stk_size); + stackInfo.botA = STK_A_FRAME_BASE(stks_space, RTSflags.GcFlags.stksSize); + stackInfo.botB = STK_B_FRAME_BASE(stks_space, RTSflags.GcFlags.stksSize); MAIN_SuA = MAIN_SpA = stackInfo.botA + AREL(1); MAIN_SuB = MAIN_SpB = stackInfo.botB + BREL(1); - if (SM_trace) + if (RTSflags.GcFlags.trace) fprintf(stderr, "STACK init: botA, spa: 0x%lx, 0x%lx\n botB, spb: 0x%lx, 0x%lx\n", (W_) stackInfo.botA, (W_) MAIN_SpA, (W_) stackInfo.botB, (W_) MAIN_SpB); - return 0; + return rtsTrue; } + #endif /* not parallel */ \end{code} diff --git a/ghc/runtime/storage/SMstatic.lc b/ghc/runtime/storage/SMstatic.lc index 2f953f135a..73558937fd 100644 --- a/ghc/runtime/storage/SMstatic.lc +++ b/ghc/runtime/storage/SMstatic.lc @@ -317,6 +317,6 @@ static const W_ INTLIKE_closures_def[] = { INTLIKE_HDR(16) /* MAX_INTLIKE == 16 */ }; -P_ INTLIKE_closures = (P_) __INTLIKE_CLOSURE(0); +const P_ INTLIKE_closures = (const P_) __INTLIKE_CLOSURE(0); \end{code} diff --git a/ghc/runtime/storage/SMstats.lc b/ghc/runtime/storage/SMstats.lc index 3f6dfc3d60..37e4895f5f 100644 --- a/ghc/runtime/storage/SMstats.lc +++ b/ghc/runtime/storage/SMstats.lc @@ -19,7 +19,7 @@ stat_exit #define NULL_REG_MAP #include "SMinternal.h" -#include "RednCounts.h" +#include "Ticky.h" #ifdef HAVE_SYS_TYPES_H #include <sys/types.h> @@ -70,14 +70,7 @@ static ullong GC_tot_alloc = 0; /* Total heap allocated -- 64 bits? */ static I_ GC_start_faults = 0, GC_end_faults = 0; char * -#ifdef __STDC__ ullong_format_string(ullong x, char *s, rtsBool with_commas) -#else -ullong_format_string(x, s, with_commas) - ullong x; - char *s; - rtsBool with_commas; -#endif { if (x < (ullong)1000) sprintf(s, "%ld", (I_)x); @@ -226,52 +219,54 @@ pagefaults(STG_NO_ARGS) /* Called at the beginning of execution of the program */ /* Writes the command line and inits stats header */ -void stat_init(collector, comment1, comment2) -char *collector, *comment1, *comment2; +void +stat_init(char *collector, char *comment1, char *comment2) { - if (SM_statsfile != NULL) { + FILE *sf = RTSflags.GcFlags.statsFile; + + if (sf != NULL) { char temp[BIG_STRING_LEN]; - ullong_format_string( (ullong)SM_word_heap_size*sizeof(W_), temp, rtsTrue/*commas*/); - fprintf(SM_statsfile, "\nCollector: %s HeapSize: %s (bytes)\n\n", collector, temp); - if (SM_stats_verbose) { + ullong_format_string( (ullong)RTSflags.GcFlags.heapSize*sizeof(W_), temp, rtsTrue/*commas*/); + fprintf(sf, "\nCollector: %s HeapSize: %s (bytes)\n\n", collector, temp); + if (RTSflags.GcFlags.giveStats) { #if !defined(HAVE_GETRUSAGE) || irix_TARGET_OS - fprintf(SM_statsfile, "NOTE: `pagefaults' does nothing!\n"); + fprintf(sf, "NOTE: `pagefaults' does nothing!\n"); #endif - fprintf(SM_statsfile, + fprintf(sf, /*######## ####### ####### ##.# ##.## ##.## ####.## ####.## #### ####*/ " Alloc Collect Live Resid GC GC TOT TOT Page Flts %s\n", comment1); - fprintf(SM_statsfile, + fprintf(sf, " bytes bytes bytes ency user elap user elap GC MUT %s\n", comment2); } #if defined(GCap) || defined(GCgn) else { - fprintf(SM_statsfile, + fprintf(sf, /*######## ####### ##.# ####### ##.# ### ##.## ##.## ##.## ##.## ####.## ####.## #### ####*/ " Alloc Promote Promo Live Resid Minor Minor Minor Major Major TOT TOT Page Flts\n"); - fprintf(SM_statsfile, + fprintf(sf, " bytes bytes ted bytes ency No user elap user elap user elap MUT Major\n"); } #endif /* generational */ - fflush(SM_statsfile); + fflush(sf); } } - /* Called at the beginning of each GC */ static I_ rub_bell = 0; void -stat_startGC(alloc) - I_ alloc; +stat_startGC(I_ alloc) { + FILE *sf = RTSflags.GcFlags.statsFile; + #if defined(GCap) || defined(GCgn) - I_ bell = alloc == 0 ? SM_ring_bell : 0; + I_ bell = alloc == 0 ? RTSflags.GcFlags.ringBell : 0; #else /* ! generational */ - I_ bell = SM_ring_bell; + I_ bell = RTSflags.GcFlags.ringBell; #endif /* ! generational */ if (bell) { @@ -283,16 +278,16 @@ stat_startGC(alloc) } } - if (SM_statsfile != NULL) { + if (sf != NULL) { GC_start_time = usertime(); GCe_start_time = elapsedtime(); #if defined(GCap) || defined(GCgn) - if (SM_stats_verbose || alloc == 0) { + if (RTSflags.GcFlags.giveStats || alloc == 0) { GC_start_faults = pagefaults(); } #else /* ! generational */ - if (SM_stats_verbose) { + if (RTSflags.GcFlags.giveStats) { GC_start_faults = pagefaults(); } #endif /* ! generational */ @@ -300,24 +295,23 @@ stat_startGC(alloc) } } - /* Called at the end of each GC */ void -stat_endGC(alloc, collect, live, comment) - I_ alloc, collect, live; - char *comment; +stat_endGC(I_ alloc, I_ collect, I_ live, char *comment) { - if (SM_statsfile != NULL) { + FILE *sf = RTSflags.GcFlags.statsFile; + + if (sf != NULL) { StgDouble time = usertime(); StgDouble etime = elapsedtime(); - if (SM_stats_verbose){ + if (RTSflags.GcFlags.giveStats) { I_ faults = pagefaults(); - fprintf(SM_statsfile, "%8ld %7ld %7ld %5.1f%%", - alloc*sizeof(W_), collect*sizeof(W_), live*sizeof(W_), collect == 0 ? 0.0 : (live / (StgFloat) collect * 100)); - fprintf(SM_statsfile, " %5.2f %5.2f %7.2f %7.2f %4ld %4ld %s\n", + fprintf(sf, "%8ld %7ld %7ld %5.1f%%", + alloc*sizeof(W_), collect*sizeof(W_), live*sizeof(W_), collect == 0 ? 0.0 : (live / (StgDouble) collect * 100)); + fprintf(sf, " %5.2f %5.2f %7.2f %7.2f %4ld %4ld %s\n", (time-GC_start_time), (etime-GCe_start_time), time, @@ -327,18 +321,18 @@ stat_endGC(alloc, collect, live, comment) comment); GC_end_faults = faults; - fflush(SM_statsfile); + fflush(sf); } #if defined(GCap) || defined(GCgn) else if(alloc == 0 && collect != 0) { I_ faults = pagefaults(); - fprintf(SM_statsfile, "%8ld %7ld %5.1f%% %7ld %5.1f%%", + fprintf(sf, "%8ld %7ld %5.1f%% %7ld %5.1f%%", GC_alloc_since_maj*sizeof(W_), (collect - GC_live_maj)*sizeof(W_), - (collect - GC_live_maj) / (StgFloat) GC_alloc_since_maj * 100, - live*sizeof(W_), live / (StgFloat) SM_word_heap_size * 100); - fprintf(SM_statsfile, " %3ld %5.2f %5.2f %5.2f %5.2f %7.2f %7.2f %4ld %4ld\n", + (collect - GC_live_maj) / (StgDouble) GC_alloc_since_maj * 100, + live*sizeof(W_), live / (StgDouble) RTSflags.GcFlags.heapSize * 100); + fprintf(sf, " %3ld %5.2f %5.2f %5.2f %5.2f %7.2f %7.2f %4ld %4ld\n", GC_min_since_maj, GC_min_time, GCe_min_time, (time-GC_start_time), (etime-GCe_start_time), @@ -349,7 +343,7 @@ stat_endGC(alloc, collect, live, comment) ); GC_end_faults = faults; - fflush(SM_statsfile); + fflush(sf); } #endif /* generational */ @@ -386,27 +380,27 @@ stat_endGC(alloc, collect, live, comment) } } - /* Called at the end of execution -- to print a summary of statistics */ void -stat_exit(alloc) - I_ alloc; +stat_exit(I_ alloc) { - if (SM_statsfile != NULL){ + FILE *sf = RTSflags.GcFlags.statsFile; + + if (sf != NULL){ char temp[BIG_STRING_LEN]; StgDouble time = usertime(); StgDouble etime = elapsedtime(); - if (SM_stats_verbose) { - fprintf(SM_statsfile, "%8ld\n\n", alloc*sizeof(W_)); + if (RTSflags.GcFlags.giveStats) { + fprintf(sf, "%8ld\n\n", alloc*sizeof(W_)); } #if defined(GCap) || defined (GCgn) else { - fprintf(SM_statsfile, "%8ld %7.7s %6.6s %7.7s %6.6s", + fprintf(sf, "%8ld %7.7s %6.6s %7.7s %6.6s", (GC_alloc_since_maj + alloc)*sizeof(W_), "", "", "", ""); - fprintf(SM_statsfile, " %3ld %5.2f %5.2f\n\n", + fprintf(sf, " %3ld %5.2f %5.2f\n\n", GC_min_since_maj, GC_min_time, GCe_min_time); } GC_min_no += GC_min_since_maj; @@ -414,55 +408,54 @@ stat_exit(alloc) GCe_tot_time += GCe_min_time; GC_tot_alloc += (ullong) (GC_alloc_since_maj + alloc); ullong_format_string(GC_tot_alloc*sizeof(W_), temp, rtsTrue/*commas*/); - fprintf(SM_statsfile, "%11s bytes allocated in the heap\n", temp); + fprintf(sf, "%11s bytes allocated in the heap\n", temp); if ( ResidencySamples > 0 ) { ullong_format_string(MaxResidency*sizeof(W_), temp, rtsTrue/*commas*/); - fprintf(SM_statsfile, "%11s bytes maximum residency (%.1f%%, %ld sample(s))\n", + fprintf(sf, "%11s bytes maximum residency (%.1f%%, %ld sample(s))\n", temp, - MaxResidency / (StgFloat) SM_word_heap_size * 100, + MaxResidency / (StgDouble) RTSflags.GcFlags.heapSize * 100, ResidencySamples); } - fprintf(SM_statsfile, "%11ld garbage collections performed (%ld major, %ld minor)\n\n", + fprintf(sf, "%11ld garbage collections performed (%ld major, %ld minor)\n\n", GC_maj_no + GC_min_no, GC_maj_no, GC_min_no); #else /* ! generational */ GC_tot_alloc += (ullong) alloc; ullong_format_string(GC_tot_alloc*sizeof(W_), temp, rtsTrue/*commas*/); - fprintf(SM_statsfile, "%11s bytes allocated in the heap\n", temp); + fprintf(sf, "%11s bytes allocated in the heap\n", temp); if ( ResidencySamples > 0 ) { ullong_format_string(MaxResidency*sizeof(W_), temp, rtsTrue/*commas*/); - fprintf(SM_statsfile, "%11s bytes maximum residency (%.1f%%, %ld sample(s))\n", + fprintf(sf, "%11s bytes maximum residency (%.1f%%, %ld sample(s))\n", temp, - MaxResidency / (StgFloat) SM_word_heap_size * 100, + MaxResidency / (StgDouble) RTSflags.GcFlags.heapSize * 100, ResidencySamples); } - fprintf(SM_statsfile, "%11ld garbage collections performed\n\n", GC_maj_no); + fprintf(sf, "%11ld garbage collections performed\n\n", GC_maj_no); #endif /* ! generational */ - fprintf(SM_statsfile, " INIT time %6.2fs (%6.2fs elapsed)\n", + fprintf(sf, " INIT time %6.2fs (%6.2fs elapsed)\n", InitUserTime, InitElapsedTime); - fprintf(SM_statsfile, " MUT time %6.2fs (%6.2fs elapsed)\n", + fprintf(sf, " MUT time %6.2fs (%6.2fs elapsed)\n", time - GC_tot_time - InitUserTime, etime - GCe_tot_time - InitElapsedTime); - fprintf(SM_statsfile, " GC time %6.2fs (%6.2fs elapsed)\n", + fprintf(sf, " GC time %6.2fs (%6.2fs elapsed)\n", GC_tot_time, GCe_tot_time); - fprintf(SM_statsfile, " Total time %6.2fs (%6.2fs elapsed)\n\n", + fprintf(sf, " Total time %6.2fs (%6.2fs elapsed)\n\n", time, etime); - fprintf(SM_statsfile, " %%GC time %5.1f%% (%.1f%% elapsed)\n\n", + fprintf(sf, " %%GC time %5.1f%% (%.1f%% elapsed)\n\n", GC_tot_time*100./time, GCe_tot_time*100./etime); ullong_format_string((ullong)(GC_tot_alloc*sizeof(W_)/(time - GC_tot_time)), temp, rtsTrue/*commas*/); - fprintf(SM_statsfile, " Alloc rate %s bytes per MUT second\n\n", temp); + fprintf(sf, " Alloc rate %s bytes per MUT second\n\n", temp); - fprintf(SM_statsfile, " Productivity %5.1f%% of total user, %.1f%% of total elapsed\n\n", + fprintf(sf, " Productivity %5.1f%% of total user, %.1f%% of total elapsed\n\n", (time - GC_tot_time - InitUserTime) * 100. / time, (time - GC_tot_time - InitUserTime) * 100. / etime); - fflush(SM_statsfile); - fclose(SM_statsfile); + fflush(sf); + fclose(sf); } } - \end{code} diff --git a/ghc/runtime/storage/mprotect.lc b/ghc/runtime/storage/mprotect.lc index 8c50a6ee5a..a27199ffe5 100644 --- a/ghc/runtime/storage/mprotect.lc +++ b/ghc/runtime/storage/mprotect.lc @@ -65,7 +65,7 @@ int size; } if (mprotect(middle, pagesize, PROT_NONE) == -1) { perror("mprotect"); - exit(1); + EXIT(EXIT_FAILURE); } if (install_segv_handler()) { fprintf(stderr, "Can't install SIGSEGV handler for stack overflow check.\n"); |