1 /* -----------------------------------------------------------------------------
2 * $Id: StgMiscClosures.hc,v 1.27 1999/08/25 16:11:51 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) 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->why_blocked = BlockedOnBlackHole;
194 CurrentTSO->block_info.closure = R1.cl;
195 recordMutable((StgMutClosure *)R1.cl);
197 /* stg_gen_block is too heavyweight, use a specialised one */
202 INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,0,0);
203 STGFUN(BLACKHOLE_BQ_entry)
208 /* Put ourselves on the blocking queue for this black hole */
209 CurrentTSO->why_blocked = BlockedOnBlackHole;
210 CurrentTSO->block_info.closure = R1.cl;
211 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
212 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
214 /* stg_gen_block is too heavyweight, use a specialised one */
219 /* identical to BLACKHOLEs except for the infotag */
220 INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,0,0);
221 STGFUN(CAF_BLACKHOLE_entry)
224 JMP_(BLACKHOLE_entry);
229 INFO_TABLE(SE_BLACKHOLE_info, SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,0,0);
230 STGFUN(SE_BLACKHOLE_entry)
233 STGCALL3(fprintf,stderr,"SE_BLACKHOLE at %p entered!\n",R1.p);
234 STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
238 INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,EF_,0,0);
239 STGFUN(SE_CAF_BLACKHOLE_entry)
242 STGCALL3(fprintf,stderr,"SE_CAF_BLACKHOLE at %p entered!\n",R1.p);
243 STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
248 /* -----------------------------------------------------------------------------
249 The code for a BCO returns to the scheduler
250 -------------------------------------------------------------------------- */
251 INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,,EF_,0,0);
256 JMP_(stg_yield_to_Hugs);
260 /* -----------------------------------------------------------------------------
261 Some static info tables for things that don't get entered, and
262 therefore don't need entry code (i.e. boxed but unpointed objects)
263 -------------------------------------------------------------------------- */
265 #define NON_ENTERABLE_ENTRY_CODE(type) \
266 STGFUN(type##_entry) \
269 DUMP_ERRMSG(#type " object entered!\n"); \
270 STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \
274 INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,,EF_,0,0);
275 NON_ENTERABLE_ENTRY_CODE(TSO);
277 /* -----------------------------------------------------------------------------
278 Evacuees are left behind by the garbage collector. Any attempt to enter
280 -------------------------------------------------------------------------- */
282 INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,,EF_,0,0);
283 NON_ENTERABLE_ENTRY_CODE(EVACUATED);
285 /* -----------------------------------------------------------------------------
288 Live weak pointers have a special closure type. Dead ones are just
289 nullary constructors (although they live on the heap - we overwrite
290 live weak pointers with dead ones).
291 -------------------------------------------------------------------------- */
293 INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,,EF_,0,0);
294 NON_ENTERABLE_ENTRY_CODE(WEAK);
296 INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,0,0);
297 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
299 /* -----------------------------------------------------------------------------
302 This is a static nullary constructor (like []) that we use to mark an empty
303 finalizer in a weak pointer object.
304 -------------------------------------------------------------------------- */
306 INFO_TABLE_CONSTR(NO_FINALIZER_info,NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
307 NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
309 SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_)
312 /* -----------------------------------------------------------------------------
313 Foreign Objects are unlifted and therefore never entered.
314 -------------------------------------------------------------------------- */
316 INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,,EF_,0,0);
317 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
319 /* -----------------------------------------------------------------------------
320 Stable Names are unlifted too.
321 -------------------------------------------------------------------------- */
323 INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,0,0);
324 NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
326 /* -----------------------------------------------------------------------------
329 There are two kinds of these: full and empty. We need an info table
330 and entry code for each type.
331 -------------------------------------------------------------------------- */
333 INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,,EF_,0,0);
334 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
336 INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,,EF_,0,0);
337 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
339 /* -----------------------------------------------------------------------------
342 This is a static nullary constructor (like []) that we use to mark the
343 end of a linked TSO queue.
344 -------------------------------------------------------------------------- */
346 INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
347 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
349 SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
352 /* -----------------------------------------------------------------------------
355 Mutable lists (used by the garbage collector) consist of a chain of
356 StgMutClosures connected through their mut_link fields, ending in
357 an END_MUT_LIST closure.
358 -------------------------------------------------------------------------- */
360 INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
361 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
363 SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
366 INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
367 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
369 /* -----------------------------------------------------------------------------
372 These come in two basic flavours: arrays of data (StgArrWords) and arrays of
373 pointers (StgArrPtrs). They all have a similar layout:
375 ___________________________
376 | Info | No. of | data....
378 ---------------------------
380 These are *unpointed* objects: i.e. they cannot be entered.
382 -------------------------------------------------------------------------- */
384 #define ArrayInfo(type) \
385 INFO_TABLE(type##_info, type##_entry, 0, 0, type, , EF_,0,0);
387 ArrayInfo(ARR_WORDS);
388 NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
389 ArrayInfo(MUT_ARR_PTRS);
390 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS);
391 ArrayInfo(MUT_ARR_PTRS_FROZEN);
392 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
396 /* -----------------------------------------------------------------------------
398 -------------------------------------------------------------------------- */
400 INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
401 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
403 /* -----------------------------------------------------------------------------
404 Standard Error Entry.
406 This is used for filling in vector-table entries that can never happen,
408 -------------------------------------------------------------------------- */
410 STGFUN(stg_error_entry) \
413 DUMP_ERRMSG("fatal: stg_error_entry"); \
414 STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \
418 /* -----------------------------------------------------------------------------
421 Entering this closure will just return to the address on the top of the
422 stack. Useful for getting a thread in a canonical form where we can
423 just enter the top stack word to start the thread. (see deleteThread)
424 * -------------------------------------------------------------------------- */
426 INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, , EF_, 0, 0);
433 JMP_(ENTRY_CODE(ret_addr));
436 SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_)
439 /* -----------------------------------------------------------------------------
440 Strict IO application - performing an IO action and entering its result.
442 rts_evalIO() lets you perform Haskell IO actions from outside of Haskell-land,
443 returning back to you their result. Want this result to be evaluated to WHNF
444 by that time, so that we can easily get at the int/char/whatever using the
445 various get{Ty} functions provided by the RTS API.
447 forceIO takes care of this, performing the IO action and entering the
448 results that comes back.
450 * -------------------------------------------------------------------------- */
452 INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
453 FN_(forceIO_ret_entry)
457 Sp -= sizeofW(StgSeqFrame);
459 JMP_(GET_ENTRY(R1.cl));
463 INFO_TABLE(forceIO_info,forceIO_entry,1,0,FUN,,EF_,0,0);
467 /* Sp[0] contains the IO action we want to perform */
469 /* Replace it with the return continuation that enters the result. */
470 Sp[0] = (W_)&forceIO_ret_info;
472 /* Push the RealWorld# tag and enter */
473 Sp[0] =(W_)REALWORLD_TAG;
474 JMP_(GET_ENTRY(R1.cl));
477 SET_STATIC_HDR(forceIO_closure,forceIO_info,CCS_DONTZuCARE,,EI_)
481 /* -----------------------------------------------------------------------------
482 Standard Infotables (for use in interpreter)
483 -------------------------------------------------------------------------- */
487 STGFUN(Hugs_CONSTR_entry)
489 /* R1 points at the constructor */
490 JMP_(ENTRY_CODE(((StgPtr*)Sp)[0]));
493 #define RET_BCO_ENTRY_TEMPLATE(label) \
498 ((StgPtr*)Sp)[0] = R1.p; \
499 JMP_(stg_yield_to_Hugs); \
503 RET_BCO_ENTRY_TEMPLATE(ret_bco_entry );
504 RET_BCO_ENTRY_TEMPLATE(ret_bco_0_entry);
505 RET_BCO_ENTRY_TEMPLATE(ret_bco_1_entry);
506 RET_BCO_ENTRY_TEMPLATE(ret_bco_2_entry);
507 RET_BCO_ENTRY_TEMPLATE(ret_bco_3_entry);
508 RET_BCO_ENTRY_TEMPLATE(ret_bco_4_entry);
509 RET_BCO_ENTRY_TEMPLATE(ret_bco_5_entry);
510 RET_BCO_ENTRY_TEMPLATE(ret_bco_6_entry);
511 RET_BCO_ENTRY_TEMPLATE(ret_bco_7_entry);
513 VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
515 #endif /* INTERPRETER */
519 INFO_TABLE_CONSTR(Czh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,,EF_,0,0);
520 INFO_TABLE_CONSTR(Izh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,,EF_,0,0);
521 INFO_TABLE_CONSTR(I64zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,,EF_,0,0);
522 INFO_TABLE_CONSTR(Fzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,,EF_,0,0);
523 INFO_TABLE_CONSTR(Dzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,,EF_,0,0);
524 INFO_TABLE_CONSTR(Azh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,,EF_,0,0);
525 INFO_TABLE_CONSTR(Wzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,,EF_,0,0);
526 INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,,EF_,0,0);
528 /* These might seem redundant but {I,C}zh_static_info are used in
529 * {INT,CHAR}LIKE and the rest are used in RtsAPI.c
531 INFO_TABLE_CONSTR(Czh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
532 INFO_TABLE_CONSTR(Izh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
533 INFO_TABLE_CONSTR(I64zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
534 INFO_TABLE_CONSTR(Fzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
535 INFO_TABLE_CONSTR(Dzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
536 INFO_TABLE_CONSTR(Azh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
537 INFO_TABLE_CONSTR(Wzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
538 INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
540 #endif /* !defined(COMPILER) */
542 /* -----------------------------------------------------------------------------
543 CHARLIKE and INTLIKE closures.
545 These are static representations of Chars and small Ints, so that
546 we can remove dynamic Chars and Ints during garbage collection and
547 replace them with references to the static objects.
548 -------------------------------------------------------------------------- */
550 #ifdef ENABLE_WIN32_DLL_SUPPORT
552 * When sticking the RTS in a DLL, we delay populating the
553 * Charlike and Intlike tables until load-time, which is only
554 * when we've got the real addresses to the C# and I# closures.
557 static INFO_TBL_CONST StgInfoTable czh_static_info;
558 static INFO_TBL_CONST StgInfoTable izh_static_info;
559 #define Char_hash_static_info czh_static_info
560 #define Int_hash_static_info izh_static_info
562 #define Char_hash_static_info Czh_static_info
563 #define Int_hash_static_info Izh_static_info
566 #define CHARLIKE_HDR(n) \
568 STATIC_HDR(Char_hash_static_info, /* C# */ \
573 #define INTLIKE_HDR(n) \
575 STATIC_HDR(Int_hash_static_info, /* I# */ \
580 /* put these in the *data* section, since the garbage collector relies
581 * on the fact that static closures live in the data section.
584 /* end the name with _closure, to convince the mangler this is a closure */
586 StgIntCharlikeClosure CHARLIKE_closure[] = {
845 StgIntCharlikeClosure INTLIKE_closure[] = {
846 INTLIKE_HDR(-16), /* MIN_INTLIKE == -16 */
878 INTLIKE_HDR(16) /* MAX_INTLIKE == 16 */