1 /* -----------------------------------------------------------------------------
2 * $Id: StgMiscClosures.hc,v 1.21 1999/05/04 10:19:19 sof 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 /* -----------------------------------------------------------------------------
23 Entry code for an indirection.
25 This code assumes R1 is in a register for now.
26 -------------------------------------------------------------------------- */
28 INFO_TABLE(IND_info,IND_entry,1,0,IND,const,EF_,0,0);
32 TICK_ENT_IND(Node); /* tick */
34 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
40 INFO_TABLE(IND_STATIC_info,IND_STATIC_entry,1,0,IND_STATIC,const,EF_,0,0);
41 STGFUN(IND_STATIC_entry)
44 TICK_ENT_IND(Node); /* tick */
46 R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
52 INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,const,EF_,0,0);
53 STGFUN(IND_PERM_entry)
56 /* Don't add INDs to granularity cost */
58 /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profi
61 /* Enter PAP cost centre -- lexical scoping only */
62 ENTER_CCS_PAP_CL(R1.cl);
64 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
66 /* Dont: TICK_ENT_VIA_NODE(); for ticky-ticky; as above */
72 INFO_TABLE(IND_OLDGEN_info,IND_OLDGEN_entry,1,1,IND_OLDGEN,const,EF_,0,0);
73 STGFUN(IND_OLDGEN_entry)
76 TICK_ENT_IND(Node); /* tick */
78 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
84 INFO_TABLE(IND_OLDGEN_PERM_info,IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,const,EF_,0,0);
85 STGFUN(IND_OLDGEN_PERM_entry)
88 TICK_ENT_IND(Node); /* tick */
90 /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profi
93 /* Enter PAP cost centre -- lexical scoping only */
94 ENTER_CCS_PAP_CL(R1.cl);
96 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
102 /* -----------------------------------------------------------------------------
105 This code assumes R1 is in a register for now.
106 -------------------------------------------------------------------------- */
108 INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,3,CAF_UNENTERED,const,EF_,0,0);
109 STGFUN(CAF_UNENTERED_entry)
112 /* ToDo: implement directly in GHC */
115 JMP_(stg_yield_to_Hugs);
119 /* 0,4 is entirely bogus; _do not_ rely on this info */
120 INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,0,4,CAF_ENTERED,const,EF_,0,0);
121 STGFUN(CAF_ENTERED_entry)
124 R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */
126 JMP_(GET_ENTRY(R1.cl));
130 /* -----------------------------------------------------------------------------
131 Entry code for a black hole.
133 Entering a black hole normally causes a cyclic data dependency, but
134 in the concurrent world, black holes are synchronization points,
135 and they are turned into blocking queues when there are threads
136 waiting for the evaluation of the closure to finish.
137 -------------------------------------------------------------------------- */
139 /* Note: a black hole must be big enough to be overwritten with an
140 * indirection/evacuee/catch. Thus we claim it has 1 non-pointer word of
141 * payload (in addition to the pointer word for the blocking queue), which
142 * should be big enough for an old-generation indirection.
145 INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,const,EF_,0,0);
146 STGFUN(BLACKHOLE_entry)
151 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
152 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
153 /* Put ourselves on the blocking queue for this black hole */
154 CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
155 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
156 CurrentTSO->blocked_on = R1.cl;
157 recordMutable((StgMutClosure *)R1.cl);
159 /* stg_gen_block is too heavyweight, use a specialised one */
164 INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,const,EF_,0,0);
165 STGFUN(BLACKHOLE_BQ_entry)
170 /* Put ourselves on the blocking queue for this black hole */
171 CurrentTSO->blocked_on = R1.cl;
172 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
173 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
175 /* stg_gen_block is too heavyweight, use a specialised one */
180 /* identical to BLACKHOLEs except for the infotag */
181 INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,const,EF_,0,0);
182 STGFUN(CAF_BLACKHOLE_entry)
187 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
188 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
189 /* Put ourselves on the blocking queue for this black hole */
190 CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
191 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
192 CurrentTSO->blocked_on = R1.cl;
193 recordMutable((StgMutClosure *)R1.cl);
195 /* stg_gen_block is too heavyweight, use a specialised one */
200 /* -----------------------------------------------------------------------------
201 The code for a BCO returns to the scheduler
202 -------------------------------------------------------------------------- */
203 INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,const,EF_,0,0);
208 JMP_(stg_yield_to_Hugs);
212 /* -----------------------------------------------------------------------------
213 Some static info tables for things that don't get entered, and
214 therefore don't need entry code (i.e. boxed but unpointed objects)
215 -------------------------------------------------------------------------- */
217 #define NON_ENTERABLE_ENTRY_CODE(type) \
218 STGFUN(type##_entry) \
221 STGCALL1(fflush,stdout); \
222 STGCALL2(fprintf,stderr,#type " object entered!\n"); \
223 STGCALL1(raiseError, errorHandler); \
224 stg_exit(EXIT_FAILURE); /* not executed */ \
228 INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,const,EF_,0,0);
229 NON_ENTERABLE_ENTRY_CODE(TSO);
231 /* -----------------------------------------------------------------------------
232 Evacuees are left behind by the garbage collector. Any attempt to enter
234 -------------------------------------------------------------------------- */
236 INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,const,EF_,0,0);
237 NON_ENTERABLE_ENTRY_CODE(EVACUATED);
239 /* -----------------------------------------------------------------------------
242 Live weak pointers have a special closure type. Dead ones are just
243 nullary constructors (although they live on the heap - we overwrite
244 live weak pointers with dead ones).
245 -------------------------------------------------------------------------- */
247 INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,const,EF_,0,0);
248 NON_ENTERABLE_ENTRY_CODE(WEAK);
250 INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,const,EF_,0,0);
251 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
253 /* -----------------------------------------------------------------------------
256 This is a static nullary constructor (like []) that we use to mark an empty
257 finalizer in a weak pointer object.
258 -------------------------------------------------------------------------- */
260 INFO_TABLE_CONSTR(NO_FINALIZER_info,NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
261 NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
263 SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_)
266 /* -----------------------------------------------------------------------------
267 Foreign Objects are unlifted and therefore never entered.
268 -------------------------------------------------------------------------- */
270 INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,const,EF_,0,0);
271 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
273 /* -----------------------------------------------------------------------------
274 Stable Names are unlifted too.
275 -------------------------------------------------------------------------- */
277 INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,const,EF_,0,0);
278 NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
280 /* -----------------------------------------------------------------------------
283 There are two kinds of these: full and empty. We need an info table
284 and entry code for each type.
285 -------------------------------------------------------------------------- */
287 INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,const,EF_,0,0);
288 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
290 INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,const,EF_,0,0);
291 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
293 /* -----------------------------------------------------------------------------
296 This is a static nullary constructor (like []) that we use to mark the
297 end of a linked TSO queue.
298 -------------------------------------------------------------------------- */
300 INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
301 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
303 SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
306 /* -----------------------------------------------------------------------------
309 Mutable lists (used by the garbage collector) consist of a chain of
310 StgMutClosures connected through their mut_link fields, ending in
311 an END_MUT_LIST closure.
312 -------------------------------------------------------------------------- */
314 INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
315 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
317 SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
320 INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, const, EF_, 0, 0);
321 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
323 /* -----------------------------------------------------------------------------
326 These come in two basic flavours: arrays of data (StgArrWords) and arrays of
327 pointers (StgArrPtrs). They all have a similar layout:
329 ___________________________
330 | Info | No. of | data....
332 ---------------------------
334 These are *unpointed* objects: i.e. they cannot be entered.
336 -------------------------------------------------------------------------- */
338 #define ArrayInfo(type) \
339 INFO_TABLE(type##_info, type##_entry, 0, 0, type, const, EF_,0,0);
341 ArrayInfo(ARR_WORDS);
342 NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
343 ArrayInfo(MUT_ARR_PTRS);
344 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS);
345 ArrayInfo(MUT_ARR_PTRS_FROZEN);
346 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
350 /* -----------------------------------------------------------------------------
352 -------------------------------------------------------------------------- */
354 INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, const, EF_, 0, 0);
355 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
357 /* -----------------------------------------------------------------------------
358 Standard Error Entry.
360 This is used for filling in vector-table entries that can never happen,
362 -------------------------------------------------------------------------- */
364 STGFUN(stg_error_entry) \
367 STGCALL1(fflush,stdout); \
368 STGCALL2(fprintf,stderr,"fatal: stg_error_entry"); \
369 STGCALL1(raiseError, errorHandler); \
370 exit(EXIT_FAILURE); /* not executed */ \
374 /* -----------------------------------------------------------------------------
377 Entering this closure will just return to the address on the top of the
378 stack. Useful for getting a thread in a canonical form where we can
379 just enter the top stack word to start the thread. (see deleteThread)
380 * -------------------------------------------------------------------------- */
382 INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, const, EF_, 0, 0);
389 JMP_(ENTRY_CODE(ret_addr));
392 SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_)
395 /* -----------------------------------------------------------------------------
396 Standard Infotables (for use in interpreter)
397 -------------------------------------------------------------------------- */
401 STGFUN(Hugs_CONSTR_entry)
404 ((StgPtr*)Sp)[0] = R1.p;
405 /* vectored: JMP_(RET_VEC(((StgPtr*)Sp)[1],constrTag(?))); */
406 JMP_(ENTRY_CODE(((StgPtr*)Sp)[1]));
409 #define RET_BCO_ENTRY_TEMPLATE(label) \
414 ((StgPtr*)Sp)[0] = R1.p; \
415 JMP_(stg_yield_to_Hugs); \
419 RET_BCO_ENTRY_TEMPLATE(ret_bco_entry );
420 RET_BCO_ENTRY_TEMPLATE(ret_bco_0_entry);
421 RET_BCO_ENTRY_TEMPLATE(ret_bco_1_entry);
422 RET_BCO_ENTRY_TEMPLATE(ret_bco_2_entry);
423 RET_BCO_ENTRY_TEMPLATE(ret_bco_3_entry);
424 RET_BCO_ENTRY_TEMPLATE(ret_bco_4_entry);
425 RET_BCO_ENTRY_TEMPLATE(ret_bco_5_entry);
426 RET_BCO_ENTRY_TEMPLATE(ret_bco_6_entry);
427 RET_BCO_ENTRY_TEMPLATE(ret_bco_7_entry);
429 VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO);
431 #endif /* INTERPRETER */
435 INFO_TABLE_CONSTR(Czh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,const,EF_,0,0);
436 INFO_TABLE_CONSTR(Izh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,const,EF_,0,0);
437 INFO_TABLE_CONSTR(I64zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,const,EF_,0,0);
438 INFO_TABLE_CONSTR(Fzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,const,EF_,0,0);
439 INFO_TABLE_CONSTR(Dzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,const,EF_,0,0);
440 INFO_TABLE_CONSTR(Azh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,const,EF_,0,0);
441 INFO_TABLE_CONSTR(Wzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,const,EF_,0,0);
442 INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,const,EF_,0,0);
444 /* These might seem redundant but {I,C}zh_static_info are used in
445 * {INT,CHAR}LIKE and the rest are used in RtsAPI.c
447 INFO_TABLE_CONSTR(Czh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
448 INFO_TABLE_CONSTR(Izh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
449 INFO_TABLE_CONSTR(I64zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
450 INFO_TABLE_CONSTR(Fzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
451 INFO_TABLE_CONSTR(Dzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
452 INFO_TABLE_CONSTR(Azh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
453 INFO_TABLE_CONSTR(Wzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
454 INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
456 #endif /* !defined(COMPILER) */
458 /* -----------------------------------------------------------------------------
459 CHARLIKE and INTLIKE closures.
461 These are static representations of Chars and small Ints, so that
462 we can remove dynamic Chars and Ints during garbage collection and
463 replace them with references to the static objects.
464 -------------------------------------------------------------------------- */
466 #ifdef ENABLE_WIN32_DLL_SUPPORT
468 * When sticking the RTS in a DLL, we delay populating the
469 * Charlike and Intlike tables until load-time, which is only
470 * when we've got the real addresses to the C# and I# closures.
473 static const StgInfoTable czh_static_info;
474 static const StgInfoTable izh_static_info;
475 #define Char_hash_static_info czh_static_info
476 #define Int_hash_static_info izh_static_info
478 #define Char_hash_static_info Czh_static_info
479 #define Int_hash_static_info Izh_static_info
482 #define CHARLIKE_HDR(n) \
484 STATIC_HDR(Char_hash_static_info, /* C# */ \
489 #define INTLIKE_HDR(n) \
491 STATIC_HDR(Int_hash_static_info, /* I# */ \
496 /* put these in the *data* section, since the garbage collector relies
497 * on the fact that static closures live in the data section.
500 /* end the name with _closure, to convince the mangler this is a closure */
502 StgIntCharlikeClosure CHARLIKE_closure[] = {
761 StgIntCharlikeClosure INTLIKE_closure[] = {
762 INTLIKE_HDR(-16), /* MIN_INTLIKE == -16 */
794 INTLIKE_HDR(16) /* MAX_INTLIKE == 16 */