Re-enable a flag-consistency check
[ghc.git] / rts / ThreadPaused.c
index 93ec960..0507880 100644 (file)
@@ -14,6 +14,7 @@
 #include "Updates.h"
 #include "RaiseAsync.h"
 #include "Trace.h"
+#include "Threads.h"
 
 #include <string.h> // for memmove()
 
 
 struct stack_gap { StgWord gap_size; struct stack_gap *next_gap; };
 
+static struct stack_gap *
+updateAdjacentFrames (Capability *cap, StgTSO *tso,
+                      StgUpdateFrame *upd, nat count, struct stack_gap *next)
+{
+    StgClosure *updatee;
+    struct stack_gap *gap;
+    nat i;
+
+    // The first one (highest address) is the frame we take the
+    // "master" updatee from; all the others will be made indirections
+    // to this one.  It is essential that we do it this way around: we
+    // used to make the lowest-addressed frame the "master" frame and
+    // shuffle it down, but a bad case cropped up (#5505) where this
+    // happened repeatedly, generating a chain of indirections which
+    // the GC repeatedly traversed (indirection chains longer than one
+    // are not supposed to happen).  So now after identifying a block
+    // of adjacent update frames we walk downwards again updating them
+    // all to point to the highest one, before squeezing out all but
+    // the highest one.
+    updatee = upd->updatee;
+    count--;
+
+    upd--;
+    gap = (struct stack_gap*)upd;
+
+    for (i = count; i > 0; i--, upd--) {
+        /*
+         * Check two things: that the two update frames
+         * don't point to the same object, and that the
+         * updatee_bypass isn't already an indirection.
+         * Both of these cases only happen when we're in a
+         * block hole-style loop (and there are multiple
+         * update frames on the stack pointing to the same
+         * closure), but they can both screw us up if we
+         * don't check.
+         */
+        if (upd->updatee != updatee && !closure_IND(upd->updatee)) {
+            updateThunk(cap, tso, upd->updatee, updatee);
+        }
+    }
+
+    gap->gap_size = count * sizeofW(StgUpdateFrame);
+    gap->next_gap = next;
+
+    return gap;
+}
+
 static void
 stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom)
 {
     StgPtr frame;
-    rtsBool prev_was_update_frame;
-    StgClosure *updatee = NULL;
-    StgRetInfoTable *info;
-    StgWord current_gap_size;
+    nat adjacent_update_frames;
     struct stack_gap *gap;
 
     // Stage 1: 
@@ -43,79 +88,47 @@ stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom)
     //    contains two values: the size of the gap, and the distance
     //    to the next gap (or the stack top).
 
-    frame = tso->sp;
+    frame = tso->stackobj->sp;
 
     ASSERT(frame < bottom);
     
-    prev_was_update_frame = rtsFalse;
-    current_gap_size = 0;
-    gap = (struct stack_gap *) (tso->sp - sizeofW(StgUpdateFrame));
+    adjacent_update_frames = 0;
+    gap = (struct stack_gap *) (frame - sizeofW(StgUpdateFrame));
 
