ghc/rts/Schedule.c

   1 /* ---------------------------------------------------------------------------
   2  * $Id: Schedule.c,v 1.46 2000/01/30 10:25:29 simonmar Exp $
   3  *
   4  * (c) The GHC Team, 1998-1999
   5  *
   6  * Scheduler
   7  *
   8  * The main scheduling code in GranSim is quite different from that in std
   9  * (concurrent) Haskell: while concurrent Haskell just iterates over the
  10  * threads in the runnable queue, GranSim is event driven, i.e. it iterates
  11  * over the events in the global event queue.  -- HWL
  12  * --------------------------------------------------------------------------*/
  13
  14 //@node Main scheduling code, , ,
  15 //@section Main scheduling code
  16
  17 /* Version with scheduler monitor support for SMPs.
  18
  19    This design provides a high-level API to create and schedule threads etc.
  20    as documented in the SMP design document.
  21
  22    It uses a monitor design controlled by a single mutex to exercise control
  23    over accesses to shared data structures, and builds on the Posix threads
  24    library.
  25
  26    The majority of state is shared.  In order to keep essential per-task state,
  27    there is a Capability structure, which contains all the information
  28    needed to run a thread: its STG registers, a pointer to its TSO, a
  29    nursery etc.  During STG execution, a pointer to the capability is
  30    kept in a register (BaseReg).
  31
  32    In a non-SMP build, there is one global capability, namely MainRegTable.
  33
  34    SDM & KH, 10/99
  35 */
  36
  37 //@menu
  38 //* Includes::
  39 //* Variables and Data structures::
  40 //* Prototypes::
  41 //* Main scheduling loop::
  42 //* Suspend and Resume::
  43 //* Run queue code::
  44 //* Garbage Collextion Routines::
  45 //* Blocking Queue Routines::
  46 //* Exception Handling Routines::
  47 //* Debugging Routines::
  48 //* Index::
  49 //@end menu
  50
  51 //@node Includes, Variables and Data structures, Main scheduling code, Main scheduling code
  52 //@subsection Includes
  53
  54 #include "Rts.h"
  55 #include "SchedAPI.h"
  56 #include "RtsUtils.h"
  57 #include "RtsFlags.h"
  58 #include "Storage.h"
  59 #include "StgRun.h"
  60 #include "StgStartup.h"
  61 #include "GC.h"
  62 #include "Hooks.h"
  63 #include "Schedule.h"
  64 #include "StgMiscClosures.h"
  65 #include "Storage.h"
  66 #include "Evaluator.h"
  67 #include "Exception.h"
  68 #include "Printer.h"
  69 #include "Main.h"
  70 #include "Signals.h"
  71 #include "Profiling.h"
  72 #include "Sanity.h"
  73 #include "Stats.h"
  74 #include "Sparks.h"
  75 #if defined(GRAN) || defined(PAR)
  76 # include "GranSimRts.h"
  77 # include "GranSim.h"
  78 # include "ParallelRts.h"
  79 # include "Parallel.h"
  80 # include "ParallelDebug.h"
  81 # include "FetchMe.h"
  82 # include "HLC.h"
  83 #endif
  84
  85 #include <stdarg.h>
  86
  87 //@node Variables and Data structures, Prototypes, Includes, Main scheduling code
  88 //@subsection Variables and Data structures
  89
  90 /* Main threads:
  91  *
  92  * These are the threads which clients have requested that we run.
  93  *
  94  * In an SMP build, we might have several concurrent clients all
  95  * waiting for results, and each one will wait on a condition variable
  96  * until the result is available.
  97  *
  98  * In non-SMP, clients are strictly nested: the first client calls
  99  * into the RTS, which might call out again to C with a _ccall_GC, and
 100  * eventually re-enter the RTS.
 101  *
 102  * Main threads information is kept in a linked list:
 103  */
 104 //@cindex StgMainThread
 105 typedef struct StgMainThread_ {
 106   StgTSO *         tso;
 107   SchedulerStatus  stat;
 108   StgClosure **    ret;
 109 #ifdef SMP
 110   pthread_cond_t wakeup;
 111 #endif
 112   struct StgMainThread_ *link;
 113 } StgMainThread;
 114
 115 /* Main thread queue.
 116  * Locks required: sched_mutex.
 117  */
 118 static StgMainThread *main_threads;
 119
 120 /* Thread queues.
 121  * Locks required: sched_mutex.
 122  */
 123
 124 #if defined(GRAN)
 125
 126 StgTSO* ActiveTSO = NULL; /* for assigning system costs; GranSim-Light only */
 127 /* rtsTime TimeOfNextEvent, EndOfTimeSlice;            now in GranSim.c */
 128
 129 /*
 130    In GranSim we have a runable and a blocked queue for each processor.
 131    In order to minimise code changes new arrays run_queue_hds/tls
 132    are created. run_queue_hd is then a short cut (macro) for
 133    run_queue_hds[CurrentProc] (see GranSim.h).
 134    -- HWL
 135 */
 136 StgTSO *run_queue_hds[MAX_PROC], *run_queue_tls[MAX_PROC];
 137 StgTSO *blocked_queue_hds[MAX_PROC], *blocked_queue_tls[MAX_PROC];
 138 StgTSO *ccalling_threadss[MAX_PROC];
 139
 140 #else /* !GRAN */
 141
 142 //@cindex run_queue_hd
 143 //@cindex run_queue_tl
 144 //@cindex blocked_queue_hd
 145 //@cindex blocked_queue_tl
 146 StgTSO *run_queue_hd, *run_queue_tl;
 147 StgTSO *blocked_queue_hd, *blocked_queue_tl;
 148
 149 /* Threads suspended in _ccall_GC.
 150  * Locks required: sched_mutex.
 151  */
 152 static StgTSO *suspended_ccalling_threads;
 153
 154 static void GetRoots(void);
 155 static StgTSO *threadStackOverflow(StgTSO *tso);
 156 #endif
 157
 158 /* KH: The following two flags are shared memory locations.  There is no need
 159        to lock them, since they are only unset at the end of a scheduler
 160        operation.
 161 */
 162
 163 /* flag set by signal handler to precipitate a context switch */
 164 //@cindex context_switch
 165 nat context_switch;
 166
 167 /* if this flag is set as well, give up execution */
 168 //@cindex interrupted
 169 rtsBool interrupted;
 170
 171 /* Next thread ID to allocate.
 172  * Locks required: sched_mutex
 173  */
 174 //@cindex next_thread_id
 175 StgThreadID next_thread_id = 1;
 176
 177 /*
 178  * Pointers to the state of the current thread.
 179  * Rule of thumb: if CurrentTSO != NULL, then we're running a Haskell
 180  * thread.  If CurrentTSO == NULL, then we're at the scheduler level.
 181  */
 182
 183 /* The smallest stack size that makes any sense is:
 184  *    RESERVED_STACK_WORDS    (so we can get back from the stack overflow)
 185  *  + sizeofW(StgStopFrame)   (the stg_stop_thread_info frame)
 186  *  + 1                       (the realworld token for an IO thread)
 187  *  + 1                       (the closure to enter)
 188  *
 189  * A thread with this stack will bomb immediately with a stack
 190  * overflow, which will increase its stack size.
 191  */
 192
 193 #define MIN_STACK_WORDS (RESERVED_STACK_WORDS + sizeofW(StgStopFrame) + 2)
 194
 195 /* Free capability list.
 196  * Locks required: sched_mutex.
 197  */
 198 #ifdef SMP
 199 //@cindex free_capabilities
 200 //@cindex n_free_capabilities
 201 Capability *free_capabilities; /* Available capabilities for running threads */
 202 nat n_free_capabilities;       /* total number of available capabilities */
 203 #else
 204 //@cindex MainRegTable
 205 Capability MainRegTable;       /* for non-SMP, we have one global capability */
 206 #endif
 207
 208 #if defined(GRAN)
 209 StgTSO      *CurrentTSOs[MAX_PROC];
 210 #else
 211 StgTSO      *CurrentTSO;
 212 #endif
 213
 214 rtsBool ready_to_gc;
 215
 216 /* All our current task ids, saved in case we need to kill them later.
 217  */
 218 #ifdef SMP
 219 //@cindex task_ids
 220 task_info *task_ids;
 221 #endif
 222
 223 void            addToBlockedQueue ( StgTSO *tso );
 224
 225 static void     schedule          ( void );
 226        void     interruptStgRts   ( void );
 227 static StgTSO * createThread_     ( nat size, rtsBool have_lock );
 228
 229 #ifdef DEBUG
 230 static void sched_belch(char *s, ...);
 231 #endif
 232
 233 #ifdef SMP
 234 //@cindex sched_mutex
 235 //@cindex term_mutex
 236 //@cindex thread_ready_cond
 237 //@cindex gc_pending_cond
 238 pthread_mutex_t sched_mutex       = PTHREAD_MUTEX_INITIALIZER;
 239 pthread_mutex_t term_mutex        = PTHREAD_MUTEX_INITIALIZER;
 240 pthread_cond_t  thread_ready_cond = PTHREAD_COND_INITIALIZER;
 241 pthread_cond_t  gc_pending_cond   = PTHREAD_COND_INITIALIZER;
 242
 243 nat await_death;
 244 #endif
 245
 246 #if defined(PAR)
 247 StgTSO *LastTSO;
 248 rtsTime TimeOfLastYield;
 249 #endif
 250
 251 /*
 252  * The thread state for the main thread.
 253 // ToDo: check whether not needed any more
 254 StgTSO   *MainTSO;
 255  */
 256
 257
 258 //@node Prototypes, Main scheduling loop, Variables and Data structures, Main scheduling code
 259 //@subsection Prototypes
 260
 261 //@node Main scheduling loop, Suspend and Resume, Prototypes, Main scheduling code
 262 //@subsection Main scheduling loop
 263
 264 /* ---------------------------------------------------------------------------
 265    Main scheduling loop.
 266
 267    We use round-robin scheduling, each thread returning to the
 268    scheduler loop when one of these conditions is detected:
 269
 270       * out of heap space
 271       * timer expires (thread yields)
 272       * thread blocks
 273       * thread ends
 274       * stack overflow
 275
 276    Locking notes:  we acquire the scheduler lock once at the beginning
 277    of the scheduler loop, and release it when
 278
 279       * running a thread, or
 280       * waiting for work, or
 281       * waiting for a GC to complete.
 282
 283    ------------------------------------------------------------------------ */
 284 //@cindex schedule
 285 static void
 286 schedule( void )
 287 {
 288   StgTSO *t;
 289   Capability *cap;
 290   StgThreadReturnCode ret;
 291 #if defined(GRAN)
 292   rtsEvent *event;
 293 #elif defined(PAR)
 294   rtsSpark spark;
 295   StgTSO *tso;
 296   GlobalTaskId pe;
 297 #endif
 298
 299   ACQUIRE_LOCK(&sched_mutex);
 300
 301 #if defined(GRAN)
 302 # error ToDo: implement GranSim scheduler
 303 #elif defined(PAR)
 304   while (!GlobalStopPending) {          /* GlobalStopPending set in par_exit */
 305
 306     if (PendingFetches != END_BF_QUEUE) {
 307         processFetches();
 308     }
 309 #else
 310   while (1) {
 311 #endif
 312
 313     /* If we're interrupted (the user pressed ^C, or some other
 314      * termination condition occurred), kill all the currently running
 315      * threads.
 316      */
 317     if (interrupted) {
 318       IF_DEBUG(scheduler, sched_belch("interrupted"));
 319       for (t = run_queue_hd; t != END_TSO_QUEUE; t = t->link) {
 320         deleteThread(t);
 321       }
 322       for (t = blocked_queue_hd; t != END_TSO_QUEUE; t = t->link) {
 323         deleteThread(t);
 324       }
 325       run_queue_hd = run_queue_tl = END_TSO_QUEUE;
 326       blocked_queue_hd = blocked_queue_tl = END_TSO_QUEUE;
 327     }
 328
 329     /* Go through the list of main threads and wake up any
 330      * clients whose computations have finished.  ToDo: this
 331      * should be done more efficiently without a linear scan
 332      * of the main threads list, somehow...
 333      */
 334 #ifdef SMP
 335     {
 336       StgMainThread *m, **prev;
 337       prev = &main_threads;
 338       for (m = main_threads; m != NULL; m = m->link) {
 339         switch (m->tso->whatNext) {
 340         case ThreadComplete:
 341           if (m->ret) {
 342             *(m->ret) = (StgClosure *)m->tso->sp[0];
 343           }
 344           *prev = m->link;
 345           m->stat = Success;
 346           pthread_cond_broadcast(&m->wakeup);
 347           break;
 348         case ThreadKilled:
 349           *prev = m->link;
 350           m->stat = Killed;
 351           pthread_cond_broadcast(&m->wakeup);
 352           break;
 353         default:
 354           break;
 355         }
 356       }
 357     }
 358 #else
 359     /* If our main thread has finished or been killed, return.
 360      */
 361     {
 362       StgMainThread *m = main_threads;
 363       if (m->tso->whatNext == ThreadComplete
 364           || m->tso->whatNext == ThreadKilled) {
 365         main_threads = main_threads->link;
 366         if (m->tso->whatNext == ThreadComplete) {
 367           /* we finished successfully, fill in the return value */
 368           if (m->ret) { *(m->ret) = (StgClosure *)m->tso->sp[0]; };
 369           m->stat = Success;
 370           return;
 371         } else {
 372           m->stat = Killed;
 373           return;
 374         }
 375       }
 376     }
 377 #endif
 378
 379     /* Top up the run queue from our spark pool.  We try to make the
 380      * number of threads in the run queue equal to the number of
 381      * free capabilities.
 382      */
 383 #if defined(SMP)
 384     {
 385       nat n = n_free_capabilities;
 386       StgTSO *tso = run_queue_hd;
 387
 388       /* Count the run queue */
 389       while (n > 0 && tso != END_TSO_QUEUE) {
 390         tso = tso->link;
 391         n--;
 392       }
 393
 394       for (; n > 0; n--) {
 395         StgClosure *spark;
 396         spark = findSpark();
 397         if (spark == NULL) {
 398           break; /* no more sparks in the pool */
 399         } else {
 400           /* I'd prefer this to be done in activateSpark -- HWL */
 401           /* tricky - it needs to hold the scheduler lock and
 402            * not try to re-acquire it -- SDM */
 403           StgTSO *tso;
 404           tso = createThread_(RtsFlags.GcFlags.initialStkSize, rtsTrue);
 405           pushClosure(tso,spark);
 406           PUSH_ON_RUN_QUEUE(tso);
 407 #ifdef PAR
 408           advisory_thread_count++;
 409 #endif
 410
 411           IF_DEBUG(scheduler,
 412                    sched_belch("turning spark of closure %p into a thread",
 413                                (StgClosure *)spark));
 414         }
 415       }
 416       /* We need to wake up the other tasks if we just created some
 417        * work for them.
 418        */
 419       if (n_free_capabilities - n > 1) {
 420           pthread_cond_signal(&thread_ready_cond);
 421       }
 422     }
 423 #endif /* SMP */
 424
 425     /* Check whether any waiting threads need to be woken up.  If the
 426      * run queue is empty, and there are no other tasks running, we
 427      * can wait indefinitely for something to happen.
 428      * ToDo: what if another client comes along & requests another
 429      * main thread?
 430      */
 431     if (blocked_queue_hd != END_TSO_QUEUE) {
 432       awaitEvent(
 433            (run_queue_hd == END_TSO_QUEUE)
 434 #ifdef SMP
 435         && (n_free_capabilities == RtsFlags.ParFlags.nNodes)
 436 #endif
 437         );
 438     }
 439
 440     /* check for signals each time around the scheduler */
 441 #ifndef __MINGW32__
 442     if (signals_pending()) {
 443       start_signal_handlers();
 444     }
 445 #endif
 446
 447     /* Detect deadlock: when we have no threads to run, there are
 448      * no threads waiting on I/O or sleeping, and all the other
 449      * tasks are waiting for work, we must have a deadlock.  Inform
 450      * all the main threads.
 451      */
 452 #ifdef SMP
 453     if (blocked_queue_hd == END_TSO_QUEUE
 454         && run_queue_hd == END_TSO_QUEUE
 455         && (n_free_capabilities == RtsFlags.ParFlags.nNodes)
 456         ) {
 457       StgMainThread *m;
 458       for (m = main_threads; m != NULL; m = m->link) {
 459           m->ret = NULL;
 460           m->stat = Deadlock;
 461           pthread_cond_broadcast(&m->wakeup);
 462       }
 463       main_threads = NULL;
 464     }
 465 #else /* ! SMP */
 466     if (blocked_queue_hd == END_TSO_QUEUE
 467         && run_queue_hd == END_TSO_QUEUE) {
 468       StgMainThread *m = main_threads;
 469       m->ret = NULL;
 470       m->stat = Deadlock;
 471       main_threads = m->link;
 472       return;
 473     }
 474 #endif
 475
 476 #ifdef SMP
 477     /* If there's a GC pending, don't do anything until it has
 478      * completed.
 479      */
 480     if (ready_to_gc) {
 481       IF_DEBUG(scheduler,sched_belch("waiting for GC"));
 482       pthread_cond_wait(&gc_pending_cond, &sched_mutex);
 483     }
 484
 485     /* block until we've got a thread on the run queue and a free
 486      * capability.
 487      */
 488     while (run_queue_hd == END_TSO_QUEUE || free_capabilities == NULL) {
 489       IF_DEBUG(scheduler, sched_belch("waiting for work"));
 490       pthread_cond_wait(&thread_ready_cond, &sched_mutex);
 491       IF_DEBUG(scheduler, sched_belch("work now available"));
 492     }
 493 #endif
 494
 495 #if defined(GRAN)
 496 # error ToDo: implement GranSim scheduler
 497 #elif defined(PAR)
 498     /* ToDo: phps merge with spark activation above */
 499     /* check whether we have local work and send requests if we have none */
 500     if (run_queue_hd == END_TSO_QUEUE) {  /* no runnable threads */
 501       /* :-[  no local threads => look out for local sparks */
 502       if (advisory_thread_count < RtsFlags.ParFlags.maxThreads &&
 503           (pending_sparks_hd[REQUIRED_POOL] < pending_sparks_tl[REQUIRED_POOL] ||
 504            pending_sparks_hd[ADVISORY_POOL] < pending_sparks_tl[ADVISORY_POOL])) {
 505         /*
 506          * ToDo: add GC code check that we really have enough heap afterwards!!
 507          * Old comment:
 508          * If we're here (no runnable threads) and we have pending
 509          * sparks, we must have a space problem.  Get enough space
 510          * to turn one of those pending sparks into a
 511          * thread...
 512          */
 513
 514         spark = findSpark();                /* get a spark */
 515         if (spark != (rtsSpark) NULL) {
 516           tso = activateSpark(spark);       /* turn the spark into a thread */
 517           IF_PAR_DEBUG(verbose,
 518                        belch("== [%x] schedule: Created TSO %p (%d); %d threads active",
 519                              mytid, tso, tso->id, advisory_thread_count));
 520
 521           if (tso==END_TSO_QUEUE) { /* failed to activate spark->back to loop */
 522             belch("^^ failed to activate spark");
 523             goto next_thread;
 524           }               /* otherwise fall through & pick-up new tso */
 525         } else {
 526           IF_PAR_DEBUG(verbose,
 527                        belch("^^ no local sparks (spark pool contains only NFs: %d)",
 528                              spark_queue_len(ADVISORY_POOL)));
 529           goto next_thread;
 530         }
 531       } else
 532       /* =8-[  no local sparks => look for work on other PEs */
 533       {
 534         /*
 535          * We really have absolutely no work.  Send out a fish
 536          * (there may be some out there already), and wait for
 537          * something to arrive.  We clearly can't run any threads
 538          * until a SCHEDULE or RESUME arrives, and so that's what
 539          * we're hoping to see.  (Of course, we still have to
 540          * respond to other types of messages.)
 541          */
 542         if (//!fishing &&
 543             outstandingFishes < RtsFlags.ParFlags.maxFishes ) { // &&
 544           // (last_fish_arrived_at+FISH_DELAY < CURRENT_TIME)) {
 545           /* fishing set in sendFish, processFish;
 546              avoid flooding system with fishes via delay */
 547           pe = choosePE();
 548           sendFish(pe, mytid, NEW_FISH_AGE, NEW_FISH_HISTORY,
 549                    NEW_FISH_HUNGER);
 550         }
 551
 552         processMessages();
 553         goto next_thread;
 554         // ReSchedule(0);
 555       }
 556     } else if (PacketsWaiting()) {  /* Look for incoming messages */
 557       processMessages();
 558     }
 559
 560     /* Now we are sure that we have some work available */
 561     ASSERT(run_queue_hd != END_TSO_QUEUE);
 562     /* Take a thread from the run queue, if we have work */
 563     t = take_off_run_queue(END_TSO_QUEUE);
 564
 565     /* ToDo: write something to the log-file
 566     if (RTSflags.ParFlags.granSimStats && !sameThread)
 567         DumpGranEvent(GR_SCHEDULE, RunnableThreadsHd);
 568     */
 569
 570     CurrentTSO = t;
 571
 572     IF_DEBUG(scheduler, belch("--^^ %d sparks on [%#x] (hd=%x; tl=%x; lim=%x)",
 573                               spark_queue_len(ADVISORY_POOL), CURRENT_PROC,
 574                               pending_sparks_hd[ADVISORY_POOL],
 575                               pending_sparks_tl[ADVISORY_POOL],
 576                               pending_sparks_lim[ADVISORY_POOL]));
 577
 578     IF_DEBUG(scheduler, belch("--== %d threads on [%#x] (hd=%x; tl=%x)",
 579                               run_queue_len(), CURRENT_PROC,
 580                               run_queue_hd, run_queue_tl));
 581
 582     if (t != LastTSO) {
 583       /*
 584          we are running a different TSO, so write a schedule event to log file
 585          NB: If we use fair scheduling we also have to write  a deschedule
 586              event for LastTSO; with unfair scheduling we know that the
 587              previous tso has blocked whenever we switch to another tso, so
 588              we don't need it in GUM for now
 589       */
 590       DumpRawGranEvent(CURRENT_PROC, CURRENT_PROC,
 591                        GR_SCHEDULE, t, (StgClosure *)NULL, 0, 0);
 592
 593     }
 594
 595 #else /* !GRAN && !PAR */
 596
 597     /* grab a thread from the run queue
 598      */
 599     t = POP_RUN_QUEUE();
 600     IF_DEBUG(sanity,checkTSO(t));
 601
 602 #endif
 603
 604     /* grab a capability
 605      */
 606 #ifdef SMP
 607     cap = free_capabilities;
 608     free_capabilities = cap->link;
 609     n_free_capabilities--;
 610 #else
 611     cap = &MainRegTable;
 612 #endif
 613
 614     cap->rCurrentTSO = t;
 615
 616     /* set the context_switch flag
 617      */
 618     if (run_queue_hd == END_TSO_QUEUE)
 619       context_switch = 0;
 620     else
 621       context_switch = 1;
 622
 623     RELEASE_LOCK(&sched_mutex);
 624
 625     IF_DEBUG(scheduler,sched_belch("running thread %d", t->id));
 626
 627     /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
 628     /* Run the current thread
 629      */
 630     switch (cap->rCurrentTSO->whatNext) {
 631     case ThreadKilled:
 632     case ThreadComplete:
 633       /* Thread already finished, return to scheduler. */
 634       ret = ThreadFinished;
 635       break;
 636     case ThreadEnterGHC:
 637       ret = StgRun((StgFunPtr) stg_enterStackTop, cap);
 638       break;
 639     case ThreadRunGHC:
 640       ret = StgRun((StgFunPtr) stg_returnToStackTop, cap);
 641       break;
 642     case ThreadEnterHugs:
 643 #ifdef INTERPRETER
 644       {
 645          StgClosure* c;
 646          IF_DEBUG(scheduler,sched_belch("entering Hugs"));
 647          c = (StgClosure *)(cap->rCurrentTSO->sp[0]);
 648          cap->rCurrentTSO->sp += 1;
 649          ret = enter(cap,c);
 650          break;
 651       }
 652 #else
 653       barf("Panic: entered a BCO but no bytecode interpreter in this build");
 654 #endif
 655     default:
 656       barf("schedule: invalid whatNext field");
 657     }
 658     /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
 659
 660     /* Costs for the scheduler are assigned to CCS_SYSTEM */
 661 #ifdef PROFILING
 662     CCCS = CCS_SYSTEM;
 663 #endif
 664
 665     ACQUIRE_LOCK(&sched_mutex);
 666
 667 #ifdef SMP
 668     IF_DEBUG(scheduler,fprintf(stderr,"scheduler (task %ld): ", pthread_self()););
 669 #else
 670     IF_DEBUG(scheduler,fprintf(stderr,"scheduler: "););
 671 #endif
 672     t = cap->rCurrentTSO;
 673
 674     switch (ret) {
 675     case HeapOverflow:
 676       /* make all the running tasks block on a condition variable,
 677        * maybe set context_switch and wait till they all pile in,
 678        * then have them wait on a GC condition variable.
 679        */
 680       IF_DEBUG(scheduler,belch("thread %ld stopped: HeapOverflow", t->id));
 681       threadPaused(t);
 682
 683       ready_to_gc = rtsTrue;
 684       context_switch = 1;               /* stop other threads ASAP */
 685       PUSH_ON_RUN_QUEUE(t);
 686       break;
 687
 688     case StackOverflow:
 689       /* just adjust the stack for this thread, then pop it back
 690        * on the run queue.
 691        */
 692       IF_DEBUG(scheduler,belch("thread %ld stopped, StackOverflow", t->id));
 693       threadPaused(t);
 694       {
 695         StgMainThread *m;
 696         /* enlarge the stack */
 697         StgTSO *new_t = threadStackOverflow(t);
 698
 699         /* This TSO has moved, so update any pointers to it from the
 700          * main thread stack.  It better not be on any other queues...
 701          * (it shouldn't be).
 702          */
 703         for (m = main_threads; m != NULL; m = m->link) {
 704           if (m->tso == t) {
 705             m->tso = new_t;
 706           }
 707         }
 708         threadPaused(new_t);
 709         ready_to_gc = rtsTrue;
 710         context_switch = 1;
 711         PUSH_ON_RUN_QUEUE(new_t);
 712       }
 713       break;
 714
 715     case ThreadYielding:
 716 #if defined(GRAN)
 717       IF_DEBUG(gran,
 718                DumpGranEvent(GR_DESCHEDULE, t));
 719       globalGranStats.tot_yields++;
 720 #elif defined(PAR)
 721       IF_DEBUG(par,
 722                DumpGranEvent(GR_DESCHEDULE, t));
 723 #endif
 724       /* put the thread back on the run queue.  Then, if we're ready to
 725        * GC, check whether this is the last task to stop.  If so, wake
 726        * up the GC thread.  getThread will block during a GC until the
 727        * GC is finished.
 728        */
 729       IF_DEBUG(scheduler,
 730                if (t->whatNext == ThreadEnterHugs) {
 731                  /* ToDo: or maybe a timer expired when we were in Hugs?
 732                   * or maybe someone hit ctrl-C
 733                   */
 734                  belch("thread %ld stopped to switch to Hugs", t->id);
 735                } else {
 736                  belch("thread %ld stopped, yielding", t->id);
 737                }
 738                );
 739       threadPaused(t);
 740       APPEND_TO_RUN_QUEUE(t);
 741       break;
 742
 743     case ThreadBlocked:
 744 #if defined(GRAN)
 745 # error ToDo: implement GranSim scheduler
 746 #elif defined(PAR)
 747       IF_DEBUG(par,
 748                DumpGranEvent(GR_DESCHEDULE, t));
 749 #else
 750 #endif
 751       /* don't need to do anything.  Either the thread is blocked on
 752        * I/O, in which case we'll have called addToBlockedQueue
 753        * previously, or it's blocked on an MVar or Blackhole, in which
 754        * case it'll be on the relevant queue already.
 755        */
 756       IF_DEBUG(scheduler,
 757                fprintf(stderr, "thread %d stopped, ", t->id);
 758                printThreadBlockage(t);
 759                fprintf(stderr, "\n"));
 760       threadPaused(t);
 761       break;
 762
 763     case ThreadFinished:
 764       /* Need to check whether this was a main thread, and if so, signal
 765        * the task that started it with the return value.  If we have no
 766        * more main threads, we probably need to stop all the tasks until
 767        * we get a new one.
 768        */
 769       IF_DEBUG(scheduler,belch("thread %ld finished", t->id));
 770       t->whatNext = ThreadComplete;
 771 #if defined(GRAN)
 772       // ToDo: endThread(t, CurrentProc); // clean-up the thread
 773 #elif defined(PAR)
 774       advisory_thread_count--;
 775       if (RtsFlags.ParFlags.ParStats.Full)
 776         DumpEndEvent(CURRENT_PROC, t, rtsFalse /* not mandatory */);
 777 #endif
 778       break;
 779
 780     default:
 781       barf("doneThread: invalid thread return code");
 782     }
 783
 784 #ifdef SMP
 785     cap->link = free_capabilities;
 786     free_capabilities = cap;
 787     n_free_capabilities++;
 788 #endif
 789
 790 #ifdef SMP
 791     if (ready_to_gc && n_free_capabilities == RtsFlags.ParFlags.nNodes)
 792 #else
 793     if (ready_to_gc)
 794 #endif
 795       {
 796       /* everybody back, start the GC.
 797        * Could do it in this thread, or signal a condition var
 798        * to do it in another thread.  Either way, we need to
 799        * broadcast on gc_pending_cond afterward.
 800        */
 801 #ifdef SMP
 802       IF_DEBUG(scheduler,sched_belch("doing GC"));
 803 #endif
 804       GarbageCollect(GetRoots);
 805       ready_to_gc = rtsFalse;
 806 #ifdef SMP
 807       pthread_cond_broadcast(&gc_pending_cond);
 808 #endif
 809     }
 810 #if defined(GRAN)
 811   next_thread:
 812     IF_GRAN_DEBUG(unused,
 813                   print_eventq(EventHd));
 814
 815     event = get_next_event();
 816
 817 #elif defined(PAR)
 818   next_thread:
 819     /* ToDo: wait for next message to arrive rather than busy wait */
 820
 821 #else /* GRAN */
 822   /* not any more
 823   next_thread:
 824     t = take_off_run_queue(END_TSO_QUEUE);
 825   */
 826 #endif /* GRAN */
 827   } /* end of while(1) */
 828 }
 829
 830 /* A hack for Hugs concurrency support.  Needs sanitisation (?) */
 831 void deleteAllThreads ( void )
 832 {
 833   StgTSO* t;
 834   IF_DEBUG(scheduler,sched_belch("deleteAllThreads()"));
 835   for (t = run_queue_hd; t != END_TSO_QUEUE; t = t->link) {
 836     deleteThread(t);
 837   }
 838   for (t = blocked_queue_hd; t != END_TSO_QUEUE; t = t->link) {
 839     deleteThread(t);
 840   }
 841   run_queue_hd = run_queue_tl = END_TSO_QUEUE;
 842   blocked_queue_hd = blocked_queue_tl = END_TSO_QUEUE;
 843 }
 844
 845 /* startThread and  insertThread are now in GranSim.c -- HWL */
 846
 847 //@node Suspend and Resume, Run queue code, Main scheduling loop, Main scheduling code
 848 //@subsection Suspend and Resume
 849
 850 /* ---------------------------------------------------------------------------
 851  * Suspending & resuming Haskell threads.
 852  *
 853  * When making a "safe" call to C (aka _ccall_GC), the task gives back
 854  * its capability before calling the C function.  This allows another
 855  * task to pick up the capability and carry on running Haskell
 856  * threads.  It also means that if the C call blocks, it won't lock
 857  * the whole system.
 858  *
 859  * The Haskell thread making the C call is put to sleep for the
 860  * duration of the call, on the susepended_ccalling_threads queue.  We
 861  * give out a token to the task, which it can use to resume the thread
 862  * on return from the C function.
 863  * ------------------------------------------------------------------------- */
 864
 865 StgInt
 866 suspendThread( Capability *cap )
 867 {
 868   nat tok;
 869
 870   ACQUIRE_LOCK(&sched_mutex);
 871
 872   IF_DEBUG(scheduler,
 873            sched_belch("thread %d did a _ccall_gc\n", cap->rCurrentTSO->id));
 874
 875   threadPaused(cap->rCurrentTSO);
 876   cap->rCurrentTSO->link = suspended_ccalling_threads;
 877   suspended_ccalling_threads = cap->rCurrentTSO;
 878
 879   /* Use the thread ID as the token; it should be unique */
 880   tok = cap->rCurrentTSO->id;
 881
 882 #ifdef SMP
 883   cap->link = free_capabilities;
 884   free_capabilities = cap;
 885   n_free_capabilities++;
 886 #endif
 887
 888   RELEASE_LOCK(&sched_mutex);
 889   return tok;
 890 }
 891
 892 Capability *
 893 resumeThread( StgInt tok )
 894 {
 895   StgTSO *tso, **prev;
 896   Capability *cap;
 897
 898   ACQUIRE_LOCK(&sched_mutex);
 899
 900   prev = &suspended_ccalling_threads;
 901   for (tso = suspended_ccalling_threads;
 902        tso != END_TSO_QUEUE;
 903        prev = &tso->link, tso = tso->link) {
 904     if (tso->id == (StgThreadID)tok) {
 905       *prev = tso->link;
 906       break;
 907     }
 908   }
 909   if (tso == END_TSO_QUEUE) {
 910     barf("resumeThread: thread not found");
 911   }
 912
 913 #ifdef SMP
 914   while (free_capabilities == NULL) {
 915     IF_DEBUG(scheduler, sched_belch("waiting to resume"));
 916     pthread_cond_wait(&thread_ready_cond, &sched_mutex);
 917     IF_DEBUG(scheduler, sched_belch("resuming thread %d", tso->id));
 918   }
 919   cap = free_capabilities;
 920   free_capabilities = cap->link;
 921   n_free_capabilities--;
 922 #else
 923   cap = &MainRegTable;
 924 #endif
 925
 926   cap->rCurrentTSO = tso;
 927
 928   RELEASE_LOCK(&sched_mutex);
 929   return cap;
 930 }
 931
 932
 933 /* ---------------------------------------------------------------------------
 934  * Static functions
 935  * ------------------------------------------------------------------------ */
 936 static void unblockThread(StgTSO *tso);
 937
 938 /* ---------------------------------------------------------------------------
 939  * Comparing Thread ids.
 940  *
 941  * This is used from STG land in the implementation of the
 942  * instances of Eq/Ord for ThreadIds.
 943  * ------------------------------------------------------------------------ */
 944
 945 int cmp_thread(const StgTSO *tso1, const StgTSO *tso2)
 946 {
 947   StgThreadID id1 = tso1->id;
 948   StgThreadID id2 = tso2->id;
 949
 950   if (id1 < id2) return (-1);
 951   if (id1 > id2) return 1;
 952   return 0;
 953 }
 954
 955 /* ---------------------------------------------------------------------------
 956    Create a new thread.
 957
 958    The new thread starts with the given stack size.  Before the
 959    scheduler can run, however, this thread needs to have a closure
 960    (and possibly some arguments) pushed on its stack.  See
 961    pushClosure() in Schedule.h.
 962
 963    createGenThread() and createIOThread() (in SchedAPI.h) are
 964    convenient packaged versions of this function.
 965    ------------------------------------------------------------------------ */
 966 //@cindex createThread
 967 #if defined(GRAN)
 968 /* currently pri (priority) is only used in a GRAN setup -- HWL */
 969 StgTSO *
 970 createThread(nat stack_size, StgInt pri)
 971 {
 972   return createThread_(stack_size, rtsFalse, pri);
 973 }
 974
 975 static StgTSO *
 976 createThread_(nat size, rtsBool have_lock, StgInt pri)
 977 {
 978 #else
 979 StgTSO *
 980 createThread(nat stack_size)
 981 {
 982   return createThread_(stack_size, rtsFalse);
 983 }
 984
 985 static StgTSO *
 986 createThread_(nat size, rtsBool have_lock)
 987 {
 988 #endif
 989     StgTSO *tso;
 990     nat stack_size;
 991
 992     /* First check whether we should create a thread at all */
 993 #if defined(PAR)
 994   /* check that no more than RtsFlags.ParFlags.maxThreads threads are created */
 995   if (advisory_thread_count >= RtsFlags.ParFlags.maxThreads) {
 996     threadsIgnored++;
 997     belch("{createThread}Daq ghuH: refusing to create another thread; no more than %d threads allowed (currently %d)",
 998           RtsFlags.ParFlags.maxThreads, advisory_thread_count);
 999     return END_TSO_QUEUE;
1000   }
1001   threadsCreated++;
1002 #endif
1003
1004 #if defined(GRAN)
1005   ASSERT(!RtsFlags.GranFlags.Light || CurrentProc==0);
1006 #endif
1007
1008   // ToDo: check whether size = stack_size - TSO_STRUCT_SIZEW
1009
1010   /* catch ridiculously small stack sizes */
1011   if (size < MIN_STACK_WORDS + TSO_STRUCT_SIZEW) {
1012     size = MIN_STACK_WORDS + TSO_STRUCT_SIZEW;
1013   }
1014
1015   tso = (StgTSO *)allocate(size);
1016   TICK_ALLOC_TSO(size-sizeofW(StgTSO),0);
1017
1018   stack_size = size - TSO_STRUCT_SIZEW;
1019
1020   // Hmm, this CCS_MAIN is not protected by a PROFILING cpp var;
1021   SET_HDR(tso, &TSO_info, CCS_MAIN);
1022 #if defined(GRAN)
1023   SET_GRAN_HDR(tso, ThisPE);
1024 #endif
1025   tso->whatNext     = ThreadEnterGHC;
1026
1027   /* tso->id needs to be unique.  For now we use a heavyweight mutex to
1028          protect the increment operation on next_thread_id.
1029          In future, we could use an atomic increment instead.
1030   */
1031
1032   if (!have_lock) { ACQUIRE_LOCK(&sched_mutex); }
1033   tso->id = next_thread_id++;
1034   if (!have_lock) { RELEASE_LOCK(&sched_mutex); }
1035
1036   tso->why_blocked  = NotBlocked;
1037   tso->blocked_exceptions = NULL;
1038
1039   tso->splim        = (P_)&(tso->stack) + RESERVED_STACK_WORDS;
1040   tso->stack_size   = stack_size;
1041   tso->max_stack_size = round_to_mblocks(RtsFlags.GcFlags.maxStkSize)
1042                               - TSO_STRUCT_SIZEW;
1043   tso->sp           = (P_)&(tso->stack) + stack_size;
1044
1045 #ifdef PROFILING
1046   tso->prof.CCCS = CCS_MAIN;
1047 #endif
1048
1049   /* put a stop frame on the stack */
1050   tso->sp -= sizeofW(StgStopFrame);
1051   SET_HDR((StgClosure*)tso->sp,(StgInfoTable *)&stg_stop_thread_info,CCS_MAIN);
1052   tso->su = (StgUpdateFrame*)tso->sp;
1053
1054   IF_DEBUG(scheduler,belch("---- Initialised TSO %ld (%p), stack size = %lx words",
1055                            tso->id, tso, tso->stack_size));
1056
1057   // ToDo: check this
1058 #if defined(GRAN)
1059   tso->link = END_TSO_QUEUE;
1060   /* uses more flexible routine in GranSim */
1061   insertThread(tso, CurrentProc);
1062 #else
1063   /* In a non-GranSim setup the pushing of a TSO onto the runq is separated
1064      from its creation
1065   */
1066 #endif
1067
1068 #if defined(GRAN)
1069   tso->gran.pri = pri;
1070   tso->gran.magic = TSO_MAGIC; // debugging only
1071   tso->gran.sparkname   = 0;
1072   tso->gran.startedat   = CURRENT_TIME;
1073   tso->gran.exported    = 0;
1074   tso->gran.basicblocks = 0;
1075   tso->gran.allocs      = 0;
1076   tso->gran.exectime    = 0;
1077   tso->gran.fetchtime   = 0;
1078   tso->gran.fetchcount  = 0;
1079   tso->gran.blocktime   = 0;
1080   tso->gran.blockcount  = 0;
1081   tso->gran.blockedat   = 0;
1082   tso->gran.globalsparks = 0;
1083   tso->gran.localsparks  = 0;
1084   if (RtsFlags.GranFlags.Light)
1085     tso->gran.clock  = Now; /* local clock */
1086   else
1087     tso->gran.clock  = 0;
1088
1089   IF_DEBUG(gran,printTSO(tso));
1090 #elif defined(PAR)
1091   tso->par.sparkname   = 0;
1092   tso->par.startedat   = CURRENT_TIME;
1093   tso->par.exported    = 0;
1094   tso->par.basicblocks = 0;
1095   tso->par.allocs      = 0;
1096   tso->par.exectime    = 0;
1097   tso->par.fetchtime   = 0;
1098   tso->par.fetchcount  = 0;
1099   tso->par.blocktime   = 0;
1100   tso->par.blockcount  = 0;
1101   tso->par.blockedat   = 0;
1102   tso->par.globalsparks = 0;
1103   tso->par.localsparks  = 0;
1104 #endif
1105
1106 #if defined(GRAN)
1107   globalGranStats.tot_threads_created++;
1108   globalGranStats.threads_created_on_PE[CurrentProc]++;
1109   globalGranStats.tot_sq_len += spark_queue_len(CurrentProc);
1110   globalGranStats.tot_sq_probes++;
1111 #endif
1112
1113   IF_DEBUG(scheduler,sched_belch("created thread %ld, stack size = %lx words",
1114                                  tso->id, tso->stack_size));
1115   return tso;
1116 }
1117
1118 /* ---------------------------------------------------------------------------
1119  * scheduleThread()
1120  *
1121  * scheduleThread puts a thread on the head of the runnable queue.
1122  * This will usually be done immediately after a thread is created.
1123  * The caller of scheduleThread must create the thread using e.g.
1124  * createThread and push an appropriate closure
1125  * on this thread's stack before the scheduler is invoked.
1126  * ------------------------------------------------------------------------ */
1127
1128 void
1129 scheduleThread(StgTSO *tso)
1130 {
1131   ACQUIRE_LOCK(&sched_mutex);
1132
1133   /* Put the new thread on the head of the runnable queue.  The caller
1134    * better push an appropriate closure on this thread's stack
1135    * beforehand.  In the SMP case, the thread may start running as
1136    * soon as we release the scheduler lock below.
1137    */
1138   PUSH_ON_RUN_QUEUE(tso);
1139   THREAD_RUNNABLE();
1140
1141   IF_DEBUG(scheduler,printTSO(tso));
1142   RELEASE_LOCK(&sched_mutex);
1143 }
1144
1145 /* ---------------------------------------------------------------------------
1146  * startTasks()
1147  *
1148  * Start up Posix threads to run each of the scheduler tasks.
1149  * I believe the task ids are not needed in the system as defined.
1150  *  KH @ 25/10/99
1151  * ------------------------------------------------------------------------ */
1152
1153 #ifdef SMP
1154 static void *
1155 taskStart( void *arg STG_UNUSED )
1156 {
1157   schedule();
1158   return NULL;
1159 }
1160 #endif
1161
1162 /* ---------------------------------------------------------------------------
1163  * initScheduler()
1164  *
1165  * Initialise the scheduler.  This resets all the queues - if the
1166  * queues contained any threads, they'll be garbage collected at the
1167  * next pass.
1168  *
1169  * This now calls startTasks(), so should only be called once!  KH @ 25/10/99
1170  * ------------------------------------------------------------------------ */
1171
1172 #ifdef SMP
1173 static void
1174 term_handler(int sig STG_UNUSED)
1175 {
1176   stat_workerStop();
1177   ACQUIRE_LOCK(&term_mutex);
1178   await_death--;
1179   RELEASE_LOCK(&term_mutex);
1180   pthread_exit(NULL);
1181 }
1182 #endif
1183
1184 //@cindex initScheduler
1185 void
1186 initScheduler(void)
1187 {
1188 #if defined(GRAN)
1189   nat i;
1190
1191   for (i=0; i<=MAX_PROC; i++) {
1192     run_queue_hds[i]      = END_TSO_QUEUE;
1193     run_queue_tls[i]      = END_TSO_QUEUE;
1194     blocked_queue_hds[i]  = END_TSO_QUEUE;
1195     blocked_queue_tls[i]  = END_TSO_QUEUE;
1196     ccalling_threadss[i]  = END_TSO_QUEUE;
1197   }
1198 #else
1199   run_queue_hd      = END_TSO_QUEUE;
1200   run_queue_tl      = END_TSO_QUEUE;
1201   blocked_queue_hd  = END_TSO_QUEUE;
1202   blocked_queue_tl  = END_TSO_QUEUE;
1203 #endif
1204
1205   suspended_ccalling_threads  = END_TSO_QUEUE;
1206
1207   main_threads = NULL;
1208
1209   context_switch = 0;
1210   interrupted    = 0;
1211
1212   enteredCAFs = END_CAF_LIST;
1213
1214   /* Install the SIGHUP handler */
1215 #ifdef SMP
1216   {
1217     struct sigaction action,oact;
1218
1219     action.sa_handler = term_handler;
1220     sigemptyset(&action.sa_mask);
1221     action.sa_flags = 0;
1222     if (sigaction(SIGTERM, &action, &oact) != 0) {
1223       barf("can't install TERM handler");
1224     }
1225   }
1226 #endif
1227
1228 #ifdef SMP
1229   /* Allocate N Capabilities */
1230   {
1231     nat i;
1232     Capability *cap, *prev;
1233     cap  = NULL;
1234     prev = NULL;
1235     for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
1236       cap = stgMallocBytes(sizeof(Capability), "initScheduler:capabilities");
1237       cap->link = prev;
1238       prev = cap;
1239     }
1240     free_capabilities = cap;
1241     n_free_capabilities = RtsFlags.ParFlags.nNodes;
1242   }
1243   IF_DEBUG(scheduler,fprintf(stderr,"scheduler: Allocated %d capabilities\n",
1244                              n_free_capabilities););
1245 #endif
1246
1247 #if defined(SMP) || defined(PAR)
1248   initSparkPools();
1249 #endif
1250 }
1251
1252 #ifdef SMP
1253 void
1254 startTasks( void )
1255 {
1256   nat i;
1257   int r;
1258   pthread_t tid;
1259
1260   /* make some space for saving all the thread ids */
1261   task_ids = stgMallocBytes(RtsFlags.ParFlags.nNodes * sizeof(task_info),
1262                             "initScheduler:task_ids");
1263
1264   /* and create all the threads */
1265   for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
1266     r = pthread_create(&tid,NULL,taskStart,NULL);
1267     if (r != 0) {
1268       barf("startTasks: Can't create new Posix thread");
1269     }
1270     task_ids[i].id = tid;
1271     task_ids[i].mut_time = 0.0;
1272     task_ids[i].mut_etime = 0.0;
1273     task_ids[i].gc_time = 0.0;
1274     task_ids[i].gc_etime = 0.0;
1275     task_ids[i].elapsedtimestart = elapsedtime();
1276     IF_DEBUG(scheduler,fprintf(stderr,"scheduler: Started task: %ld\n",tid););
1277   }
1278 }
1279 #endif
1280
1281 void
1282 exitScheduler( void )
1283 {
1284 #ifdef SMP
1285   nat i;
1286
1287   /* Don't want to use pthread_cancel, since we'd have to install
1288    * these silly exception handlers (pthread_cleanup_{push,pop}) around
1289    * all our locks.
1290    */
1291 #if 0
1292   /* Cancel all our tasks */
1293   for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
1294     pthread_cancel(task_ids[i].id);
1295   }
1296
1297   /* Wait for all the tasks to terminate */
1298   for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
1299     IF_DEBUG(scheduler,fprintf(stderr,"scheduler: waiting for task %ld\n",
1300                                task_ids[i].id));
1301     pthread_join(task_ids[i].id, NULL);
1302   }
1303 #endif
1304
1305   /* Send 'em all a SIGHUP.  That should shut 'em up.
1306    */
1307   await_death = RtsFlags.ParFlags.nNodes;
1308   for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
1309     pthread_kill(task_ids[i].id,SIGTERM);
1310   }
1311   while (await_death > 0) {
1312     sched_yield();
1313   }
1314 #endif
1315 }
1316
1317 /* -----------------------------------------------------------------------------
1318    Managing the per-task allocation areas.
1319
1320    Each capability comes with an allocation area.  These are
1321    fixed-length block lists into which allocation can be done.
1322
1323    ToDo: no support for two-space collection at the moment???
1324    -------------------------------------------------------------------------- */
1325
1326 /* -----------------------------------------------------------------------------
1327  * waitThread is the external interface for running a new computataion
1328  * and waiting for the result.
1329  *
1330  * In the non-SMP case, we create a new main thread, push it on the
1331  * main-thread stack, and invoke the scheduler to run it.  The
1332  * scheduler will return when the top main thread on the stack has
1333  * completed or died, and fill in the necessary fields of the
1334  * main_thread structure.
1335  *
1336  * In the SMP case, we create a main thread as before, but we then
1337  * create a new condition variable and sleep on it.  When our new
1338  * main thread has completed, we'll be woken up and the status/result
1339  * will be in the main_thread struct.
1340  * -------------------------------------------------------------------------- */
1341
1342 SchedulerStatus
1343 waitThread(StgTSO *tso, /*out*/StgClosure **ret)
1344 {
1345   StgMainThread *m;
1346   SchedulerStatus stat;
1347
1348   ACQUIRE_LOCK(&sched_mutex);
1349
1350   m = stgMallocBytes(sizeof(StgMainThread), "waitThread");
1351
1352   m->tso = tso;
1353   m->ret = ret;
1354   m->stat = NoStatus;
1355 #ifdef SMP
1356   pthread_cond_init(&m->wakeup, NULL);
1357 #endif
1358
1359   m->link = main_threads;
1360   main_threads = m;
1361
1362   IF_DEBUG(scheduler, fprintf(stderr, "scheduler: new main thread (%d)\n",
1363                               m->tso->id));
1364
1365 #ifdef SMP
1366   do {
1367     pthread_cond_wait(&m->wakeup, &sched_mutex);
1368   } while (m->stat == NoStatus);
1369 #else
1370   schedule();
1371   ASSERT(m->stat != NoStatus);
1372 #endif
1373
1374   stat = m->stat;
1375
1376 #ifdef SMP
1377   pthread_cond_destroy(&m->wakeup);
1378 #endif
1379
1380   IF_DEBUG(scheduler, fprintf(stderr, "scheduler: main thread (%d) finished\n",
1381                               m->tso->id));
1382   free(m);
1383
1384   RELEASE_LOCK(&sched_mutex);
1385
1386   return stat;
1387 }
1388
1389 //@node Run queue code, Garbage Collextion Routines, Suspend and Resume, Main scheduling code
1390 //@subsection Run queue code
1391
1392 #if 0
1393 /*
1394    NB: In GranSim we have many run queues; run_queue_hd is actually a macro
1395        unfolding to run_queue_hds[CurrentProc], thus CurrentProc is an
1396        implicit global variable that has to be correct when calling these
1397        fcts -- HWL
1398 */
1399
1400 /* Put the new thread on the head of the runnable queue.
1401  * The caller of createThread better push an appropriate closure
1402  * on this thread's stack before the scheduler is invoked.
1403  */
1404 static /* inline */ void
1405 add_to_run_queue(tso)
1406 StgTSO* tso;
1407 {
1408   ASSERT(tso!=run_queue_hd && tso!=run_queue_tl);
1409   tso->link = run_queue_hd;
1410   run_queue_hd = tso;
1411   if (run_queue_tl == END_TSO_QUEUE) {
1412     run_queue_tl = tso;
1413   }
1414 }
1415
1416 /* Put the new thread at the end of the runnable queue. */
1417 static /* inline */ void
1418 push_on_run_queue(tso)
1419 StgTSO* tso;
1420 {
1421   ASSERT(get_itbl((StgClosure *)tso)->type == TSO);
1422   ASSERT(run_queue_hd!=NULL && run_queue_tl!=NULL);
1423   ASSERT(tso!=run_queue_hd && tso!=run_queue_tl);
1424   if (run_queue_hd == END_TSO_QUEUE) {
1425     run_queue_hd = tso;
1426   } else {
1427     run_queue_tl->link = tso;
1428   }
1429   run_queue_tl = tso;
1430 }
1431
1432 /*
1433    Should be inlined because it's used very often in schedule.  The tso
1434    argument is actually only needed in GranSim, where we want to have the
1435    possibility to schedule *any* TSO on the run queue, irrespective of the
1436    actual ordering. Therefore, if tso is not the nil TSO then we traverse
1437    the run queue and dequeue the tso, adjusting the links in the queue.
1438 */
1439 //@cindex take_off_run_queue
1440 static /* inline */ StgTSO*
1441 take_off_run_queue(StgTSO *tso) {
1442   StgTSO *t, *prev;
1443
1444   /*
1445      qetlaHbogh Qu' ngaSbogh ghomDaQ {tso} yIteq!
1446
1447      if tso is specified, unlink that tso from the run_queue (doesn't have
1448      to be at the beginning of the queue); GranSim only
1449   */
1450   if (tso!=END_TSO_QUEUE) {
1451     /* find tso in queue */
1452     for (t=run_queue_hd, prev=END_TSO_QUEUE;
1453          t!=END_TSO_QUEUE && t!=tso;
1454          prev=t, t=t->link)
1455       /* nothing */ ;
1456     ASSERT(t==tso);
1457     /* now actually dequeue the tso */
1458     if (prev!=END_TSO_QUEUE) {
1459       ASSERT(run_queue_hd!=t);
1460       prev->link = t->link;
1461     } else {
1462       /* t is at beginning of thread queue */
1463       ASSERT(run_queue_hd==t);
1464       run_queue_hd = t->link;
1465     }
1466     /* t is at end of thread queue */
1467     if (t->link==END_TSO_QUEUE) {
1468       ASSERT(t==run_queue_tl);
1469       run_queue_tl = prev;
1470     } else {
1471       ASSERT(run_queue_tl!=t);
1472     }
1473     t->link = END_TSO_QUEUE;
1474   } else {
1475     /* take tso from the beginning of the queue; std concurrent code */
1476     t = run_queue_hd;
1477     if (t != END_TSO_QUEUE) {
1478       run_queue_hd = t->link;
1479       t->link = END_TSO_QUEUE;
1480       if (run_queue_hd == END_TSO_QUEUE) {
1481         run_queue_tl = END_TSO_QUEUE;
1482       }
1483     }
1484   }
1485   return t;
1486 }
1487
1488 #endif /* 0 */
1489
1490 //@node Garbage Collextion Routines, Blocking Queue Routines, Run queue code, Main scheduling code
1491 //@subsection Garbage Collextion Routines
1492
1493 /* ---------------------------------------------------------------------------
1494    Where are the roots that we know about?
1495
1496         - all the threads on the runnable queue
1497         - all the threads on the blocked queue
1498         - all the thread currently executing a _ccall_GC
1499         - all the "main threads"
1500
1501    ------------------------------------------------------------------------ */
1502
1503 /* This has to be protected either by the scheduler monitor, or by the
1504         garbage collection monitor (probably the latter).
1505         KH @ 25/10/99
1506 */
1507
1508 static void GetRoots(void)
1509 {
1510   StgMainThread *m;
1511
1512 #if defined(GRAN)
1513   {
1514     nat i;
1515     for (i=0; i<=RtsFlags.GranFlags.proc; i++) {
1516       if ((run_queue_hds[i] != END_TSO_QUEUE) && ((run_queue_hds[i] != NULL)))
1517         run_queue_hds[i]    = (StgTSO *)MarkRoot((StgClosure *)run_queue_hds[i]);
1518       if ((run_queue_tls[i] != END_TSO_QUEUE) && ((run_queue_tls[i] != NULL)))
1519         run_queue_tls[i]    = (StgTSO *)MarkRoot((StgClosure *)run_queue_tls[i]);
1520
1521       if ((blocked_queue_hds[i] != END_TSO_QUEUE) && ((blocked_queue_hds[i] != NULL)))
1522         blocked_queue_hds[i] = (StgTSO *)MarkRoot((StgClosure *)blocked_queue_hds[i]);
1523       if ((blocked_queue_tls[i] != END_TSO_QUEUE) && ((blocked_queue_tls[i] != NULL)))
1524         blocked_queue_tls[i] = (StgTSO *)MarkRoot((StgClosure *)blocked_queue_tls[i]);
1525       if ((ccalling_threadss[i] != END_TSO_QUEUE) && ((ccalling_threadss[i] != NULL)))
1526         ccalling_threadss[i] = (StgTSO *)MarkRoot((StgClosure *)ccalling_threadss[i]);
1527     }
1528   }
1529
1530   markEventQueue();
1531
1532 #else /* !GRAN */
1533   run_queue_hd      = (StgTSO *)MarkRoot((StgClosure *)run_queue_hd);
1534   run_queue_tl      = (StgTSO *)MarkRoot((StgClosure *)run_queue_tl);
1535
1536   blocked_queue_hd  = (StgTSO *)MarkRoot((StgClosure *)blocked_queue_hd);
1537   blocked_queue_tl  = (StgTSO *)MarkRoot((StgClosure *)blocked_queue_tl);
1538 #endif
1539
1540   for (m = main_threads; m != NULL; m = m->link) {
1541     m->tso = (StgTSO *)MarkRoot((StgClosure *)m->tso);
1542   }
1543   suspended_ccalling_threads =
1544     (StgTSO *)MarkRoot((StgClosure *)suspended_ccalling_threads);
1545
1546 #if defined(SMP) || defined(PAR) || defined(GRAN)
1547   markSparkQueue();
1548 #endif
1549 }
1550
1551 /* -----------------------------------------------------------------------------
1552    performGC
1553
1554    This is the interface to the garbage collector from Haskell land.
1555    We provide this so that external C code can allocate and garbage
1556    collect when called from Haskell via _ccall_GC.
1557
1558    It might be useful to provide an interface whereby the programmer
1559    can specify more roots (ToDo).
1560
1561    This needs to be protected by the GC condition variable above.  KH.
1562    -------------------------------------------------------------------------- */
1563
1564 void (*extra_roots)(void);
1565
1566 void
1567 performGC(void)
1568 {
1569   GarbageCollect(GetRoots);
1570 }
1571
1572 static void
1573 AllRoots(void)
1574 {
1575   GetRoots();                   /* the scheduler's roots */
1576   extra_roots();                /* the user's roots */
1577 }
1578
1579 void
1580 performGCWithRoots(void (*get_roots)(void))
1581 {
1582   extra_roots = get_roots;
1583
1584   GarbageCollect(AllRoots);
1585 }
1586
1587 /* -----------------------------------------------------------------------------
1588    Stack overflow
1589
1590    If the thread has reached its maximum stack size, then raise the
1591    StackOverflow exception in the offending thread.  Otherwise
1592    relocate the TSO into a larger chunk of memory and adjust its stack
1593    size appropriately.
1594    -------------------------------------------------------------------------- */
1595
1596 static StgTSO *
1597 threadStackOverflow(StgTSO *tso)
1598 {
1599   nat new_stack_size, new_tso_size, diff, stack_words;
1600   StgPtr new_sp;
1601   StgTSO *dest;
1602
1603   IF_DEBUG(sanity,checkTSO(tso));
1604   if (tso->stack_size >= tso->max_stack_size) {
1605 #if 0
1606     /* If we're debugging, just print out the top of the stack */
1607     printStackChunk(tso->sp, stg_min(tso->stack+tso->stack_size,
1608                                      tso->sp+64));
1609 #endif
1610 #ifdef INTERPRETER
1611     fprintf(stderr, "fatal: stack overflow in Hugs; aborting\n" );
1612     exit(1);
1613 #else
1614     /* Send this thread the StackOverflow exception */
1615     raiseAsync(tso, (StgClosure *)&stackOverflow_closure);
1616 #endif
1617     return tso;
1618   }
1619
1620   /* Try to double the current stack size.  If that takes us over the
1621    * maximum stack size for this thread, then use the maximum instead.
1622    * Finally round up so the TSO ends up as a whole number of blocks.
1623    */
1624   new_stack_size = stg_min(tso->stack_size * 2, tso->max_stack_size);
1625   new_tso_size   = (nat)BLOCK_ROUND_UP(new_stack_size * sizeof(W_) +
1626                                        TSO_STRUCT_SIZE)/sizeof(W_);
1627   new_tso_size = round_to_mblocks(new_tso_size);  /* Be MBLOCK-friendly */
1628   new_stack_size = new_tso_size - TSO_STRUCT_SIZEW;
1629
1630   IF_DEBUG(scheduler, fprintf(stderr,"scheduler: increasing stack size from %d words to %d.\n", tso->stack_size, new_stack_size));
1631
1632   dest = (StgTSO *)allocate(new_tso_size);
1633   TICK_ALLOC_TSO(new_tso_size-sizeofW(StgTSO),0);
1634
1635   /* copy the TSO block and the old stack into the new area */
1636   memcpy(dest,tso,TSO_STRUCT_SIZE);
1637   stack_words = tso->stack + tso->stack_size - tso->sp;
1638   new_sp = (P_)dest + new_tso_size - stack_words;
1639   memcpy(new_sp, tso->sp, stack_words * sizeof(W_));
1640
1641   /* relocate the stack pointers... */
1642   diff = (P_)new_sp - (P_)tso->sp; /* In *words* */
1643   dest->su    = (StgUpdateFrame *) ((P_)dest->su + diff);
1644   dest->sp    = new_sp;
1645   dest->splim = (P_)dest->splim + (nat)((P_)dest - (P_)tso);
1646   dest->stack_size = new_stack_size;
1647
1648   /* and relocate the update frame list */
1649   relocate_TSO(tso, dest);
1650
1651   /* Mark the old TSO as relocated.  We have to check for relocated
1652    * TSOs in the garbage collector and any primops that deal with TSOs.
1653    *
1654    * It's important to set the sp and su values to just beyond the end
1655    * of the stack, so we don't attempt to scavenge any part of the
1656    * dead TSO's stack.
1657    */
1658   tso->whatNext = ThreadRelocated;
1659   tso->link = dest;
1660   tso->sp = (P_)&(tso->stack[tso->stack_size]);
1661   tso->su = (StgUpdateFrame *)tso->sp;
1662   tso->why_blocked = NotBlocked;
1663   dest->mut_link = NULL;
1664
1665   IF_DEBUG(sanity,checkTSO(tso));
1666 #if 0
1667   IF_DEBUG(scheduler,printTSO(dest));
1668 #endif
1669
1670   return dest;
1671 }
1672
1673 //@node Blocking Queue Routines, Exception Handling Routines, Garbage Collextion Routines, Main scheduling code
1674 //@subsection Blocking Queue Routines
1675
1676 /* ---------------------------------------------------------------------------
1677    Wake up a queue that was blocked on some resource.
1678    ------------------------------------------------------------------------ */
1679
1680 /* ToDo: check push_on_run_queue vs. PUSH_ON_RUN_QUEUE */
1681
1682 #if defined(GRAN)
1683 static inline void
1684 unblockCount ( StgBlockingQueueElement *bqe, StgClosure *node )
1685 {
1686 }
1687 #elif defined(PAR)
1688 static inline void
1689 unblockCount ( StgBlockingQueueElement *bqe, StgClosure *node )
1690 {
1691   /* write RESUME events to log file and
1692      update blocked and fetch time (depending on type of the orig closure) */
1693   if (RtsFlags.ParFlags.ParStats.Full) {
1694     DumpRawGranEvent(CURRENT_PROC, CURRENT_PROC,
1695                      GR_RESUMEQ, ((StgTSO *)bqe), ((StgTSO *)bqe)->block_info.closure,
1696                      0, 0 /* spark_queue_len(ADVISORY_POOL) */);
1697
1698     switch (get_itbl(node)->type) {
1699         case FETCH_ME_BQ:
1700           ((StgTSO *)bqe)->par.fetchtime += CURRENT_TIME-((StgTSO *)bqe)->par.blockedat;
1701           break;
1702         case RBH:
1703         case FETCH_ME:
1704         case BLACKHOLE_BQ:
1705           ((StgTSO *)bqe)->par.blocktime += CURRENT_TIME-((StgTSO *)bqe)->par.blockedat;
1706           break;
1707         default:
1708           barf("{unblockOneLocked}Daq Qagh: unexpected closure in blocking queue");
1709         }
1710       }
1711 }
1712 #endif
1713
1714 #if defined(GRAN)
1715 static StgBlockingQueueElement *
1716 unblockOneLocked(StgBlockingQueueElement *bqe, StgClosure *node)
1717 {
1718     StgBlockingQueueElement *next;
1719     PEs node_loc, tso_loc;
1720
1721     node_loc = where_is(node); // should be lifted out of loop
1722     tso = (StgTSO *)bqe;  // wastes an assignment to get the type right
1723     tso_loc = where_is(tso);
1724     if (IS_LOCAL_TO(PROCS(node),tso_loc)) { // TSO is local
1725       /* !fake_fetch => TSO is on CurrentProc is same as IS_LOCAL_TO */
1726       ASSERT(CurrentProc!=node_loc || tso_loc==CurrentProc);
1727       bq_processing_time += RtsFlags.GranFlags.Costs.lunblocktime;
1728       // insertThread(tso, node_loc);
1729       new_event(tso_loc, tso_loc,
1730                 CurrentTime[CurrentProc]+bq_processing_time,
1731                 ResumeThread,
1732                 tso, node, (rtsSpark*)NULL);
1733       tso->link = END_TSO_QUEUE; // overwrite link just to be sure
1734       // len_local++;
1735       // len++;
1736     } else { // TSO is remote (actually should be FMBQ)
1737       bq_processing_time += RtsFlags.GranFlags.Costs.mpacktime;
1738       bq_processing_time += RtsFlags.GranFlags.Costs.gunblocktime;
1739       new_event(tso_loc, CurrentProc,
1740                 CurrentTime[CurrentProc]+bq_processing_time+
1741                 RtsFlags.GranFlags.Costs.latency,
1742                 UnblockThread,
1743                 tso, node, (rtsSpark*)NULL);
1744       tso->link = END_TSO_QUEUE; // overwrite link just to be sure
1745       bq_processing_time += RtsFlags.GranFlags.Costs.mtidytime;
1746       // len++;
1747     }
1748     /* the thread-queue-overhead is accounted for in either Resume or UnblockThread */
1749     IF_GRAN_DEBUG(bq,
1750                   fprintf(stderr," %s TSO %d (%p) [PE %d] (blocked_on=%p) (next=%p) ,",
1751                           (node_loc==tso_loc ? "Local" : "Global"),
1752                           tso->id, tso, CurrentProc, tso->blocked_on, tso->link))
1753     tso->blocked_on = NULL;
1754     IF_DEBUG(scheduler,belch("-- Waking up thread %ld (%p)",
1755                              tso->id, tso));
1756   }
1757
1758   /* if this is the BQ of an RBH, we have to put back the info ripped out of
1759      the closure to make room for the anchor of the BQ */
1760   if (next!=END_BQ_QUEUE) {
1761     ASSERT(get_itbl(node)->type == RBH && get_itbl(next)->type == CONSTR);
1762     /*
1763     ASSERT((info_ptr==&RBH_Save_0_info) ||
1764            (info_ptr==&RBH_Save_1_info) ||
1765            (info_ptr==&RBH_Save_2_info));
1766     */
1767     /* cf. convertToRBH in RBH.c for writing the RBHSave closure */
1768     ((StgRBH *)node)->blocking_queue = ((StgRBHSave *)next)->payload[0];
1769     ((StgRBH *)node)->mut_link       = ((StgRBHSave *)next)->payload[1];
1770
1771     IF_GRAN_DEBUG(bq,
1772                   belch("## Filled in RBH_Save for %p (%s) at end of AwBQ",
1773                         node, info_type(node)));
1774   }
1775 }
1776 #elif defined(PAR)
1777 static StgBlockingQueueElement *
1778 unblockOneLocked(StgBlockingQueueElement *bqe, StgClosure *node)
1779 {
1780     StgBlockingQueueElement *next;
1781
1782     switch (get_itbl(bqe)->type) {
1783     case TSO:
1784       ASSERT(((StgTSO *)bqe)->why_blocked != NotBlocked);
1785       /* if it's a TSO just push it onto the run_queue */
1786       next = bqe->link;
1787       // ((StgTSO *)bqe)->link = END_TSO_QUEUE; // debugging?
1788       PUSH_ON_RUN_QUEUE((StgTSO *)bqe);
1789       THREAD_RUNNABLE();
1790       unblockCount(bqe, node);
1791       /* reset blocking status after dumping event */
1792       ((StgTSO *)bqe)->why_blocked = NotBlocked;
1793       break;
1794
1795     case BLOCKED_FETCH:
1796       /* if it's a BLOCKED_FETCH put it on the PendingFetches list */
1797       next = bqe->link;
1798       bqe->link = PendingFetches;
1799       PendingFetches = bqe;
1800       break;
1801
1802 # if defined(DEBUG)
1803       /* can ignore this case in a non-debugging setup;
1804          see comments on RBHSave closures above */
1805     case CONSTR:
1806       /* check that the closure is an RBHSave closure */
1807       ASSERT(get_itbl((StgClosure *)bqe) == &RBH_Save_0_info ||
1808              get_itbl((StgClosure *)bqe) == &RBH_Save_1_info ||
1809              get_itbl((StgClosure *)bqe) == &RBH_Save_2_info);
1810       break;
1811
1812     default:
1813       barf("{unblockOneLocked}Daq Qagh: Unexpected IP (%#lx; %s) in blocking queue at %#lx\n",
1814            get_itbl((StgClosure *)bqe), info_type((StgClosure *)bqe),
1815            (StgClosure *)bqe);
1816 # endif
1817     }
1818   // IF_DEBUG(scheduler,sched_belch("waking up thread %ld", tso->id));
1819   return next;
1820 }
1821
1822 #else /* !GRAN && !PAR */
1823 static StgTSO *
1824 unblockOneLocked(StgTSO *tso)
1825 {
1826   StgTSO *next;
1827
1828   ASSERT(get_itbl(tso)->type == TSO);
1829   ASSERT(tso->why_blocked != NotBlocked);
1830   tso->why_blocked = NotBlocked;
1831   next = tso->link;
1832   PUSH_ON_RUN_QUEUE(tso);
1833   THREAD_RUNNABLE();
1834   IF_DEBUG(scheduler,sched_belch("waking up thread %ld", tso->id));
1835   return next;
1836 }
1837 #endif
1838
1839 #if defined(GRAN)
1840 inline StgTSO *
1841 unblockOne(StgTSO *tso, StgClosure *node)
1842 {
1843   ACQUIRE_LOCK(&sched_mutex);
1844   tso = unblockOneLocked(tso, node);
1845   RELEASE_LOCK(&sched_mutex);
1846   return tso;
1847 }
1848 #elif defined(PAR)
1849 inline StgTSO *
1850 unblockOne(StgTSO *tso, StgClosure *node)
1851 {
1852   ACQUIRE_LOCK(&sched_mutex);
1853   tso = unblockOneLocked(tso, node);
1854   RELEASE_LOCK(&sched_mutex);
1855   return tso;
1856 }
1857 #else
1858 inline StgTSO *
1859 unblockOne(StgTSO *tso)
1860 {
1861   ACQUIRE_LOCK(&sched_mutex);
1862   tso = unblockOneLocked(tso);
1863   RELEASE_LOCK(&sched_mutex);
1864   return tso;
1865 }
1866 #endif
1867
1868 #if defined(GRAN)
1869 void
1870 awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node)
1871 {
1872   StgBlockingQueueElement *bqe, *next;
1873   StgTSO *tso;
1874   PEs node_loc, tso_loc;
1875   rtsTime bq_processing_time = 0;
1876   nat len = 0, len_local = 0;
1877
1878   IF_GRAN_DEBUG(bq,
1879                 belch("## AwBQ for node %p on PE %d @ %ld by TSO %d (%p): ", \
1880                       node, CurrentProc, CurrentTime[CurrentProc],
1881                       CurrentTSO->id, CurrentTSO));
1882
1883   node_loc = where_is(node);
1884
1885   ASSERT(get_itbl(q)->type == TSO ||   // q is either a TSO or an RBHSave
1886          get_itbl(q)->type == CONSTR); // closure (type constructor)
1887   ASSERT(is_unique(node));
1888
1889   /* FAKE FETCH: magically copy the node to the tso's proc;
1890      no Fetch necessary because in reality the node should not have been
1891      moved to the other PE in the first place
1892   */
1893   if (CurrentProc!=node_loc) {
1894     IF_GRAN_DEBUG(bq,
1895                   belch("## node %p is on PE %d but CurrentProc is %d (TSO %d); assuming fake fetch and adjusting bitmask (old: %#x)",
1896                         node, node_loc, CurrentProc, CurrentTSO->id,
1897                         // CurrentTSO, where_is(CurrentTSO),
1898                         node->header.gran.procs));
1899     node->header.gran.procs = (node->header.gran.procs) | PE_NUMBER(CurrentProc);
1900     IF_GRAN_DEBUG(bq,
1901                   belch("## new bitmask of node %p is %#x",
1902                         node, node->header.gran.procs));
1903     if (RtsFlags.GranFlags.GranSimStats.Global) {
1904       globalGranStats.tot_fake_fetches++;
1905     }
1906   }
1907
1908   bqe = q;
1909   // ToDo: check: ASSERT(CurrentProc==node_loc);
1910   while (get_itbl(bqe)->type==TSO) { // q != END_TSO_QUEUE) {
1911     //next = bqe->link;
1912     /*
1913        bqe points to the current element in the queue
1914        next points to the next element in the queue
1915     */
1916     //tso = (StgTSO *)bqe;  // wastes an assignment to get the type right
1917     //tso_loc = where_is(tso);
1918     bqe = unblockOneLocked(bqe, node);
1919   }
1920
1921   /* statistics gathering */
1922   /* ToDo: fix counters
1923   if (RtsFlags.GranFlags.GranSimStats.Global) {
1924     globalGranStats.tot_bq_processing_time += bq_processing_time;
1925     globalGranStats.tot_bq_len += len;      // total length of all bqs awakened
1926     globalGranStats.tot_bq_len_local += len_local;  // same for local TSOs only
1927     globalGranStats.tot_awbq++;             // total no. of bqs awakened
1928   }
1929   IF_GRAN_DEBUG(bq,
1930                 fprintf(stderr,"## BQ Stats of %p: [%d entries, %d local] %s\n",
1931                         node, len, len_local, (next!=END_TSO_QUEUE) ? "RBH" : ""));
1932   */
1933 }
1934 #elif defined(PAR)
1935 void
1936 awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node)
1937 {
1938   StgBlockingQueueElement *bqe, *next;
1939
1940   ACQUIRE_LOCK(&sched_mutex);
1941
1942   IF_PAR_DEBUG(verbose,
1943                belch("## AwBQ for node %p on [%x]: ",
1944                      node, mytid));
1945
1946   ASSERT(get_itbl(q)->type == TSO ||
1947          get_itbl(q)->type == BLOCKED_FETCH ||
1948          get_itbl(q)->type == CONSTR);
1949
1950   bqe = q;
1951   while (get_itbl(bqe)->type==TSO ||
1952          get_itbl(bqe)->type==BLOCKED_FETCH) {
1953     bqe = unblockOneLocked(bqe, node);
1954   }
1955   RELEASE_LOCK(&sched_mutex);
1956 }
1957
1958 #else   /* !GRAN && !PAR */
1959 void
1960 awakenBlockedQueue(StgTSO *tso)
1961 {
1962   ACQUIRE_LOCK(&sched_mutex);
1963   while (tso != END_TSO_QUEUE) {
1964     tso = unblockOneLocked(tso);
1965   }
1966   RELEASE_LOCK(&sched_mutex);
1967 }
1968 #endif
1969
1970 //@node Exception Handling Routines, Debugging Routines, Blocking Queue Routines, Main scheduling code
1971 //@subsection Exception Handling Routines
1972
1973 /* ---------------------------------------------------------------------------
1974    Interrupt execution
1975    - usually called inside a signal handler so it mustn't do anything fancy.
1976    ------------------------------------------------------------------------ */
1977
1978 void
1979 interruptStgRts(void)
1980 {
1981     interrupted    = 1;
1982     context_switch = 1;
1983 }
1984
1985 /* -----------------------------------------------------------------------------
1986    Unblock a thread
1987
1988    This is for use when we raise an exception in another thread, which
1989    may be blocked.
1990    This has nothing to do with the UnblockThread event in GranSim. -- HWL
1991    -------------------------------------------------------------------------- */
1992
1993 static void
1994 unblockThread(StgTSO *tso)
1995 {
1996   StgTSO *t, **last;
1997
1998   ACQUIRE_LOCK(&sched_mutex);
1999   switch (tso->why_blocked) {
2000
2001   case NotBlocked:
2002     return;  /* not blocked */
2003
2004   case BlockedOnMVar:
2005     ASSERT(get_itbl(tso->block_info.closure)->type == MVAR);
2006     {
2007       StgTSO *last_tso = END_TSO_QUEUE;
2008       StgMVar *mvar = (StgMVar *)(tso->block_info.closure);
2009
2010       last = &mvar->head;
2011       for (t = mvar->head; t != END_TSO_QUEUE;
2012            last = &t->link, last_tso = t, t = t->link) {
2013         if (t == tso) {
2014           *last = tso->link;
2015           if (mvar->tail == tso) {
2016             mvar->tail = last_tso;
2017           }
2018           goto done;
2019         }
2020       }
2021       barf("unblockThread (MVAR): TSO not found");
2022     }
2023
2024   case BlockedOnBlackHole:
2025     ASSERT(get_itbl(tso->block_info.closure)->type == BLACKHOLE_BQ);
2026     {
2027       StgBlockingQueue *bq = (StgBlockingQueue *)(tso->block_info.closure);
2028
2029       last = &bq->blocking_queue;
2030       for (t = bq->blocking_queue; t != END_TSO_QUEUE;
2031            last = &t->link, t = t->link) {
2032         if (t == tso) {
2033           *last = tso->link;
2034           goto done;
2035         }
2036       }
2037       barf("unblockThread (BLACKHOLE): TSO not found");
2038     }
2039
2040   case BlockedOnException:
2041     {
2042       StgTSO *target  = tso->block_info.tso;
2043
2044       ASSERT(get_itbl(target)->type == TSO);
2045       ASSERT(target->blocked_exceptions != NULL);
2046
2047       last = &target->blocked_exceptions;
2048       for (t = target->blocked_exceptions; t != END_TSO_QUEUE;
2049            last = &t->link, t = t->link) {
2050         ASSERT(get_itbl(t)->type == TSO);
2051         if (t == tso) {
2052           *last = tso->link;
2053           goto done;
2054         }
2055       }
2056       barf("unblockThread (Exception): TSO not found");
2057     }
2058
2059   case BlockedOnDelay:
2060   case BlockedOnRead:
2061   case BlockedOnWrite:
2062     {
2063       StgTSO *prev = NULL;
2064       for (t = blocked_queue_hd; t != END_TSO_QUEUE;
2065            prev = t, t = t->link) {
2066         if (t == tso) {
2067           if (prev == NULL) {
2068             blocked_queue_hd = t->link;
2069             if (blocked_queue_tl == t) {
2070               blocked_queue_tl = END_TSO_QUEUE;
2071             }
2072           } else {
2073             prev->link = t->link;
2074             if (blocked_queue_tl == t) {
2075               blocked_queue_tl = prev;
2076             }
2077           }
2078           goto done;
2079         }
2080       }
2081       barf("unblockThread (I/O): TSO not found");
2082     }
2083
2084   default:
2085     barf("unblockThread");
2086   }
2087
2088  done:
2089   tso->link = END_TSO_QUEUE;
2090   tso->why_blocked = NotBlocked;
2091   tso->block_info.closure = NULL;
2092   PUSH_ON_RUN_QUEUE(tso);
2093   RELEASE_LOCK(&sched_mutex);
2094 }
2095
2096 /* -----------------------------------------------------------------------------
2097  * raiseAsync()
2098  *
2099  * The following function implements the magic for raising an
2100  * asynchronous exception in an existing thread.
2101  *
2102  * We first remove the thread from any queue on which it might be
2103  * blocked.  The possible blockages are MVARs and BLACKHOLE_BQs.
2104  *
2105  * We strip the stack down to the innermost CATCH_FRAME, building
2106  * thunks in the heap for all the active computations, so they can
2107  * be restarted if necessary.  When we reach a CATCH_FRAME, we build
2108  * an application of the handler to the exception, and push it on
2109  * the top of the stack.
2110  *
2111  * How exactly do we save all the active computations?  We create an
2112  * AP_UPD for every UpdateFrame on the stack.  Entering one of these
2113  * AP_UPDs pushes everything from the corresponding update frame
2114  * upwards onto the stack.  (Actually, it pushes everything up to the
2115  * next update frame plus a pointer to the next AP_UPD object.
2116  * Entering the next AP_UPD object pushes more onto the stack until we
2117  * reach the last AP_UPD object - at which point the stack should look
2118  * exactly as it did when we killed the TSO and we can continue
2119  * execution by entering the closure on top of the stack.
2120  *
2121  * We can also kill a thread entirely - this happens if either (a) the
2122  * exception passed to raiseAsync is NULL, or (b) there's no
2123  * CATCH_FRAME on the stack.  In either case, we strip the entire
2124  * stack and replace the thread with a zombie.
2125  *
2126  * -------------------------------------------------------------------------- */
2127
2128 void
2129 deleteThread(StgTSO *tso)
2130 {
2131   raiseAsync(tso,NULL);
2132 }
2133
2134 void
2135 raiseAsync(StgTSO *tso, StgClosure *exception)
2136 {
2137   StgUpdateFrame* su = tso->su;
2138   StgPtr          sp = tso->sp;
2139
2140   /* Thread already dead? */
2141   if (tso->whatNext == ThreadComplete || tso->whatNext == ThreadKilled) {
2142     return;
2143   }
2144
2145   IF_DEBUG(scheduler, sched_belch("raising exception in thread %ld.", tso->id));
2146
2147   /* Remove it from any blocking queues */
2148   unblockThread(tso);
2149
2150   /* The stack freezing code assumes there's a closure pointer on
2151    * the top of the stack.  This isn't always the case with compiled
2152    * code, so we have to push a dummy closure on the top which just
2153    * returns to the next return address on the stack.
2154    */
2155   if ( LOOKS_LIKE_GHC_INFO((void*)*sp) ) {
2156     *(--sp) = (W_)&dummy_ret_closure;
2157   }
2158
2159   while (1) {
2160     int words = ((P_)su - (P_)sp) - 1;
2161     nat i;
2162     StgAP_UPD * ap;
2163
2164     /* If we find a CATCH_FRAME, and we've got an exception to raise,
2165      * then build PAP(handler,exception,realworld#), and leave it on
2166      * top of the stack ready to enter.
2167      */
2168     if (get_itbl(su)->type == CATCH_FRAME && exception != NULL) {
2169       StgCatchFrame *cf = (StgCatchFrame *)su;
2170       /* we've got an exception to raise, so let's pass it to the
2171        * handler in this frame.
2172        */
2173       ap = (StgAP_UPD *)allocate(sizeofW(StgPAP) + 2);
2174       TICK_ALLOC_UPD_PAP(3,0);
2175       SET_HDR(ap,&PAP_info,cf->header.prof.ccs);
2176
2177       ap->n_args = 2;
2178       ap->fun = cf->handler;    /* :: Exception -> IO a */
2179       ap->payload[0] = (P_)exception;
2180       ap->payload[1] = ARG_TAG(0); /* realworld token */
2181
2182       /* throw away the stack from Sp up to and including the
2183        * CATCH_FRAME.
2184        */
2185       sp = (P_)su + sizeofW(StgCatchFrame) - 1;
2186       tso->su = cf->link;
2187
2188       /* Restore the blocked/unblocked state for asynchronous exceptions
2189        * at the CATCH_FRAME.
2190        *
2191        * If exceptions were unblocked at the catch, arrange that they
2192        * are unblocked again after executing the handler by pushing an
2193        * unblockAsyncExceptions_ret stack frame.
2194        */
2195       if (!cf->exceptions_blocked) {
2196         *(sp--) = (W_)&unblockAsyncExceptionszh_ret_info;
2197       }
2198
2199       /* Ensure that async exceptions are blocked when running the handler.
2200        */
2201       if (tso->blocked_exceptions == NULL) {
2202         tso->blocked_exceptions = END_TSO_QUEUE;
2203       }
2204
2205       /* Put the newly-built PAP on top of the stack, ready to execute
2206        * when the thread restarts.
2207        */
2208       sp[0] = (W_)ap;
2209       tso->sp = sp;
2210       tso->whatNext = ThreadEnterGHC;
2211       return;
2212     }
2213
2214     /* First build an AP_UPD consisting of the stack chunk above the
2215      * current update frame, with the top word on the stack as the
2216      * fun field.
2217      */
2218     ap = (StgAP_UPD *)allocate(AP_sizeW(words));
2219
2220     ASSERT(words >= 0);
2221
2222     ap->n_args = words;
2223     ap->fun    = (StgClosure *)sp[0];
2224     sp++;
2225     for(i=0; i < (nat)words; ++i) {
2226       ap->payload[i] = (P_)*sp++;
2227     }
2228
2229     switch (get_itbl(su)->type) {
2230
2231     case UPDATE_FRAME:
2232       {
2233         SET_HDR(ap,&AP_UPD_info,su->header.prof.ccs /* ToDo */);
2234         TICK_ALLOC_UP_THK(words+1,0);
2235
2236         IF_DEBUG(scheduler,
2237                  fprintf(stderr,  "scheduler: Updating ");
2238                  printPtr((P_)su->updatee);
2239                  fprintf(stderr,  " with ");
2240                  printObj((StgClosure *)ap);
2241                  );
2242
2243         /* Replace the updatee with an indirection - happily
2244          * this will also wake up any threads currently
2245          * waiting on the result.
2246          */
2247         UPD_IND_NOLOCK(su->updatee,ap);  /* revert the black hole */
2248         su = su->link;
2249         sp += sizeofW(StgUpdateFrame) -1;
2250         sp[0] = (W_)ap; /* push onto stack */
2251         break;
2252       }
2253
2254     case CATCH_FRAME:
2255       {
2256         StgCatchFrame *cf = (StgCatchFrame *)su;
2257         StgClosure* o;
2258
2259         /* We want a PAP, not an AP_UPD.  Fortunately, the
2260          * layout's the same.
2261          */
2262         SET_HDR(ap,&PAP_info,su->header.prof.ccs /* ToDo */);
2263         TICK_ALLOC_UPD_PAP(words+1,0);
2264
2265         /* now build o = FUN(catch,ap,handler) */
2266         o = (StgClosure *)allocate(sizeofW(StgClosure)+2);
2267         TICK_ALLOC_FUN(2,0);
2268         SET_HDR(o,&catch_info,su->header.prof.ccs /* ToDo */);
2269         o->payload[0] = (StgClosure *)ap;
2270         o->payload[1] = cf->handler;
2271
2272         IF_DEBUG(scheduler,
2273                  fprintf(stderr,  "scheduler: Built ");
2274                  printObj((StgClosure *)o);
2275                  );
2276
2277         /* pop the old handler and put o on the stack */
2278         su = cf->link;
2279         sp += sizeofW(StgCatchFrame) - 1;
2280         sp[0] = (W_)o;
2281         break;
2282       }
2283
2284     case SEQ_FRAME:
2285       {
2286         StgSeqFrame *sf = (StgSeqFrame *)su;
2287         StgClosure* o;
2288
2289         SET_HDR(ap,&PAP_info,su->header.prof.ccs /* ToDo */);
2290         TICK_ALLOC_UPD_PAP(words+1,0);
2291
2292         /* now build o = FUN(seq,ap) */
2293         o = (StgClosure *)allocate(sizeofW(StgClosure)+1);
2294         TICK_ALLOC_SE_THK(1,0);
2295         SET_HDR(o,&seq_info,su->header.prof.ccs /* ToDo */);
2296         payloadCPtr(o,0) = (StgClosure *)ap;
2297
2298         IF_DEBUG(scheduler,
2299                  fprintf(stderr,  "scheduler: Built ");
2300                  printObj((StgClosure *)o);
2301                  );
2302
2303         /* pop the old handler and put o on the stack */
2304         su = sf->link;
2305         sp += sizeofW(StgSeqFrame) - 1;
2306         sp[0] = (W_)o;
2307         break;
2308       }
2309
2310     case STOP_FRAME:
2311       /* We've stripped the entire stack, the thread is now dead. */
2312       sp += sizeofW(StgStopFrame) - 1;
2313       sp[0] = (W_)exception;    /* save the exception */
2314       tso->whatNext = ThreadKilled;
2315       tso->su = (StgUpdateFrame *)(sp+1);
2316       tso->sp = sp;
2317       return;
2318
2319     default:
2320       barf("raiseAsync");
2321     }
2322   }
2323   barf("raiseAsync");
2324 }
2325
2326 //@node Debugging Routines, Index, Exception Handling Routines, Main scheduling code
2327 //@subsection Debugging Routines
2328
2329 /* -----------------------------------------------------------------------------
2330    Debugging: why is a thread blocked
2331    -------------------------------------------------------------------------- */
2332
2333 #ifdef DEBUG
2334
2335 void printThreadBlockage(StgTSO *tso)
2336 {
2337   switch (tso->why_blocked) {
2338   case BlockedOnRead:
2339     fprintf(stderr,"blocked on read from fd %d", tso->block_info.fd);
2340     break;
2341   case BlockedOnWrite:
2342     fprintf(stderr,"blocked on write to fd %d", tso->block_info.fd);
2343     break;
2344   case BlockedOnDelay:
2345     fprintf(stderr,"blocked on delay of %d ms", tso->block_info.delay);
2346     break;
2347   case BlockedOnMVar:
2348     fprintf(stderr,"blocked on an MVar");
2349     break;
2350   case BlockedOnException:
2351     fprintf(stderr,"blocked on delivering an exception to thread %d",
2352             tso->block_info.tso->id);
2353     break;
2354   case BlockedOnBlackHole:
2355     fprintf(stderr,"blocked on a black hole");
2356     break;
2357   case NotBlocked:
2358     fprintf(stderr,"not blocked");
2359     break;
2360 #if defined(PAR)
2361   case BlockedOnGA:
2362     fprintf(stderr,"blocked on global address");
2363     break;
2364 #endif
2365   }
2366 }
2367
2368 /*
2369    Print a whole blocking queue attached to node (debugging only).
2370 */
2371 //@cindex print_bq
2372 # if defined(PAR)
2373 void
2374 print_bq (StgClosure *node)
2375 {
2376   StgBlockingQueueElement *bqe;
2377   StgTSO *tso;
2378   rtsBool end;
2379
2380   fprintf(stderr,"## BQ of closure %p (%s): ",
2381           node, info_type(node));
2382
2383   /* should cover all closures that may have a blocking queue */
2384   ASSERT(get_itbl(node)->type == BLACKHOLE_BQ ||
2385          get_itbl(node)->type == FETCH_ME_BQ ||
2386          get_itbl(node)->type == RBH);
2387
2388   ASSERT(node!=(StgClosure*)NULL);         // sanity check
2389   /*
2390      NB: In a parallel setup a BQ of an RBH must end with an RBH_Save closure;
2391   */
2392   for (bqe = ((StgBlockingQueue*)node)->blocking_queue, end = (bqe==END_BQ_QUEUE);
2393        !end; // iterate until bqe points to a CONSTR
2394        end = (get_itbl(bqe)->type == CONSTR) || (bqe->link==END_BQ_QUEUE), bqe = end ? END_BQ_QUEUE : bqe->link) {
2395     ASSERT(bqe != END_BQ_QUEUE);             // sanity check
2396     ASSERT(bqe != (StgTSO*)NULL);            // sanity check
2397     /* types of closures that may appear in a blocking queue */
2398     ASSERT(get_itbl(bqe)->type == TSO ||
2399            get_itbl(bqe)->type == BLOCKED_FETCH ||
2400            get_itbl(bqe)->type == CONSTR);
2401     /* only BQs of an RBH end with an RBH_Save closure */
2402     ASSERT(get_itbl(bqe)->type != CONSTR || get_itbl(node)->type == RBH);
2403
2404     switch (get_itbl(bqe)->type) {
2405     case TSO:
2406       fprintf(stderr," TSO %d (%x),",
2407               ((StgTSO *)bqe)->id, ((StgTSO *)bqe));
2408       break;
2409     case BLOCKED_FETCH:
2410       fprintf(stderr," BF (node=%p, ga=((%x, %d, %x)),",
2411               ((StgBlockedFetch *)bqe)->node,
2412               ((StgBlockedFetch *)bqe)->ga.payload.gc.gtid,
2413               ((StgBlockedFetch *)bqe)->ga.payload.gc.slot,
2414               ((StgBlockedFetch *)bqe)->ga.weight);
2415       break;
2416     case CONSTR:
2417       fprintf(stderr," %s (IP %p),",
2418               (get_itbl(bqe) == &RBH_Save_0_info ? "RBH_Save_0" :
2419                get_itbl(bqe) == &RBH_Save_1_info ? "RBH_Save_1" :
2420                get_itbl(bqe) == &RBH_Save_2_info ? "RBH_Save_2" :
2421                "RBH_Save_?"), get_itbl(bqe));
2422       break;
2423     default:
2424       barf("Unexpected closure type %s in blocking queue of %p (%s)",
2425            info_type(bqe), node, info_type(node));
2426       break;
2427     }
2428   } /* for */
2429   fputc('\n', stderr);
2430 }
2431 # elif defined(GRAN)
2432 void
2433 print_bq (StgClosure *node)
2434 {
2435   StgBlockingQueueElement *bqe;
2436   StgTSO *tso;
2437   PEs node_loc, tso_loc;
2438   rtsBool end;
2439
2440   /* should cover all closures that may have a blocking queue */
2441   ASSERT(get_itbl(node)->type == BLACKHOLE_BQ ||
2442          get_itbl(node)->type == FETCH_ME_BQ ||
2443          get_itbl(node)->type == RBH);
2444
2445   ASSERT(node!=(StgClosure*)NULL);         // sanity check
2446   node_loc = where_is(node);
2447
2448   fprintf(stderr,"## BQ of closure %p (%s) on [PE %d]: ",
2449           node, info_type(node), node_loc);
2450
2451   /*
2452      NB: In a parallel setup a BQ of an RBH must end with an RBH_Save closure;
2453   */
2454   for (bqe = ((StgBlockingQueue*)node)->blocking_queue, end = (bqe==END_BQ_QUEUE);
2455        !end; // iterate until bqe points to a CONSTR
2456        end = (get_itbl(bqe)->type == CONSTR) || (bqe->link==END_BQ_QUEUE), bqe = end ? END_BQ_QUEUE : bqe->link) {
2457     ASSERT(bqe != END_BQ_QUEUE);             // sanity check
2458     ASSERT(bqe != (StgTSO*)NULL);            // sanity check
2459     /* types of closures that may appear in a blocking queue */
2460     ASSERT(get_itbl(bqe)->type == TSO ||
2461            get_itbl(bqe)->type == CONSTR);
2462     /* only BQs of an RBH end with an RBH_Save closure */
2463     ASSERT(get_itbl(bqe)->type != CONSTR || get_itbl(node)->type == RBH);
2464
2465     tso_loc = where_is((StgClosure *)bqe);
2466     switch (get_itbl(bqe)->type) {
2467     case TSO:
2468       fprintf(stderr," TSO %d (%x) on [PE %d],",
2469               ((StgTSO *)bqe)->id, ((StgTSO *)bqe), tso_loc);
2470       break;
2471     case CONSTR:
2472       fprintf(stderr," %s (IP %p),",
2473               (get_itbl(bqe) == &RBH_Save_0_info ? "RBH_Save_0" :
2474                get_itbl(bqe) == &RBH_Save_1_info ? "RBH_Save_1" :
2475                get_itbl(bqe) == &RBH_Save_2_info ? "RBH_Save_2" :
2476                "RBH_Save_?"), get_itbl(bqe));
2477       break;
2478     default:
2479       barf("Unexpected closure type %s in blocking queue of %p (%s)",
2480            info_type(bqe), node, info_type(node));
2481       break;
2482     }
2483   } /* for */
2484   fputc('\n', stderr);
2485 }
2486 #else
2487 /*
2488    Nice and easy: only TSOs on the blocking queue
2489 */
2490 void
2491 print_bq (StgClosure *node)
2492 {
2493   StgTSO *tso;
2494
2495   ASSERT(node!=(StgClosure*)NULL);         // sanity check
2496   for (tso = ((StgBlockingQueue*)node)->blocking_queue;
2497        tso != END_TSO_QUEUE;
2498        tso=tso->link) {
2499     ASSERT(tso!=NULL && tso!=END_TSO_QUEUE);   // sanity check
2500     ASSERT(get_itbl(tso)->type == TSO);  // guess what, sanity check
2501     fprintf(stderr," TSO %d (%p),", tso->id, tso);
2502   }
2503   fputc('\n', stderr);
2504 }
2505 # endif
2506
2507 #if defined(PAR)
2508 static nat
2509 run_queue_len(void)
2510 {
2511   nat i;
2512   StgTSO *tso;
2513
2514   for (i=0, tso=run_queue_hd;
2515        tso != END_TSO_QUEUE;
2516        i++, tso=tso->link)
2517     /* nothing */
2518
2519   return i;
2520 }
2521 #endif
2522
2523 static void
2524 sched_belch(char *s, ...)
2525 {
2526   va_list ap;
2527   va_start(ap,s);
2528 #ifdef SMP
2529   fprintf(stderr, "scheduler (task %ld): ", pthread_self());
2530 #else
2531   fprintf(stderr, "scheduler: ");
2532 #endif
2533   vfprintf(stderr, s, ap);
2534   fprintf(stderr, "\n");
2535 }
2536
2537 #endif /* DEBUG */
2538
2539 //@node Index,  , Debugging Routines, Main scheduling code
2540 //@subsection Index
2541
2542 //@index
2543 //* MainRegTable::  @cindex\s-+MainRegTable
2544 //* StgMainThread::  @cindex\s-+StgMainThread
2545 //* awaken_blocked_queue::  @cindex\s-+awaken_blocked_queue
2546 //* blocked_queue_hd::  @cindex\s-+blocked_queue_hd
2547 //* blocked_queue_tl::  @cindex\s-+blocked_queue_tl
2548 //* context_switch::  @cindex\s-+context_switch
2549 //* createThread::  @cindex\s-+createThread
2550 //* free_capabilities::  @cindex\s-+free_capabilities
2551 //* gc_pending_cond::  @cindex\s-+gc_pending_cond
2552 //* initScheduler::  @cindex\s-+initScheduler
2553 //* interrupted::  @cindex\s-+interrupted
2554 //* n_free_capabilities::  @cindex\s-+n_free_capabilities
2555 //* next_thread_id::  @cindex\s-+next_thread_id
2556 //* print_bq::  @cindex\s-+print_bq
2557 //* run_queue_hd::  @cindex\s-+run_queue_hd
2558 //* run_queue_tl::  @cindex\s-+run_queue_tl
2559 //* sched_mutex::  @cindex\s-+sched_mutex
2560 //* schedule::  @cindex\s-+schedule
2561 //* take_off_run_queue::  @cindex\s-+take_off_run_queue
2562 //* task_ids::  @cindex\s-+task_ids
2563 //* term_mutex::  @cindex\s-+term_mutex
2564 //* thread_ready_cond::  @cindex\s-+thread_ready_cond
2565 //@end index