1 /* -----------------------------------------------------------------------------
2 * $Id: StgMiscClosures.hc,v 1.49 2000/10/09 11:41:43 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"
20 #if defined(GRAN) || defined(PAR)
21 # include "GranSimRts.h" /* for DumpRawGranEvent */
22 # include "StgRun.h" /* for StgReturn and register saving */
29 /* ToDo: make the printing of panics more win32-friendly, i.e.,
30 * pop up some lovely message boxes (as well).
32 #define DUMP_ERRMSG(msg) STGCALL2(fprintf,stderr,msg)
35 Template for the entry code of non-enterable closures.
38 #define NON_ENTERABLE_ENTRY_CODE(type) \
39 STGFUN(type##_entry) \
42 DUMP_ERRMSG(#type " object entered!\n"); \
43 STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \
49 /* -----------------------------------------------------------------------------
50 Support for the metacircular interpreter.
51 -------------------------------------------------------------------------- */
55 /* 9 bits of return code for constructors created by mci_make_constr. */
58 /* R1 points at the constructor */
60 STGCALL2(fprintf,stderr,"mci_constr_entry (direct return)!\n");
61 /* Pointless, since SET_TAG doesn't do anything */
62 SET_TAG( GET_TAG(GET_INFO(R1.cl)));
63 JMP_(ENTRY_CODE((P_)(*Sp)));
67 FN_(mci_constr1_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),0)); FE_ }
68 FN_(mci_constr2_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),1)); FE_ }
69 FN_(mci_constr3_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),2)); FE_ }
70 FN_(mci_constr4_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),3)); FE_ }
71 FN_(mci_constr5_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),4)); FE_ }
72 FN_(mci_constr6_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),5)); FE_ }
73 FN_(mci_constr7_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),6)); FE_ }
74 FN_(mci_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); FE_ }
77 /* Since this stuff is ostensibly in some other module, we need
78 to supply an __init_ function.
80 START_MOD_INIT(__init_MCIzumakezuconstr)
84 INFO_TABLE(mci_make_constr_info, mci_make_constr_entry, 0,0,FUN_STATIC,,EF_,0,0);
85 INFO_TABLE(mci_make_constrI_info, mci_make_constrI_entry, 0,0,FUN_STATIC,,EF_,0,0);
86 INFO_TABLE(mci_make_constrP_info, mci_make_constrP_entry, 0,0,FUN_STATIC,,EF_,0,0);
87 INFO_TABLE(mci_make_constrPP_info, mci_make_constrPP_entry, 0,0,FUN_STATIC,,EF_,0,0);
88 INFO_TABLE(mci_make_constrPPP_info,mci_make_constrPPP_entry,0,0,FUN_STATIC,,EF_,0,0);
90 SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstr_closure,
91 mci_make_constr_info,0,,EI_)
94 SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrI_closure,
95 mci_make_constrI_info,0,,EI_)
98 SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrP_closure,
99 mci_make_constrP_info,0,,EI_)
102 SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrPP_closure,
103 mci_make_constrPP_info,0,,EI_)
106 SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrPPP_closure,
107 mci_make_constrPPP_info,0,,EI_)
112 /* Make a constructor with no args. */
113 STGFUN(mci_make_constr_entry)
119 /* Sp[0 & 1] are tag, Addr#
121 itbl = ((StgInfoTable**)Sp)[1];
122 np = INFO_PTR_TO_STRUCT(itbl)->layout.payload.ptrs;
123 nw = INFO_PTR_TO_STRUCT(itbl)->layout.payload.nptrs;
124 size = sizeofW(StgHeader) + stg_max(MIN_NONUPD_SIZE, np+nw);
125 /* STGCALL5(fprintf,stderr,"np %d nw %d size %d\n",np,nw,size); */
127 /* The total number of words to copy off the stack is np + nw.
128 That doesn't include tag words, tho.
130 HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constr_entry, );
131 TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0);
132 CCS_ALLOC(CCCS,size); /* ccs prof */
134 con = (StgClosure*)(Hp + 1 - size);
135 SET_HDR(con, itbl,CCCS);
137 Sp = Sp +2; /* Zap the Addr# arg */
140 JMP_(ENTRY_CODE(GET_INFO(R1.cl)));
144 /* Make a constructor with 1 Int# arg */
145 STGFUN(mci_make_constrI_entry)
151 /* Sp[0 & 1] are tag, Addr#
152 Sp[2 & 3] are tag, Int#
154 itbl = ((StgInfoTable**)Sp)[1];
155 np = INFO_PTR_TO_STRUCT(itbl)->layout.payload.ptrs;
156 nw = INFO_PTR_TO_STRUCT(itbl)->layout.payload.nptrs;
157 size = sizeofW(StgHeader) + stg_max(MIN_NONUPD_SIZE, np+nw);
158 /* STGCALL5(fprintf,stderr,"np %d nw %d size %d\n",np,nw,size); */
160 /* The total number of words to copy off the stack is np + nw.
161 That doesn't include tag words, tho.
163 HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constrI_entry, );
164 TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0);
165 CCS_ALLOC(CCCS,size); /* ccs prof */
167 con = (StgClosure*)(Hp + 1 - size);
168 SET_HDR(con, itbl,CCCS);
170 con->payload[0] = ((StgClosure**)Sp)[3];
171 Sp = Sp +1/*word*/ +1/*tag*/; /* Zap the Int# arg */
172 Sp = Sp +2; /* Zap the Addr# arg */
175 JMP_(ENTRY_CODE(GET_INFO(R1.cl)));
179 STGFUN(mci_make_constrP_entry)
182 DUMP_ERRMSG("mci_make_constrP_entry: unimplemented!\n");
183 STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE);
189 /* Make a constructor with 2 pointer args. */
190 STGFUN(mci_make_constrPP_entry)
196 /* Sp[0 & 1] are tag, Addr#
200 itbl = ((StgInfoTable**)Sp)[1];
201 np = INFO_PTR_TO_STRUCT(itbl)->layout.payload.ptrs;
202 nw = INFO_PTR_TO_STRUCT(itbl)->layout.payload.nptrs;
203 size = sizeofW(StgHeader) + stg_max(MIN_NONUPD_SIZE, np+nw);
204 /* STGCALL5(fprintf,stderr,"np %d nw %d size %d\n",np,nw,size); */
206 /* The total number of words to copy off the stack is np + nw.
207 That doesn't include tag words, tho.
209 HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constrPP_entry, );
210 TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0);
211 CCS_ALLOC(CCCS,size); /* ccs prof */
213 con = (StgClosure*)(Hp + 1 - size);
214 SET_HDR(con, itbl,CCCS);
216 con->payload[0] = ((StgClosure**)Sp)[2];
217 con->payload[1] = ((StgClosure**)Sp)[3];
218 Sp = Sp +2; /* Zap 2 ptr args */
219 Sp = Sp +2; /* Zap the Addr# arg */
222 JMP_(ENTRY_CODE(GET_INFO(R1.cl)));
227 STGFUN(mci_make_constrPPP_entry)
230 DUMP_ERRMSG("mci_make_constrPPP_entry: unimplemented!\n");
231 STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE);
237 /* It would be nice if this worked, but it doesn't. Yet. */
238 STGFUN(mci_make_constr_entry)
240 nat size, np, nw_heap, nw_really, w;
245 itbl = ((StgInfoTable**)Sp)[0];
246 STGCALL3(fprintf,stderr,"mmc: itbl = %d\n",itbl);
248 STGCALL3(fprintf,stderr,"mmc: sp-4 = %d\n", ((W_*)Sp)[-4] );
249 STGCALL3(fprintf,stderr,"mmc: sp-3 = %d\n", ((W_*)Sp)[-3] );
250 STGCALL3(fprintf,stderr,"mmc: sp-2 = %d\n", ((W_*)Sp)[-2] );
251 STGCALL3(fprintf,stderr,"mmc: sp-1 = %d\n", ((W_*)Sp)[-1] );
252 STGCALL3(fprintf,stderr,"mmc: sp+0 = %d\n", ((W_*)Sp)[0] );
253 STGCALL3(fprintf,stderr,"mmc: sp+1 = %d\n", ((W_*)Sp)[1] );
254 STGCALL3(fprintf,stderr,"mmc: sp+2 = %d\n", ((W_*)Sp)[2] );
255 STGCALL3(fprintf,stderr,"mmc: sp+3 = %d\n", ((W_*)Sp)[3] );
256 STGCALL3(fprintf,stderr,"mmc: sp+4 = %d\n", ((W_*)Sp)[4] );
257 np = itbl->layout.payload.ptrs;
258 nw_really = itbl->layout.payload.nptrs;
259 nw_heap = stg_max(nw_really, MIN_NONUPD_SIZE-np);
260 size = CONSTR_sizeW( np, nw_heap );
262 /* The total number of words to copy off the stack is np + nw.
263 That doesn't include tag words, tho.
265 HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constr_entry, );
266 TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0);
267 CCS_ALLOC(CCCS,size); /* ccs prof */
269 con = (StgClosure*)(Hp + 1 - size);
270 SET_HDR(con, itbl,CCCS);
272 /* Copy into the closure. */
276 if (w == np + nw) break;
278 if (IS_ARG_TAG(*r)) {
281 con->payload[w++] = (StgClosure*)(*r++);
283 con->payload[w++] = (StgClosure*)(*r++);
285 ASSERT((P_)r <= (P_)Su);
288 /* Remove all the args we've used. */
292 JMP_(ENTRY_CODE(R1.cl));
300 /* -----------------------------------------------------------------------------
301 Entry code for an indirection.
302 -------------------------------------------------------------------------- */
304 INFO_TABLE(IND_info,IND_entry,1,0,IND,,EF_,0,0);
308 TICK_ENT_IND(Node); /* tick */
310 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
312 JMP_(ENTRY_CODE(*R1.p));
316 INFO_TABLE(IND_STATIC_info,IND_STATIC_entry,1,0,IND_STATIC,,EF_,0,0);
317 STGFUN(IND_STATIC_entry)
320 TICK_ENT_IND(Node); /* tick */
321 R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
323 JMP_(ENTRY_CODE(*R1.p));
327 INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,,EF_,"IND_PERM","IND_PERM");
328 STGFUN(IND_PERM_entry)
331 /* Don't add INDs to granularity cost */
332 /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
334 #if defined(TICKY_TICKY) && !defined(PROFILING)
335 /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */
336 TICK_ENT_PERM_IND(R1.p); /* tick */
339 /* Enter PAP cost centre -- lexical scoping only */
340 ENTER_CCS_PAP_CL(R1.cl);
342 /* For ticky-ticky, change the perm_ind to a normal ind on first
343 * entry, so the number of ent_perm_inds is the number of *thunks*
344 * entered again, not the number of subsequent entries.
346 * Since this screws up cost centres, we die if profiling and
347 * ticky_ticky are on at the same time. KSW 1999-01.
352 # error Profiling and ticky-ticky do not mix at present!
353 # endif /* PROFILING */
354 SET_INFO((StgInd*)R1.p,&IND_info);
355 #endif /* TICKY_TICKY */
357 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
359 /* Dont: TICK_ENT_VIA_NODE(); for ticky-ticky; as above */
361 #if defined(TICKY_TICKY) && !defined(PROFILING)
365 JMP_(ENTRY_CODE(*R1.p));
369 INFO_TABLE(IND_OLDGEN_info,IND_OLDGEN_entry,1,1,IND_OLDGEN,,EF_,0,0);
370 STGFUN(IND_OLDGEN_entry)
373 TICK_ENT_IND(Node); /* tick */
375 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
377 JMP_(ENTRY_CODE(*R1.p));
381 INFO_TABLE(IND_OLDGEN_PERM_info,IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,,EF_,0,0);
382 STGFUN(IND_OLDGEN_PERM_entry)
385 /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
387 #if defined(TICKY_TICKY) && !defined(PROFILING)
388 /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */
389 TICK_ENT_PERM_IND(R1.p); /* tick */
392 /* Enter PAP cost centre -- lexical scoping only */
393 ENTER_CCS_PAP_CL(R1.cl);
395 /* see comment in IND_PERM */
398 # error Profiling and ticky-ticky do not mix at present!
399 # endif /* PROFILING */
400 SET_INFO((StgInd*)R1.p,&IND_OLDGEN_info);
401 #endif /* TICKY_TICKY */
403 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
405 JMP_(ENTRY_CODE(*R1.p));
409 /* -----------------------------------------------------------------------------
412 This code assumes R1 is in a register for now.
413 -------------------------------------------------------------------------- */
415 INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,3,CAF_UNENTERED,,EF_,0,0);
416 STGFUN(CAF_UNENTERED_entry)
419 /* ToDo: implement directly in GHC */
422 JMP_(stg_yield_to_Hugs);
426 /* 0,4 is entirely bogus; _do not_ rely on this info */
427 INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,0,4,CAF_ENTERED,,EF_,0,0);
428 STGFUN(CAF_ENTERED_entry)
431 R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */
433 JMP_(GET_ENTRY(R1.cl));
437 /* -----------------------------------------------------------------------------
438 Entry code for a black hole.
440 Entering a black hole normally causes a cyclic data dependency, but
441 in the concurrent world, black holes are synchronization points,
442 and they are turned into blocking queues when there are threads
443 waiting for the evaluation of the closure to finish.
444 -------------------------------------------------------------------------- */
446 /* Note: a BLACKHOLE and BLACKHOLE_BQ must be big enough to be
447 * overwritten with an indirection/evacuee/catch. Thus we claim it
448 * has 1 non-pointer word of payload (in addition to the pointer word
449 * for the blocking queue in a BQ), which should be big enough for an
450 * old-generation indirection.
453 INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,"BLACKHOLE","BLACKHOLE");
454 STGFUN(BLACKHOLE_entry)
458 /* Before overwriting TSO_LINK */
459 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
464 bdescr *bd = Bdescr(R1.p);
465 if (bd->back != (bdescr *)BaseReg) {
466 if (bd->gen->no >= 1 || bd->step->no >= 1) {
467 CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
469 EXTFUN_RTS(stg_gc_enter_1_hponly);
470 JMP_(stg_gc_enter_1_hponly);
477 /* Put ourselves on the blocking queue for this black hole */
478 #if defined(GRAN) || defined(PAR)
479 /* in fact, only difference is the type of the end-of-queue marker! */
480 CurrentTSO->link = END_BQ_QUEUE;
481 ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
483 CurrentTSO->link = END_TSO_QUEUE;
484 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
486 /* jot down why and on what closure we are blocked */
487 CurrentTSO->why_blocked = BlockedOnBlackHole;
488 CurrentTSO->block_info.closure = R1.cl;
489 /* closure is mutable since something has just been added to its BQ */
490 recordMutable((StgMutClosure *)R1.cl);
491 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
492 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
494 /* PAR: dumping of event now done in blockThread -- HWL */
496 /* stg_gen_block is too heavyweight, use a specialised one */
502 INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,"BLACKHOLE","BLACKHOLE");
503 STGFUN(BLACKHOLE_BQ_entry)
507 /* Before overwriting TSO_LINK */
508 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
513 bdescr *bd = Bdescr(R1.p);
514 if (bd->back != (bdescr *)BaseReg) {
515 if (bd->gen->no >= 1 || bd->step->no >= 1) {
516 CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
518 EXTFUN_RTS(stg_gc_enter_1_hponly);
519 JMP_(stg_gc_enter_1_hponly);
527 /* Put ourselves on the blocking queue for this black hole */
528 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
529 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
530 /* jot down why and on what closure we are blocked */
531 CurrentTSO->why_blocked = BlockedOnBlackHole;
532 CurrentTSO->block_info.closure = R1.cl;
534 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
537 /* PAR: dumping of event now done in blockThread -- HWL */
539 /* stg_gen_block is too heavyweight, use a specialised one */
545 Revertible black holes are needed in the parallel world, to handle
546 negative acknowledgements of messages containing updatable closures.
547 The idea is that when the original message is transmitted, the closure
548 is turned into a revertible black hole...an object which acts like a
549 black hole when local threads try to enter it, but which can be reverted
550 back to the original closure if necessary.
552 It's actually a lot like a blocking queue (BQ) entry, because revertible
553 black holes are initially set up with an empty blocking queue.
556 #if defined(PAR) || defined(GRAN)
558 INFO_TABLE(RBH_info, RBH_entry,1,1,RBH,,EF_,0,0);
563 /* mainly statistics gathering for GranSim simulation */
564 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
567 /* exactly the same as a BLACKHOLE_BQ_entry -- HWL */
568 /* Put ourselves on the blocking queue for this black hole */
569 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
570 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
571 /* jot down why and on what closure we are blocked */
572 CurrentTSO->why_blocked = BlockedOnBlackHole;
573 CurrentTSO->block_info.closure = R1.cl;
575 /* PAR: dumping of event now done in blockThread -- HWL */
577 /* stg_gen_block is too heavyweight, use a specialised one */
582 INFO_TABLE(RBH_Save_0_info, RBH_Save_0_entry,0,2,CONSTR,,EF_,0,0);
583 NON_ENTERABLE_ENTRY_CODE(RBH_Save_0);
585 INFO_TABLE(RBH_Save_1_info, RBH_Save_1_entry,1,1,CONSTR,,EF_,0,0);
586 NON_ENTERABLE_ENTRY_CODE(RBH_Save_1);
588 INFO_TABLE(RBH_Save_2_info, RBH_Save_2_entry,2,0,CONSTR,,EF_,0,0);
589 NON_ENTERABLE_ENTRY_CODE(RBH_Save_2);
590 #endif /* defined(PAR) || defined(GRAN) */
592 /* identical to BLACKHOLEs except for the infotag */
593 INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,"CAF_BLACKHOLE","CAF_BLACKHOLE");
594 STGFUN(CAF_BLACKHOLE_entry)
598 /* mainly statistics gathering for GranSim simulation */
599 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
604 bdescr *bd = Bdescr(R1.p);
605 if (bd->back != (bdescr *)BaseReg) {
606 if (bd->gen->no >= 1 || bd->step->no >= 1) {
607 CMPXCHG(R1.cl->header.info, &CAF_BLACKHOLE_info, &WHITEHOLE_info);
609 EXTFUN_RTS(stg_gc_enter_1_hponly);
610 JMP_(stg_gc_enter_1_hponly);
618 /* Put ourselves on the blocking queue for this black hole */
619 #if defined(GRAN) || defined(PAR)
620 /* in fact, only difference is the type of the end-of-queue marker! */
621 CurrentTSO->link = END_BQ_QUEUE;
622 ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
624 CurrentTSO->link = END_TSO_QUEUE;
625 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
627 /* jot down why and on what closure we are blocked */
628 CurrentTSO->why_blocked = BlockedOnBlackHole;
629 CurrentTSO->block_info.closure = R1.cl;
630 /* closure is mutable since something has just been added to its BQ */
631 recordMutable((StgMutClosure *)R1.cl);
632 /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ */
633 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
635 /* PAR: dumping of event now done in blockThread -- HWL */
637 /* stg_gen_block is too heavyweight, use a specialised one */
643 INFO_TABLE(SE_BLACKHOLE_info, SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,0,0);
644 STGFUN(SE_BLACKHOLE_entry)
647 STGCALL3(fprintf,stderr,"SE_BLACKHOLE at %p entered!\n",R1.p);
648 STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
652 INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,EF_,0,0);
653 STGFUN(SE_CAF_BLACKHOLE_entry)
656 STGCALL3(fprintf,stderr,"SE_CAF_BLACKHOLE at %p entered!\n",R1.p);
657 STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
663 INFO_TABLE(WHITEHOLE_info, WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,EF_,0,0);
664 STGFUN(WHITEHOLE_entry)
667 JMP_(GET_ENTRY(R1.cl));
672 /* -----------------------------------------------------------------------------
673 The code for a BCO returns to the scheduler
674 -------------------------------------------------------------------------- */
675 INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,,EF_,"BCO","BCO");
680 JMP_(stg_yield_to_Hugs);
684 /* -----------------------------------------------------------------------------
685 Some static info tables for things that don't get entered, and
686 therefore don't need entry code (i.e. boxed but unpointed objects)
687 NON_ENTERABLE_ENTRY_CODE now defined at the beginning of the file
688 -------------------------------------------------------------------------- */
690 INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,,EF_,"TSO","TSO");
691 NON_ENTERABLE_ENTRY_CODE(TSO);
693 /* -----------------------------------------------------------------------------
694 Evacuees are left behind by the garbage collector. Any attempt to enter
696 -------------------------------------------------------------------------- */
698 INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,,EF_,0,0);
699 NON_ENTERABLE_ENTRY_CODE(EVACUATED);
701 /* -----------------------------------------------------------------------------
704 Live weak pointers have a special closure type. Dead ones are just
705 nullary constructors (although they live on the heap - we overwrite
706 live weak pointers with dead ones).
707 -------------------------------------------------------------------------- */
709 INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,,EF_,"WEAK","WEAK");
710 NON_ENTERABLE_ENTRY_CODE(WEAK);
712 INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,"DEAD_WEAK","DEAD_WEAK");
713 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
715 /* -----------------------------------------------------------------------------
718 This is a static nullary constructor (like []) that we use to mark an empty
719 finalizer in a weak pointer object.
720 -------------------------------------------------------------------------- */
722 INFO_TABLE_CONSTR(NO_FINALIZER_info,NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
723 NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
725 SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_)
728 /* -----------------------------------------------------------------------------
729 Foreign Objects are unlifted and therefore never entered.
730 -------------------------------------------------------------------------- */
732 INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,,EF_,"FOREIGN","FOREIGN");
733 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
735 /* -----------------------------------------------------------------------------
736 Stable Names are unlifted too.
737 -------------------------------------------------------------------------- */
739 INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,"STABLE_NAME","STABLE_NAME");
740 NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
742 /* -----------------------------------------------------------------------------
745 There are two kinds of these: full and empty. We need an info table
746 and entry code for each type.
747 -------------------------------------------------------------------------- */
749 INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
750 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
752 INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
753 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
755 /* -----------------------------------------------------------------------------
758 This is a static nullary constructor (like []) that we use to mark the
759 end of a linked TSO queue.
760 -------------------------------------------------------------------------- */
762 INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
763 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
765 SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
768 /* -----------------------------------------------------------------------------
771 Mutable lists (used by the garbage collector) consist of a chain of
772 StgMutClosures connected through their mut_link fields, ending in
773 an END_MUT_LIST closure.
774 -------------------------------------------------------------------------- */
776 INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
777 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
779 SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
782 INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
783 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
785 /* -----------------------------------------------------------------------------
787 -------------------------------------------------------------------------- */
789 INFO_TABLE_CONSTR(END_EXCEPTION_LIST_info,END_EXCEPTION_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
790 NON_ENTERABLE_ENTRY_CODE(END_EXCEPTION_LIST);
792 SET_STATIC_HDR(END_EXCEPTION_LIST_closure,END_EXCEPTION_LIST_info,0/*CC*/,,EI_)
795 INFO_TABLE(EXCEPTION_CONS_info, EXCEPTION_CONS_entry, 1, 1, CONSTR, , EF_, 0, 0);
796 NON_ENTERABLE_ENTRY_CODE(EXCEPTION_CONS);
798 /* -----------------------------------------------------------------------------
801 These come in two basic flavours: arrays of data (StgArrWords) and arrays of
802 pointers (StgArrPtrs). They all have a similar layout:
804 ___________________________
805 | Info | No. of | data....
807 ---------------------------
809 These are *unpointed* objects: i.e. they cannot be entered.
811 -------------------------------------------------------------------------- */
813 #define ArrayInfo(type) \
814 INFO_TABLE(type##_info, type##_entry, 0, 0, type, , EF_,"" # type "","" # type "");
816 ArrayInfo(ARR_WORDS);
817 NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
818 ArrayInfo(MUT_ARR_PTRS);
819 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS);
820 ArrayInfo(MUT_ARR_PTRS_FROZEN);
821 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
825 /* -----------------------------------------------------------------------------
827 -------------------------------------------------------------------------- */
829 INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, "MUT_VAR", "MUT_VAR");
830 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
832 /* -----------------------------------------------------------------------------
833 Standard Error Entry.
835 This is used for filling in vector-table entries that can never happen,
837 -------------------------------------------------------------------------- */
838 /* No longer used; we use NULL, because a) it never happens, right? and b)
839 Windows doesn't like DLL entry points being used as static initialisers
840 STGFUN(stg_error_entry) \
843 DUMP_ERRMSG("fatal: stg_error_entry"); \
844 STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \
849 /* -----------------------------------------------------------------------------
852 Entering this closure will just return to the address on the top of the
853 stack. Useful for getting a thread in a canonical form where we can
854 just enter the top stack word to start the thread. (see deleteThread)
855 * -------------------------------------------------------------------------- */
857 INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, , EF_, 0, 0);
864 JMP_(ENTRY_CODE(ret_addr));
867 SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONT_CARE,,EI_)
870 /* -----------------------------------------------------------------------------
871 Strict IO application - performing an IO action and entering its result.
873 rts_evalIO() lets you perform Haskell IO actions from outside of Haskell-land,
874 returning back to you their result. Want this result to be evaluated to WHNF
875 by that time, so that we can easily get at the int/char/whatever using the
876 various get{Ty} functions provided by the RTS API.
878 forceIO takes care of this, performing the IO action and entering the
879 results that comes back.
881 * -------------------------------------------------------------------------- */
884 INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
885 FN_(forceIO_ret_entry)
889 Sp -= sizeofW(StgSeqFrame);
891 JMP_(GET_ENTRY(R1.cl));
894 INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
895 FN_(forceIO_ret_entry)
899 rval = (StgClosure *)Sp[0];
901 Sp -= sizeofW(StgSeqFrame);
904 JMP_(GET_ENTRY(R1.cl));
908 INFO_TABLE(forceIO_info,forceIO_entry,1,0,FUN_STATIC,,EF_,0,0);
912 /* Sp[0] contains the IO action we want to perform */
914 /* Replace it with the return continuation that enters the result. */
915 Sp[0] = (W_)&forceIO_ret_info;
917 /* Push the RealWorld# tag and enter */
918 Sp[0] =(W_)REALWORLD_TAG;
919 JMP_(GET_ENTRY(R1.cl));
922 SET_STATIC_HDR(forceIO_closure,forceIO_info,CCS_DONT_CARE,,EI_)
926 /* -----------------------------------------------------------------------------
927 Standard Infotables (for use in interpreter)
928 -------------------------------------------------------------------------- */
932 STGFUN(Hugs_CONSTR_entry)
934 /* R1 points at the constructor */
935 JMP_(ENTRY_CODE(((StgPtr*)Sp)[0]));
938 #define RET_BCO_ENTRY_TEMPLATE(label) \
943 ((StgPtr*)Sp)[0] = R1.p; \
944 JMP_(stg_yield_to_Hugs); \
948 RET_BCO_ENTRY_TEMPLATE(ret_bco_entry );
949 RET_BCO_ENTRY_TEMPLATE(ret_bco_0_entry);
950 RET_BCO_ENTRY_TEMPLATE(ret_bco_1_entry);
951 RET_BCO_ENTRY_TEMPLATE(ret_bco_2_entry);
952 RET_BCO_ENTRY_TEMPLATE(ret_bco_3_entry);
953 RET_BCO_ENTRY_TEMPLATE(ret_bco_4_entry);
954 RET_BCO_ENTRY_TEMPLATE(ret_bco_5_entry);
955 RET_BCO_ENTRY_TEMPLATE(ret_bco_6_entry);
956 RET_BCO_ENTRY_TEMPLATE(ret_bco_7_entry);
958 VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
960 #endif /* INTERPRETER */
962 /* -----------------------------------------------------------------------------
963 CHARLIKE and INTLIKE closures.
965 These are static representations of Chars and small Ints, so that
966 we can remove dynamic Chars and Ints during garbage collection and
967 replace them with references to the static objects.
968 -------------------------------------------------------------------------- */
970 #if defined(INTERPRETER) || defined(ENABLE_WIN32_DLL_SUPPORT)
972 * When sticking the RTS in a DLL, we delay populating the
973 * Charlike and Intlike tables until load-time, which is only
974 * when we've got the real addresses to the C# and I# closures.
977 static INFO_TBL_CONST StgInfoTable czh_static_info;
978 static INFO_TBL_CONST StgInfoTable izh_static_info;
979 #define Char_hash_static_info czh_static_info
980 #define Int_hash_static_info izh_static_info
982 #define Char_hash_static_info PrelBase_Czh_static_info
983 #define Int_hash_static_info PrelBase_Izh_static_info
986 #define CHARLIKE_HDR(n) \
988 STATIC_HDR(Char_hash_static_info, /* C# */ \
993 #define INTLIKE_HDR(n) \
995 STATIC_HDR(Int_hash_static_info, /* I# */ \
1000 /* put these in the *data* section, since the garbage collector relies
1001 * on the fact that static closures live in the data section.
1004 /* end the name with _closure, to convince the mangler this is a closure */
1006 StgIntCharlikeClosure CHARLIKE_closure[] = {
1265 StgIntCharlikeClosure INTLIKE_closure[] = {
1266 INTLIKE_HDR(-16), /* MIN_INTLIKE == -16 */
1298 INTLIKE_HDR(16) /* MAX_INTLIKE == 16 */