1 /* -----------------------------------------------------------------------------
2 * $Id: StgMiscClosures.hc,v 1.45 2000/06/25 17:25:42 panne 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); \
48 /* -----------------------------------------------------------------------------
49 Entry code for an indirection.
50 -------------------------------------------------------------------------- */
52 INFO_TABLE(IND_info,IND_entry,1,0,IND,,EF_,0,0);
56 TICK_ENT_IND(Node); /* tick */
58 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
60 JMP_(ENTRY_CODE(*R1.p));
64 INFO_TABLE(IND_STATIC_info,IND_STATIC_entry,1,0,IND_STATIC,,EF_,0,0);
65 STGFUN(IND_STATIC_entry)
68 TICK_ENT_IND(Node); /* tick */
69 R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
71 JMP_(ENTRY_CODE(*R1.p));
75 INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,,EF_,"IND_PERM","IND_PERM");
76 STGFUN(IND_PERM_entry)
79 /* Don't add INDs to granularity cost */
80 /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
82 #if defined(TICKY_TICKY) && !defined(PROFILING)
83 /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */
84 TICK_ENT_PERM_IND(R1.p); /* tick */
87 /* Enter PAP cost centre -- lexical scoping only */
88 ENTER_CCS_PAP_CL(R1.cl);
90 /* For ticky-ticky, change the perm_ind to a normal ind on first
91 * entry, so the number of ent_perm_inds is the number of *thunks*
92 * entered again, not the number of subsequent entries.
94 * Since this screws up cost centres, we die if profiling and
95 * ticky_ticky are on at the same time. KSW 1999-01.
100 # error Profiling and ticky-ticky do not mix at present!
101 # endif /* PROFILING */
102 SET_INFO((StgInd*)R1.p,&IND_info);
103 #endif /* TICKY_TICKY */
105 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
107 /* Dont: TICK_ENT_VIA_NODE(); for ticky-ticky; as above */
109 #if defined(TICKY_TICKY) && !defined(PROFILING)
113 JMP_(ENTRY_CODE(*R1.p));
117 INFO_TABLE(IND_OLDGEN_info,IND_OLDGEN_entry,1,1,IND_OLDGEN,,EF_,0,0);
118 STGFUN(IND_OLDGEN_entry)
121 TICK_ENT_IND(Node); /* tick */
123 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
125 JMP_(ENTRY_CODE(*R1.p));
129 INFO_TABLE(IND_OLDGEN_PERM_info,IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,,EF_,0,0);
130 STGFUN(IND_OLDGEN_PERM_entry)
133 /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
135 #if defined(TICKY_TICKY) && !defined(PROFILING)
136 /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */
137 TICK_ENT_PERM_IND(R1.p); /* tick */
140 /* Enter PAP cost centre -- lexical scoping only */
141 ENTER_CCS_PAP_CL(R1.cl);
143 /* see comment in IND_PERM */
146 # error Profiling and ticky-ticky do not mix at present!
147 # endif /* PROFILING */
148 SET_INFO((StgInd*)R1.p,&IND_OLDGEN_info);
149 #endif /* TICKY_TICKY */
151 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
153 JMP_(ENTRY_CODE(*R1.p));
157 /* -----------------------------------------------------------------------------
160 This code assumes R1 is in a register for now.
161 -------------------------------------------------------------------------- */
163 INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,3,CAF_UNENTERED,,EF_,0,0);
164 STGFUN(CAF_UNENTERED_entry)
167 /* ToDo: implement directly in GHC */
170 JMP_(stg_yield_to_Hugs);
174 /* 0,4 is entirely bogus; _do not_ rely on this info */
175 INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,0,4,CAF_ENTERED,,EF_,0,0);
176 STGFUN(CAF_ENTERED_entry)
179 R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */
181 JMP_(GET_ENTRY(R1.cl));
185 /* -----------------------------------------------------------------------------
186 Entry code for a black hole.
188 Entering a black hole normally causes a cyclic data dependency, but
189 in the concurrent world, black holes are synchronization points,
190 and they are turned into blocking queues when there are threads
191 waiting for the evaluation of the closure to finish.
192 -------------------------------------------------------------------------- */
194 /* Note: a BLACKHOLE and BLACKHOLE_BQ must be big enough to be
195 * overwritten with an indirection/evacuee/catch. Thus we claim it
196 * has 1 non-pointer word of payload (in addition to the pointer word
197 * for the blocking queue in a BQ), which should be big enough for an
198 * old-generation indirection.
201 INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,"BLACKHOLE","BLACKHOLE");
202 STGFUN(BLACKHOLE_entry)
206 /* Before overwriting TSO_LINK */
207 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
212 bdescr *bd = Bdescr(R1.p);
213 if (bd->back != (bdescr *)BaseReg) {
214 if (bd->gen->no >= 1 || bd->step->no >= 1) {
215 CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
217 EXTFUN_RTS(stg_gc_enter_1_hponly);
218 JMP_(stg_gc_enter_1_hponly);
225 /* Put ourselves on the blocking queue for this black hole */
226 #if defined(GRAN) || defined(PAR)
227 /* in fact, only difference is the type of the end-of-queue marker! */
228 CurrentTSO->link = END_BQ_QUEUE;
229 ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
231 CurrentTSO->link = END_TSO_QUEUE;
232 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
234 /* jot down why and on what closure we are blocked */
235 CurrentTSO->why_blocked = BlockedOnBlackHole;
236 CurrentTSO->block_info.closure = R1.cl;
237 /* closure is mutable since something has just been added to its BQ */
238 recordMutable((StgMutClosure *)R1.cl);
239 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
240 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
242 /* PAR: dumping of event now done in blockThread -- HWL */
244 /* stg_gen_block is too heavyweight, use a specialised one */
250 INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,"BLACKHOLE","BLACKHOLE");
251 STGFUN(BLACKHOLE_BQ_entry)
255 /* Before overwriting TSO_LINK */
256 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
261 bdescr *bd = Bdescr(R1.p);
262 if (bd->back != (bdescr *)BaseReg) {
263 if (bd->gen->no >= 1 || bd->step->no >= 1) {
264 CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
266 EXTFUN_RTS(stg_gc_enter_1_hponly);
267 JMP_(stg_gc_enter_1_hponly);
275 /* Put ourselves on the blocking queue for this black hole */
276 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
277 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
278 /* jot down why and on what closure we are blocked */
279 CurrentTSO->why_blocked = BlockedOnBlackHole;
280 CurrentTSO->block_info.closure = R1.cl;
282 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
285 /* PAR: dumping of event now done in blockThread -- HWL */
287 /* stg_gen_block is too heavyweight, use a specialised one */
293 Revertible black holes are needed in the parallel world, to handle
294 negative acknowledgements of messages containing updatable closures.
295 The idea is that when the original message is transmitted, the closure
296 is turned into a revertible black hole...an object which acts like a
297 black hole when local threads try to enter it, but which can be reverted
298 back to the original closure if necessary.
300 It's actually a lot like a blocking queue (BQ) entry, because revertible
301 black holes are initially set up with an empty blocking queue.
304 #if defined(PAR) || defined(GRAN)
306 INFO_TABLE(RBH_info, RBH_entry,1,1,RBH,,EF_,0,0);
311 /* mainly statistics gathering for GranSim simulation */
312 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
315 /* exactly the same as a BLACKHOLE_BQ_entry -- HWL */
316 /* Put ourselves on the blocking queue for this black hole */
317 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
318 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
319 /* jot down why and on what closure we are blocked */
320 CurrentTSO->why_blocked = BlockedOnBlackHole;
321 CurrentTSO->block_info.closure = R1.cl;
323 /* PAR: dumping of event now done in blockThread -- HWL */
325 /* stg_gen_block is too heavyweight, use a specialised one */
330 INFO_TABLE(RBH_Save_0_info, RBH_Save_0_entry,0,2,CONSTR,,EF_,0,0);
331 NON_ENTERABLE_ENTRY_CODE(RBH_Save_0);
333 INFO_TABLE(RBH_Save_1_info, RBH_Save_1_entry,1,1,CONSTR,,EF_,0,0);
334 NON_ENTERABLE_ENTRY_CODE(RBH_Save_1);
336 INFO_TABLE(RBH_Save_2_info, RBH_Save_2_entry,2,0,CONSTR,,EF_,0,0);
337 NON_ENTERABLE_ENTRY_CODE(RBH_Save_2);
338 #endif /* defined(PAR) || defined(GRAN) */
340 /* identical to BLACKHOLEs except for the infotag */
341 INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,"CAF_BLACKHOLE","CAF_BLACKHOLE");
342 STGFUN(CAF_BLACKHOLE_entry)
346 /* mainly statistics gathering for GranSim simulation */
347 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
352 bdescr *bd = Bdescr(R1.p);
353 if (bd->back != (bdescr *)BaseReg) {
354 if (bd->gen->no >= 1 || bd->step->no >= 1) {
355 CMPXCHG(R1.cl->header.info, &CAF_BLACKHOLE_info, &WHITEHOLE_info);
357 EXTFUN_RTS(stg_gc_enter_1_hponly);
358 JMP_(stg_gc_enter_1_hponly);
366 /* Put ourselves on the blocking queue for this black hole */
367 #if defined(GRAN) || defined(PAR)
368 /* in fact, only difference is the type of the end-of-queue marker! */
369 CurrentTSO->link = END_BQ_QUEUE;
370 ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
372 CurrentTSO->link = END_TSO_QUEUE;
373 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
375 /* jot down why and on what closure we are blocked */
376 CurrentTSO->why_blocked = BlockedOnBlackHole;
377 CurrentTSO->block_info.closure = R1.cl;
378 /* closure is mutable since something has just been added to its BQ */
379 recordMutable((StgMutClosure *)R1.cl);
380 /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ */
381 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
383 /* PAR: dumping of event now done in blockThread -- HWL */
385 /* stg_gen_block is too heavyweight, use a specialised one */
391 INFO_TABLE(SE_BLACKHOLE_info, SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,0,0);
392 STGFUN(SE_BLACKHOLE_entry)
395 STGCALL3(fprintf,stderr,"SE_BLACKHOLE at %p entered!\n",R1.p);
396 STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
400 INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,EF_,0,0);
401 STGFUN(SE_CAF_BLACKHOLE_entry)
404 STGCALL3(fprintf,stderr,"SE_CAF_BLACKHOLE at %p entered!\n",R1.p);
405 STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
411 INFO_TABLE(WHITEHOLE_info, WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,EF_,0,0);
412 STGFUN(WHITEHOLE_entry)
415 JMP_(GET_ENTRY(R1.cl));
420 /* -----------------------------------------------------------------------------
421 The code for a BCO returns to the scheduler
422 -------------------------------------------------------------------------- */
423 INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,,EF_,"BCO","BCO");
428 JMP_(stg_yield_to_Hugs);
432 /* -----------------------------------------------------------------------------
433 Some static info tables for things that don't get entered, and
434 therefore don't need entry code (i.e. boxed but unpointed objects)
435 NON_ENTERABLE_ENTRY_CODE now defined at the beginning of the file
436 -------------------------------------------------------------------------- */
438 INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,,EF_,"TSO","TSO");
439 NON_ENTERABLE_ENTRY_CODE(TSO);
441 /* -----------------------------------------------------------------------------
442 Evacuees are left behind by the garbage collector. Any attempt to enter
444 -------------------------------------------------------------------------- */
446 INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,,EF_,0,0);
447 NON_ENTERABLE_ENTRY_CODE(EVACUATED);
449 /* -----------------------------------------------------------------------------
452 Live weak pointers have a special closure type. Dead ones are just
453 nullary constructors (although they live on the heap - we overwrite
454 live weak pointers with dead ones).
455 -------------------------------------------------------------------------- */
457 INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,,EF_,"WEAK","WEAK");
458 NON_ENTERABLE_ENTRY_CODE(WEAK);
460 INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,"DEAD_WEAK","DEAD_WEAK");
461 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
463 /* -----------------------------------------------------------------------------
466 This is a static nullary constructor (like []) that we use to mark an empty
467 finalizer in a weak pointer object.
468 -------------------------------------------------------------------------- */
470 INFO_TABLE_CONSTR(NO_FINALIZER_info,NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
471 NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
473 SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_)
476 /* -----------------------------------------------------------------------------
477 Foreign Objects are unlifted and therefore never entered.
478 -------------------------------------------------------------------------- */
480 INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,,EF_,"FOREIGN","FOREIGN");
481 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
483 /* -----------------------------------------------------------------------------
484 Stable Names are unlifted too.
485 -------------------------------------------------------------------------- */
487 INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,"STABLE_NAME","STABLE_NAME");
488 NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
490 /* -----------------------------------------------------------------------------
493 There are two kinds of these: full and empty. We need an info table
494 and entry code for each type.
495 -------------------------------------------------------------------------- */
497 INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
498 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
500 INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
501 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
503 /* -----------------------------------------------------------------------------
506 This is a static nullary constructor (like []) that we use to mark the
507 end of a linked TSO queue.
508 -------------------------------------------------------------------------- */
510 INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
511 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
513 SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
516 /* -----------------------------------------------------------------------------
519 Mutable lists (used by the garbage collector) consist of a chain of
520 StgMutClosures connected through their mut_link fields, ending in
521 an END_MUT_LIST closure.
522 -------------------------------------------------------------------------- */
524 INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
525 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
527 SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
530 INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
531 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
533 /* -----------------------------------------------------------------------------
535 -------------------------------------------------------------------------- */
537 INFO_TABLE_CONSTR(END_EXCEPTION_LIST_info,END_EXCEPTION_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
538 NON_ENTERABLE_ENTRY_CODE(END_EXCEPTION_LIST);
540 SET_STATIC_HDR(END_EXCEPTION_LIST_closure,END_EXCEPTION_LIST_info,0/*CC*/,,EI_)
543 INFO_TABLE(EXCEPTION_CONS_info, EXCEPTION_CONS_entry, 1, 1, CONSTR, , EF_, 0, 0);
544 NON_ENTERABLE_ENTRY_CODE(EXCEPTION_CONS);
546 /* -----------------------------------------------------------------------------
549 These come in two basic flavours: arrays of data (StgArrWords) and arrays of
550 pointers (StgArrPtrs). They all have a similar layout:
552 ___________________________
553 | Info | No. of | data....
555 ---------------------------
557 These are *unpointed* objects: i.e. they cannot be entered.
559 -------------------------------------------------------------------------- */
561 #define ArrayInfo(type) \
562 INFO_TABLE(type##_info, type##_entry, 0, 0, type, , EF_,"" # type "","" # type "");
564 ArrayInfo(ARR_WORDS);
565 NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
566 ArrayInfo(MUT_ARR_PTRS);
567 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS);
568 ArrayInfo(MUT_ARR_PTRS_FROZEN);
569 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
573 /* -----------------------------------------------------------------------------
575 -------------------------------------------------------------------------- */
577 INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, "MUT_VAR", "MUT_VAR");
578 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
580 /* -----------------------------------------------------------------------------
581 Standard Error Entry.
583 This is used for filling in vector-table entries that can never happen,
585 -------------------------------------------------------------------------- */
587 STGFUN(stg_error_entry) \
590 DUMP_ERRMSG("fatal: stg_error_entry"); \
591 STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \
596 /* -----------------------------------------------------------------------------
599 Entering this closure will just return to the address on the top of the
600 stack. Useful for getting a thread in a canonical form where we can
601 just enter the top stack word to start the thread. (see deleteThread)
602 * -------------------------------------------------------------------------- */
604 INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, , EF_, 0, 0);
611 JMP_(ENTRY_CODE(ret_addr));
614 SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONT_CARE,,EI_)
617 /* -----------------------------------------------------------------------------
618 Strict IO application - performing an IO action and entering its result.
620 rts_evalIO() lets you perform Haskell IO actions from outside of Haskell-land,
621 returning back to you their result. Want this result to be evaluated to WHNF
622 by that time, so that we can easily get at the int/char/whatever using the
623 various get{Ty} functions provided by the RTS API.
625 forceIO takes care of this, performing the IO action and entering the
626 results that comes back.
628 * -------------------------------------------------------------------------- */
631 INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
632 FN_(forceIO_ret_entry)
636 Sp -= sizeofW(StgSeqFrame);
638 JMP_(GET_ENTRY(R1.cl));
641 INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
642 FN_(forceIO_ret_entry)
646 rval = (StgClosure *)Sp[0];
648 Sp -= sizeofW(StgSeqFrame);
651 JMP_(GET_ENTRY(R1.cl));
655 INFO_TABLE(forceIO_info,forceIO_entry,1,0,FUN_STATIC,,EF_,0,0);
659 /* Sp[0] contains the IO action we want to perform */
661 /* Replace it with the return continuation that enters the result. */
662 Sp[0] = (W_)&forceIO_ret_info;
664 /* Push the RealWorld# tag and enter */
665 Sp[0] =(W_)REALWORLD_TAG;
666 JMP_(GET_ENTRY(R1.cl));
669 SET_STATIC_HDR(forceIO_closure,forceIO_info,CCS_DONT_CARE,,EI_)
673 /* -----------------------------------------------------------------------------
674 Standard Infotables (for use in interpreter)
675 -------------------------------------------------------------------------- */
679 STGFUN(Hugs_CONSTR_entry)
681 /* R1 points at the constructor */
682 JMP_(ENTRY_CODE(((StgPtr*)Sp)[0]));
685 #define RET_BCO_ENTRY_TEMPLATE(label) \
690 ((StgPtr*)Sp)[0] = R1.p; \
691 JMP_(stg_yield_to_Hugs); \
695 RET_BCO_ENTRY_TEMPLATE(ret_bco_entry );
696 RET_BCO_ENTRY_TEMPLATE(ret_bco_0_entry);
697 RET_BCO_ENTRY_TEMPLATE(ret_bco_1_entry);
698 RET_BCO_ENTRY_TEMPLATE(ret_bco_2_entry);
699 RET_BCO_ENTRY_TEMPLATE(ret_bco_3_entry);
700 RET_BCO_ENTRY_TEMPLATE(ret_bco_4_entry);
701 RET_BCO_ENTRY_TEMPLATE(ret_bco_5_entry);
702 RET_BCO_ENTRY_TEMPLATE(ret_bco_6_entry);
703 RET_BCO_ENTRY_TEMPLATE(ret_bco_7_entry);
705 VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
707 #endif /* INTERPRETER */
709 /* -----------------------------------------------------------------------------
710 CHARLIKE and INTLIKE closures.
712 These are static representations of Chars and small Ints, so that
713 we can remove dynamic Chars and Ints during garbage collection and
714 replace them with references to the static objects.
715 -------------------------------------------------------------------------- */
717 #if defined(INTERPRETER) || defined(ENABLE_WIN32_DLL_SUPPORT)
719 * When sticking the RTS in a DLL, we delay populating the
720 * Charlike and Intlike tables until load-time, which is only
721 * when we've got the real addresses to the C# and I# closures.
724 static INFO_TBL_CONST StgInfoTable czh_static_info;
725 static INFO_TBL_CONST StgInfoTable izh_static_info;
726 #define Char_hash_static_info czh_static_info
727 #define Int_hash_static_info izh_static_info
729 #define Char_hash_static_info PrelBase_Czh_static_info
730 #define Int_hash_static_info PrelBase_Izh_static_info
733 #define CHARLIKE_HDR(n) \
735 STATIC_HDR(Char_hash_static_info, /* C# */ \
740 #define INTLIKE_HDR(n) \
742 STATIC_HDR(Int_hash_static_info, /* I# */ \
747 /* put these in the *data* section, since the garbage collector relies
748 * on the fact that static closures live in the data section.
751 /* end the name with _closure, to convince the mangler this is a closure */
753 StgIntCharlikeClosure CHARLIKE_closure[] = {
1012 StgIntCharlikeClosure INTLIKE_closure[] = {
1013 INTLIKE_HDR(-16), /* MIN_INTLIKE == -16 */
1045 INTLIKE_HDR(16) /* MAX_INTLIKE == 16 */