/* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.124 2001/10/17 15:19:24 simonmar Exp $
+ * $Id: GC.c,v 1.131 2002/03/07 17:53:05 keithw Exp $
*
* (c) The GHC Team 1998-1999
*
#include "FrontPanel.h"
#endif
+#include "RetainerProfile.h"
+#include "LdvProfile.h"
+
/* STATIC OBJECT LIST.
*
* During GC:
static void scavenge_static ( void );
static void scavenge_mutable_list ( generation *g );
static void scavenge_mut_once_list ( generation *g );
-static void scavengeCAFs ( void );
#if 0 && defined(DEBUG)
static void gcCAFs ( void );
- free from-space in each step, and set from-space = to-space.
+ Locks held: sched_mutex
+
-------------------------------------------------------------------------- */
void
}
}
- scavengeCAFs();
+ /* follow roots from the CAF list (used by GHCi)
+ */
+ evac_gen = 0;
+ markCAFs(mark_root);
/* follow all the roots that the application knows about.
*/
}
}
+#ifdef PROFILING
+ // We call processHeapClosureForDead() on every closure destroyed during
+ // the current garbage collection, so we invoke LdvCensusForDead().
+ if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV
+ || RtsFlags.ProfFlags.bioSelector != NULL)
+ LdvCensusForDead(N);
+#endif
+
// NO MORE EVACUATION AFTER THIS POINT!
// Finally: compaction of the oldest generation.
if (major_gc && oldest_gen->steps[0].is_compacted) {
}
resizeNursery((nat)blocks);
+
+ } else {
+ // we might have added extra large blocks to the nursery, so
+ // resize back to minAllocAreaSize again.
+ resizeNursery(RtsFlags.GcFlags.minAllocAreaSize);
}
}
if (major_gc) { gcCAFs(); }
#endif
+#ifdef PROFILING
+ // resetStaticObjectForRetainerProfiling() must be called before
+ // zeroing below.
+ resetStaticObjectForRetainerProfiling();
+#endif
+
// zero the scavenged static object list
if (major_gc) {
zero_static_object_list(scavenged_static_objects);
// Reset the nursery
resetNurseries();
+ // let go of lock (so that it can be re-grabbed below).
+ RELEASE_LOCK(&sched_mutex);
+
// start any pending finalizers
scheduleFinalizers(old_weak_ptr_list);
// send exceptions to any threads which were about to die
resurrectThreads(resurrected_threads);
+ ACQUIRE_LOCK(&sched_mutex);
+
// Update the stable pointer hash table.
updateStablePtrTable(major_gc);
// restore enclosing cost centre
#ifdef PROFILING
- heapCensus();
CCCS = prev_CCS;
#endif
copy(StgClosure *src, nat size, step *stp)
{
P_ to, from, dest;
+#ifdef PROFILING
+ // @LDV profiling
+ nat size_org = size;
+#endif
TICK_GC_WORDS_COPIED(size);
/* Find out where we're going, using the handy "to" pointer in
dest = stp->hp;
stp->hp = to;
upd_evacuee(src,(StgClosure *)dest);
+#ifdef PROFILING
+ // We store the size of the just evacuated object in the LDV word so that
+ // the profiler can guess the position of the next object later.
+ SET_EVACUAEE_FOR_LDV(src, size_org);
+#endif
return (StgClosure *)dest;
}
*/
-static __inline__ StgClosure *
+static StgClosure *
copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp)
{
P_ dest, to, from;
+#ifdef PROFILING
+ // @LDV profiling
+ nat size_to_copy_org = size_to_copy;
+#endif
TICK_GC_WORDS_COPIED(size_to_copy);
if (stp->gen_no < evac_gen) {
dest = stp->hp;
stp->hp += size_to_reserve;
upd_evacuee(src,(StgClosure *)dest);
+#ifdef PROFILING
+ // We store the size of the just evacuated object in the LDV word so that
+ // the profiler can guess the position of the next object later.
+ // size_to_copy_org is wrong because the closure already occupies size_to_reserve
+ // words.
+ SET_EVACUAEE_FOR_LDV(src, size_to_reserve);
+ // fill the slop
+ if (size_to_reserve - size_to_copy_org > 0)
+ FILL_SLOP(stp->hp - 1, (int)(size_to_reserve - size_to_copy_org));
+#endif
return (StgClosure *)dest;
}
if (HEAP_ALLOCED(q)) {
bd = Bdescr((P_)q);
+ // not a group head: find the group head
+ if (bd->blocks == 0) { bd = bd->link; }
+
if (bd->gen_no > N) {
/* Can't evacuate this object, because it's in a generation
* older than the ones we're collecting. Let's hope that it's
// perform the selection!
q = selectee->payload[offset];
+ if (major_gc==rtsTrue) {TICK_GC_SEL_MAJOR();} else {TICK_GC_SEL_MINOR();}
/* if we're already in to-space, there's no need to continue
* with the evacuation, just update the source address with
thunk_selector_depth--;
goto selector_loop;
}
- }
- // otherwise, fall through...
+ } else {
+ TICK_GC_SEL_ABANDONED();
+ // and fall through...
+ }
# endif
case AP_UPD:
}
case IND_PERM:
- if (stp->gen_no != 0) {
- SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info);
- }
+ if (stp->gen->no != 0) {
+#ifdef PROFILING
+ // @LDV profiling
+ // No need to call LDV_recordDead_FILL_SLOP_DYNAMIC() because an
+ // IND_OLDGEN_PERM closure is larger than an IND_PERM closure.
+ LDV_recordDead((StgClosure *)p, sizeofW(StgInd));
+#endif
+ //
+ // Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
+ //
+ SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info);
+#ifdef PROFILING
+ // @LDV profiling
+ // We pretend that p has just been created.
+ LDV_recordCreate((StgClosure *)p);
+#endif
+ }
// fall through
case IND_OLDGEN_PERM:
((StgIndOldGen *)p)->indirectee =
}
void
-scavengeCAFs( void )
+markCAFs( evac_fn evac )
{
StgIndStatic *c;
- evac_gen = 0;
for (c = (StgIndStatic *)caf_list; c != NULL;
c = (StgIndStatic *)c->static_link)
{
- c->indirectee = evacuate(c->indirectee);
+ evac(&c->indirectee);
}
}
#if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
belch("Unexpected lazy BHing required at 0x%04x",(int)bh);
#endif
+#ifdef PROFILING
+ // @LDV profiling
+ // We pretend that bh is now dead.
+ LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh);
+#endif
SET_INFO(bh,&stg_BLACKHOLE_info);
+#ifdef PROFILING
+ // @LDV profiling
+ // We pretend that bh has just been created.
+ LDV_recordCreate(bh);
+#endif
}
update_frame = update_frame->link;
}
}
#endif
+#ifdef PROFILING
+ // @LDV profiling
+ // We pretend that bh is now dead.
+ LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh);
+#endif
+ //
+ // Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
+ //
SET_INFO(bh,&stg_BLACKHOLE_info);
+#ifdef PROFILING
+ // @LDV profiling
+ // We pretend that bh has just been created.
+ LDV_recordCreate(bh);
+#endif
}
}
projects / ghc-hetmet.git / blobdiff