1 /* -----------------------------------------------------------------------------
2 * $Id: StgMiscClosures.hc,v 1.31 2000/01/13 14:34:05 hwloidl 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(raiseError, errorHandler); \
43 stg_exit(EXIT_FAILURE); /* not executed */ \
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*/);
213 CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
218 /* Put ourselves on the blocking queue for this black hole */
219 #if defined(GRAN) || defined(PAR)
220 /* in fact, only difference is the type of the end-of-queue marker! */
221 CurrentTSO->link = END_BQ_QUEUE;
222 ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
224 CurrentTSO->link = END_TSO_QUEUE;
225 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
227 /* jot down why and on what closure we are blocked */
228 CurrentTSO->why_blocked = BlockedOnBlackHole;
229 CurrentTSO->block_info.closure = R1.cl;
230 /* closure is mutable since something has just been added to its BQ */
231 recordMutable((StgMutClosure *)R1.cl);
232 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
233 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
236 /* Save the Thread State here, before calling RTS routines below! */
237 SAVE_THREAD_STATE(1);
239 /* if collecting stats update the execution time etc */
240 if (RtsFlags.ParFlags.ParStats.Full) {
241 /* Note that CURRENT_TIME may perform an unsafe call */
242 //rtsTime now = CURRENT_TIME; /* Now */
243 CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat;
244 CurrentTSO->par.blockcount++;
245 CurrentTSO->par.blockedat = CURRENT_TIME;
246 DumpRawGranEvent(CURRENT_PROC, thisPE,
247 GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0);
250 THREAD_RETURN(1); /* back to the scheduler */
252 /* stg_gen_block is too heavyweight, use a specialised one */
259 INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,0,0);
260 STGFUN(BLACKHOLE_BQ_entry)
264 /* Before overwriting TSO_LINK */
265 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
269 CMPXCHG(R1.cl->header.info, &BLACKHOLE_BQ_info, &WHITEHOLE_info);
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;
285 /* Save the Thread State here, before calling RTS routines below! */
286 SAVE_THREAD_STATE(1);
288 /* if collecting stats update the execution time etc */
289 if (RtsFlags.ParFlags.ParStats.Full) {
290 /* Note that CURRENT_TIME may perform an unsafe call */
291 //rtsTime now = CURRENT_TIME; /* Now */
292 CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat;
293 CurrentTSO->par.blockcount++;
294 CurrentTSO->par.blockedat = CURRENT_TIME;
295 DumpRawGranEvent(CURRENT_PROC, thisPE,
296 GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0);
299 THREAD_RETURN(1); /* back to the scheduler */
301 /* stg_gen_block is too heavyweight, use a specialised one */
308 Revertible black holes are needed in the parallel world, to handle
309 negative acknowledgements of messages containing updatable closures.
310 The idea is that when the original message is transmitted, the closure
311 is turned into a revertible black hole...an object which acts like a
312 black hole when local threads try to enter it, but which can be reverted
313 back to the original closure if necessary.
315 It's actually a lot like a blocking queue (BQ) entry, because revertible
316 black holes are initially set up with an empty blocking queue.
319 #if defined(PAR) || defined(GRAN)
321 INFO_TABLE(RBH_info, RBH_entry,1,1,RBH,,EF_,0,0);
326 /* mainly statistics gathering for GranSim simulation */
327 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
330 /* exactly the same as a BLACKHOLE_BQ_entry -- HWL */
331 /* Put ourselves on the blocking queue for this black hole */
332 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
333 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
334 /* jot down why and on what closure we are blocked */
335 CurrentTSO->why_blocked = BlockedOnBlackHole;
336 CurrentTSO->block_info.closure = R1.cl;
339 /* Save the Thread State here, before calling RTS routines below! */
340 SAVE_THREAD_STATE(1);
342 /* if collecting stats update the execution time etc */
343 if (RtsFlags.ParFlags.ParStats.Full) {
344 /* Note that CURRENT_TIME may perform an unsafe call */
345 //rtsTime now = CURRENT_TIME; /* Now */
346 CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat;
347 CurrentTSO->par.blockcount++;
348 CurrentTSO->par.blockedat = CURRENT_TIME;
349 DumpRawGranEvent(CURRENT_PROC, thisPE,
350 GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0);
353 THREAD_RETURN(1); /* back to the scheduler */
355 /* saves thread state and leaves thread in ThreadEnterGHC state; */
356 /* stg_gen_block is too heavyweight, use a specialised one */
363 INFO_TABLE(RBH_Save_0_info, RBH_Save_0_entry,0,2,CONSTR,,EF_,0,0);
364 NON_ENTERABLE_ENTRY_CODE(RBH_Save_0);
366 INFO_TABLE(RBH_Save_1_info, RBH_Save_1_entry,1,1,CONSTR,,EF_,0,0);
367 NON_ENTERABLE_ENTRY_CODE(RBH_Save_1);
369 INFO_TABLE(RBH_Save_2_info, RBH_Save_2_entry,2,0,CONSTR,,EF_,0,0);
370 NON_ENTERABLE_ENTRY_CODE(RBH_Save_2);
371 #endif /* defined(PAR) || defined(GRAN) */
373 /* identical to BLACKHOLEs except for the infotag */
374 INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,0,0);
375 STGFUN(CAF_BLACKHOLE_entry)
379 /* mainly statistics gathering for GranSim simulation */
380 STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/);
384 CMPXCHG(R1.cl->header.info, &CAF_BLACKHOLE_info, &WHITEHOLE_info);
389 /* Put ourselves on the blocking queue for this black hole */
390 #if defined(GRAN) || defined(PAR)
391 /* in fact, only difference is the type of the end-of-queue marker! */
392 CurrentTSO->link = END_BQ_QUEUE;
393 ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
395 CurrentTSO->link = END_TSO_QUEUE;
396 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
398 /* jot down why and on what closure we are blocked */
399 CurrentTSO->why_blocked = BlockedOnBlackHole;
400 CurrentTSO->block_info.closure = R1.cl;
401 /* closure is mutable since something has just been added to its BQ */
402 recordMutable((StgMutClosure *)R1.cl);
403 /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ */
404 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
407 /* Save the Thread State here, before calling RTS routines below! */
408 SAVE_THREAD_STATE(1);
410 /* if collecting stats update the execution time etc */
411 if (RtsFlags.ParFlags.ParStats.Full) {
412 /* Note that CURRENT_TIME may perform an unsafe call */
413 //rtsTime now = CURRENT_TIME; /* Now */
414 CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat;
415 CurrentTSO->par.blockcount++;
416 CurrentTSO->par.blockedat = CURRENT_TIME;
417 DumpRawGranEvent(CURRENT_PROC, thisPE,
418 GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0);
421 THREAD_RETURN(1); /* back to the scheduler */
423 /* stg_gen_block is too heavyweight, use a specialised one */
431 INFO_TABLE(SE_BLACKHOLE_info, SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,0,0);
432 STGFUN(SE_BLACKHOLE_entry)
435 STGCALL3(fprintf,stderr,"SE_BLACKHOLE at %p entered!\n",R1.p);
436 STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
440 INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,EF_,0,0);
441 STGFUN(SE_CAF_BLACKHOLE_entry)
444 STGCALL3(fprintf,stderr,"SE_CAF_BLACKHOLE at %p entered!\n",R1.p);
445 STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
451 INFO_TABLE(WHITEHOLE_info, WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,EF_,0,0);
452 STGFUN(WHITEHOLE_entry)
455 JMP_(GET_ENTRY(R1.cl));
460 /* -----------------------------------------------------------------------------
461 The code for a BCO returns to the scheduler
462 -------------------------------------------------------------------------- */
463 INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,,EF_,0,0);
468 JMP_(stg_yield_to_Hugs);
472 /* -----------------------------------------------------------------------------
473 Some static info tables for things that don't get entered, and
474 therefore don't need entry code (i.e. boxed but unpointed objects)
475 NON_ENTERABLE_ENTRY_CODE now defined at the beginning of the file
476 -------------------------------------------------------------------------- */
478 INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,,EF_,0,0);
479 NON_ENTERABLE_ENTRY_CODE(TSO);
481 /* -----------------------------------------------------------------------------
482 Evacuees are left behind by the garbage collector. Any attempt to enter
484 -------------------------------------------------------------------------- */
486 INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,,EF_,0,0);
487 NON_ENTERABLE_ENTRY_CODE(EVACUATED);
489 /* -----------------------------------------------------------------------------
492 Live weak pointers have a special closure type. Dead ones are just
493 nullary constructors (although they live on the heap - we overwrite
494 live weak pointers with dead ones).
495 -------------------------------------------------------------------------- */
497 INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,,EF_,0,0);
498 NON_ENTERABLE_ENTRY_CODE(WEAK);
500 INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,0,0);
501 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
503 /* -----------------------------------------------------------------------------
506 This is a static nullary constructor (like []) that we use to mark an empty
507 finalizer in a weak pointer object.
508 -------------------------------------------------------------------------- */
510 INFO_TABLE_CONSTR(NO_FINALIZER_info,NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
511 NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
513 SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_)
516 /* -----------------------------------------------------------------------------
517 Foreign Objects are unlifted and therefore never entered.
518 -------------------------------------------------------------------------- */
520 INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,,EF_,0,0);
521 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
523 /* -----------------------------------------------------------------------------
524 Stable Names are unlifted too.
525 -------------------------------------------------------------------------- */
527 INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,0,0);
528 NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
530 /* -----------------------------------------------------------------------------
533 There are two kinds of these: full and empty. We need an info table
534 and entry code for each type.
535 -------------------------------------------------------------------------- */
537 INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,,EF_,0,0);
538 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
540 INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,,EF_,0,0);
541 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
543 /* -----------------------------------------------------------------------------
546 This is a static nullary constructor (like []) that we use to mark the
547 end of a linked TSO queue.
548 -------------------------------------------------------------------------- */
550 INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
551 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
553 SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
556 /* -----------------------------------------------------------------------------
559 Mutable lists (used by the garbage collector) consist of a chain of
560 StgMutClosures connected through their mut_link fields, ending in
561 an END_MUT_LIST closure.
562 -------------------------------------------------------------------------- */
564 INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
565 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
567 SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
570 INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
571 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
573 /* -----------------------------------------------------------------------------
575 -------------------------------------------------------------------------- */
577 INFO_TABLE_CONSTR(END_EXCEPTION_LIST_info,END_EXCEPTION_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
578 NON_ENTERABLE_ENTRY_CODE(END_EXCEPTION_LIST);
580 SET_STATIC_HDR(END_EXCEPTION_LIST_closure,END_EXCEPTION_LIST_info,0/*CC*/,,EI_)
583 INFO_TABLE(EXCEPTION_CONS_info, EXCEPTION_CONS_entry, 1, 1, CONSTR, , EF_, 0, 0);
584 NON_ENTERABLE_ENTRY_CODE(EXCEPTION_CONS);
586 /* -----------------------------------------------------------------------------
589 These come in two basic flavours: arrays of data (StgArrWords) and arrays of
590 pointers (StgArrPtrs). They all have a similar layout:
592 ___________________________
593 | Info | No. of | data....
595 ---------------------------
597 These are *unpointed* objects: i.e. they cannot be entered.
599 -------------------------------------------------------------------------- */
601 #define ArrayInfo(type) \
602 INFO_TABLE(type##_info, type##_entry, 0, 0, type, , EF_,0,0);
604 ArrayInfo(ARR_WORDS);
605 NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
606 ArrayInfo(MUT_ARR_PTRS);
607 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS);
608 ArrayInfo(MUT_ARR_PTRS_FROZEN);
609 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
613 /* -----------------------------------------------------------------------------
615 -------------------------------------------------------------------------- */
617 INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
618 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
620 /* -----------------------------------------------------------------------------
621 Standard Error Entry.
623 This is used for filling in vector-table entries that can never happen,
625 -------------------------------------------------------------------------- */
627 STGFUN(stg_error_entry) \
630 DUMP_ERRMSG("fatal: stg_error_entry"); \
631 STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \
635 /* -----------------------------------------------------------------------------
638 Entering this closure will just return to the address on the top of the
639 stack. Useful for getting a thread in a canonical form where we can
640 just enter the top stack word to start the thread. (see deleteThread)
641 * -------------------------------------------------------------------------- */
643 INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, , EF_, 0, 0);
650 JMP_(ENTRY_CODE(ret_addr));
653 SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_)
656 /* -----------------------------------------------------------------------------
657 Strict IO application - performing an IO action and entering its result.
659 rts_evalIO() lets you perform Haskell IO actions from outside of Haskell-land,
660 returning back to you their result. Want this result to be evaluated to WHNF
661 by that time, so that we can easily get at the int/char/whatever using the
662 various get{Ty} functions provided by the RTS API.
664 forceIO takes care of this, performing the IO action and entering the
665 results that comes back.
667 * -------------------------------------------------------------------------- */
669 INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
670 FN_(forceIO_ret_entry)
674 Sp -= sizeofW(StgSeqFrame);
676 JMP_(GET_ENTRY(R1.cl));
680 INFO_TABLE(forceIO_info,forceIO_entry,1,0,FUN,,EF_,0,0);
684 /* Sp[0] contains the IO action we want to perform */
686 /* Replace it with the return continuation that enters the result. */
687 Sp[0] = (W_)&forceIO_ret_info;
689 /* Push the RealWorld# tag and enter */
690 Sp[0] =(W_)REALWORLD_TAG;
691 JMP_(GET_ENTRY(R1.cl));
694 SET_STATIC_HDR(forceIO_closure,forceIO_info,CCS_DONTZuCARE,,EI_)
698 /* -----------------------------------------------------------------------------
699 Standard Infotables (for use in interpreter)
700 -------------------------------------------------------------------------- */
704 STGFUN(Hugs_CONSTR_entry)
706 /* R1 points at the constructor */
707 JMP_(ENTRY_CODE(((StgPtr*)Sp)[0]));
710 #define RET_BCO_ENTRY_TEMPLATE(label) \
715 ((StgPtr*)Sp)[0] = R1.p; \
716 JMP_(stg_yield_to_Hugs); \
720 RET_BCO_ENTRY_TEMPLATE(ret_bco_entry );
721 RET_BCO_ENTRY_TEMPLATE(ret_bco_0_entry);
722 RET_BCO_ENTRY_TEMPLATE(ret_bco_1_entry);
723 RET_BCO_ENTRY_TEMPLATE(ret_bco_2_entry);
724 RET_BCO_ENTRY_TEMPLATE(ret_bco_3_entry);
725 RET_BCO_ENTRY_TEMPLATE(ret_bco_4_entry);
726 RET_BCO_ENTRY_TEMPLATE(ret_bco_5_entry);
727 RET_BCO_ENTRY_TEMPLATE(ret_bco_6_entry);
728 RET_BCO_ENTRY_TEMPLATE(ret_bco_7_entry);
730 VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
732 #endif /* INTERPRETER */
736 INFO_TABLE_CONSTR(Czh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,,EF_,0,0);
737 INFO_TABLE_CONSTR(Izh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,,EF_,0,0);
738 INFO_TABLE_CONSTR(I64zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,,EF_,0,0);
739 INFO_TABLE_CONSTR(Fzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,,EF_,0,0);
740 INFO_TABLE_CONSTR(Dzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,,EF_,0,0);
741 INFO_TABLE_CONSTR(Azh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,,EF_,0,0);
742 INFO_TABLE_CONSTR(Wzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,,EF_,0,0);
743 INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,,EF_,0,0);
745 /* These might seem redundant but {I,C}zh_static_info are used in
746 * {INT,CHAR}LIKE and the rest are used in RtsAPI.c
748 INFO_TABLE_CONSTR(Czh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
749 INFO_TABLE_CONSTR(Izh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
750 INFO_TABLE_CONSTR(I64zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
751 INFO_TABLE_CONSTR(Fzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
752 INFO_TABLE_CONSTR(Dzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
753 INFO_TABLE_CONSTR(Azh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
754 INFO_TABLE_CONSTR(Wzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
755 INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
757 #endif /* !defined(COMPILER) */
759 /* -----------------------------------------------------------------------------
760 CHARLIKE and INTLIKE closures.
762 These are static representations of Chars and small Ints, so that
763 we can remove dynamic Chars and Ints during garbage collection and
764 replace them with references to the static objects.
765 -------------------------------------------------------------------------- */
767 #ifdef ENABLE_WIN32_DLL_SUPPORT
769 * When sticking the RTS in a DLL, we delay populating the
770 * Charlike and Intlike tables until load-time, which is only
771 * when we've got the real addresses to the C# and I# closures.
774 static INFO_TBL_CONST StgInfoTable czh_static_info;
775 static INFO_TBL_CONST StgInfoTable izh_static_info;
776 #define Char_hash_static_info czh_static_info
777 #define Int_hash_static_info izh_static_info
779 #define Char_hash_static_info Czh_static_info
780 #define Int_hash_static_info Izh_static_info
783 #define CHARLIKE_HDR(n) \
785 STATIC_HDR(Char_hash_static_info, /* C# */ \
790 #define INTLIKE_HDR(n) \
792 STATIC_HDR(Int_hash_static_info, /* I# */ \
797 /* put these in the *data* section, since the garbage collector relies
798 * on the fact that static closures live in the data section.
801 /* end the name with _closure, to convince the mangler this is a closure */
803 StgIntCharlikeClosure CHARLIKE_closure[] = {
1062 StgIntCharlikeClosure INTLIKE_closure[] = {
1063 INTLIKE_HDR(-16), /* MIN_INTLIKE == -16 */
1095 INTLIKE_HDR(16) /* MAX_INTLIKE == 16 */