Tag pointers in interpreted constructors
[ghc.git] / rts / StgMiscClosures.cmm
1 /* ----------------------------------------------------------------------------
2  *
3  * (c) The GHC Team, 1998-2004
4  *
5  * Entry code for various built-in closure types.
6  *
7  * This file is written in a subset of C--, extended with various
8  * features specific to GHC.  It is compiled by GHC directly.  For the
9  * syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
10  *
11  * --------------------------------------------------------------------------*/
12
13 #include "Cmm.h"
14
15 import pthread_mutex_lock;
16 import ghczmprim_GHCziTypes_Czh_static_info;
17 import ghczmprim_GHCziTypes_Izh_static_info;
18 import EnterCriticalSection;
19 import LeaveCriticalSection;
20
21 /* ----------------------------------------------------------------------------
22    Stack underflow
23    ------------------------------------------------------------------------- */
24
25 INFO_TABLE_RET (stg_stack_underflow_frame, UNDERFLOW_FRAME,
26                 W_ info_ptr, P_ unused)
27     /* no args => explicit stack */
28 {
29     W_ new_tso;
30     W_ ret_off;
31
32     SAVE_STGREGS
33
34     SAVE_THREAD_STATE();
35     (ret_off) = foreign "C" threadStackUnderflow(MyCapability() "ptr",
36                                                  CurrentTSO);
37     LOAD_THREAD_STATE();
38
39     RESTORE_STGREGS
40
41     jump %ENTRY_CODE(Sp(ret_off)) [*]; // NB. all registers live!
42 }
43
44 /* ----------------------------------------------------------------------------
45    Restore a saved cost centre
46    ------------------------------------------------------------------------- */
47
48 INFO_TABLE_RET (stg_restore_cccs, RET_SMALL, W_ info_ptr, W_ cccs)
49 {
50     unwind Sp = Sp + WDS(2);
51 #if defined(PROFILING)
52     CCCS = Sp(1);
53 #endif
54     Sp_adj(2);
55     jump %ENTRY_CODE(Sp(0)) [*]; // NB. all registers live!
56 }
57
58 /* ----------------------------------------------------------------------------
59    Support for the bytecode interpreter.
60    ------------------------------------------------------------------------- */
61
62 /* 7 bits of return code for constructors created by the interpreter. */
63 stg_interp_constr1_entry (P_ ret) { return (ret + 1); }
64 stg_interp_constr2_entry (P_ ret) { return (ret + 2); }
65 stg_interp_constr3_entry (P_ ret) { return (ret + 3); }
66 stg_interp_constr4_entry (P_ ret) { return (ret + 4); }
67 stg_interp_constr5_entry (P_ ret) { return (ret + 5); }
68 stg_interp_constr6_entry (P_ ret) { return (ret + 6); }
69 stg_interp_constr7_entry (P_ ret) { return (ret + 7); }
70
71 /* Some info tables to be used when compiled code returns a value to
72    the interpreter, i.e. the interpreter pushes one of these onto the
73    stack before entering a value.  What the code does is to
74    impedance-match the compiled return convention (in R1p/R1n/F1/D1 etc) to
75    the interpreter's convention (returned value is on top of stack),
76    and then cause the scheduler to enter the interpreter.
77
78    On entry, the stack (growing down) looks like this:
79
80       ptr to BCO holding return continuation
81       ptr to one of these info tables.
82
83    The info table code, both direct and vectored, must:
84       * push R1/F1/D1 on the stack, and its tag if necessary
85       * push the BCO (so it's now on the stack twice)
86       * Yield, ie, go to the scheduler.
87
88    Scheduler examines the t.o.s, discovers it is a BCO, and proceeds
89    directly to the bytecode interpreter.  That pops the top element
90    (the BCO, containing the return continuation), and interprets it.
91    Net result: return continuation gets interpreted, with the
92    following stack:
93
94       ptr to this BCO
95       ptr to the info table just jumped thru
96       return value
97
98    which is just what we want -- the "standard" return layout for the
99    interpreter.  Hurrah!
100
101    Don't ask me how unboxed tuple returns are supposed to work.  We
102    haven't got a good story about that yet.
103 */
104
105 INFO_TABLE_RET( stg_ctoi_R1p, RET_BCO)
106     /* explicit stack */
107 {
108     Sp_adj(-2);
109     Sp(1) = R1;
110     Sp(0) = stg_enter_info;
111     jump stg_yield_to_interpreter [];
112 }
113
114 /*
115  * When the returned value is a pointer, but unlifted, in R1 ...
116  */
117 INFO_TABLE_RET( stg_ctoi_R1unpt, RET_BCO )
118     /* explicit stack */
119 {
120     Sp_adj(-2);
121     Sp(1) = R1;
122     Sp(0) = stg_ret_p_info;
123     jump stg_yield_to_interpreter [];
124 }
125
126 /*
127  * When the returned value is a non-pointer in R1 ...
128  */
129 INFO_TABLE_RET( stg_ctoi_R1n, RET_BCO )
130     /* explicit stack */
131 {
132     Sp_adj(-2);
133     Sp(1) = R1;
134     Sp(0) = stg_ret_n_info;
135     jump stg_yield_to_interpreter [];
136 }
137
138 /*
139  * When the returned value is in F1
140  */
141 INFO_TABLE_RET( stg_ctoi_F1, RET_BCO )
142     /* explicit stack */
143 {
144     Sp_adj(-2);
145     F_[Sp + WDS(1)] = F1;
146     Sp(0) = stg_ret_f_info;
147     jump stg_yield_to_interpreter [];
148 }
149
150 /*
151  * When the returned value is in D1
152  */
153 INFO_TABLE_RET( stg_ctoi_D1, RET_BCO )
154     /* explicit stack */
155 {
156     Sp_adj(-1) - SIZEOF_DOUBLE;
157     D_[Sp + WDS(1)] = D1;
158     Sp(0) = stg_ret_d_info;
159     jump stg_yield_to_interpreter [];
160 }
161
162 /*
163  * When the returned value is in L1
164  */
165 INFO_TABLE_RET( stg_ctoi_L1, RET_BCO )
166     /* explicit stack */
167 {
168     Sp_adj(-1) - 8;
169     L_[Sp + WDS(1)] = L1;
170     Sp(0) = stg_ret_l_info;
171     jump stg_yield_to_interpreter [];
172 }
173
174 /*
175  * When the returned value is a void
176  */
177 INFO_TABLE_RET( stg_ctoi_V, RET_BCO )
178     /* explicit stack */
179 {
180     Sp_adj(-1);
181     Sp(0) = stg_ret_v_info;
182     jump stg_yield_to_interpreter [];
183 }
184
185 /*
186  * Dummy info table pushed on the top of the stack when the interpreter
187  * should apply the BCO on the stack to its arguments, also on the
188  * stack.
189  */
190 INFO_TABLE_RET( stg_apply_interp, RET_BCO )
191     /* explicit stack */
192 {
193     /* Just in case we end up in here... (we shouldn't) */
194     jump stg_yield_to_interpreter [];
195 }
196
197 /* ----------------------------------------------------------------------------
198    Entry code for a BCO
199    ------------------------------------------------------------------------- */
200
201 INFO_TABLE_FUN( stg_BCO, 4, 0, BCO, "BCO", "BCO", ARG_BCO )
202     /* explicit stack */
203 {
204   /* entering a BCO means "apply it", same as a function */
205   Sp_adj(-2);
206   // Skip the stack check; the interpreter will do one before using
207   // the stack anyway.
208   Sp(1) = R1;
209   Sp(0) = stg_apply_interp_info;
210   jump stg_yield_to_interpreter [];
211 }
212
213 /* ----------------------------------------------------------------------------
214    Info tables for indirections.
215
216    SPECIALISED INDIRECTIONS: we have a specialised indirection for direct returns,
217    so that we can avoid entering
218    the object when we know it points directly to a value.  The update
219    code (Updates.cmm) updates objects with the appropriate kind of
220    indirection.  We only do this for young-gen indirections.
221    ------------------------------------------------------------------------- */
222
223 INFO_TABLE(stg_IND,1,0,IND,"IND","IND")
224 #if 0
225 /*
226   This version in high-level cmm generates slightly less good code
227   than the low-level version below it. (ToDo)
228 */
229     (P_ node)
230 {
231     TICK_ENT_DYN_IND(); /* tick */
232     node = UNTAG(StgInd_indirectee(node));
233     TICK_ENT_VIA_NODE();
234     jump %GET_ENTRY(node) (node);
235 }
236 #else
237     /* explicit stack */
238 {
239     TICK_ENT_DYN_IND(); /* tick */
240     R1 = UNTAG(StgInd_indirectee(R1));
241     TICK_ENT_VIA_NODE();
242     jump %GET_ENTRY(R1) [R1];
243 }
244 #endif
245
246 INFO_TABLE(stg_IND_direct,1,0,IND,"IND","IND")
247     (P_ node)
248 {
249     TICK_ENT_DYN_IND(); /* tick */
250     node = StgInd_indirectee(node);
251     TICK_ENT_VIA_NODE();
252     jump %ENTRY_CODE(Sp(0)) (node);
253 }
254
255 INFO_TABLE(stg_IND_STATIC,1,0,IND_STATIC,"IND_STATIC","IND_STATIC")
256     /* explicit stack */
257 {
258     TICK_ENT_STATIC_IND(); /* tick */
259     R1 = UNTAG(StgInd_indirectee(R1));
260     TICK_ENT_VIA_NODE();
261     jump %GET_ENTRY(R1) [R1];
262 }
263
264 INFO_TABLE(stg_IND_PERM,1,0,IND_PERM,"IND_PERM","IND_PERM")
265     /* explicit stack */
266 {
267     /* Don't add INDs to granularity cost */
268
269     /* Don't: TICK_ENT_STATIC_IND(Node); for ticky-ticky; this ind is
270        here only to help profiling */
271
272 #if defined(TICKY_TICKY) && !defined(PROFILING)
273     /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than
274        being extra  */
275     TICK_ENT_PERM_IND();
276 #endif
277
278     LDV_ENTER(R1);
279
280     /* For ticky-ticky, change the perm_ind to a normal ind on first
281      * entry, so the number of ent_perm_inds is the number of *thunks*
282      * entered again, not the number of subsequent entries.
283      *
284      * Since this screws up cost centres, we die if profiling and
285      * ticky_ticky are on at the same time.  KSW 1999-01.
286      */
287 #ifdef TICKY_TICKY
288 #  ifdef PROFILING
289 #    error Profiling and ticky-ticky do not mix at present!
290 #  endif  /* PROFILING */
291     StgHeader_info(R1) = stg_IND_info;
292 #endif /* TICKY_TICKY */
293
294     R1 = UNTAG(StgInd_indirectee(R1));
295
296 #if defined(TICKY_TICKY) && !defined(PROFILING)
297     TICK_ENT_VIA_NODE();
298 #endif
299
300     jump %GET_ENTRY(R1) [R1];
301 }
302
303 /* ----------------------------------------------------------------------------
304    Black holes.
305
306    Entering a black hole normally causes a cyclic data dependency, but
307    in the concurrent world, black holes are synchronization points,
308    and they are turned into blocking queues when there are threads
309    waiting for the evaluation of the closure to finish.
310    ------------------------------------------------------------------------- */
311
312 INFO_TABLE(stg_BLACKHOLE,1,0,BLACKHOLE,"BLACKHOLE","BLACKHOLE")
313     (P_ node)
314 {
315     W_ r, info, owner, bd;
316     P_ p, bq, msg;
317
318     TICK_ENT_DYN_IND(); /* tick */
319
320 retry:
321     p = StgInd_indirectee(node);
322     if (GETTAG(p) != 0) {
323         return (p);
324     }
325
326     info = StgHeader_info(p);
327     if (info == stg_IND_info) {
328         // This could happen, if e.g. we got a BLOCKING_QUEUE that has
329         // just been replaced with an IND by another thread in
330         // wakeBlockingQueue().
331         goto retry;
332     }
333
334     if (info == stg_TSO_info ||
335         info == stg_BLOCKING_QUEUE_CLEAN_info ||
336         info == stg_BLOCKING_QUEUE_DIRTY_info)
337     {
338         ("ptr" msg) = ccall allocate(MyCapability() "ptr",
339                                      BYTES_TO_WDS(SIZEOF_MessageBlackHole));
340
341         SET_HDR(msg, stg_MSG_BLACKHOLE_info, CCS_SYSTEM);
342         MessageBlackHole_tso(msg) = CurrentTSO;
343         MessageBlackHole_bh(msg) = node;
344
345         (r) = ccall messageBlackHole(MyCapability() "ptr", msg "ptr");
346
347         if (r == 0) {
348             goto retry;
349         } else {
350             StgTSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16;
351             StgTSO_block_info(CurrentTSO) = msg;
352             jump stg_block_blackhole(node);
353         }
354     }
355     else
356     {
357         ENTER(p);
358     }
359 }
360
361 // CAF_BLACKHOLE is allocated when entering a CAF.  The reason it is
362 // distinct from BLACKHOLE is so that we can tell the difference
363 // between an update frame on the stack that points to a CAF under
364 // evaluation, and one that points to a closure that is under
365 // evaluation by another thread (a BLACKHOLE).  see Note [suspend
366 // duplicate work] in ThreadPaused.c
367 //
368 INFO_TABLE(stg_CAF_BLACKHOLE,1,0,BLACKHOLE,"BLACKHOLE","BLACKHOLE")
369     (P_ node)
370 {
371     jump ENTRY_LBL(stg_BLACKHOLE) (node);
372 }
373
374 // EAGER_BLACKHOLE exists for the same reason as CAF_BLACKHOLE (see above).
375 INFO_TABLE(__stg_EAGER_BLACKHOLE,1,0,BLACKHOLE,"BLACKHOLE","BLACKHOLE")
376     (P_ node)
377 {
378     jump ENTRY_LBL(stg_BLACKHOLE) (node);
379 }
380
381 INFO_TABLE(stg_BLOCKING_QUEUE_CLEAN,4,0,BLOCKING_QUEUE,"BLOCKING_QUEUE","BLOCKING_QUEUE")
382 { foreign "C" barf("BLOCKING_QUEUE_CLEAN object entered!") never returns; }
383
384
385 INFO_TABLE(stg_BLOCKING_QUEUE_DIRTY,4,0,BLOCKING_QUEUE,"BLOCKING_QUEUE","BLOCKING_QUEUE")
386 { foreign "C" barf("BLOCKING_QUEUE_DIRTY object entered!") never returns; }
387
388
389 /* ----------------------------------------------------------------------------
390    Whiteholes are used for the "locked" state of a closure (see lockClosure())
391    ------------------------------------------------------------------------- */
392
393 INFO_TABLE(stg_WHITEHOLE, 0,0, WHITEHOLE, "WHITEHOLE", "WHITEHOLE")
394     (P_ node)
395 {
396 #if defined(THREADED_RTS)
397     W_ info, i;
398
399     i = 0;
400 loop:
401     // spin until the WHITEHOLE is updated
402     info = StgHeader_info(node);
403     if (info == stg_WHITEHOLE_info) {
404         i = i + 1;
405         if (i == SPIN_COUNT) {
406             i = 0;
407             ccall yieldThread();
408         }
409         goto loop;
410     }
411     jump %ENTRY_CODE(info) (node);
412 #else
413     ccall barf("WHITEHOLE object entered!") never returns;
414 #endif
415 }
416
417 /* ----------------------------------------------------------------------------
418    Some static info tables for things that don't get entered, and
419    therefore don't need entry code (i.e. boxed but unpointed objects)
420    NON_ENTERABLE_ENTRY_CODE now defined at the beginning of the file
421    ------------------------------------------------------------------------- */
422
423 INFO_TABLE(stg_TSO, 0,0,TSO, "TSO", "TSO")
424 { foreign "C" barf("TSO object entered!") never returns; }
425
426 INFO_TABLE(stg_STACK, 0,0, STACK, "STACK", "STACK")
427 { foreign "C" barf("STACK object entered!") never returns; }
428
429 /* ----------------------------------------------------------------------------
430    Weak pointers
431
432    Live weak pointers have a special closure type.  Dead ones are just
433    nullary constructors (although they live on the heap - we overwrite
434    live weak pointers with dead ones).
435    ------------------------------------------------------------------------- */
436
437 INFO_TABLE(stg_WEAK,1,4,WEAK,"WEAK","WEAK")
438 { foreign "C" barf("WEAK object entered!") never returns; }
439
440 /*
441  * It's important when turning an existing WEAK into a DEAD_WEAK
442  * (which is what finalizeWeak# does) that we don't lose the link
443  * field and break the linked list of weak pointers.  Hence, we give
444  * DEAD_WEAK 5 non-pointer fields.
445  */
446 INFO_TABLE_CONSTR(stg_DEAD_WEAK,0,5,0,CONSTR,"DEAD_WEAK","DEAD_WEAK")
447 { foreign "C" barf("DEAD_WEAK object entered!") never returns; }
448
449 /* ----------------------------------------------------------------------------
450    C finalizer lists
451
452    Singly linked lists that chain multiple C finalizers on a weak pointer.
453    ------------------------------------------------------------------------- */
454
455 INFO_TABLE_CONSTR(stg_C_FINALIZER_LIST,1,4,0,CONSTR,"C_FINALIZER_LIST","C_FINALIZER_LIST")
456 { foreign "C" barf("C_FINALIZER_LIST object entered!") never returns; }
457
458 /* ----------------------------------------------------------------------------
459    NO_FINALIZER
460
461    This is a static nullary constructor (like []) that we use to mark an empty
462    finalizer in a weak pointer object.
463    ------------------------------------------------------------------------- */
464
465 INFO_TABLE_CONSTR(stg_NO_FINALIZER,0,0,0,CONSTR_NOCAF_STATIC,"NO_FINALIZER","NO_FINALIZER")
466 { foreign "C" barf("NO_FINALIZER object entered!") never returns; }
467
468 CLOSURE(stg_NO_FINALIZER_closure,stg_NO_FINALIZER);
469
470 /* ----------------------------------------------------------------------------
471    Stable Names are unlifted too.
472    ------------------------------------------------------------------------- */
473
474 INFO_TABLE(stg_STABLE_NAME,0,1,PRIM,"STABLE_NAME","STABLE_NAME")
475 { foreign "C" barf("STABLE_NAME object entered!") never returns; }
476
477 /* ----------------------------------------------------------------------------
478    MVars
479
480    There are two kinds of these: full and empty.  We need an info table
481    and entry code for each type.
482    ------------------------------------------------------------------------- */
483
484 INFO_TABLE(stg_MVAR_CLEAN,3,0,MVAR_CLEAN,"MVAR","MVAR")
485 { foreign "C" barf("MVAR object entered!") never returns; }
486
487 INFO_TABLE(stg_MVAR_DIRTY,3,0,MVAR_DIRTY,"MVAR","MVAR")
488 { foreign "C" barf("MVAR object entered!") never returns; }
489
490 /* -----------------------------------------------------------------------------
491    STM
492    -------------------------------------------------------------------------- */
493
494 INFO_TABLE(stg_TVAR_CLEAN, 2, 1, TVAR, "TVAR", "TVAR")
495 { foreign "C" barf("TVAR_CLEAN object entered!") never returns; }
496
497 INFO_TABLE(stg_TVAR_DIRTY, 2, 1, TVAR, "TVAR", "TVAR")
498 { foreign "C" barf("TVAR_DIRTY object entered!") never returns; }
499
500 INFO_TABLE(stg_TVAR_WATCH_QUEUE, 3, 0, MUT_PRIM, "TVAR_WATCH_QUEUE", "TVAR_WATCH_QUEUE")
501 { foreign "C" barf("TVAR_WATCH_QUEUE object entered!") never returns; }
502
503 INFO_TABLE(stg_ATOMIC_INVARIANT, 2, 1, MUT_PRIM, "ATOMIC_INVARIANT", "ATOMIC_INVARIANT")
504 { foreign "C" barf("ATOMIC_INVARIANT object entered!") never returns; }
505
506 INFO_TABLE(stg_INVARIANT_CHECK_QUEUE, 3, 0, MUT_PRIM, "INVARIANT_CHECK_QUEUE", "INVARIANT_CHECK_QUEUE")
507 { foreign "C" barf("INVARIANT_CHECK_QUEUE object entered!") never returns; }
508
509 INFO_TABLE(stg_TREC_CHUNK, 0, 0, TREC_CHUNK, "TREC_CHUNK", "TREC_CHUNK")
510 { foreign "C" barf("TREC_CHUNK object entered!") never returns; }
511
512 INFO_TABLE(stg_TREC_HEADER, 3, 1, MUT_PRIM, "TREC_HEADER", "TREC_HEADER")
513 { foreign "C" barf("TREC_HEADER object entered!") never returns; }
514
515 INFO_TABLE_CONSTR(stg_END_STM_WATCH_QUEUE,0,0,0,CONSTR_NOCAF_STATIC,"END_STM_WATCH_QUEUE","END_STM_WATCH_QUEUE")
516 { foreign "C" barf("END_STM_WATCH_QUEUE object entered!") never returns; }
517
518 INFO_TABLE_CONSTR(stg_END_INVARIANT_CHECK_QUEUE,0,0,0,CONSTR_NOCAF_STATIC,"END_INVARIANT_CHECK_QUEUE","END_INVARIANT_CHECK_QUEUE")
519 { foreign "C" barf("END_INVARIANT_CHECK_QUEUE object entered!") never returns; }
520
521 INFO_TABLE_CONSTR(stg_END_STM_CHUNK_LIST,0,0,0,CONSTR_NOCAF_STATIC,"END_STM_CHUNK_LIST","END_STM_CHUNK_LIST")
522 { foreign "C" barf("END_STM_CHUNK_LIST object entered!") never returns; }
523
524 INFO_TABLE_CONSTR(stg_NO_TREC,0,0,0,CONSTR_NOCAF_STATIC,"NO_TREC","NO_TREC")
525 { foreign "C" barf("NO_TREC object entered!") never returns; }
526
527 CLOSURE(stg_END_STM_WATCH_QUEUE_closure,stg_END_STM_WATCH_QUEUE);
528
529 CLOSURE(stg_END_INVARIANT_CHECK_QUEUE_closure,stg_END_INVARIANT_CHECK_QUEUE);
530
531 CLOSURE(stg_END_STM_CHUNK_LIST_closure,stg_END_STM_CHUNK_LIST);
532
533 CLOSURE(stg_NO_TREC_closure,stg_NO_TREC);
534
535 /* ----------------------------------------------------------------------------
536    Messages
537    ------------------------------------------------------------------------- */
538
539 // PRIM rather than CONSTR, because PRIM objects cannot be duplicated by the GC.
540
541 INFO_TABLE_CONSTR(stg_MSG_TRY_WAKEUP,2,0,0,PRIM,"MSG_TRY_WAKEUP","MSG_TRY_WAKEUP")
542 { foreign "C" barf("MSG_TRY_WAKEUP object entered!") never returns; }
543
544 INFO_TABLE_CONSTR(stg_MSG_THROWTO,4,0,0,PRIM,"MSG_THROWTO","MSG_THROWTO")
545 { foreign "C" barf("MSG_THROWTO object entered!") never returns; }
546
547 INFO_TABLE_CONSTR(stg_MSG_BLACKHOLE,3,0,0,PRIM,"MSG_BLACKHOLE","MSG_BLACKHOLE")
548 { foreign "C" barf("MSG_BLACKHOLE object entered!") never returns; }
549
550 // used to overwrite a MSG_THROWTO when the message has been used/revoked
551 INFO_TABLE_CONSTR(stg_MSG_NULL,1,0,0,PRIM,"MSG_NULL","MSG_NULL")
552 { foreign "C" barf("MSG_NULL object entered!") never returns; }
553
554 /* ----------------------------------------------------------------------------
555    END_TSO_QUEUE
556
557    This is a static nullary constructor (like []) that we use to mark the
558    end of a linked TSO queue.
559    ------------------------------------------------------------------------- */
560
561 INFO_TABLE_CONSTR(stg_END_TSO_QUEUE,0,0,0,CONSTR_NOCAF_STATIC,"END_TSO_QUEUE","END_TSO_QUEUE")
562 { foreign "C" barf("END_TSO_QUEUE object entered!") never returns; }
563
564 CLOSURE(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE);
565
566 /* ----------------------------------------------------------------------------
567    GCD_CAF
568    ------------------------------------------------------------------------- */
569
570 INFO_TABLE_CONSTR(stg_GCD_CAF,0,0,0,CONSTR_NOCAF_STATIC,"GCD_CAF","GCD_CAF")
571 { foreign "C" barf("Evaluated a CAF that was GC'd!") never returns; }
572
573 /* ----------------------------------------------------------------------------
574    STM_AWOKEN
575
576    This is a static nullary constructor (like []) that we use to mark a
577    thread waiting on an STM wakeup
578    ------------------------------------------------------------------------- */
579
580 INFO_TABLE_CONSTR(stg_STM_AWOKEN,0,0,0,CONSTR_NOCAF_STATIC,"STM_AWOKEN","STM_AWOKEN")
581 { foreign "C" barf("STM_AWOKEN object entered!") never returns; }
582
583 CLOSURE(stg_STM_AWOKEN_closure,stg_STM_AWOKEN);
584
585 /* ----------------------------------------------------------------------------
586    Arrays
587
588    These come in two basic flavours: arrays of data (StgArrWords) and arrays of
589    pointers (StgArrPtrs).  They all have a similar layout:
590
591    ___________________________
592    | Info | No. of | data....
593    |  Ptr | Words  |
594    ---------------------------
595
596    These are *unpointed* objects: i.e. they cannot be entered.
597
598    ------------------------------------------------------------------------- */
599
600 INFO_TABLE(stg_ARR_WORDS, 0, 0, ARR_WORDS, "ARR_WORDS", "ARR_WORDS")
601 { foreign "C" barf("ARR_WORDS object entered!") never returns; }
602
603 INFO_TABLE(stg_MUT_ARR_PTRS_CLEAN, 0, 0, MUT_ARR_PTRS_CLEAN, "MUT_ARR_PTRS_CLEAN", "MUT_ARR_PTRS_CLEAN")
604 { foreign "C" barf("MUT_ARR_PTRS_CLEAN object entered!") never returns; }
605
606 INFO_TABLE(stg_MUT_ARR_PTRS_DIRTY, 0, 0, MUT_ARR_PTRS_DIRTY, "MUT_ARR_PTRS_DIRTY", "MUT_ARR_PTRS_DIRTY")
607 { foreign "C" barf("MUT_ARR_PTRS_DIRTY object entered!") never returns; }
608
609 INFO_TABLE(stg_MUT_ARR_PTRS_FROZEN, 0, 0, MUT_ARR_PTRS_FROZEN, "MUT_ARR_PTRS_FROZEN", "MUT_ARR_PTRS_FROZEN")
610 { foreign "C" barf("MUT_ARR_PTRS_FROZEN object entered!") never returns; }
611
612 INFO_TABLE(stg_MUT_ARR_PTRS_FROZEN0, 0, 0, MUT_ARR_PTRS_FROZEN0, "MUT_ARR_PTRS_FROZEN0", "MUT_ARR_PTRS_FROZEN0")
613 { foreign "C" barf("MUT_ARR_PTRS_FROZEN0 object entered!") never returns; }
614
615 INFO_TABLE(stg_SMALL_MUT_ARR_PTRS_CLEAN, 0, 0, SMALL_MUT_ARR_PTRS_CLEAN, "SMALL_MUT_ARR_PTRS_CLEAN", "SMALL_MUT_ARR_PTRS_CLEAN")
616 { foreign "C" barf("SMALL_MUT_ARR_PTRS_CLEAN object entered!") never returns; }
617
618 INFO_TABLE(stg_SMALL_MUT_ARR_PTRS_DIRTY, 0, 0, SMALL_MUT_ARR_PTRS_DIRTY, "SMALL_MUT_ARR_PTRS_DIRTY", "SMALL_MUT_ARR_PTRS_DIRTY")
619 { foreign "C" barf("SMALL_MUT_ARR_PTRS_DIRTY object entered!") never returns; }
620
621 INFO_TABLE(stg_SMALL_MUT_ARR_PTRS_FROZEN, 0, 0, SMALL_MUT_ARR_PTRS_FROZEN, "SMALL_MUT_ARR_PTRS_FROZEN", "SMALL_MUT_ARR_PTRS_FROZEN")
622 { foreign "C" barf("SMALL_MUT_ARR_PTRS_FROZEN object entered!") never returns; }
623
624 INFO_TABLE(stg_SMALL_MUT_ARR_PTRS_FROZEN0, 0, 0, SMALL_MUT_ARR_PTRS_FROZEN0, "SMALL_MUT_ARR_PTRS_FROZEN0", "SMALL_MUT_ARR_PTRS_FROZEN0")
625 { foreign "C" barf("SMALL_MUT_ARR_PTRS_FROZEN0 object entered!") never returns; }
626
627 /* ----------------------------------------------------------------------------
628    Mutable Variables
629    ------------------------------------------------------------------------- */
630
631 INFO_TABLE(stg_MUT_VAR_CLEAN, 1, 0, MUT_VAR_CLEAN, "MUT_VAR_CLEAN", "MUT_VAR_CLEAN")
632 { foreign "C" barf("MUT_VAR_CLEAN object entered!") never returns; }
633 INFO_TABLE(stg_MUT_VAR_DIRTY, 1, 0, MUT_VAR_DIRTY, "MUT_VAR_DIRTY", "MUT_VAR_DIRTY")
634 { foreign "C" barf("MUT_VAR_DIRTY object entered!") never returns; }
635
636 /* ----------------------------------------------------------------------------
637    Dummy return closure
638
639    Entering this closure will just return to the address on the top of the
640    stack.  Useful for getting a thread in a canonical form where we can
641    just enter the top stack word to start the thread.  (see deleteThread)
642  * ------------------------------------------------------------------------- */
643
644 INFO_TABLE( stg_dummy_ret, 0, 0, CONSTR_NOCAF_STATIC, "DUMMY_RET", "DUMMY_RET")
645     ()
646 {
647     return ();
648 }
649 CLOSURE(stg_dummy_ret_closure,stg_dummy_ret);
650
651 /* ----------------------------------------------------------------------------
652    MVAR_TSO_QUEUE
653    ------------------------------------------------------------------------- */
654
655 INFO_TABLE_CONSTR(stg_MVAR_TSO_QUEUE,2,0,0,PRIM,"MVAR_TSO_QUEUE","MVAR_TSO_QUEUE")
656 { foreign "C" barf("MVAR_TSO_QUEUE object entered!") never returns; }
657
658 /* ----------------------------------------------------------------------------
659    CHARLIKE and INTLIKE closures.
660
661    These are static representations of Chars and small Ints, so that
662    we can remove dynamic Chars and Ints during garbage collection and
663    replace them with references to the static objects.
664    ------------------------------------------------------------------------- */
665
666 #if defined(COMPILING_WINDOWS_DLL)
667 /*
668  * When sticking the RTS in a Windows DLL, we delay populating the
669  * Charlike and Intlike tables until load-time, which is only
670  * when we've got the real addresses to the C# and I# closures.
671  *
672  * -- this is currently broken BL 2009/11/14.
673  *    we don't rewrite to static closures at all with Windows DLLs.
674  */
675 // #warning Is this correct? _imp is a pointer!
676 #define Char_hash_static_info _imp__ghczmprim_GHCziTypes_Czh_static_info
677 #define Int_hash_static_info _imp__ghczmprim_GHCziTypes_Izh_static_info
678 #else
679 #define Char_hash_static_info ghczmprim_GHCziTypes_Czh_static_info
680 #define Int_hash_static_info ghczmprim_GHCziTypes_Izh_static_info
681 #endif
682
683
684 #define CHARLIKE_HDR(n)  CLOSURE(Char_hash_static_info, n)
685 #define INTLIKE_HDR(n)   CLOSURE(Int_hash_static_info, n)
686
687 /* put these in the *data* section, since the garbage collector relies
688  * on the fact that static closures live in the data section.
689  */
690
691 #if !(defined(COMPILING_WINDOWS_DLL))
692 section "data" {
693  stg_CHARLIKE_closure:
694     CHARLIKE_HDR(0)
695     CHARLIKE_HDR(1)
696     CHARLIKE_HDR(2)
697     CHARLIKE_HDR(3)
698     CHARLIKE_HDR(4)
699     CHARLIKE_HDR(5)
700     CHARLIKE_HDR(6)
701     CHARLIKE_HDR(7)
702     CHARLIKE_HDR(8)
703     CHARLIKE_HDR(9)
704     CHARLIKE_HDR(10)
705     CHARLIKE_HDR(11)
706     CHARLIKE_HDR(12)
707     CHARLIKE_HDR(13)
708     CHARLIKE_HDR(14)
709     CHARLIKE_HDR(15)
710     CHARLIKE_HDR(16)
711     CHARLIKE_HDR(17)
712     CHARLIKE_HDR(18)
713     CHARLIKE_HDR(19)
714     CHARLIKE_HDR(20)
715     CHARLIKE_HDR(21)
716     CHARLIKE_HDR(22)
717     CHARLIKE_HDR(23)
718     CHARLIKE_HDR(24)
719     CHARLIKE_HDR(25)
720     CHARLIKE_HDR(26)
721     CHARLIKE_HDR(27)
722     CHARLIKE_HDR(28)
723     CHARLIKE_HDR(29)
724     CHARLIKE_HDR(30)
725     CHARLIKE_HDR(31)
726     CHARLIKE_HDR(32)
727     CHARLIKE_HDR(33)
728     CHARLIKE_HDR(34)
729     CHARLIKE_HDR(35)
730     CHARLIKE_HDR(36)
731     CHARLIKE_HDR(37)
732     CHARLIKE_HDR(38)
733     CHARLIKE_HDR(39)
734     CHARLIKE_HDR(40)
735     CHARLIKE_HDR(41)
736     CHARLIKE_HDR(42)
737     CHARLIKE_HDR(43)
738     CHARLIKE_HDR(44)
739     CHARLIKE_HDR(45)
740     CHARLIKE_HDR(46)
741     CHARLIKE_HDR(47)
742     CHARLIKE_HDR(48)
743     CHARLIKE_HDR(49)
744     CHARLIKE_HDR(50)
745     CHARLIKE_HDR(51)
746     CHARLIKE_HDR(52)
747     CHARLIKE_HDR(53)
748     CHARLIKE_HDR(54)
749     CHARLIKE_HDR(55)
750     CHARLIKE_HDR(56)
751     CHARLIKE_HDR(57)
752     CHARLIKE_HDR(58)
753     CHARLIKE_HDR(59)
754     CHARLIKE_HDR(60)
755     CHARLIKE_HDR(61)
756     CHARLIKE_HDR(62)
757     CHARLIKE_HDR(63)
758     CHARLIKE_HDR(64)
759     CHARLIKE_HDR(65)
760     CHARLIKE_HDR(66)
761     CHARLIKE_HDR(67)
762     CHARLIKE_HDR(68)
763     CHARLIKE_HDR(69)
764     CHARLIKE_HDR(70)
765     CHARLIKE_HDR(71)
766     CHARLIKE_HDR(72)
767     CHARLIKE_HDR(73)
768     CHARLIKE_HDR(74)
769     CHARLIKE_HDR(75)
770     CHARLIKE_HDR(76)
771     CHARLIKE_HDR(77)
772     CHARLIKE_HDR(78)
773     CHARLIKE_HDR(79)
774     CHARLIKE_HDR(80)
775     CHARLIKE_HDR(81)
776     CHARLIKE_HDR(82)
777     CHARLIKE_HDR(83)
778     CHARLIKE_HDR(84)
779     CHARLIKE_HDR(85)
780     CHARLIKE_HDR(86)
781     CHARLIKE_HDR(87)
782     CHARLIKE_HDR(88)
783     CHARLIKE_HDR(89)
784     CHARLIKE_HDR(90)
785     CHARLIKE_HDR(91)
786     CHARLIKE_HDR(92)
787     CHARLIKE_HDR(93)
788     CHARLIKE_HDR(94)
789     CHARLIKE_HDR(95)
790     CHARLIKE_HDR(96)
791     CHARLIKE_HDR(97)
792     CHARLIKE_HDR(98)
793     CHARLIKE_HDR(99)
794     CHARLIKE_HDR(100)
795     CHARLIKE_HDR(101)
796     CHARLIKE_HDR(102)
797     CHARLIKE_HDR(103)
798     CHARLIKE_HDR(104)
799     CHARLIKE_HDR(105)
800     CHARLIKE_HDR(106)
801     CHARLIKE_HDR(107)
802     CHARLIKE_HDR(108)
803     CHARLIKE_HDR(109)
804     CHARLIKE_HDR(110)
805     CHARLIKE_HDR(111)
806     CHARLIKE_HDR(112)
807     CHARLIKE_HDR(113)
808     CHARLIKE_HDR(114)
809     CHARLIKE_HDR(115)
810     CHARLIKE_HDR(116)
811     CHARLIKE_HDR(117)
812     CHARLIKE_HDR(118)
813     CHARLIKE_HDR(119)
814     CHARLIKE_HDR(120)
815     CHARLIKE_HDR(121)
816     CHARLIKE_HDR(122)
817     CHARLIKE_HDR(123)
818     CHARLIKE_HDR(124)
819     CHARLIKE_HDR(125)
820     CHARLIKE_HDR(126)
821     CHARLIKE_HDR(127)
822     CHARLIKE_HDR(128)
823     CHARLIKE_HDR(129)
824     CHARLIKE_HDR(130)
825     CHARLIKE_HDR(131)
826     CHARLIKE_HDR(132)
827     CHARLIKE_HDR(133)
828     CHARLIKE_HDR(134)
829     CHARLIKE_HDR(135)
830     CHARLIKE_HDR(136)
831     CHARLIKE_HDR(137)
832     CHARLIKE_HDR(138)
833     CHARLIKE_HDR(139)
834     CHARLIKE_HDR(140)
835     CHARLIKE_HDR(141)
836     CHARLIKE_HDR(142)
837     CHARLIKE_HDR(143)
838     CHARLIKE_HDR(144)
839     CHARLIKE_HDR(145)
840     CHARLIKE_HDR(146)
841     CHARLIKE_HDR(147)
842     CHARLIKE_HDR(148)
843     CHARLIKE_HDR(149)
844     CHARLIKE_HDR(150)
845     CHARLIKE_HDR(151)
846     CHARLIKE_HDR(152)
847     CHARLIKE_HDR(153)
848     CHARLIKE_HDR(154)
849     CHARLIKE_HDR(155)
850     CHARLIKE_HDR(156)
851     CHARLIKE_HDR(157)
852     CHARLIKE_HDR(158)
853     CHARLIKE_HDR(159)
854     CHARLIKE_HDR(160)
855     CHARLIKE_HDR(161)
856     CHARLIKE_HDR(162)
857     CHARLIKE_HDR(163)
858     CHARLIKE_HDR(164)
859     CHARLIKE_HDR(165)
860     CHARLIKE_HDR(166)
861     CHARLIKE_HDR(167)
862     CHARLIKE_HDR(168)
863     CHARLIKE_HDR(169)
864     CHARLIKE_HDR(170)
865     CHARLIKE_HDR(171)
866     CHARLIKE_HDR(172)
867     CHARLIKE_HDR(173)
868     CHARLIKE_HDR(174)
869     CHARLIKE_HDR(175)
870     CHARLIKE_HDR(176)
871     CHARLIKE_HDR(177)
872     CHARLIKE_HDR(178)
873     CHARLIKE_HDR(179)
874     CHARLIKE_HDR(180)
875     CHARLIKE_HDR(181)
876     CHARLIKE_HDR(182)
877     CHARLIKE_HDR(183)
878     CHARLIKE_HDR(184)
879     CHARLIKE_HDR(185)
880     CHARLIKE_HDR(186)
881     CHARLIKE_HDR(187)
882     CHARLIKE_HDR(188)
883     CHARLIKE_HDR(189)
884     CHARLIKE_HDR(190)
885     CHARLIKE_HDR(191)
886     CHARLIKE_HDR(192)
887     CHARLIKE_HDR(193)
888     CHARLIKE_HDR(194)
889     CHARLIKE_HDR(195)
890     CHARLIKE_HDR(196)
891     CHARLIKE_HDR(197)
892     CHARLIKE_HDR(198)
893     CHARLIKE_HDR(199)
894     CHARLIKE_HDR(200)
895     CHARLIKE_HDR(201)
896     CHARLIKE_HDR(202)
897     CHARLIKE_HDR(203)
898     CHARLIKE_HDR(204)
899     CHARLIKE_HDR(205)
900     CHARLIKE_HDR(206)
901     CHARLIKE_HDR(207)
902     CHARLIKE_HDR(208)
903     CHARLIKE_HDR(209)
904     CHARLIKE_HDR(210)
905     CHARLIKE_HDR(211)
906     CHARLIKE_HDR(212)
907     CHARLIKE_HDR(213)
908     CHARLIKE_HDR(214)
909     CHARLIKE_HDR(215)
910     CHARLIKE_HDR(216)
911     CHARLIKE_HDR(217)
912     CHARLIKE_HDR(218)
913     CHARLIKE_HDR(219)
914     CHARLIKE_HDR(220)
915     CHARLIKE_HDR(221)
916     CHARLIKE_HDR(222)
917     CHARLIKE_HDR(223)
918     CHARLIKE_HDR(224)
919     CHARLIKE_HDR(225)
920     CHARLIKE_HDR(226)
921     CHARLIKE_HDR(227)
922     CHARLIKE_HDR(228)
923     CHARLIKE_HDR(229)
924     CHARLIKE_HDR(230)
925     CHARLIKE_HDR(231)
926     CHARLIKE_HDR(232)
927     CHARLIKE_HDR(233)
928     CHARLIKE_HDR(234)
929     CHARLIKE_HDR(235)
930     CHARLIKE_HDR(236)
931     CHARLIKE_HDR(237)
932     CHARLIKE_HDR(238)
933     CHARLIKE_HDR(239)
934     CHARLIKE_HDR(240)
935     CHARLIKE_HDR(241)
936     CHARLIKE_HDR(242)
937     CHARLIKE_HDR(243)
938     CHARLIKE_HDR(244)
939     CHARLIKE_HDR(245)
940     CHARLIKE_HDR(246)
941     CHARLIKE_HDR(247)
942     CHARLIKE_HDR(248)
943     CHARLIKE_HDR(249)
944     CHARLIKE_HDR(250)
945     CHARLIKE_HDR(251)
946     CHARLIKE_HDR(252)
947     CHARLIKE_HDR(253)
948     CHARLIKE_HDR(254)
949     CHARLIKE_HDR(255)
950 }
951
952 section "data" {
953  stg_INTLIKE_closure:
954     INTLIKE_HDR(-16) /* MIN_INTLIKE == -16 */
955     INTLIKE_HDR(-15)
956     INTLIKE_HDR(-14)
957     INTLIKE_HDR(-13)
958     INTLIKE_HDR(-12)
959     INTLIKE_HDR(-11)
960     INTLIKE_HDR(-10)
961     INTLIKE_HDR(-9)
962     INTLIKE_HDR(-8)
963     INTLIKE_HDR(-7)
964     INTLIKE_HDR(-6)
965     INTLIKE_HDR(-5)
966     INTLIKE_HDR(-4)
967     INTLIKE_HDR(-3)
968     INTLIKE_HDR(-2)
969     INTLIKE_HDR(-1)
970     INTLIKE_HDR(0)
971     INTLIKE_HDR(1)
972     INTLIKE_HDR(2)
973     INTLIKE_HDR(3)
974     INTLIKE_HDR(4)
975     INTLIKE_HDR(5)
976     INTLIKE_HDR(6)
977     INTLIKE_HDR(7)
978     INTLIKE_HDR(8)
979     INTLIKE_HDR(9)
980     INTLIKE_HDR(10)
981     INTLIKE_HDR(11)
982     INTLIKE_HDR(12)
983     INTLIKE_HDR(13)
984     INTLIKE_HDR(14)
985     INTLIKE_HDR(15)
986     INTLIKE_HDR(16)  /* MAX_INTLIKE == 16 */
987 }
988
989 #endif