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