1 /* -----------------------------------------------------------------------------
2 * $Id: StgMiscClosures.hc,v 1.35 2000/02/04 11:18:05 simonmar Exp $
4 * (c) The GHC Team, 1998-1999
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"
19 #if defined(GRAN) || defined(PAR)
20 # include "GranSimRts.h" /* for DumpRawGranEvent */
21 # include "StgRun.h" /* for StgReturn and register saving */
28 /* ToDo: make the printing of panics more Win32-friendly, i.e.,
29 * pop up some lovely message boxes (as well).
31 #define DUMP_ERRMSG(msg) STGCALL2(fprintf,stderr,msg)
34 Template for the entry code of non-enterable closures.
37 #define NON_ENTERABLE_ENTRY_CODE(type) \
38 STGFUN(type##_entry) \
41 DUMP_ERRMSG(#type " object entered!\n"); \
42 STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \
46 /* -----------------------------------------------------------------------------
47 Entry code for an indirection.
49 This code assumes R1 is in a register for now.
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 */
70 R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
72 JMP_(ENTRY_CODE(*R1.p));
76 INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,,EF_,0,0);
77 STGFUN(IND_PERM_entry)
80 /* Don't add INDs to granularity cost */
81 /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
83 #if defined(TICKY_TICKY) && !defined(PROFILING)
84 /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */
85 TICK_ENT_PERM_IND(R1.p); /* tick */
88 /* Enter PAP cost centre -- lexical scoping only */
89 ENTER_CCS_PAP_CL(R1.cl);
91 /* For ticky-ticky, change the perm_ind to a normal ind on first
92 * entry, so the number of ent_perm_inds is the number of *thunks*
93 * entered again, not the number of subsequent entries.
95 * Since this screws up cost centres, we die if profiling and
96 * ticky_ticky are on at the same time. KSW 1999-01.
101 # error Profiling and ticky-ticky do not mix at present!
102 # endif /* PROFILING */
103 SET_INFO((StgInd*)R1.p,&IND_info);
104 #endif /* TICKY_TICKY */
106 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
108 /* Dont: TICK_ENT_VIA_NODE(); for ticky-ticky; as above */
110 #if defined(TICKY_TICKY) && !defined(PROFILING)
114 JMP_(ENTRY_CODE(*R1.p));
118 INFO_TABLE(IND_OLDGEN_info,IND_OLDGEN_entry,1,1,IND_OLDGEN,,EF_,0,0);
119 STGFUN(IND_OLDGEN_entry)
122 TICK_ENT_IND(Node); /* tick */
124 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
126 JMP_(ENTRY_CODE(*R1.p));
130 INFO_TABLE(IND_OLDGEN_PERM_info,IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,,EF_,0,0);
131 STGFUN(IND_OLDGEN_PERM_entry)
134 /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
136 #if defined(TICKY_TICKY) && !defined(PROFILING)
137 /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */
138 TICK_ENT_PERM_IND(R1.p); /* tick */
141 /* Enter PAP cost centre -- lexical scoping only */
142 ENTER_CCS_PAP_CL(R1.cl);
144 /* see comment in IND_PERM */
147 # error Profiling and ticky-ticky do not mix at present!
148 # endif /* PROFILING */
149 SET_INFO((StgInd*)R1.p,&IND_OLDGEN_info);
150 #endif /* TICKY_TICKY */
152 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
154 JMP_(ENTRY_CODE(*R1.p));
158 /* -----------------------------------------------------------------------------
161 This code assumes R1 is in a register for now.
162 -------------------------------------------------------------------------- */
164 INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,3,CAF_UNENTERED,,EF_,0,0);
165 STGFUN(CAF_UNENTERED_entry)
168 /* ToDo: implement directly in GHC */
171 JMP_(stg_yield_to_Hugs);
175 /* 0,4 is entirely bogus; _do not_ rely on this info */
176 INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,0,4,CAF_ENTERED,,EF_,0,0);
177 STGFUN(CAF_ENTERED_entry)
180 R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */
182 JMP_(GET_ENTRY(R1.cl));
186 /* -----------------------------------------------------------------------------
187 Entry code for a black hole.
189 Entering a black hole normally causes a cyclic data dependency, but
190 in the concurrent world, black holes are synchronization points,
191 and they are turned into blocking queues when there are threads
192 waiting for the evaluation of the closure to finish.
193 -------------------------------------------------------------------------- */
195 /* Note: a BLACKHOLE and BLACKHOLE_BQ must be big enough to be
196 * overwritten with an indirection/evacuee/catch. Thus we claim it
197 * has 1 non-pointer word of payload (in addition to the pointer word
198 * for the blocking queue in a BQ), which should be big enough for an
199 * old-generation indirection.
202 INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,0,0);
203 STGFUN(BLACKHOLE_entry)
207 /* Before overwriting TSO_LINK */
208 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
213 bdescr *bd = Bdescr(R1.p);
214 if (bd->back != (bdescr *)BaseReg) {
215 if (bd->gen->no >= 1 || bd->step->no >= 1) {
216 CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
218 EXTFUN_RTS(stg_gc_enter_1_hponly);
219 JMP_(stg_gc_enter_1_hponly);
226 /* Put ourselves on the blocking queue for this black hole */
227 #if defined(GRAN) || defined(PAR)
228 /* in fact, only difference is the type of the end-of-queue marker! */
229 CurrentTSO->link = END_BQ_QUEUE;
230 ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
232 CurrentTSO->link = END_TSO_QUEUE;
233 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
235 /* jot down why and on what closure we are blocked */
236 CurrentTSO->why_blocked = BlockedOnBlackHole;
237 CurrentTSO->block_info.closure = R1.cl;
238 /* closure is mutable since something has just been added to its BQ */
239 recordMutable((StgMutClosure *)R1.cl);
240 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
241 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
244 /* Save the Thread State here, before calling RTS routines below! */
245 SAVE_THREAD_STATE(1);
247 /* if collecting stats update the execution time etc */
248 if (RtsFlags.ParFlags.ParStats.Full) {
249 /* Note that CURRENT_TIME may perform an unsafe call */
250 //rtsTime now = CURRENT_TIME; /* Now */
251 CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat;
252 CurrentTSO->par.blockcount++;
253 CurrentTSO->par.blockedat = CURRENT_TIME;
254 DumpRawGranEvent(CURRENT_PROC, thisPE,
255 GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0);
258 THREAD_RETURN(1); /* back to the scheduler */
260 /* stg_gen_block is too heavyweight, use a specialised one */
267 INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,0,0);
268 STGFUN(BLACKHOLE_BQ_entry)
272 /* Before overwriting TSO_LINK */
273 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
278 bdescr *bd = Bdescr(R1.p);
279 if (bd->back != (bdescr *)BaseReg) {
280 if (bd->gen->no >= 1 || bd->step->no >= 1) {
281 CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
283 EXTFUN_RTS(stg_gc_enter_1_hponly);
284 JMP_(stg_gc_enter_1_hponly);
292 /* Put ourselves on the blocking queue for this black hole */
293 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
294 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
295 /* jot down why and on what closure we are blocked */
296 CurrentTSO->why_blocked = BlockedOnBlackHole;
297 CurrentTSO->block_info.closure = R1.cl;
299 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
303 /* Save the Thread State here, before calling RTS routines below! */
304 SAVE_THREAD_STATE(1);
306 /* if collecting stats update the execution time etc */
307 if (RtsFlags.ParFlags.ParStats.Full) {
308 /* Note that CURRENT_TIME may perform an unsafe call */
309 //rtsTime now = CURRENT_TIME; /* Now */
310 CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat;
311 CurrentTSO->par.blockcount++;
312 CurrentTSO->par.blockedat = CURRENT_TIME;
313 DumpRawGranEvent(CURRENT_PROC, thisPE,
314 GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0);
317 THREAD_RETURN(1); /* back to the scheduler */
319 /* stg_gen_block is too heavyweight, use a specialised one */
326 Revertible black holes are needed in the parallel world, to handle
327 negative acknowledgements of messages containing updatable closures.
328 The idea is that when the original message is transmitted, the closure
329 is turned into a revertible black hole...an object which acts like a
330 black hole when local threads try to enter it, but which can be reverted
331 back to the original closure if necessary.
333 It's actually a lot like a blocking queue (BQ) entry, because revertible
334 black holes are initially set up with an empty blocking queue.
337 #if defined(PAR) || defined(GRAN)
339 INFO_TABLE(RBH_info, RBH_entry,1,1,RBH,,EF_,0,0);
344 /* mainly statistics gathering for GranSim simulation */
345 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
348 /* exactly the same as a BLACKHOLE_BQ_entry -- HWL */
349 /* Put ourselves on the blocking queue for this black hole */
350 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
351 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
352 /* jot down why and on what closure we are blocked */
353 CurrentTSO->why_blocked = BlockedOnBlackHole;
354 CurrentTSO->block_info.closure = R1.cl;
357 /* Save the Thread State here, before calling RTS routines below! */
358 SAVE_THREAD_STATE(1);
360 /* if collecting stats update the execution time etc */
361 if (RtsFlags.ParFlags.ParStats.Full) {
362 /* Note that CURRENT_TIME may perform an unsafe call */
363 //rtsTime now = CURRENT_TIME; /* Now */
364 CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat;
365 CurrentTSO->par.blockcount++;
366 CurrentTSO->par.blockedat = CURRENT_TIME;
367 DumpRawGranEvent(CURRENT_PROC, thisPE,
368 GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0);
371 THREAD_RETURN(1); /* back to the scheduler */
373 /* saves thread state and leaves thread in ThreadEnterGHC state; */
374 /* stg_gen_block is too heavyweight, use a specialised one */
381 INFO_TABLE(RBH_Save_0_info, RBH_Save_0_entry,0,2,CONSTR,,EF_,0,0);
382 NON_ENTERABLE_ENTRY_CODE(RBH_Save_0);
384 INFO_TABLE(RBH_Save_1_info, RBH_Save_1_entry,1,1,CONSTR,,EF_,0,0);
385 NON_ENTERABLE_ENTRY_CODE(RBH_Save_1);
387 INFO_TABLE(RBH_Save_2_info, RBH_Save_2_entry,2,0,CONSTR,,EF_,0,0);
388 NON_ENTERABLE_ENTRY_CODE(RBH_Save_2);
389 #endif /* defined(PAR) || defined(GRAN) */
391 /* identical to BLACKHOLEs except for the infotag */
392 INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,0,0);
393 STGFUN(CAF_BLACKHOLE_entry)
397 /* mainly statistics gathering for GranSim simulation */
398 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
403 bdescr *bd = Bdescr(R1.p);
404 if (bd->back != (bdescr *)BaseReg) {
405 if (bd->gen->no >= 1 || bd->step->no >= 1) {
406 CMPXCHG(R1.cl->header.info, &CAF_BLACKHOLE_info, &WHITEHOLE_info);
408 EXTFUN_RTS(stg_gc_enter_1_hponly);
409 JMP_(stg_gc_enter_1_hponly);
417 /* Put ourselves on the blocking queue for this black hole */
418 #if defined(GRAN) || defined(PAR)
419 /* in fact, only difference is the type of the end-of-queue marker! */
420 CurrentTSO->link = END_BQ_QUEUE;
421 ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
423 CurrentTSO->link = END_TSO_QUEUE;
424 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
426 /* jot down why and on what closure we are blocked */
427 CurrentTSO->why_blocked = BlockedOnBlackHole;
428 CurrentTSO->block_info.closure = R1.cl;
429 /* closure is mutable since something has just been added to its BQ */
430 recordMutable((StgMutClosure *)R1.cl);
431 /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ */
432 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
435 /* Save the Thread State here, before calling RTS routines below! */
436 SAVE_THREAD_STATE(1);
438 /* if collecting stats update the execution time etc */
439 if (RtsFlags.ParFlags.ParStats.Full) {
440 /* Note that CURRENT_TIME may perform an unsafe call */
441 //rtsTime now = CURRENT_TIME; /* Now */
442 CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat;
443 CurrentTSO->par.blockcount++;
444 CurrentTSO->par.blockedat = CURRENT_TIME;
445 DumpRawGranEvent(CURRENT_PROC, thisPE,
446 GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0);
449 THREAD_RETURN(1); /* back to the scheduler */
451 /* stg_gen_block is too heavyweight, use a specialised one */
459 INFO_TABLE(SE_BLACKHOLE_info, SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,0,0);
460 STGFUN(SE_BLACKHOLE_entry)
463 STGCALL3(fprintf,stderr,"SE_BLACKHOLE at %p entered!\n",R1.p);
464 STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
468 INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,EF_,0,0);
469 STGFUN(SE_CAF_BLACKHOLE_entry)
472 STGCALL3(fprintf,stderr,"SE_CAF_BLACKHOLE at %p entered!\n",R1.p);
473 STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
479 INFO_TABLE(WHITEHOLE_info, WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,EF_,0,0);
480 STGFUN(WHITEHOLE_entry)
483 JMP_(GET_ENTRY(R1.cl));
488 /* -----------------------------------------------------------------------------
489 The code for a BCO returns to the scheduler
490 -------------------------------------------------------------------------- */
491 INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,,EF_,0,0);
496 JMP_(stg_yield_to_Hugs);
500 /* -----------------------------------------------------------------------------
501 Some static info tables for things that don't get entered, and
502 therefore don't need entry code (i.e. boxed but unpointed objects)
503 NON_ENTERABLE_ENTRY_CODE now defined at the beginning of the file
504 -------------------------------------------------------------------------- */
506 INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,,EF_,0,0);
507 NON_ENTERABLE_ENTRY_CODE(TSO);
509 /* -----------------------------------------------------------------------------
510 Evacuees are left behind by the garbage collector. Any attempt to enter
512 -------------------------------------------------------------------------- */
514 INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,,EF_,0,0);
515 NON_ENTERABLE_ENTRY_CODE(EVACUATED);
517 /* -----------------------------------------------------------------------------
520 Live weak pointers have a special closure type. Dead ones are just
521 nullary constructors (although they live on the heap - we overwrite
522 live weak pointers with dead ones).
523 -------------------------------------------------------------------------- */
525 INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,,EF_,0,0);
526 NON_ENTERABLE_ENTRY_CODE(WEAK);
528 INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,0,0);
529 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
531 /* -----------------------------------------------------------------------------
534 This is a static nullary constructor (like []) that we use to mark an empty
535 finalizer in a weak pointer object.
536 -------------------------------------------------------------------------- */
538 INFO_TABLE_CONSTR(NO_FINALIZER_info,NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
539 NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
541 SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_)
544 /* -----------------------------------------------------------------------------
545 Foreign Objects are unlifted and therefore never entered.
546 -------------------------------------------------------------------------- */
548 INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,,EF_,0,0);
549 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
551 /* -----------------------------------------------------------------------------
552 Stable Names are unlifted too.
553 -------------------------------------------------------------------------- */
555 INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,0,0);
556 NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
558 /* -----------------------------------------------------------------------------
561 There are two kinds of these: full and empty. We need an info table
562 and entry code for each type.
563 -------------------------------------------------------------------------- */
565 INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,,EF_,0,0);
566 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
568 INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,,EF_,0,0);
569 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
571 /* -----------------------------------------------------------------------------
574 This is a static nullary constructor (like []) that we use to mark the
575 end of a linked TSO queue.
576 -------------------------------------------------------------------------- */
578 INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
579 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
581 SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
584 /* -----------------------------------------------------------------------------
587 Mutable lists (used by the garbage collector) consist of a chain of
588 StgMutClosures connected through their mut_link fields, ending in
589 an END_MUT_LIST closure.
590 -------------------------------------------------------------------------- */
592 INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
593 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
595 SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
598 INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
599 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
601 /* -----------------------------------------------------------------------------
603 -------------------------------------------------------------------------- */
605 INFO_TABLE_CONSTR(END_EXCEPTION_LIST_info,END_EXCEPTION_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
606 NON_ENTERABLE_ENTRY_CODE(END_EXCEPTION_LIST);
608 SET_STATIC_HDR(END_EXCEPTION_LIST_closure,END_EXCEPTION_LIST_info,0/*CC*/,,EI_)
611 INFO_TABLE(EXCEPTION_CONS_info, EXCEPTION_CONS_entry, 1, 1, CONSTR, , EF_, 0, 0);
612 NON_ENTERABLE_ENTRY_CODE(EXCEPTION_CONS);
614 /* -----------------------------------------------------------------------------
617 These come in two basic flavours: arrays of data (StgArrWords) and arrays of
618 pointers (StgArrPtrs). They all have a similar layout:
620 ___________________________
621 | Info | No. of | data....
623 ---------------------------
625 These are *unpointed* objects: i.e. they cannot be entered.
627 -------------------------------------------------------------------------- */
629 #define ArrayInfo(type) \
630 INFO_TABLE(type##_info, type##_entry, 0, 0, type, , EF_,0,0);
632 ArrayInfo(ARR_WORDS);
633 NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
634 ArrayInfo(MUT_ARR_PTRS);
635 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS);
636 ArrayInfo(MUT_ARR_PTRS_FROZEN);
637 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
641 /* -----------------------------------------------------------------------------
643 -------------------------------------------------------------------------- */
645 INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
646 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
648 /* -----------------------------------------------------------------------------
649 Standard Error Entry.
651 This is used for filling in vector-table entries that can never happen,
653 -------------------------------------------------------------------------- */
655 STGFUN(stg_error_entry) \
658 DUMP_ERRMSG("fatal: stg_error_entry"); \
659 STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \
663 /* -----------------------------------------------------------------------------
666 Entering this closure will just return to the address on the top of the
667 stack. Useful for getting a thread in a canonical form where we can
668 just enter the top stack word to start the thread. (see deleteThread)
669 * -------------------------------------------------------------------------- */
671 INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, , EF_, 0, 0);
678 JMP_(ENTRY_CODE(ret_addr));
681 SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_)
684 /* -----------------------------------------------------------------------------
685 Strict IO application - performing an IO action and entering its result.
687 rts_evalIO() lets you perform Haskell IO actions from outside of Haskell-land,
688 returning back to you their result. Want this result to be evaluated to WHNF
689 by that time, so that we can easily get at the int/char/whatever using the
690 various get{Ty} functions provided by the RTS API.
692 forceIO takes care of this, performing the IO action and entering the
693 results that comes back.
695 * -------------------------------------------------------------------------- */
698 INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
699 FN_(forceIO_ret_entry)
703 Sp -= sizeofW(StgSeqFrame);
705 JMP_(GET_ENTRY(R1.cl));
708 INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
709 FN_(forceIO_ret_entry)
713 rval = (StgClosure *)Sp[0];
715 Sp -= sizeofW(StgSeqFrame);
717 JMP_(GET_ENTRY(rval));
721 INFO_TABLE(forceIO_info,forceIO_entry,1,0,FUN_STATIC,,EF_,0,0);
725 /* Sp[0] contains the IO action we want to perform */
727 /* Replace it with the return continuation that enters the result. */
728 Sp[0] = (W_)&forceIO_ret_info;
730 /* Push the RealWorld# tag and enter */
731 Sp[0] =(W_)REALWORLD_TAG;
732 JMP_(GET_ENTRY(R1.cl));
735 SET_STATIC_HDR(forceIO_closure,forceIO_info,CCS_DONTZuCARE,,EI_)
739 /* -----------------------------------------------------------------------------
740 Standard Infotables (for use in interpreter)
741 -------------------------------------------------------------------------- */
745 STGFUN(Hugs_CONSTR_entry)
747 /* R1 points at the constructor */
748 JMP_(ENTRY_CODE(((StgPtr*)Sp)[0]));
751 #define RET_BCO_ENTRY_TEMPLATE(label) \
756 ((StgPtr*)Sp)[0] = R1.p; \
757 JMP_(stg_yield_to_Hugs); \
761 RET_BCO_ENTRY_TEMPLATE(ret_bco_entry );
762 RET_BCO_ENTRY_TEMPLATE(ret_bco_0_entry);
763 RET_BCO_ENTRY_TEMPLATE(ret_bco_1_entry);
764 RET_BCO_ENTRY_TEMPLATE(ret_bco_2_entry);
765 RET_BCO_ENTRY_TEMPLATE(ret_bco_3_entry);
766 RET_BCO_ENTRY_TEMPLATE(ret_bco_4_entry);
767 RET_BCO_ENTRY_TEMPLATE(ret_bco_5_entry);
768 RET_BCO_ENTRY_TEMPLATE(ret_bco_6_entry);
769 RET_BCO_ENTRY_TEMPLATE(ret_bco_7_entry);
771 VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
773 #endif /* INTERPRETER */
777 INFO_TABLE_CONSTR(Czh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,,EF_,0,0);
778 INFO_TABLE_CONSTR(Izh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,,EF_,0,0);
779 INFO_TABLE_CONSTR(I64zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,,EF_,0,0);
780 INFO_TABLE_CONSTR(Fzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,,EF_,0,0);
781 INFO_TABLE_CONSTR(Dzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,,EF_,0,0);
782 INFO_TABLE_CONSTR(Azh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,,EF_,0,0);
783 INFO_TABLE_CONSTR(Wzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,,EF_,0,0);
784 INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,,EF_,0,0);
786 /* These might seem redundant but {I,C}zh_static_info are used in
787 * {INT,CHAR}LIKE and the rest are used in RtsAPI.c
789 INFO_TABLE_CONSTR(Czh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
790 INFO_TABLE_CONSTR(Izh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
791 INFO_TABLE_CONSTR(I64zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
792 INFO_TABLE_CONSTR(Fzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
793 INFO_TABLE_CONSTR(Dzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
794 INFO_TABLE_CONSTR(Azh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
795 INFO_TABLE_CONSTR(Wzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
796 INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
798 #endif /* !defined(COMPILER) */
800 /* -----------------------------------------------------------------------------
801 CHARLIKE and INTLIKE closures.
803 These are static representations of Chars and small Ints, so that
804 we can remove dynamic Chars and Ints during garbage collection and
805 replace them with references to the static objects.
806 -------------------------------------------------------------------------- */
808 #ifdef ENABLE_WIN32_DLL_SUPPORT
810 * When sticking the RTS in a DLL, we delay populating the
811 * Charlike and Intlike tables until load-time, which is only
812 * when we've got the real addresses to the C# and I# closures.
815 static INFO_TBL_CONST StgInfoTable czh_static_info;
816 static INFO_TBL_CONST StgInfoTable izh_static_info;
817 #define Char_hash_static_info czh_static_info
818 #define Int_hash_static_info izh_static_info
820 #define Char_hash_static_info Czh_static_info
821 #define Int_hash_static_info Izh_static_info
824 #define CHARLIKE_HDR(n) \
826 STATIC_HDR(Char_hash_static_info, /* C# */ \
831 #define INTLIKE_HDR(n) \
833 STATIC_HDR(Int_hash_static_info, /* I# */ \
838 /* put these in the *data* section, since the garbage collector relies
839 * on the fact that static closures live in the data section.
842 /* end the name with _closure, to convince the mangler this is a closure */
844 StgIntCharlikeClosure CHARLIKE_closure[] = {
1103 StgIntCharlikeClosure INTLIKE_closure[] = {
1104 INTLIKE_HDR(-16), /* MIN_INTLIKE == -16 */
1136 INTLIKE_HDR(16) /* MAX_INTLIKE == 16 */