ab63382739db5125d8bdbba173788f43d6f3dcff
[ghc-hetmet.git] / 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(RTSflags.ParFlags.granSimStats) {
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(RTSflags.ParFlags.granSimStats) {
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 \tr{resumeThread},
215 which short-circuits any indirections to the TSO and StkO, sets up STG
216 registers, and jumps to the saved PC.
217
218 \begin{code}
219 STGFUN(resumeThread)
220 {
221     FB_
222
223     while(IS_INDIRECTION(INFO_PTR(CurrentTSO))) {
224         CurrentTSO = (P_) IND_CLOSURE_PTR(CurrentTSO);
225     }
226
227 #ifdef PAR
228     if (RTSflags.ParFlags.granSimStats) {
229         TSO_QUEUE(CurrentTSO) = Q_RUNNING;
230         /* Note that CURRENT_TIME may perform an unsafe call */
231         TSO_BLOCKEDAT(CurrentTSO) = CURRENT_TIME;
232     }
233 #endif
234
235     CurrentRegTable = TSO_INTERNAL_PTR(CurrentTSO);
236
237     while(IS_INDIRECTION(INFO_PTR(SAVE_StkO))) {
238         SAVE_StkO = (P_) IND_CLOSURE_PTR(SAVE_StkO);
239     }
240     RestoreAllStgRegs();
241
242     SET_TASK_ACTIVITY(ST_REDUCING);
243     RESTORE_CCC(TSO_CCC(CurrentTSO));
244     JMP_(TSO_PC1(CurrentTSO));
245     FE_
246 }
247 \end{code}
248
249 Since we normally context switch during a heap check, it is possible
250 that we will return to a previously suspended thread without
251 sufficient heap for the thread to continue.  However, we have cleverly
252 stashed away the heap requirements in @TSO_ARG1@ so that we can decide
253 whether or not to perform a garbage collection before resuming the
254 thread.  The actual thread resumption address (either @EnterNodeCode@
255 or elsewhere) is stashed in @TSO_PC2@.
256
257 \begin{code}
258 STGFUN(CheckHeapCode)
259 {
260     FB_
261
262     ALLOC_HEAP(TSO_ARG1(CurrentTSO)); /* ticky profiling */
263     if ((Hp += TSO_ARG1(CurrentTSO)) > HpLim) {
264         ReallyPerformThreadGC(TSO_ARG1(CurrentTSO), rtsFalse);
265         JMP_(resumeThread);
266     }
267     SET_TASK_ACTIVITY(ST_REDUCING);
268     RESUME_(TSO_PC2(CurrentTSO));
269     FE_
270 }
271 \end{code}
272
273 Often, a thread starts (or rather, resumes) by entering the closure
274 that Node points to.  Here's a tiny code fragment to do just that.
275 The saved PC in the TSO can be set to @EnterNodeCode@ whenever we
276 want this to happen upon resumption of the thread.
277
278 \begin{code}
279 STGFUN(EnterNodeCode)
280 {
281     FB_
282     ENT_VIA_NODE();
283     InfoPtr=(D_)(INFO_PTR(Node));
284     GRAN_EXEC(5,1,2,0,0);
285     JMP_(ENTRY_CODE(InfoPtr));
286     FE_
287 }
288 \end{code}
289
290 Then, there are the occasions when we just want to pick up where we
291 left off.  We use \tr{RESUME_} here instead of \tr{JMP_}, because when
292 we return to a call site, the Alpha is going to try to load \tr{%gp}
293 from \tr{%ra} rather than \tr{%pv}, and \tr{JMP_} only sets \tr{%pv}.
294 Resuming to the start of a function is currently okay, but an
295 extremely bad practice.  As we add support for more architectures, we
296 can expect the difference between \tr{RESUME_} and \tr{JMP_} to become
297 more acute.
298
299 \begin{code}
300 STGFUN(Continue)
301 {
302     FB_
303
304     SET_TASK_ACTIVITY(ST_REDUCING);
305     RESUME_(TSO_PC2(CurrentTSO));
306     FE_
307 }
308 \end{code}
309
310 %************************************************************************
311 %*                                                                      *
312 \subsection[stack-chunk-underflow-code]{Underflow code for stack chunks}
313 %*                                                                      *
314 %************************************************************************
315
316 \begin{code}
317 #ifndef PAR
318 \end{code}
319
320 On a uniprocessor, stack underflow causes us no great headaches.  The
321 old value of RetReg is squirreled away at the base of the top stack
322 object (the one that's about to get blown away).  We just yank it
323 outta there and perform the same kind of return that got us here in
324 the first place.
325
326 This simplicity is due to the fact that we never have to fetch a stack
327 object on underflow.
328
329 \begin{code}
330
331 #define DO_RETURN_TEMPLATE(label, cont)         \
332     STGFUN(label)                               \
333     {                                           \
334       P_ temp;                                  \
335       FB_                                       \
336       temp = STKO_LINK(StkOReg);                \
337       RetReg = STKO_RETURN(StkOReg);            \
338       StkOReg = temp;                           \
339       RestoreStackStgRegs();                    \
340       JMP_(cont);                               \
341       FE_                                       \
342     }
343
344 DO_RETURN_TEMPLATE(UnderflowDirectReturn, DIRECT(((P_)RetReg)))
345 DO_RETURN_TEMPLATE(UnderflowVect0, ((P_)RetReg)[RVREL(0)])
346 DO_RETURN_TEMPLATE(UnderflowVect1, ((P_)RetReg)[RVREL(1)])
347 DO_RETURN_TEMPLATE(UnderflowVect2, ((P_)RetReg)[RVREL(2)])
348 DO_RETURN_TEMPLATE(UnderflowVect3, ((P_)RetReg)[RVREL(3)])
349 DO_RETURN_TEMPLATE(UnderflowVect4, ((P_)RetReg)[RVREL(4)])
350
351 DO_RETURN_TEMPLATE(UnderflowVect5, ((P_)RetReg)[RVREL(5)])
352 DO_RETURN_TEMPLATE(UnderflowVect6, ((P_)RetReg)[RVREL(6)])
353 DO_RETURN_TEMPLATE(UnderflowVect7, ((P_)RetReg)[RVREL(7)])
354
355 DO_RETURN_TEMPLATE(StackUnderflowEnterNode, EnterNodeCode)
356
357 #else
358
359 \end{code}
360
361 In the parallel world, we may have to fetch the StkO from a remote
362 location before we can load up the stack registers and perform the
363 return.  Our convention is that we load RetReg up with the exact
364 continuation address (after a vector table lookup, if necessary),
365 and tail-call the code to fetch the stack object.  (Of course, if
366 the stack object is already local, we then just jump to the 
367 continuation address.)
368
369 \begin{code}
370
371 STGFUN(CommonUnderflow)
372 {
373     P_ temp;
374
375     FB_
376     temp = STKO_LINK(StkOReg);
377
378     /* fprintf(stderr,"Stk Underflow from: %lx to: %lx size abandoned: %d\n",StkOReg,temp,STKO_CLOSURE_CTS_SIZE(StkOReg)); */
379
380     /* change the guy we are abandoning into something
381        that will not be "interesting" on the mutables
382        list.  (As long as it is there, it will be
383        scavenged in GC, and we cannot guarantee that
384        it is still a "sane" StkO object).  (And, besides,
385        why continue to keep it [and all it pts to] alive?)
386        Will & Phil 95/10
387     */
388     FREEZE_MUT_HDR(StkOReg, ImMutArrayOfPtrs_info);
389     MUTUPLE_CLOSURE_SIZE(StkOReg) = MUTUPLE_VHS;
390
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}