[project @ 2002-02-12 15:17:13 by simonmar]
[ghc-hetmet.git] / ghc / rts / StgMiscClosures.hc
1 /* -----------------------------------------------------------------------------
2  * $Id: StgMiscClosures.hc,v 1.73 2002/02/12 15:17:22 simonmar Exp $
3  *
4  * (c) The GHC Team, 1998-2000
5  *
6  * Entry code for various built-in closure types.
7  *
8  * ---------------------------------------------------------------------------*/
9
10 #include "Stg.h"
11 #include "Rts.h"
12 #include "RtsUtils.h"
13 #include "RtsFlags.h"
14 #include "StgMiscClosures.h"
15 #include "Storage.h"
16 #include "StoragePriv.h"
17 #include "Profiling.h"
18 #include "Prelude.h"
19 #include "Schedule.h"
20 #include "SMP.h"
21 #if defined(GRAN) || defined(PAR)
22 # include "GranSimRts.h"      /* for DumpRawGranEvent */
23 # include "StgRun.h"    /* for StgReturn and register saving */
24 #endif
25
26 #ifdef HAVE_STDIO_H
27 #include <stdio.h>
28 #endif
29
30 /* ToDo: make the printing of panics more win32-friendly, i.e.,
31  *       pop up some lovely message boxes (as well).
32  */
33 #define DUMP_ERRMSG(msg) STGCALL2(fprintf,stderr,msg)
34
35 /*
36   Template for the entry code of non-enterable closures.
37 */
38
39 #define NON_ENTERABLE_ENTRY_CODE(type)                                  \
40 STGFUN(stg_##type##_entry)                                                      \
41 {                                                                       \
42   FB_                                                                   \
43     DUMP_ERRMSG(#type " object entered!\n");                            \
44     STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE);                     \
45     return NULL;                                                        \
46   FE_                                                                   \
47 }
48
49
50 /* -----------------------------------------------------------------------------
51    Support for the bytecode interpreter.
52    -------------------------------------------------------------------------- */
53
54 /* 9 bits of return code for constructors created by the interpreter. */
55 FN_(stg_interp_constr_entry) 
56
57   /* R1 points at the constructor */
58   FB_ 
59     /* STGCALL2(fprintf,stderr,"stg_interp_constr_entry (direct return)!\n"); */
60     /* Pointless, since SET_TAG doesn't do anything */
61     SET_TAG( GET_TAG(GET_INFO(R1.cl))); 
62     JMP_(ENTRY_CODE((P_)(*Sp))); 
63   FE_ 
64 }
65
66 FN_(stg_interp_constr1_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),0)); FE_ }
67 FN_(stg_interp_constr2_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),1)); FE_ }
68 FN_(stg_interp_constr3_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),2)); FE_ }
69 FN_(stg_interp_constr4_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),3)); FE_ }
70 FN_(stg_interp_constr5_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),4)); FE_ }
71 FN_(stg_interp_constr6_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),5)); FE_ }
72 FN_(stg_interp_constr7_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),6)); FE_ }
73 FN_(stg_interp_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); FE_ }
74  
75 /* Some info tables to be used when compiled code returns a value to
76    the interpreter, i.e. the interpreter pushes one of these onto the
77    stack before entering a value.  What the code does is to
78    impedance-match the compiled return convention (in R1p/R1n/F1/D1 etc) to
79    the interpreter's convention (returned value is on top of stack),
80    and then cause the scheduler to enter the interpreter.
81
82    On entry, the stack (growing down) looks like this:
83
84       ptr to BCO holding return continuation
85       ptr to one of these info tables.
86  
87    The info table code, both direct and vectored, must:
88       * push R1/F1/D1 on the stack, and its tag if necessary
89       * push the BCO (so it's now on the stack twice)
90       * Yield, ie, go to the scheduler.
91
92    Scheduler examines the t.o.s, discovers it is a BCO, and proceeds
93    directly to the bytecode interpreter.  That pops the top element
94    (the BCO, containing the return continuation), and interprets it.
95    Net result: return continuation gets interpreted, with the
96    following stack:
97
98       ptr to this BCO
99       ptr to the info table just jumped thru
100       return value
101
102    which is just what we want -- the "standard" return layout for the
103    interpreter.  Hurrah!
104
105    Don't ask me how unboxed tuple returns are supposed to work.  We
106    haven't got a good story about that yet.
107 */
108
109 /* When the returned value is in R1 and it is a pointer, so doesn't
110    need tagging ... */
111 #define STG_CtoI_RET_R1p_Template(label)        \
112    IFN_(label)                          \
113    {                                    \
114       StgPtr bco;                       \
115       FB_                               \
116       bco = ((StgPtr*)Sp)[1];           \
117       Sp -= 1;                          \
118       ((StgPtr*)Sp)[0] = R1.p;          \
119       Sp -= 1;                          \
120       ((StgPtr*)Sp)[0] = bco;           \
121       JMP_(stg_yield_to_interpreter);   \
122       FE_                               \
123    }
124
125 STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_entry);
126 STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_0_entry);
127 STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_1_entry);
128 STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_2_entry);
129 STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_3_entry);
130 STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_4_entry);
131 STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_5_entry);
132 STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_6_entry);
133 STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_7_entry);
134
135 VEC_POLY_INFO_TABLE(stg_ctoi_ret_R1p,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
136
137
138
139 /* When the returned value is in R1 and it isn't a pointer. */
140 #define STG_CtoI_RET_R1n_Template(label)        \
141    IFN_(label)                          \
142    {                                    \
143       StgPtr bco;                       \
144       FB_                               \
145       bco = ((StgPtr*)Sp)[1];           \
146       Sp -= 1;                          \
147       ((StgPtr*)Sp)[0] = (StgPtr)R1.i;  \
148       Sp -= 1;                          \
149       ((StgPtr*)Sp)[0] = (StgPtr)1; /* tag */   \
150       Sp -= 1;                          \
151       ((StgPtr*)Sp)[0] = bco;           \
152       JMP_(stg_yield_to_interpreter);   \
153       FE_                               \
154    }
155
156 STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_entry);
157 STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_0_entry);
158 STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_1_entry);
159 STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_2_entry);
160 STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_3_entry);
161 STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_4_entry);
162 STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_5_entry);
163 STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_6_entry);
164 STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_7_entry);
165
166 VEC_POLY_INFO_TABLE(stg_ctoi_ret_R1n,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
167
168
169
170 /* When the returned value is in F1 ... */
171 #define STG_CtoI_RET_F1_Template(label)         \
172    IFN_(label)                          \
173    {                                    \
174       StgPtr bco;                       \
175       FB_                               \
176       bco = ((StgPtr*)Sp)[1];           \
177       Sp -= sizeofW(StgFloat);          \
178       ASSIGN_FLT((W_*)Sp, F1);          \
179       Sp -= 1;                          \
180       ((StgPtr*)Sp)[0] = (StgPtr)sizeofW(StgFloat); \
181       Sp -= 1;                          \
182       ((StgPtr*)Sp)[0] = bco;           \
183       JMP_(stg_yield_to_interpreter);   \
184       FE_                               \
185    }
186
187 STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_entry);
188 STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_0_entry);
189 STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_1_entry);
190 STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_2_entry);
191 STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_3_entry);
192 STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_4_entry);
193 STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_5_entry);
194 STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_6_entry);
195 STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_7_entry);
196
197 VEC_POLY_INFO_TABLE(stg_ctoi_ret_F1,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
198
199
200 /* When the returned value is in D1 ... */
201 #define STG_CtoI_RET_D1_Template(label)         \
202    IFN_(label)                          \
203    {                                    \
204       StgPtr bco;                       \
205       FB_                               \
206       bco = ((StgPtr*)Sp)[1];           \
207       Sp -= sizeofW(StgDouble);         \
208       ASSIGN_DBL((W_*)Sp, D1);          \
209       Sp -= 1;                          \
210       ((StgPtr*)Sp)[0] = (StgPtr)sizeofW(StgDouble); \
211       Sp -= 1;                          \
212       ((StgPtr*)Sp)[0] = bco;           \
213       JMP_(stg_yield_to_interpreter);   \
214       FE_                               \
215    }
216
217 STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_entry);
218 STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_0_entry);
219 STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_1_entry);
220 STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_2_entry);
221 STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_3_entry);
222 STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_4_entry);
223 STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_5_entry);
224 STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_6_entry);
225 STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_7_entry);
226
227 VEC_POLY_INFO_TABLE(stg_ctoi_ret_D1,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
228
229
230 /* When the returned value a VoidRep ... */
231 #define STG_CtoI_RET_V_Template(label)  \
232    IFN_(label)                          \
233    {                                    \
234       StgPtr bco;                       \
235       FB_                               \
236       bco = ((StgPtr*)Sp)[1];           \
237       Sp -= 1;                          \
238       ((StgPtr*)Sp)[0] = 0; /* VoidRep tag */ \
239       Sp -= 1;                          \
240       ((StgPtr*)Sp)[0] = bco;           \
241       JMP_(stg_yield_to_interpreter);   \
242       FE_                               \
243    }
244
245 STG_CtoI_RET_V_Template(stg_ctoi_ret_V_entry);
246 STG_CtoI_RET_V_Template(stg_ctoi_ret_V_0_entry);
247 STG_CtoI_RET_V_Template(stg_ctoi_ret_V_1_entry);
248 STG_CtoI_RET_V_Template(stg_ctoi_ret_V_2_entry);
249 STG_CtoI_RET_V_Template(stg_ctoi_ret_V_3_entry);
250 STG_CtoI_RET_V_Template(stg_ctoi_ret_V_4_entry);
251 STG_CtoI_RET_V_Template(stg_ctoi_ret_V_5_entry);
252 STG_CtoI_RET_V_Template(stg_ctoi_ret_V_6_entry);
253 STG_CtoI_RET_V_Template(stg_ctoi_ret_V_7_entry);
254
255 VEC_POLY_INFO_TABLE(stg_ctoi_ret_V,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
256
257
258 /* The other way round: when the interpreter returns a value to
259    compiled code.  The stack looks like this:
260
261       return info table (pushed by compiled code)
262       return value (pushed by interpreter)
263
264    If the value is ptr-rep'd, the interpreter simply returns to the
265    scheduler, instructing it to ThreadEnterGHC.
266
267    Otherwise (unboxed return value), we replace the top stack word,
268    which must be the tag, with stg_gc_unbx_r1_info (or f1_info or d1_info),
269    and return to the scheduler, instructing it to ThreadRunGHC.
270
271    No supporting code needed!
272 */
273
274
275 /* Entering a BCO.  Heave it on the stack and defer to the
276    scheduler. */
277 INFO_TABLE(stg_BCO_info,stg_BCO_entry,4,0,BCO,,EF_,"BCO","BCO");
278 STGFUN(stg_BCO_entry) {
279   FB_
280     Sp -= 1;
281     Sp[0] = R1.w;
282     JMP_(stg_yield_to_interpreter);
283   FE_
284 }
285
286
287 /* -----------------------------------------------------------------------------
288    Entry code for an indirection.
289    -------------------------------------------------------------------------- */
290
291 INFO_TABLE(stg_IND_info,stg_IND_entry,1,0,IND,,EF_,"IND","IND");
292 STGFUN(stg_IND_entry)
293 {
294     FB_
295     TICK_ENT_IND(Node); /* tick */
296     R1.p = (P_) ((StgInd*)R1.p)->indirectee;
297     TICK_ENT_VIA_NODE();
298     JMP_(GET_ENTRY(R1.cl));
299     FE_
300 }
301
302 INFO_TABLE(stg_IND_STATIC_info,stg_IND_STATIC_entry,1,0,IND_STATIC,,EF_,"IND_STATIC","IND_STATIC");
303 STGFUN(stg_IND_STATIC_entry)
304 {
305     FB_
306     TICK_ENT_IND(Node); /* tick */
307     R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
308     TICK_ENT_VIA_NODE();
309     JMP_(GET_ENTRY(R1.cl));
310     FE_
311 }
312
313 INFO_TABLE(stg_IND_PERM_info,stg_IND_PERM_entry,1,1,IND_PERM,,EF_,"IND_PERM","IND_PERM");
314 STGFUN(stg_IND_PERM_entry)
315 {
316     FB_
317     /* Don't add INDs to granularity cost */
318     /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
319
320 #if defined(TICKY_TICKY) && !defined(PROFILING)
321     /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra  */
322     TICK_ENT_PERM_IND(R1.p); /* tick */
323 #endif
324
325     LDV_ENTER((StgInd *)R1.p);
326
327     /* Enter PAP cost centre -- lexical scoping only */
328     ENTER_CCS_PAP_CL(R1.cl);
329
330     /* For ticky-ticky, change the perm_ind to a normal ind on first
331      * entry, so the number of ent_perm_inds is the number of *thunks*
332      * entered again, not the number of subsequent entries.
333      *
334      * Since this screws up cost centres, we die if profiling and
335      * ticky_ticky are on at the same time.  KSW 1999-01.
336      */
337
338 #ifdef TICKY_TICKY
339 #  ifdef PROFILING
340 #    error Profiling and ticky-ticky do not mix at present!
341 #  endif  /* PROFILING */
342     SET_INFO((StgInd*)R1.p,&stg_IND_info);
343 #endif /* TICKY_TICKY */
344
345     R1.p = (P_) ((StgInd*)R1.p)->indirectee;
346
347     /* Dont: TICK_ENT_VIA_NODE(); for ticky-ticky; as above */
348
349 #if defined(TICKY_TICKY) && !defined(PROFILING)
350     TICK_ENT_VIA_NODE();
351 #endif
352
353     JMP_(GET_ENTRY(R1.cl));
354     FE_
355 }  
356
357 INFO_TABLE(stg_IND_OLDGEN_info,stg_IND_OLDGEN_entry,1,1,IND_OLDGEN,,EF_,"IND_OLDGEN","IND_OLDGEN");
358 STGFUN(stg_IND_OLDGEN_entry)
359 {
360     FB_
361     TICK_ENT_IND(Node); /* tick */
362     R1.p = (P_) ((StgInd*)R1.p)->indirectee;
363     TICK_ENT_VIA_NODE();
364     JMP_(GET_ENTRY(R1.cl));
365     FE_
366 }
367
368 INFO_TABLE(stg_IND_OLDGEN_PERM_info,stg_IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,,EF_,"IND_OLDGEN_PERM","IND_OLDGEN_PERM");
369 STGFUN(stg_IND_OLDGEN_PERM_entry)
370 {
371     FB_
372     /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
373
374 #if defined(TICKY_TICKY) && !defined(PROFILING)
375     /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra  */
376     TICK_ENT_PERM_IND(R1.p); /* tick */
377 #endif
378
379     LDV_ENTER((StgInd *)R1.p);
380
381     /* Enter PAP cost centre -- lexical scoping only */
382     ENTER_CCS_PAP_CL(R1.cl);
383
384     /* see comment in IND_PERM */
385 #ifdef TICKY_TICKY
386 #  ifdef PROFILING
387 #    error Profiling and ticky-ticky do not mix at present!
388 #  endif  /* PROFILING */
389     SET_INFO((StgInd*)R1.p,&stg_IND_OLDGEN_info);
390 #endif /* TICKY_TICKY */
391
392     R1.p = (P_) ((StgInd*)R1.p)->indirectee;
393     TICK_ENT_VIA_NODE();
394     JMP_(GET_ENTRY(R1.cl));
395     FE_
396 }
397
398 /* -----------------------------------------------------------------------------
399    Entry code for a black hole.
400
401    Entering a black hole normally causes a cyclic data dependency, but
402    in the concurrent world, black holes are synchronization points,
403    and they are turned into blocking queues when there are threads
404    waiting for the evaluation of the closure to finish.
405    -------------------------------------------------------------------------- */
406
407 /* Note: a BLACKHOLE and BLACKHOLE_BQ must be big enough to be
408  * overwritten with an indirection/evacuee/catch.  Thus we claim it
409  * has 1 non-pointer word of payload (in addition to the pointer word
410  * for the blocking queue in a BQ), which should be big enough for an
411  * old-generation indirection. 
412  */
413
414 INFO_TABLE(stg_BLACKHOLE_info, stg_BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,"BLACKHOLE","BLACKHOLE");
415 STGFUN(stg_BLACKHOLE_entry)
416 {
417   FB_
418 #if defined(GRAN)
419     /* Before overwriting TSO_LINK */
420     STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
421 #endif
422
423 #ifdef SMP
424     {
425       bdescr *bd = Bdescr(R1.p);
426       if (bd->u.back != (bdescr *)BaseReg) {
427         if (bd->gen_no >= 1 || bd->step->no >= 1) {
428           CMPXCHG(R1.cl->header.info, &stg_BLACKHOLE_info, &stg_WHITEHOLE_info);
429         } else {
430           EXTFUN_RTS(stg_gc_enter_1_hponly);
431           JMP_(stg_gc_enter_1_hponly);
432         }
433       }
434     }
435 #endif
436     TICK_ENT_BH();
437
438     // Actually this is not necessary because R1.p is about to be destroyed.
439     LDV_ENTER((StgClosure *)R1.p);
440
441     /* Put ourselves on the blocking queue for this black hole */
442 #if defined(GRAN) || defined(PAR)
443     // in fact, only difference is the type of the end-of-queue marker!
444     CurrentTSO->link = END_BQ_QUEUE;
445     ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
446 #else
447     CurrentTSO->link = END_TSO_QUEUE;
448     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
449 #endif
450     // jot down why and on what closure we are blocked
451     CurrentTSO->why_blocked = BlockedOnBlackHole;
452     CurrentTSO->block_info.closure = R1.cl;
453
454     /* Change the BLACKHOLE into a BLACKHOLE_BQ */
455 #ifdef PROFILING
456
457     // The size remains the same, so we call LDV_recordDead() - no need to fill slop.
458     LDV_recordDead((StgClosure *)R1.p, BLACKHOLE_sizeW());
459 #endif
460     // 
461     // Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
462     // 
463     ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info;
464 #ifdef PROFILING
465     LDV_recordCreate((StgClosure *)R1.p);
466 #endif
467
468     // closure is mutable since something has just been added to its BQ
469     recordMutable((StgMutClosure *)R1.cl);
470
471     // PAR: dumping of event now done in blockThread -- HWL
472
473     // stg_gen_block is too heavyweight, use a specialised one
474     BLOCK_NP(1);
475   FE_
476 }
477
478 INFO_TABLE(stg_BLACKHOLE_BQ_info, stg_BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,"BLACKHOLE","BLACKHOLE");
479 STGFUN(stg_BLACKHOLE_BQ_entry)
480 {
481   FB_
482 #if defined(GRAN)
483     /* Before overwriting TSO_LINK */
484     STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
485 #endif
486
487 #ifdef SMP
488     {
489       bdescr *bd = Bdescr(R1.p);
490       if (bd->u.back != (bdescr *)BaseReg) {
491         if (bd->gen_no >= 1 || bd->step->no >= 1) {
492           CMPXCHG(R1.cl->header.info, &stg_BLACKHOLE_info, &stg_WHITEHOLE_info);
493         } else {
494           EXTFUN_RTS(stg_gc_enter_1_hponly);
495           JMP_(stg_gc_enter_1_hponly);
496         }
497       }
498     }
499 #endif
500
501     TICK_ENT_BH();
502     LDV_ENTER((StgClosure *)R1.p);
503
504     /* Put ourselves on the blocking queue for this black hole */
505     CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
506     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
507     /* jot down why and on what closure we are blocked */
508     CurrentTSO->why_blocked = BlockedOnBlackHole;
509     CurrentTSO->block_info.closure = R1.cl;
510 #ifdef SMP
511     ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info;
512 #endif
513
514     /* PAR: dumping of event now done in blockThread -- HWL */
515
516     /* stg_gen_block is too heavyweight, use a specialised one */
517     BLOCK_NP(1);
518   FE_
519 }
520
521 /*
522    Revertible black holes are needed in the parallel world, to handle
523    negative acknowledgements of messages containing updatable closures.
524    The idea is that when the original message is transmitted, the closure
525    is turned into a revertible black hole...an object which acts like a
526    black hole when local threads try to enter it, but which can be reverted
527    back to the original closure if necessary.
528
529    It's actually a lot like a blocking queue (BQ) entry, because revertible
530    black holes are initially set up with an empty blocking queue.
531 */
532
533 #if defined(PAR) || defined(GRAN)
534
535 INFO_TABLE(stg_RBH_info, stg_RBH_entry,1,1,RBH,,EF_,"RBH","RBH");
536 STGFUN(stg_RBH_entry)
537 {
538   FB_
539 # if defined(GRAN)
540     /* mainly statistics gathering for GranSim simulation */
541     STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
542 # endif
543
544     /* exactly the same as a BLACKHOLE_BQ_entry -- HWL */
545     /* Put ourselves on the blocking queue for this black hole */
546     CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
547     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
548     /* jot down why and on what closure we are blocked */
549     CurrentTSO->why_blocked = BlockedOnBlackHole;
550     CurrentTSO->block_info.closure = R1.cl;
551
552     /* PAR: dumping of event now done in blockThread -- HWL */
553
554     /* stg_gen_block is too heavyweight, use a specialised one */
555     BLOCK_NP(1); 
556   FE_
557 }
558
559 INFO_TABLE(stg_RBH_Save_0_info, stg_RBH_Save_0_entry,0,2,CONSTR,,EF_,"RBH_Save_0","RBH_Save_0");
560 NON_ENTERABLE_ENTRY_CODE(RBH_Save_0);
561
562 INFO_TABLE(stg_RBH_Save_1_info, stg_RBH_Save_1_entry,1,1,CONSTR,,EF_,"RBH_Save_1","RBH_Save_1");
563 NON_ENTERABLE_ENTRY_CODE(RBH_Save_1);
564
565 INFO_TABLE(stg_RBH_Save_2_info, stg_RBH_Save_2_entry,2,0,CONSTR,,EF_,"RBH_Save_2","RBH_Save_2");
566 NON_ENTERABLE_ENTRY_CODE(RBH_Save_2);
567 #endif /* defined(PAR) || defined(GRAN) */
568
569 /* identical to BLACKHOLEs except for the infotag */
570 INFO_TABLE(stg_CAF_BLACKHOLE_info, stg_CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,"CAF_BLACKHOLE","CAF_BLACKHOLE");
571 STGFUN(stg_CAF_BLACKHOLE_entry)
572 {
573   FB_
574 #if defined(GRAN)
575     /* mainly statistics gathering for GranSim simulation */
576     STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
577 #endif
578
579 #ifdef SMP
580     {
581       bdescr *bd = Bdescr(R1.p);
582       if (bd->u.back != (bdescr *)BaseReg) {
583         if (bd->gen_no >= 1 || bd->step->no >= 1) {
584           CMPXCHG(R1.cl->header.info, &stg_CAF_BLACKHOLE_info, &stg_WHITEHOLE_info);
585         } else {
586           EXTFUN_RTS(stg_gc_enter_1_hponly);
587           JMP_(stg_gc_enter_1_hponly);
588         }
589       }
590     }
591 #endif
592
593     TICK_ENT_BH();
594     LDV_ENTER((StgClosure *)R1.p);
595
596     // Put ourselves on the blocking queue for this black hole
597 #if defined(GRAN) || defined(PAR)
598     // in fact, only difference is the type of the end-of-queue marker!
599     CurrentTSO->link = END_BQ_QUEUE;
600     ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
601 #else
602     CurrentTSO->link = END_TSO_QUEUE;
603     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
604 #endif
605     // jot down why and on what closure we are blocked
606     CurrentTSO->why_blocked = BlockedOnBlackHole;
607     CurrentTSO->block_info.closure = R1.cl;
608
609     // Change the CAF_BLACKHOLE into a BLACKHOLE_BQ_STATIC
610     ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info;
611
612     // closure is mutable since something has just been added to its BQ
613     recordMutable((StgMutClosure *)R1.cl);
614
615     // PAR: dumping of event now done in blockThread -- HWL
616
617     // stg_gen_block is too heavyweight, use a specialised one
618     BLOCK_NP(1);
619   FE_
620 }
621
622 #ifdef TICKY_TICKY
623 INFO_TABLE(stg_SE_BLACKHOLE_info, stg_SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,"SE_BLACKHOLE","SE_BLACKHOLE");
624 STGFUN(stg_SE_BLACKHOLE_entry)
625 {
626   FB_
627     STGCALL3(fprintf,stderr,"SE_BLACKHOLE at %p entered!\n",R1.p);
628     STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
629   FE_
630 }
631
632 INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,EF_,"CAF_BLACKHOLE","CAF_BLACKHOLE");
633 STGFUN(stg_SE_CAF_BLACKHOLE_entry)
634 {
635   FB_
636     STGCALL3(fprintf,stderr,"SE_CAF_BLACKHOLE at %p entered!\n",R1.p);
637     STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
638   FE_
639 }
640 #endif
641
642 #ifdef SMP
643 INFO_TABLE(stg_WHITEHOLE_info, stg_WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,EF_,"WHITEHOLE","WHITEHOLE");
644 STGFUN(stg_WHITEHOLE_entry)
645 {
646   FB_
647      JMP_(GET_ENTRY(R1.cl));
648   FE_
649 }
650 #endif
651
652 /* -----------------------------------------------------------------------------
653    Some static info tables for things that don't get entered, and
654    therefore don't need entry code (i.e. boxed but unpointed objects)
655    NON_ENTERABLE_ENTRY_CODE now defined at the beginning of the file
656    -------------------------------------------------------------------------- */
657
658 INFO_TABLE(stg_TSO_info, stg_TSO_entry, 0,0,TSO,,EF_,"TSO","TSO");
659 NON_ENTERABLE_ENTRY_CODE(TSO);
660
661 /* -----------------------------------------------------------------------------
662    Evacuees are left behind by the garbage collector.  Any attempt to enter
663    one is a real bug.
664    -------------------------------------------------------------------------- */
665
666 INFO_TABLE(stg_EVACUATED_info,stg_EVACUATED_entry,1,0,EVACUATED,,EF_,"EVACUATED","EVACUATED");
667 NON_ENTERABLE_ENTRY_CODE(EVACUATED);
668
669 /* -----------------------------------------------------------------------------
670    Weak pointers
671
672    Live weak pointers have a special closure type.  Dead ones are just
673    nullary constructors (although they live on the heap - we overwrite
674    live weak pointers with dead ones).
675    -------------------------------------------------------------------------- */
676
677 INFO_TABLE(stg_WEAK_info,stg_WEAK_entry,0,4,WEAK,,EF_,"WEAK","WEAK");
678 NON_ENTERABLE_ENTRY_CODE(WEAK);
679
680 // XXX! The garbage collector replaces a WEAK with a DEAD_WEAK
681 // in-place, which causes problems if the heap is scanned linearly
682 // after GC (certain kinds of profiling do this).  So when profiling,
683 // we set the size of a DEAD_WEAK to 4 non-pointers, rather than its
684 // usual 1.
685
686 #ifdef PROFILING
687 #define DEAD_WEAK_PAYLOAD_WORDS 4
688 #else
689 #define DEAD_WEAK_PAYLOAD_WORDS 1
690 #endif
691
692 INFO_TABLE_CONSTR(stg_DEAD_WEAK_info,stg_DEAD_WEAK_entry,0,DEAD_WEAK_PAYLOAD_WORDS,0,CONSTR,,EF_,"DEAD_WEAK","DEAD_WEAK");
693 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
694
695 /* -----------------------------------------------------------------------------
696    NO_FINALIZER
697
698    This is a static nullary constructor (like []) that we use to mark an empty
699    finalizer in a weak pointer object.
700    -------------------------------------------------------------------------- */
701
702 INFO_TABLE_CONSTR(stg_NO_FINALIZER_info,stg_NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,"NO_FINALIZER","NO_FINALIZER");
703 NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
704
705 SET_STATIC_HDR(stg_NO_FINALIZER_closure,stg_NO_FINALIZER_info,0/*CC*/,,EI_)
706 , /*payload*/{} };
707
708 /* -----------------------------------------------------------------------------
709    Foreign Objects are unlifted and therefore never entered.
710    -------------------------------------------------------------------------- */
711
712 INFO_TABLE(stg_FOREIGN_info,stg_FOREIGN_entry,0,1,FOREIGN,,EF_,"FOREIGN","FOREIGN");
713 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
714
715 /* -----------------------------------------------------------------------------
716    Stable Names are unlifted too.
717    -------------------------------------------------------------------------- */
718
719 INFO_TABLE(stg_STABLE_NAME_info,stg_STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,"STABLE_NAME","STABLE_NAME");
720 NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
721
722 /* -----------------------------------------------------------------------------
723    MVars
724
725    There are two kinds of these: full and empty.  We need an info table
726    and entry code for each type.
727    -------------------------------------------------------------------------- */
728
729 INFO_TABLE(stg_FULL_MVAR_info,stg_FULL_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
730 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
731
732 INFO_TABLE(stg_EMPTY_MVAR_info,stg_EMPTY_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
733 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
734
735 /* -----------------------------------------------------------------------------
736    END_TSO_QUEUE
737
738    This is a static nullary constructor (like []) that we use to mark the
739    end of a linked TSO queue.
740    -------------------------------------------------------------------------- */
741
742 INFO_TABLE_CONSTR(stg_END_TSO_QUEUE_info,stg_END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,"END_TSO_QUEUE","END_TSO_QUEUE");
743 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
744
745 SET_STATIC_HDR(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE_info,0/*CC*/,,EI_)
746 , /*payload*/{} };
747
748 /* -----------------------------------------------------------------------------
749    Mutable lists
750
751    Mutable lists (used by the garbage collector) consist of a chain of
752    StgMutClosures connected through their mut_link fields, ending in
753    an END_MUT_LIST closure.
754    -------------------------------------------------------------------------- */
755
756 INFO_TABLE_CONSTR(stg_END_MUT_LIST_info,stg_END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,"END_MUT_LIST","END_MUT_LIST");
757 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
758
759 SET_STATIC_HDR(stg_END_MUT_LIST_closure,stg_END_MUT_LIST_info,0/*CC*/,,EI_)
760 , /*payload*/{} };
761
762 INFO_TABLE(stg_MUT_CONS_info, stg_MUT_CONS_entry, 1, 1, MUT_CONS, , EF_, "MUT_CONS", "MUT_CONS");
763 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
764
765 /* -----------------------------------------------------------------------------
766    Exception lists
767    -------------------------------------------------------------------------- */
768
769 INFO_TABLE_CONSTR(stg_END_EXCEPTION_LIST_info,stg_END_EXCEPTION_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,"END_EXCEPTION_LIST","END_EXCEPTION_LIST");
770 NON_ENTERABLE_ENTRY_CODE(END_EXCEPTION_LIST);
771
772 SET_STATIC_HDR(stg_END_EXCEPTION_LIST_closure,stg_END_EXCEPTION_LIST_info,0/*CC*/,,EI_)
773 , /*payload*/{} };
774
775 INFO_TABLE(stg_EXCEPTION_CONS_info, stg_EXCEPTION_CONS_entry, 1, 1, CONSTR, , EF_, "EXCEPTION_CONS", "EXCEPTION_CONS");
776 NON_ENTERABLE_ENTRY_CODE(EXCEPTION_CONS);
777
778 /* -----------------------------------------------------------------------------
779    Arrays
780
781    These come in two basic flavours: arrays of data (StgArrWords) and arrays of
782    pointers (StgArrPtrs).  They all have a similar layout:
783
784         ___________________________
785         | Info | No. of | data....
786         |  Ptr | Words  |
787         ---------------------------
788
789    These are *unpointed* objects: i.e. they cannot be entered.
790
791    -------------------------------------------------------------------------- */
792
793 #define ArrayInfo(type)                                 \
794 INFO_TABLE(stg_##type##_info, stg_##type##_entry, 0, 0, type, , EF_,"" # type "","" # type "");
795
796 ArrayInfo(ARR_WORDS);
797 NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
798 ArrayInfo(MUT_ARR_PTRS);
799 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS);
800 ArrayInfo(MUT_ARR_PTRS_FROZEN);
801 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
802
803 #undef ArrayInfo
804
805 /* -----------------------------------------------------------------------------
806    Mutable Variables
807    -------------------------------------------------------------------------- */
808
809 INFO_TABLE(stg_MUT_VAR_info, stg_MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, "MUT_VAR", "MUT_VAR");
810 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
811
812 /* -----------------------------------------------------------------------------
813    Standard Error Entry.
814
815    This is used for filling in vector-table entries that can never happen,
816    for instance.
817    -------------------------------------------------------------------------- */
818 /* No longer used; we use NULL, because a) it never happens, right? and b)
819    Windows doesn't like DLL entry points being used as static initialisers
820 STGFUN(stg_error_entry)                                                 \
821 {                                                                       \
822   FB_                                                                   \
823     DUMP_ERRMSG("fatal: stg_error_entry");                              \
824     STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE);                     \
825     return NULL;                                                        \
826   FE_                                                                   \
827 }
828 */
829 /* -----------------------------------------------------------------------------
830    Dummy return closure
831  
832    Entering this closure will just return to the address on the top of the
833    stack.  Useful for getting a thread in a canonical form where we can
834    just enter the top stack word to start the thread.  (see deleteThread)
835  * -------------------------------------------------------------------------- */
836
837 INFO_TABLE(stg_dummy_ret_info, stg_dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, , EF_, "DUMMY_RET", "DUMMY_RET");
838 STGFUN(stg_dummy_ret_entry)
839 {
840   W_ ret_addr;
841   FB_
842   ret_addr = Sp[0];
843   Sp++;
844   JMP_(ENTRY_CODE(ret_addr));
845   FE_
846 }
847 SET_STATIC_HDR(stg_dummy_ret_closure,stg_dummy_ret_info,CCS_DONT_CARE,,EI_)
848 , /*payload*/{} };
849
850 /* -----------------------------------------------------------------------------
851     Strict IO application - performing an IO action and entering its result.
852     
853     rts_evalIO() lets you perform Haskell IO actions from outside of Haskell-land,
854     returning back to you their result. Want this result to be evaluated to WHNF
855     by that time, so that we can easily get at the int/char/whatever using the
856     various get{Ty} functions provided by the RTS API.
857
858     forceIO takes care of this, performing the IO action and entering the
859     results that comes back.
860
861  * -------------------------------------------------------------------------- */
862
863 #ifdef REG_R1
864 INFO_TABLE_SRT_BITMAP(stg_forceIO_ret_info,stg_forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
865 STGFUN(stg_forceIO_ret_entry)
866 {
867   FB_
868   Sp++;
869   Sp -= sizeofW(StgSeqFrame);
870   PUSH_SEQ_FRAME(Sp);
871   JMP_(GET_ENTRY(R1.cl));
872 }
873 #else
874 INFO_TABLE_SRT_BITMAP(stg_forceIO_ret_info,stg_forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
875 STGFUN(stg_forceIO_ret_entry)
876 {
877   StgClosure *rval;
878   FB_
879   rval = (StgClosure *)Sp[0];
880   Sp += 2;
881   Sp -= sizeofW(StgSeqFrame);
882   PUSH_SEQ_FRAME(Sp);
883   R1.cl = rval;
884   JMP_(GET_ENTRY(R1.cl));
885 }
886 #endif
887
888 INFO_TABLE(stg_forceIO_info,stg_forceIO_entry,1,0,FUN_STATIC,,EF_,"FORCE_IO","FORCE_IO");
889 FN_(stg_forceIO_entry)
890 {
891   FB_
892   /* Sp[0] contains the IO action we want to perform */
893   R1.p  = (P_)Sp[0];
894   /* Replace it with the return continuation that enters the result. */
895   Sp[0] = (W_)&stg_forceIO_ret_info;
896   Sp--;
897   /* Push the RealWorld# tag and enter */
898   Sp[0] =(W_)REALWORLD_TAG;
899   JMP_(GET_ENTRY(R1.cl));
900   FE_
901 }
902 SET_STATIC_HDR(stg_forceIO_closure,stg_forceIO_info,CCS_DONT_CARE,,EI_)
903 , /*payload*/{} };
904
905
906 /* -----------------------------------------------------------------------------
907    CHARLIKE and INTLIKE closures.  
908
909    These are static representations of Chars and small Ints, so that
910    we can remove dynamic Chars and Ints during garbage collection and
911    replace them with references to the static objects.
912    -------------------------------------------------------------------------- */
913
914 #if defined(INTERPRETER) || defined(ENABLE_WIN32_DLL_SUPPORT)
915 /*
916  * When sticking the RTS in a DLL, we delay populating the
917  * Charlike and Intlike tables until load-time, which is only
918  * when we've got the real addresses to the C# and I# closures.
919  *
920  */
921 static INFO_TBL_CONST StgInfoTable czh_static_info;
922 static INFO_TBL_CONST StgInfoTable izh_static_info;
923 #define Char_hash_static_info czh_static_info
924 #define Int_hash_static_info izh_static_info
925 #else
926 #define Char_hash_static_info GHCziBase_Czh_static_info
927 #define Int_hash_static_info GHCziBase_Izh_static_info
928 #endif
929
930 #define CHARLIKE_HDR(n)                                         \
931         {                                                       \
932           STATIC_HDR(Char_hash_static_info, /* C# */            \
933                          CCS_DONT_CARE),                        \
934           data : n                                              \
935         }
936                                              
937 #define INTLIKE_HDR(n)                                          \
938         {                                                       \
939           STATIC_HDR(Int_hash_static_info,  /* I# */            \
940                          CCS_DONT_CARE),                        \
941           data : n                                              \
942         }
943
944 /* put these in the *data* section, since the garbage collector relies
945  * on the fact that static closures live in the data section.
946  */
947
948 /* end the name with _closure, to convince the mangler this is a closure */
949
950 StgIntCharlikeClosure stg_CHARLIKE_closure[] = {
951     CHARLIKE_HDR(0),
952     CHARLIKE_HDR(1),
953     CHARLIKE_HDR(2),
954     CHARLIKE_HDR(3),
955     CHARLIKE_HDR(4),
956     CHARLIKE_HDR(5),
957     CHARLIKE_HDR(6),
958     CHARLIKE_HDR(7),
959     CHARLIKE_HDR(8),
960     CHARLIKE_HDR(9),
961     CHARLIKE_HDR(10),
962     CHARLIKE_HDR(11),
963     CHARLIKE_HDR(12),
964     CHARLIKE_HDR(13),
965     CHARLIKE_HDR(14),
966     CHARLIKE_HDR(15),
967     CHARLIKE_HDR(16),
968     CHARLIKE_HDR(17),
969     CHARLIKE_HDR(18),
970     CHARLIKE_HDR(19),
971     CHARLIKE_HDR(20),
972     CHARLIKE_HDR(21),
973     CHARLIKE_HDR(22),
974     CHARLIKE_HDR(23),
975     CHARLIKE_HDR(24),
976     CHARLIKE_HDR(25),
977     CHARLIKE_HDR(26),
978     CHARLIKE_HDR(27),
979     CHARLIKE_HDR(28),
980     CHARLIKE_HDR(29),
981     CHARLIKE_HDR(30),
982     CHARLIKE_HDR(31),
983     CHARLIKE_HDR(32),
984     CHARLIKE_HDR(33),
985     CHARLIKE_HDR(34),
986     CHARLIKE_HDR(35),
987     CHARLIKE_HDR(36),
988     CHARLIKE_HDR(37),
989     CHARLIKE_HDR(38),
990     CHARLIKE_HDR(39),
991     CHARLIKE_HDR(40),
992     CHARLIKE_HDR(41),
993     CHARLIKE_HDR(42),
994     CHARLIKE_HDR(43),
995     CHARLIKE_HDR(44),
996     CHARLIKE_HDR(45),
997     CHARLIKE_HDR(46),
998     CHARLIKE_HDR(47),
999     CHARLIKE_HDR(48),
1000     CHARLIKE_HDR(49),
1001     CHARLIKE_HDR(50),
1002     CHARLIKE_HDR(51),
1003     CHARLIKE_HDR(52),
1004     CHARLIKE_HDR(53),
1005     CHARLIKE_HDR(54),
1006     CHARLIKE_HDR(55),
1007     CHARLIKE_HDR(56),
1008     CHARLIKE_HDR(57),
1009     CHARLIKE_HDR(58),
1010     CHARLIKE_HDR(59),
1011     CHARLIKE_HDR(60),
1012     CHARLIKE_HDR(61),
1013     CHARLIKE_HDR(62),
1014     CHARLIKE_HDR(63),
1015     CHARLIKE_HDR(64),
1016     CHARLIKE_HDR(65),
1017     CHARLIKE_HDR(66),
1018     CHARLIKE_HDR(67),
1019     CHARLIKE_HDR(68),
1020     CHARLIKE_HDR(69),
1021     CHARLIKE_HDR(70),
1022     CHARLIKE_HDR(71),
1023     CHARLIKE_HDR(72),
1024     CHARLIKE_HDR(73),
1025     CHARLIKE_HDR(74),
1026     CHARLIKE_HDR(75),
1027     CHARLIKE_HDR(76),
1028     CHARLIKE_HDR(77),
1029     CHARLIKE_HDR(78),
1030     CHARLIKE_HDR(79),
1031     CHARLIKE_HDR(80),
1032     CHARLIKE_HDR(81),
1033     CHARLIKE_HDR(82),
1034     CHARLIKE_HDR(83),
1035     CHARLIKE_HDR(84),
1036     CHARLIKE_HDR(85),
1037     CHARLIKE_HDR(86),
1038     CHARLIKE_HDR(87),
1039     CHARLIKE_HDR(88),
1040     CHARLIKE_HDR(89),
1041     CHARLIKE_HDR(90),
1042     CHARLIKE_HDR(91),
1043     CHARLIKE_HDR(92),
1044     CHARLIKE_HDR(93),
1045     CHARLIKE_HDR(94),
1046     CHARLIKE_HDR(95),
1047     CHARLIKE_HDR(96),
1048     CHARLIKE_HDR(97),
1049     CHARLIKE_HDR(98),
1050     CHARLIKE_HDR(99),
1051     CHARLIKE_HDR(100),
1052     CHARLIKE_HDR(101),
1053     CHARLIKE_HDR(102),
1054     CHARLIKE_HDR(103),
1055     CHARLIKE_HDR(104),
1056     CHARLIKE_HDR(105),
1057     CHARLIKE_HDR(106),
1058     CHARLIKE_HDR(107),
1059     CHARLIKE_HDR(108),
1060     CHARLIKE_HDR(109),
1061     CHARLIKE_HDR(110),
1062     CHARLIKE_HDR(111),
1063     CHARLIKE_HDR(112),
1064     CHARLIKE_HDR(113),
1065     CHARLIKE_HDR(114),
1066     CHARLIKE_HDR(115),
1067     CHARLIKE_HDR(116),
1068     CHARLIKE_HDR(117),
1069     CHARLIKE_HDR(118),
1070     CHARLIKE_HDR(119),
1071     CHARLIKE_HDR(120),
1072     CHARLIKE_HDR(121),
1073     CHARLIKE_HDR(122),
1074     CHARLIKE_HDR(123),
1075     CHARLIKE_HDR(124),
1076     CHARLIKE_HDR(125),
1077     CHARLIKE_HDR(126),
1078     CHARLIKE_HDR(127),
1079     CHARLIKE_HDR(128),
1080     CHARLIKE_HDR(129),
1081     CHARLIKE_HDR(130),
1082     CHARLIKE_HDR(131),
1083     CHARLIKE_HDR(132),
1084     CHARLIKE_HDR(133),
1085     CHARLIKE_HDR(134),
1086     CHARLIKE_HDR(135),
1087     CHARLIKE_HDR(136),
1088     CHARLIKE_HDR(137),
1089     CHARLIKE_HDR(138),
1090     CHARLIKE_HDR(139),
1091     CHARLIKE_HDR(140),
1092     CHARLIKE_HDR(141),
1093     CHARLIKE_HDR(142),
1094     CHARLIKE_HDR(143),
1095     CHARLIKE_HDR(144),
1096     CHARLIKE_HDR(145),
1097     CHARLIKE_HDR(146),
1098     CHARLIKE_HDR(147),
1099     CHARLIKE_HDR(148),
1100     CHARLIKE_HDR(149),
1101     CHARLIKE_HDR(150),
1102     CHARLIKE_HDR(151),
1103     CHARLIKE_HDR(152),
1104     CHARLIKE_HDR(153),
1105     CHARLIKE_HDR(154),
1106     CHARLIKE_HDR(155),
1107     CHARLIKE_HDR(156),
1108     CHARLIKE_HDR(157),
1109     CHARLIKE_HDR(158),
1110     CHARLIKE_HDR(159),
1111     CHARLIKE_HDR(160),
1112     CHARLIKE_HDR(161),
1113     CHARLIKE_HDR(162),
1114     CHARLIKE_HDR(163),
1115     CHARLIKE_HDR(164),
1116     CHARLIKE_HDR(165),
1117     CHARLIKE_HDR(166),
1118     CHARLIKE_HDR(167),
1119     CHARLIKE_HDR(168),
1120     CHARLIKE_HDR(169),
1121     CHARLIKE_HDR(170),
1122     CHARLIKE_HDR(171),
1123     CHARLIKE_HDR(172),
1124     CHARLIKE_HDR(173),
1125     CHARLIKE_HDR(174),
1126     CHARLIKE_HDR(175),
1127     CHARLIKE_HDR(176),
1128     CHARLIKE_HDR(177),
1129     CHARLIKE_HDR(178),
1130     CHARLIKE_HDR(179),
1131     CHARLIKE_HDR(180),
1132     CHARLIKE_HDR(181),
1133     CHARLIKE_HDR(182),
1134     CHARLIKE_HDR(183),
1135     CHARLIKE_HDR(184),
1136     CHARLIKE_HDR(185),
1137     CHARLIKE_HDR(186),
1138     CHARLIKE_HDR(187),
1139     CHARLIKE_HDR(188),
1140     CHARLIKE_HDR(189),
1141     CHARLIKE_HDR(190),
1142     CHARLIKE_HDR(191),
1143     CHARLIKE_HDR(192),
1144     CHARLIKE_HDR(193),
1145     CHARLIKE_HDR(194),
1146     CHARLIKE_HDR(195),
1147     CHARLIKE_HDR(196),
1148     CHARLIKE_HDR(197),
1149     CHARLIKE_HDR(198),
1150     CHARLIKE_HDR(199),
1151     CHARLIKE_HDR(200),
1152     CHARLIKE_HDR(201),
1153     CHARLIKE_HDR(202),
1154     CHARLIKE_HDR(203),
1155     CHARLIKE_HDR(204),
1156     CHARLIKE_HDR(205),
1157     CHARLIKE_HDR(206),
1158     CHARLIKE_HDR(207),
1159     CHARLIKE_HDR(208),
1160     CHARLIKE_HDR(209),
1161     CHARLIKE_HDR(210),
1162     CHARLIKE_HDR(211),
1163     CHARLIKE_HDR(212),
1164     CHARLIKE_HDR(213),
1165     CHARLIKE_HDR(214),
1166     CHARLIKE_HDR(215),
1167     CHARLIKE_HDR(216),
1168     CHARLIKE_HDR(217),
1169     CHARLIKE_HDR(218),
1170     CHARLIKE_HDR(219),
1171     CHARLIKE_HDR(220),
1172     CHARLIKE_HDR(221),
1173     CHARLIKE_HDR(222),
1174     CHARLIKE_HDR(223),
1175     CHARLIKE_HDR(224),
1176     CHARLIKE_HDR(225),
1177     CHARLIKE_HDR(226),
1178     CHARLIKE_HDR(227),
1179     CHARLIKE_HDR(228),
1180     CHARLIKE_HDR(229),
1181     CHARLIKE_HDR(230),
1182     CHARLIKE_HDR(231),
1183     CHARLIKE_HDR(232),
1184     CHARLIKE_HDR(233),
1185     CHARLIKE_HDR(234),
1186     CHARLIKE_HDR(235),
1187     CHARLIKE_HDR(236),
1188     CHARLIKE_HDR(237),
1189     CHARLIKE_HDR(238),
1190     CHARLIKE_HDR(239),
1191     CHARLIKE_HDR(240),
1192     CHARLIKE_HDR(241),
1193     CHARLIKE_HDR(242),
1194     CHARLIKE_HDR(243),
1195     CHARLIKE_HDR(244),
1196     CHARLIKE_HDR(245),
1197     CHARLIKE_HDR(246),
1198     CHARLIKE_HDR(247),
1199     CHARLIKE_HDR(248),
1200     CHARLIKE_HDR(249),
1201     CHARLIKE_HDR(250),
1202     CHARLIKE_HDR(251),
1203     CHARLIKE_HDR(252),
1204     CHARLIKE_HDR(253),
1205     CHARLIKE_HDR(254),
1206     CHARLIKE_HDR(255)
1207 };
1208
1209 StgIntCharlikeClosure stg_INTLIKE_closure[] = {
1210     INTLIKE_HDR(-16),   /* MIN_INTLIKE == -16 */
1211     INTLIKE_HDR(-15),
1212     INTLIKE_HDR(-14),
1213     INTLIKE_HDR(-13),
1214     INTLIKE_HDR(-12),
1215     INTLIKE_HDR(-11),
1216     INTLIKE_HDR(-10),
1217     INTLIKE_HDR(-9),
1218     INTLIKE_HDR(-8),
1219     INTLIKE_HDR(-7),
1220     INTLIKE_HDR(-6),
1221     INTLIKE_HDR(-5),
1222     INTLIKE_HDR(-4),
1223     INTLIKE_HDR(-3),
1224     INTLIKE_HDR(-2),
1225     INTLIKE_HDR(-1),
1226     INTLIKE_HDR(0),
1227     INTLIKE_HDR(1),
1228     INTLIKE_HDR(2),
1229     INTLIKE_HDR(3),
1230     INTLIKE_HDR(4),
1231     INTLIKE_HDR(5),
1232     INTLIKE_HDR(6),
1233     INTLIKE_HDR(7),
1234     INTLIKE_HDR(8),
1235     INTLIKE_HDR(9),
1236     INTLIKE_HDR(10),
1237     INTLIKE_HDR(11),
1238     INTLIKE_HDR(12),
1239     INTLIKE_HDR(13),
1240     INTLIKE_HDR(14),
1241     INTLIKE_HDR(15),
1242     INTLIKE_HDR(16)     /* MAX_INTLIKE == 16 */
1243 };