1 /* -----------------------------------------------------------------------------
2 * $Id: StgMiscClosures.hc,v 1.58 2001/01/15 16:55:25 sewardj Exp $
4 * (c) The GHC Team, 1998-2000
6 * Entry code for various built-in closure types.
8 * ---------------------------------------------------------------------------*/
13 #include "StgMiscClosures.h"
14 #include "HeapStackCheck.h" /* for stg_gen_yield */
16 #include "StoragePriv.h"
17 #include "Profiling.h"
21 #if defined(GRAN) || defined(PAR)
22 # include "GranSimRts.h" /* for DumpRawGranEvent */
23 # include "StgRun.h" /* for StgReturn and register saving */
30 /* ToDo: make the printing of panics more win32-friendly, i.e.,
31 * pop up some lovely message boxes (as well).
33 #define DUMP_ERRMSG(msg) STGCALL2(fprintf,stderr,msg)
36 Template for the entry code of non-enterable closures.
39 #define NON_ENTERABLE_ENTRY_CODE(type) \
40 STGFUN(stg_##type##_entry) \
43 DUMP_ERRMSG(#type " object entered!\n"); \
44 STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \
50 /* -----------------------------------------------------------------------------
51 Support for the bytecode interpreter.
52 -------------------------------------------------------------------------- */
56 /* 9 bits of return code for constructors created by the interpreter. */
57 FN_(stg_interp_constr_entry)
59 /* R1 points at the constructor */
61 STGCALL2(fprintf,stderr,"stg_interp_constr_entry (direct return)!\n");
62 /* Pointless, since SET_TAG doesn't do anything */
63 SET_TAG( GET_TAG(GET_INFO(R1.cl)));
64 JMP_(ENTRY_CODE((P_)(*Sp)));
68 FN_(stg_interp_constr1_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),0)); FE_ }
69 FN_(stg_interp_constr2_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),1)); FE_ }
70 FN_(stg_interp_constr3_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),2)); FE_ }
71 FN_(stg_interp_constr4_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),3)); FE_ }
72 FN_(stg_interp_constr5_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),4)); FE_ }
73 FN_(stg_interp_constr6_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),5)); FE_ }
74 FN_(stg_interp_constr7_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),6)); FE_ }
75 FN_(stg_interp_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); FE_ }
77 /* Some info tables to be used when compiled code returns a value to
78 the interpreter, i.e. the interpreter pushes one of these onto the
79 stack before entering a value. What the code does is to
80 impedance-match the compiled return convention (in R1p/R1n/F1/D1 etc) to
81 the interpreter's convention (returned value is on top of stack),
82 and then cause the scheduler to enter the interpreter.
84 On entry, the stack (growing down) looks like this:
86 ptr to BCO holding return continuation
87 ptr to one of these info tables.
89 The info table code, both direct and vectored, must:
90 * push R1/F1/D1 on the stack, and its tag if necessary
91 * push the BCO (so it's now on the stack twice)
92 * Yield, ie, go to the scheduler.
94 Scheduler examines the t.o.s, discovers it is a BCO, and proceeds
95 directly to the bytecode interpreter. That pops the top element
96 (the BCO, containing the return continuation), and interprets it.
97 Net result: return continuation gets interpreted, with the
101 ptr to the info table just jumped thru
104 which is just what we want -- the "standard" return layout for the
107 Don't ask me how unboxed tuple returns are supposed to work. We
108 haven't got a good story about that yet.
111 /* When the returned value is in R1 and it is a pointer, so doesn't
113 #define STG_CtoI_RET_R1p_Template(label) \
118 bco = ((StgPtr*)Sp)[1]; \
120 ((StgPtr*)Sp)[0] = R1.p; \
122 ((StgPtr*)Sp)[0] = bco; \
123 JMP_(stg_yield_to_interpreter); \
127 STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_entry);
128 STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_0_entry);
129 STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_1_entry);
130 STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_2_entry);
131 STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_3_entry);
132 STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_4_entry);
133 STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_5_entry);
134 STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_6_entry);
135 STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_7_entry);
137 VEC_POLY_INFO_TABLE(stg_ctoi_ret_R1p,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
141 /* When the returned value is in R1 and it isn't a pointer. */
142 #define STG_CtoI_RET_R1n_Template(label) \
147 bco = ((StgPtr*)Sp)[1]; \
149 ((StgPtr*)Sp)[0] = (StgPtr)R1.i; \
151 ((StgPtr*)Sp)[0] = (StgPtr)1; /* tag */ \
153 ((StgPtr*)Sp)[0] = bco; \
154 JMP_(stg_yield_to_interpreter); \
158 STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_entry);
159 STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_0_entry);
160 STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_1_entry);
161 STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_2_entry);
162 STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_3_entry);
163 STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_4_entry);
164 STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_5_entry);
165 STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_6_entry);
166 STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_7_entry);
168 VEC_POLY_INFO_TABLE(stg_ctoi_ret_R1n,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
172 /* When the returned value is in F1 ... */
173 #define STG_CtoI_RET_F1_Template(label) \
178 bco = ((StgPtr*)Sp)[1]; \
179 Sp -= sizeofW(StgFloat); \
180 ASSIGN_FLT((W_*)Sp, F1); \
182 ((StgPtr*)Sp)[0] = (StgPtr)sizeofW(StgFloat); \
184 ((StgPtr*)Sp)[0] = bco; \
185 JMP_(stg_yield_to_interpreter); \
189 STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_entry);
190 STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_0_entry);
191 STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_1_entry);
192 STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_2_entry);
193 STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_3_entry);
194 STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_4_entry);
195 STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_5_entry);
196 STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_6_entry);
197 STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_7_entry);
199 VEC_POLY_INFO_TABLE(stg_ctoi_ret_F1,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
202 /* When the returned value is in D1 ... */
203 #define STG_CtoI_RET_D1_Template(label) \
208 bco = ((StgPtr*)Sp)[1]; \
209 Sp -= sizeofW(StgDouble); \
210 ASSIGN_DBL((W_*)Sp, D1); \
212 ((StgPtr*)Sp)[0] = (StgPtr)sizeofW(StgDouble); \
214 ((StgPtr*)Sp)[0] = bco; \
215 JMP_(stg_yield_to_interpreter); \
219 STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_entry);
220 STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_0_entry);
221 STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_1_entry);
222 STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_2_entry);
223 STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_3_entry);
224 STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_4_entry);
225 STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_5_entry);
226 STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_6_entry);
227 STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_7_entry);
229 VEC_POLY_INFO_TABLE(stg_ctoi_ret_D1,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
232 /* The other way round: when the interpreter returns a value to
233 compiled code. The stack looks like this:
235 return info table (pushed by compiled code)
236 return value (pushed by interpreter)
238 If the value is ptr-rep'd, the interpreter simply returns to the
239 scheduler, instructing it to ThreadEnterGHC.
241 Otherwise (unboxed return value), we replace the top stack word,
242 which must be the tag, with stg_gc_unbx_r1_info (or f1_info or d1_info),
243 and return to the scheduler, instructing it to ThreadRunGHC.
245 No supporting code needed!
249 /* Entering a BCO. Heave it on the stack and defer to the
251 INFO_TABLE(stg_BCO_info,stg_BCO_entry,4,0,BCO,,EF_,"BCO","BCO");
252 STGFUN(stg_BCO_entry) {
256 JMP_(stg_yield_to_interpreter);
263 /* -----------------------------------------------------------------------------
264 Entry code for an indirection.
265 -------------------------------------------------------------------------- */
267 INFO_TABLE(stg_IND_info,stg_IND_entry,1,0,IND,,EF_,0,0);
268 STGFUN(stg_IND_entry)
271 TICK_ENT_IND(Node); /* tick */
273 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
275 JMP_(ENTRY_CODE(*R1.p));
279 INFO_TABLE(stg_IND_STATIC_info,stg_IND_STATIC_entry,1,0,IND_STATIC,,EF_,0,0);
280 STGFUN(stg_IND_STATIC_entry)
283 TICK_ENT_IND(Node); /* tick */
284 R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
286 JMP_(ENTRY_CODE(*R1.p));
290 INFO_TABLE(stg_IND_PERM_info,stg_IND_PERM_entry,1,1,IND_PERM,,EF_,"IND_PERM","IND_PERM");
291 STGFUN(stg_IND_PERM_entry)
294 /* Don't add INDs to granularity cost */
295 /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
297 #if defined(TICKY_TICKY) && !defined(PROFILING)
298 /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */
299 TICK_ENT_PERM_IND(R1.p); /* tick */
302 /* Enter PAP cost centre -- lexical scoping only */
303 ENTER_CCS_PAP_CL(R1.cl);
305 /* For ticky-ticky, change the perm_ind to a normal ind on first
306 * entry, so the number of ent_perm_inds is the number of *thunks*
307 * entered again, not the number of subsequent entries.
309 * Since this screws up cost centres, we die if profiling and
310 * ticky_ticky are on at the same time. KSW 1999-01.
315 # error Profiling and ticky-ticky do not mix at present!
316 # endif /* PROFILING */
317 SET_INFO((StgInd*)R1.p,&IND_info);
318 #endif /* TICKY_TICKY */
320 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
322 /* Dont: TICK_ENT_VIA_NODE(); for ticky-ticky; as above */
324 #if defined(TICKY_TICKY) && !defined(PROFILING)
328 JMP_(ENTRY_CODE(*R1.p));
332 INFO_TABLE(stg_IND_OLDGEN_info,stg_IND_OLDGEN_entry,1,1,IND_OLDGEN,,EF_,0,0);
333 STGFUN(stg_IND_OLDGEN_entry)
336 TICK_ENT_IND(Node); /* tick */
338 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
340 JMP_(ENTRY_CODE(*R1.p));
344 INFO_TABLE(stg_IND_OLDGEN_PERM_info,stg_IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,,EF_,0,0);
345 STGFUN(stg_IND_OLDGEN_PERM_entry)
348 /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
350 #if defined(TICKY_TICKY) && !defined(PROFILING)
351 /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */
352 TICK_ENT_PERM_IND(R1.p); /* tick */
355 /* Enter PAP cost centre -- lexical scoping only */
356 ENTER_CCS_PAP_CL(R1.cl);
358 /* see comment in IND_PERM */
361 # error Profiling and ticky-ticky do not mix at present!
362 # endif /* PROFILING */
363 SET_INFO((StgInd*)R1.p,&IND_OLDGEN_info);
364 #endif /* TICKY_TICKY */
366 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
368 JMP_(ENTRY_CODE(*R1.p));
372 /* -----------------------------------------------------------------------------
375 This code assumes R1 is in a register for now.
376 -------------------------------------------------------------------------- */
378 INFO_TABLE(stg_CAF_UNENTERED_info,stg_CAF_UNENTERED_entry,1,3,CAF_UNENTERED,,EF_,0,0);
379 STGFUN(stg_CAF_UNENTERED_entry)
382 /* ToDo: implement directly in GHC */
385 JMP_(stg_yield_to_interpreter);
389 /* 0,4 is entirely bogus; _do not_ rely on this info */
390 INFO_TABLE(stg_CAF_ENTERED_info,stg_CAF_ENTERED_entry,0,4,CAF_ENTERED,,EF_,0,0);
391 STGFUN(stg_CAF_ENTERED_entry)
394 R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */
396 JMP_(GET_ENTRY(R1.cl));
400 /* -----------------------------------------------------------------------------
401 Entry code for a black hole.
403 Entering a black hole normally causes a cyclic data dependency, but
404 in the concurrent world, black holes are synchronization points,
405 and they are turned into blocking queues when there are threads
406 waiting for the evaluation of the closure to finish.
407 -------------------------------------------------------------------------- */
409 /* Note: a BLACKHOLE and BLACKHOLE_BQ must be big enough to be
410 * overwritten with an indirection/evacuee/catch. Thus we claim it
411 * has 1 non-pointer word of payload (in addition to the pointer word
412 * for the blocking queue in a BQ), which should be big enough for an
413 * old-generation indirection.
416 INFO_TABLE(stg_BLACKHOLE_info, stg_BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,"BLACKHOLE","BLACKHOLE");
417 STGFUN(stg_BLACKHOLE_entry)
421 /* Before overwriting TSO_LINK */
422 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
427 bdescr *bd = Bdescr(R1.p);
428 if (bd->back != (bdescr *)BaseReg) {
429 if (bd->gen->no >= 1 || bd->step->no >= 1) {
430 CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
432 EXTFUN_RTS(stg_gc_enter_1_hponly);
433 JMP_(stg_gc_enter_1_hponly);
440 /* Put ourselves on the blocking queue for this black hole */
441 #if defined(GRAN) || defined(PAR)
442 /* in fact, only difference is the type of the end-of-queue marker! */
443 CurrentTSO->link = END_BQ_QUEUE;
444 ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
446 CurrentTSO->link = END_TSO_QUEUE;
447 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
449 /* jot down why and on what closure we are blocked */
450 CurrentTSO->why_blocked = BlockedOnBlackHole;
451 CurrentTSO->block_info.closure = R1.cl;
452 /* closure is mutable since something has just been added to its BQ */
453 recordMutable((StgMutClosure *)R1.cl);
454 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
455 ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info;
457 /* PAR: dumping of event now done in blockThread -- HWL */
459 /* stg_gen_block is too heavyweight, use a specialised one */
465 INFO_TABLE(stg_BLACKHOLE_BQ_info, stg_BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,"BLACKHOLE","BLACKHOLE");
466 STGFUN(stg_BLACKHOLE_BQ_entry)
470 /* Before overwriting TSO_LINK */
471 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
476 bdescr *bd = Bdescr(R1.p);
477 if (bd->back != (bdescr *)BaseReg) {
478 if (bd->gen->no >= 1 || bd->step->no >= 1) {
479 CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
481 EXTFUN_RTS(stg_gc_enter_1_hponly);
482 JMP_(stg_gc_enter_1_hponly);
490 /* Put ourselves on the blocking queue for this black hole */
491 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
492 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
493 /* jot down why and on what closure we are blocked */
494 CurrentTSO->why_blocked = BlockedOnBlackHole;
495 CurrentTSO->block_info.closure = R1.cl;
497 ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info;
500 /* PAR: dumping of event now done in blockThread -- HWL */
502 /* stg_gen_block is too heavyweight, use a specialised one */
508 Revertible black holes are needed in the parallel world, to handle
509 negative acknowledgements of messages containing updatable closures.
510 The idea is that when the original message is transmitted, the closure
511 is turned into a revertible black hole...an object which acts like a
512 black hole when local threads try to enter it, but which can be reverted
513 back to the original closure if necessary.
515 It's actually a lot like a blocking queue (BQ) entry, because revertible
516 black holes are initially set up with an empty blocking queue.
519 #if defined(PAR) || defined(GRAN)
521 INFO_TABLE(stg_RBH_info, stg_RBH_entry,1,1,RBH,,EF_,0,0);
522 STGFUN(stg_RBH_entry)
526 /* mainly statistics gathering for GranSim simulation */
527 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
530 /* exactly the same as a BLACKHOLE_BQ_entry -- HWL */
531 /* Put ourselves on the blocking queue for this black hole */
532 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
533 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
534 /* jot down why and on what closure we are blocked */
535 CurrentTSO->why_blocked = BlockedOnBlackHole;
536 CurrentTSO->block_info.closure = R1.cl;
538 /* PAR: dumping of event now done in blockThread -- HWL */
540 /* stg_gen_block is too heavyweight, use a specialised one */
545 INFO_TABLE(stg_RBH_Save_0_info, stg_RBH_Save_0_entry,0,2,CONSTR,,EF_,0,0);
546 NON_ENTERABLE_ENTRY_CODE(RBH_Save_0);
548 INFO_TABLE(stg_RBH_Save_1_info, stg_RBH_Save_1_entry,1,1,CONSTR,,EF_,0,0);
549 NON_ENTERABLE_ENTRY_CODE(RBH_Save_1);
551 INFO_TABLE(stg_RBH_Save_2_info, stg_RBH_Save_2_entry,2,0,CONSTR,,EF_,0,0);
552 NON_ENTERABLE_ENTRY_CODE(RBH_Save_2);
553 #endif /* defined(PAR) || defined(GRAN) */
555 /* identical to BLACKHOLEs except for the infotag */
556 INFO_TABLE(stg_CAF_BLACKHOLE_info, stg_CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,"CAF_BLACKHOLE","CAF_BLACKHOLE");
557 STGFUN(stg_CAF_BLACKHOLE_entry)
561 /* mainly statistics gathering for GranSim simulation */
562 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
567 bdescr *bd = Bdescr(R1.p);
568 if (bd->back != (bdescr *)BaseReg) {
569 if (bd->gen->no >= 1 || bd->step->no >= 1) {
570 CMPXCHG(R1.cl->header.info, &CAF_BLACKHOLE_info, &WHITEHOLE_info);
572 EXTFUN_RTS(stg_gc_enter_1_hponly);
573 JMP_(stg_gc_enter_1_hponly);
581 /* Put ourselves on the blocking queue for this black hole */
582 #if defined(GRAN) || defined(PAR)
583 /* in fact, only difference is the type of the end-of-queue marker! */
584 CurrentTSO->link = END_BQ_QUEUE;
585 ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
587 CurrentTSO->link = END_TSO_QUEUE;
588 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
590 /* jot down why and on what closure we are blocked */
591 CurrentTSO->why_blocked = BlockedOnBlackHole;
592 CurrentTSO->block_info.closure = R1.cl;
593 /* closure is mutable since something has just been added to its BQ */
594 recordMutable((StgMutClosure *)R1.cl);
595 /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ */
596 ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info;
598 /* PAR: dumping of event now done in blockThread -- HWL */
600 /* stg_gen_block is too heavyweight, use a specialised one */
606 INFO_TABLE(stg_SE_BLACKHOLE_info, stg_SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,0,0);
607 STGFUN(stg_SE_BLACKHOLE_entry)
610 STGCALL3(fprintf,stderr,"SE_BLACKHOLE at %p entered!\n",R1.p);
611 STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
615 INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,EF_,0,0);
616 STGFUN(stg_SE_CAF_BLACKHOLE_entry)
619 STGCALL3(fprintf,stderr,"SE_CAF_BLACKHOLE at %p entered!\n",R1.p);
620 STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
626 INFO_TABLE(stg_WHITEHOLE_info, stg_WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,EF_,0,0);
627 STGFUN(stg_WHITEHOLE_entry)
630 JMP_(GET_ENTRY(R1.cl));
635 /* -----------------------------------------------------------------------------
636 Some static info tables for things that don't get entered, and
637 therefore don't need entry code (i.e. boxed but unpointed objects)
638 NON_ENTERABLE_ENTRY_CODE now defined at the beginning of the file
639 -------------------------------------------------------------------------- */
641 INFO_TABLE(stg_TSO_info, stg_TSO_entry, 0,0,TSO,,EF_,"TSO","TSO");
642 NON_ENTERABLE_ENTRY_CODE(TSO);
644 /* -----------------------------------------------------------------------------
645 Evacuees are left behind by the garbage collector. Any attempt to enter
647 -------------------------------------------------------------------------- */
649 INFO_TABLE(stg_EVACUATED_info,stg_EVACUATED_entry,1,0,EVACUATED,,EF_,0,0);
650 NON_ENTERABLE_ENTRY_CODE(EVACUATED);
652 /* -----------------------------------------------------------------------------
655 Live weak pointers have a special closure type. Dead ones are just
656 nullary constructors (although they live on the heap - we overwrite
657 live weak pointers with dead ones).
658 -------------------------------------------------------------------------- */
660 INFO_TABLE(stg_WEAK_info,stg_WEAK_entry,0,4,WEAK,,EF_,"WEAK","WEAK");
661 NON_ENTERABLE_ENTRY_CODE(WEAK);
663 INFO_TABLE_CONSTR(stg_DEAD_WEAK_info,stg_DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,"DEAD_WEAK","DEAD_WEAK");
664 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
666 /* -----------------------------------------------------------------------------
669 This is a static nullary constructor (like []) that we use to mark an empty
670 finalizer in a weak pointer object.
671 -------------------------------------------------------------------------- */
673 INFO_TABLE_CONSTR(stg_NO_FINALIZER_info,stg_NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
674 NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
676 SET_STATIC_HDR(stg_NO_FINALIZER_closure,stg_NO_FINALIZER_info,0/*CC*/,,EI_)
679 /* -----------------------------------------------------------------------------
680 Foreign Objects are unlifted and therefore never entered.
681 -------------------------------------------------------------------------- */
683 INFO_TABLE(stg_FOREIGN_info,stg_FOREIGN_entry,0,1,FOREIGN,,EF_,"FOREIGN","FOREIGN");
684 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
686 /* -----------------------------------------------------------------------------
687 Stable Names are unlifted too.
688 -------------------------------------------------------------------------- */
690 INFO_TABLE(stg_STABLE_NAME_info,stg_STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,"STABLE_NAME","STABLE_NAME");
691 NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
693 /* -----------------------------------------------------------------------------
696 There are two kinds of these: full and empty. We need an info table
697 and entry code for each type.
698 -------------------------------------------------------------------------- */
700 INFO_TABLE(stg_FULL_MVAR_info,stg_FULL_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
701 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
703 INFO_TABLE(stg_EMPTY_MVAR_info,stg_EMPTY_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
704 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
706 /* -----------------------------------------------------------------------------
709 This is a static nullary constructor (like []) that we use to mark the
710 end of a linked TSO queue.
711 -------------------------------------------------------------------------- */
713 INFO_TABLE_CONSTR(stg_END_TSO_QUEUE_info,stg_END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
714 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
716 SET_STATIC_HDR(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE_info,0/*CC*/,,EI_)
719 /* -----------------------------------------------------------------------------
722 Mutable lists (used by the garbage collector) consist of a chain of
723 StgMutClosures connected through their mut_link fields, ending in
724 an END_MUT_LIST closure.
725 -------------------------------------------------------------------------- */
727 INFO_TABLE_CONSTR(stg_END_MUT_LIST_info,stg_END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
728 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
730 SET_STATIC_HDR(stg_END_MUT_LIST_closure,stg_END_MUT_LIST_info,0/*CC*/,,EI_)
733 INFO_TABLE(stg_MUT_CONS_info, stg_MUT_CONS_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
734 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
736 /* -----------------------------------------------------------------------------
738 -------------------------------------------------------------------------- */
740 INFO_TABLE_CONSTR(stg_END_EXCEPTION_LIST_info,stg_END_EXCEPTION_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
741 NON_ENTERABLE_ENTRY_CODE(END_EXCEPTION_LIST);
743 SET_STATIC_HDR(stg_END_EXCEPTION_LIST_closure,stg_END_EXCEPTION_LIST_info,0/*CC*/,,EI_)
746 INFO_TABLE(stg_EXCEPTION_CONS_info, stg_EXCEPTION_CONS_entry, 1, 1, CONSTR, , EF_, 0, 0);
747 NON_ENTERABLE_ENTRY_CODE(EXCEPTION_CONS);
749 /* -----------------------------------------------------------------------------
752 These come in two basic flavours: arrays of data (StgArrWords) and arrays of
753 pointers (StgArrPtrs). They all have a similar layout:
755 ___________________________
756 | Info | No. of | data....
758 ---------------------------
760 These are *unpointed* objects: i.e. they cannot be entered.
762 -------------------------------------------------------------------------- */
764 #define ArrayInfo(type) \
765 INFO_TABLE(stg_##type##_info, stg_##type##_entry, 0, 0, type, , EF_,"" # type "","" # type "");
767 ArrayInfo(ARR_WORDS);
768 NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
769 ArrayInfo(MUT_ARR_PTRS);
770 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS);
771 ArrayInfo(MUT_ARR_PTRS_FROZEN);
772 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
776 /* -----------------------------------------------------------------------------
778 -------------------------------------------------------------------------- */
780 INFO_TABLE(stg_MUT_VAR_info, stg_MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, "MUT_VAR", "MUT_VAR");
781 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
783 /* -----------------------------------------------------------------------------
784 Standard Error Entry.
786 This is used for filling in vector-table entries that can never happen,
788 -------------------------------------------------------------------------- */
789 /* No longer used; we use NULL, because a) it never happens, right? and b)
790 Windows doesn't like DLL entry points being used as static initialisers
791 STGFUN(stg_error_entry) \
794 DUMP_ERRMSG("fatal: stg_error_entry"); \
795 STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \
800 /* -----------------------------------------------------------------------------
803 Entering this closure will just return to the address on the top of the
804 stack. Useful for getting a thread in a canonical form where we can
805 just enter the top stack word to start the thread. (see deleteThread)
806 * -------------------------------------------------------------------------- */
808 INFO_TABLE(stg_dummy_ret_info, stg_dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, , EF_, 0, 0);
809 STGFUN(stg_dummy_ret_entry)
815 JMP_(ENTRY_CODE(ret_addr));
818 SET_STATIC_HDR(stg_dummy_ret_closure,stg_dummy_ret_info,CCS_DONT_CARE,,EI_)
821 /* -----------------------------------------------------------------------------
822 Strict IO application - performing an IO action and entering its result.
824 rts_evalIO() lets you perform Haskell IO actions from outside of Haskell-land,
825 returning back to you their result. Want this result to be evaluated to WHNF
826 by that time, so that we can easily get at the int/char/whatever using the
827 various get{Ty} functions provided by the RTS API.
829 forceIO takes care of this, performing the IO action and entering the
830 results that comes back.
832 * -------------------------------------------------------------------------- */
835 INFO_TABLE_SRT_BITMAP(stg_forceIO_ret_info,stg_forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
836 STGFUN(stg_forceIO_ret_entry)
840 Sp -= sizeofW(StgSeqFrame);
842 JMP_(GET_ENTRY(R1.cl));
845 INFO_TABLE_SRT_BITMAP(stg_forceIO_ret_info,stg_forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
846 STGFUN(forceIO_ret_entry)
850 rval = (StgClosure *)Sp[0];
852 Sp -= sizeofW(StgSeqFrame);
855 JMP_(GET_ENTRY(R1.cl));
859 INFO_TABLE(stg_forceIO_info,stg_forceIO_entry,1,0,FUN_STATIC,,EF_,0,0);
860 FN_(stg_forceIO_entry)
863 /* Sp[0] contains the IO action we want to perform */
865 /* Replace it with the return continuation that enters the result. */
866 Sp[0] = (W_)&stg_forceIO_ret_info;
868 /* Push the RealWorld# tag and enter */
869 Sp[0] =(W_)REALWORLD_TAG;
870 JMP_(GET_ENTRY(R1.cl));
873 SET_STATIC_HDR(stg_forceIO_closure,stg_forceIO_info,CCS_DONT_CARE,,EI_)
877 /* -----------------------------------------------------------------------------
878 CHARLIKE and INTLIKE closures.
880 These are static representations of Chars and small Ints, so that
881 we can remove dynamic Chars and Ints during garbage collection and
882 replace them with references to the static objects.
883 -------------------------------------------------------------------------- */
885 #if defined(INTERPRETER) || defined(ENABLE_WIN32_DLL_SUPPORT)
887 * When sticking the RTS in a DLL, we delay populating the
888 * Charlike and Intlike tables until load-time, which is only
889 * when we've got the real addresses to the C# and I# closures.
892 static INFO_TBL_CONST StgInfoTable czh_static_info;
893 static INFO_TBL_CONST StgInfoTable izh_static_info;
894 #define Char_hash_static_info czh_static_info
895 #define Int_hash_static_info izh_static_info
897 #define Char_hash_static_info PrelBase_Czh_static_info
898 #define Int_hash_static_info PrelBase_Izh_static_info
901 #define CHARLIKE_HDR(n) \
903 STATIC_HDR(Char_hash_static_info, /* C# */ \
908 #define INTLIKE_HDR(n) \
910 STATIC_HDR(Int_hash_static_info, /* I# */ \
915 /* put these in the *data* section, since the garbage collector relies
916 * on the fact that static closures live in the data section.
919 /* end the name with _closure, to convince the mangler this is a closure */
921 StgIntCharlikeClosure stg_CHARLIKE_closure[] = {
1180 StgIntCharlikeClosure stg_INTLIKE_closure[] = {
1181 INTLIKE_HDR(-16), /* MIN_INTLIKE == -16 */
1213 INTLIKE_HDR(16) /* MAX_INTLIKE == 16 */