ghc/rts/Schedule.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Schedule.c,v 1.9 1999/02/05 16:02:53 simonm Exp $
   3  *
   4  * (c) The GHC Team, 1998-1999
   5  *
   6  * Scheduler
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #include "Rts.h"
  11 #include "SchedAPI.h"
  12 #include "RtsUtils.h"
  13 #include "RtsFlags.h"
  14 #include "Storage.h"
  15 #include "StgRun.h"
  16 #include "StgStartup.h"
  17 #include "GC.h"
  18 #include "Hooks.h"
  19 #include "Schedule.h"
  20 #include "StgMiscClosures.h"
  21 #include "Storage.h"
  22 #include "Evaluator.h"
  23 #include "Printer.h"
  24 #include "Main.h"
  25 #include "Signals.h"
  26 #include "Profiling.h"
  27 #include "Sanity.h"
  28
  29 StgTSO *run_queue_hd, *run_queue_tl;
  30 StgTSO *blocked_queue_hd, *blocked_queue_tl;
  31 StgTSO *ccalling_threads;
  32
  33 #define MAX_SCHEDULE_NESTING 256
  34 nat next_main_thread;
  35 StgTSO *main_threads[MAX_SCHEDULE_NESTING];
  36
  37 static void GetRoots(void);
  38 static StgTSO *threadStackOverflow(StgTSO *tso);
  39
  40 /* flag set by signal handler to precipitate a context switch */
  41 nat context_switch;
  42 /* if this flag is set as well, give up execution */
  43 static nat interrupted;
  44
  45 /* Next thread ID to allocate */
  46 StgThreadID next_thread_id = 1;
  47
  48 /*
  49  * Pointers to the state of the current thread.
  50  * Rule of thumb: if CurrentTSO != NULL, then we're running a Haskell
  51  * thread.  If CurrentTSO == NULL, then we're at the scheduler level.
  52  */
  53 StgTSO      *CurrentTSO;
  54 StgRegTable  MainRegTable;
  55
  56 /*
  57  * The thread state for the main thread.
  58  */
  59 StgTSO   *MainTSO;
  60
  61 /* The smallest stack size that makes any sense is:
  62  *    RESERVED_STACK_WORDS    (so we can get back from the stack overflow)
  63  *  + sizeofW(StgStopFrame)   (the stg_stop_thread_info frame)
  64  *  + 1                       (the realworld token for an IO thread)
  65  *  + 1                       (the closure to enter)
  66  *
  67  * A thread with this stack will bomb immediately with a stack
  68  * overflow, which will increase its stack size.
  69  */
  70
  71 #define MIN_STACK_WORDS (RESERVED_STACK_WORDS + sizeofW(StgStopFrame) + 2)
  72
  73 /* -----------------------------------------------------------------------------
  74    Create a new thread.
  75
  76    The new thread starts with the given stack size.  Before the
  77    scheduler can run, however, this thread needs to have a closure
  78    (and possibly some arguments) pushed on its stack.  See
  79    pushClosure() in Schedule.h.
  80
  81    createGenThread() and createIOThread() (in Schedule.h) are
  82    convenient packaged versions of this function.
  83    -------------------------------------------------------------------------- */
  84
  85 StgTSO *
  86 createThread(nat stack_size)
  87 {
  88   StgTSO *tso;
  89
  90   /* catch ridiculously small stack sizes */
  91   if (stack_size < MIN_STACK_WORDS + TSO_STRUCT_SIZEW) {
  92     stack_size = MIN_STACK_WORDS + TSO_STRUCT_SIZEW;
  93   }
  94
  95   tso = (StgTSO *)allocate(stack_size);
  96   TICK_ALLOC_TSO(stack_size-sizeofW(StgTSO),0);
  97
  98   initThread(tso, stack_size - TSO_STRUCT_SIZEW);
  99   return tso;
 100 }
 101
 102 void
 103 initThread(StgTSO *tso, nat stack_size)
 104 {
 105   SET_INFO(tso,&TSO_info);
 106   tso->whatNext     = ThreadEnterGHC;
 107   tso->state        = tso_state_runnable;
 108   tso->id           = next_thread_id++;
 109
 110   tso->splim        = (P_)&(tso->stack) + RESERVED_STACK_WORDS;
 111   tso->stack_size   = stack_size;
 112   tso->max_stack_size = round_to_mblocks(RtsFlags.GcFlags.maxStkSize)
 113                               - TSO_STRUCT_SIZEW;
 114   tso->sp           = (P_)&(tso->stack) + stack_size;
 115
 116 #ifdef PROFILING
 117   tso->prof.CCCS = CCS_MAIN;
 118 #endif
 119
 120   /* put a stop frame on the stack */
 121   tso->sp -= sizeofW(StgStopFrame);
 122   SET_HDR((StgClosure*)tso->sp,(StgInfoTable *)&stg_stop_thread_info,CCS_MAIN);
 123   tso->su = (StgUpdateFrame*)tso->sp;
 124
 125   IF_DEBUG(scheduler,belch("Initialised thread %ld, stack size = %lx words\n",
 126                            tso->id, tso->stack_size));
 127
 128   /* Put the new thread on the head of the runnable queue.
 129    * The caller of createThread better push an appropriate closure
 130    * on this thread's stack before the scheduler is invoked.
 131    */
 132   tso->link = run_queue_hd;
 133   run_queue_hd = tso;
 134   if (run_queue_tl == END_TSO_QUEUE) {
 135     run_queue_tl = tso;
 136   }
 137
 138   IF_DEBUG(scheduler,printTSO(tso));
 139 }
 140
 141 /* -----------------------------------------------------------------------------
 142    Delete a thread - reverting all blackholes to (something
 143    equivalent to) their former state.
 144
 145    We create an AP_UPD for every UpdateFrame on the stack.
 146    Entering one of these AP_UPDs pushes everything from the corresponding
 147    update frame upwards onto the stack.  (Actually, it pushes everything
 148    up to the next update frame plus a pointer to the next AP_UPD
 149    object.  Entering the next AP_UPD object pushes more onto the
 150    stack until we reach the last AP_UPD object - at which point
 151    the stack should look exactly as it did when we killed the TSO
 152    and we can continue execution by entering the closure on top of
 153    the stack.
 154    -------------------------------------------------------------------------- */
 155
 156 void deleteThread(StgTSO *tso)
 157 {
 158     StgUpdateFrame* su = tso->su;
 159     StgPtr          sp = tso->sp;
 160
 161     /* Thread already dead? */
 162     if (tso->whatNext == ThreadComplete || tso->whatNext == ThreadKilled) {
 163       return;
 164     }
 165
 166     IF_DEBUG(scheduler, belch("Killing thread %ld.", tso->id));
 167
 168     tso->whatNext = ThreadKilled; /* changed to ThreadComplete in schedule() */
 169     tso->link = END_TSO_QUEUE; /* Just to be on the safe side... */
 170
 171     /* Threads that finish normally leave Su pointing to the word
 172      * beyond the top of the stack, and Sp pointing to the last word
 173      * on the stack, which is the return value of the thread.
 174      */
 175     if ((P_)tso->su >= tso->stack + tso->stack_size
 176         || get_itbl(tso->su)->type == STOP_FRAME) {
 177       return;
 178     }
 179
 180     IF_DEBUG(scheduler,
 181              fprintf(stderr, "Freezing TSO stack\n");
 182              printTSO(tso);
 183              );
 184
 185     /* The stack freezing code assumes there's a closure pointer on
 186      * the top of the stack.  This isn't always the case with compiled
 187      * code, so we have to push a dummy closure on the top which just
 188      * returns to the next return address on the stack.
 189      */
 190     if (LOOKS_LIKE_GHC_INFO(*sp)) {
 191       *(--sp) = (W_)&dummy_ret_closure;
 192     }
 193
 194     while (1) {
 195       int words = (stgCast(StgPtr,su) - stgCast(StgPtr,sp)) - 1;
 196       nat i;
 197       StgAP_UPD* ap = stgCast(StgAP_UPD*,allocate(AP_sizeW(words)));
 198       TICK_ALLOC_THK(words+1,0);
 199
 200       /* First build an AP_UPD consisting of the stack chunk above the
 201        * current update frame, with the top word on the stack as the
 202        * fun field.
 203        */
 204       ASSERT(words >= 0);
 205
 206       /*      if (words == 0) {  -- optimisation
 207         ap = stgCast(StgAP_UPD*,*stgCast(StgPtr*,sp)++);
 208       } else */ {
 209         ap->n_args = words;
 210         ap->fun    = stgCast(StgClosure*,*stgCast(StgPtr*,sp)++);
 211         for(i=0; i < (nat)words; ++i) {
 212           payloadWord(ap,i) = *sp++;
 213         }
 214       }
 215
 216       switch (get_itbl(su)->type) {
 217
 218       case UPDATE_FRAME:
 219         {
 220           SET_HDR(ap,&AP_UPD_info,su->header.prof.ccs /* ToDo */);
 221
 222           IF_DEBUG(scheduler,
 223                    fprintf(stderr,  "Updating ");
 224                    printPtr(stgCast(StgPtr,su->updatee));
 225                    fprintf(stderr,  " with ");
 226                    printObj(stgCast(StgClosure*,ap));
 227                    );
 228
 229           /* Replace the updatee with an indirection - happily
 230            * this will also wake up any threads currently
 231            * waiting on the result.
 232            */
 233           UPD_IND(su->updatee,ap);  /* revert the black hole */
 234           su = su->link;
 235           sp += sizeofW(StgUpdateFrame) -1;
 236           sp[0] = stgCast(StgWord,ap); /* push onto stack */
 237           break;
 238         }
 239
 240       case CATCH_FRAME:
 241         {
 242           StgCatchFrame *cf = (StgCatchFrame *)su;
 243           StgClosure* o;
 244
 245           /* We want a PAP, not an AP_UPD.  Fortunately, the
 246            * layout's the same.
 247            */
 248           SET_HDR(ap,&PAP_info,su->header.prof.ccs /* ToDo */);
 249
 250           /* now build o = FUN(catch,ap,handler) */
 251           o = stgCast(StgClosure*, allocate(sizeofW(StgClosure)+2));
 252           TICK_ALLOC_THK(2,0);
 253           SET_HDR(o,&catch_info,su->header.prof.ccs /* ToDo */);
 254           payloadCPtr(o,0) = stgCast(StgClosure*,ap);
 255           payloadCPtr(o,1) = cf->handler;
 256
 257           IF_DEBUG(scheduler,
 258                    fprintf(stderr,  "Built ");
 259                    printObj(stgCast(StgClosure*,o));
 260                    );
 261
 262           /* pop the old handler and put o on the stack */
 263           su = cf->link;
 264           sp += sizeofW(StgCatchFrame) - 1;
 265           sp[0] = (W_)o;
 266           break;
 267         }
 268
 269       case SEQ_FRAME:
 270         {
 271           StgSeqFrame *sf = (StgSeqFrame *)su;
 272           StgClosure* o;
 273
 274           SET_HDR(ap,&PAP_info,su->header.prof.ccs /* ToDo */);
 275
 276           /* now build o = FUN(seq,ap) */
 277           o = stgCast(StgClosure*, allocate(sizeofW(StgClosure)+1));
 278           TICK_ALLOC_THK(1,0);
 279           SET_HDR(o,&seq_info,su->header.prof.ccs /* ToDo */);
 280           payloadCPtr(o,0) = stgCast(StgClosure*,ap);
 281
 282           IF_DEBUG(scheduler,
 283                    fprintf(stderr,  "Built ");
 284                    printObj(stgCast(StgClosure*,o));
 285                    );
 286
 287           /* pop the old handler and put o on the stack */
 288           su = sf->link;
 289           sp += sizeofW(StgSeqFrame) - 1;
 290           sp[0] = (W_)o;
 291           break;
 292         }
 293
 294       case STOP_FRAME:
 295         return;
 296
 297       default:
 298         barf("freezeTSO");
 299       }
 300     }
 301 }
 302
 303 void initScheduler(void)
 304 {
 305   run_queue_hd      = END_TSO_QUEUE;
 306   run_queue_tl      = END_TSO_QUEUE;
 307   blocked_queue_hd  = END_TSO_QUEUE;
 308   blocked_queue_tl  = END_TSO_QUEUE;
 309   ccalling_threads  = END_TSO_QUEUE;
 310   next_main_thread  = 0;
 311
 312   context_switch = 0;
 313   interrupted    = 0;
 314
 315   enteredCAFs = END_CAF_LIST;
 316 }
 317
 318 /* -----------------------------------------------------------------------------
 319    Main scheduling loop.
 320
 321    We use round-robin scheduling, each thread returning to the
 322    scheduler loop when one of these conditions is detected:
 323
 324       * stack overflow
 325       * out of heap space
 326       * timer expires (thread yields)
 327       * thread blocks
 328       * thread ends
 329    -------------------------------------------------------------------------- */
 330
 331 SchedulerStatus schedule(StgTSO *main, StgClosure **ret_val)
 332 {
 333   StgTSO *t;
 334   StgThreadReturnCode ret;
 335   StgTSO **MainTSO;
 336   rtsBool in_ccall_gc;
 337
 338   /* Return value is NULL by default, it is only filled in if the
 339    * main thread completes successfully.
 340    */
 341   if (ret_val) { *ret_val = NULL; }
 342
 343   /* Save away a pointer to the main thread so that we can keep track
 344    * of it should a garbage collection happen.  We keep a stack of
 345    * main threads in order to support scheduler re-entry.  We can't
 346    * use the normal TSO linkage for this stack, because the main TSO
 347    * may need to be linked onto other queues.
 348    */
 349   main_threads[next_main_thread] = main;
 350   MainTSO = &main_threads[next_main_thread];
 351   next_main_thread++;
 352   IF_DEBUG(scheduler,
 353            fprintf(stderr, "Scheduler entered: nesting = %d\n",
 354                    next_main_thread););
 355
 356   /* Are we being re-entered?
 357    */
 358   if (CurrentTSO != NULL) {
 359     /* This happens when a _ccall_gc from Haskell ends up re-entering
 360      * the scheduler.
 361      *
 362      * Block the current thread (put it on the ccalling_queue) and
 363      * continue executing.  The calling thread better have stashed
 364      * away its state properly and left its stack with a proper stack
 365      * frame on the top.
 366      */
 367     threadPaused(CurrentTSO);
 368     CurrentTSO->link = ccalling_threads;
 369     ccalling_threads = CurrentTSO;
 370     in_ccall_gc = rtsTrue;
 371     IF_DEBUG(scheduler,
 372              fprintf(stderr, "Re-entry, thread %d did a _ccall_gc\n",
 373                      CurrentTSO->id););
 374   } else {
 375     in_ccall_gc = rtsFalse;
 376   }
 377
 378   /* Take a thread from the run queue.
 379    */
 380   t = run_queue_hd;
 381   if (t != END_TSO_QUEUE) {
 382     run_queue_hd = t->link;
 383     t->link = END_TSO_QUEUE;
 384     if (run_queue_hd == END_TSO_QUEUE) {
 385       run_queue_tl = END_TSO_QUEUE;
 386     }
 387   }
 388
 389   while (t != END_TSO_QUEUE) {
 390     CurrentTSO = t;
 391
 392     /* If we have more threads on the run queue, set up a context
 393      * switch at some point in the future.
 394      */
 395     if (run_queue_hd != END_TSO_QUEUE) {
 396       context_switch = 1;
 397     } else {
 398       context_switch = 0;
 399     }
 400     IF_DEBUG(scheduler, belch("Running thread %ld...\n", t->id));
 401
 402     /* Be friendly to the storage manager: we're about to *run* this
 403      * thread, so we better make sure the TSO is mutable.
 404      */
 405     if (t->mut_link == NULL) {
 406       recordMutable((StgMutClosure *)t);
 407     }
 408
 409     /* Run the current thread */
 410     switch (t->whatNext) {
 411     case ThreadKilled:
 412     case ThreadComplete:
 413       /* thread already killed.  Drop it and carry on. */
 414       goto next_thread;
 415     case ThreadEnterGHC:
 416       ret = StgRun((StgFunPtr) stg_enterStackTop);
 417       break;
 418     case ThreadRunGHC:
 419       ret = StgRun((StgFunPtr) stg_returnToStackTop);
 420       break;
 421     case ThreadEnterHugs:
 422 #ifdef INTERPRETER
 423       {
 424           IF_DEBUG(scheduler,belch("entering Hugs"));
 425           LoadThreadState();
 426           /* CHECK_SENSIBLE_REGS(); */
 427           {
 428               StgClosure* c = stgCast(StgClosure*,*Sp);
 429               Sp += 1;
 430               ret = enter(c);
 431           }
 432           SaveThreadState();
 433           break;
 434       }
 435 #else
 436       barf("Panic: entered a BCO but no bytecode interpreter in this build");
 437 #endif
 438     default:
 439       barf("schedule: invalid whatNext field");
 440     }
 441
 442     /* We may have garbage collected while running the thread
 443      * (eg. something nefarious like _ccall_GC_ performGC), and hence
 444      * CurrentTSO may have moved.  Update t to reflect this.
 445      */
 446     t = CurrentTSO;
 447     CurrentTSO = NULL;
 448
 449     /* Costs for the scheduler are assigned to CCS_SYSTEM */
 450 #ifdef PROFILING
 451     CCCS = CCS_SYSTEM;
 452 #endif
 453
 454     switch (ret) {
 455
 456     case HeapOverflow:
 457       IF_DEBUG(scheduler,belch("Thread %ld stopped: HeapOverflow\n", t->id));
 458       threadPaused(t);
 459       PUSH_ON_RUN_QUEUE(t);
 460       GarbageCollect(GetRoots);
 461       break;
 462
 463     case StackOverflow:
 464       IF_DEBUG(scheduler,belch("Thread %ld stopped, StackOverflow\n", t->id));
 465       {
 466         nat i;
 467         /* enlarge the stack */
 468         StgTSO *new_t = threadStackOverflow(t);
 469
 470         /* This TSO has moved, so update any pointers to it from the
 471          * main thread stack.  It better not be on any other queues...
 472          * (it shouldn't be)
 473          */
 474         for (i = 0; i < next_main_thread; i++) {
 475           if (main_threads[i] == t) {
 476             main_threads[i] = new_t;
 477           }
 478         }
 479         t = new_t;
 480       }
 481       PUSH_ON_RUN_QUEUE(t);
 482       break;
 483
 484     case ThreadYielding:
 485       IF_DEBUG(scheduler,
 486                if (t->whatNext == ThreadEnterHugs) {
 487                    /* ToDo: or maybe a timer expired when we were in Hugs?
 488                     * or maybe someone hit ctrl-C
 489                     */
 490                    belch("Thread %ld stopped to switch to Hugs\n", t->id);
 491                } else {
 492                    belch("Thread %ld stopped, timer expired\n", t->id);
 493                }
 494                );
 495       threadPaused(t);
 496       if (interrupted) {
 497           IF_DEBUG(scheduler,belch("Scheduler interrupted - returning"));
 498           deleteThread(t);
 499           while (run_queue_hd != END_TSO_QUEUE) {
 500               run_queue_hd = t->link;
 501               deleteThread(t);
 502           }
 503           run_queue_tl = END_TSO_QUEUE;
 504           /* ToDo: should I do the same with blocked queues? */
 505           return Interrupted;
 506       }
 507
 508       /* Put the thread back on the run queue, at the end.
 509        * t->link is already set to END_TSO_QUEUE.
 510        */
 511       ASSERT(t->link == END_TSO_QUEUE);
 512       if (run_queue_tl != END_TSO_QUEUE) {
 513         ASSERT(get_itbl(run_queue_tl)->type == TSO);
 514         if (run_queue_hd == run_queue_tl) {
 515           run_queue_hd->link = t;
 516           run_queue_tl = t;
 517         } else {
 518           run_queue_tl->link = t;
 519         }
 520       } else {
 521         run_queue_hd = run_queue_tl = t;
 522       }
 523       break;
 524
 525     case ThreadBlocked:
 526       IF_DEBUG(scheduler,belch("Thread %ld stopped, blocking\n", t->id));
 527       threadPaused(t);
 528       /* assume the thread has put itself on some blocked queue
 529        * somewhere.
 530        */
 531       break;
 532
 533     case ThreadFinished:
 534       IF_DEBUG(scheduler,belch("Thread %ld finished\n", t->id));
 535       deleteThread(t);
 536       t->whatNext = ThreadComplete;
 537       break;
 538
 539     default:
 540       barf("schedule: invalid thread return code");
 541     }
 542
 543     /* check for signals each time around the scheduler */
 544     if (signals_pending()) {
 545       start_signal_handlers();
 546     }
 547
 548     /* If our main thread has finished or been killed, return.
 549      * If we were re-entered as a result of a _ccall_gc, then
 550      * pop the blocked thread off the ccalling_threads stack back
 551      * into CurrentTSO.
 552      */
 553     if ((*MainTSO)->whatNext == ThreadComplete
 554         || (*MainTSO)->whatNext == ThreadKilled) {
 555       next_main_thread--;
 556       if (in_ccall_gc) {
 557         CurrentTSO = ccalling_threads;
 558         ccalling_threads = ccalling_threads->link;
 559         /* remember to stub the link field of CurrentTSO */
 560         CurrentTSO->link = END_TSO_QUEUE;
 561       }
 562       if ((*MainTSO)->whatNext == ThreadComplete) {
 563         /* we finished successfully, fill in the return value */
 564         if (ret_val) { *ret_val = (StgClosure *)(*MainTSO)->sp[0]; };
 565         return Success;
 566       } else {
 567         return Killed;
 568       }
 569     }
 570
 571   next_thread:
 572     t = run_queue_hd;
 573     if (t != END_TSO_QUEUE) {
 574       run_queue_hd = t->link;
 575       t->link = END_TSO_QUEUE;
 576       if (run_queue_hd == END_TSO_QUEUE) {
 577         run_queue_tl = END_TSO_QUEUE;
 578       }
 579     }
 580   }
 581
 582   if (blocked_queue_hd != END_TSO_QUEUE) {
 583     return AllBlocked;
 584   } else {
 585     return Deadlock;
 586   }
 587 }
 588
 589 /* -----------------------------------------------------------------------------
 590    Where are the roots that we know about?
 591
 592         - all the threads on the runnable queue
 593         - all the threads on the blocked queue
 594         - all the thread currently executing a _ccall_GC
 595         - all the "main threads"
 596
 597    -------------------------------------------------------------------------- */
 598
 599 static void GetRoots(void)
 600 {
 601   nat i;
 602
 603   run_queue_hd      = (StgTSO *)MarkRoot((StgClosure *)run_queue_hd);
 604   run_queue_tl      = (StgTSO *)MarkRoot((StgClosure *)run_queue_tl);
 605
 606   blocked_queue_hd  = (StgTSO *)MarkRoot((StgClosure *)blocked_queue_hd);
 607   blocked_queue_tl  = (StgTSO *)MarkRoot((StgClosure *)blocked_queue_tl);
 608
 609   ccalling_threads  = (StgTSO *)MarkRoot((StgClosure *)ccalling_threads);
 610
 611   for (i = 0; i < next_main_thread; i++) {
 612     main_threads[i] = (StgTSO *)MarkRoot((StgClosure *)main_threads[i]);
 613   }
 614 }
 615
 616 /* -----------------------------------------------------------------------------
 617    performGC
 618
 619    This is the interface to the garbage collector from Haskell land.
 620    We provide this so that external C code can allocate and garbage
 621    collect when called from Haskell via _ccall_GC.
 622
 623    It might be useful to provide an interface whereby the programmer
 624    can specify more roots (ToDo).
 625    -------------------------------------------------------------------------- */
 626
 627 void (*extra_roots)(void);
 628
 629 void
 630 performGC(void)
 631 {
 632   GarbageCollect(GetRoots);
 633 }
 634
 635 static void
 636 AllRoots(void)
 637 {
 638   GetRoots();                   /* the scheduler's roots */
 639   extra_roots();                /* the user's roots */
 640 }
 641
 642 void
 643 performGCWithRoots(void (*get_roots)(void))
 644 {
 645   extra_roots = get_roots;
 646
 647   GarbageCollect(AllRoots);
 648 }
 649
 650 /* -----------------------------------------------------------------------------
 651    Stack overflow
 652
 653    If the thread has reached its maximum stack size,
 654    then bomb out.  Otherwise relocate the TSO into a larger chunk of
 655    memory and adjust its stack size appropriately.
 656    -------------------------------------------------------------------------- */
 657
 658 static StgTSO *
 659 threadStackOverflow(StgTSO *tso)
 660 {
 661   nat new_stack_size, new_tso_size, diff, stack_words;
 662   StgPtr new_sp;
 663   StgTSO *dest;
 664
 665   if (tso->stack_size >= tso->max_stack_size) {
 666     /* ToDo: just kill this thread? */
 667 #ifdef DEBUG
 668     /* If we're debugging, just print out the top of the stack */
 669     printStackChunk(tso->sp, stg_min(tso->stack+tso->stack_size,
 670                                      tso->sp+64));
 671 #endif
 672     stackOverflow(tso->max_stack_size);
 673   }
 674
 675   /* Try to double the current stack size.  If that takes us over the
 676    * maximum stack size for this thread, then use the maximum instead.
 677    * Finally round up so the TSO ends up as a whole number of blocks.
 678    */
 679   new_stack_size = stg_min(tso->stack_size * 2, tso->max_stack_size);
 680   new_tso_size   = (nat)BLOCK_ROUND_UP(new_stack_size * sizeof(W_) +
 681                                        TSO_STRUCT_SIZE)/sizeof(W_);
 682   new_tso_size = round_to_mblocks(new_tso_size);  /* Be MBLOCK-friendly */
 683   new_stack_size = new_tso_size - TSO_STRUCT_SIZEW;
 684
 685   IF_DEBUG(scheduler, fprintf(stderr,"increasing stack size from %d words to %d.\n", tso->stack_size, new_stack_size));
 686
 687   dest = (StgTSO *)allocate(new_tso_size);
 688   TICK_ALLOC_TSO(new_tso_size-sizeofW(StgTSO),0);
 689
 690   /* copy the TSO block and the old stack into the new area */
 691   memcpy(dest,tso,TSO_STRUCT_SIZE);
 692   stack_words = tso->stack + tso->stack_size - tso->sp;
 693   new_sp = (P_)dest + new_tso_size - stack_words;
 694   memcpy(new_sp, tso->sp, stack_words * sizeof(W_));
 695
 696   /* relocate the stack pointers... */
 697   diff = (P_)new_sp - (P_)tso->sp; /* In *words* */
 698   dest->su    = (StgUpdateFrame *) ((P_)dest->su + diff);
 699   dest->sp    = new_sp;
 700   dest->splim = (P_)dest->splim + (nat)((P_)dest - (P_)tso);
 701   dest->stack_size = new_stack_size;
 702
 703   /* and relocate the update frame list */
 704   relocate_TSO(tso, dest);
 705
 706   /* Mark the old one as dead so we don't try to scavenge it during
 707    * garbage collection (the TSO will likely be on a mutables list in
 708    * some generation, but it'll get collected soon enough).
 709    */
 710   tso->whatNext = ThreadKilled;
 711   dest->mut_link = NULL;
 712
 713   IF_DEBUG(sanity,checkTSO(tso));
 714 #if 0
 715   IF_DEBUG(scheduler,printTSO(dest));
 716 #endif
 717   if (tso == MainTSO) { /* hack */
 718       MainTSO = dest;
 719   }
 720   return dest;
 721 }
 722
 723 /* -----------------------------------------------------------------------------
 724    Wake up a queue that was blocked on some resource (usually a
 725    computation in progress).
 726    -------------------------------------------------------------------------- */
 727
 728 void awaken_blocked_queue(StgTSO *q)
 729 {
 730   StgTSO *tso;
 731
 732   while (q != END_TSO_QUEUE) {
 733     ASSERT(get_itbl(q)->type == TSO);
 734     tso = q;
 735     q = tso->link;
 736     PUSH_ON_RUN_QUEUE(tso);
 737     IF_DEBUG(scheduler,belch("Waking up thread %ld", tso->id));
 738   }
 739 }
 740
 741 /* -----------------------------------------------------------------------------
 742    Interrupt execution
 743    - usually called inside a signal handler so it mustn't do anything fancy.
 744    -------------------------------------------------------------------------- */
 745
 746 void interruptStgRts(void)
 747 {
 748     interrupted    = 1;
 749     context_switch = 1;
 750 }
 751