Re-enable a flag-consistency check
[ghc.git] / rts / ThreadPaused.c
index 94a5a15..0507880 100644 (file)
 
 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: 
@@ -44,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) {
+            if (adjacent_update_frames > 0) {
+                TICK_UPD_SQUEEZED();
+            }
+            adjacent_update_frames++;
 
-               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)) {
-                    updateThunk(cap, tso, 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;
-           }
-       }
+            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
@@ -150,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;
@@ -164,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;
     }
 }    
 
@@ -201,27 +213,27 @@ threadPaused(Capability *cap, StgTSO *tso)
     // 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;
@@ -230,12 +242,44 @@ threadPaused(Capability *cap, StgTSO *tso)
 #ifdef THREADED_RTS
         retry:
 #endif
-           if (bh_info == &stg_BLACKHOLE_info ||
-                bh_info == &stg_WHITEHOLE_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.
@@ -245,25 +289,22 @@ 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->stackobj->sp = (StgPtr)frame + sizeofW(StgUpdateFrame) - 2;
+                tso->stackobj->sp[1] = (StgWord)bh;
                 ASSERT(bh->header.info != &stg_TSO_info);
-               tso->sp[0] = (W_)&stg_enter_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;
            }
 
+
             // zero out the slop so that the sanity checker can tell
             // where the next closure is.
-            DEBUG_FILL_SLOP(bh);
-
-            // @LDV profiling
-            // We pretend that bh is now dead.
-            LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC((StgClosure *)bh);
+            OVERWRITING_CLOSURE(bh);
 
             // an EAGER_BLACKHOLE or CAF_BLACKHOLE gets turned into a
             // BLACKHOLE here.
@@ -301,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
@@ -319,7 +361,7 @@ 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