[project @ 1997-11-20 16:51:04 by simonm]
[ghc-hetmet.git] / ghc / includes / Threads.lh
1 %
2 % (c) The GRASP Project, Glasgow University, 1994-1995
3 %
4 \section[Thread]{Thread support macros used in \tr{.hc} files}
5
6 \begin{code}
7 #ifndef THREADS_H
8 #define THREADS_H
9 \end{code}
10
11 \begin{code}
12 #if defined(GRAN)
13
14 #define sparkq sparkq 
15 #define TYPE_OF_SPARK    struct spark
16 #define TYPE_OF_SPARK_PTR sparkq
17 #define SIZE_OF_SPARK    (sizeof(TYPE_OF_SPARK))
18
19 typedef struct spark
20 {
21   struct spark *prev, *next;
22   P_ node;
23   I_ name, global;
24   I_ gran_info;
25 } *sparkq;
26
27 #endif 
28
29 #ifndef CONCURRENT
30
31 #define OR_CONTEXT_SWITCH
32
33 #else
34
35 extern I_ do_gr_sim;                            /* Are we simulating granularity? */
36 extern FILE *gr_file;
37
38 extern I_ do_qp_prof;                           /* Are we quasi-parallel profiling? */
39 extern FILE *qp_file;
40
41 #ifdef PAR
42 #define DO_QP_PROF 0
43 #else
44 #define DO_QP_PROF do_qp_prof
45 #endif
46
47 extern I_ context_switch;                       /* Flag set by signal handler */
48 #if defined(i386_TARGET_ARCH)
49 extern I_ entersFromC;                          /* Counter set by enterStablePtr
50                                                    (see comments in c-as-asm/StablePtrOps.lc) */
51 #endif
52
53 #define CS_MAX_FREQUENCY 100                    /* context switches per second */
54 #define CS_MIN_MILLISECS (1000/CS_MAX_FREQUENCY)/* milliseconds per slice */
55
56 #ifdef __STG_GCC_REGS__
57 # if defined(i386_TARGET_ARCH)
58 # define OR_CONTEXT_SWITCH || (context_switch && !entersFromC)
59 # else
60 # define OR_CONTEXT_SWITCH || context_switch
61 # endif
62 #else
63 #define OR_CONTEXT_SWITCH /* in miniInterpret */
64 #endif
65
66 #define REQUIRED_POOL   0
67 #define ADVISORY_POOL   1
68 #define SPARK_POOLS     2
69
70 #if !defined(GRAN) 
71
72 #define TYPE_OF_SPARK    PP_
73 #define SIZE_OF_SPARK    (sizeof(TYPE_OF_SPARK))
74
75 extern TYPE_OF_SPARK PendingSparksBase[SPARK_POOLS], 
76                      PendingSparksLim[SPARK_POOLS];
77 extern TYPE_OF_SPARK PendingSparksHd[SPARK_POOLS], 
78                      PendingSparksTl[SPARK_POOLS];
79
80 extern I_ SparkLimit[SPARK_POOLS];
81
82 extern P_ RunnableThreadsHd, RunnableThreadsTl;
83 extern P_ WaitingThreadsHd, WaitingThreadsTl;
84
85 extern I_ sparksIgnored;
86
87 IF_RTS(extern void AwaitEvent(I_);)
88
89 #else /* GRAN */
90
91 extern TYPE_OF_SPARK_PTR PendingSparksBase[][SPARK_POOLS], 
92                          PendingSparksLim[][SPARK_POOLS];
93 extern TYPE_OF_SPARK_PTR PendingSparksHd[][SPARK_POOLS], 
94                          PendingSparksTl[][SPARK_POOLS];
95 extern P_ RunnableThreadsHd[], RunnableThreadsTl[],
96           WaitThreadsHd[], WaitThreadsTl[];
97
98 #define SparkQueueHd    PendingSparksHd[CurrentProc][ADVISORY_POOL]
99 #define SparkQueueTl    PendingSparksTl[CurrentProc][ADVISORY_POOL]
100 #define ThreadQueueHd   RunnableThreadsHd[CurrentProc]
101 #define ThreadQueueTl   RunnableThreadsTl[CurrentProc]
102 #define WaitingThreadsHd  WaitThreadsHd[CurrentProc]
103 #define WaitingThreadsTl  WaitThreadsTl[CurrentProc]
104
105 #endif  /* GRAN */
106
107 IF_RTS(extern void PruneSparks(STG_NO_ARGS);)
108
109 #if defined(GRAN)
110
111 /* Codes that can be used as params for ReSchedule */
112 /* I distinguish them from the values 0/1 in the -UGRAN setup for security */
113 /* reasons */
114 #define FIND_THREAD     10
115 #define SAME_THREAD     11
116 #define NEW_THREAD      SAME_THREAD
117 #define CHANGE_THREAD   13
118 #define END_OF_WORLD    14
119
120 extern W_ SparksAvail, SurplusThreads;
121
122 extern W_ CurrentTime[];
123 extern I_ OutstandingFetches[], OutstandingFishes[];
124 extern enum proc_status procStatus[];
125
126 #  if defined(GRAN_CHECK) && defined(GRAN) /* Just for testing */
127 # define FETCH_MASK_TSO  0x08000000      /* only bits 0, 1, 2 should be used */
128                                         /* normally */
129 extern P_ BlockedOnFetch[];
130 #  endif
131
132 #endif     /* GRAN */
133
134 extern P_ CurrentTSO;                    /* thread state object now in use */
135
136 extern P_ AvailableStack;
137 extern P_ AvailableTSO;
138
139 extern I_ threadId;
140
141 void ScheduleThreads PROTO((P_ topClosure));
142
143 #if defined(GRAN)
144 void ReSchedule PROTO((int what_next)) STG_NORETURN;
145 void add_to_spark_queue PROTO((sparkq));
146 int set_sparkname PROTO((P_, int));
147 int reset_sparkname PROTO((P_)); 
148 I_ spark_queue_len PROTO((PROC, I_));
149 sparkq delete_from_spark_queue PROTO((sparkq, sparkq));
150 I_ thread_queue_len PROTO((PROC));
151 void DisposeSparkQ PROTO((sparkq));
152
153 #else /* !GRAN */
154
155 void ReSchedule PROTO((int again)) STG_NORETURN;
156
157 #endif
158
159 void EndThread(STG_NO_ARGS) STG_NORETURN;
160
161 /* ToDo: Check if these are still needed -- HWL */
162 void QP_Event0 PROTO((I_, P_));
163 void QP_Event1 PROTO((char *, P_));
164 void QP_Event2 PROTO((char *, P_, P_));
165 long qp_elapsed_time(STG_NO_ARGS);
166 \end{code}
167
168 %************************************************************************
169 %*                                                                      *
170 \subsection[thread-heap-objs]{Special threads-only heap objects (`closures')}
171 %*                                                                      *
172 %************************************************************************
173
174 %************************************************************************
175 %*                                                                      *
176 \subsubsection[TSO-closures]{@TSO@ (thread state object) heap objects}
177 %*                                                                      *
178 %************************************************************************
179
180 We now enter the realm of the Deeply Magical.
181
182 Reduction threads come and go, resume and suspend, etc., in the threaded
183 world.  Obviously, there must be a place to squirrel away state information
184 when a thread is suspended.  Hence these {\em thread state objects} (TSOs).
185
186 Rather than manage TSOs' alloc/dealloc, etc., in some {\em ad hoc} way, we
187 instead alloc/dealloc/etc them in the heap; then we can use all the
188 standard garbage-collection/fetching/flushing/etc machinery on them.
189 So that's why TSOs are ``heap objects,'' albeit very special ones.
190
191 We use all the standard heap-object/closure jargon... (e.g.,
192 @SET_TSO_HDR@, fixed headers, variable-hdr size, ...).
193
194 A TSO is a fixed-size object with (post-header) words arranged like
195 the main register table, and enough slop so that the register table
196 can be properly aligned.  The last header word of the TSO is
197 a pointer to the (internal) start of the interesting data.
198
199 Note that the heap and stack pointers in the TSO are only valid while
200 the thread is executing, and only if the corresponding values are not
201 stored in machine registers (i.e. the TSO becomes the backing register
202 table for those values).
203
204 \begin{code}
205 #define TSO_INFO_WORDS 10
206
207 #ifdef TICKY_TICKY
208 #define TSO_REDN_WORDS 2
209 #else
210 #define TSO_REDN_WORDS 0
211 #endif
212
213 #if defined(GRAN) || defined(PAR)
214            /* do we really need a whole statistics buffer in PAR setup? HWL*/
215 #define TSO_GRAN_WORDS 17
216 #else
217 #define TSO_GRAN_WORDS 0
218 #endif
219
220 #define TSO_VHS \
221         (GC_MUT_RESERVED_WORDS + TSO_INFO_WORDS + TSO_REDN_WORDS + TSO_GRAN_WORDS)
222
223 #define TSO_HS          (FIXED_HS + TSO_VHS)
224 #define TSO_CTS_SIZE    (BYTES_TO_STGWORDS(sizeof(STGRegisterTable) + sizeof(StgDouble)))
225
226 #define TSO_PTRS        (MAX_VANILLA_REG + 2)
227
228 /* std start-filling-in macro: */
229 #define SET_TSO_HDR(closure,infolbl,cc)         \
230 { SET_FIXED_HDR(closure,infolbl,cc);            \
231   SET_MUT_RESERVED_WORDS(closure);              \
232 }
233
234 #define TSO_INFO_START          (FIXED_HS + GC_MUT_RESERVED_WORDS)
235 #define TSO_LINK_LOCN           (TSO_INFO_START + 0)
236 #define TSO_CCC_LOCN            (TSO_INFO_START + 1)
237 #define TSO_NAME_LOCN           (TSO_INFO_START + 2)
238 #define TSO_ID_LOCN             (TSO_INFO_START + 3)
239 #define TSO_TYPE_LOCN           (TSO_INFO_START + 4)
240 #define TSO_PC1_LOCN            (TSO_INFO_START + 5)
241 #define TSO_PC2_LOCN            (TSO_INFO_START + 6)
242 #define TSO_ARG1_LOCN           (TSO_INFO_START + 7)
243 #define TSO_EVENT_LOCN          (TSO_INFO_START + 8)
244 #define TSO_SWITCH_LOCN         (TSO_INFO_START + 9)
245
246 #define TSO_REDN_START          (TSO_INFO_START + TSO_INFO_WORDS)
247 #ifdef TICKY_TICKY
248 #define TSO_AHWM_LOCN           (TSO_REDN_START + 0)
249 #define TSO_BHWM_LOCN           (TSO_REDN_START + 1)
250 #endif
251
252 #define TSO_GRAN_START          (TSO_REDN_START + TSO_REDN_WORDS)
253 #if defined(GRAN) || defined(PAR)
254 #define TSO_LOCKED_LOCN         (TSO_GRAN_START + 0)
255 #define TSO_SPARKNAME_LOCN      (TSO_GRAN_START + 1)
256 #define TSO_STARTEDAT_LOCN      (TSO_GRAN_START + 2)
257 #define TSO_EXPORTED_LOCN       (TSO_GRAN_START + 3)
258 #define TSO_BASICBLOCKS_LOCN    (TSO_GRAN_START + 4)
259 #define TSO_ALLOCS_LOCN         (TSO_GRAN_START + 5)
260 #define TSO_EXECTIME_LOCN       (TSO_GRAN_START + 6)
261 #define TSO_FETCHTIME_LOCN      (TSO_GRAN_START + 7)
262 #define TSO_FETCHCOUNT_LOCN     (TSO_GRAN_START + 8)
263 #define TSO_BLOCKTIME_LOCN      (TSO_GRAN_START + 9)
264 #define TSO_BLOCKCOUNT_LOCN     (TSO_GRAN_START + 10)
265 #define TSO_BLOCKEDAT_LOCN      (TSO_GRAN_START + 11)
266 #define TSO_GLOBALSPARKS_LOCN   (TSO_GRAN_START + 12)
267 #define TSO_LOCALSPARKS_LOCN    (TSO_GRAN_START + 13)
268 #define TSO_QUEUE_LOCN          (TSO_GRAN_START + 14)
269 #define TSO_PRI_LOCN            (TSO_GRAN_START + 15)
270 #define TSO_CLOCK_LOCN          (TSO_GRAN_START + 16)
271 #endif
272
273 #define TSO_LINK(closure)           (((PP_)closure)[TSO_LINK_LOCN])
274 #define TSO_CCC(closure)            (((CostCentre *)closure)[TSO_CCC_LOCN])
275 #define TSO_NAME(closure)           (((PP_)closure)[TSO_NAME_LOCN])
276 #define TSO_ID(closure)             (((P_)closure)[TSO_ID_LOCN])
277 #define TSO_TYPE(closure)           (((P_)closure)[TSO_TYPE_LOCN])
278 #define TSO_PC1(closure)            (((FP_)closure)[TSO_PC1_LOCN])
279 #define TSO_PC2(closure)            (((FP_)closure)[TSO_PC2_LOCN])
280 #define TSO_ARG1(closure)           (((P_)closure)[TSO_ARG1_LOCN])
281 #define TSO_EVENT(closure)          (((P_)closure)[TSO_EVENT_LOCN])
282 #define TSO_SWITCH(closure)         (((FP_)closure)[TSO_SWITCH_LOCN])
283
284 #define TSO_AHWM(closure)           (((I_ *)closure)[TSO_AHWM_LOCN])
285 #define TSO_BHWM(closure)           (((I_ *)closure)[TSO_BHWM_LOCN])
286
287 #define TSO_LOCKED(closure)         (((P_)closure)[TSO_LOCKED_LOCN])
288 #define TSO_SPARKNAME(closure)      (((P_)closure)[TSO_SPARKNAME_LOCN])
289 #define TSO_STARTEDAT(closure)      (((P_)closure)[TSO_STARTEDAT_LOCN])
290 #define TSO_EXPORTED(closure)       (((P_)closure)[TSO_EXPORTED_LOCN])
291 #define TSO_BASICBLOCKS(closure)    (((P_)closure)[TSO_BASICBLOCKS_LOCN])
292 #define TSO_ALLOCS(closure)         (((P_)closure)[TSO_ALLOCS_LOCN])
293 #define TSO_EXECTIME(closure)       (((P_)closure)[TSO_EXECTIME_LOCN])
294 #define TSO_FETCHTIME(closure)      (((P_)closure)[TSO_FETCHTIME_LOCN])
295 #define TSO_FETCHCOUNT(closure)     (((P_)closure)[TSO_FETCHCOUNT_LOCN])
296 #define TSO_BLOCKTIME(closure)      (((P_)closure)[TSO_BLOCKTIME_LOCN])
297 #define TSO_BLOCKCOUNT(closure)     (((P_)closure)[TSO_BLOCKCOUNT_LOCN])
298 #define TSO_BLOCKEDAT(closure)      (((P_)closure)[TSO_BLOCKEDAT_LOCN])
299 #define TSO_GLOBALSPARKS(closure)   (((P_)closure)[TSO_GLOBALSPARKS_LOCN])
300 #define TSO_LOCALSPARKS(closure)    (((P_)closure)[TSO_LOCALSPARKS_LOCN])
301 #define TSO_QUEUE(closure)          (((P_)closure)[TSO_QUEUE_LOCN])
302 #define TSO_PRI(closure)            (((P_)closure)[TSO_PRI_LOCN])
303 /* TSO_CLOCK is only needed in GrAnSim-Light */
304 #define TSO_CLOCK(closure)          (((P_)closure)[TSO_CLOCK_LOCN])
305
306 #define TSO_INTERNAL_PTR(closure)           \
307   ((STGRegisterTable *)(((W_)(((P_)closure) \
308     + TSO_HS + BYTES_TO_STGWORDS(sizeof(StgDouble)))) & ~(sizeof(StgDouble) - 1)))
309
310 #if defined(CONCURRENT) && defined(GRAN)        /* HWL */
311 /* Per definitionem a tso is really awake if it has met a first */
312 /* GRAN_RESCHEDULE macro after having been rescheduled. */
313 #define REALLY_AWAKE(tso)       (TSO_SWITCH(tso) != TSO_PC2(tso))
314 #define SET_AWAKE_FLAG(tso)     TSO_SWITCH(tso) = NULL
315 #define RESET_AWAKE_FLAG(tso)   TSO_SWITCH(tso) = TSO_PC2(tso)
316 #endif
317
318 \end{code}
319
320 The types of threads (TSO_TYPE):
321 \begin{code}
322 #define T_MAIN                  0       /* Must be executed locally */
323 #define T_REQUIRED              1       /* A required thread  -- may be exported */
324 #define T_ADVISORY              2       /* An advisory thread -- may be exported */
325 #define T_FAIL                  3       /* A failure thread   -- may be exported */
326 \end{code}
327
328 The total space required to start a new thread (See NewThread in
329 Threads.lc):
330 \begin{code}
331 #define THREAD_SPACE_REQUIRED (TSO_HS + TSO_CTS_SIZE + STKO_HS + RTSflags.ConcFlags.stkChunkSize)
332 \end{code}
333
334 Here are the various queues for GrAnSim-type events.
335 \begin{code}
336 #define Q_RUNNING   'G'
337 #define Q_RUNNABLE  'A'
338 #define Q_BLOCKED   'R'
339 #define Q_FETCHING  'Y'
340 #define Q_MIGRATING 'B'
341 \end{code}
342
343 %************************************************************************
344 %*                                                                      *
345 \subsubsection[spark-closures]{Pending Sparks}
346 %*                                                                      *
347 %************************************************************************
348
349 \begin{code}
350 #ifdef PAR
351
352 P_ FindLocalSpark PROTO((rtsBool forexport));
353
354 void DisposeSpark PROTO((P_ spark));
355 rtsBool Spark PROTO((P_ closure, rtsBool required));
356
357 #endif /*PAR*/
358
359 #ifdef GRAN   /* For GrAnSim sparks are currently mallocated -- HWL */
360
361 void DisposeSpark PROTO((sparkq spark));
362 sparkq NewSpark PROTO((P_,I_,I_,I_,I_,I_));
363
364 /* # define MAX_EVENTS          1000 */  /* For GC Roots Purposes */
365 # define MAX_SPARKS             0        /* i.e. infinite */
366
367 #if defined(GRAN_JSM_SPARKS)
368 /* spark is a pointer into some sparkq (which is for JSM sparls just an 
369    array of (struct sparks) */
370
371 # define SPARK_PREV(spark)      { fprintf(stderr,"Error: SPARK_PREV not supported for JSM sparks") \
372                                   EXIT(EXIT_FAILURE); }
373 /* NB: SPARK_NEXT may only be used as a rhs but NOT as a lhs */
374 # define SPARK_NEXT(spark)      (spark++)
375 # define SPARK_NODE(spark)      (P_)(spark->node)
376 # define SPARK_NAME(spark)      (spark->name)
377 # define SPARK_GRAN_INFO(spark) (spark->gran_info)
378 # define SPARK_GLOBAL(spark)    (spark->global)
379 # define SPARK_EXPORTED(spark)  (SPARK_GLOBAL(spark) > 1)
380 #else
381 # define SPARK_PREV(spark)      (spark->prev)
382 # define SPARK_NEXT(spark)      (sparkq)(spark->next)
383 # define SPARK_NODE(spark)      (spark->node)
384 # define SPARK_NAME(spark)      (spark->name)
385 # define SPARK_GRAN_INFO(spark) (spark->gran_info)
386 # define SPARK_GLOBAL(spark)    (spark->global)
387 # define SPARK_EXPORTED(spark)  (SPARK_GLOBAL(spark) > 1)
388 #endif
389
390 #endif      /* GRAN */
391 \end{code}
392
393 %************************************************************************
394 %*                                                                      *
395 \subsubsection[STKO-closures]{@STKO@ (stack object) heap objects}
396 %*                                                                      *
397 %************************************************************************
398
399 We linger in the Deeply Magical...
400
401 Each reduction thread has to have its own stack space.  As there may
402 be many such threads, and as any given one may need quite a big stack,
403 a naive give-'em-a-big-stack-and-let-'em-run approach will cost a {\em
404 lot} of memory.
405
406 Our approach is to give a thread a small stack space, and then link
407 on/off extra ``chunks'' as the need arises.  Again, this is a
408 storage-management problem, and, yet again, we choose to graft the
409 whole business onto the existing heap-management machinery.  So stack
410 objects will live in the heap, be garbage collected, etc., etc..
411
412 So, as with TSOs, we use the standard heap-object (`closure') jargon.
413
414 Here is the picture of how a stack object is arranged:
415 \begin{verbatim}
416     <-----  var hdr -------->                    v ---- FirstPtr --- v
417 ---------------------------------------------------------------------
418 ...|| SpB | SuB | SpA | SuA || B stk -> ... | ... <- A stk || PREV ||
419 ---------------------------------------------------------------------
420                               XX->                     <-YY 
421 \end{verbatim}
422
423 We keep the following state-of-stack info in the {\em variable-header}
424 part of a STKO:
425 \begin{tabular}{ll}
426 SpB, SuB & their {\em offsets} from 1st non-hdr word (marked \tr{XX} above)\\
427 SpA, SuA & their {\em offsets} from the next-to-last word (marked \tr{YY} above)\\
428 ctr field??? & (GC\_GEN\_WHATNOT may serve instead)\\
429 \end{tabular}
430
431 The stack-pointer offsets are from the points indicated and are {\em
432 non-negative} for pointers to this chunk of the stack space.
433
434 At the {\em end} of the stack object, we have a {\em link} to the
435 previous part of the overall stack.  The link is \tr{NULL} if this is
436 the bottom of the overall stack.
437
438 After the header, we have @STKO_CHUNK_SIZE-1@ words of actual stack
439 stuff.  The B-stack part begins at the lowest address and grows
440 upwards; the A-stack parts begins at the highest address and grows
441 downwards.
442
443 From a storage-manager point of view, these are {\em very special}
444 objects.
445
446 \begin{code}
447 #ifdef TICKY_TICKY
448 #define STKO_VHS        (GC_MUT_RESERVED_WORDS + 9)
449 #else
450 #define STKO_VHS        (GC_MUT_RESERVED_WORDS + 7)
451 #endif
452 #define STKO_HS         (FIXED_HS + STKO_VHS)
453
454 #define MIN_STKO_CHUNK_SIZE 16  /* Rather arbitrary */
455
456 #define STKO_CLOSURE_SIZE(closure)      STKO_SIZE(closure)
457
458 #define STKO_CLOSURE_CTS_SIZE(closure)  (STKO_CLOSURE_SIZE(closure) - STKO_VHS)
459 #define STKO_CLOSURE_PTR(closure, no)   (*STKO_CLOSURE_ADDR(closure, no))
460
461 #define STKO_CLOSURE_ADDR(s, n)     (((P_)(s)) + STKO_HS + (n) - 1)
462 #define STKO_CLOSURE_OFFSET(s, p)   (((P_)(p) - (P_)(s)) - STKO_HS + 1)
463
464 /* std start-filling-in macro: */
465 #define SET_STKO_HDR(s,infolbl,cc)      \
466         { SET_FIXED_HDR(s,infolbl,cc);  \
467           SET_MUT_RESERVED_WORDS(s);    \
468           /* the other header words filled in some other way */ }
469
470 /* now we have the STKO-specific stuff 
471
472    Note: The S[pu][AB] registers are put in this order so that
473          they will appear in monotonically increasing order in
474          the StkO...just as an aid to the poor wee soul who has
475          to debug things.
476  */
477
478 #ifdef TICKY_TICKY
479 #define STKO_ADEP_LOCN      (STKO_HS - 9)
480 #define STKO_BDEP_LOCN      (STKO_HS - 8)
481 #endif
482 #define STKO_SIZE_LOCN      (STKO_HS - 7)
483 #define STKO_RETURN_LOCN    (STKO_HS - 6)
484 #define STKO_LINK_LOCN      (STKO_HS - 5)
485 #define STKO_SuB_LOCN       (STKO_HS - 4)
486 #define STKO_SpB_LOCN       (STKO_HS - 3)
487 #define STKO_SpA_LOCN       (STKO_HS - 2)
488 #define STKO_SuA_LOCN       (STKO_HS - 1)
489
490 #define STKO_ADEP(s)        (((I_ *)(s))[STKO_ADEP_LOCN])
491 #define STKO_BDEP(s)        (((I_ *)(s))[STKO_BDEP_LOCN])
492 #define STKO_SIZE(s)        (((P_)(s))[STKO_SIZE_LOCN])
493 #define STKO_RETURN(s)      (((StgRetAddr *)(s))[STKO_RETURN_LOCN])
494 #define STKO_LINK(s)        (((PP_)(s))[STKO_LINK_LOCN])
495 #define STKO_SpB(s)         (((PP_)(s))[STKO_SpB_LOCN])
496 #define STKO_SuB(s)         (((PP_)(s))[STKO_SuB_LOCN])
497 #define STKO_SpA(s)         (((PP_ *)(s))[STKO_SpA_LOCN])
498 #define STKO_SuA(s)         (((PP_ *)(s))[STKO_SuA_LOCN])
499
500 #define STKO_BSTK_OFFSET(closure) (STKO_HS)
501 #define STKO_ASTK_OFFSET(closure) (FIXED_HS + STKO_CLOSURE_SIZE(closure) - 1)
502 #define STKO_BSTK_BOT(closure)    (((P_)(closure)) + STKO_BSTK_OFFSET(closure))
503 #define STKO_ASTK_BOT(closure)    (((PP_)(closure)) + STKO_ASTK_OFFSET(closure))
504 \end{code}
505
506 These are offsets into the stack object proper (starting at 1 for
507 the first word after the header).
508
509 \begin{code}
510 #define STKO_SpA_OFFSET(s)  (STKO_CLOSURE_OFFSET(s,STKO_SpA(s)))
511 #define STKO_SuA_OFFSET(s)  (STKO_CLOSURE_OFFSET(s,STKO_SuA(s)))
512 #define STKO_SpB_OFFSET(s)  (STKO_CLOSURE_OFFSET(s,STKO_SpB(s)))
513 #define STKO_SuB_OFFSET(s)  (STKO_CLOSURE_OFFSET(s,STKO_SuB(s)))
514 \end{code}
515
516 %************************************************************************
517 %*                                                                      *
518 \subsubsection[BQ-closures]{@BQ@ (blocking queue) heap objects (`closures')}
519 %*                                                                      *
520 %************************************************************************
521
522 Blocking queues are built in the parallel system when a local thread
523 enters a non-global node.  They are similar to black holes, except
524 that when they are updated, the blocking queue must be enlivened
525 too.  A blocking queue closure thus has the following structure.
526
527 \begin{onlylatex}
528 \begin{center}
529 \end{onlylatex}
530 \begin{tabular}{||l|l|l|l||}\hline
531 GA      &       Info ptr.       & $\ldots$              &       Blocking Queue  \\ \hline
532 \end{tabular}
533 \begin{onlylatex}
534 \begin{center}
535 \end{onlylatex}
536
537 The blocking queue itself is a pointer to a list of blocking queue entries.
538 The list is formed from TSO closures.  For the generational garbage collectors,
539 the BQ must have the same structure as an IND, with the blocking queue hanging
540 off of the indirection pointer.  (This has to do with treating the BQ as an old
541 root if it gets updated while in the old generation.)
542
543 \begin{code}
544 #define BQ_VHS                      IND_VHS
545 #define BQ_HS                       IND_HS
546
547 #define BQ_CLOSURE_SIZE(closure)    IND_CLOSURE_SIZE(closure)
548 #define BQ_CLOSURE_NoPTRS(closure)  IND_CLOSURE_NoPTRS(closure)
549 #define BQ_CLOSURE_NoNONPTRS(closure)   IND_CLOSURE_NoNONPTRS(closure)
550 #define BQ_CLOSURE_PTR(closure, no) (((P_)(closure))[BQ_HS + (no) - 1])
551 \end{code}
552
553 Blocking queues store a pointer to a list of blocking queue entries.
554
555 \begin{code}
556 #define BQ_ENTRIES(closure)         IND_CLOSURE_PTR(closure)
557 #define BQ_LINK(closure)            IND_CLOSURE_LINK(closure)
558 \end{code}
559
560 We have only one kind of blocking queue closure, so we test the info pointer
561 for a specific value rather than looking in the info table for a special bit.
562
563 \begin{code}
564 EXTDATA_RO(BQ_info);
565 EXTFUN(BQ_entry);
566 #define IS_BQ_CLOSURE(closure)     (INFO_PTR(closure) == (W_) BQ_info)
567 \end{code}
568
569 %************************************************************************
570 %*                                                                      *
571 \subsubsection[TSO_ITBL]{@TSO_ITBL@}
572 %*                                                                      *
573 %************************************************************************
574
575 The special info table used for thread state objects (TSOs).
576
577 \begin{code}
578
579 #define TSO_ITBL()                                  \
580     CAT_DECLARE(TSO,INTERNAL_KIND,"TSO","<TSO>")    \
581     EXTFUN(TSO_entry);                              \
582     EXTDATA_RO(MK_REP_LBL(TSO,,));                  \
583     const W_ TSO_info[] = {                         \
584         (W_) TSO_entry                              \
585         ,(W_) INFO_OTHER_TAG                        \
586         ,(W_) MK_REP_REF(TSO,,)                     \
587         INCLUDE_PROFILING_INFO(TSO)                 \
588         }
589
590 #define TSO_RTBL() \
591     const W_ MK_REP_LBL(TSO,,)[] = { \
592         INCLUDE_TYPE_INFO(TSO)                                  \
593         INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED)              \
594         INCLUDE_PAR_INFO                                        \
595         INCLUDE_COPYING_INFO(_Evacuate_TSO,_Scavenge_TSO)       \
596         INCLUDE_COMPACTING_INFO(_ScanLink_TSO,_PRStart_TSO,_ScanMove_TSO,_PRIn_TSO) \
597         }
598
599 \end{code}
600
601 %************************************************************************
602 %*                                                                      *
603 \subsubsection[STKO_ITBL]{@STKO_ITBL@}
604 %*                                                                      *
605 %************************************************************************
606
607 The special info table used for stack objects (STKOs).
608
609 \begin{code}
610 #define STKO_ITBL()                                     \
611     CAT_DECLARE(StkO,INTERNAL_KIND,"STKO","<STKO>")     \
612     EXTFUN(StkO_entry);                                 \
613     EXTDATA_RO(MK_REP_LBL(StkO,,));                     \
614     const W_ StkO_info[] = {                            \
615         (W_) StkO_entry                                 \
616         ,(W_) INFO_OTHER_TAG                            \
617         ,(W_) MK_REP_REF(StkO,,)                        \
618         INCLUDE_PROFILING_INFO(StkO)                    \
619     }
620
621 #define STKO_RTBL() \
622     const W_ MK_REP_LBL(StkO,,)[] = { \
623         INCLUDE_TYPE_INFO(STKO_DYNAMIC)                         \
624         INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED)              \
625         INCLUDE_PAR_INFO                                        \
626         INCLUDE_COPYING_INFO(_Evacuate_StkO,_Scavenge_StkO)     \
627         INCLUDE_COMPACTING_INFO(_ScanLink_StkO,_PRStart_StkO,_ScanMove_StkO,_PRIn_StkO) \
628     }
629
630 #define STKO_STATIC_ITBL()                              \
631     CAT_DECLARE(StkO_static,INTERNAL_KIND,"STKO","<STKO>")      \
632     EXTFUN(StkO_static_entry);                          \
633     EXTDATA_RO(MK_REP_LBL(StkO_static,,));              \
634     const W_ StkO_static_info[] = {                     \
635         (W_) StkO_static_entry                          \
636         ,(W_) INFO_OTHER_TAG                            \
637         ,(W_) MK_REP_REF(StkO_static,,)                 \
638         INCLUDE_PROFILING_INFO(StkO_static)             \
639     }
640
641 #define STKO_STATIC_RTBL() \
642     const W_ MK_REP_LBL(StkO_static,,)[] = { \
643         INCLUDE_TYPE_INFO(STKO_STATIC)                          \
644         INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED)              \
645         INCLUDE_PAR_INFO                                        \
646         INCLUDE_COPYING_INFO(_Evacuate_Static,_Dummy_Static_entry) \
647         INCLUDE_COMPACTING_INFO(_Dummy_Static_entry,_PRStart_Static, \
648                                 _Dummy_Static_entry,_PRIn_Error)    \
649     }
650
651 \end{code}
652
653 %************************************************************************
654 %*                                                                      *
655 \subsubsection[BQ_ITBL]{@BQ_ITBL@}
656 %*                                                                      *
657 %************************************************************************
658
659 Special info-table for local blocking queues.
660
661 \begin{code}
662 #define BQ_ITBL()                               \
663     CAT_DECLARE(BQ,INTERNAL_KIND,"BQ","<BQ>")   \
664     EXTFUN(BQ_entry);                           \
665     EXTDATA_RO(MK_REP_LBL(BQ,,));               \
666     const W_ BQ_info[] = {                      \
667         (W_) BQ_entry                           \
668         ,(W_) INFO_OTHER_TAG                    \
669         ,(W_) MK_REP_REF(BQ,,)                  \
670         INCLUDE_PROFILING_INFO(BQ)              \
671     }
672
673 #define BQ_RTBL() \
674     const W_ MK_REP_LBL(BQ,,)[] = {                             \
675         INCLUDE_TYPE_INFO(BQ)                                   \
676         INCLUDE_SIZE_INFO(MIN_UPD_SIZE,INFO_UNUSED)             \
677         INCLUDE_PAR_INFO                                        \
678         INCLUDE_COPYING_INFO(_Evacuate_BQ,_Scavenge_BQ)         \
679         SPEC_COMPACTING_INFO(_ScanLink_BQ,_PRStart_BQ,_ScanMove_BQ,_PRIn_BQ) \
680     }
681
682 \end{code}
683
684 \begin{code}
685 #endif  /* CONCURRENT */
686 \end{code}
687
688 Even the sequential system gets to play with SynchVars, though it really
689 doesn't make too much sense (if any).  Okay; maybe it makes some sense.
690 (See the 1.3 I/O stuff.)
691
692 %************************************************************************
693 %*                                                                      *
694 \subsubsection[SVar-closures]{@SynchVar@ heap objects}
695 %*                                                                      *
696 %************************************************************************
697
698 \begin{code}
699 #define SVAR_HS                     (MUTUPLE_HS)
700
701 #define SVAR_CLOSURE_SIZE(closure)  3
702
703 #define SET_SVAR_HDR(closure,infolbl,cc)   \
704     SET_MUTUPLE_HDR(closure,infolbl,cc,MUTUPLE_VHS+3,3)
705
706 /* The value must come first, because we shrink the other two fields off
707    when writing an IVar */
708
709 #define SVAR_VALUE_LOCN         (SVAR_HS+0)
710 #define SVAR_HEAD_LOCN          (SVAR_HS+1)
711 #define SVAR_TAIL_LOCN          (SVAR_HS+2)
712
713 #define SVAR_VALUE(closure)     ((PP_)(closure))[SVAR_VALUE_LOCN]
714 #define SVAR_HEAD(closure)      ((PP_)(closure))[SVAR_HEAD_LOCN]
715 #define SVAR_TAIL(closure)      ((PP_)(closure))[SVAR_TAIL_LOCN]
716 \end{code}
717
718 End multi-slurp protection:
719
720 \begin{code}
721 #endif  /* THREADS_H */
722 \end{code}
723
724