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