1 /* -----------------------------------------------------------------------------
2 * $Id: StgMiscClosures.hc,v 1.38 2000/03/14 09:55:05 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"
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.
50 This code assumes R1 is in a register for now.
51 -------------------------------------------------------------------------- */
53 INFO_TABLE(IND_info,IND_entry,1,0,IND,,EF_,0,0);
57 TICK_ENT_IND(Node); /* tick */
59 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
61 JMP_(ENTRY_CODE(*R1.p));
65 INFO_TABLE(IND_STATIC_info,IND_STATIC_entry,1,0,IND_STATIC,,EF_,0,0);
66 STGFUN(IND_STATIC_entry)
69 TICK_ENT_IND(Node); /* tick */
71 R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
73 JMP_(ENTRY_CODE(*R1.p));
77 INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,,EF_,0,0);
78 STGFUN(IND_PERM_entry)
81 /* Don't add INDs to granularity cost */
82 /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
84 #if defined(TICKY_TICKY) && !defined(PROFILING)
85 /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */
86 TICK_ENT_PERM_IND(R1.p); /* tick */
89 /* Enter PAP cost centre -- lexical scoping only */
90 ENTER_CCS_PAP_CL(R1.cl);
92 /* For ticky-ticky, change the perm_ind to a normal ind on first
93 * entry, so the number of ent_perm_inds is the number of *thunks*
94 * entered again, not the number of subsequent entries.
96 * Since this screws up cost centres, we die if profiling and
97 * ticky_ticky are on at the same time. KSW 1999-01.
102 # error Profiling and ticky-ticky do not mix at present!
103 # endif /* PROFILING */
104 SET_INFO((StgInd*)R1.p,&IND_info);
105 #endif /* TICKY_TICKY */
107 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
109 /* Dont: TICK_ENT_VIA_NODE(); for ticky-ticky; as above */
111 #if defined(TICKY_TICKY) && !defined(PROFILING)
115 JMP_(ENTRY_CODE(*R1.p));
119 INFO_TABLE(IND_OLDGEN_info,IND_OLDGEN_entry,1,1,IND_OLDGEN,,EF_,0,0);
120 STGFUN(IND_OLDGEN_entry)
123 TICK_ENT_IND(Node); /* tick */
125 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
127 JMP_(ENTRY_CODE(*R1.p));
131 INFO_TABLE(IND_OLDGEN_PERM_info,IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,,EF_,0,0);
132 STGFUN(IND_OLDGEN_PERM_entry)
135 /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
137 #if defined(TICKY_TICKY) && !defined(PROFILING)
138 /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */
139 TICK_ENT_PERM_IND(R1.p); /* tick */
142 /* Enter PAP cost centre -- lexical scoping only */
143 ENTER_CCS_PAP_CL(R1.cl);
145 /* see comment in IND_PERM */
148 # error Profiling and ticky-ticky do not mix at present!
149 # endif /* PROFILING */
150 SET_INFO((StgInd*)R1.p,&IND_OLDGEN_info);
151 #endif /* TICKY_TICKY */
153 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
155 JMP_(ENTRY_CODE(*R1.p));
159 /* -----------------------------------------------------------------------------
162 This code assumes R1 is in a register for now.
163 -------------------------------------------------------------------------- */
165 INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,3,CAF_UNENTERED,,EF_,0,0);
166 STGFUN(CAF_UNENTERED_entry)
169 /* ToDo: implement directly in GHC */
172 JMP_(stg_yield_to_Hugs);
176 /* 0,4 is entirely bogus; _do not_ rely on this info */
177 INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,0,4,CAF_ENTERED,,EF_,0,0);
178 STGFUN(CAF_ENTERED_entry)
181 R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */
183 JMP_(GET_ENTRY(R1.cl));
187 /* -----------------------------------------------------------------------------
188 Entry code for a black hole.
190 Entering a black hole normally causes a cyclic data dependency, but
191 in the concurrent world, black holes are synchronization points,
192 and they are turned into blocking queues when there are threads
193 waiting for the evaluation of the closure to finish.
194 -------------------------------------------------------------------------- */
196 /* Note: a BLACKHOLE and BLACKHOLE_BQ must be big enough to be
197 * overwritten with an indirection/evacuee/catch. Thus we claim it
198 * has 1 non-pointer word of payload (in addition to the pointer word
199 * for the blocking queue in a BQ), which should be big enough for an
200 * old-generation indirection.
203 INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,0,0);
204 STGFUN(BLACKHOLE_entry)
208 /* Before overwriting TSO_LINK */
209 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
214 bdescr *bd = Bdescr(R1.p);
215 if (bd->back != (bdescr *)BaseReg) {
216 if (bd->gen->no >= 1 || bd->step->no >= 1) {
217 CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
219 EXTFUN_RTS(stg_gc_enter_1_hponly);
220 JMP_(stg_gc_enter_1_hponly);
227 /* Put ourselves on the blocking queue for this black hole */
228 #if defined(GRAN) || defined(PAR)
229 /* in fact, only difference is the type of the end-of-queue marker! */
230 CurrentTSO->link = END_BQ_QUEUE;
231 ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
233 CurrentTSO->link = END_TSO_QUEUE;
234 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
236 /* jot down why and on what closure we are blocked */
237 CurrentTSO->why_blocked = BlockedOnBlackHole;
238 CurrentTSO->block_info.closure = R1.cl;
239 /* closure is mutable since something has just been added to its BQ */
240 recordMutable((StgMutClosure *)R1.cl);
241 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
242 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
245 /* Save the Thread State here, before calling RTS routines below! */
246 SAVE_THREAD_STATE(1);
248 /* if collecting stats update the execution time etc */
249 if (RtsFlags.ParFlags.ParStats.Full) {
250 /* Note that CURRENT_TIME may perform an unsafe call */
251 //rtsTime now = CURRENT_TIME; /* Now */
252 CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat;
253 CurrentTSO->par.blockcount++;
254 CurrentTSO->par.blockedat = CURRENT_TIME;
255 DumpRawGranEvent(CURRENT_PROC, thisPE,
256 GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0);
259 THREAD_RETURN(1); /* back to the scheduler */
261 /* stg_gen_block is too heavyweight, use a specialised one */
268 INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,0,0);
269 STGFUN(BLACKHOLE_BQ_entry)
273 /* Before overwriting TSO_LINK */
274 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
279 bdescr *bd = Bdescr(R1.p);
280 if (bd->back != (bdescr *)BaseReg) {
281 if (bd->gen->no >= 1 || bd->step->no >= 1) {
282 CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
284 EXTFUN_RTS(stg_gc_enter_1_hponly);
285 JMP_(stg_gc_enter_1_hponly);
293 /* Put ourselves on the blocking queue for this black hole */
294 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
295 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
296 /* jot down why and on what closure we are blocked */
297 CurrentTSO->why_blocked = BlockedOnBlackHole;
298 CurrentTSO->block_info.closure = R1.cl;
300 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
304 /* Save the Thread State here, before calling RTS routines below! */
305 SAVE_THREAD_STATE(1);
307 /* if collecting stats update the execution time etc */
308 if (RtsFlags.ParFlags.ParStats.Full) {
309 /* Note that CURRENT_TIME may perform an unsafe call */
310 //rtsTime now = CURRENT_TIME; /* Now */
311 CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat;
312 CurrentTSO->par.blockcount++;
313 CurrentTSO->par.blockedat = CURRENT_TIME;
314 DumpRawGranEvent(CURRENT_PROC, thisPE,
315 GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0);
318 THREAD_RETURN(1); /* back to the scheduler */
320 /* stg_gen_block is too heavyweight, use a specialised one */
327 Revertible black holes are needed in the parallel world, to handle
328 negative acknowledgements of messages containing updatable closures.
329 The idea is that when the original message is transmitted, the closure
330 is turned into a revertible black hole...an object which acts like a
331 black hole when local threads try to enter it, but which can be reverted
332 back to the original closure if necessary.
334 It's actually a lot like a blocking queue (BQ) entry, because revertible
335 black holes are initially set up with an empty blocking queue.
338 #if defined(PAR) || defined(GRAN)
340 INFO_TABLE(RBH_info, RBH_entry,1,1,RBH,,EF_,0,0);
345 /* mainly statistics gathering for GranSim simulation */
346 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
349 /* exactly the same as a BLACKHOLE_BQ_entry -- HWL */
350 /* Put ourselves on the blocking queue for this black hole */
351 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
352 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
353 /* jot down why and on what closure we are blocked */
354 CurrentTSO->why_blocked = BlockedOnBlackHole;
355 CurrentTSO->block_info.closure = R1.cl;
358 /* Save the Thread State here, before calling RTS routines below! */
359 SAVE_THREAD_STATE(1);
361 /* if collecting stats update the execution time etc */
362 if (RtsFlags.ParFlags.ParStats.Full) {
363 /* Note that CURRENT_TIME may perform an unsafe call */
364 //rtsTime now = CURRENT_TIME; /* Now */
365 CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat;
366 CurrentTSO->par.blockcount++;
367 CurrentTSO->par.blockedat = CURRENT_TIME;
368 DumpRawGranEvent(CURRENT_PROC, thisPE,
369 GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0);
372 THREAD_RETURN(1); /* back to the scheduler */
374 /* saves thread state and leaves thread in ThreadEnterGHC state; */
375 /* stg_gen_block is too heavyweight, use a specialised one */
382 INFO_TABLE(RBH_Save_0_info, RBH_Save_0_entry,0,2,CONSTR,,EF_,0,0);
383 NON_ENTERABLE_ENTRY_CODE(RBH_Save_0);
385 INFO_TABLE(RBH_Save_1_info, RBH_Save_1_entry,1,1,CONSTR,,EF_,0,0);
386 NON_ENTERABLE_ENTRY_CODE(RBH_Save_1);
388 INFO_TABLE(RBH_Save_2_info, RBH_Save_2_entry,2,0,CONSTR,,EF_,0,0);
389 NON_ENTERABLE_ENTRY_CODE(RBH_Save_2);
390 #endif /* defined(PAR) || defined(GRAN) */
392 /* identical to BLACKHOLEs except for the infotag */
393 INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,0,0);
394 STGFUN(CAF_BLACKHOLE_entry)
398 /* mainly statistics gathering for GranSim simulation */
399 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
404 bdescr *bd = Bdescr(R1.p);
405 if (bd->back != (bdescr *)BaseReg) {
406 if (bd->gen->no >= 1 || bd->step->no >= 1) {
407 CMPXCHG(R1.cl->header.info, &CAF_BLACKHOLE_info, &WHITEHOLE_info);
409 EXTFUN_RTS(stg_gc_enter_1_hponly);
410 JMP_(stg_gc_enter_1_hponly);
418 /* Put ourselves on the blocking queue for this black hole */
419 #if defined(GRAN) || defined(PAR)
420 /* in fact, only difference is the type of the end-of-queue marker! */
421 CurrentTSO->link = END_BQ_QUEUE;
422 ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
424 CurrentTSO->link = END_TSO_QUEUE;
425 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
427 /* jot down why and on what closure we are blocked */
428 CurrentTSO->why_blocked = BlockedOnBlackHole;
429 CurrentTSO->block_info.closure = R1.cl;
430 /* closure is mutable since something has just been added to its BQ */
431 recordMutable((StgMutClosure *)R1.cl);
432 /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ */
433 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
436 /* Save the Thread State here, before calling RTS routines below! */
437 SAVE_THREAD_STATE(1);
439 /* if collecting stats update the execution time etc */
440 if (RtsFlags.ParFlags.ParStats.Full) {
441 /* Note that CURRENT_TIME may perform an unsafe call */
442 //rtsTime now = CURRENT_TIME; /* Now */
443 CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat;
444 CurrentTSO->par.blockcount++;
445 CurrentTSO->par.blockedat = CURRENT_TIME;
446 DumpRawGranEvent(CURRENT_PROC, thisPE,
447 GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0);
450 THREAD_RETURN(1); /* back to the scheduler */
452 /* stg_gen_block is too heavyweight, use a specialised one */
460 INFO_TABLE(SE_BLACKHOLE_info, SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,0,0);
461 STGFUN(SE_BLACKHOLE_entry)
464 STGCALL3(fprintf,stderr,"SE_BLACKHOLE at %p entered!\n",R1.p);
465 STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
469 INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,EF_,0,0);
470 STGFUN(SE_CAF_BLACKHOLE_entry)
473 STGCALL3(fprintf,stderr,"SE_CAF_BLACKHOLE at %p entered!\n",R1.p);
474 STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
480 INFO_TABLE(WHITEHOLE_info, WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,EF_,0,0);
481 STGFUN(WHITEHOLE_entry)
484 JMP_(GET_ENTRY(R1.cl));
489 /* -----------------------------------------------------------------------------
490 The code for a BCO returns to the scheduler
491 -------------------------------------------------------------------------- */
492 INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,,EF_,0,0);
497 JMP_(stg_yield_to_Hugs);
501 /* -----------------------------------------------------------------------------
502 Some static info tables for things that don't get entered, and
503 therefore don't need entry code (i.e. boxed but unpointed objects)
504 NON_ENTERABLE_ENTRY_CODE now defined at the beginning of the file
505 -------------------------------------------------------------------------- */
507 INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,,EF_,0,0);
508 NON_ENTERABLE_ENTRY_CODE(TSO);
510 /* -----------------------------------------------------------------------------
511 Evacuees are left behind by the garbage collector. Any attempt to enter
513 -------------------------------------------------------------------------- */
515 INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,,EF_,0,0);
516 NON_ENTERABLE_ENTRY_CODE(EVACUATED);
518 /* -----------------------------------------------------------------------------
521 Live weak pointers have a special closure type. Dead ones are just
522 nullary constructors (although they live on the heap - we overwrite
523 live weak pointers with dead ones).
524 -------------------------------------------------------------------------- */
526 INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,,EF_,0,0);
527 NON_ENTERABLE_ENTRY_CODE(WEAK);
529 INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,0,0);
530 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
532 /* -----------------------------------------------------------------------------
535 This is a static nullary constructor (like []) that we use to mark an empty
536 finalizer in a weak pointer object.
537 -------------------------------------------------------------------------- */
539 INFO_TABLE_CONSTR(NO_FINALIZER_info,NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
540 NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
542 SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_)
545 /* -----------------------------------------------------------------------------
546 Foreign Objects are unlifted and therefore never entered.
547 -------------------------------------------------------------------------- */
549 INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,,EF_,0,0);
550 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
552 /* -----------------------------------------------------------------------------
553 Stable Names are unlifted too.
554 -------------------------------------------------------------------------- */
556 INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,0,0);
557 NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
559 /* -----------------------------------------------------------------------------
562 There are two kinds of these: full and empty. We need an info table
563 and entry code for each type.
564 -------------------------------------------------------------------------- */
566 INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,,EF_,0,0);
567 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
569 INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,,EF_,0,0);
570 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
572 /* -----------------------------------------------------------------------------
575 This is a static nullary constructor (like []) that we use to mark the
576 end of a linked TSO queue.
577 -------------------------------------------------------------------------- */
579 INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
580 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
582 SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
585 /* -----------------------------------------------------------------------------
588 Mutable lists (used by the garbage collector) consist of a chain of
589 StgMutClosures connected through their mut_link fields, ending in
590 an END_MUT_LIST closure.
591 -------------------------------------------------------------------------- */
593 INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
594 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
596 SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
599 INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
600 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
602 /* -----------------------------------------------------------------------------
604 -------------------------------------------------------------------------- */
606 INFO_TABLE_CONSTR(END_EXCEPTION_LIST_info,END_EXCEPTION_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
607 NON_ENTERABLE_ENTRY_CODE(END_EXCEPTION_LIST);
609 SET_STATIC_HDR(END_EXCEPTION_LIST_closure,END_EXCEPTION_LIST_info,0/*CC*/,,EI_)
612 INFO_TABLE(EXCEPTION_CONS_info, EXCEPTION_CONS_entry, 1, 1, CONSTR, , EF_, 0, 0);
613 NON_ENTERABLE_ENTRY_CODE(EXCEPTION_CONS);
615 /* -----------------------------------------------------------------------------
618 These come in two basic flavours: arrays of data (StgArrWords) and arrays of
619 pointers (StgArrPtrs). They all have a similar layout:
621 ___________________________
622 | Info | No. of | data....
624 ---------------------------
626 These are *unpointed* objects: i.e. they cannot be entered.
628 -------------------------------------------------------------------------- */
630 #define ArrayInfo(type) \
631 INFO_TABLE(type##_info, type##_entry, 0, 0, type, , EF_,0,0);
633 ArrayInfo(ARR_WORDS);
634 NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
635 ArrayInfo(MUT_ARR_PTRS);
636 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS);
637 ArrayInfo(MUT_ARR_PTRS_FROZEN);
638 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
642 /* -----------------------------------------------------------------------------
644 -------------------------------------------------------------------------- */
646 INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
647 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
649 /* -----------------------------------------------------------------------------
650 Standard Error Entry.
652 This is used for filling in vector-table entries that can never happen,
654 -------------------------------------------------------------------------- */
656 STGFUN(stg_error_entry) \
659 DUMP_ERRMSG("fatal: stg_error_entry"); \
660 STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \
664 /* -----------------------------------------------------------------------------
667 Entering this closure will just return to the address on the top of the
668 stack. Useful for getting a thread in a canonical form where we can
669 just enter the top stack word to start the thread. (see deleteThread)
670 * -------------------------------------------------------------------------- */
672 INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, , EF_, 0, 0);
679 JMP_(ENTRY_CODE(ret_addr));
682 SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_)
685 /* -----------------------------------------------------------------------------
686 Strict IO application - performing an IO action and entering its result.
688 rts_evalIO() lets you perform Haskell IO actions from outside of Haskell-land,
689 returning back to you their result. Want this result to be evaluated to WHNF
690 by that time, so that we can easily get at the int/char/whatever using the
691 various get{Ty} functions provided by the RTS API.
693 forceIO takes care of this, performing the IO action and entering the
694 results that comes back.
696 * -------------------------------------------------------------------------- */
699 INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
700 FN_(forceIO_ret_entry)
704 Sp -= sizeofW(StgSeqFrame);
706 JMP_(GET_ENTRY(R1.cl));
709 INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
710 FN_(forceIO_ret_entry)
714 rval = (StgClosure *)Sp[0];
716 Sp -= sizeofW(StgSeqFrame);
719 JMP_(GET_ENTRY(R1.cl));
723 INFO_TABLE(forceIO_info,forceIO_entry,1,0,FUN_STATIC,,EF_,0,0);
727 /* Sp[0] contains the IO action we want to perform */
729 /* Replace it with the return continuation that enters the result. */
730 Sp[0] = (W_)&forceIO_ret_info;
732 /* Push the RealWorld# tag and enter */
733 Sp[0] =(W_)REALWORLD_TAG;
734 JMP_(GET_ENTRY(R1.cl));
737 SET_STATIC_HDR(forceIO_closure,forceIO_info,CCS_DONTZuCARE,,EI_)
741 /* -----------------------------------------------------------------------------
742 Standard Infotables (for use in interpreter)
743 -------------------------------------------------------------------------- */
747 STGFUN(Hugs_CONSTR_entry)
749 /* R1 points at the constructor */
750 JMP_(ENTRY_CODE(((StgPtr*)Sp)[0]));
753 #define RET_BCO_ENTRY_TEMPLATE(label) \
758 ((StgPtr*)Sp)[0] = R1.p; \
759 JMP_(stg_yield_to_Hugs); \
763 RET_BCO_ENTRY_TEMPLATE(ret_bco_entry );
764 RET_BCO_ENTRY_TEMPLATE(ret_bco_0_entry);
765 RET_BCO_ENTRY_TEMPLATE(ret_bco_1_entry);
766 RET_BCO_ENTRY_TEMPLATE(ret_bco_2_entry);
767 RET_BCO_ENTRY_TEMPLATE(ret_bco_3_entry);
768 RET_BCO_ENTRY_TEMPLATE(ret_bco_4_entry);
769 RET_BCO_ENTRY_TEMPLATE(ret_bco_5_entry);
770 RET_BCO_ENTRY_TEMPLATE(ret_bco_6_entry);
771 RET_BCO_ENTRY_TEMPLATE(ret_bco_7_entry);
773 VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
775 #endif /* INTERPRETER */
777 /* -----------------------------------------------------------------------------
778 CHARLIKE and INTLIKE closures.
780 These are static representations of Chars and small Ints, so that
781 we can remove dynamic Chars and Ints during garbage collection and
782 replace them with references to the static objects.
783 -------------------------------------------------------------------------- */
785 #if defined(INTERPRETER) || defined(ENABLE_WIN32_DLL_SUPPORT)
787 * When sticking the RTS in a DLL, we delay populating the
788 * Charlike and Intlike tables until load-time, which is only
789 * when we've got the real addresses to the C# and I# closures.
792 static INFO_TBL_CONST StgInfoTable czh_static_info;
793 static INFO_TBL_CONST StgInfoTable izh_static_info;
794 #define Char_hash_static_info czh_static_info
795 #define Int_hash_static_info izh_static_info
797 #define Char_hash_static_info PrelBase_Czh_static_info
798 #define Int_hash_static_info PrelBase_Izh_static_info
801 #define CHARLIKE_HDR(n) \
803 STATIC_HDR(Char_hash_static_info, /* C# */ \
808 #define INTLIKE_HDR(n) \
810 STATIC_HDR(Int_hash_static_info, /* I# */ \
815 /* put these in the *data* section, since the garbage collector relies
816 * on the fact that static closures live in the data section.
819 /* end the name with _closure, to convince the mangler this is a closure */
821 StgIntCharlikeClosure CHARLIKE_closure[] = {
1080 StgIntCharlikeClosure INTLIKE_closure[] = {
1081 INTLIKE_HDR(-16), /* MIN_INTLIKE == -16 */
1113 INTLIKE_HDR(16) /* MAX_INTLIKE == 16 */