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