ghc/runtime/main/StgThreads.lhc

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994
   3 %
   4 %************************************************************************
   5 %*                                                                      *
   6 \section[StgThreads.lhc]{Threaded Threads Support}
   7 %*                                                                      *
   8 %************************************************************************
   9
  10 Some of the threads support is done in threaded code.  How's that for ambiguous
  11 overloading?
  12
  13 \begin{code}
  14
  15 #ifdef CONCURRENT
  16
  17 #define MAIN_REG_MAP        /* STG world */
  18 #include "rtsdefs.h"
  19
  20 #if 0
  21 #ifdef PAR
  22 #include "Statistics.h"
  23 #endif
  24 #endif
  25
  26 \end{code}
  27
  28 %************************************************************************
  29 %*                                                                      *
  30 \subsection[thread-objects]{Special objects for thread support}
  31 %*                                                                      *
  32 %************************************************************************
  33
  34 TSO's are Thread State Objects, where the thread context is stored when the
  35 thread is sleeping, and where we have slots for STG registers that don't
  36 live in real machine registers.
  37
  38 \begin{code}
  39
  40 TSO_ITBL();
  41
  42 STGFUN(TSO_entry)
  43 {
  44     FB_
  45     fflush(stdout);
  46     fprintf(stderr, "TSO Entry: panic");
  47     abort();
  48     FE_
  49 }
  50
  51 \end{code}
  52
  53 Stack objects are chunks of stack words allocated out of the heap and
  54 linked together in a chain.
  55
  56 \begin{code}
  57
  58 STKO_ITBL();
  59
  60 STGFUN(StkO_entry)
  61 {
  62     FB_
  63     fflush(stdout);
  64     fprintf(stderr, "StkO Entry: panic");
  65     abort();
  66     FE_
  67
  68 }
  69
  70 #ifndef PAR
  71
  72 STKO_STATIC_ITBL();
  73
  74 STGFUN(StkO_static_entry)
  75 {
  76     FB_
  77     fflush(stdout);
  78     fprintf(stderr, "StkO_static Entry: panic");
  79     abort();
  80     FE_
  81
  82 }
  83
  84 #endif
  85
  86 \end{code}
  87
  88 Blocking queues are essentially black holes with threads attached.  These
  89 are the threads to be awakened when the closure is updated.
  90
  91 \begin{code}
  92
  93 EXTFUN(EnterNodeCode);
  94
  95 STGFUN(BQ_entry)
  96 {
  97     FB_
  98
  99 #if defined(GRAN)
 100     STGCALL0(void,(),GranSimBlock);     /* Before overwriting TSO_LINK */
 101 #endif
 102
 103     TSO_LINK(CurrentTSO) = (P_) BQ_ENTRIES(Node);
 104     BQ_ENTRIES(Node) = (W_) CurrentTSO;
 105
 106     LivenessReg = LIVENESS_R1;
 107     SaveAllStgRegs();
 108     TSO_PC1(CurrentTSO) = EnterNodeCode;
 109
 110     if (DO_QP_PROF) {
 111         QP_Event1("GR", CurrentTSO);
 112     }
 113 #ifdef PAR
 114     if(do_gr_profile) {
 115         /* Note that CURRENT_TIME may perform an unsafe call */
 116         TIME now = CURRENT_TIME;
 117         TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO);
 118         TSO_BLOCKCOUNT(CurrentTSO)++;
 119         TSO_QUEUE(CurrentTSO) = Q_BLOCKED;
 120         TSO_BLOCKEDAT(CurrentTSO) = now;
 121         DumpGranEvent(GR_BLOCK, CurrentTSO);
 122     }
 123 #endif
 124 #if defined(GRAN)
 125     ReSchedule(NEW_THREAD);
 126 #else
 127     ReSchedule(0);
 128 #endif
 129     FE_
 130 }
 131
 132 BQ_ITBL();
 133
 134 \end{code}
 135
 136 Revertible black holes are needed in the parallel world, to handle
 137 negative acknowledgements of messages containing updatable closures.
 138 The idea is that when the original message is transmitted, the closure
 139 is turned into a revertible black hole...an object which acts like a
 140 black hole when local threads try to enter it, but which can be
 141 reverted back to the original closure if necessary.
 142
 143 It's actually a lot like a blocking queue (BQ) entry, because
 144 revertible black holes are initially set up with an empty blocking
 145 queue.
 146
 147 The combination of GrAnSim with revertible black holes has not been
 148 checked, yet. -- HWL
 149
 150 \begin{code}
 151
 152 #ifdef PAR
 153
 154 STGFUN(RBH_entry)
 155 {
 156     FB_
 157
 158 #if defined(GRAN)
 159     STGCALL0(void, (), GranSimBlock);   /* Before overwriting TSO_LINK */
 160 #endif
 161
 162     switch (INFO_TYPE(InfoPtr)) {
 163     case INFO_SPEC_RBH_TYPE:
 164         TSO_LINK(CurrentTSO) = (P_) SPEC_RBH_BQ(Node);
 165         SPEC_RBH_BQ(Node) = (W_) CurrentTSO;
 166         break;
 167     case INFO_GEN_RBH_TYPE:
 168         TSO_LINK(CurrentTSO) = (P_) GEN_RBH_BQ(Node);
 169         GEN_RBH_BQ(Node) = (W_) CurrentTSO;
 170         break;
 171     default:
 172         fflush(stdout);
 173         fprintf(stderr, "Panic: non-{SPEC,GEN} RBH %#lx (IP %#lx)\n", Node, InfoPtr);
 174         EXIT(EXIT_FAILURE);
 175     }
 176
 177     LivenessReg = LIVENESS_R1;
 178     SaveAllStgRegs();
 179     TSO_PC1(CurrentTSO) = EnterNodeCode;
 180
 181     if (DO_QP_PROF) {
 182         QP_Event1("GR", CurrentTSO);
 183     }
 184
 185     if(do_gr_profile) {
 186         /* Note that CURRENT_TIME may perform an unsafe call */
 187         TIME now = CURRENT_TIME;
 188         TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO);
 189         TSO_BLOCKCOUNT(CurrentTSO)++;
 190         TSO_QUEUE(CurrentTSO) = Q_BLOCKED;
 191         TSO_BLOCKEDAT(CurrentTSO) = now;
 192         DumpGranEvent(GR_BLOCK, CurrentTSO);
 193     }
 194
 195 #if defined(GRAN)
 196     ReSchedule(NEW_THREAD);
 197 #else
 198     ReSchedule(0);
 199 #endif
 200
 201     FE_
 202 }
 203
 204 #endif
 205
 206 \end{code}
 207
 208 %************************************************************************
 209 %*                                                                      *
 210 \subsection[thread-entrypoints]{Scheduler-Thread Interfaces}
 211 %*                                                                      *
 212 %************************************************************************
 213
 214 The normal way of entering a thread is through resumeThread, which
 215 short-circuits and indirections to the TSO and StkO, sets up STG registers,
 216 and jumps to the saved PC.
 217
 218 \begin{code}
 219
 220 STGFUN(resumeThread)
 221 {
 222     FB_
 223
 224     while((P_) INFO_PTR(CurrentTSO) == Ind_info) {
 225         CurrentTSO = (P_) IND_CLOSURE_PTR(CurrentTSO);
 226     }
 227
 228 #ifdef PAR
 229     if (do_gr_profile) {
 230         TSO_QUEUE(CurrentTSO) = Q_RUNNING;
 231         /* Note that CURRENT_TIME may perform an unsafe call */
 232         TSO_BLOCKEDAT(CurrentTSO) = CURRENT_TIME;
 233     }
 234 #endif
 235
 236     CurrentRegTable = TSO_INTERNAL_PTR(CurrentTSO);
 237
 238     while((P_) INFO_PTR(SAVE_StkO) == Ind_info) {
 239         SAVE_StkO = (P_) IND_CLOSURE_PTR(SAVE_StkO);
 240     }
 241     RestoreAllStgRegs();
 242
 243     SET_TASK_ACTIVITY(ST_REDUCING);
 244     SET_ACTIVITY(ACT_REDN); /* back to normal reduction */
 245     RESTORE_CCC(TSO_CCC(CurrentTSO));
 246     JMP_(TSO_PC1(CurrentTSO));
 247     FE_
 248 }
 249
 250 \end{code}
 251
 252 Since we normally context switch during a heap check, it is possible
 253 that we will return to a previously suspended thread without
 254 sufficient heap for the thread to continue.  However, we have cleverly
 255 stashed away the heap requirements in @TSO_ARG1@ so that we can decide
 256 whether or not to perform a garbage collection before resuming the
 257 thread.  The actual thread resumption address (either @EnterNodeCode@
 258 or elsewhere) is stashed in TSO_PC2.
 259
 260 \begin{code}
 261
 262 STGFUN(CheckHeapCode)
 263 {
 264     FB_
 265
 266     ALLOC_HEAP(TSO_ARG1(CurrentTSO)); /* ticky profiling */
 267     SET_ACTIVITY(ACT_HEAP_CHK); /* SPAT counting */
 268     if ((Hp += TSO_ARG1(CurrentTSO)) > HpLim) {
 269         ReallyPerformThreadGC(TSO_ARG1(CurrentTSO), rtsFalse);
 270         JMP_(resumeThread);
 271     }
 272     SET_TASK_ACTIVITY(ST_REDUCING);
 273     SET_ACTIVITY(ACT_REDN); /* back to normal reduction */
 274     RESUME_(TSO_PC2(CurrentTSO));
 275     FE_
 276 }
 277
 278 \end{code}
 279
 280 Often, a thread starts (or rather, resumes) by entering the closure
 281 that Node points to.  Here's a tiny code fragment to do just that.
 282 The saved PC in the TSO can be set to @EnterNodeCode@ whenever we
 283 want this to happen upon resumption of the thread.
 284
 285 \begin{code}
 286
 287 STGFUN(EnterNodeCode)
 288 {
 289     FB_
 290     ENT_VIA_NODE();
 291     InfoPtr=(D_)(INFO_PTR(Node));
 292     GRAN_EXEC(5,1,2,0,0);
 293     JMP_(ENTRY_CODE(InfoPtr));
 294     FE_
 295 }
 296
 297 \end{code}
 298
 299 Then, there are the occasions when we just want to pick up where we left off.
 300 We use RESUME_ here instead of JMP_, because when we return to a call site,
 301 the alpha is going to try to load %gp from %ra rather than %pv, and JMP_ only
 302 sets %pv.  Resuming to the start of a function is currently okay, but an
 303 extremely bad practice.  As we add support for more architectures, we can expect
 304 the difference between RESUME_ and JMP_ to become more acute.
 305
 306 \begin{code}
 307
 308 STGFUN(Continue)
 309 {
 310     FB_
 311
 312     SET_TASK_ACTIVITY(ST_REDUCING);
 313     SET_ACTIVITY(ACT_REDN); /* back to normal reduction */
 314     RESUME_(TSO_PC2(CurrentTSO));
 315     FE_
 316 }
 317
 318 \end{code}
 319
 320 %************************************************************************
 321 %*                                                                      *
 322 \subsection[stack-chunk-underflow-code]{Underflow code for stack chunks}
 323 %*                                                                      *
 324 %************************************************************************
 325
 326 \begin{code}
 327
 328 extern P_ AvailableStack;
 329
 330 #ifndef PAR
 331
 332 \end{code}
 333
 334 On a uniprocessor, stack underflow causes us no great headaches.  The
 335 old value of RetReg is squirreled away at the base of the top stack
 336 object (the one that's about to get blown away).  We just yank it
 337 outta there and perform the same kind of return that got us here in
 338 the first place.
 339
 340 This simplicity is due to the fact that we never have to fetch a stack
 341 object on underflow.
 342
 343 \begin{code}
 344
 345 #define DO_RETURN_TEMPLATE(label, cont)         \
 346     STGFUN(label)                               \
 347     {                                           \
 348       P_ temp;                                  \
 349       FB_                                       \
 350       temp = STKO_LINK(StkOReg);                \
 351       RetReg = STKO_RETURN(StkOReg);            \
 352       StkOReg = temp;                           \
 353       RestoreStackStgRegs();                    \
 354       JMP_(cont);                               \
 355       FE_                                       \
 356     }
 357
 358 DO_RETURN_TEMPLATE(UnderflowDirectReturn, DIRECT(((P_)RetReg)))
 359 DO_RETURN_TEMPLATE(UnderflowVect0, ((P_)RetReg)[RVREL(0)])
 360 DO_RETURN_TEMPLATE(UnderflowVect1, ((P_)RetReg)[RVREL(1)])
 361 DO_RETURN_TEMPLATE(UnderflowVect2, ((P_)RetReg)[RVREL(2)])
 362 DO_RETURN_TEMPLATE(UnderflowVect3, ((P_)RetReg)[RVREL(3)])
 363 DO_RETURN_TEMPLATE(UnderflowVect4, ((P_)RetReg)[RVREL(4)])
 364
 365 DO_RETURN_TEMPLATE(UnderflowVect5, ((P_)RetReg)[RVREL(5)])
 366 DO_RETURN_TEMPLATE(UnderflowVect6, ((P_)RetReg)[RVREL(6)])
 367 DO_RETURN_TEMPLATE(UnderflowVect7, ((P_)RetReg)[RVREL(7)])
 368
 369 DO_RETURN_TEMPLATE(StackUnderflowEnterNode, EnterNodeCode)
 370
 371 #else
 372
 373 \end{code}
 374
 375 In the parallel world, we may have to fetch the StkO from a remote
 376 location before we can load up the stack registers and perform the
 377 return.  Our convention is that we load RetReg up with the exact
 378 continuation address (after a vector table lookup, if necessary),
 379 and tail-call the code to fetch the stack object.  (Of course, if
 380 the stack object is already local, we then just jump to the
 381 continuation address.)
 382
 383 \begin{code}
 384
 385 STGFUN(CommonUnderflow)
 386 {
 387     P_ temp;
 388
 389     FB_
 390     temp = STKO_LINK(StkOReg);
 391     StkOReg = temp;
 392     /* ToDo: Fetch the remote stack object here! */
 393     RestoreStackStgRegs();
 394     JMP_(RetReg);
 395     FE_
 396 }
 397
 398 #define DO_RETURN_TEMPLATE(label, cont)         \
 399     STGFUN(label)                               \
 400     {                                           \
 401       FB_                                       \
 402       RetReg = STKO_RETURN(StkOReg);            \
 403       RetReg = (StgRetAddr)(cont);              \
 404       LivenessReg = INFO_LIVENESS(InfoPtr);     \
 405       JMP_(CommonUnderflow);                    \
 406       FE_                                       \
 407     }
 408
 409 DO_RETURN_TEMPLATE(UnderflowDirectReturn, DIRECT(((P_)RetReg)))
 410 DO_RETURN_TEMPLATE(UnderflowVect0, ((P_)RetReg)[RVREL(0)])
 411 DO_RETURN_TEMPLATE(UnderflowVect1, ((P_)RetReg)[RVREL(1)])
 412 DO_RETURN_TEMPLATE(UnderflowVect2, ((P_)RetReg)[RVREL(2)])
 413 DO_RETURN_TEMPLATE(UnderflowVect3, ((P_)RetReg)[RVREL(3)])
 414 DO_RETURN_TEMPLATE(UnderflowVect4, ((P_)RetReg)[RVREL(4)])
 415 DO_RETURN_TEMPLATE(UnderflowVect5, ((P_)RetReg)[RVREL(5)])
 416 DO_RETURN_TEMPLATE(UnderflowVect6, ((P_)RetReg)[RVREL(6)])
 417 DO_RETURN_TEMPLATE(UnderflowVect7, ((P_)RetReg)[RVREL(7)])
 418
 419 STGFUN(PrimUnderflow)
 420 {
 421     FB_
 422     RetReg = STKO_RETURN(StkOReg);
 423     RetReg = (StgRetAddr)DIRECT(((P_)RetReg));
 424     LivenessReg = NO_LIVENESS;
 425     JMP_(CommonUnderflow);
 426     FE_
 427 }
 428
 429 /*
 430  * This one is similar, but isn't part of the return vector.  It's only used
 431  * when we fall off of a stack chunk and want to enter Node rather than
 432  * returning through RetReg.  (This occurs during UpdatePAP, when the updatee
 433  * isn't on the current stack chunk.)  It can't be done with the template,
 434  * because R2 is dead, and R1 points to a PAP.  Only R1 is live.
 435  */
 436
 437 STGFUN(StackUnderflowEnterNode)
 438 {
 439     FB_
 440     RetReg = (StgRetAddr)(EnterNodeCode);
 441     LivenessReg = LIVENESS_R1;
 442     JMP_(CommonUnderflow);
 443     FE_
 444 }
 445
 446 #endif
 447
 448 const W_
 449 vtbl_Underflow[] = {
 450     /* "MAX_VECTORED_RTN" elements (see GhcConstants.lh) */
 451     (W_) UnderflowVect0,
 452     (W_) UnderflowVect1,
 453     (W_) UnderflowVect2,
 454     (W_) UnderflowVect3,
 455     (W_) UnderflowVect4,
 456     (W_) UnderflowVect5,
 457     (W_) UnderflowVect6,
 458     (W_) UnderflowVect7
 459 };
 460
 461 \end{code}
 462
 463 \begin{code}
 464
 465 IFN_(seqDirectReturn) {
 466     void *cont;
 467
 468     FB_
 469     RetReg = (StgRetAddr) SpB[BREL(0)];
 470     cont = (void *) SpB[BREL(1)];
 471     SpB += BREL(2);
 472 /*  GRAN_EXEC(1,1,2,0,0); /? ToDo: RE-CHECK (WDP) */
 473     JMP_(cont);
 474     FE_
 475 }
 476
 477 /*
 478    NB: For direct returns to work properly, the name of the routine must be
 479    the same as the name of the vector table with vtbl_ removed and DirectReturn
 480    appended.  This is all the mangler understands.
 481  */
 482
 483 const W_
 484 vtbl_seq[] = {
 485     (W_) seqDirectReturn,
 486     (W_) seqDirectReturn,
 487     (W_) seqDirectReturn,
 488     (W_) seqDirectReturn,
 489     (W_) seqDirectReturn,
 490     (W_) seqDirectReturn,
 491     (W_) seqDirectReturn,
 492     (W_) seqDirectReturn
 493 };
 494
 495 #endif /* CONCURRENT */
 496 \end{code}