projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Wrap gcc on Windows, to provide the -B flags
[ghc-hetmet.git]
/
rts
/
sm
/
Compact.c
diff --git
a/rts/sm/Compact.c
b/rts/sm/Compact.c
index
b8a40d4
..
c566aa0
100644
(file)
--- a/
rts/sm/Compact.c
+++ b/
rts/sm/Compact.c
@@
-1,6
+1,6
@@
/* -----------------------------------------------------------------------------
*
/* -----------------------------------------------------------------------------
*
- * (c) The GHC Team 2001-2006
+ * (c) The GHC Team 2001-2008
*
* Compacting garbage collector
*
*
* Compacting garbage collector
*
@@
-13,16
+13,18
@@
#include "PosixSource.h"
#include "Rts.h"
#include "PosixSource.h"
#include "Rts.h"
+
+#include "Storage.h"
#include "RtsUtils.h"
#include "RtsUtils.h"
-#include "RtsFlags.h"
-#include "OSThreads.h"
#include "BlockAlloc.h"
#include "BlockAlloc.h"
-#include "MBlock.h"
#include "GC.h"
#include "Compact.h"
#include "Schedule.h"
#include "Apply.h"
#include "Trace.h"
#include "GC.h"
#include "Compact.h"
#include "Schedule.h"
#include "Apply.h"
#include "Trace.h"
+#include "Weak.h"
+#include "MarkWeak.h"
+#include "Stable.h"
// Turn off inlining when debugging - it obfuscates things
#ifdef DEBUG
// Turn off inlining when debugging - it obfuscates things
#ifdef DEBUG
@@
-83,11
+85,8
@@
thread (StgClosure **p)
if (HEAP_ALLOCED(q)) {
bd = Bdescr(q);
if (HEAP_ALLOCED(q)) {
bd = Bdescr(q);
- // a handy way to discover whether the ptr is into the
- // compacted area of the old gen, is that the EVACUATED flag
- // is zero (it's non-zero for all the other areas of live
- // memory).
- if ((bd->flags & BF_EVACUATED) == 0)
+
+ if (bd->flags & BF_MARKED)
{
iptr = *q;
switch (GET_CLOSURE_TAG((StgClosure *)iptr))
{
iptr = *q;
switch (GET_CLOSURE_TAG((StgClosure *)iptr))
@@
-109,6
+108,12
@@
thread (StgClosure **p)
}
}
}
}
+static void
+thread_root (void *user STG_UNUSED, StgClosure **p)
+{
+ thread(p);
+}
+
// This version of thread() takes a (void *), used to circumvent
// warnings from gcc about pointer punning and strict aliasing.
STATIC_INLINE void thread_ (void *p) { thread((StgClosure **)p); }
// This version of thread() takes a (void *), used to circumvent
// warnings from gcc about pointer punning and strict aliasing.
STATIC_INLINE void thread_ (void *p) { thread((StgClosure **)p); }
@@
-163,7
+168,7
@@
loop:
case 1:
{
StgWord r = *(StgPtr)(q-1);
case 1:
{
StgWord r = *(StgPtr)(q-1);
- ASSERT(LOOKS_LIKE_INFO_PTR(UNTAG_CLOSURE((StgClosure *)r)));
+ ASSERT(LOOKS_LIKE_INFO_PTR((StgWord)UNTAG_CLOSURE((StgClosure *)r)));
return r;
}
case 2:
return r;
}
case 2:
@@
-461,7
+466,7
@@
thread_AP_STACK (StgAP_STACK *ap)
static StgPtr
thread_TSO (StgTSO *tso)
{
static StgPtr
thread_TSO (StgTSO *tso)
{
- thread_(&tso->link);
+ thread_(&tso->_link);
thread_(&tso->global_link);
if ( tso->why_blocked == BlockedOnMVar
thread_(&tso->global_link);
if ( tso->why_blocked == BlockedOnMVar
@@
-487,6
+492,10
@@
update_fwd_large( bdescr *bd )
for (; bd != NULL; bd = bd->link) {
for (; bd != NULL; bd = bd->link) {
+ // nothing to do in a pinned block; it might not even have an object
+ // at the beginning.
+ if (bd->flags & BF_PINNED) continue;
+
p = bd->start;
info = get_itbl((StgClosure *)p);
p = bd->start;
info = get_itbl((StgClosure *)p);
@@
-618,8
+627,6
@@
thread_obj (StgInfoTable *info, StgPtr p)
case MUT_VAR_CLEAN:
case MUT_VAR_DIRTY:
case CAF_BLACKHOLE:
case MUT_VAR_CLEAN:
case MUT_VAR_DIRTY:
case CAF_BLACKHOLE:
- case SE_CAF_BLACKHOLE:
- case SE_BLACKHOLE:
case BLACKHOLE:
{
StgPtr end;
case BLACKHOLE:
{
StgPtr end;
@@
-635,6
+642,7
@@
thread_obj (StgInfoTable *info, StgPtr p)
case WEAK:
{
StgWeak *w = (StgWeak *)p;
case WEAK:
{
StgWeak *w = (StgWeak *)p;
+ thread(&w->cfinalizer);
thread(&w->key);
thread(&w->value);
thread(&w->finalizer);
thread(&w->key);
thread(&w->value);
thread(&w->finalizer);
@@
-846,15
+854,15
@@
update_fwd_compact( bdescr *blocks )
size = p - q;
if (free + size > free_bd->start + BLOCK_SIZE_W) {
size = p - q;
if (free + size > free_bd->start + BLOCK_SIZE_W) {
- // unset the next bit in the bitmap to indicate that
+ // set the next bit in the bitmap to indicate that
// this object needs to be pushed into the next
// block. This saves us having to run down the
// threaded info pointer list twice during the next pass.
// this object needs to be pushed into the next
// block. This saves us having to run down the
// threaded info pointer list twice during the next pass.
- unmark(q+1,bd);
+ mark(q+1,bd);
free_bd = free_bd->link;
free = free_bd->start;
} else {
free_bd = free_bd->link;
free = free_bd->start;
} else {
- ASSERT(is_marked(q+1,bd));
+ ASSERT(!is_marked(q+1,bd));
}
unthread(q,(StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr));
}
unthread(q,(StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr));
@@
-913,7
+921,7
@@
update_bkwd_compact( step *stp )
}
#endif
}
#endif
- if (!is_marked(p+1,bd)) {
+ if (is_marked(p+1,bd)) {
// don't forget to update the free ptr in the block desc.
free_bd->free = free;
free_bd = free_bd->link;
// don't forget to update the free ptr in the block desc.
free_bd->free = free;
free_bd = free_bd->link;
@@
-923,7
+931,7
@@
update_bkwd_compact( step *stp )
iptr = get_threaded_info(p);
unthread(p, (StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr));
iptr = get_threaded_info(p);
unthread(p, (StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr));
- ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
+ ASSERT(LOOKS_LIKE_INFO_PTR((StgWord)((StgClosure *)p)->header.info));
info = get_itbl((StgClosure *)p);
size = closure_sizeW_((StgClosure *)p,info);
info = get_itbl((StgClosure *)p);
size = closure_sizeW_((StgClosure *)p,info);
@@
-955,13
+963,13
@@
update_bkwd_compact( step *stp )
}
void
}
void
-compact(void)
+compact(StgClosure *static_objects)
{
nat g, s, blocks;
step *stp;
// 1. thread the roots
{
nat g, s, blocks;
step *stp;
// 1. thread the roots
- GetRoots((evac_fn)thread);
+ markCapabilities((evac_fn)thread_root, NULL);
// the weak pointer lists...
if (weak_ptr_list != NULL) {
// the weak pointer lists...
if (weak_ptr_list != NULL) {
@@
-975,19
+983,33
@@
compact(void)
for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
bdescr *bd;
StgPtr p;
for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
bdescr *bd;
StgPtr p;
+ nat n;
for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
for (p = bd->start; p < bd->free; p++) {
thread((StgClosure **)p);
}
}
for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
for (p = bd->start; p < bd->free; p++) {
thread((StgClosure **)p);
}
}
+ for (n = 0; n < n_capabilities; n++) {
+ for (bd = capabilities[n].mut_lists[g];
+ bd != NULL; bd = bd->link) {
+ for (p = bd->start; p < bd->free; p++) {
+ thread((StgClosure **)p);
+ }
+ }
+ }
}
// the global thread list
}
// the global thread list
- thread((void *)&all_threads);
+ for (s = 0; s < total_steps; s++) {
+ thread((void *)&all_steps[s].threads);
+ }
// any threads resurrected during this GC
thread((void *)&resurrected_threads);
// any threads resurrected during this GC
thread((void *)&resurrected_threads);
+ // the blackhole queue
+ thread((void *)&blackhole_queue);
+
// the task list
{
Task *task;
// the task list
{
Task *task;
@@
-999,13
+1021,13
@@
compact(void)
}
// the static objects
}
// the static objects
- thread_static(scavenged_static_objects);
+ thread_static(static_objects /* ToDo: ok? */);
// the stable pointer table
// the stable pointer table
- threadStablePtrTable((evac_fn)thread);
+ threadStablePtrTable((evac_fn)thread_root, NULL);
// the CAF list (used by GHCi)
// the CAF list (used by GHCi)
- markCAFs((evac_fn)thread);
+ markCAFs((evac_fn)thread_root, NULL);
// 2. update forward ptrs
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
// 2. update forward ptrs
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {