ghc/runtime/main/StgOverflow.lc

   1 \section[stk-overflow]{Stack overflow routine}
   2
   3 %************************************************************************
   4 %*                                                                      *
   5 \subsection[arity-error]{Arity error has nothing to do with stack overflow}
   6 %*                                                                      *
   7 %************************************************************************
   8
   9 \begin{code}
  10
  11 #include "rtsdefs.h"
  12
  13 void PrintTickyInfo(STG_NO_ARGS);
  14
  15 #ifdef __DO_ARITY_CHKS__
  16 I_ ExpectedArity;
  17
  18 void
  19 ArityError(n)
  20   I_ n;
  21 {
  22     fflush(stdout);
  23     fprintf(stderr, "Arity error: called with %ld args, should have been %ld\n",
  24                 ExpectedArity, n);
  25
  26 #if defined(TICKY_TICKY)
  27     if (RTSflags.TickyFlags.showTickyStats) PrintTickyInfo();
  28 #endif
  29
  30     EXIT(EXIT_FAILURE);
  31 }
  32
  33 #endif  /* __DO_ARITY_CHECKS__ */
  34 \end{code}
  35
  36 %************************************************************************
  37 %*                                                                      *
  38 \subsection[stk-oflow-seq]{Boring sequential stack overflow}
  39 %*                                                                      *
  40 %************************************************************************
  41
  42 \begin{code}
  43 #ifndef CONCURRENT
  44
  45 void
  46 StackOverflow(STG_NO_ARGS)
  47 {
  48     fflush(stdout);
  49     StackOverflowHook(RTSflags.GcFlags.stksSize * sizeof(W_)); /*msg*/
  50
  51 #if defined(TICKY_TICKY)
  52     if (RTSflags.TickyFlags.showTickyStats) PrintTickyInfo();
  53 #endif
  54
  55     EXIT(EXIT_FAILURE);
  56 }
  57 #endif
  58 \end{code}
  59
  60 %************************************************************************
  61 %*                                                                      *
  62 \subsection[stk-squeeze]{Code for squeezing out update frames}
  63 %*                                                                      *
  64 %************************************************************************
  65
  66 Code for squeezing out vacuous update frames.  Updatees of squeezed frames
  67 are turned into indirections to the common black hole (or blocking queue).
  68
  69 \begin{code}
  70 I_
  71 SqueezeUpdateFrames(bottom, top, frame)
  72 P_ bottom;
  73 P_ top;
  74 P_ frame;
  75 {
  76     I_ displacement = 0;
  77     P_ next_frame = NULL;       /* Temporally next */
  78     P_ prev_frame;              /* Temporally previous */
  79
  80     /*
  81      * If we have no update frames, there is nothing to do.
  82      */
  83
  84     if (frame <= bottom)
  85         return 0;
  86
  87     if ((prev_frame = GRAB_SuB(frame)) <= bottom) {
  88 #if !defined(CONCURRENT)
  89         if ( RTSflags.GcFlags.lazyBlackHoling )
  90             UPD_BH(GRAB_UPDATEE(frame), BH_UPD_info);
  91 #endif
  92         return 0;
  93     }
  94
  95     /*
  96      * Walk down the stack, reversing the SuB pointers so that we can walk back up
  97      * as we squeeze from the bottom.  Note that next_frame and prev_frame refer to
  98      * next and previous as they were added to the stack, rather than the way we see
  99      * them in this walk. (It makes the next loop less confusing.)
 100      */
 101
 102     while (prev_frame > bottom) {
 103         PUSH_SuB(frame, next_frame);
 104         next_frame = frame;
 105         frame = prev_frame;
 106         prev_frame = GRAB_SuB(frame);
 107     }
 108
 109     /*
 110      * Now, we're at the bottom.  Frame points to the lowest update
 111      * frame on the stack, and its saved SuB actually points to the
 112      * frame above. We have to walk back up the stack, squeezing out
 113      * empty update frames and turning the pointers back around on the
 114      * way back up.
 115      */
 116
 117     /*
 118      * The bottom-most frame has not been altered, and we never want
 119      * to eliminate it anyway.  Just black hole the updatee and walk
 120      * one step up before starting to squeeze. When you get to the
 121      * topmost frame, remember that there are still some words above
 122      * it that might have to be moved.
 123      */
 124
 125 #if !defined(CONCURRENT)
 126     if ( RTSflags.GcFlags.lazyBlackHoling )
 127         UPD_BH(GRAB_UPDATEE(frame), BH_UPD_info);
 128 #endif
 129     prev_frame = frame;
 130     frame = next_frame;
 131
 132     /*
 133      * Loop through all of the middle frames (everything except the
 134      * very bottom and the very top).
 135      */
 136     while ((next_frame = GRAB_SuB(frame)) != NULL) {
 137         P_ sp;
 138         P_ frame_bottom = frame + BREL(STD_UF_SIZE);
 139
 140         /* Check to see if the current frame is empty (both A and B) */
 141         if (prev_frame == frame_bottom + BREL(displacement) &&
 142           GRAB_SuA(next_frame) == GRAB_SuA(frame)) {
 143
 144             /* Now squeeze out the current frame */
 145             P_ updatee_keep = GRAB_UPDATEE(prev_frame);
 146             P_ updatee_bypass = GRAB_UPDATEE(frame);
 147
 148             /*
 149               fprintf(stderr, "squeezing frame at %lx, ret %lx\n", frame,
 150               GRAB_RET(frame));
 151             */
 152
 153 #ifdef CONCURRENT
 154             /* Check for a blocking queue on the node that's going away */
 155             if (INFO_PTR(updatee_bypass) == (W_) BQ_info) {
 156                 /* Sigh.  It has one.  Don't lose those threads! */
 157                 if (INFO_PTR(updatee_keep) == (W_) BQ_info) {
 158                     /* Urgh.  Two queues.  Merge them. */
 159                     P_ tso = (P_) BQ_ENTRIES(updatee_keep);
 160
 161                     while (TSO_LINK(tso) != Nil_closure)
 162                         tso = TSO_LINK(tso);
 163
 164                     TSO_LINK(tso) = (P_) BQ_ENTRIES(updatee_bypass);
 165                 } else {
 166                     /* For simplicity, just swap the BQ for the BH */
 167                     P_ temp = updatee_keep;
 168
 169                     updatee_keep = updatee_bypass;
 170                     updatee_bypass = temp;
 171
 172                     /* Record the swap in the kept frame (below) */
 173                     PUSH_UPDATEE(prev_frame, updatee_keep);
 174                 }
 175             }
 176 #endif
 177
 178             UPD_SQUEEZED();     /* ticky stuff (NB: nothing for spat-profiling) */
 179             UPD_IND(updatee_bypass, updatee_keep);
 180
 181             sp = frame - BREL(1);       /* Toss the current frame */
 182             displacement += STD_UF_SIZE;
 183
 184         } else {
 185 #if !defined(CONCURRENT)
 186             if ( RTSflags.GcFlags.lazyBlackHoling )
 187                 UPD_BH(GRAB_UPDATEE(frame), BH_UPD_info);
 188 #endif
 189
 190             /* No squeeze for this frame */
 191             sp = frame_bottom - BREL(1);        /* Keep the current frame */
 192
 193             /* Fix the SuB in the current frame (should point to the frame below) */
 194             PUSH_SuB(frame, prev_frame);
 195         }
 196
 197         /* Now slide all words from sp up to the next frame */
 198
 199         if (displacement > 0) {
 200             P_ next_frame_bottom = next_frame + BREL(STD_UF_SIZE);
 201
 202             /*
 203              fprintf(stderr, "sliding [%lx, %lx] by %d\n", sp, next_frame_bottom,
 204              displacement);
 205             */
 206
 207             while (sp <= next_frame_bottom) {
 208                 sp[BREL(displacement)] = *sp;
 209                 sp -= BREL(1);
 210             }
 211         }
 212         prev_frame = frame + BREL(displacement);
 213         frame = next_frame;
 214     }
 215
 216     /*
 217      * Now handle the topmost frame.  Patch SuB, black hole the
 218      * updatee, and slide down.
 219      */
 220
 221     PUSH_SuB(frame, prev_frame);
 222
 223 #if !defined(CONCURRENT)
 224     if ( RTSflags.GcFlags.lazyBlackHoling )
 225         UPD_BH(GRAB_UPDATEE(frame), BH_UPD_info);
 226 #endif
 227
 228     if (displacement > 0) {
 229         P_ sp = frame + BREL(STD_UF_SIZE) - BREL(1);
 230
 231         /*
 232          fprintf(stderr, "sliding [%lx, %lx] by %d\n", sp, top, displacement);
 233         */
 234
 235         while (sp <= top) {
 236             sp[BREL(displacement)] = *sp;
 237             sp -= BREL(1);
 238         }
 239     }
 240     return displacement;
 241 }
 242 \end{code}
 243
 244 %************************************************************************
 245 %*                                                                      *
 246 \subsection[stk-ouflow-par]{Rather exciting parallel stack overflow and underflow}
 247 %*                                                                      *
 248 %************************************************************************
 249
 250 \begin{code}
 251 #ifdef CONCURRENT
 252 \end{code}
 253
 254 StackOverflow: called inside a nice ``callwrapper'' when stack
 255 overflow occurs.  The state is already saved in the TSO, and the stack
 256 is in a tidy saved state.
 257
 258 \begin{code}
 259 EXTDATA_RO(StkO_info);          /* boring extern decl */
 260 EXTFUN(EnterNodeCode);          /* For reentering node after potential GC */
 261
 262 #ifdef PAR
 263 EXTDATA_RO(FetchMe_info);
 264 #endif
 265
 266 I_
 267 StackOverflow(args1, args2)
 268 W_ args1;
 269 W_ args2;
 270 {
 271     I_ i;
 272     P_ old_stko, new_stko;
 273     W_ headroom = STACK_OVERFLOW_HEADROOM(args1, args2);
 274     I_ cts_size;
 275
 276 #ifdef PAR
 277     W_ is_prim_return = STACK_OVERFLOW_PRIM_RETURN(args1, args2);
 278 #endif
 279     W_ reenter = STACK_OVERFLOW_REENTER(args1, args2);
 280     W_ words_of_a = STACK_OVERFLOW_AWORDS(args1, args2);
 281     W_ words_of_b = STACK_OVERFLOW_BWORDS(args1, args2);
 282     W_ liveness = STACK_OVERFLOW_LIVENESS(args1, args2);
 283     I_ really_reenter_node = 0;
 284
 285     SET_TASK_ACTIVITY(ST_OVERHEAD);
 286
 287
 288     /*?/
 289       fprintf(stderr,"StackOverflow:liveness=%lx,a=%lx,b=%lx\n",
 290       liveness,words_of_a,words_of_b);
 291     /?*/
 292
 293     old_stko = SAVE_StkO;
 294
 295     /*?/
 296       fprintf(stderr, "stko: %lx SpA %lx SuA %lx SpB %lx SuB %lx\n",
 297       old_stko, STKO_SpA(old_stko),
 298       STKO_SuA(old_stko), STKO_SpB(old_stko), STKO_SuB(old_stko));
 299     /?*/
 300
 301     if (RTSflags.GcFlags.squeezeUpdFrames) {
 302
 303         i = SqueezeUpdateFrames(STKO_BSTK_BOT(old_stko), STKO_SpB(old_stko),
 304                                 STKO_SuB(old_stko));
 305
 306         STKO_SuB(old_stko) += BREL(i);
 307         STKO_SpB(old_stko) += BREL(i);
 308
 309      /*?/ fprintf(stderr, "Just squeezed; now: SpB %lx SuB %lx retval %d\n", STKO_SpB(old_stko), STKO_SuB(old_stko), i); /?*/
 310
 311         if ((P_) STKO_SpA(old_stko) - AREL(headroom) > STKO_SpB(old_stko)) {
 312
 313             /*?/
 314               fprintf(stderr, "Squeezed; now: SpA %lx SpB %lx headroom %d\n", STKO_SpA(old_stko),
 315               STKO_SpB(old_stko), headroom);
 316             /?*/
 317
 318             /* We saved enough space to continue on the old StkO */
 319             return 0;
 320         }
 321     }
 322     SAVE_Liveness = liveness;
 323
 324     ASSERT(sanityChk_StkO(old_stko));
 325
 326     /* Double the stack chunk size each time we grow the stack */
 327     /*?/ fprintf(stderr, "Stko %lx: about to double stk-chk size from %d...\n", old_stko, STKO_CLOSURE_CTS_SIZE(old_stko)); /?*/
 328     cts_size = STKO_CLOSURE_CTS_SIZE(old_stko) * 2;
 329
 330     if (SAVE_Hp + STKO_HS + cts_size > SAVE_HpLim) {
 331         if (reenter) {
 332             /*
 333              * Even in the uniprocessor world, we may have to reenter node in case
 334              * node is a selector shorted out by GC.
 335              */
 336             ASSERT(liveness & LIVENESS_R1);
 337             TSO_PC2(CurrentTSO) = EnterNodeCode;
 338             really_reenter_node = 1;
 339         }
 340         /*?/ fprintf(stderr, "StkO %lx: stk-chk GC: size %d...\n", old_stko, STKO_HS + cts_size);/?*/
 341         ReallyPerformThreadGC(STKO_HS + cts_size, rtsFalse);
 342         /*
 343            now, GC semantics promise to have left SAVE_Hp with
 344            the requested space *behind* it; as we will bump
 345            SAVE_Hp just below, we had better first put it back.
 346            (PS: Finding this was a two-day bug-hunting trip...)
 347            Will & Phil 95/10
 348         */
 349         SAVE_Hp -= STKO_HS + cts_size;
 350
 351         old_stko = SAVE_StkO;
 352     }
 353     ALLOC_STK(STKO_HS, cts_size, 0);
 354     new_stko = SAVE_Hp + 1;
 355     SAVE_Hp += STKO_HS + cts_size;
 356     SET_STKO_HDR(new_stko, StkO_info, CCC);
 357
 358     /*?/ fprintf(stderr, "New StkO now %lx...\n", new_stko); /?*/
 359
 360     /* Initialize the StkO, as in NewThread */
 361     STKO_SIZE(new_stko) = cts_size + STKO_VHS;
 362     STKO_SpB(new_stko) = STKO_SuB(new_stko) = STKO_BSTK_BOT(new_stko) + BREL(1);
 363     STKO_SpA(new_stko) = STKO_SuA(new_stko) = STKO_ASTK_BOT(new_stko) + AREL(1);
 364     STKO_LINK(new_stko) = old_stko;
 365
 366     /*?/ fprintf(stderr, "New StkO SpA = %lx...\n", STKO_SpA(new_stko) ); /?*/
 367
 368     STKO_RETURN(new_stko) = SAVE_Ret;
 369
 370 #ifdef PAR
 371
 372     /*
 373      * When we fall off of the top stack segment, we will either be
 374      * returning an algebraic data type, in which case R2 holds a
 375      * valid info ptr, or we will be returning a primitive
 376      * (e.g. Int#), in which case R2 is garbage. If we need to perform
 377      * GC to pull in the lower stack segment (this should only happen
 378      * because of task migration), then we need to know the register
 379      * liveness for the algebraic returns.  We get the liveness out of
 380      * the info table.  Now, we could set up the primitive returns
 381      * with a bogus infoptr, which has a NO_LIVENESS field in the info
 382      * table, but that would involve a lot more overhead than the
 383      * current approach. At present, we set up RetReg to point to
 384      * *either* a polymorphic algebraic return point, or a primitive
 385      * return point.
 386      */
 387
 388     SAVE_Ret = is_prim_return ? (P_) PrimUnderflow : (P_) vtbl_Underflow;
 389 #else
 390     SAVE_Ret = (P_) vtbl_Underflow;
 391 #endif
 392
 393     STKO_SpA(old_stko) += AREL(words_of_a);
 394     STKO_SpB(old_stko) += BREL(words_of_b);
 395
 396 #ifdef TICKY_TICKY
 397     /* Record the stack depths in chunks below the new stack object */
 398
 399     STKO_ADEP(new_stko) = STKO_ADEP(old_stko) +
 400       AREL((I_) STKO_ASTK_BOT(old_stko) - (I_) STKO_SpA(old_stko));
 401     STKO_BDEP(new_stko) = STKO_BDEP(old_stko) +
 402       BREL((I_) STKO_BSTK_BOT(old_stko) - (I_) STKO_SpB(old_stko));
 403 #endif
 404
 405     if (STKO_SpB(old_stko) < STKO_BSTK_BOT(old_stko)) {
 406         /*
 407          * This _should_ only happen if PAP_entry fails a stack check
 408          * and there is no update frame on the current stack.  We can
 409          * deal with this by storing a function's argument
 410          * requirements in its info table, peering into the PAP (it
 411          * had better be in R1) for the function pointer and taking
 412          * only the necessary number of arguments, but this would be
 413          * hard, so we haven't done it.
 414          */
 415         fflush(stdout);
 416         fprintf(stderr, "StackOverflow too deep (SpB=%lx, Bstk bot=%lx).  Probably a PAP with no update frame.\n", STKO_SpB(old_stko), STKO_BSTK_BOT(old_stko));
 417         abort(); /* an 'abort' may be overkill WDP 95/04 */
 418     }
 419     /* Move A stack words from old StkO to new StkO */
 420     for (i = 1; i <= words_of_a; i++) {
 421         STKO_SpA(new_stko)[-AREL(i)] = STKO_SpA(old_stko)[-AREL(i)];
 422     }
 423     STKO_SpA(new_stko) -= AREL(words_of_a);
 424
 425     /* Move B stack words from old StkO to new StkO */
 426     for (i = 1; i <= words_of_b; i++) {
 427         STKO_SpB(new_stko)[-BREL(i)] = STKO_SpB(old_stko)[-BREL(i)];
 428     }
 429     STKO_SpB(new_stko) -= BREL(words_of_b);
 430
 431     /* Now, handle movement of a single update frame */
 432     /* ToDo: Make this more efficient.  (JSM) */
 433     if (STKO_SpB(old_stko) < STKO_SuB(old_stko)) {
 434         /* Yikes!  PAP_entry stole an update frame.  Fix the world! */
 435         P_ frame = STKO_SuB(new_stko) - BREL(STD_UF_SIZE);
 436
 437         /*
 438           fprintf(stderr, "Stolen update frame: (old %lx, new %lx) SuA %lx, SuB
 439           %lx, return %lx\n", old_stko, new_stko, GRAB_SuA(frame), GRAB_SuB(frame),
 440           GRAB_RET(frame));
 441          */
 442
 443         STKO_SuA(old_stko) = GRAB_SuA(frame);
 444         STKO_SuB(old_stko) = GRAB_SuB(frame);
 445
 446         SAVE_Ret = STKO_RETURN(new_stko);
 447         STKO_RETURN(new_stko) = GRAB_RET(frame);
 448
 449         PUSH_SuA(frame, STKO_SuA(new_stko));
 450         PUSH_SuB(frame, STKO_SuB(new_stko));
 451         PUSH_RET(frame, vtbl_Underflow);
 452
 453         STKO_SuB(new_stko) = frame;
 454     }
 455
 456     ASSERT(sanityChk_StkO(new_stko));
 457
 458     SAVE_StkO = new_stko;
 459
 460     return really_reenter_node;
 461 }
 462 \end{code}
 463
 464 Underflow things are all done in the threaded world.  The code is in
 465 main/StgThreads.lhc.
 466
 467 \begin{code}
 468 #endif /* parallel */
 469 \end{code}