don't make -ddump-if-trace imply -no-recomp

[ghc-hetmet.git] / rts / ThreadPaused.c

diff --git a/rts/ThreadPaused.c b/rts/ThreadPaused.c
index f701704..3aa66ed 100644 (file)
--- a/rts/ThreadPaused.c
+++ b/rts/ThreadPaused.c
@@ -8,6 +8,7 @@
 
 #include "Rts.h"
 #include "Storage.h"
+#include "LdvProfile.h"
 #include "Updates.h"
 #include "RaiseAsync.h"
 #include "Trace.h"
@@ -49,7 +50,7 @@ stackSqueeze(StgTSO *tso, StgPtr bottom)
     current_gap_size = 0;
     gap = (struct stack_gap *) (tso->sp - sizeofW(StgUpdateFrame));
 
-    while (frame < bottom) {
+    while (frame <= bottom) {
        
        info = get_ret_itbl((StgClosure *)frame);
        switch (info->i.type) {
@@ -177,6 +178,8 @@ threadPaused(Capability *cap, StgTSO *tso)
 {
     StgClosure *frame;
     StgRetInfoTable *info;
+    const StgInfoTable *bh_info;
+    const StgInfoTable *cur_bh_info USED_IF_THREADS;
     StgClosure *bh;
     StgPtr stack_end;
     nat words_to_squeeze = 0;
@@ -199,6 +202,11 @@ threadPaused(Capability *cap, StgTSO *tso)
     while (1) {
        // If we've already marked this frame, then stop here.
        if (frame->header.info == (StgInfoTable *)&stg_marked_upd_frame_info) {
+           if (prev_was_update_frame) {
+               words_to_squeeze += sizeofW(StgUpdateFrame);
+               weight += weight_pending;
+               weight_pending = 0;
+           }
            goto end;
        }
 
@@ -211,8 +219,13 @@ threadPaused(Capability *cap, StgTSO *tso)
            SET_INFO(frame, (StgInfoTable *)&stg_marked_upd_frame_info);
 
            bh = ((StgUpdateFrame *)frame)->updatee;
+            bh_info = bh->header.info;
 
-           if (closure_IND(bh) || bh->header.info == &stg_BLACKHOLE_info) {
+#ifdef THREADED_RTS
+        retry:
+#endif
+           if (closure_flags[INFO_PTR_TO_STRUCT(bh_info)->type] & _IND
+                || bh_info == &stg_BLACKHOLE_info) {
                debugTrace(DEBUG_squeeze,
                           "suspending duplicate work: %ld words of stack",
                           (long)((StgPtr)frame - tso->sp));
@@ -245,7 +258,20 @@ threadPaused(Capability *cap, StgTSO *tso)
                // We pretend that bh is now dead.
                LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh);
 #endif
+
+#ifdef THREADED_RTS
+                cur_bh_info = (const StgInfoTable *)
+                    cas((StgVolatilePtr)&bh->header.info, 
+                        (StgWord)bh_info, 
+                        (StgWord)&stg_BLACKHOLE_info);
+
+                if (cur_bh_info != bh_info) {
+                    bh_info = cur_bh_info;
+                    goto retry;
+                }
+#else
                SET_INFO(bh,&stg_BLACKHOLE_info);
+#endif
 
                // We pretend that bh has just been created.
                LDV_RECORD_CREATE(bh);
@@ -284,7 +310,7 @@ end:
     // the number of words we have to shift down is less than the
     // number of stack words we squeeze away by doing so.
     if (RtsFlags.GcFlags.squeezeUpdFrames == rtsTrue &&
-       weight < words_to_squeeze) {
+       ((weight <= 4 && words_to_squeeze > 0) || weight < words_to_squeeze)) {
        stackSqueeze(tso, (StgPtr)frame);
     }
 }