-    while (frame <= bottom) {
-       
-       info = get_ret_itbl((StgClosure *)frame);
-       switch (info->i.type) {
+    while (frame <= bottom)
+    {
+        switch (get_ret_itbl((StgClosure *)frame)->i.type) {
 
-       case UPDATE_FRAME:
+        case UPDATE_FRAME:
        { 
-           StgUpdateFrame *upd = (StgUpdateFrame *)frame;
-
-           if (prev_was_update_frame) {
-
-               TICK_UPD_SQUEEZED();
-               /* wasn't there something about update squeezing and ticky to be
-                * sorted out?  oh yes: we aren't counting each enter properly
-                * in this case.  See the log somewhere.  KSW 1999-04-21
-                *
-                * Check two things: that the two update frames don't point to
-                * the same object, and that the updatee_bypass isn't already an
-                * indirection.  Both of these cases only happen when we're in a
-                * block hole-style loop (and there are multiple update frames
-                * on the stack pointing to the same closure), but they can both
-                * screw us up if we don't check.
-                */
-               if (upd->updatee != updatee && !closure_IND(upd->updatee)) {
-                   UPD_IND(cap, upd->updatee, updatee);
-               }
-
-               // now mark this update frame as a stack gap.  The gap
-               // marker resides in the bottom-most update frame of
-               // the series of adjacent frames, and covers all the
-               // frames in this series.
-               current_gap_size += sizeofW(StgUpdateFrame);
-               ((struct stack_gap *)frame)->gap_size = current_gap_size;
-               ((struct stack_gap *)frame)->next_gap = gap;
-
-               frame += sizeofW(StgUpdateFrame);
-               continue;
-           } 
-
-           // single update frame, or the topmost update frame in a series
-           else {
-               prev_was_update_frame = rtsTrue;
-               updatee = upd->updatee;
-               frame += sizeofW(StgUpdateFrame);
-               continue;
-           }
-       }
+            if (adjacent_update_frames > 0) {
+                TICK_UPD_SQUEEZED();
+            }
+            adjacent_update_frames++;
+
+            frame += sizeofW(StgUpdateFrame);
+            continue;
+        }
            
        default:
-           prev_was_update_frame = rtsFalse;
-
-           // we're not in a gap... check whether this is the end of a gap
+            // we're not in a gap... check whether this is the end of a gap
            // (an update frame can't be the end of a gap).
-           if (current_gap_size != 0) {
-               gap = (struct stack_gap *) (frame - sizeofW(StgUpdateFrame));
-           }
-           current_gap_size = 0;
+            if (adjacent_update_frames > 1) {
+                gap = updateAdjacentFrames(cap, tso,
+                                           (StgUpdateFrame*)(frame - sizeofW(StgUpdateFrame)),
+                                           adjacent_update_frames, gap);
+            }
+            adjacent_update_frames = 0;
 
            frame += stack_frame_sizeW((StgClosure *)frame);
            continue;
        }
     }
 
-    if (current_gap_size != 0) {
-       gap = (struct stack_gap *) (frame - sizeofW(StgUpdateFrame));
+    if (adjacent_update_frames > 1) {
+        gap = updateAdjacentFrames(cap, tso,
+                                   (StgUpdateFrame*)(frame - sizeofW(StgUpdateFrame)),
+                                   adjacent_update_frames, gap);
     }
 
     // Now we have a stack with gaps in it, and we have to walk down
@@ -149,7 +162,7 @@ stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom)
        next_gap_start = (StgWord8*)gap + sizeof(StgUpdateFrame);
        sp = next_gap_start;
 
-       while ((StgPtr)gap > tso->sp) {
+        while ((StgPtr)gap > tso->stackobj->sp) {
 
            // we're working in *bytes* now...
            gap_start = next_gap_start;
@@ -163,7 +176,7 @@ stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom)
            memmove(sp, next_gap_start, chunk_size);
        }
 
-       tso->sp = (StgPtr)sp;
+        tso->stackobj->sp = (StgPtr)sp;
     }
 }    
 
@@ -196,31 +209,31 @@ threadPaused(Capability *cap, StgTSO *tso)
     maybePerformBlockedException (cap, tso);
     if (tso->what_next == ThreadKilled) { return; }
 
-    // NB. Blackholing is *not* optional, we must either do lazy
+    // NB. Blackholing is *compulsory*, we must either do lazy
     // blackholing, or eager blackholing consistently.  See Note
     // [upd-black-hole] in sm/Scav.c.
 
-    stack_end = &tso->stack[tso->stack_size];
+    stack_end = tso->stackobj->stack + tso->stackobj->stack_size;
     
-    frame = (StgClosure *)tso->sp;
+    frame = (StgClosure *)tso->stackobj->sp;
 
