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