1 /* -----------------------------------------------------------------------------
2 * $Id: StgMiscClosures.hc,v 1.52 2000/12/04 12:31:21 simonmar 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 metacircular interpreter.
52 -------------------------------------------------------------------------- */
56 /* 9 bits of return code for constructors created by mci_make_constr. */
57 FN_(stg_mci_constr_entry)
59 /* R1 points at the constructor */
61 STGCALL2(fprintf,stderr,"mci_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_mci_constr1_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),0)); FE_ }
69 FN_(stg_mci_constr2_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),1)); FE_ }
70 FN_(stg_mci_constr3_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),2)); FE_ }
71 FN_(stg_mci_constr4_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),3)); FE_ }
72 FN_(stg_mci_constr5_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),4)); FE_ }
73 FN_(stg_mci_constr6_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),5)); FE_ }
74 FN_(stg_mci_constr7_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),6)); FE_ }
75 FN_(stg_mci_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); FE_ }
78 /* Since this stuff is ostensibly in some other module, we need
79 to supply an __init_ function.
81 EXTFUN(__init_MCIzumakezuconstr);
82 START_MOD_INIT(__init_MCIzumakezuconstr)
86 INFO_TABLE(mci_make_constr_info, mci_make_constr_entry, 0,0,FUN_STATIC,static,EF_,0,0);
87 INFO_TABLE(mci_make_constr0_info, mci_make_constr0_entry, 0,0,FUN_STATIC,static,EF_,0,0);
88 INFO_TABLE(mci_make_constrI_info, mci_make_constrI_entry, 0,0,FUN_STATIC,static,EF_,0,0);
89 INFO_TABLE(mci_make_constrP_info, mci_make_constrP_entry, 0,0,FUN_STATIC,static,EF_,0,0);
90 INFO_TABLE(mci_make_constrPP_info, mci_make_constrPP_entry, 0,0,FUN_STATIC,static,EF_,0,0);
91 INFO_TABLE(mci_make_constrPPP_info,mci_make_constrPPP_entry,0,0,FUN_STATIC,static,EF_,0,0);
93 SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstr_closure,
94 mci_make_constr_info,0,,EI_)
97 SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstr0_closure,
98 mci_make_constr0_info,0,,EI_)
101 SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrI_closure,
102 mci_make_constrI_info,0,,EI_)
105 SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrP_closure,
106 mci_make_constrP_info,0,,EI_)
109 SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrPP_closure,
110 mci_make_constrPP_info,0,,EI_)
113 SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrPPP_closure,
114 mci_make_constrPPP_info,0,,EI_)
119 /* Make a constructor with no args. */
120 STGFUN(mci_make_constr0_entry)
126 /* Sp[0 & 1] are tag, Addr#
128 itbl = ((StgInfoTable**)Sp)[1];
129 np = INFO_PTR_TO_STRUCT(itbl)->layout.payload.ptrs;
130 nw = INFO_PTR_TO_STRUCT(itbl)->layout.payload.nptrs;
131 size = sizeofW(StgHeader) + stg_max(MIN_NONUPD_SIZE, np+nw);
132 /* STGCALL5(fprintf,stderr,"np %d nw %d size %d\n",np,nw,size); */
134 /* The total number of words to copy off the stack is np + nw.
135 That doesn't include tag words, tho.
137 HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constr_entry, );
138 TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0);
139 CCS_ALLOC(CCCS,size); /* ccs prof */
141 con = (StgClosure*)(Hp + 1 - size);
142 SET_HDR(con, itbl,CCCS);
144 Sp = Sp +2; /* Zap the Addr# arg */
147 JMP_(ENTRY_CODE(GET_INFO(R1.cl)));
151 /* Make a constructor with 1 Int# arg */
152 STGFUN(mci_make_constrI_entry)
158 /* Sp[0 & 1] are tag, Addr#
159 Sp[2 & 3] are tag, Int#
161 itbl = ((StgInfoTable**)Sp)[1];
162 np = INFO_PTR_TO_STRUCT(itbl)->layout.payload.ptrs;
163 nw = INFO_PTR_TO_STRUCT(itbl)->layout.payload.nptrs;
164 size = sizeofW(StgHeader) + stg_max(MIN_NONUPD_SIZE, np+nw);
165 /* STGCALL5(fprintf,stderr,"np %d nw %d size %d\n",np,nw,size); */
167 /* The total number of words to copy off the stack is np + nw.
168 That doesn't include tag words, tho.
170 HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constrI_entry, );
171 TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0);
172 CCS_ALLOC(CCCS,size); /* ccs prof */
174 con = (StgClosure*)(Hp + 1 - size);
175 SET_HDR(con, itbl,CCCS);
177 con->payload[0] = ((StgClosure**)Sp)[3];
178 Sp = Sp +1/*word*/ +1/*tag*/; /* Zap the Int# arg */
179 Sp = Sp +2; /* Zap the Addr# arg */
182 JMP_(ENTRY_CODE(GET_INFO(R1.cl)));
186 STGFUN(mci_make_constrP_entry)
189 DUMP_ERRMSG("mci_make_constrP_entry: unimplemented!\n");
190 STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE);
196 /* Make a constructor with 2 pointer args. */
197 STGFUN(mci_make_constrPP_entry)
203 /* Sp[0 & 1] are tag, Addr#
207 itbl = ((StgInfoTable**)Sp)[1];
208 np = INFO_PTR_TO_STRUCT(itbl)->layout.payload.ptrs;
209 nw = INFO_PTR_TO_STRUCT(itbl)->layout.payload.nptrs;
210 size = sizeofW(StgHeader) + stg_max(MIN_NONUPD_SIZE, np+nw);
211 /* STGCALL5(fprintf,stderr,"np %d nw %d size %d\n",np,nw,size); */
213 /* The total number of words to copy off the stack is np + nw.
214 That doesn't include tag words, tho.
216 HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constrPP_entry, );
217 TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0);
218 CCS_ALLOC(CCCS,size); /* ccs prof */
220 con = (StgClosure*)(Hp + 1 - size);
221 SET_HDR(con, itbl,CCCS);
223 con->payload[0] = ((StgClosure**)Sp)[2];
224 con->payload[1] = ((StgClosure**)Sp)[3];
225 Sp = Sp +2; /* Zap 2 ptr args */
226 Sp = Sp +2; /* Zap the Addr# arg */
229 JMP_(GET_ENTRY(R1.cl));
234 STGFUN(mci_make_constrPPP_entry)
237 DUMP_ERRMSG("mci_make_constrPPP_entry: unimplemented!\n");
238 STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE);
243 /* It would be nice if this worked, but it doesn't. Yet. */
244 STGFUN(mci_make_constr_entry)
246 nat size, np, nw_heap, nw_really, i;
250 /* Sp[0] should be the tag for the itbl */
251 itbl = ((StgInfoTable**)Sp)[1];
253 np = INFO_PTR_TO_STRUCT(itbl)->layout.payload.ptrs;
254 nw_really = INFO_PTR_TO_STRUCT(itbl)->layout.payload.nptrs;
256 nw_heap = stg_max((int)nw_really, MIN_NONUPD_SIZE-np);
257 size = CONSTR_sizeW( np, nw_heap );
260 fprintf(stderr, "np = %d, nw_really = %d, nw_heap = %d, size = %d\n",
261 np, nw_really, nw_heap, size);
264 HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constr_entry, );
265 TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0);
266 CCS_ALLOC(CCCS,size); /* ccs prof */
268 con = (StgClosure*)(Hp + 1 - size);
269 SET_HDR(con, itbl,CCCS);
271 /* set the pointer fields */
272 for (i = 0; i < np; i++) {
273 con->payload[i] = &stg_dummy_ret_closure;
279 JMP_(GET_ENTRY(R1.cl));
286 /* -----------------------------------------------------------------------------
287 Entry code for an indirection.
288 -------------------------------------------------------------------------- */
290 INFO_TABLE(stg_IND_info,stg_IND_entry,1,0,IND,,EF_,0,0);
291 STGFUN(stg_IND_entry)
294 TICK_ENT_IND(Node); /* tick */
296 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
298 JMP_(ENTRY_CODE(*R1.p));
302 INFO_TABLE(stg_IND_STATIC_info,stg_IND_STATIC_entry,1,0,IND_STATIC,,EF_,0,0);
303 STGFUN(stg_IND_STATIC_entry)
306 TICK_ENT_IND(Node); /* tick */
307 R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
309 JMP_(ENTRY_CODE(*R1.p));
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)
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 */
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 */
325 /* Enter PAP cost centre -- lexical scoping only */
326 ENTER_CCS_PAP_CL(R1.cl);
328 /* For ticky-ticky, change the perm_ind to a normal ind on first
329 * entry, so the number of ent_perm_inds is the number of *thunks*
330 * entered again, not the number of subsequent entries.
332 * Since this screws up cost centres, we die if profiling and
333 * ticky_ticky are on at the same time. KSW 1999-01.
338 # error Profiling and ticky-ticky do not mix at present!
339 # endif /* PROFILING */
340 SET_INFO((StgInd*)R1.p,&IND_info);
341 #endif /* TICKY_TICKY */
343 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
345 /* Dont: TICK_ENT_VIA_NODE(); for ticky-ticky; as above */
347 #if defined(TICKY_TICKY) && !defined(PROFILING)
351 JMP_(ENTRY_CODE(*R1.p));
355 INFO_TABLE(stg_IND_OLDGEN_info,stg_IND_OLDGEN_entry,1,1,IND_OLDGEN,,EF_,0,0);
356 STGFUN(stg_IND_OLDGEN_entry)
359 TICK_ENT_IND(Node); /* tick */
361 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
363 JMP_(ENTRY_CODE(*R1.p));
367 INFO_TABLE(stg_IND_OLDGEN_PERM_info,stg_IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,,EF_,0,0);
368 STGFUN(stg_IND_OLDGEN_PERM_entry)
371 /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
373 #if defined(TICKY_TICKY) && !defined(PROFILING)
374 /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */
375 TICK_ENT_PERM_IND(R1.p); /* tick */
378 /* Enter PAP cost centre -- lexical scoping only */
379 ENTER_CCS_PAP_CL(R1.cl);
381 /* see comment in IND_PERM */
384 # error Profiling and ticky-ticky do not mix at present!
385 # endif /* PROFILING */
386 SET_INFO((StgInd*)R1.p,&IND_OLDGEN_info);
387 #endif /* TICKY_TICKY */
389 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
391 JMP_(ENTRY_CODE(*R1.p));
395 /* -----------------------------------------------------------------------------
398 This code assumes R1 is in a register for now.
399 -------------------------------------------------------------------------- */
401 INFO_TABLE(stg_CAF_UNENTERED_info,stg_CAF_UNENTERED_entry,1,3,CAF_UNENTERED,,EF_,0,0);
402 STGFUN(stg_CAF_UNENTERED_entry)
405 /* ToDo: implement directly in GHC */
408 JMP_(stg_yield_to_Hugs);
412 /* 0,4 is entirely bogus; _do not_ rely on this info */
413 INFO_TABLE(stg_CAF_ENTERED_info,stg_CAF_ENTERED_entry,0,4,CAF_ENTERED,,EF_,0,0);
414 STGFUN(stg_CAF_ENTERED_entry)
417 R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */
419 JMP_(GET_ENTRY(R1.cl));
423 /* -----------------------------------------------------------------------------
424 Entry code for a black hole.
426 Entering a black hole normally causes a cyclic data dependency, but
427 in the concurrent world, black holes are synchronization points,
428 and they are turned into blocking queues when there are threads
429 waiting for the evaluation of the closure to finish.
430 -------------------------------------------------------------------------- */
432 /* Note: a BLACKHOLE and BLACKHOLE_BQ must be big enough to be
433 * overwritten with an indirection/evacuee/catch. Thus we claim it
434 * has 1 non-pointer word of payload (in addition to the pointer word
435 * for the blocking queue in a BQ), which should be big enough for an
436 * old-generation indirection.
439 INFO_TABLE(stg_BLACKHOLE_info, stg_BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,"BLACKHOLE","BLACKHOLE");
440 STGFUN(stg_BLACKHOLE_entry)
444 /* Before overwriting TSO_LINK */
445 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
450 bdescr *bd = Bdescr(R1.p);
451 if (bd->back != (bdescr *)BaseReg) {
452 if (bd->gen->no >= 1 || bd->step->no >= 1) {
453 CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
455 EXTFUN_RTS(stg_gc_enter_1_hponly);
456 JMP_(stg_gc_enter_1_hponly);
463 /* Put ourselves on the blocking queue for this black hole */
464 #if defined(GRAN) || defined(PAR)
465 /* in fact, only difference is the type of the end-of-queue marker! */
466 CurrentTSO->link = END_BQ_QUEUE;
467 ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
469 CurrentTSO->link = END_TSO_QUEUE;
470 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
472 /* jot down why and on what closure we are blocked */
473 CurrentTSO->why_blocked = BlockedOnBlackHole;
474 CurrentTSO->block_info.closure = R1.cl;
475 /* closure is mutable since something has just been added to its BQ */
476 recordMutable((StgMutClosure *)R1.cl);
477 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
478 ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info;
480 /* PAR: dumping of event now done in blockThread -- HWL */
482 /* stg_gen_block is too heavyweight, use a specialised one */
488 INFO_TABLE(stg_BLACKHOLE_BQ_info, stg_BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,"BLACKHOLE","BLACKHOLE");
489 STGFUN(stg_BLACKHOLE_BQ_entry)
493 /* Before overwriting TSO_LINK */
494 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
499 bdescr *bd = Bdescr(R1.p);
500 if (bd->back != (bdescr *)BaseReg) {
501 if (bd->gen->no >= 1 || bd->step->no >= 1) {
502 CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
504 EXTFUN_RTS(stg_gc_enter_1_hponly);
505 JMP_(stg_gc_enter_1_hponly);
513 /* Put ourselves on the blocking queue for this black hole */
514 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
515 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
516 /* jot down why and on what closure we are blocked */
517 CurrentTSO->why_blocked = BlockedOnBlackHole;
518 CurrentTSO->block_info.closure = R1.cl;
520 ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info;
523 /* PAR: dumping of event now done in blockThread -- HWL */
525 /* stg_gen_block is too heavyweight, use a specialised one */
531 Revertible black holes are needed in the parallel world, to handle
532 negative acknowledgements of messages containing updatable closures.
533 The idea is that when the original message is transmitted, the closure
534 is turned into a revertible black hole...an object which acts like a
535 black hole when local threads try to enter it, but which can be reverted
536 back to the original closure if necessary.
538 It's actually a lot like a blocking queue (BQ) entry, because revertible
539 black holes are initially set up with an empty blocking queue.
542 #if defined(PAR) || defined(GRAN)
544 INFO_TABLE(stg_RBH_info, stg_RBH_entry,1,1,RBH,,EF_,0,0);
545 STGFUN(stg_RBH_entry)
549 /* mainly statistics gathering for GranSim simulation */
550 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
553 /* exactly the same as a BLACKHOLE_BQ_entry -- HWL */
554 /* Put ourselves on the blocking queue for this black hole */
555 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
556 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
557 /* jot down why and on what closure we are blocked */
558 CurrentTSO->why_blocked = BlockedOnBlackHole;
559 CurrentTSO->block_info.closure = R1.cl;
561 /* PAR: dumping of event now done in blockThread -- HWL */
563 /* stg_gen_block is too heavyweight, use a specialised one */
568 INFO_TABLE(stg_RBH_Save_0_info, stg_RBH_Save_0_entry,0,2,CONSTR,,EF_,0,0);
569 NON_ENTERABLE_ENTRY_CODE(RBH_Save_0);
571 INFO_TABLE(stg_RBH_Save_1_info, stg_RBH_Save_1_entry,1,1,CONSTR,,EF_,0,0);
572 NON_ENTERABLE_ENTRY_CODE(RBH_Save_1);
574 INFO_TABLE(stg_RBH_Save_2_info, stg_RBH_Save_2_entry,2,0,CONSTR,,EF_,0,0);
575 NON_ENTERABLE_ENTRY_CODE(RBH_Save_2);
576 #endif /* defined(PAR) || defined(GRAN) */
578 /* identical to BLACKHOLEs except for the infotag */
579 INFO_TABLE(stg_CAF_BLACKHOLE_info, stg_CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,"CAF_BLACKHOLE","CAF_BLACKHOLE");
580 STGFUN(stg_CAF_BLACKHOLE_entry)
584 /* mainly statistics gathering for GranSim simulation */
585 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
590 bdescr *bd = Bdescr(R1.p);
591 if (bd->back != (bdescr *)BaseReg) {
592 if (bd->gen->no >= 1 || bd->step->no >= 1) {
593 CMPXCHG(R1.cl->header.info, &CAF_BLACKHOLE_info, &WHITEHOLE_info);
595 EXTFUN_RTS(stg_gc_enter_1_hponly);
596 JMP_(stg_gc_enter_1_hponly);
604 /* Put ourselves on the blocking queue for this black hole */
605 #if defined(GRAN) || defined(PAR)
606 /* in fact, only difference is the type of the end-of-queue marker! */
607 CurrentTSO->link = END_BQ_QUEUE;
608 ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
610 CurrentTSO->link = END_TSO_QUEUE;
611 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
613 /* jot down why and on what closure we are blocked */
614 CurrentTSO->why_blocked = BlockedOnBlackHole;
615 CurrentTSO->block_info.closure = R1.cl;
616 /* closure is mutable since something has just been added to its BQ */
617 recordMutable((StgMutClosure *)R1.cl);
618 /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ */
619 ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info;
621 /* PAR: dumping of event now done in blockThread -- HWL */
623 /* stg_gen_block is too heavyweight, use a specialised one */
629 INFO_TABLE(stg_SE_BLACKHOLE_info, stg_SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,0,0);
630 STGFUN(stg_SE_BLACKHOLE_entry)
633 STGCALL3(fprintf,stderr,"SE_BLACKHOLE at %p entered!\n",R1.p);
634 STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
638 INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,EF_,0,0);
639 STGFUN(stg_SE_CAF_BLACKHOLE_entry)
642 STGCALL3(fprintf,stderr,"SE_CAF_BLACKHOLE at %p entered!\n",R1.p);
643 STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
649 INFO_TABLE(stg_WHITEHOLE_info, stg_WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,EF_,0,0);
650 STGFUN(stg_WHITEHOLE_entry)
653 JMP_(GET_ENTRY(R1.cl));
658 /* -----------------------------------------------------------------------------
659 The code for a BCO returns to the scheduler
660 -------------------------------------------------------------------------- */
661 INFO_TABLE(stg_BCO_info,stg_BCO_entry,0,0,BCO,,EF_,"BCO","BCO");
662 STGFUN(stg_BCO_entry) {
666 JMP_(stg_yield_to_Hugs);
670 /* -----------------------------------------------------------------------------
671 Some static info tables for things that don't get entered, and
672 therefore don't need entry code (i.e. boxed but unpointed objects)
673 NON_ENTERABLE_ENTRY_CODE now defined at the beginning of the file
674 -------------------------------------------------------------------------- */
676 INFO_TABLE(stg_TSO_info, stg_TSO_entry, 0,0,TSO,,EF_,"TSO","TSO");
677 NON_ENTERABLE_ENTRY_CODE(TSO);
679 /* -----------------------------------------------------------------------------
680 Evacuees are left behind by the garbage collector. Any attempt to enter
682 -------------------------------------------------------------------------- */
684 INFO_TABLE(stg_EVACUATED_info,stg_EVACUATED_entry,1,0,EVACUATED,,EF_,0,0);
685 NON_ENTERABLE_ENTRY_CODE(EVACUATED);
687 /* -----------------------------------------------------------------------------
690 Live weak pointers have a special closure type. Dead ones are just
691 nullary constructors (although they live on the heap - we overwrite
692 live weak pointers with dead ones).
693 -------------------------------------------------------------------------- */
695 INFO_TABLE(stg_WEAK_info,stg_WEAK_entry,0,4,WEAK,,EF_,"WEAK","WEAK");
696 NON_ENTERABLE_ENTRY_CODE(WEAK);
698 INFO_TABLE_CONSTR(stg_DEAD_WEAK_info,stg_DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,"DEAD_WEAK","DEAD_WEAK");
699 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
701 /* -----------------------------------------------------------------------------
704 This is a static nullary constructor (like []) that we use to mark an empty
705 finalizer in a weak pointer object.
706 -------------------------------------------------------------------------- */
708 INFO_TABLE_CONSTR(stg_NO_FINALIZER_info,stg_NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
709 NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
711 SET_STATIC_HDR(stg_NO_FINALIZER_closure,stg_NO_FINALIZER_info,0/*CC*/,,EI_)
714 /* -----------------------------------------------------------------------------
715 Foreign Objects are unlifted and therefore never entered.
716 -------------------------------------------------------------------------- */
718 INFO_TABLE(stg_FOREIGN_info,stg_FOREIGN_entry,0,1,FOREIGN,,EF_,"FOREIGN","FOREIGN");
719 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
721 /* -----------------------------------------------------------------------------
722 Stable Names are unlifted too.
723 -------------------------------------------------------------------------- */
725 INFO_TABLE(stg_STABLE_NAME_info,stg_STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,"STABLE_NAME","STABLE_NAME");
726 NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
728 /* -----------------------------------------------------------------------------
731 There are two kinds of these: full and empty. We need an info table
732 and entry code for each type.
733 -------------------------------------------------------------------------- */
735 INFO_TABLE(stg_FULL_MVAR_info,stg_FULL_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
736 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
738 INFO_TABLE(stg_EMPTY_MVAR_info,stg_EMPTY_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
739 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
741 /* -----------------------------------------------------------------------------
744 This is a static nullary constructor (like []) that we use to mark the
745 end of a linked TSO queue.
746 -------------------------------------------------------------------------- */
748 INFO_TABLE_CONSTR(stg_END_TSO_QUEUE_info,stg_END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
749 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
751 SET_STATIC_HDR(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE_info,0/*CC*/,,EI_)
754 /* -----------------------------------------------------------------------------
757 Mutable lists (used by the garbage collector) consist of a chain of
758 StgMutClosures connected through their mut_link fields, ending in
759 an END_MUT_LIST closure.
760 -------------------------------------------------------------------------- */
762 INFO_TABLE_CONSTR(stg_END_MUT_LIST_info,stg_END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
763 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
765 SET_STATIC_HDR(stg_END_MUT_LIST_closure,stg_END_MUT_LIST_info,0/*CC*/,,EI_)
768 INFO_TABLE(stg_MUT_CONS_info, stg_MUT_CONS_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
769 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
771 /* -----------------------------------------------------------------------------
773 -------------------------------------------------------------------------- */
775 INFO_TABLE_CONSTR(stg_END_EXCEPTION_LIST_info,stg_END_EXCEPTION_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
776 NON_ENTERABLE_ENTRY_CODE(END_EXCEPTION_LIST);
778 SET_STATIC_HDR(stg_END_EXCEPTION_LIST_closure,stg_END_EXCEPTION_LIST_info,0/*CC*/,,EI_)
781 INFO_TABLE(stg_EXCEPTION_CONS_info, stg_EXCEPTION_CONS_entry, 1, 1, CONSTR, , EF_, 0, 0);
782 NON_ENTERABLE_ENTRY_CODE(EXCEPTION_CONS);
784 /* -----------------------------------------------------------------------------
787 These come in two basic flavours: arrays of data (StgArrWords) and arrays of
788 pointers (StgArrPtrs). They all have a similar layout:
790 ___________________________
791 | Info | No. of | data....
793 ---------------------------
795 These are *unpointed* objects: i.e. they cannot be entered.
797 -------------------------------------------------------------------------- */
799 #define ArrayInfo(type) \
800 INFO_TABLE(stg_##type##_info, stg_##type##_entry, 0, 0, type, , EF_,"" # type "","" # type "");
802 ArrayInfo(ARR_WORDS);
803 NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
804 ArrayInfo(MUT_ARR_PTRS);
805 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS);
806 ArrayInfo(MUT_ARR_PTRS_FROZEN);
807 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
811 /* -----------------------------------------------------------------------------
813 -------------------------------------------------------------------------- */
815 INFO_TABLE(stg_MUT_VAR_info, stg_MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, "MUT_VAR", "MUT_VAR");
816 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
818 /* -----------------------------------------------------------------------------
819 Standard Error Entry.
821 This is used for filling in vector-table entries that can never happen,
823 -------------------------------------------------------------------------- */
824 /* No longer used; we use NULL, because a) it never happens, right? and b)
825 Windows doesn't like DLL entry points being used as static initialisers
826 STGFUN(stg_error_entry) \
829 DUMP_ERRMSG("fatal: stg_error_entry"); \
830 STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \
835 /* -----------------------------------------------------------------------------
838 Entering this closure will just return to the address on the top of the
839 stack. Useful for getting a thread in a canonical form where we can
840 just enter the top stack word to start the thread. (see deleteThread)
841 * -------------------------------------------------------------------------- */
843 INFO_TABLE(stg_dummy_ret_info, stg_dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, , EF_, 0, 0);
844 STGFUN(stg_dummy_ret_entry)
850 JMP_(ENTRY_CODE(ret_addr));
853 SET_STATIC_HDR(stg_dummy_ret_closure,stg_dummy_ret_info,CCS_DONT_CARE,,EI_)
856 /* -----------------------------------------------------------------------------
857 Strict IO application - performing an IO action and entering its result.
859 rts_evalIO() lets you perform Haskell IO actions from outside of Haskell-land,
860 returning back to you their result. Want this result to be evaluated to WHNF
861 by that time, so that we can easily get at the int/char/whatever using the
862 various get{Ty} functions provided by the RTS API.
864 forceIO takes care of this, performing the IO action and entering the
865 results that comes back.
867 * -------------------------------------------------------------------------- */
870 INFO_TABLE_SRT_BITMAP(stg_forceIO_ret_info,stg_forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
871 STGFUN(stg_forceIO_ret_entry)
875 Sp -= sizeofW(StgSeqFrame);
877 JMP_(GET_ENTRY(R1.cl));
880 INFO_TABLE_SRT_BITMAP(stg_forceIO_ret_info,stg_forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
881 STGFUN(forceIO_ret_entry)
885 rval = (StgClosure *)Sp[0];
887 Sp -= sizeofW(StgSeqFrame);
890 JMP_(GET_ENTRY(R1.cl));
894 INFO_TABLE(stg_forceIO_info,stg_forceIO_entry,1,0,FUN_STATIC,,EF_,0,0);
895 FN_(stg_forceIO_entry)
898 /* Sp[0] contains the IO action we want to perform */
900 /* Replace it with the return continuation that enters the result. */
901 Sp[0] = (W_)&stg_forceIO_ret_info;
903 /* Push the RealWorld# tag and enter */
904 Sp[0] =(W_)REALWORLD_TAG;
905 JMP_(GET_ENTRY(R1.cl));
908 SET_STATIC_HDR(stg_forceIO_closure,stg_forceIO_info,CCS_DONT_CARE,,EI_)
912 /* -----------------------------------------------------------------------------
913 Standard Infotables (for use in interpreter)
914 -------------------------------------------------------------------------- */
918 STGFUN(stg_Hugs_CONSTR_entry)
920 /* R1 points at the constructor */
921 JMP_(ENTRY_CODE(((StgPtr*)Sp)[0]));
924 #define RET_BCO_ENTRY_TEMPLATE(label) \
929 ((StgPtr*)Sp)[0] = R1.p; \
930 JMP_(stg_yield_to_Hugs); \
934 RET_BCO_ENTRY_TEMPLATE(stg_ret_bco_entry );
935 RET_BCO_ENTRY_TEMPLATE(stg_ret_bco_0_entry);
936 RET_BCO_ENTRY_TEMPLATE(stg_ret_bco_1_entry);
937 RET_BCO_ENTRY_TEMPLATE(stg_ret_bco_2_entry);
938 RET_BCO_ENTRY_TEMPLATE(stg_ret_bco_3_entry);
939 RET_BCO_ENTRY_TEMPLATE(stg_ret_bco_4_entry);
940 RET_BCO_ENTRY_TEMPLATE(stg_ret_bco_5_entry);
941 RET_BCO_ENTRY_TEMPLATE(stg_ret_bco_6_entry);
942 RET_BCO_ENTRY_TEMPLATE(stg_ret_bco_7_entry);
944 VEC_POLY_INFO_TABLE(stg_ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
946 #endif /* INTERPRETER */
948 /* -----------------------------------------------------------------------------
949 CHARLIKE and INTLIKE closures.
951 These are static representations of Chars and small Ints, so that
952 we can remove dynamic Chars and Ints during garbage collection and
953 replace them with references to the static objects.
954 -------------------------------------------------------------------------- */
956 #if defined(INTERPRETER) || defined(ENABLE_WIN32_DLL_SUPPORT)
958 * When sticking the RTS in a DLL, we delay populating the
959 * Charlike and Intlike tables until load-time, which is only
960 * when we've got the real addresses to the C# and I# closures.
963 static INFO_TBL_CONST StgInfoTable czh_static_info;
964 static INFO_TBL_CONST StgInfoTable izh_static_info;
965 #define Char_hash_static_info czh_static_info
966 #define Int_hash_static_info izh_static_info
968 #define Char_hash_static_info PrelBase_Czh_static_info
969 #define Int_hash_static_info PrelBase_Izh_static_info
972 #define CHARLIKE_HDR(n) \
974 STATIC_HDR(Char_hash_static_info, /* C# */ \
979 #define INTLIKE_HDR(n) \
981 STATIC_HDR(Int_hash_static_info, /* I# */ \
986 /* put these in the *data* section, since the garbage collector relies
987 * on the fact that static closures live in the data section.
990 /* end the name with _closure, to convince the mangler this is a closure */
992 StgIntCharlikeClosure stg_CHARLIKE_closure[] = {
1251 StgIntCharlikeClosure stg_INTLIKE_closure[] = {
1252 INTLIKE_HDR(-16), /* MIN_INTLIKE == -16 */
1284 INTLIKE_HDR(16) /* MAX_INTLIKE == 16 */