1 /* -----------------------------------------------------------------------------
2 * $Id: StgMiscClosures.hc,v 1.44 2000/04/27 16:29:55 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"
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); \
47 /* -----------------------------------------------------------------------------
48 Entry code for an indirection.
49 -------------------------------------------------------------------------- */
51 INFO_TABLE(IND_info,IND_entry,1,0,IND,,EF_,0,0);
55 TICK_ENT_IND(Node); /* tick */
57 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
59 JMP_(ENTRY_CODE(*R1.p));
63 INFO_TABLE(IND_STATIC_info,IND_STATIC_entry,1,0,IND_STATIC,,EF_,0,0);
64 STGFUN(IND_STATIC_entry)
67 TICK_ENT_IND(Node); /* tick */
68 R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
70 JMP_(ENTRY_CODE(*R1.p));
74 INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,,EF_,"IND_PERM","IND_PERM");
75 STGFUN(IND_PERM_entry)
78 /* Don't add INDs to granularity cost */
79 /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
81 #if defined(TICKY_TICKY) && !defined(PROFILING)
82 /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */
83 TICK_ENT_PERM_IND(R1.p); /* tick */
86 /* Enter PAP cost centre -- lexical scoping only */
87 ENTER_CCS_PAP_CL(R1.cl);
89 /* For ticky-ticky, change the perm_ind to a normal ind on first
90 * entry, so the number of ent_perm_inds is the number of *thunks*
91 * entered again, not the number of subsequent entries.
93 * Since this screws up cost centres, we die if profiling and
94 * ticky_ticky are on at the same time. KSW 1999-01.
99 # error Profiling and ticky-ticky do not mix at present!
100 # endif /* PROFILING */
101 SET_INFO((StgInd*)R1.p,&IND_info);
102 #endif /* TICKY_TICKY */
104 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
106 /* Dont: TICK_ENT_VIA_NODE(); for ticky-ticky; as above */
108 #if defined(TICKY_TICKY) && !defined(PROFILING)
112 JMP_(ENTRY_CODE(*R1.p));
116 INFO_TABLE(IND_OLDGEN_info,IND_OLDGEN_entry,1,1,IND_OLDGEN,,EF_,0,0);
117 STGFUN(IND_OLDGEN_entry)
120 TICK_ENT_IND(Node); /* tick */
122 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
124 JMP_(ENTRY_CODE(*R1.p));
128 INFO_TABLE(IND_OLDGEN_PERM_info,IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,,EF_,0,0);
129 STGFUN(IND_OLDGEN_PERM_entry)
132 /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
134 #if defined(TICKY_TICKY) && !defined(PROFILING)
135 /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */
136 TICK_ENT_PERM_IND(R1.p); /* tick */
139 /* Enter PAP cost centre -- lexical scoping only */
140 ENTER_CCS_PAP_CL(R1.cl);
142 /* see comment in IND_PERM */
145 # error Profiling and ticky-ticky do not mix at present!
146 # endif /* PROFILING */
147 SET_INFO((StgInd*)R1.p,&IND_OLDGEN_info);
148 #endif /* TICKY_TICKY */
150 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
152 JMP_(ENTRY_CODE(*R1.p));
156 /* -----------------------------------------------------------------------------
159 This code assumes R1 is in a register for now.
160 -------------------------------------------------------------------------- */
162 INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,3,CAF_UNENTERED,,EF_,0,0);
163 STGFUN(CAF_UNENTERED_entry)
166 /* ToDo: implement directly in GHC */
169 JMP_(stg_yield_to_Hugs);
173 /* 0,4 is entirely bogus; _do not_ rely on this info */
174 INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,0,4,CAF_ENTERED,,EF_,0,0);
175 STGFUN(CAF_ENTERED_entry)
178 R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */
180 JMP_(GET_ENTRY(R1.cl));
184 /* -----------------------------------------------------------------------------
185 Entry code for a black hole.
187 Entering a black hole normally causes a cyclic data dependency, but
188 in the concurrent world, black holes are synchronization points,
189 and they are turned into blocking queues when there are threads
190 waiting for the evaluation of the closure to finish.
191 -------------------------------------------------------------------------- */
193 /* Note: a BLACKHOLE and BLACKHOLE_BQ must be big enough to be
194 * overwritten with an indirection/evacuee/catch. Thus we claim it
195 * has 1 non-pointer word of payload (in addition to the pointer word
196 * for the blocking queue in a BQ), which should be big enough for an
197 * old-generation indirection.
200 INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,"BLACKHOLE","BLACKHOLE");
201 STGFUN(BLACKHOLE_entry)
205 /* Before overwriting TSO_LINK */
206 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
211 bdescr *bd = Bdescr(R1.p);
212 if (bd->back != (bdescr *)BaseReg) {
213 if (bd->gen->no >= 1 || bd->step->no >= 1) {
214 CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
216 EXTFUN_RTS(stg_gc_enter_1_hponly);
217 JMP_(stg_gc_enter_1_hponly);
224 /* Put ourselves on the blocking queue for this black hole */
225 #if defined(GRAN) || defined(PAR)
226 /* in fact, only difference is the type of the end-of-queue marker! */
227 CurrentTSO->link = END_BQ_QUEUE;
228 ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
230 CurrentTSO->link = END_TSO_QUEUE;
231 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
233 /* jot down why and on what closure we are blocked */
234 CurrentTSO->why_blocked = BlockedOnBlackHole;
235 CurrentTSO->block_info.closure = R1.cl;
236 /* closure is mutable since something has just been added to its BQ */
237 recordMutable((StgMutClosure *)R1.cl);
238 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
239 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
241 /* PAR: dumping of event now done in blockThread -- HWL */
243 /* stg_gen_block is too heavyweight, use a specialised one */
249 INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,"BLACKHOLE","BLACKHOLE");
250 STGFUN(BLACKHOLE_BQ_entry)
254 /* Before overwriting TSO_LINK */
255 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
260 bdescr *bd = Bdescr(R1.p);
261 if (bd->back != (bdescr *)BaseReg) {
262 if (bd->gen->no >= 1 || bd->step->no >= 1) {
263 CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
265 EXTFUN_RTS(stg_gc_enter_1_hponly);
266 JMP_(stg_gc_enter_1_hponly);
274 /* Put ourselves on the blocking queue for this black hole */
275 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
276 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
277 /* jot down why and on what closure we are blocked */
278 CurrentTSO->why_blocked = BlockedOnBlackHole;
279 CurrentTSO->block_info.closure = R1.cl;
281 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
284 /* PAR: dumping of event now done in blockThread -- HWL */
286 /* stg_gen_block is too heavyweight, use a specialised one */
292 Revertible black holes are needed in the parallel world, to handle
293 negative acknowledgements of messages containing updatable closures.
294 The idea is that when the original message is transmitted, the closure
295 is turned into a revertible black hole...an object which acts like a
296 black hole when local threads try to enter it, but which can be reverted
297 back to the original closure if necessary.
299 It's actually a lot like a blocking queue (BQ) entry, because revertible
300 black holes are initially set up with an empty blocking queue.
303 #if defined(PAR) || defined(GRAN)
305 INFO_TABLE(RBH_info, RBH_entry,1,1,RBH,,EF_,0,0);
310 /* mainly statistics gathering for GranSim simulation */
311 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
314 /* exactly the same as a BLACKHOLE_BQ_entry -- HWL */
315 /* Put ourselves on the blocking queue for this black hole */
316 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
317 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
318 /* jot down why and on what closure we are blocked */
319 CurrentTSO->why_blocked = BlockedOnBlackHole;
320 CurrentTSO->block_info.closure = R1.cl;
322 /* PAR: dumping of event now done in blockThread -- HWL */
324 /* stg_gen_block is too heavyweight, use a specialised one */
329 INFO_TABLE(RBH_Save_0_info, RBH_Save_0_entry,0,2,CONSTR,,EF_,0,0);
330 NON_ENTERABLE_ENTRY_CODE(RBH_Save_0);
332 INFO_TABLE(RBH_Save_1_info, RBH_Save_1_entry,1,1,CONSTR,,EF_,0,0);
333 NON_ENTERABLE_ENTRY_CODE(RBH_Save_1);
335 INFO_TABLE(RBH_Save_2_info, RBH_Save_2_entry,2,0,CONSTR,,EF_,0,0);
336 NON_ENTERABLE_ENTRY_CODE(RBH_Save_2);
337 #endif /* defined(PAR) || defined(GRAN) */
339 /* identical to BLACKHOLEs except for the infotag */
340 INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,"CAF_BLACKHOLE","CAF_BLACKHOLE");
341 STGFUN(CAF_BLACKHOLE_entry)
345 /* mainly statistics gathering for GranSim simulation */
346 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
351 bdescr *bd = Bdescr(R1.p);
352 if (bd->back != (bdescr *)BaseReg) {
353 if (bd->gen->no >= 1 || bd->step->no >= 1) {
354 CMPXCHG(R1.cl->header.info, &CAF_BLACKHOLE_info, &WHITEHOLE_info);
356 EXTFUN_RTS(stg_gc_enter_1_hponly);
357 JMP_(stg_gc_enter_1_hponly);
365 /* Put ourselves on the blocking queue for this black hole */
366 #if defined(GRAN) || defined(PAR)
367 /* in fact, only difference is the type of the end-of-queue marker! */
368 CurrentTSO->link = END_BQ_QUEUE;
369 ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
371 CurrentTSO->link = END_TSO_QUEUE;
372 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
374 /* jot down why and on what closure we are blocked */
375 CurrentTSO->why_blocked = BlockedOnBlackHole;
376 CurrentTSO->block_info.closure = R1.cl;
377 /* closure is mutable since something has just been added to its BQ */
378 recordMutable((StgMutClosure *)R1.cl);
379 /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ */
380 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
382 /* PAR: dumping of event now done in blockThread -- HWL */
384 /* stg_gen_block is too heavyweight, use a specialised one */
390 INFO_TABLE(SE_BLACKHOLE_info, SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,0,0);
391 STGFUN(SE_BLACKHOLE_entry)
394 STGCALL3(fprintf,stderr,"SE_BLACKHOLE at %p entered!\n",R1.p);
395 STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
399 INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,EF_,0,0);
400 STGFUN(SE_CAF_BLACKHOLE_entry)
403 STGCALL3(fprintf,stderr,"SE_CAF_BLACKHOLE at %p entered!\n",R1.p);
404 STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
410 INFO_TABLE(WHITEHOLE_info, WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,EF_,0,0);
411 STGFUN(WHITEHOLE_entry)
414 JMP_(GET_ENTRY(R1.cl));
419 /* -----------------------------------------------------------------------------
420 The code for a BCO returns to the scheduler
421 -------------------------------------------------------------------------- */
422 INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,,EF_,"BCO","BCO");
427 JMP_(stg_yield_to_Hugs);
431 /* -----------------------------------------------------------------------------
432 Some static info tables for things that don't get entered, and
433 therefore don't need entry code (i.e. boxed but unpointed objects)
434 NON_ENTERABLE_ENTRY_CODE now defined at the beginning of the file
435 -------------------------------------------------------------------------- */
437 INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,,EF_,"TSO","TSO");
438 NON_ENTERABLE_ENTRY_CODE(TSO);
440 /* -----------------------------------------------------------------------------
441 Evacuees are left behind by the garbage collector. Any attempt to enter
443 -------------------------------------------------------------------------- */
445 INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,,EF_,0,0);
446 NON_ENTERABLE_ENTRY_CODE(EVACUATED);
448 /* -----------------------------------------------------------------------------
451 Live weak pointers have a special closure type. Dead ones are just
452 nullary constructors (although they live on the heap - we overwrite
453 live weak pointers with dead ones).
454 -------------------------------------------------------------------------- */
456 INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,,EF_,"WEAK","WEAK");
457 NON_ENTERABLE_ENTRY_CODE(WEAK);
459 INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,"DEAD_WEAK","DEAD_WEAK");
460 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
462 /* -----------------------------------------------------------------------------
465 This is a static nullary constructor (like []) that we use to mark an empty
466 finalizer in a weak pointer object.
467 -------------------------------------------------------------------------- */
469 INFO_TABLE_CONSTR(NO_FINALIZER_info,NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
470 NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
472 SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_)
475 /* -----------------------------------------------------------------------------
476 Foreign Objects are unlifted and therefore never entered.
477 -------------------------------------------------------------------------- */
479 INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,,EF_,"FOREIGN","FOREIGN");
480 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
482 /* -----------------------------------------------------------------------------
483 Stable Names are unlifted too.
484 -------------------------------------------------------------------------- */
486 INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,"STABLE_NAME","STABLE_NAME");
487 NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
489 /* -----------------------------------------------------------------------------
492 There are two kinds of these: full and empty. We need an info table
493 and entry code for each type.
494 -------------------------------------------------------------------------- */
496 INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
497 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
499 INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
500 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
502 /* -----------------------------------------------------------------------------
505 This is a static nullary constructor (like []) that we use to mark the
506 end of a linked TSO queue.
507 -------------------------------------------------------------------------- */
509 INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
510 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
512 SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
515 /* -----------------------------------------------------------------------------
518 Mutable lists (used by the garbage collector) consist of a chain of
519 StgMutClosures connected through their mut_link fields, ending in
520 an END_MUT_LIST closure.
521 -------------------------------------------------------------------------- */
523 INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
524 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
526 SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
529 INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
530 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
532 /* -----------------------------------------------------------------------------
534 -------------------------------------------------------------------------- */
536 INFO_TABLE_CONSTR(END_EXCEPTION_LIST_info,END_EXCEPTION_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
537 NON_ENTERABLE_ENTRY_CODE(END_EXCEPTION_LIST);
539 SET_STATIC_HDR(END_EXCEPTION_LIST_closure,END_EXCEPTION_LIST_info,0/*CC*/,,EI_)
542 INFO_TABLE(EXCEPTION_CONS_info, EXCEPTION_CONS_entry, 1, 1, CONSTR, , EF_, 0, 0);
543 NON_ENTERABLE_ENTRY_CODE(EXCEPTION_CONS);
545 /* -----------------------------------------------------------------------------
548 These come in two basic flavours: arrays of data (StgArrWords) and arrays of
549 pointers (StgArrPtrs). They all have a similar layout:
551 ___________________________
552 | Info | No. of | data....
554 ---------------------------
556 These are *unpointed* objects: i.e. they cannot be entered.
558 -------------------------------------------------------------------------- */
560 #define ArrayInfo(type) \
561 INFO_TABLE(type##_info, type##_entry, 0, 0, type, , EF_,"" # type "","" # type "");
563 ArrayInfo(ARR_WORDS);
564 NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
565 ArrayInfo(MUT_ARR_PTRS);
566 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS);
567 ArrayInfo(MUT_ARR_PTRS_FROZEN);
568 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
572 /* -----------------------------------------------------------------------------
574 -------------------------------------------------------------------------- */
576 INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, "MUT_VAR", "MUT_VAR");
577 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
579 /* -----------------------------------------------------------------------------
580 Standard Error Entry.
582 This is used for filling in vector-table entries that can never happen,
584 -------------------------------------------------------------------------- */
586 STGFUN(stg_error_entry) \
589 DUMP_ERRMSG("fatal: stg_error_entry"); \
590 STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \
594 /* -----------------------------------------------------------------------------
597 Entering this closure will just return to the address on the top of the
598 stack. Useful for getting a thread in a canonical form where we can
599 just enter the top stack word to start the thread. (see deleteThread)
600 * -------------------------------------------------------------------------- */
602 INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, , EF_, 0, 0);
609 JMP_(ENTRY_CODE(ret_addr));
612 SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONT_CARE,,EI_)
615 /* -----------------------------------------------------------------------------
616 Strict IO application - performing an IO action and entering its result.
618 rts_evalIO() lets you perform Haskell IO actions from outside of Haskell-land,
619 returning back to you their result. Want this result to be evaluated to WHNF
620 by that time, so that we can easily get at the int/char/whatever using the
621 various get{Ty} functions provided by the RTS API.
623 forceIO takes care of this, performing the IO action and entering the
624 results that comes back.
626 * -------------------------------------------------------------------------- */
629 INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
630 FN_(forceIO_ret_entry)
634 Sp -= sizeofW(StgSeqFrame);
636 JMP_(GET_ENTRY(R1.cl));
639 INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
640 FN_(forceIO_ret_entry)
644 rval = (StgClosure *)Sp[0];
646 Sp -= sizeofW(StgSeqFrame);
649 JMP_(GET_ENTRY(R1.cl));
653 INFO_TABLE(forceIO_info,forceIO_entry,1,0,FUN_STATIC,,EF_,0,0);
657 /* Sp[0] contains the IO action we want to perform */
659 /* Replace it with the return continuation that enters the result. */
660 Sp[0] = (W_)&forceIO_ret_info;
662 /* Push the RealWorld# tag and enter */
663 Sp[0] =(W_)REALWORLD_TAG;
664 JMP_(GET_ENTRY(R1.cl));
667 SET_STATIC_HDR(forceIO_closure,forceIO_info,CCS_DONT_CARE,,EI_)
671 /* -----------------------------------------------------------------------------
672 Standard Infotables (for use in interpreter)
673 -------------------------------------------------------------------------- */
677 STGFUN(Hugs_CONSTR_entry)
679 /* R1 points at the constructor */
680 JMP_(ENTRY_CODE(((StgPtr*)Sp)[0]));
683 #define RET_BCO_ENTRY_TEMPLATE(label) \
688 ((StgPtr*)Sp)[0] = R1.p; \
689 JMP_(stg_yield_to_Hugs); \
693 RET_BCO_ENTRY_TEMPLATE(ret_bco_entry );
694 RET_BCO_ENTRY_TEMPLATE(ret_bco_0_entry);
695 RET_BCO_ENTRY_TEMPLATE(ret_bco_1_entry);
696 RET_BCO_ENTRY_TEMPLATE(ret_bco_2_entry);
697 RET_BCO_ENTRY_TEMPLATE(ret_bco_3_entry);
698 RET_BCO_ENTRY_TEMPLATE(ret_bco_4_entry);
699 RET_BCO_ENTRY_TEMPLATE(ret_bco_5_entry);
700 RET_BCO_ENTRY_TEMPLATE(ret_bco_6_entry);
701 RET_BCO_ENTRY_TEMPLATE(ret_bco_7_entry);
703 VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
705 #endif /* INTERPRETER */
707 /* -----------------------------------------------------------------------------
708 CHARLIKE and INTLIKE closures.
710 These are static representations of Chars and small Ints, so that
711 we can remove dynamic Chars and Ints during garbage collection and
712 replace them with references to the static objects.
713 -------------------------------------------------------------------------- */
715 #if defined(INTERPRETER) || defined(ENABLE_WIN32_DLL_SUPPORT)
717 * When sticking the RTS in a DLL, we delay populating the
718 * Charlike and Intlike tables until load-time, which is only
719 * when we've got the real addresses to the C# and I# closures.
722 static INFO_TBL_CONST StgInfoTable czh_static_info;
723 static INFO_TBL_CONST StgInfoTable izh_static_info;
724 #define Char_hash_static_info czh_static_info
725 #define Int_hash_static_info izh_static_info
727 #define Char_hash_static_info PrelBase_Czh_static_info
728 #define Int_hash_static_info PrelBase_Izh_static_info
731 #define CHARLIKE_HDR(n) \
733 STATIC_HDR(Char_hash_static_info, /* C# */ \
738 #define INTLIKE_HDR(n) \
740 STATIC_HDR(Int_hash_static_info, /* I# */ \
745 /* put these in the *data* section, since the garbage collector relies
746 * on the fact that static closures live in the data section.
749 /* end the name with _closure, to convince the mangler this is a closure */
751 StgIntCharlikeClosure CHARLIKE_closure[] = {
1010 StgIntCharlikeClosure INTLIKE_closure[] = {
1011 INTLIKE_HDR(-16), /* MIN_INTLIKE == -16 */
1043 INTLIKE_HDR(16) /* MAX_INTLIKE == 16 */