X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FGC.c;h=09e2b2c2f87ae51d358eeb108b2cdacceaafb413;hb=ea661992b7397eddee145b80a449c40ab565fd12;hp=a07086e65f8d2b881e5b8cdedd3332404f31c8b7;hpb=8db56c8606e6c0e89a87d34c3f67124f1e8b988e;p=ghc-hetmet.git diff --git a/rts/sm/GC.c b/rts/sm/GC.c index a07086e..09e2b2c 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -207,16 +207,11 @@ GarbageCollect ( rtsBool force_major_gc ) } #endif - // tell the STM to discard any cached closures it's hoping to re-use - stmPreGCHook(); - // tell the stats department that we've started a GC stat_startGC(); -#ifdef DEBUG - // check for memory leaks if DEBUG is on - memInventory(); -#endif + // tell the STM to discard any cached closures it's hoping to re-use + stmPreGCHook(); #ifdef DEBUG mutlist_MUTVARS = 0; @@ -266,6 +261,11 @@ GarbageCollect ( rtsBool force_major_gc ) } #endif +#ifdef DEBUG + // check for memory leaks if DEBUG is on + memInventory(traceClass(DEBUG_gc)); +#endif + // check stack sanity *before* GC (ToDo: check all threads) IF_DEBUG(sanity, checkFreeListSanity()); @@ -274,12 +274,6 @@ GarbageCollect ( rtsBool force_major_gc ) static_objects = END_OF_STATIC_LIST; scavenged_static_objects = END_OF_STATIC_LIST; -#ifdef THREADED_RTS - initSpinLock(&static_objects_sync); - initSpinLock(&recordMutableGen_sync); - initSpinLock(&gc_alloc_block_sync); -#endif - // Initialise all the generations/steps that we're collecting. for (g = 0; g <= N; g++) { init_collected_gen(g,n_gc_threads); @@ -344,6 +338,11 @@ GarbageCollect ( rtsBool force_major_gc ) gct->evac_step = 0; GetRoots(mark_root); +#if defined(RTS_USER_SIGNALS) + // mark the signal handlers (signals should be already blocked) + markSignalHandlers(mark_root); +#endif + // Mark the weak pointer list, and prepare to detect dead weak pointers. markWeakPtrList(); initWeakForGC(); @@ -575,7 +574,9 @@ GarbageCollect ( rtsBool force_major_gc ) resize_generations(); // Guess the amount of live data for stats. - live = calcLive(); + live = calcLiveBlocks() * BLOCK_SIZE_W; + debugTrace(DEBUG_gc, "Slop: %ldKB", + (live - calcLiveWords()) / (1024/sizeof(W_))); // Free the small objects allocated via allocate(), since this will // all have been copied into G0S1 now. @@ -660,7 +661,7 @@ GarbageCollect ( rtsBool force_major_gc ) #ifdef DEBUG // check for memory leaks if DEBUG is on - memInventory(); + memInventory(traceClass(DEBUG_gc)); #endif #ifdef RTS_GTK_FRONTPANEL @@ -684,6 +685,76 @@ GarbageCollect ( rtsBool force_major_gc ) gct = saved_gct; } +/* ----------------------------------------------------------------------------- + * Mark all nodes pointed to by sparks in the spark queues (for GC) Does an + * implicit slide i.e. after marking all sparks are at the beginning of the + * spark pool and the spark pool only contains sparkable closures + * -------------------------------------------------------------------------- */ + +#ifdef THREADED_RTS +static void +markSparkQueue (evac_fn evac, Capability *cap) +{ + StgClosure **sparkp, **to_sparkp; + nat n, pruned_sparks; // stats only + StgSparkPool *pool; + + PAR_TICKY_MARK_SPARK_QUEUE_START(); + + n = 0; + pruned_sparks = 0; + + pool = &(cap->r.rSparks); + + ASSERT_SPARK_POOL_INVARIANTS(pool); + +#if defined(PARALLEL_HASKELL) + // stats only + n = 0; + pruned_sparks = 0; +#endif + + sparkp = pool->hd; + to_sparkp = pool->hd; + while (sparkp != pool->tl) { + ASSERT(*sparkp!=NULL); + ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgClosure *)*sparkp))); + // ToDo?: statistics gathering here (also for GUM!) + if (closure_SHOULD_SPARK(*sparkp)) { + evac(sparkp); + *to_sparkp++ = *sparkp; + if (to_sparkp == pool->lim) { + to_sparkp = pool->base; + } + n++; + } else { + pruned_sparks++; + } + sparkp++; + if (sparkp == pool->lim) { + sparkp = pool->base; + } + } + pool->tl = to_sparkp; + + PAR_TICKY_MARK_SPARK_QUEUE_END(n); + +#if defined(PARALLEL_HASKELL) + debugTrace(DEBUG_sched, + "marked %d sparks and pruned %d sparks on [%x]", + n, pruned_sparks, mytid); +#else + debugTrace(DEBUG_sched, + "marked %d sparks and pruned %d sparks", + n, pruned_sparks); +#endif + + debugTrace(DEBUG_sched, + "new spark queue len=%d; (hd=%p; tl=%p)\n", + sparkPoolSize(pool), pool->hd, pool->tl); +} +#endif + /* --------------------------------------------------------------------------- Where are the roots that we know about? @@ -695,11 +766,6 @@ GarbageCollect ( rtsBool force_major_gc ) ------------------------------------------------------------------------ */ -/* This has to be protected either by the scheduler monitor, or by the - garbage collection monitor (probably the latter). - KH @ 25/10/99 -*/ - void GetRoots( evac_fn evac ) { @@ -707,7 +773,12 @@ GetRoots( evac_fn evac ) Capability *cap; Task *task; - for (i = 0; i < n_capabilities; i++) { + // Each GC thread is responsible for following roots from the + // Capability of the same number. There will usually be the same + // or fewer Capabilities as GC threads, but just in case there + // are more, we mark every Capability whose number is the GC + // thread's index plus a multiple of the number of GC threads. + for (i = gct->thread_index; i < n_capabilities; i += n_gc_threads) { cap = &capabilities[i]; evac((StgClosure **)(void *)&cap->run_queue_hd); evac((StgClosure **)(void *)&cap->run_queue_tl); @@ -722,6 +793,9 @@ GetRoots( evac_fn evac ) evac((StgClosure **)(void *)&task->suspended_tso); } +#if defined(THREADED_RTS) + markSparkQueue(evac,cap); +#endif } #if !defined(THREADED_RTS) @@ -729,17 +803,6 @@ GetRoots( evac_fn evac ) evac((StgClosure **)(void *)&blocked_queue_tl); evac((StgClosure **)(void *)&sleeping_queue); #endif - - // evac((StgClosure **)&blackhole_queue); - -#if defined(THREADED_RTS) - markSparkQueue(evac); -#endif - -#if defined(RTS_USER_SIGNALS) - // mark the signal handlers (signals should be already blocked) - markSignalHandlers(evac); -#endif } /* ----------------------------------------------------------------------------- @@ -978,6 +1041,10 @@ gc_thread_work (void) // GarbageCollect(), or this is a worker thread and the main // thread bumped gc_running_threads before waking us up. + // Every thread evacuates some roots. + gct->evac_step = 0; + GetRoots(mark_root); + loop: scavenge_loop(); // scavenge_loop() only exits when there's no work to do @@ -1236,9 +1303,11 @@ init_uncollected_gen (nat g, nat threads) // If the block at the head of the list in this generation // is less than 3/4 full, then use it as a todo block. - if (isPartiallyFull(stp->blocks)) + if (stp->blocks && isPartiallyFull(stp->blocks)) { ws->todo_bd = stp->blocks; + ws->todo_free = ws->todo_bd->free; + ws->todo_lim = ws->todo_bd->start + BLOCK_SIZE_W; stp->blocks = stp->blocks->link; stp->n_blocks -= 1; ws->todo_bd->link = NULL;