-/* -----------------------------------------------------------------------------
- Stack overflow
-
- If the thread has reached its maximum stack size, then raise the
- StackOverflow exception in the offending thread. Otherwise
- relocate the TSO into a larger chunk of memory and adjust its stack
- size appropriately.
- -------------------------------------------------------------------------- */
-
-static StgTSO *
-threadStackOverflow(Capability *cap, StgTSO *tso)
-{
- nat new_stack_size, stack_words;
- lnat new_tso_size;
- StgPtr new_sp;
- StgTSO *dest;
-
- IF_DEBUG(sanity,checkTSO(tso));
-
- if (tso->stack_size >= tso->max_stack_size
- && !(tso->flags & TSO_BLOCKEX)) {
- // NB. never raise a StackOverflow exception if the thread is
- // inside Control.Exceptino.block. It is impractical to protect
- // against stack overflow exceptions, since virtually anything
- // can raise one (even 'catch'), so this is the only sensible
- // thing to do here. See bug #767.
- //
-
- if (tso->flags & TSO_SQUEEZED) {
- return tso;
- }
- // #3677: In a stack overflow situation, stack squeezing may
- // reduce the stack size, but we don't know whether it has been
- // reduced enough for the stack check to succeed if we try
- // again. Fortunately stack squeezing is idempotent, so all we
- // need to do is record whether *any* squeezing happened. If we
- // are at the stack's absolute -K limit, and stack squeezing
- // happened, then we try running the thread again. The
- // TSO_SQUEEZED flag is set by threadPaused() to tell us whether
- // squeezing happened or not.
-
- debugTrace(DEBUG_gc,
- "threadStackOverflow of TSO %ld (%p): stack too large (now %ld; max is %ld)",
- (long)tso->id, tso, (long)tso->stack_size, (long)tso->max_stack_size);
- IF_DEBUG(gc,
- /* If we're debugging, just print out the top of the stack */
- printStackChunk(tso->sp, stg_min(tso->stack+tso->stack_size,
- tso->sp+64)));
-
- // Send this thread the StackOverflow exception
- throwToSingleThreaded(cap, tso, (StgClosure *)stackOverflow_closure);
- return tso;
- }
-
-
- // We also want to avoid enlarging the stack if squeezing has
- // already released some of it. However, we don't want to get into
- // a pathalogical situation where a thread has a nearly full stack
- // (near its current limit, but not near the absolute -K limit),
- // keeps allocating a little bit, squeezing removes a little bit,
- // and then it runs again. So to avoid this, if we squeezed *and*
- // there is still less than BLOCK_SIZE_W words free, then we enlarge
- // the stack anyway.
- if ((tso->flags & TSO_SQUEEZED) &&
- ((W_)(tso->sp - tso->stack) >= BLOCK_SIZE_W)) {
- return tso;
- }
-
- /* Try to double the current stack size. If that takes us over the
- * maximum stack size for this thread, then use the maximum instead
- * (that is, unless we're already at or over the max size and we
- * can't raise the StackOverflow exception (see above), in which
- * case just double the size). Finally round up so the TSO ends up as
- * a whole number of blocks.
- */
- if (tso->stack_size >= tso->max_stack_size) {
- new_stack_size = tso->stack_size * 2;
- } else {
- new_stack_size = stg_min(tso->stack_size * 2, tso->max_stack_size);
- }
- new_tso_size = (lnat)BLOCK_ROUND_UP(new_stack_size * sizeof(W_) +
- TSO_STRUCT_SIZE)/sizeof(W_);
- new_tso_size = round_to_mblocks(new_tso_size); /* Be MBLOCK-friendly */
- new_stack_size = new_tso_size - TSO_STRUCT_SIZEW;
-
- debugTrace(DEBUG_sched,
- "increasing stack size from %ld words to %d.",
- (long)tso->stack_size, new_stack_size);
-
- dest = (StgTSO *)allocate(cap,new_tso_size);
- TICK_ALLOC_TSO(new_stack_size,0);
-
- /* copy the TSO block and the old stack into the new area */
- memcpy(dest,tso,TSO_STRUCT_SIZE);
- stack_words = tso->stack + tso->stack_size - tso->sp;
- new_sp = (P_)dest + new_tso_size - stack_words;
- memcpy(new_sp, tso->sp, stack_words * sizeof(W_));
-
- /* relocate the stack pointers... */
- dest->sp = new_sp;
- dest->stack_size = new_stack_size;
-
- /* Mark the old TSO as relocated. We have to check for relocated
- * TSOs in the garbage collector and any primops that deal with TSOs.
- *
- * It's important to set the sp value to just beyond the end
- * of the stack, so we don't attempt to scavenge any part of the
- * dead TSO's stack.
- */
- setTSOLink(cap,tso,dest);
- write_barrier(); // other threads seeing ThreadRelocated will look at _link
- tso->what_next = ThreadRelocated;
- tso->sp = (P_)&(tso->stack[tso->stack_size]);
- tso->why_blocked = NotBlocked;
-
- IF_DEBUG(sanity,checkTSO(dest));
-#if 0
- IF_DEBUG(scheduler,printTSO(dest));
-#endif
-
- return dest;
-}
-
-static StgTSO *
-threadStackUnderflow (Capability *cap, Task *task, StgTSO *tso)
-{
- bdescr *bd, *new_bd;
- lnat free_w, tso_size_w;
- StgTSO *new_tso;
-
- tso_size_w = tso_sizeW(tso);
-
- if (tso_size_w < MBLOCK_SIZE_W ||
- // TSO is less than 2 mblocks (since the first mblock is
- // shorter than MBLOCK_SIZE_W)
- (tso_size_w - BLOCKS_PER_MBLOCK*BLOCK_SIZE_W) % MBLOCK_SIZE_W != 0 ||
- // or TSO is not a whole number of megablocks (ensuring
- // precondition of splitLargeBlock() below)
- (tso_size_w <= round_up_to_mblocks(RtsFlags.GcFlags.initialStkSize)) ||
- // or TSO is smaller than the minimum stack size (rounded up)
- (nat)(tso->stack + tso->stack_size - tso->sp) > tso->stack_size / 4)
- // or stack is using more than 1/4 of the available space
- {
- // then do nothing
- return tso;
- }
-
- // this is the number of words we'll free
- free_w = round_to_mblocks(tso_size_w/2);
-
- bd = Bdescr((StgPtr)tso);
- new_bd = splitLargeBlock(bd, free_w / BLOCK_SIZE_W);
- bd->free = bd->start + TSO_STRUCT_SIZEW;
-
- new_tso = (StgTSO *)new_bd->start;
- memcpy(new_tso,tso,TSO_STRUCT_SIZE);
- new_tso->stack_size = new_bd->free - new_tso->stack;
-
- // The original TSO was dirty and probably on the mutable
- // list. The new TSO is not yet on the mutable list, so we better
- // put it there.
- new_tso->dirty = 0;
- new_tso->flags &= ~TSO_LINK_DIRTY;
- dirty_TSO(cap, new_tso);
-
- debugTrace(DEBUG_sched, "thread %ld: reducing TSO size from %lu words to %lu",
- (long)tso->id, tso_size_w, tso_sizeW(new_tso));
-
- tso->_link = new_tso; // no write barrier reqd: same generation
- write_barrier(); // other threads seeing ThreadRelocated will look at _link
- tso->what_next = ThreadRelocated;
-
- // The TSO attached to this Task may have moved, so update the
- // pointer to it.
- if (task->incall->tso == tso) {
- task->incall->tso = new_tso;
- }
-
- IF_DEBUG(sanity,checkTSO(new_tso));
-
- return new_tso;
-}
-