1 /* -----------------------------------------------------------------------------
2 * $Id: StgMiscClosures.hc,v 1.25 1999/06/08 10:26:39 simonmar Exp $
4 * (c) The GHC Team, 1998-1999
6 * Entry code for various built-in closure types.
8 * ---------------------------------------------------------------------------*/
12 #include "StgMiscClosures.h"
13 #include "HeapStackCheck.h" /* for stg_gen_yield */
15 #include "StoragePriv.h"
22 /* ToDo: make the printing of panics more Win32-friendly, i.e.,
23 * pop up some lovely message boxes (as well).
25 #define DUMP_ERRMSG(msg) STGCALL1(fflush,stdout); STGCALL2(fprintf,stderr,msg)
27 /* -----------------------------------------------------------------------------
28 Entry code for an indirection.
30 This code assumes R1 is in a register for now.
31 -------------------------------------------------------------------------- */
33 INFO_TABLE(IND_info,IND_entry,1,0,IND,,EF_,0,0);
37 TICK_ENT_IND(Node); /* tick */
39 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
41 JMP_(ENTRY_CODE(*R1.p));
45 INFO_TABLE(IND_STATIC_info,IND_STATIC_entry,1,0,IND_STATIC,,EF_,0,0);
46 STGFUN(IND_STATIC_entry)
49 TICK_ENT_IND(Node); /* tick */
51 R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
53 JMP_(ENTRY_CODE(*R1.p));
57 INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,,EF_,0,0);
58 STGFUN(IND_PERM_entry)
61 /* Don't add INDs to granularity cost */
62 /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
64 #if defined(TICKY_TICKY) && !defined(PROFILING)
65 /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */
66 TICK_ENT_PERM_IND(R1.p); /* tick */
69 /* Enter PAP cost centre -- lexical scoping only */
70 ENTER_CCS_PAP_CL(R1.cl);
72 /* For ticky-ticky, change the perm_ind to a normal ind on first
73 * entry, so the number of ent_perm_inds is the number of *thunks*
74 * entered again, not the number of subsequent entries.
76 * Since this screws up cost centres, we die if profiling and
77 * ticky_ticky are on at the same time. KSW 1999-01.
82 # error Profiling and ticky-ticky do not mix at present!
83 # endif /* PROFILING */
84 SET_INFO((StgInd*)R1.p,&IND_info);
85 #endif /* TICKY_TICKY */
87 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
89 /* Dont: TICK_ENT_VIA_NODE(); for ticky-ticky; as above */
91 #if defined(TICKY_TICKY) && !defined(PROFILING)
95 JMP_(ENTRY_CODE(*R1.p));
99 INFO_TABLE(IND_OLDGEN_info,IND_OLDGEN_entry,1,1,IND_OLDGEN,,EF_,0,0);
100 STGFUN(IND_OLDGEN_entry)
103 TICK_ENT_IND(Node); /* tick */
105 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
107 JMP_(ENTRY_CODE(*R1.p));
111 INFO_TABLE(IND_OLDGEN_PERM_info,IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,,EF_,0,0);
112 STGFUN(IND_OLDGEN_PERM_entry)
115 /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
117 #if defined(TICKY_TICKY) && !defined(PROFILING)
118 /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */
119 TICK_ENT_PERM_IND(R1.p); /* tick */
122 /* Enter PAP cost centre -- lexical scoping only */
123 ENTER_CCS_PAP_CL(R1.cl);
125 /* see comment in IND_PERM */
128 # error Profiling and ticky-ticky do not mix at present!
129 # endif /* PROFILING */
130 SET_INFO((StgInd*)R1.p,&IND_OLDGEN_info);
131 #endif /* TICKY_TICKY */
133 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
135 JMP_(ENTRY_CODE(*R1.p));
139 /* -----------------------------------------------------------------------------
142 This code assumes R1 is in a register for now.
143 -------------------------------------------------------------------------- */
145 INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,3,CAF_UNENTERED,,EF_,0,0);
146 STGFUN(CAF_UNENTERED_entry)
149 /* ToDo: implement directly in GHC */
152 JMP_(stg_yield_to_Hugs);
156 /* 0,4 is entirely bogus; _do not_ rely on this info */
157 INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,0,4,CAF_ENTERED,,EF_,0,0);
158 STGFUN(CAF_ENTERED_entry)
161 R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */
163 JMP_(GET_ENTRY(R1.cl));
167 /* -----------------------------------------------------------------------------
168 Entry code for a black hole.
170 Entering a black hole normally causes a cyclic data dependency, but
171 in the concurrent world, black holes are synchronization points,
172 and they are turned into blocking queues when there are threads
173 waiting for the evaluation of the closure to finish.
174 -------------------------------------------------------------------------- */
176 /* Note: a black hole must be big enough to be overwritten with an
177 * indirection/evacuee/catch. Thus we claim it has 1 non-pointer word of
178 * payload (in addition to the pointer word for the blocking queue), which
179 * should be big enough for an old-generation indirection.
182 INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,0,0);
183 STGFUN(BLACKHOLE_entry)
188 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
189 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
190 /* Put ourselves on the blocking queue for this black hole */
191 CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
192 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
193 CurrentTSO->blocked_on = R1.cl;
194 recordMutable((StgMutClosure *)R1.cl);
196 /* stg_gen_block is too heavyweight, use a specialised one */
201 INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,0,0);
202 STGFUN(BLACKHOLE_BQ_entry)
207 /* Put ourselves on the blocking queue for this black hole */
208 CurrentTSO->blocked_on = R1.cl;
209 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
210 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
212 /* stg_gen_block is too heavyweight, use a specialised one */
217 /* identical to BLACKHOLEs except for the infotag */
218 INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,0,0);
219 STGFUN(CAF_BLACKHOLE_entry)
224 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
225 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
226 /* Put ourselves on the blocking queue for this black hole */
227 CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
228 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
229 CurrentTSO->blocked_on = R1.cl;
230 recordMutable((StgMutClosure *)R1.cl);
232 /* stg_gen_block is too heavyweight, use a specialised one */
238 INFO_TABLE(SE_BLACKHOLE_info, SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,0,0);
239 STGFUN(SE_BLACKHOLE_entry)
242 STGCALL1(fflush,stdout);
243 STGCALL3(fprintf,stderr,"SE_BLACKHOLE at %p entered!\n",R1.p);
244 STGCALL1(raiseError, errorHandler);
245 stg_exit(EXIT_FAILURE); /* not executed */
249 INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,EF_,0,0);
250 STGFUN(SE_CAF_BLACKHOLE_entry)
253 STGCALL1(fflush,stdout);
254 STGCALL3(fprintf,stderr,"SE_CAF_BLACKHOLE at %p entered!\n",R1.p);
255 STGCALL1(raiseError, errorHandler);
256 stg_exit(EXIT_FAILURE); /* not executed */
261 /* -----------------------------------------------------------------------------
262 The code for a BCO returns to the scheduler
263 -------------------------------------------------------------------------- */
264 INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,,EF_,0,0);
269 JMP_(stg_yield_to_Hugs);
273 /* -----------------------------------------------------------------------------
274 Some static info tables for things that don't get entered, and
275 therefore don't need entry code (i.e. boxed but unpointed objects)
276 -------------------------------------------------------------------------- */
278 #define NON_ENTERABLE_ENTRY_CODE(type) \
279 STGFUN(type##_entry) \
282 DUMP_ERRMSG(#type " object entered!\n"); \
283 STGCALL1(raiseError, errorHandler); \
284 stg_exit(EXIT_FAILURE); /* not executed */ \
288 INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,,EF_,0,0);
289 NON_ENTERABLE_ENTRY_CODE(TSO);
291 /* -----------------------------------------------------------------------------
292 Evacuees are left behind by the garbage collector. Any attempt to enter
294 -------------------------------------------------------------------------- */
296 INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,,EF_,0,0);
297 NON_ENTERABLE_ENTRY_CODE(EVACUATED);
299 /* -----------------------------------------------------------------------------
302 Live weak pointers have a special closure type. Dead ones are just
303 nullary constructors (although they live on the heap - we overwrite
304 live weak pointers with dead ones).
305 -------------------------------------------------------------------------- */
307 INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,,EF_,0,0);
308 NON_ENTERABLE_ENTRY_CODE(WEAK);
310 INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,0,0);
311 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
313 /* -----------------------------------------------------------------------------
316 This is a static nullary constructor (like []) that we use to mark an empty
317 finalizer in a weak pointer object.
318 -------------------------------------------------------------------------- */
320 INFO_TABLE_CONSTR(NO_FINALIZER_info,NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
321 NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
323 SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_)
326 /* -----------------------------------------------------------------------------
327 Foreign Objects are unlifted and therefore never entered.
328 -------------------------------------------------------------------------- */
330 INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,,EF_,0,0);
331 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
333 /* -----------------------------------------------------------------------------
334 Stable Names are unlifted too.
335 -------------------------------------------------------------------------- */
337 INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,0,0);
338 NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
340 /* -----------------------------------------------------------------------------
343 There are two kinds of these: full and empty. We need an info table
344 and entry code for each type.
345 -------------------------------------------------------------------------- */
347 INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,,EF_,0,0);
348 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
350 INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,,EF_,0,0);
351 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
353 /* -----------------------------------------------------------------------------
356 This is a static nullary constructor (like []) that we use to mark the
357 end of a linked TSO queue.
358 -------------------------------------------------------------------------- */
360 INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
361 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
363 SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
366 /* -----------------------------------------------------------------------------
369 Mutable lists (used by the garbage collector) consist of a chain of
370 StgMutClosures connected through their mut_link fields, ending in
371 an END_MUT_LIST closure.
372 -------------------------------------------------------------------------- */
374 INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
375 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
377 SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
380 INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
381 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
383 /* -----------------------------------------------------------------------------
386 These come in two basic flavours: arrays of data (StgArrWords) and arrays of
387 pointers (StgArrPtrs). They all have a similar layout:
389 ___________________________
390 | Info | No. of | data....
392 ---------------------------
394 These are *unpointed* objects: i.e. they cannot be entered.
396 -------------------------------------------------------------------------- */
398 #define ArrayInfo(type) \
399 INFO_TABLE(type##_info, type##_entry, 0, 0, type, , EF_,0,0);
401 ArrayInfo(ARR_WORDS);
402 NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
403 ArrayInfo(MUT_ARR_PTRS);
404 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS);
405 ArrayInfo(MUT_ARR_PTRS_FROZEN);
406 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
410 /* -----------------------------------------------------------------------------
412 -------------------------------------------------------------------------- */
414 INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
415 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
417 /* -----------------------------------------------------------------------------
418 Standard Error Entry.
420 This is used for filling in vector-table entries that can never happen,
422 -------------------------------------------------------------------------- */
424 STGFUN(stg_error_entry) \
427 DUMP_ERRMSG("fatal: stg_error_entry"); \
428 STGCALL1(raiseError, errorHandler); \
429 exit(EXIT_FAILURE); /* not executed */ \
433 /* -----------------------------------------------------------------------------
436 Entering this closure will just return to the address on the top of the
437 stack. Useful for getting a thread in a canonical form where we can
438 just enter the top stack word to start the thread. (see deleteThread)
439 * -------------------------------------------------------------------------- */
441 INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, , EF_, 0, 0);
448 JMP_(ENTRY_CODE(ret_addr));
451 SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_)
454 /* -----------------------------------------------------------------------------
455 Strict IO application - performing an IO action and entering its result.
457 rts_evalIO() lets you perform Haskell IO actions from outside of Haskell-land,
458 returning back to you their result. Want this result to be evaluated to WHNF
459 by that time, so that we can easily get at the int/char/whatever using the
460 various get{Ty} functions provided by the RTS API.
462 forceIO takes care of this, performing the IO action and entering the
463 results that comes back.
465 * -------------------------------------------------------------------------- */
467 INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
468 FN_(forceIO_ret_entry)
472 Sp -= sizeofW(StgSeqFrame);
474 JMP_(GET_ENTRY(R1.cl));
478 INFO_TABLE(forceIO_info,forceIO_entry,1,0,FUN,,EF_,0,0);
482 /* Sp[0] contains the IO action we want to perform */
484 /* Replace it with the return continuation that enters the result. */
485 Sp[0] = (W_)&forceIO_ret_info;
487 /* Push the RealWorld# tag and enter */
488 Sp[0] =(W_)REALWORLD_TAG;
489 JMP_(GET_ENTRY(R1.cl));
492 SET_STATIC_HDR(forceIO_closure,forceIO_info,CCS_DONTZuCARE,,EI_)
496 /* -----------------------------------------------------------------------------
497 Standard Infotables (for use in interpreter)
498 -------------------------------------------------------------------------- */
502 STGFUN(Hugs_CONSTR_entry)
505 ((StgPtr*)Sp)[0] = R1.p;
506 /* vectored: JMP_(RET_VEC(((StgPtr*)Sp)[1],constrTag(?))); */
507 JMP_(ENTRY_CODE(((StgPtr*)Sp)[1]));
510 #define RET_BCO_ENTRY_TEMPLATE(label) \
515 ((StgPtr*)Sp)[0] = R1.p; \
516 JMP_(stg_yield_to_Hugs); \
520 RET_BCO_ENTRY_TEMPLATE(ret_bco_entry );
521 RET_BCO_ENTRY_TEMPLATE(ret_bco_0_entry);
522 RET_BCO_ENTRY_TEMPLATE(ret_bco_1_entry);
523 RET_BCO_ENTRY_TEMPLATE(ret_bco_2_entry);
524 RET_BCO_ENTRY_TEMPLATE(ret_bco_3_entry);
525 RET_BCO_ENTRY_TEMPLATE(ret_bco_4_entry);
526 RET_BCO_ENTRY_TEMPLATE(ret_bco_5_entry);
527 RET_BCO_ENTRY_TEMPLATE(ret_bco_6_entry);
528 RET_BCO_ENTRY_TEMPLATE(ret_bco_7_entry);
530 VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
532 #endif /* INTERPRETER */
536 INFO_TABLE_CONSTR(Czh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,,EF_,0,0);
537 INFO_TABLE_CONSTR(Izh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,,EF_,0,0);
538 INFO_TABLE_CONSTR(I64zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,,EF_,0,0);
539 INFO_TABLE_CONSTR(Fzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,,EF_,0,0);
540 INFO_TABLE_CONSTR(Dzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,,EF_,0,0);
541 INFO_TABLE_CONSTR(Azh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,,EF_,0,0);
542 INFO_TABLE_CONSTR(Wzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,,EF_,0,0);
543 INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,,EF_,0,0);
545 /* These might seem redundant but {I,C}zh_static_info are used in
546 * {INT,CHAR}LIKE and the rest are used in RtsAPI.c
548 INFO_TABLE_CONSTR(Czh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
549 INFO_TABLE_CONSTR(Izh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
550 INFO_TABLE_CONSTR(I64zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
551 INFO_TABLE_CONSTR(Fzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
552 INFO_TABLE_CONSTR(Dzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
553 INFO_TABLE_CONSTR(Azh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
554 INFO_TABLE_CONSTR(Wzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
555 INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
557 #endif /* !defined(COMPILER) */
559 /* -----------------------------------------------------------------------------
560 CHARLIKE and INTLIKE closures.
562 These are static representations of Chars and small Ints, so that
563 we can remove dynamic Chars and Ints during garbage collection and
564 replace them with references to the static objects.
565 -------------------------------------------------------------------------- */
567 #ifdef ENABLE_WIN32_DLL_SUPPORT
569 * When sticking the RTS in a DLL, we delay populating the
570 * Charlike and Intlike tables until load-time, which is only
571 * when we've got the real addresses to the C# and I# closures.
574 static INFO_TBL_CONST StgInfoTable czh_static_info;
575 static INFO_TBL_CONST StgInfoTable izh_static_info;
576 #define Char_hash_static_info czh_static_info
577 #define Int_hash_static_info izh_static_info
579 #define Char_hash_static_info Czh_static_info
580 #define Int_hash_static_info Izh_static_info
583 #define CHARLIKE_HDR(n) \
585 STATIC_HDR(Char_hash_static_info, /* C# */ \
590 #define INTLIKE_HDR(n) \
592 STATIC_HDR(Int_hash_static_info, /* I# */ \
597 /* put these in the *data* section, since the garbage collector relies
598 * on the fact that static closures live in the data section.
601 /* end the name with _closure, to convince the mangler this is a closure */
603 StgIntCharlikeClosure CHARLIKE_closure[] = {
862 StgIntCharlikeClosure INTLIKE_closure[] = {
863 INTLIKE_HDR(-16), /* MIN_INTLIKE == -16 */
895 INTLIKE_HDR(16) /* MAX_INTLIKE == 16 */