1 /* -----------------------------------------------------------------------------
2 * $Id: StgMiscClosures.hc,v 1.19 1999/03/18 17:57:23 simonm 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"
21 /* -----------------------------------------------------------------------------
22 Entry code for an indirection.
24 This code assumes R1 is in a register for now.
25 -------------------------------------------------------------------------- */
27 INFO_TABLE(IND_info,IND_entry,1,0,IND,const,EF_,0,0);
31 TICK_ENT_IND(Node); /* tick */
33 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
39 INFO_TABLE(IND_STATIC_info,IND_STATIC_entry,1,0,IND_STATIC,const,EF_,0,0);
40 STGFUN(IND_STATIC_entry)
43 TICK_ENT_IND(Node); /* tick */
45 R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
51 INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,const,EF_,0,0);
52 STGFUN(IND_PERM_entry)
55 /* Don't add INDs to granularity cost */
57 /* Dont: ENT_IND(Node); for ticky-ticky; this ind is here only to help profi
60 /* Enter PAP cost centre -- lexical scoping only */
61 ENTER_CCS_PAP_CL(R1.cl);
63 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
65 /* Dont: TICK_ENT_VIA_NODE(); for ticky-ticky; as above */
71 INFO_TABLE(IND_OLDGEN_info,IND_OLDGEN_entry,1,1,IND_OLDGEN,const,EF_,0,0);
72 STGFUN(IND_OLDGEN_entry)
75 TICK_ENT_IND(Node); /* tick */
77 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
83 INFO_TABLE(IND_OLDGEN_PERM_info,IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,const,EF_,0,0);
84 STGFUN(IND_OLDGEN_PERM_entry)
87 TICK_ENT_IND(Node); /* tick */
89 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
95 /* -----------------------------------------------------------------------------
98 This code assumes R1 is in a register for now.
99 -------------------------------------------------------------------------- */
101 INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,3,CAF_UNENTERED,const,EF_,0,0);
102 STGFUN(CAF_UNENTERED_entry)
105 /* ToDo: implement directly in GHC */
108 JMP_(stg_yield_to_Hugs);
112 /* 0,4 is entirely bogus; _do not_ rely on this info */
113 INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,0,4,CAF_ENTERED,const,EF_,0,0);
114 STGFUN(CAF_ENTERED_entry)
117 R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */
119 JMP_(GET_ENTRY(R1.cl));
123 /* -----------------------------------------------------------------------------
124 Entry code for a black hole.
126 Entering a black hole normally causes a cyclic data dependency, but
127 in the concurrent world, black holes are synchronization points,
128 and they are turned into blocking queues when there are threads
129 waiting for the evaluation of the closure to finish.
130 -------------------------------------------------------------------------- */
132 /* Note: a black hole must be big enough to be overwritten with an
133 * indirection/evacuee/catch. Thus we claim it has 1 non-pointer word of
134 * payload (in addition to the pointer word for the blocking queue), which
135 * should be big enough for an old-generation indirection.
138 INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,const,EF_,0,0);
139 STGFUN(BLACKHOLE_entry)
144 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
145 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
146 /* Put ourselves on the blocking queue for this black hole */
147 CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
148 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
149 CurrentTSO->blocked_on = R1.cl;
150 recordMutable((StgMutClosure *)R1.cl);
152 /* stg_gen_block is too heavyweight, use a specialised one */
157 INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,const,EF_,0,0);
158 STGFUN(BLACKHOLE_BQ_entry)
163 /* Put ourselves on the blocking queue for this black hole */
164 CurrentTSO->blocked_on = R1.cl;
165 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
166 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
168 /* stg_gen_block is too heavyweight, use a specialised one */
173 /* identical to BLACKHOLEs except for the infotag */
174 INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,const,EF_,0,0);
175 STGFUN(CAF_BLACKHOLE_entry)
180 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
181 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
182 /* Put ourselves on the blocking queue for this black hole */
183 CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
184 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
185 CurrentTSO->blocked_on = R1.cl;
186 recordMutable((StgMutClosure *)R1.cl);
188 /* stg_gen_block is too heavyweight, use a specialised one */
193 /* -----------------------------------------------------------------------------
194 The code for a BCO returns to the scheduler
195 -------------------------------------------------------------------------- */
196 INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,const,EF_,0,0);
201 JMP_(stg_yield_to_Hugs);
205 /* -----------------------------------------------------------------------------
206 Some static info tables for things that don't get entered, and
207 therefore don't need entry code (i.e. boxed but unpointed objects)
208 -------------------------------------------------------------------------- */
210 #define NON_ENTERABLE_ENTRY_CODE(type) \
211 STGFUN(type##_entry) \
214 STGCALL1(fflush,stdout); \
215 STGCALL2(fprintf,stderr,#type " object entered!\n"); \
216 STGCALL1(raiseError, errorHandler); \
217 stg_exit(EXIT_FAILURE); /* not executed */ \
221 INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,const,EF_,0,0);
222 NON_ENTERABLE_ENTRY_CODE(TSO);
224 /* -----------------------------------------------------------------------------
225 Evacuees are left behind by the garbage collector. Any attempt to enter
227 -------------------------------------------------------------------------- */
229 INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,const,EF_,0,0);
230 NON_ENTERABLE_ENTRY_CODE(EVACUATED);
232 /* -----------------------------------------------------------------------------
235 Live weak pointers have a special closure type. Dead ones are just
236 nullary constructors (although they live on the heap - we overwrite
237 live weak pointers with dead ones).
238 -------------------------------------------------------------------------- */
240 INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,const,EF_,0,0);
241 NON_ENTERABLE_ENTRY_CODE(WEAK);
243 INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,const,EF_,0,0);
244 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
246 /* -----------------------------------------------------------------------------
249 This is a static nullary constructor (like []) that we use to mark an empty
250 finalizer in a weak pointer object.
251 -------------------------------------------------------------------------- */
253 INFO_TABLE_CONSTR(NO_FINALIZER_info,NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
254 NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
256 SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_)
259 /* -----------------------------------------------------------------------------
260 Foreign Objects are unlifted and therefore never entered.
261 -------------------------------------------------------------------------- */
263 INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,const,EF_,0,0);
264 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
266 /* -----------------------------------------------------------------------------
267 Stable Names are unlifted too.
268 -------------------------------------------------------------------------- */
270 INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,const,EF_,0,0);
271 NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
273 /* -----------------------------------------------------------------------------
276 There are two kinds of these: full and empty. We need an info table
277 and entry code for each type.
278 -------------------------------------------------------------------------- */
280 INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,const,EF_,0,0);
281 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
283 INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,const,EF_,0,0);
284 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
286 /* -----------------------------------------------------------------------------
289 This is a static nullary constructor (like []) that we use to mark the
290 end of a linked TSO queue.
291 -------------------------------------------------------------------------- */
293 INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
294 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
296 SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
299 /* -----------------------------------------------------------------------------
302 Mutable lists (used by the garbage collector) consist of a chain of
303 StgMutClosures connected through their mut_link fields, ending in
304 an END_MUT_LIST closure.
305 -------------------------------------------------------------------------- */
307 INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
308 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
310 SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
313 INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, const, EF_, 0, 0);
314 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
316 /* -----------------------------------------------------------------------------
319 These come in two basic flavours: arrays of data (StgArrWords) and arrays of
320 pointers (StgArrPtrs). They all have a similar layout:
322 ___________________________
323 | Info | No. of | data....
325 ---------------------------
327 These are *unpointed* objects: i.e. they cannot be entered.
329 -------------------------------------------------------------------------- */
331 #define ArrayInfo(type) \
332 INFO_TABLE(type##_info, type##_entry, 0, 0, type, const, EF_,0,0);
334 ArrayInfo(ARR_WORDS);
335 NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
336 ArrayInfo(MUT_ARR_PTRS);
337 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS);
338 ArrayInfo(MUT_ARR_PTRS_FROZEN);
339 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
343 /* -----------------------------------------------------------------------------
345 -------------------------------------------------------------------------- */
347 INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, const, EF_, 0, 0);
348 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
350 /* -----------------------------------------------------------------------------
351 Standard Error Entry.
353 This is used for filling in vector-table entries that can never happen,
355 -------------------------------------------------------------------------- */
357 STGFUN(stg_error_entry) \
360 STGCALL1(fflush,stdout); \
361 STGCALL2(fprintf,stderr,"fatal: stg_error_entry"); \
362 STGCALL1(raiseError, errorHandler); \
363 exit(EXIT_FAILURE); /* not executed */ \
367 /* -----------------------------------------------------------------------------
370 Entering this closure will just return to the address on the top of the
371 stack. Useful for getting a thread in a canonical form where we can
372 just enter the top stack word to start the thread. (see deleteThread)
373 * -------------------------------------------------------------------------- */
375 INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, const, EF_, 0, 0);
382 JMP_(ENTRY_CODE(ret_addr));
385 SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_)
388 /* -----------------------------------------------------------------------------
389 Standard Infotables (for use in interpreter)
390 -------------------------------------------------------------------------- */
394 STGFUN(Hugs_CONSTR_entry)
397 ((StgPtr*)Sp)[0] = R1.p;
398 /* vectored: JMP_(RET_VEC(((StgPtr*)Sp)[1],constrTag(?))); */
399 JMP_(ENTRY_CODE(((StgPtr*)Sp)[1]));
402 #define RET_BCO_ENTRY_TEMPLATE(label) \
407 ((StgPtr*)Sp)[0] = R1.p; \
408 JMP_(stg_yield_to_Hugs); \
412 RET_BCO_ENTRY_TEMPLATE(ret_bco_entry );
413 RET_BCO_ENTRY_TEMPLATE(ret_bco_0_entry);
414 RET_BCO_ENTRY_TEMPLATE(ret_bco_1_entry);
415 RET_BCO_ENTRY_TEMPLATE(ret_bco_2_entry);
416 RET_BCO_ENTRY_TEMPLATE(ret_bco_3_entry);
417 RET_BCO_ENTRY_TEMPLATE(ret_bco_4_entry);
418 RET_BCO_ENTRY_TEMPLATE(ret_bco_5_entry);
419 RET_BCO_ENTRY_TEMPLATE(ret_bco_6_entry);
420 RET_BCO_ENTRY_TEMPLATE(ret_bco_7_entry);
422 VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO);
424 #endif /* INTERPRETER */
428 INFO_TABLE_CONSTR(Czh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,const,EF_,0,0);
429 INFO_TABLE_CONSTR(Izh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,const,EF_,0,0);
430 INFO_TABLE_CONSTR(I64zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,const,EF_,0,0);
431 INFO_TABLE_CONSTR(Fzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,const,EF_,0,0);
432 INFO_TABLE_CONSTR(Dzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,const,EF_,0,0);
433 INFO_TABLE_CONSTR(Azh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,const,EF_,0,0);
434 INFO_TABLE_CONSTR(Wzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,const,EF_,0,0);
435 INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,const,EF_,0,0);
437 /* These might seem redundant but {I,C}zh_static_info are used in
438 * {INT,CHAR}LIKE and the rest are used in RtsAPI.c
440 INFO_TABLE_CONSTR(Czh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
441 INFO_TABLE_CONSTR(Izh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
442 INFO_TABLE_CONSTR(I64zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
443 INFO_TABLE_CONSTR(Fzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
444 INFO_TABLE_CONSTR(Dzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
445 INFO_TABLE_CONSTR(Azh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
446 INFO_TABLE_CONSTR(Wzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
447 INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
449 #endif /* !defined(COMPILER) */
451 /* -----------------------------------------------------------------------------
452 CHARLIKE and INTLIKE closures.
454 These are static representations of Chars and small Ints, so that
455 we can remove dynamic Chars and Ints during garbage collection and
456 replace them with references to the static objects.
457 -------------------------------------------------------------------------- */
459 #ifdef HAVE_WIN32_DLL_SUPPORT
461 * When sticking the RTS in a DLL, we delay populating the
462 * Charlike and Intlike tables until load-time, which is only
463 * when we've got the real addresses to the C# and I# closures.
466 static const StgInfoTable czh_static_info;
467 static const StgInfoTable izh_static_info;
468 #define Char_hash_static_info czh_static_info
469 #define Int_hash_static_info izh_static_info
471 #define Char_hash_static_info Czh_static_info
472 #define Int_hash_static_info Izh_static_info
475 #define CHARLIKE_HDR(n) \
477 STATIC_HDR(Char_hash_static_info, /* C# */ \
482 #define INTLIKE_HDR(n) \
484 STATIC_HDR(Int_hash_static_info, /* I# */ \
489 /* put these in the *data* section, since the garbage collector relies
490 * on the fact that static closures live in the data section.
493 /* end the name with _closure, to convince the mangler this is a closure */
495 StgIntCharlikeClosure CHARLIKE_closure[] = {
754 StgIntCharlikeClosure INTLIKE_closure[] = {
755 INTLIKE_HDR(-16), /* MIN_INTLIKE == -16 */
787 INTLIKE_HDR(16) /* MAX_INTLIKE == 16 */