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     /* Before overwriting TSO_LINK */
 101     STGCALL3(void,(),GranSimBlock,CurrentTSO,CurrentProc,Node);
 102 #endif
 103
 104     TSO_LINK(CurrentTSO) = (P_) BQ_ENTRIES(Node);
 105     BQ_ENTRIES(Node) = (W_) CurrentTSO;
 106
 107     LivenessReg = LIVENESS_R1;
 108     SaveAllStgRegs();
 109     TSO_PC1(CurrentTSO) = EnterNodeCode;
 110
 111     if (DO_QP_PROF) {
 112         QP_Event1("GR", CurrentTSO);
 113     }
 114 #ifdef PAR
 115     if(RTSflags.ParFlags.granSimStats) {
 116         /* Note that CURRENT_TIME may perform an unsafe call */
 117         TIME now = CURRENT_TIME;
 118         TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO);
 119         TSO_BLOCKCOUNT(CurrentTSO)++;
 120         TSO_QUEUE(CurrentTSO) = Q_BLOCKED;
 121         TSO_BLOCKEDAT(CurrentTSO) = now;
 122         DumpGranEvent(GR_BLOCK, CurrentTSO);
 123     }
 124 #endif
 125 #if defined(GRAN)
 126     ReSchedule(SAME_THREAD); /* NB: GranSimBlock activated next thread */
 127 #else
 128     ReSchedule(0);
 129 #endif
 130     FE_
 131 }
 132
 133 BQ_ITBL();
 134
 135 \end{code}
 136
 137 Revertible black holes are needed in the parallel world, to handle
 138 negative acknowledgements of messages containing updatable closures.
 139 The idea is that when the original message is transmitted, the closure
 140 is turned into a revertible black hole...an object which acts like a
 141 black hole when local threads try to enter it, but which can be
 142 reverted back to the original closure if necessary.
 143
 144 It's actually a lot like a blocking queue (BQ) entry, because
 145 revertible black holes are initially set up with an empty blocking
 146 queue.
 147
 148 The combination of GrAnSim with revertible black holes has not been
 149 checked, yet. -- HWL
 150
 151 \begin{code}
 152
 153 #if defined(PAR) || defined(GRAN)
 154
 155 STGFUN(RBH_entry)
 156 {
 157     FB_
 158
 159 #  if defined(GRAN)
 160     /* Before overwriting TSO_LINK */
 161     STGCALL3(void,(),GranSimBlock,CurrentTSO,CurrentProc,Node);
 162 #  endif
 163
 164     switch (INFO_TYPE(InfoPtr)) {
 165     case INFO_SPEC_RBH_TYPE:
 166         TSO_LINK(CurrentTSO) = (P_) SPEC_RBH_BQ(Node);
 167         SPEC_RBH_BQ(Node) = (W_) CurrentTSO;
 168         break;
 169     case INFO_GEN_RBH_TYPE:
 170         TSO_LINK(CurrentTSO) = (P_) GEN_RBH_BQ(Node);
 171         GEN_RBH_BQ(Node) = (W_) CurrentTSO;
 172         break;
 173     default:
 174         fflush(stdout);
 175         fprintf(stderr, "Panic: non-{SPEC,GEN} RBH %#lx (IP %#lx)\n", Node, InfoPtr);
 176         EXIT(EXIT_FAILURE);
 177     }
 178
 179     LivenessReg = LIVENESS_R1;
 180     SaveAllStgRegs();
 181     TSO_PC1(CurrentTSO) = EnterNodeCode;
 182
 183     if (DO_QP_PROF) {
 184         QP_Event1("GR", CurrentTSO);
 185     }
 186
 187 #  ifdef PAR
 188     if(RTSflags.ParFlags.granSimStats) {
 189         /* Note that CURRENT_TIME may perform an unsafe call */
 190         TIME now = CURRENT_TIME;
 191         TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO);
 192         TSO_BLOCKCOUNT(CurrentTSO)++;
 193         TSO_QUEUE(CurrentTSO) = Q_BLOCKED;
 194         TSO_BLOCKEDAT(CurrentTSO) = now;
 195         DumpGranEvent(GR_BLOCK, CurrentTSO);
 196     }
 197 #  endif
 198 #  if defined(GRAN)
 199     ReSchedule(SAME_THREAD);  /* NB: GranSimBlock activated next thread */
 200 #  else
 201     ReSchedule(0);
 202 #  endif
 203
 204     FE_
 205 }
 206
 207 #endif
 208
 209 \end{code}
 210
 211 %************************************************************************
 212 %*                                                                      *
 213 \subsection[thread-entrypoints]{Scheduler-Thread Interfaces}
 214 %*                                                                      *
 215 %************************************************************************
 216
 217 The normal way of entering a thread is through \tr{resumeThread},
 218 which short-circuits any indirections to the TSO and StkO, sets up STG
 219 registers, and jumps to the saved PC.
 220
 221 \begin{code}
 222 STGFUN(resumeThread)
 223 {
 224     FB_
 225
 226     while(IS_INDIRECTION(INFO_PTR(CurrentTSO))) {
 227         CurrentTSO = (P_) IND_CLOSURE_PTR(CurrentTSO);
 228     }
 229
 230 #ifdef PAR
 231     if (RTSflags.ParFlags.granSimStats) {
 232         TSO_QUEUE(CurrentTSO) = Q_RUNNING;
 233         /* Note that CURRENT_TIME may perform an unsafe call */
 234         TSO_BLOCKEDAT(CurrentTSO) = CURRENT_TIME;
 235     }
 236 #endif
 237
 238     CurrentRegTable = TSO_INTERNAL_PTR(CurrentTSO);
 239
 240     while(IS_INDIRECTION(INFO_PTR(SAVE_StkO))) {
 241         SAVE_StkO = (P_) IND_CLOSURE_PTR(SAVE_StkO);
 242     }
 243     RestoreAllStgRegs();
 244
 245     SET_TASK_ACTIVITY(ST_REDUCING);
 246     RESTORE_CCC(TSO_CCC(CurrentTSO));
 247     JMP_(TSO_PC1(CurrentTSO));
 248     FE_
 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 STGFUN(CheckHeapCode)
 262 {
 263     FB_
 264
 265     ALLOC_HEAP(TSO_ARG1(CurrentTSO)); /* ticky profiling */
 266     if ((Hp += TSO_ARG1(CurrentTSO)) > HpLim) {
 267         ReallyPerformThreadGC(TSO_ARG1(CurrentTSO), rtsFalse);
 268         JMP_(resumeThread);
 269     }
 270     SET_TASK_ACTIVITY(ST_REDUCING);
 271     RESUME_(TSO_PC2(CurrentTSO));
 272     FE_
 273 }
 274 \end{code}
 275
 276 Often, a thread starts (or rather, resumes) by entering the closure
 277 that Node points to.  Here's a tiny code fragment to do just that.
 278 The saved PC in the TSO can be set to @EnterNodeCode@ whenever we
 279 want this to happen upon resumption of the thread.
 280
 281 \begin{code}
 282 STGFUN(EnterNodeCode)
 283 {
 284     FB_
 285     ENT_VIA_NODE();
 286     InfoPtr=(D_)(INFO_PTR(Node));
 287     JMP_(ENTRY_CODE(InfoPtr));
 288     FE_
 289 }
 290 \end{code}
 291
 292 Then, there are the occasions when we just want to pick up where we
 293 left off.  We use \tr{RESUME_} here instead of \tr{JMP_}, because when
 294 we return to a call site, the Alpha is going to try to load \tr{%gp}
 295 from \tr{%ra} rather than \tr{%pv}, and \tr{JMP_} only sets \tr{%pv}.
 296 Resuming to the start of a function is currently okay, but an
 297 extremely bad practice.  As we add support for more architectures, we
 298 can expect the difference between \tr{RESUME_} and \tr{JMP_} to become
 299 more acute.
 300
 301 \begin{code}
 302 STGFUN(Continue)
 303 {
 304     FB_
 305
 306     SET_TASK_ACTIVITY(ST_REDUCING);
 307     RESUME_(TSO_PC2(CurrentTSO));
 308     FE_
 309 }
 310 \end{code}
 311
 312 %************************************************************************
 313 %*                                                                      *
 314 \subsection[stack-chunk-underflow-code]{Underflow code for stack chunks}
 315 %*                                                                      *
 316 %************************************************************************
 317
 318 \begin{code}
 319 #ifndef PAR
 320 \end{code}
 321
 322 On a uniprocessor, stack underflow causes us no great headaches.  The
 323 old value of RetReg is squirreled away at the base of the top stack
 324 object (the one that's about to get blown away).  We just yank it
 325 outta there and perform the same kind of return that got us here in
 326 the first place.
 327
 328 This simplicity is due to the fact that we never have to fetch a stack
 329 object on underflow.
 330
 331 \begin{code}
 332
 333 #define DO_RETURN_TEMPLATE(label, cont)         \
 334     STGFUN(label)                               \
 335     {                                           \
 336       P_ temp;                                  \
 337       FB_                                       \
 338       temp = STKO_LINK(StkOReg);                \
 339       RetReg = STKO_RETURN(StkOReg);            \
 340       StkOReg = temp;                           \
 341       RestoreStackStgRegs();                    \
 342       JMP_(cont);                               \
 343       FE_                                       \
 344     }
 345
 346 DO_RETURN_TEMPLATE(UnderflowDirectReturn, DIRECT(((P_)RetReg)))
 347 DO_RETURN_TEMPLATE(UnderflowVect0, ((P_)RetReg)[RVREL(0)])
 348 DO_RETURN_TEMPLATE(UnderflowVect1, ((P_)RetReg)[RVREL(1)])
 349 DO_RETURN_TEMPLATE(UnderflowVect2, ((P_)RetReg)[RVREL(2)])
 350 DO_RETURN_TEMPLATE(UnderflowVect3, ((P_)RetReg)[RVREL(3)])
 351 DO_RETURN_TEMPLATE(UnderflowVect4, ((P_)RetReg)[RVREL(4)])
 352
 353 DO_RETURN_TEMPLATE(UnderflowVect5, ((P_)RetReg)[RVREL(5)])
 354 DO_RETURN_TEMPLATE(UnderflowVect6, ((P_)RetReg)[RVREL(6)])
 355 DO_RETURN_TEMPLATE(UnderflowVect7, ((P_)RetReg)[RVREL(7)])
 356
 357 DO_RETURN_TEMPLATE(StackUnderflowEnterNode, EnterNodeCode)
 358
 359 #else /* PAR */
 360
 361 \end{code}
 362
 363 In the parallel world, we may have to fetch the StkO from a remote
 364 location before we can load up the stack registers and perform the
 365 return.  Our convention is that we load RetReg up with the exact
 366 continuation address (after a vector table lookup, if necessary),
 367 and tail-call the code to fetch the stack object.  (Of course, if
 368 the stack object is already local, we then just jump to the
 369 continuation address.)
 370
 371 \begin{code}
 372
 373 STGFUN(CommonUnderflow)
 374 {
 375     P_ temp;
 376
 377     FB_
 378     temp = STKO_LINK(StkOReg);
 379
 380     /* fprintf(stderr,"Stk Underflow from: %lx to: %lx size abandoned: %d\n",StkOReg,temp,STKO_CLOSURE_CTS_SIZE(StkOReg)); */
 381
 382     /* change the guy we are abandoning into something
 383        that will not be "interesting" on the mutables
 384        list.  (As long as it is there, it will be
 385        scavenged in GC, and we cannot guarantee that
 386        it is still a "sane" StkO object).  (And, besides,
 387        why continue to keep it [and all it pts to] alive?)
 388        Will & Phil 95/10
 389     */
 390     FREEZE_MUT_HDR(StkOReg, ImMutArrayOfPtrs_info);
 391     MUTUPLE_CLOSURE_SIZE(StkOReg) = MUTUPLE_VHS;
 392
 393     StkOReg = temp;
 394     /* ToDo: Fetch the remote stack object here! */
 395     RestoreStackStgRegs();
 396     JMP_(RetReg);
 397     FE_
 398 }
 399
 400 #define DO_RETURN_TEMPLATE(label, cont)         \
 401     STGFUN(label)                               \
 402     {                                           \
 403       FB_                                       \
 404       RetReg = STKO_RETURN(StkOReg);            \
 405       RetReg = (StgRetAddr)(cont);              \
 406       LivenessReg = INFO_LIVENESS(InfoPtr);     \
 407       JMP_(CommonUnderflow);                    \
 408       FE_                                       \
 409     }
 410
 411 DO_RETURN_TEMPLATE(UnderflowDirectReturn, DIRECT(((P_)RetReg)))
 412 DO_RETURN_TEMPLATE(UnderflowVect0, ((P_)RetReg)[RVREL(0)])
 413 DO_RETURN_TEMPLATE(UnderflowVect1, ((P_)RetReg)[RVREL(1)])
 414 DO_RETURN_TEMPLATE(UnderflowVect2, ((P_)RetReg)[RVREL(2)])
 415 DO_RETURN_TEMPLATE(UnderflowVect3, ((P_)RetReg)[RVREL(3)])
 416 DO_RETURN_TEMPLATE(UnderflowVect4, ((P_)RetReg)[RVREL(4)])
 417 DO_RETURN_TEMPLATE(UnderflowVect5, ((P_)RetReg)[RVREL(5)])
 418 DO_RETURN_TEMPLATE(UnderflowVect6, ((P_)RetReg)[RVREL(6)])
 419 DO_RETURN_TEMPLATE(UnderflowVect7, ((P_)RetReg)[RVREL(7)])
 420
 421 STGFUN(PrimUnderflow)
 422 {
 423     FB_
 424     RetReg = STKO_RETURN(StkOReg);
 425     RetReg = (StgRetAddr)DIRECT(((P_)RetReg));
 426     LivenessReg = NO_LIVENESS;
 427     JMP_(CommonUnderflow);
 428     FE_
 429 }
 430
 431 /*
 432  * This one is similar, but isn't part of the return vector.  It's only used
 433  * when we fall off of a stack chunk and want to enter Node rather than
 434  * returning through RetReg.  (This occurs during UpdatePAP, when the updatee
 435  * isn't on the current stack chunk.)  It can't be done with the template,
 436  * because R2 is dead, and R1 points to a PAP.  Only R1 is live.
 437  */
 438
 439 #if 0
 440
 441 /* old version of the code */
 442 STGFUN(StackUnderflowEnterNode)
 443 {
 444     FB_
 445     RetReg = (StgRetAddr)(EnterNodeCode);
 446     LivenessReg = LIVENESS_R1;
 447     JMP_(CommonUnderflow);
 448     FE_
 449 }
 450
 451 #else
 452
 453 /*
 454    We've inlined CommonUnderFlow because setting RetReg would zap
 455    the return vector that the node needs.
 456    We pick up the RetReg from the STkO header instead.
 457    KH/HWL 14/2/97
 458 */
 459
 460 STGFUN(StackUnderflowEnterNode)
 461 {
 462     P_ temp;
 463     FB_
 464     RetReg = STKO_RETURN(StkOReg); /* pick up return code from the StkO hdr
 465                                       needed because we come from UpdatePAP */
 466     LivenessReg = LIVENESS_R1;
 467
 468     temp = STKO_LINK(StkOReg);
 469
 470     /*? fprintf(stderr,"Stk Underflow from: %lx to: %lx size abandoned: %d\n",StkOReg,temp,STKO_CLOSURE_CTS_SIZE(StkOReg)); ?*/
 471
 472     /* change the guy we are abandoning into something
 473        that will not be "interesting" on the mutables
 474        list.  (As long as it is there, it will be
 475        scavenged in GC, and we cannot guarantee that
 476        it is still a "sane" StkO object).  (And, besides,
 477        why continue to keep it [and all it pts to] alive?)
 478        Will & Phil 95/10
 479     */
 480     FREEZE_MUT_HDR(StkOReg, ImMutArrayOfPtrs_info);
 481     MUTUPLE_CLOSURE_SIZE(StkOReg) = MUTUPLE_VHS;
 482
 483     StkOReg = temp;
 484     /* ToDo: Fetch the remote stack object here! */
 485     RestoreStackStgRegs();
 486     JMP_(EnterNodeCode);  /* this will enter a PAP containing the old stkos
 487                              A and B stacks */
 488     FE_
 489 }
 490 #endif
 491
 492
 493 #endif /* !PAR */
 494
 495 const W_
 496 vtbl_Underflow[] = {
 497     /* "MAX_VECTORED_RTN" elements (see GhcConstants.lh) */
 498     (W_) UnderflowVect0,
 499     (W_) UnderflowVect1,
 500     (W_) UnderflowVect2,
 501     (W_) UnderflowVect3,
 502     (W_) UnderflowVect4,
 503     (W_) UnderflowVect5,
 504     (W_) UnderflowVect6,
 505     (W_) UnderflowVect7
 506 };
 507
 508 #endif /* CONCURRENT */
 509 \end{code}