ghc/rts/Schedule.c

   1 /* ---------------------------------------------------------------------------
   2  * $Id: Schedule.c,v 1.50 2000/03/13 09:57:16 simonmar Exp $
   3  *
   4  * (c) The GHC Team, 1998-2000
   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   rtsBool was_interrupted = rtsFalse;
 299
 300   ACQUIRE_LOCK(&sched_mutex);
 301
 302 #if defined(GRAN)
 303 # error ToDo: implement GranSim scheduler
 304 #elif defined(PAR)
 305   while (!GlobalStopPending) {          /* GlobalStopPending set in par_exit */
 306
 307     if (PendingFetches != END_BF_QUEUE) {
 308         processFetches();
 309     }
 310 #else
 311   while (1) {
 312 #endif
 313
 314     /* If we're interrupted (the user pressed ^C, or some other
 315      * termination condition occurred), kill all the currently running
 316      * threads.
 317      */
 318     if (interrupted) {
 319       IF_DEBUG(scheduler, sched_belch("interrupted"));
 320       for (t = run_queue_hd; t != END_TSO_QUEUE; t = t->link) {
 321         deleteThread(t);
 322       }
 323       for (t = blocked_queue_hd; t != END_TSO_QUEUE; t = t->link) {
 324         deleteThread(t);
 325       }
 326       run_queue_hd = run_queue_tl = END_TSO_QUEUE;
 327       blocked_queue_hd = blocked_queue_tl = END_TSO_QUEUE;
 328       interrupted = rtsFalse;
 329       was_interrupted = rtsTrue;
 330     }
 331
 332     /* Go through the list of main threads and wake up any
 333      * clients whose computations have finished.  ToDo: this
 334      * should be done more efficiently without a linear scan
 335      * of the main threads list, somehow...
 336      */
 337 #ifdef SMP
 338     {
 339       StgMainThread *m, **prev;
 340       prev = &main_threads;
 341       for (m = main_threads; m != NULL; m = m->link) {
 342         switch (m->tso->whatNext) {
 343         case ThreadComplete:
 344           if (m->ret) {
 345             *(m->ret) = (StgClosure *)m->tso->sp[0];
 346           }
 347           *prev = m->link;
 348           m->stat = Success;
 349           pthread_cond_broadcast(&m->wakeup);
 350           break;
 351         case ThreadKilled:
 352           *prev = m->link;
 353           if (was_interrupted) {
 354             m->stat = Interrupted;
 355           } else {
 356             m->stat = Killed;
 357           }
 358           pthread_cond_broadcast(&m->wakeup);
 359           break;
 360         default:
 361           break;
 362         }
 363       }
 364     }
 365 #else
 366     /* If our main thread has finished or been killed, return.
 367      */
 368     {
 369       StgMainThread *m = main_threads;
 370       if (m->tso->whatNext == ThreadComplete
 371           || m->tso->whatNext == ThreadKilled) {
 372         main_threads = main_threads->link;
 373         if (m->tso->whatNext == ThreadComplete) {
 374           /* we finished successfully, fill in the return value */
 375           if (m->ret) { *(m->ret) = (StgClosure *)m->tso->sp[0]; };
 376           m->stat = Success;
 377           return;
 378         } else {
 379           if (was_interrupted) {
 380             m->stat = Interrupted;
 381           } else {
 382             m->stat = Killed;
 383           }
 384           return;
 385         }
 386       }
 387     }
 388 #endif
 389
 390     /* Top up the run queue from our spark pool.  We try to make the
 391      * number of threads in the run queue equal to the number of
 392      * free capabilities.
 393      */
 394 #if defined(SMP)
 395     {
 396       nat n = n_free_capabilities;
 397       StgTSO *tso = run_queue_hd;
 398
 399       /* Count the run queue */
 400       while (n > 0 && tso != END_TSO_QUEUE) {
 401         tso = tso->link;
 402         n--;
 403       }
 404
 405       for (; n > 0; n--) {
 406         StgClosure *spark;
 407         spark = findSpark();
 408         if (spark == NULL) {
 409           break; /* no more sparks in the pool */
 410         } else {
 411           /* I'd prefer this to be done in activateSpark -- HWL */
 412           /* tricky - it needs to hold the scheduler lock and
 413            * not try to re-acquire it -- SDM */
 414           StgTSO *tso;
 415           tso = createThread_(RtsFlags.GcFlags.initialStkSize, rtsTrue);
 416           pushClosure(tso,spark);
 417           PUSH_ON_RUN_QUEUE(tso);
 418 #ifdef PAR
 419           advisory_thread_count++;
 420 #endif
 421
 422           IF_DEBUG(scheduler,
 423                    sched_belch("turning spark of closure %p into a thread",
 424                                (StgClosure *)spark));
 425         }
 426       }
 427       /* We need to wake up the other tasks if we just created some
 428        * work for them.
 429        */
 430       if (n_free_capabilities - n > 1) {
 431           pthread_cond_signal(&thread_ready_cond);
 432       }
 433     }
 434 #endif /* SMP */
 435
 436     /* Check whether any waiting threads need to be woken up.  If the
 437      * run queue is empty, and there are no other tasks running, we
 438      * can wait indefinitely for something to happen.
 439      * ToDo: what if another client comes along & requests another
 440      * main thread?
 441      */
 442     if (blocked_queue_hd != END_TSO_QUEUE) {
 443       awaitEvent(
 444            (run_queue_hd == END_TSO_QUEUE)
 445 #ifdef SMP
 446         && (n_free_capabilities == RtsFlags.ParFlags.nNodes)
 447 #endif
 448         );
 449     }
 450
 451     /* check for signals each time around the scheduler */
 452 #ifndef __MINGW32__
 453     if (signals_pending()) {
 454       start_signal_handlers();
 455     }
 456 #endif
 457
 458     /* Detect deadlock: when we have no threads to run, there are
 459      * no threads waiting on I/O or sleeping, and all the other
 460      * tasks are waiting for work, we must have a deadlock.  Inform
 461      * all the main threads.
 462      */
 463 #ifdef SMP
 464     if (blocked_queue_hd == END_TSO_QUEUE
 465         && run_queue_hd == END_TSO_QUEUE
 466         && (n_free_capabilities == RtsFlags.ParFlags.nNodes)
 467         ) {
 468       StgMainThread *m;
 469       for (m = main_threads; m != NULL; m = m->link) {
 470           m->ret = NULL;
 471           m->stat = Deadlock;
 472           pthread_cond_broadcast(&m->wakeup);
 473       }
 474       main_threads = NULL;
 475     }
 476 #else /* ! SMP */
 477     if (blocked_queue_hd == END_TSO_QUEUE
 478         && run_queue_hd == END_TSO_QUEUE) {
 479       StgMainThread *m = main_threads;
 480       m->ret = NULL;
 481       m->stat = Deadlock;
 482       main_threads = m->link;
 483       return;
 484     }
 485 #endif
 486
 487 #ifdef SMP
 488     /* If there's a GC pending, don't do anything until it has
 489      * completed.
 490      */
 491     if (ready_to_gc) {
 492       IF_DEBUG(scheduler,sched_belch("waiting for GC"));
 493       pthread_cond_wait(&gc_pending_cond, &sched_mutex);
 494     }
 495
 496     /* block until we've got a thread on the run queue and a free
 497      * capability.
 498      */
 499     while (run_queue_hd == END_TSO_QUEUE || free_capabilities == NULL) {
 500       IF_DEBUG(scheduler, sched_belch("waiting for work"));
 501       pthread_cond_wait(&thread_ready_cond, &sched_mutex);
 502       IF_DEBUG(scheduler, sched_belch("work now available"));
 503     }
 504 #endif
 505
 506 #if defined(GRAN)
 507 # error ToDo: implement GranSim scheduler
 508 #elif defined(PAR)
 509     /* ToDo: phps merge with spark activation above */
 510     /* check whether we have local work and send requests if we have none */
 511     if (run_queue_hd == END_TSO_QUEUE) {  /* no runnable threads */
 512       /* :-[  no local threads => look out for local sparks */
 513       if (advisory_thread_count < RtsFlags.ParFlags.maxThreads &&
 514           (pending_sparks_hd[REQUIRED_POOL] < pending_sparks_tl[REQUIRED_POOL] ||
 515            pending_sparks_hd[ADVISORY_POOL] < pending_sparks_tl[ADVISORY_POOL])) {
 516         /*
 517          * ToDo: add GC code check that we really have enough heap afterwards!!
 518          * Old comment:
 519          * If we're here (no runnable threads) and we have pending
 520          * sparks, we must have a space problem.  Get enough space
 521          * to turn one of those pending sparks into a
 522          * thread...
 523          */
 524
 525         spark = findSpark();                /* get a spark */
 526         if (spark != (rtsSpark) NULL) {
 527           tso = activateSpark(spark);       /* turn the spark into a thread */
 528           IF_PAR_DEBUG(verbose,
 529                        belch("== [%x] schedule: Created TSO %p (%d); %d threads active",
 530                              mytid, tso, tso->id, advisory_thread_count));
 531
 532           if (tso==END_TSO_QUEUE) { /* failed to activate spark->back to loop */
 533             belch("^^ failed to activate spark");
 534             goto next_thread;
 535           }               /* otherwise fall through & pick-up new tso */
 536         } else {
 537           IF_PAR_DEBUG(verbose,
 538                        belch("^^ no local sparks (spark pool contains only NFs: %d)",
 539                              spark_queue_len(ADVISORY_POOL)));
 540           goto next_thread;
 541         }
 542       } else
 543       /* =8-[  no local sparks => look for work on other PEs */
 544       {
 545         /*
 546          * We really have absolutely no work.  Send out a fish
 547          * (there may be some out there already), and wait for
 548          * something to arrive.  We clearly can't run any threads
 549          * until a SCHEDULE or RESUME arrives, and so that's what
 550          * we're hoping to see.  (Of course, we still have to
 551          * respond to other types of messages.)
 552          */
 553         if (//!fishing &&
 554             outstandingFishes < RtsFlags.ParFlags.maxFishes ) { // &&
 555           // (last_fish_arrived_at+FISH_DELAY < CURRENT_TIME)) {
 556           /* fishing set in sendFish, processFish;
 557              avoid flooding system with fishes via delay */
 558           pe = choosePE();
 559           sendFish(pe, mytid, NEW_FISH_AGE, NEW_FISH_HISTORY,
 560                    NEW_FISH_HUNGER);
 561         }
 562
 563         processMessages();
 564         goto next_thread;
 565         // ReSchedule(0);
 566       }
 567     } else if (PacketsWaiting()) {  /* Look for incoming messages */
 568       processMessages();
 569     }
 570
 571     /* Now we are sure that we have some work available */
 572     ASSERT(run_queue_hd != END_TSO_QUEUE);
 573     /* Take a thread from the run queue, if we have work */
 574     t = take_off_run_queue(END_TSO_QUEUE);
 575
 576     /* ToDo: write something to the log-file
 577     if (RTSflags.ParFlags.granSimStats && !sameThread)
 578         DumpGranEvent(GR_SCHEDULE, RunnableThreadsHd);
 579     */
 580
 581     CurrentTSO = t;
 582
 583     IF_DEBUG(scheduler, belch("--^^ %d sparks on [%#x] (hd=%x; tl=%x; lim=%x)",
 584                               spark_queue_len(ADVISORY_POOL), CURRENT_PROC,
 585                               pending_sparks_hd[ADVISORY_POOL],
 586                               pending_sparks_tl[ADVISORY_POOL],
 587                               pending_sparks_lim[ADVISORY_POOL]));
 588
 589     IF_DEBUG(scheduler, belch("--== %d threads on [%#x] (hd=%x; tl=%x)",
 590                               run_queue_len(), CURRENT_PROC,
 591                               run_queue_hd, run_queue_tl));
 592
 593     if (t != LastTSO) {
 594       /*
 595          we are running a different TSO, so write a schedule event to log file
 596          NB: If we use fair scheduling we also have to write  a deschedule
 597              event for LastTSO; with unfair scheduling we know that the
 598              previous tso has blocked whenever we switch to another tso, so
 599              we don't need it in GUM for now
 600       */
 601       DumpRawGranEvent(CURRENT_PROC, CURRENT_PROC,
 602                        GR_SCHEDULE, t, (StgClosure *)NULL, 0, 0);
 603
 604     }
 605
 606 #else /* !GRAN && !PAR */
 607
 608     /* grab a thread from the run queue
 609      */
 610     t = POP_RUN_QUEUE();
 611     IF_DEBUG(sanity,checkTSO(t));
 612
 613 #endif
 614
 615     /* grab a capability
 616      */
 617 #ifdef SMP
 618     cap = free_capabilities;
 619     free_capabilities = cap->link;
 620     n_free_capabilities--;
 621 #else
 622     cap = &MainRegTable;
 623 #endif
 624
 625     cap->rCurrentTSO = t;
 626
 627     /* set the context_switch flag
 628      */
 629     if (run_queue_hd == END_TSO_QUEUE)
 630       context_switch = 0;
 631     else
 632       context_switch = 1;
 633
 634     RELEASE_LOCK(&sched_mutex);
 635
 636     IF_DEBUG(scheduler,sched_belch("running thread %d", t->id));
 637
 638     /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
 639     /* Run the current thread
 640      */
 641     switch (cap->rCurrentTSO->whatNext) {
 642     case ThreadKilled:
 643     case ThreadComplete:
 644       /* Thread already finished, return to scheduler. */
 645       ret = ThreadFinished;
 646       break;
 647     case ThreadEnterGHC:
 648       ret = StgRun((StgFunPtr) stg_enterStackTop, cap);
 649       break;
 650     case ThreadRunGHC:
 651       ret = StgRun((StgFunPtr) stg_returnToStackTop, cap);
 652       break;
 653     case ThreadEnterHugs:
 654 #ifdef INTERPRETER
 655       {
 656          StgClosure* c;
 657          IF_DEBUG(scheduler,sched_belch("entering Hugs"));
 658          c = (StgClosure *)(cap->rCurrentTSO->sp[0]);
 659          cap->rCurrentTSO->sp += 1;
 660          ret = enter(cap,c);
 661          break;
 662       }
 663 #else
 664       barf("Panic: entered a BCO but no bytecode interpreter in this build");
 665 #endif
 666     default:
 667       barf("schedule: invalid whatNext field");
 668     }
 669     /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
 670
 671     /* Costs for the scheduler are assigned to CCS_SYSTEM */
 672 #ifdef PROFILING
 673     CCCS = CCS_SYSTEM;
 674 #endif
 675
 676     ACQUIRE_LOCK(&sched_mutex);
 677
 678 #ifdef SMP
 679     IF_DEBUG(scheduler,fprintf(stderr,"scheduler (task %ld): ", pthread_self()););
 680 #else
 681     IF_DEBUG(scheduler,fprintf(stderr,"scheduler: "););
 682 #endif
 683     t = cap->rCurrentTSO;
 684
 685     switch (ret) {
 686     case HeapOverflow:
 687       /* make all the running tasks block on a condition variable,
 688        * maybe set context_switch and wait till they all pile in,
 689        * then have them wait on a GC condition variable.
 690        */
 691       IF_DEBUG(scheduler,belch("thread %ld stopped: HeapOverflow", t->id));
 692       threadPaused(t);
 693
 694       ready_to_gc = rtsTrue;
 695       context_switch = 1;               /* stop other threads ASAP */
 696       PUSH_ON_RUN_QUEUE(t);
 697       break;
 698
 699     case StackOverflow:
 700       /* just adjust the stack for this thread, then pop it back
 701        * on the run queue.
 702        */
 703       IF_DEBUG(scheduler,belch("thread %ld stopped, StackOverflow", t->id));
 704       threadPaused(t);
 705       {
 706         StgMainThread *m;
 707         /* enlarge the stack */
 708         StgTSO *new_t = threadStackOverflow(t);
 709
 710         /* This TSO has moved, so update any pointers to it from the
 711          * main thread stack.  It better not be on any other queues...
 712          * (it shouldn't be).
 713          */
 714         for (m = main_threads; m != NULL; m = m->link) {
 715           if (m->tso == t) {
 716             m->tso = new_t;
 717           }
 718         }
 719         threadPaused(new_t);
 720         PUSH_ON_RUN_QUEUE(new_t);
 721       }
 722       break;
 723
 724     case ThreadYielding:
 725 #if defined(GRAN)
 726       IF_DEBUG(gran,
 727                DumpGranEvent(GR_DESCHEDULE, t));
 728       globalGranStats.tot_yields++;
 729 #elif defined(PAR)
 730       IF_DEBUG(par,
 731                DumpGranEvent(GR_DESCHEDULE, t));
 732 #endif
 733       /* put the thread back on the run queue.  Then, if we're ready to
 734        * GC, check whether this is the last task to stop.  If so, wake
 735        * up the GC thread.  getThread will block during a GC until the
 736        * GC is finished.
 737        */
 738       IF_DEBUG(scheduler,
 739                if (t->whatNext == ThreadEnterHugs) {
 740                  /* ToDo: or maybe a timer expired when we were in Hugs?
 741                   * or maybe someone hit ctrl-C
 742                   */
 743                  belch("thread %ld stopped to switch to Hugs", t->id);
 744                } else {
 745                  belch("thread %ld stopped, yielding", t->id);
 746                }
 747                );
 748       threadPaused(t);
 749       APPEND_TO_RUN_QUEUE(t);
 750       break;
 751
 752     case ThreadBlocked:
 753 #if defined(GRAN)
 754 # error ToDo: implement GranSim scheduler
 755 #elif defined(PAR)
 756       IF_DEBUG(par,
 757                DumpGranEvent(GR_DESCHEDULE, t));
 758 #else
 759 #endif
 760       /* don't need to do anything.  Either the thread is blocked on
 761        * I/O, in which case we'll have called addToBlockedQueue
 762        * previously, or it's blocked on an MVar or Blackhole, in which
 763        * case it'll be on the relevant queue already.
 764        */
 765       IF_DEBUG(scheduler,
 766                fprintf(stderr, "thread %d stopped, ", t->id);
 767                printThreadBlockage(t);
 768                fprintf(stderr, "\n"));
 769       threadPaused(t);
 770       break;
 771
 772     case ThreadFinished:
 773       /* Need to check whether this was a main thread, and if so, signal
 774        * the task that started it with the return value.  If we have no
 775        * more main threads, we probably need to stop all the tasks until
 776        * we get a new one.
 777        */
 778       IF_DEBUG(scheduler,belch("thread %ld finished", t->id));
 779       t->whatNext = ThreadComplete;
 780 #if defined(GRAN)
 781       // ToDo: endThread(t, CurrentProc); // clean-up the thread
 782 #elif defined(PAR)
 783       advisory_thread_count--;
 784       if (RtsFlags.ParFlags.ParStats.Full)
 785         DumpEndEvent(CURRENT_PROC, t, rtsFalse /* not mandatory */);
 786 #endif
 787       break;
 788
 789     default:
 790       barf("doneThread: invalid thread return code");
 791     }
 792
 793 #ifdef SMP
 794     cap->link = free_capabilities;
 795     free_capabilities = cap;
 796     n_free_capabilities++;
 797 #endif
 798
 799 #ifdef SMP
 800     if (ready_to_gc && n_free_capabilities == RtsFlags.ParFlags.nNodes)
 801 #else
 802     if (ready_to_gc)
 803 #endif
 804       {
 805       /* everybody back, start the GC.
 806        * Could do it in this thread, or signal a condition var
 807        * to do it in another thread.  Either way, we need to
 808        * broadcast on gc_pending_cond afterward.
 809        */
 810 #ifdef SMP
 811       IF_DEBUG(scheduler,sched_belch("doing GC"));
 812 #endif
 813       GarbageCollect(GetRoots);
 814       ready_to_gc = rtsFalse;
 815 #ifdef SMP
 816       pthread_cond_broadcast(&gc_pending_cond);
 817 #endif
 818     }
 819 #if defined(GRAN)
 820   next_thread:
 821     IF_GRAN_DEBUG(unused,
 822                   print_eventq(EventHd));
 823
 824     event = get_next_event();
 825
 826 #elif defined(PAR)
 827   next_thread:
 828     /* ToDo: wait for next message to arrive rather than busy wait */
 829
 830 #else /* GRAN */
 831   /* not any more
 832   next_thread:
 833     t = take_off_run_queue(END_TSO_QUEUE);
 834   */
 835 #endif /* GRAN */
 836   } /* end of while(1) */
 837 }
 838
 839 /* A hack for Hugs concurrency support.  Needs sanitisation (?) */
 840 void deleteAllThreads ( void )
 841 {
 842   StgTSO* t;
 843   IF_DEBUG(scheduler,sched_belch("deleteAllThreads()"));
 844   for (t = run_queue_hd; t != END_TSO_QUEUE; t = t->link) {
 845     deleteThread(t);
 846   }
 847   for (t = blocked_queue_hd; t != END_TSO_QUEUE; t = t->link) {
 848     deleteThread(t);
 849   }
 850   run_queue_hd = run_queue_tl = END_TSO_QUEUE;
 851   blocked_queue_hd = blocked_queue_tl = END_TSO_QUEUE;
 852 }
 853
 854 /* startThread and  insertThread are now in GranSim.c -- HWL */
 855
 856 //@node Suspend and Resume, Run queue code, Main scheduling loop, Main scheduling code
 857 //@subsection Suspend and Resume
 858
 859 /* ---------------------------------------------------------------------------
 860  * Suspending & resuming Haskell threads.
 861  *
 862  * When making a "safe" call to C (aka _ccall_GC), the task gives back
 863  * its capability before calling the C function.  This allows another
 864  * task to pick up the capability and carry on running Haskell
 865  * threads.  It also means that if the C call blocks, it won't lock
 866  * the whole system.
 867  *
 868  * The Haskell thread making the C call is put to sleep for the
 869  * duration of the call, on the susepended_ccalling_threads queue.  We
 870  * give out a token to the task, which it can use to resume the thread
 871  * on return from the C function.
 872  * ------------------------------------------------------------------------- */
 873
 874 StgInt
 875 suspendThread( Capability *cap )
 876 {
 877   nat tok;
 878
 879   ACQUIRE_LOCK(&sched_mutex);
 880
 881   IF_DEBUG(scheduler,
 882            sched_belch("thread %d did a _ccall_gc\n", cap->rCurrentTSO->id));
 883
 884   threadPaused(cap->rCurrentTSO);
 885   cap->rCurrentTSO->link = suspended_ccalling_threads;
 886   suspended_ccalling_threads = cap->rCurrentTSO;
 887
 888   /* Use the thread ID as the token; it should be unique */
 889   tok = cap->rCurrentTSO->id;
 890
 891 #ifdef SMP
 892   cap->link = free_capabilities;
 893   free_capabilities = cap;
 894   n_free_capabilities++;
 895 #endif
 896
 897   RELEASE_LOCK(&sched_mutex);
 898   return tok;
 899 }
 900
 901 Capability *
 902 resumeThread( StgInt tok )
 903 {
 904   StgTSO *tso, **prev;
 905   Capability *cap;
 906
 907   ACQUIRE_LOCK(&sched_mutex);
 908
 909   prev = &suspended_ccalling_threads;
 910   for (tso = suspended_ccalling_threads;
 911        tso != END_TSO_QUEUE;
 912        prev = &tso->link, tso = tso->link) {
 913     if (tso->id == (StgThreadID)tok) {
 914       *prev = tso->link;
 915       break;
 916     }
 917   }
 918   if (tso == END_TSO_QUEUE) {
 919     barf("resumeThread: thread not found");
 920   }
 921
 922 #ifdef SMP
 923   while (free_capabilities == NULL) {
 924     IF_DEBUG(scheduler, sched_belch("waiting to resume"));
 925     pthread_cond_wait(&thread_ready_cond, &sched_mutex);
 926     IF_DEBUG(scheduler, sched_belch("resuming thread %d", tso->id));
 927   }
 928   cap = free_capabilities;
 929   free_capabilities = cap->link;
 930   n_free_capabilities--;
 931 #else
 932   cap = &MainRegTable;
 933 #endif
 934
 935   cap->rCurrentTSO = tso;
 936
 937   RELEASE_LOCK(&sched_mutex);
 938   return cap;
 939 }
 940
 941
 942 /* ---------------------------------------------------------------------------
 943  * Static functions
 944  * ------------------------------------------------------------------------ */
 945 static void unblockThread(StgTSO *tso);
 946
 947 /* ---------------------------------------------------------------------------
 948  * Comparing Thread ids.
 949  *
 950  * This is used from STG land in the implementation of the
 951  * instances of Eq/Ord for ThreadIds.
 952  * ------------------------------------------------------------------------ */
 953
 954 int cmp_thread(const StgTSO *tso1, const StgTSO *tso2)
 955 {
 956   StgThreadID id1 = tso1->id;
 957   StgThreadID id2 = tso2->id;
 958
 959   if (id1 < id2) return (-1);
 960   if (id1 > id2) return 1;
 961   return 0;
 962 }
 963
 964 /* ---------------------------------------------------------------------------
 965    Create a new thread.
 966
 967    The new thread starts with the given stack size.  Before the
 968    scheduler can run, however, this thread needs to have a closure
 969    (and possibly some arguments) pushed on its stack.  See
 970    pushClosure() in Schedule.h.
 971
 972    createGenThread() and createIOThread() (in SchedAPI.h) are
 973    convenient packaged versions of this function.
 974    ------------------------------------------------------------------------ */
 975 //@cindex createThread
 976 #if defined(GRAN)
 977 /* currently pri (priority) is only used in a GRAN setup -- HWL */
 978 StgTSO *
 979 createThread(nat stack_size, StgInt pri)
 980 {
 981   return createThread_(stack_size, rtsFalse, pri);
 982 }
 983
 984 static StgTSO *
 985 createThread_(nat size, rtsBool have_lock, StgInt pri)
 986 {
 987 #else
 988 StgTSO *
 989 createThread(nat stack_size)
 990 {
 991   return createThread_(stack_size, rtsFalse);
 992 }
 993
 994 static StgTSO *
 995 createThread_(nat size, rtsBool have_lock)
 996 {
 997 #endif
 998     StgTSO *tso;
 999     nat stack_size;
1000
1001     /* First check whether we should create a thread at all */
1002 #if defined(PAR)
1003   /* check that no more than RtsFlags.ParFlags.maxThreads threads are created */
1004   if (advisory_thread_count >= RtsFlags.ParFlags.maxThreads) {
1005     threadsIgnored++;
1006     belch("{createThread}Daq ghuH: refusing to create another thread; no more than %d threads allowed (currently %d)",
1007           RtsFlags.ParFlags.maxThreads, advisory_thread_count);
1008     return END_TSO_QUEUE;
1009   }
1010   threadsCreated++;
1011 #endif
1012
1013 #if defined(GRAN)
1014   ASSERT(!RtsFlags.GranFlags.Light || CurrentProc==0);
1015 #endif
1016
1017   // ToDo: check whether size = stack_size - TSO_STRUCT_SIZEW
1018
1019   /* catch ridiculously small stack sizes */
1020   if (size < MIN_STACK_WORDS + TSO_STRUCT_SIZEW) {
1021     size = MIN_STACK_WORDS + TSO_STRUCT_SIZEW;
1022   }
1023
1024   tso = (StgTSO *)allocate(size);
1025   TICK_ALLOC_TSO(size-sizeofW(StgTSO),0);
1026
1027   stack_size = size - TSO_STRUCT_SIZEW;
1028
1029   // Hmm, this CCS_MAIN is not protected by a PROFILING cpp var;
1030   SET_HDR(tso, &TSO_info, CCS_MAIN);
1031 #if defined(GRAN)
1032   SET_GRAN_HDR(tso, ThisPE);
1033 #endif
1034   tso->whatNext     = ThreadEnterGHC;
1035
1036   /* tso->id needs to be unique.  For now we use a heavyweight mutex to
1037          protect the increment operation on next_thread_id.
1038          In future, we could use an atomic increment instead.
1039   */
1040
1041   if (!have_lock) { ACQUIRE_LOCK(&sched_mutex); }
1042   tso->id = next_thread_id++;
1043   if (!have_lock) { RELEASE_LOCK(&sched_mutex); }
1044
1045   tso->why_blocked  = NotBlocked;
1046   tso->blocked_exceptions = NULL;
1047
1048   tso->splim        = (P_)&(tso->stack) + RESERVED_STACK_WORDS;
1049   tso->stack_size   = stack_size;
1050   tso->max_stack_size = round_to_mblocks(RtsFlags.GcFlags.maxStkSize)
1051                               - TSO_STRUCT_SIZEW;
1052   tso->sp           = (P_)&(tso->stack) + stack_size;
1053
1054 #ifdef PROFILING
1055   tso->prof.CCCS = CCS_MAIN;
1056 #endif
1057
1058   /* put a stop frame on the stack */
1059   tso->sp -= sizeofW(StgStopFrame);
1060   SET_HDR((StgClosure*)tso->sp,(StgInfoTable *)&stg_stop_thread_info,CCS_MAIN);
1061   tso->su = (StgUpdateFrame*)tso->sp;
1062
1063   IF_DEBUG(scheduler,belch("---- Initialised TSO %ld (%p), stack size = %lx words",
1064                            tso->id, tso, tso->stack_size));
1065
1066   // ToDo: check this
1067 #if defined(GRAN)
1068   tso->link = END_TSO_QUEUE;
1069   /* uses more flexible routine in GranSim */
1070   insertThread(tso, CurrentProc);
1071 #else
1072   /* In a non-GranSim setup the pushing of a TSO onto the runq is separated
1073      from its creation
1074   */
1075 #endif
1076
1077 #if defined(GRAN)
1078   tso->gran.pri = pri;
1079   tso->gran.magic = TSO_MAGIC; // debugging only
1080   tso->gran.sparkname   = 0;
1081   tso->gran.startedat   = CURRENT_TIME;
1082   tso->gran.exported    = 0;
1083   tso->gran.basicblocks = 0;
1084   tso->gran.allocs      = 0;
1085   tso->gran.exectime    = 0;
1086   tso->gran.fetchtime   = 0;
1087   tso->gran.fetchcount  = 0;
1088   tso->gran.blocktime   = 0;
1089   tso->gran.blockcount  = 0;
1090   tso->gran.blockedat   = 0;
1091   tso->gran.globalsparks = 0;
1092   tso->gran.localsparks  = 0;
1093   if (RtsFlags.GranFlags.Light)
1094     tso->gran.clock  = Now; /* local clock */
1095   else
1096     tso->gran.clock  = 0;
1097
1098   IF_DEBUG(gran,printTSO(tso));
1099 #elif defined(PAR)
1100   tso->par.sparkname   = 0;
1101   tso->par.startedat   = CURRENT_TIME;
1102   tso->par.exported    = 0;
1103   tso->par.basicblocks = 0;
1104   tso->par.allocs      = 0;
1105   tso->par.exectime    = 0;
1106   tso->par.fetchtime   = 0;
1107   tso->par.fetchcount  = 0;
1108   tso->par.blocktime   = 0;
1109   tso->par.blockcount  = 0;
1110   tso->par.blockedat   = 0;
1111   tso->par.globalsparks = 0;
1112   tso->par.localsparks  = 0;
1113 #endif
1114
1115 #if defined(GRAN)
1116   globalGranStats.tot_threads_created++;
1117   globalGranStats.threads_created_on_PE[CurrentProc]++;
1118   globalGranStats.tot_sq_len += spark_queue_len(CurrentProc);
1119   globalGranStats.tot_sq_probes++;
1120 #endif
1121
1122   IF_DEBUG(scheduler,sched_belch("created thread %ld, stack size = %lx words",
1123                                  tso->id, tso->stack_size));
1124   return tso;
1125 }
1126
1127 /* ---------------------------------------------------------------------------
1128  * scheduleThread()
1129  *
1130  * scheduleThread puts a thread on the head of the runnable queue.
1131  * This will usually be done immediately after a thread is created.
1132  * The caller of scheduleThread must create the thread using e.g.
1133  * createThread and push an appropriate closure
1134  * on this thread's stack before the scheduler is invoked.
1135  * ------------------------------------------------------------------------ */
1136
1137 void
1138 scheduleThread(StgTSO *tso)
1139 {
1140   ACQUIRE_LOCK(&sched_mutex);
1141
1142   /* Put the new thread on the head of the runnable queue.  The caller
1143    * better push an appropriate closure on this thread's stack
1144    * beforehand.  In the SMP case, the thread may start running as
1145    * soon as we release the scheduler lock below.
1146    */
1147   PUSH_ON_RUN_QUEUE(tso);
1148   THREAD_RUNNABLE();
1149
1150   IF_DEBUG(scheduler,printTSO(tso));
1151   RELEASE_LOCK(&sched_mutex);
1152 }
1153
1154 /* ---------------------------------------------------------------------------
1155  * startTasks()
1156  *
1157  * Start up Posix threads to run each of the scheduler tasks.
1158  * I believe the task ids are not needed in the system as defined.
1159  *  KH @ 25/10/99
1160  * ------------------------------------------------------------------------ */
1161
1162 #ifdef SMP
1163 static void *
1164 taskStart( void *arg STG_UNUSED )
1165 {
1166   schedule();
1167   return NULL;
1168 }
1169 #endif
1170
1171 /* ---------------------------------------------------------------------------
1172  * initScheduler()
1173  *
1174  * Initialise the scheduler.  This resets all the queues - if the
1175  * queues contained any threads, they'll be garbage collected at the
1176  * next pass.
1177  *
1178  * This now calls startTasks(), so should only be called once!  KH @ 25/10/99
1179  * ------------------------------------------------------------------------ */
1180
1181 #ifdef SMP
1182 static void
1183 term_handler(int sig STG_UNUSED)
1184 {
1185   stat_workerStop();
1186   ACQUIRE_LOCK(&term_mutex);
1187   await_death--;
1188   RELEASE_LOCK(&term_mutex);
1189   pthread_exit(NULL);
1190 }
1191 #endif
1192
1193 //@cindex initScheduler
1194 void
1195 initScheduler(void)
1196 {
1197 #if defined(GRAN)
1198   nat i;
1199
1200   for (i=0; i<=MAX_PROC; i++) {
1201     run_queue_hds[i]      = END_TSO_QUEUE;
1202     run_queue_tls[i]      = END_TSO_QUEUE;
1203     blocked_queue_hds[i]  = END_TSO_QUEUE;
1204     blocked_queue_tls[i]  = END_TSO_QUEUE;
1205     ccalling_threadss[i]  = END_TSO_QUEUE;
1206   }
1207 #else
1208   run_queue_hd      = END_TSO_QUEUE;
1209   run_queue_tl      = END_TSO_QUEUE;
1210   blocked_queue_hd  = END_TSO_QUEUE;
1211   blocked_queue_tl  = END_TSO_QUEUE;
1212 #endif
1213
1214   suspended_ccalling_threads  = END_TSO_QUEUE;
1215
1216   main_threads = NULL;
1217
1218   context_switch = 0;
1219   interrupted    = 0;
1220
1221   enteredCAFs = END_CAF_LIST;
1222
1223   /* Install the SIGHUP handler */
1224 #ifdef SMP
1225   {
1226     struct sigaction action,oact;
1227
1228     action.sa_handler = term_handler;
1229     sigemptyset(&action.sa_mask);
1230     action.sa_flags = 0;
1231     if (sigaction(SIGTERM, &action, &oact) != 0) {
1232       barf("can't install TERM handler");
1233     }
1234   }
1235 #endif
1236
1237 #ifdef SMP
1238   /* Allocate N Capabilities */
1239   {
1240     nat i;
1241     Capability *cap, *prev;
1242     cap  = NULL;
1243     prev = NULL;
1244     for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
1245       cap = stgMallocBytes(sizeof(Capability), "initScheduler:capabilities");
1246       cap->link = prev;
1247       prev = cap;
1248     }
1249     free_capabilities = cap;
1250     n_free_capabilities = RtsFlags.ParFlags.nNodes;
1251   }
1252   IF_DEBUG(scheduler,fprintf(stderr,"scheduler: Allocated %d capabilities\n",
1253                              n_free_capabilities););
1254 #endif
1255
1256 #if defined(SMP) || defined(PAR)
1257   initSparkPools();
1258 #endif
1259 }
1260
1261 #ifdef SMP
1262 void
1263 startTasks( void )
1264 {
1265   nat i;
1266   int r;
1267   pthread_t tid;
1268
1269   /* make some space for saving all the thread ids */
1270   task_ids = stgMallocBytes(RtsFlags.ParFlags.nNodes * sizeof(task_info),
1271                             "initScheduler:task_ids");
1272
1273   /* and create all the threads */
1274   for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
1275     r = pthread_create(&tid,NULL,taskStart,NULL);
1276     if (r != 0) {
1277       barf("startTasks: Can't create new Posix thread");
1278     }
1279     task_ids[i].id = tid;
1280     task_ids[i].mut_time = 0.0;
1281     task_ids[i].mut_etime = 0.0;
1282     task_ids[i].gc_time = 0.0;
1283     task_ids[i].gc_etime = 0.0;
1284     task_ids[i].elapsedtimestart = elapsedtime();
1285     IF_DEBUG(scheduler,fprintf(stderr,"scheduler: Started task: %ld\n",tid););
1286   }
1287 }
1288 #endif
1289
1290 void
1291 exitScheduler( void )
1292 {
1293 #ifdef SMP
1294   nat i;
1295
1296   /* Don't want to use pthread_cancel, since we'd have to install
1297    * these silly exception handlers (pthread_cleanup_{push,pop}) around
1298    * all our locks.
1299    */
1300 #if 0
1301   /* Cancel all our tasks */
1302   for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
1303     pthread_cancel(task_ids[i].id);
1304   }
1305
1306   /* Wait for all the tasks to terminate */
1307   for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
1308     IF_DEBUG(scheduler,fprintf(stderr,"scheduler: waiting for task %ld\n",
1309                                task_ids[i].id));
1310     pthread_join(task_ids[i].id, NULL);
1311   }
1312 #endif
1313
1314   /* Send 'em all a SIGHUP.  That should shut 'em up.
1315    */
1316   await_death = RtsFlags.ParFlags.nNodes;
1317   for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
1318     pthread_kill(task_ids[i].id,SIGTERM);
1319   }
1320   while (await_death > 0) {
1321     sched_yield();
1322   }
1323 #endif
1324 }
1325
1326 /* -----------------------------------------------------------------------------
1327    Managing the per-task allocation areas.
1328
1329    Each capability comes with an allocation area.  These are
1330    fixed-length block lists into which allocation can be done.
1331
1332    ToDo: no support for two-space collection at the moment???
1333    -------------------------------------------------------------------------- */
1334
1335 /* -----------------------------------------------------------------------------
1336  * waitThread is the external interface for running a new computataion
1337  * and waiting for the result.
1338  *
1339  * In the non-SMP case, we create a new main thread, push it on the
1340  * main-thread stack, and invoke the scheduler to run it.  The
1341  * scheduler will return when the top main thread on the stack has
1342  * completed or died, and fill in the necessary fields of the
1343  * main_thread structure.
1344  *
1345  * In the SMP case, we create a main thread as before, but we then
1346  * create a new condition variable and sleep on it.  When our new
1347  * main thread has completed, we'll be woken up and the status/result
1348  * will be in the main_thread struct.
1349  * -------------------------------------------------------------------------- */
1350
1351 SchedulerStatus
1352 waitThread(StgTSO *tso, /*out*/StgClosure **ret)
1353 {
1354   StgMainThread *m;
1355   SchedulerStatus stat;
1356
1357   ACQUIRE_LOCK(&sched_mutex);
1358
1359   m = stgMallocBytes(sizeof(StgMainThread), "waitThread");
1360
1361   m->tso = tso;
1362   m->ret = ret;
1363   m->stat = NoStatus;
1364 #ifdef SMP
1365   pthread_cond_init(&m->wakeup, NULL);
1366 #endif
1367
1368   m->link = main_threads;
1369   main_threads = m;
1370
1371   IF_DEBUG(scheduler, fprintf(stderr, "scheduler: new main thread (%d)\n",
1372                               m->tso->id));
1373
1374 #ifdef SMP
1375   do {
1376     pthread_cond_wait(&m->wakeup, &sched_mutex);
1377   } while (m->stat == NoStatus);
1378 #else
1379   schedule();
1380   ASSERT(m->stat != NoStatus);
1381 #endif
1382
1383   stat = m->stat;
1384
1385 #ifdef SMP
1386   pthread_cond_destroy(&m->wakeup);
1387 #endif
1388
1389   IF_DEBUG(scheduler, fprintf(stderr, "scheduler: main thread (%d) finished\n",
1390                               m->tso->id));
1391   free(m);
1392
1393   RELEASE_LOCK(&sched_mutex);
1394
1395   return stat;
1396 }
1397
1398 //@node Run queue code, Garbage Collextion Routines, Suspend and Resume, Main scheduling code
1399 //@subsection Run queue code
1400
1401 #if 0
1402 /*
1403    NB: In GranSim we have many run queues; run_queue_hd is actually a macro
1404        unfolding to run_queue_hds[CurrentProc], thus CurrentProc is an
1405        implicit global variable that has to be correct when calling these
1406        fcts -- HWL
1407 */
1408
1409 /* Put the new thread on the head of the runnable queue.
1410  * The caller of createThread better push an appropriate closure
1411  * on this thread's stack before the scheduler is invoked.
1412  */
1413 static /* inline */ void
1414 add_to_run_queue(tso)
1415 StgTSO* tso;
1416 {
1417   ASSERT(tso!=run_queue_hd && tso!=run_queue_tl);
1418   tso->link = run_queue_hd;
1419   run_queue_hd = tso;
1420   if (run_queue_tl == END_TSO_QUEUE) {
1421     run_queue_tl = tso;
1422   }
1423 }
1424
1425 /* Put the new thread at the end of the runnable queue. */
1426 static /* inline */ void
1427 push_on_run_queue(tso)
1428 StgTSO* tso;
1429 {
1430   ASSERT(get_itbl((StgClosure *)tso)->type == TSO);
1431   ASSERT(run_queue_hd!=NULL && run_queue_tl!=NULL);
1432   ASSERT(tso!=run_queue_hd && tso!=run_queue_tl);
1433   if (run_queue_hd == END_TSO_QUEUE) {
1434     run_queue_hd = tso;
1435   } else {
1436     run_queue_tl->link = tso;
1437   }
1438   run_queue_tl = tso;
1439 }
1440
1441 /*
1442    Should be inlined because it's used very often in schedule.  The tso
1443    argument is actually only needed in GranSim, where we want to have the
1444    possibility to schedule *any* TSO on the run queue, irrespective of the
1445    actual ordering. Therefore, if tso is not the nil TSO then we traverse
1446    the run queue and dequeue the tso, adjusting the links in the queue.
1447 */
1448 //@cindex take_off_run_queue
1449 static /* inline */ StgTSO*
1450 take_off_run_queue(StgTSO *tso) {
1451   StgTSO *t, *prev;
1452
1453   /*
1454      qetlaHbogh Qu' ngaSbogh ghomDaQ {tso} yIteq!
1455
1456      if tso is specified, unlink that tso from the run_queue (doesn't have
1457      to be at the beginning of the queue); GranSim only
1458   */
1459   if (tso!=END_TSO_QUEUE) {
1460     /* find tso in queue */
1461     for (t=run_queue_hd, prev=END_TSO_QUEUE;
1462          t!=END_TSO_QUEUE && t!=tso;
1463          prev=t, t=t->link)
1464       /* nothing */ ;
1465     ASSERT(t==tso);
1466     /* now actually dequeue the tso */
1467     if (prev!=END_TSO_QUEUE) {
1468       ASSERT(run_queue_hd!=t);
1469       prev->link = t->link;
1470     } else {
1471       /* t is at beginning of thread queue */
1472       ASSERT(run_queue_hd==t);
1473       run_queue_hd = t->link;
1474     }
1475     /* t is at end of thread queue */
1476     if (t->link==END_TSO_QUEUE) {
1477       ASSERT(t==run_queue_tl);
1478       run_queue_tl = prev;
1479     } else {
1480       ASSERT(run_queue_tl!=t);
1481     }
1482     t->link = END_TSO_QUEUE;
1483   } else {
1484     /* take tso from the beginning of the queue; std concurrent code */
1485     t = run_queue_hd;
1486     if (t != END_TSO_QUEUE) {
1487       run_queue_hd = t->link;
1488       t->link = END_TSO_QUEUE;
1489       if (run_queue_hd == END_TSO_QUEUE) {
1490         run_queue_tl = END_TSO_QUEUE;
1491       }
1492     }
1493   }
1494   return t;
1495 }
1496
1497 #endif /* 0 */
1498
1499 //@node Garbage Collextion Routines, Blocking Queue Routines, Run queue code, Main scheduling code
1500 //@subsection Garbage Collextion Routines
1501
1502 /* ---------------------------------------------------------------------------
1503    Where are the roots that we know about?
1504
1505         - all the threads on the runnable queue
1506         - all the threads on the blocked queue
1507         - all the thread currently executing a _ccall_GC
1508         - all the "main threads"
1509
1510    ------------------------------------------------------------------------ */
1511
1512 /* This has to be protected either by the scheduler monitor, or by the
1513         garbage collection monitor (probably the latter).
1514         KH @ 25/10/99
1515 */
1516
1517 static void GetRoots(void)
1518 {
1519   StgMainThread *m;
1520
1521 #if defined(GRAN)
1522   {
1523     nat i;
1524     for (i=0; i<=RtsFlags.GranFlags.proc; i++) {
1525       if ((run_queue_hds[i] != END_TSO_QUEUE) && ((run_queue_hds[i] != NULL)))
1526         run_queue_hds[i]    = (StgTSO *)MarkRoot((StgClosure *)run_queue_hds[i]);
1527       if ((run_queue_tls[i] != END_TSO_QUEUE) && ((run_queue_tls[i] != NULL)))
1528         run_queue_tls[i]    = (StgTSO *)MarkRoot((StgClosure *)run_queue_tls[i]);
1529
1530       if ((blocked_queue_hds[i] != END_TSO_QUEUE) && ((blocked_queue_hds[i] != NULL)))
1531         blocked_queue_hds[i] = (StgTSO *)MarkRoot((StgClosure *)blocked_queue_hds[i]);
1532       if ((blocked_queue_tls[i] != END_TSO_QUEUE) && ((blocked_queue_tls[i] != NULL)))
1533         blocked_queue_tls[i] = (StgTSO *)MarkRoot((StgClosure *)blocked_queue_tls[i]);
1534       if ((ccalling_threadss[i] != END_TSO_QUEUE) && ((ccalling_threadss[i] != NULL)))
1535         ccalling_threadss[i] = (StgTSO *)MarkRoot((StgClosure *)ccalling_threadss[i]);
1536     }
1537   }
1538
1539   markEventQueue();
1540
1541 #else /* !GRAN */
1542   run_queue_hd      = (StgTSO *)MarkRoot((StgClosure *)run_queue_hd);
1543   run_queue_tl      = (StgTSO *)MarkRoot((StgClosure *)run_queue_tl);
1544
1545   blocked_queue_hd  = (StgTSO *)MarkRoot((StgClosure *)blocked_queue_hd);
1546   blocked_queue_tl  = (StgTSO *)MarkRoot((StgClosure *)blocked_queue_tl);
1547 #endif
1548
1549   for (m = main_threads; m != NULL; m = m->link) {
1550     m->tso = (StgTSO *)MarkRoot((StgClosure *)m->tso);
1551   }
1552   suspended_ccalling_threads =
1553     (StgTSO *)MarkRoot((StgClosure *)suspended_ccalling_threads);
1554
1555 #if defined(SMP) || defined(PAR) || defined(GRAN)
1556   markSparkQueue();
1557 #endif
1558 }
1559
1560 /* -----------------------------------------------------------------------------
1561    performGC
1562
1563    This is the interface to the garbage collector from Haskell land.
1564    We provide this so that external C code can allocate and garbage
1565    collect when called from Haskell via _ccall_GC.
1566
1567    It might be useful to provide an interface whereby the programmer
1568    can specify more roots (ToDo).
1569
1570    This needs to be protected by the GC condition variable above.  KH.
1571    -------------------------------------------------------------------------- */
1572
1573 void (*extra_roots)(void);
1574
1575 void
1576 performGC(void)
1577 {
1578   GarbageCollect(GetRoots);
1579 }
1580
1581 static void
1582 AllRoots(void)
1583 {
1584   GetRoots();                   /* the scheduler's roots */
1585   extra_roots();                /* the user's roots */
1586 }
1587
1588 void
1589 performGCWithRoots(void (*get_roots)(void))
1590 {
1591   extra_roots = get_roots;
1592
1593   GarbageCollect(AllRoots);
1594 }
1595
1596 /* -----------------------------------------------------------------------------
1597    Stack overflow
1598
1599    If the thread has reached its maximum stack size, then raise the
1600    StackOverflow exception in the offending thread.  Otherwise
1601    relocate the TSO into a larger chunk of memory and adjust its stack
1602    size appropriately.
1603    -------------------------------------------------------------------------- */
1604
1605 static StgTSO *
1606 threadStackOverflow(StgTSO *tso)
1607 {
1608   nat new_stack_size, new_tso_size, diff, stack_words;
1609   StgPtr new_sp;
1610   StgTSO *dest;
1611
1612   IF_DEBUG(sanity,checkTSO(tso));
1613   if (tso->stack_size >= tso->max_stack_size) {
1614 #if 0
1615     /* If we're debugging, just print out the top of the stack */
1616     printStackChunk(tso->sp, stg_min(tso->stack+tso->stack_size,
1617                                      tso->sp+64));
1618 #endif
1619 #ifdef INTERPRETER
1620     fprintf(stderr, "fatal: stack overflow in Hugs; aborting\n" );
1621     exit(1);
1622 #else
1623     /* Send this thread the StackOverflow exception */
1624     raiseAsync(tso, (StgClosure *)&stackOverflow_closure);
1625 #endif
1626     return tso;
1627   }
1628
1629   /* Try to double the current stack size.  If that takes us over the
1630    * maximum stack size for this thread, then use the maximum instead.
1631    * Finally round up so the TSO ends up as a whole number of blocks.
1632    */
1633   new_stack_size = stg_min(tso->stack_size * 2, tso->max_stack_size);
1634   new_tso_size   = (nat)BLOCK_ROUND_UP(new_stack_size * sizeof(W_) +
1635                                        TSO_STRUCT_SIZE)/sizeof(W_);
1636   new_tso_size = round_to_mblocks(new_tso_size);  /* Be MBLOCK-friendly */
1637   new_stack_size = new_tso_size - TSO_STRUCT_SIZEW;
1638
1639   IF_DEBUG(scheduler, fprintf(stderr,"scheduler: increasing stack size from %d words to %d.\n", tso->stack_size, new_stack_size));
1640
1641   dest = (StgTSO *)allocate(new_tso_size);
1642   TICK_ALLOC_TSO(new_tso_size-sizeofW(StgTSO),0);
1643
1644   /* copy the TSO block and the old stack into the new area */
1645   memcpy(dest,tso,TSO_STRUCT_SIZE);
1646   stack_words = tso->stack + tso->stack_size - tso->sp;
1647   new_sp = (P_)dest + new_tso_size - stack_words;
1648   memcpy(new_sp, tso->sp, stack_words * sizeof(W_));
1649
1650   /* relocate the stack pointers... */
1651   diff = (P_)new_sp - (P_)tso->sp; /* In *words* */
1652   dest->su    = (StgUpdateFrame *) ((P_)dest->su + diff);
1653   dest->sp    = new_sp;
1654   dest->splim = (P_)dest->splim + (nat)((P_)dest - (P_)tso);
1655   dest->stack_size = new_stack_size;
1656
1657   /* and relocate the update frame list */
1658   relocate_TSO(tso, dest);
1659
1660   /* Mark the old TSO as relocated.  We have to check for relocated
1661    * TSOs in the garbage collector and any primops that deal with TSOs.
1662    *
1663    * It's important to set the sp and su values to just beyond the end
1664    * of the stack, so we don't attempt to scavenge any part of the
1665    * dead TSO's stack.
1666    */
1667   tso->whatNext = ThreadRelocated;
1668   tso->link = dest;
1669   tso->sp = (P_)&(tso->stack[tso->stack_size]);
1670   tso->su = (StgUpdateFrame *)tso->sp;
1671   tso->why_blocked = NotBlocked;
1672   dest->mut_link = NULL;
1673
1674   IF_DEBUG(sanity,checkTSO(tso));
1675 #if 0
1676   IF_DEBUG(scheduler,printTSO(dest));
1677 #endif
1678
1679   return dest;
1680 }
1681
1682 //@node Blocking Queue Routines, Exception Handling Routines, Garbage Collextion Routines, Main scheduling code
1683 //@subsection Blocking Queue Routines
1684
1685 /* ---------------------------------------------------------------------------
1686    Wake up a queue that was blocked on some resource.
1687    ------------------------------------------------------------------------ */
1688
1689 /* ToDo: check push_on_run_queue vs. PUSH_ON_RUN_QUEUE */
1690
1691 #if defined(GRAN)
1692 static inline void
1693 unblockCount ( StgBlockingQueueElement *bqe, StgClosure *node )
1694 {
1695 }
1696 #elif defined(PAR)
1697 static inline void
1698 unblockCount ( StgBlockingQueueElement *bqe, StgClosure *node )
1699 {
1700   /* write RESUME events to log file and
1701      update blocked and fetch time (depending on type of the orig closure) */
1702   if (RtsFlags.ParFlags.ParStats.Full) {
1703     DumpRawGranEvent(CURRENT_PROC, CURRENT_PROC,
1704                      GR_RESUMEQ, ((StgTSO *)bqe), ((StgTSO *)bqe)->block_info.closure,
1705                      0, 0 /* spark_queue_len(ADVISORY_POOL) */);
1706
1707     switch (get_itbl(node)->type) {
1708         case FETCH_ME_BQ:
1709           ((StgTSO *)bqe)->par.fetchtime += CURRENT_TIME-((StgTSO *)bqe)->par.blockedat;
1710           break;
1711         case RBH:
1712         case FETCH_ME:
1713         case BLACKHOLE_BQ:
1714           ((StgTSO *)bqe)->par.blocktime += CURRENT_TIME-((StgTSO *)bqe)->par.blockedat;
1715           break;
1716         default:
1717           barf("{unblockOneLocked}Daq Qagh: unexpected closure in blocking queue");
1718         }
1719       }
1720 }
1721 #endif
1722
1723 #if defined(GRAN)
1724 static StgBlockingQueueElement *
1725 unblockOneLocked(StgBlockingQueueElement *bqe, StgClosure *node)
1726 {
1727     StgBlockingQueueElement *next;
1728     PEs node_loc, tso_loc;
1729
1730     node_loc = where_is(node); // should be lifted out of loop
1731     tso = (StgTSO *)bqe;  // wastes an assignment to get the type right
1732     tso_loc = where_is(tso);
1733     if (IS_LOCAL_TO(PROCS(node),tso_loc)) { // TSO is local
1734       /* !fake_fetch => TSO is on CurrentProc is same as IS_LOCAL_TO */
1735       ASSERT(CurrentProc!=node_loc || tso_loc==CurrentProc);
1736       bq_processing_time += RtsFlags.GranFlags.Costs.lunblocktime;
1737       // insertThread(tso, node_loc);
1738       new_event(tso_loc, tso_loc,
1739                 CurrentTime[CurrentProc]+bq_processing_time,
1740                 ResumeThread,
1741                 tso, node, (rtsSpark*)NULL);
1742       tso->link = END_TSO_QUEUE; // overwrite link just to be sure
1743       // len_local++;
1744       // len++;
1745     } else { // TSO is remote (actually should be FMBQ)
1746       bq_processing_time += RtsFlags.GranFlags.Costs.mpacktime;
1747       bq_processing_time += RtsFlags.GranFlags.Costs.gunblocktime;
1748       new_event(tso_loc, CurrentProc,
1749                 CurrentTime[CurrentProc]+bq_processing_time+
1750                 RtsFlags.GranFlags.Costs.latency,
1751                 UnblockThread,
1752                 tso, node, (rtsSpark*)NULL);
1753       tso->link = END_TSO_QUEUE; // overwrite link just to be sure
1754       bq_processing_time += RtsFlags.GranFlags.Costs.mtidytime;
1755       // len++;
1756     }
1757     /* the thread-queue-overhead is accounted for in either Resume or UnblockThread */
1758     IF_GRAN_DEBUG(bq,
1759                   fprintf(stderr," %s TSO %d (%p) [PE %d] (blocked_on=%p) (next=%p) ,",
1760                           (node_loc==tso_loc ? "Local" : "Global"),
1761                           tso->id, tso, CurrentProc, tso->blocked_on, tso->link))
1762     tso->blocked_on = NULL;
1763     IF_DEBUG(scheduler,belch("-- Waking up thread %ld (%p)",
1764                              tso->id, tso));
1765   }
1766
1767   /* if this is the BQ of an RBH, we have to put back the info ripped out of
1768      the closure to make room for the anchor of the BQ */
1769   if (next!=END_BQ_QUEUE) {
1770     ASSERT(get_itbl(node)->type == RBH && get_itbl(next)->type == CONSTR);
1771     /*
1772     ASSERT((info_ptr==&RBH_Save_0_info) ||
1773            (info_ptr==&RBH_Save_1_info) ||
1774            (info_ptr==&RBH_Save_2_info));
1775     */
1776     /* cf. convertToRBH in RBH.c for writing the RBHSave closure */
1777     ((StgRBH *)node)->blocking_queue = ((StgRBHSave *)next)->payload[0];
1778     ((StgRBH *)node)->mut_link       = ((StgRBHSave *)next)->payload[1];
1779
1780     IF_GRAN_DEBUG(bq,
1781                   belch("## Filled in RBH_Save for %p (%s) at end of AwBQ",
1782                         node, info_type(node)));
1783   }
1784 }
1785 #elif defined(PAR)
1786 static StgBlockingQueueElement *
1787 unblockOneLocked(StgBlockingQueueElement *bqe, StgClosure *node)
1788 {
1789     StgBlockingQueueElement *next;
1790
1791     switch (get_itbl(bqe)->type) {
1792     case TSO:
1793       ASSERT(((StgTSO *)bqe)->why_blocked != NotBlocked);
1794       /* if it's a TSO just push it onto the run_queue */
1795       next = bqe->link;
1796       // ((StgTSO *)bqe)->link = END_TSO_QUEUE; // debugging?
1797       PUSH_ON_RUN_QUEUE((StgTSO *)bqe);
1798       THREAD_RUNNABLE();
1799       unblockCount(bqe, node);
1800       /* reset blocking status after dumping event */
1801       ((StgTSO *)bqe)->why_blocked = NotBlocked;
1802       break;
1803
1804     case BLOCKED_FETCH:
1805       /* if it's a BLOCKED_FETCH put it on the PendingFetches list */
1806       next = bqe->link;
1807       bqe->link = PendingFetches;
1808       PendingFetches = bqe;
1809       break;
1810
1811 # if defined(DEBUG)
1812       /* can ignore this case in a non-debugging setup;
1813          see comments on RBHSave closures above */
1814     case CONSTR:
1815       /* check that the closure is an RBHSave closure */
1816       ASSERT(get_itbl((StgClosure *)bqe) == &RBH_Save_0_info ||
1817              get_itbl((StgClosure *)bqe) == &RBH_Save_1_info ||
1818              get_itbl((StgClosure *)bqe) == &RBH_Save_2_info);
1819       break;
1820
1821     default:
1822       barf("{unblockOneLocked}Daq Qagh: Unexpected IP (%#lx; %s) in blocking queue at %#lx\n",
1823            get_itbl((StgClosure *)bqe), info_type((StgClosure *)bqe),
1824            (StgClosure *)bqe);
1825 # endif
1826     }
1827   // IF_DEBUG(scheduler,sched_belch("waking up thread %ld", tso->id));
1828   return next;
1829 }
1830
1831 #else /* !GRAN && !PAR */
1832 static StgTSO *
1833 unblockOneLocked(StgTSO *tso)
1834 {
1835   StgTSO *next;
1836
1837   ASSERT(get_itbl(tso)->type == TSO);
1838   ASSERT(tso->why_blocked != NotBlocked);
1839   tso->why_blocked = NotBlocked;
1840   next = tso->link;
1841   PUSH_ON_RUN_QUEUE(tso);
1842   THREAD_RUNNABLE();
1843   IF_DEBUG(scheduler,sched_belch("waking up thread %ld", tso->id));
1844   return next;
1845 }
1846 #endif
1847
1848 #if defined(PAR) || defined(GRAN)
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