-    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;
-       }
-
-       info = get_ret_itbl(frame);
+    while ((P_)frame < stack_end) {
+        info = get_ret_itbl(frame);
        
        switch (info->i.type) {
-           
+
        case UPDATE_FRAME:
 
+            // 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;
+            }
+
            SET_INFO(frame, (StgInfoTable *)&stg_marked_upd_frame_info);
 
            bh = ((StgUpdateFrame *)frame)->updatee;
@@ -229,11 +242,44 @@ threadPaused(Capability *cap, StgTSO *tso)
 #ifdef THREADED_RTS
         retry:
 #endif
-           if (closure_flags[INFO_PTR_TO_STRUCT(bh_info)->type] & _IND
-                || bh_info == &stg_BLACKHOLE_info) {
+            // If the info table is a WHITEHOLE or a BLACKHOLE, then
+            // another thread has claimed it (via the SET_INFO()
+            // below), or is in the process of doing so.  In that case
+            // we want to suspend the work that the current thread has
+            // done on this thunk and wait until the other thread has
+            // finished.
+            //
+            // If eager blackholing is taking place, it could be the
+            // case that the blackhole points to the current
+            // TSO. e.g.:
+            //
+            //    this thread                   other thread
+            //    --------------------------------------------------------
+            //                                  c->indirectee = other_tso;
+            //                                  c->header.info = EAGER_BH
+            //                                  threadPaused():
+            //                                    c->header.info = WHITEHOLE
+            //                                    c->indirectee = other_tso
+            //    c->indirectee = this_tso;
+            //    c->header.info = EAGER_BH
+            //                                    c->header.info = BLACKHOLE
+            //    threadPaused()
+            //    *** c->header.info is now BLACKHOLE,
+            //        c->indirectee  points to this_tso
+            //
+            // So in this case do *not* suspend the work of the
+            // current thread, because the current thread will become
+            // deadlocked on itself.  See #5226 for an instance of
+            // this bug.
+            //
+            if ((bh_info == &stg_WHITEHOLE_info ||
+                 bh_info == &stg_BLACKHOLE_info)
+                &&
+                ((StgInd*)bh)->indirectee != (StgClosure*)tso)
+            {
                debugTrace(DEBUG_squeeze,
                           "suspending duplicate work: %ld words of stack",
-                          (long)((StgPtr)frame - tso->sp));
+                           (long)((StgPtr)frame - tso->stackobj->sp));
 
                // If this closure is already an indirection, then
                // suspend the computation up to this point.
@@ -243,44 +289,49 @@ threadPaused(Capability *cap, StgTSO *tso)
 
                // Now drop the update frame, and arrange to return
                // the value to the frame underneath:
-               tso->sp = (StgPtr)frame + sizeofW(StgUpdateFrame) - 2;
-               tso->sp[1] = (StgWord)bh;
-               tso->sp[0] = (W_)&stg_enter_info;
+                tso->stackobj->sp = (StgPtr)frame + sizeofW(StgUpdateFrame) - 2;
+                tso->stackobj->sp[1] = (StgWord)bh;
+                ASSERT(bh->header.info != &stg_TSO_info);
+                tso->stackobj->sp[0] = (W_)&stg_enter_info;
 
                // And continue with threadPaused; there might be
                // yet more computation to suspend.
-                frame = (StgClosure *)tso->sp + 2;
+                frame = (StgClosure *)(tso->stackobj->sp + 2);
                 prev_was_update_frame = rtsFalse;
                 continue;
            }
 
-           if (bh->header.info != &stg_CAF_BLACKHOLE_info) {
-               // zero out the slop so that the sanity checker can tell
-               // where the next closure is.
-               DEBUG_FILL_SLOP(bh);
-#ifdef PROFILING
-               // @LDV profiling
-               // We pretend that bh is now dead.
-               LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh);
-#endif
-                // an EAGER_BLACKHOLE gets turned into a BLACKHOLE here.
+
+            // zero out the slop so that the sanity checker can tell
+            // where the next closure is.
+            OVERWRITING_CLOSURE(bh);
+
+            // an EAGER_BLACKHOLE or CAF_BLACKHOLE gets turned into a
+            // BLACKHOLE here.
 #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);
+            // first we turn it into a WHITEHOLE to claim it, and if
+            // successful we write our TSO and then the BLACKHOLE info pointer.
+            cur_bh_info = (const StgInfoTable *)
+                cas((StgVolatilePtr)&bh->header.info, 
+                    (StgWord)bh_info, 
+                    (StgWord)&stg_WHITEHOLE_info);
+            
+            if (cur_bh_info != bh_info) {
+                bh_info = cur_bh_info;
+                goto retry;
+            }
 #endif
 
-               // We pretend that bh has just been created.
-               LDV_RECORD_CREATE(bh);
-           }
+            // The payload of the BLACKHOLE points to the TSO
+            ((StgInd *)bh)->indirectee = (StgClosure *)tso;
+            write_barrier();
+            SET_INFO(bh,&stg_BLACKHOLE_info);
+
+            // .. and we need a write barrier, since we just mutated the closure:
+            recordClosureMutated(cap,bh);
+
+            // We pretend that bh has just been created.
+            LDV_RECORD_CREATE(bh);
            
            frame = (StgClosure *) ((StgUpdateFrame *)frame + 1);
            if (prev_was_update_frame) {
@@ -291,7 +342,8 @@ threadPaused(Capability *cap, StgTSO *tso)
            prev_was_update_frame = rtsTrue;
            break;
            
-       case STOP_FRAME:
+        case UNDERFLOW_FRAME:
+        case STOP_FRAME:
            goto end;
            
            // normal stack frames; do nothing except advance the pointer
@@ -309,13 +361,14 @@ end:
     debugTrace(DEBUG_squeeze, 
               "words_to_squeeze: %d, weight: %d, squeeze: %s", 
               words_to_squeeze, weight, 
-              weight < words_to_squeeze ? "YES" : "NO");
+               ((weight <= 8 && words_to_squeeze > 0) || weight < words_to_squeeze) ? "YES" : "NO");
 
     // Should we squeeze or not?  Arbitrary heuristic: we squeeze if
     // 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 <= 5 && words_to_squeeze > 0) || weight < words_to_squeeze)) {
+       ((weight <= 8 && words_to_squeeze > 0) || weight < words_to_squeeze)) {
+        // threshold above bumped from 5 to 8 as a result of #2797
        stackSqueeze(cap, tso, (StgPtr)frame);
         tso->flags |= TSO_SQUEEZED;
         // This flag tells threadStackOverflow() that the stack was