1 /* -----------------------------------------------------------------------------
2 * $Id: StgMiscClosures.hc,v 1.22 1999/05/11 16:47:58 keithw 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 profiling */
60 #if defined(TICKY_TICKY) && !defined(PROFILING)
61 /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */
62 TICK_ENT_PERM_IND(R1.p); /* tick */
65 /* Enter PAP cost centre -- lexical scoping only */
66 ENTER_CCS_PAP_CL(R1.cl);
68 /* For ticky-ticky, change the perm_ind to a normal ind on first
69 * entry, so the number of ent_perm_inds is the number of *thunks*
70 * entered again, not the number of subsequent entries.
72 * Since this screws up cost centres, we die if profiling and
73 * ticky_ticky are on at the same time. KSW 1999-01.
78 # error Profiling and ticky-ticky do not mix at present!
79 # endif /* PROFILING */
80 SET_INFO((StgInd*)R1.p,&IND_info);
81 #endif /* TICKY_TICKY */
83 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
85 /* Dont: TICK_ENT_VIA_NODE(); for ticky-ticky; as above */
87 #if defined(TICKY_TICKY) && !defined(PROFILING)
95 INFO_TABLE(IND_OLDGEN_info,IND_OLDGEN_entry,1,1,IND_OLDGEN,const,EF_,0,0);
96 STGFUN(IND_OLDGEN_entry)
99 TICK_ENT_IND(Node); /* tick */
101 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
107 INFO_TABLE(IND_OLDGEN_PERM_info,IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,const,EF_,0,0);
108 STGFUN(IND_OLDGEN_PERM_entry)
111 /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
113 #if defined(TICKY_TICKY) && !defined(PROFILING)
114 /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */
115 TICK_ENT_PERM_IND(R1.p); /* tick */
118 /* Enter PAP cost centre -- lexical scoping only */
119 ENTER_CCS_PAP_CL(R1.cl);
121 /* see comment in IND_PERM */
124 # error Profiling and ticky-ticky do not mix at present!
125 # endif /* PROFILING */
126 SET_INFO((StgInd*)R1.p,&IND_OLDGEN_info);
127 #endif /* TICKY_TICKY */
129 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
135 /* -----------------------------------------------------------------------------
138 This code assumes R1 is in a register for now.
139 -------------------------------------------------------------------------- */
141 INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,3,CAF_UNENTERED,const,EF_,0,0);
142 STGFUN(CAF_UNENTERED_entry)
145 /* ToDo: implement directly in GHC */
148 JMP_(stg_yield_to_Hugs);
152 /* 0,4 is entirely bogus; _do not_ rely on this info */
153 INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,0,4,CAF_ENTERED,const,EF_,0,0);
154 STGFUN(CAF_ENTERED_entry)
157 R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */
159 JMP_(GET_ENTRY(R1.cl));
163 /* -----------------------------------------------------------------------------
164 Entry code for a black hole.
166 Entering a black hole normally causes a cyclic data dependency, but
167 in the concurrent world, black holes are synchronization points,
168 and they are turned into blocking queues when there are threads
169 waiting for the evaluation of the closure to finish.
170 -------------------------------------------------------------------------- */
172 /* Note: a black hole must be big enough to be overwritten with an
173 * indirection/evacuee/catch. Thus we claim it has 1 non-pointer word of
174 * payload (in addition to the pointer word for the blocking queue), which
175 * should be big enough for an old-generation indirection.
178 INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,const,EF_,0,0);
179 STGFUN(BLACKHOLE_entry)
184 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
185 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
186 /* Put ourselves on the blocking queue for this black hole */
187 CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
188 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
189 CurrentTSO->blocked_on = R1.cl;
190 recordMutable((StgMutClosure *)R1.cl);
192 /* stg_gen_block is too heavyweight, use a specialised one */
197 INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,const,EF_,0,0);
198 STGFUN(BLACKHOLE_BQ_entry)
203 /* Put ourselves on the blocking queue for this black hole */
204 CurrentTSO->blocked_on = R1.cl;
205 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
206 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
208 /* stg_gen_block is too heavyweight, use a specialised one */
213 /* identical to BLACKHOLEs except for the infotag */
214 INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,const,EF_,0,0);
215 STGFUN(CAF_BLACKHOLE_entry)
220 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
221 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
222 /* Put ourselves on the blocking queue for this black hole */
223 CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
224 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
225 CurrentTSO->blocked_on = R1.cl;
226 recordMutable((StgMutClosure *)R1.cl);
228 /* stg_gen_block is too heavyweight, use a specialised one */
234 INFO_TABLE(SE_BLACKHOLE_info, SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,const,EF_,0,0);
235 STGFUN(SE_BLACKHOLE_entry)
238 STGCALL1(fflush,stdout);
239 STGCALL3(fprintf,stderr,"SE_BLACKHOLE at %p entered!\n",R1.p);
240 STGCALL1(raiseError, errorHandler);
241 stg_exit(EXIT_FAILURE); /* not executed */
245 INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,const,EF_,0,0);
246 STGFUN(SE_CAF_BLACKHOLE_entry)
249 STGCALL1(fflush,stdout);
250 STGCALL3(fprintf,stderr,"SE_CAF_BLACKHOLE at %p entered!\n",R1.p);
251 STGCALL1(raiseError, errorHandler);
252 stg_exit(EXIT_FAILURE); /* not executed */
257 /* -----------------------------------------------------------------------------
258 The code for a BCO returns to the scheduler
259 -------------------------------------------------------------------------- */
260 INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,const,EF_,0,0);
265 JMP_(stg_yield_to_Hugs);
269 /* -----------------------------------------------------------------------------
270 Some static info tables for things that don't get entered, and
271 therefore don't need entry code (i.e. boxed but unpointed objects)
272 -------------------------------------------------------------------------- */
274 #define NON_ENTERABLE_ENTRY_CODE(type) \
275 STGFUN(type##_entry) \
278 STGCALL1(fflush,stdout); \
279 STGCALL2(fprintf,stderr,#type " object entered!\n"); \
280 STGCALL1(raiseError, errorHandler); \
281 stg_exit(EXIT_FAILURE); /* not executed */ \
285 INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,const,EF_,0,0);
286 NON_ENTERABLE_ENTRY_CODE(TSO);
288 /* -----------------------------------------------------------------------------
289 Evacuees are left behind by the garbage collector. Any attempt to enter
291 -------------------------------------------------------------------------- */
293 INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,const,EF_,0,0);
294 NON_ENTERABLE_ENTRY_CODE(EVACUATED);
296 /* -----------------------------------------------------------------------------
299 Live weak pointers have a special closure type. Dead ones are just
300 nullary constructors (although they live on the heap - we overwrite
301 live weak pointers with dead ones).
302 -------------------------------------------------------------------------- */
304 INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,const,EF_,0,0);
305 NON_ENTERABLE_ENTRY_CODE(WEAK);
307 INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,const,EF_,0,0);
308 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
310 /* -----------------------------------------------------------------------------
313 This is a static nullary constructor (like []) that we use to mark an empty
314 finalizer in a weak pointer object.
315 -------------------------------------------------------------------------- */
317 INFO_TABLE_CONSTR(NO_FINALIZER_info,NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
318 NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
320 SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_)
323 /* -----------------------------------------------------------------------------
324 Foreign Objects are unlifted and therefore never entered.
325 -------------------------------------------------------------------------- */
327 INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,const,EF_,0,0);
328 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
330 /* -----------------------------------------------------------------------------
331 Stable Names are unlifted too.
332 -------------------------------------------------------------------------- */
334 INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,const,EF_,0,0);
335 NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
337 /* -----------------------------------------------------------------------------
340 There are two kinds of these: full and empty. We need an info table
341 and entry code for each type.
342 -------------------------------------------------------------------------- */
344 INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,const,EF_,0,0);
345 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
347 INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,const,EF_,0,0);
348 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
350 /* -----------------------------------------------------------------------------
353 This is a static nullary constructor (like []) that we use to mark the
354 end of a linked TSO queue.
355 -------------------------------------------------------------------------- */
357 INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
358 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
360 SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
363 /* -----------------------------------------------------------------------------
366 Mutable lists (used by the garbage collector) consist of a chain of
367 StgMutClosures connected through their mut_link fields, ending in
368 an END_MUT_LIST closure.
369 -------------------------------------------------------------------------- */
371 INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
372 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
374 SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
377 INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, const, EF_, 0, 0);
378 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
380 /* -----------------------------------------------------------------------------
383 These come in two basic flavours: arrays of data (StgArrWords) and arrays of
384 pointers (StgArrPtrs). They all have a similar layout:
386 ___________________________
387 | Info | No. of | data....
389 ---------------------------
391 These are *unpointed* objects: i.e. they cannot be entered.
393 -------------------------------------------------------------------------- */
395 #define ArrayInfo(type) \
396 INFO_TABLE(type##_info, type##_entry, 0, 0, type, const, EF_,0,0);
398 ArrayInfo(ARR_WORDS);
399 NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
400 ArrayInfo(MUT_ARR_PTRS);
401 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS);
402 ArrayInfo(MUT_ARR_PTRS_FROZEN);
403 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
407 /* -----------------------------------------------------------------------------
409 -------------------------------------------------------------------------- */
411 INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, const, EF_, 0, 0);
412 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
414 /* -----------------------------------------------------------------------------
415 Standard Error Entry.
417 This is used for filling in vector-table entries that can never happen,
419 -------------------------------------------------------------------------- */
421 STGFUN(stg_error_entry) \
424 STGCALL1(fflush,stdout); \
425 STGCALL2(fprintf,stderr,"fatal: stg_error_entry"); \
426 STGCALL1(raiseError, errorHandler); \
427 exit(EXIT_FAILURE); /* not executed */ \
431 /* -----------------------------------------------------------------------------
434 Entering this closure will just return to the address on the top of the
435 stack. Useful for getting a thread in a canonical form where we can
436 just enter the top stack word to start the thread. (see deleteThread)
437 * -------------------------------------------------------------------------- */
439 INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, const, EF_, 0, 0);
446 JMP_(ENTRY_CODE(ret_addr));
449 SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_)
452 /* -----------------------------------------------------------------------------
453 Standard Infotables (for use in interpreter)
454 -------------------------------------------------------------------------- */
458 STGFUN(Hugs_CONSTR_entry)
461 ((StgPtr*)Sp)[0] = R1.p;
462 /* vectored: JMP_(RET_VEC(((StgPtr*)Sp)[1],constrTag(?))); */
463 JMP_(ENTRY_CODE(((StgPtr*)Sp)[1]));
466 #define RET_BCO_ENTRY_TEMPLATE(label) \
471 ((StgPtr*)Sp)[0] = R1.p; \
472 JMP_(stg_yield_to_Hugs); \
476 RET_BCO_ENTRY_TEMPLATE(ret_bco_entry );
477 RET_BCO_ENTRY_TEMPLATE(ret_bco_0_entry);
478 RET_BCO_ENTRY_TEMPLATE(ret_bco_1_entry);
479 RET_BCO_ENTRY_TEMPLATE(ret_bco_2_entry);
480 RET_BCO_ENTRY_TEMPLATE(ret_bco_3_entry);
481 RET_BCO_ENTRY_TEMPLATE(ret_bco_4_entry);
482 RET_BCO_ENTRY_TEMPLATE(ret_bco_5_entry);
483 RET_BCO_ENTRY_TEMPLATE(ret_bco_6_entry);
484 RET_BCO_ENTRY_TEMPLATE(ret_bco_7_entry);
486 VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO);
488 #endif /* INTERPRETER */
492 INFO_TABLE_CONSTR(Czh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,const,EF_,0,0);
493 INFO_TABLE_CONSTR(Izh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,const,EF_,0,0);
494 INFO_TABLE_CONSTR(I64zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,const,EF_,0,0);
495 INFO_TABLE_CONSTR(Fzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,const,EF_,0,0);
496 INFO_TABLE_CONSTR(Dzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,const,EF_,0,0);
497 INFO_TABLE_CONSTR(Azh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,const,EF_,0,0);
498 INFO_TABLE_CONSTR(Wzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,const,EF_,0,0);
499 INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,const,EF_,0,0);
501 /* These might seem redundant but {I,C}zh_static_info are used in
502 * {INT,CHAR}LIKE and the rest are used in RtsAPI.c
504 INFO_TABLE_CONSTR(Czh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
505 INFO_TABLE_CONSTR(Izh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
506 INFO_TABLE_CONSTR(I64zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
507 INFO_TABLE_CONSTR(Fzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
508 INFO_TABLE_CONSTR(Dzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
509 INFO_TABLE_CONSTR(Azh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
510 INFO_TABLE_CONSTR(Wzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
511 INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
513 #endif /* !defined(COMPILER) */
515 /* -----------------------------------------------------------------------------
516 CHARLIKE and INTLIKE closures.
518 These are static representations of Chars and small Ints, so that
519 we can remove dynamic Chars and Ints during garbage collection and
520 replace them with references to the static objects.
521 -------------------------------------------------------------------------- */
523 #ifdef ENABLE_WIN32_DLL_SUPPORT
525 * When sticking the RTS in a DLL, we delay populating the
526 * Charlike and Intlike tables until load-time, which is only
527 * when we've got the real addresses to the C# and I# closures.
530 static const StgInfoTable czh_static_info;
531 static const StgInfoTable izh_static_info;
532 #define Char_hash_static_info czh_static_info
533 #define Int_hash_static_info izh_static_info
535 #define Char_hash_static_info Czh_static_info
536 #define Int_hash_static_info Izh_static_info
539 #define CHARLIKE_HDR(n) \
541 STATIC_HDR(Char_hash_static_info, /* C# */ \
546 #define INTLIKE_HDR(n) \
548 STATIC_HDR(Int_hash_static_info, /* I# */ \
553 /* put these in the *data* section, since the garbage collector relies
554 * on the fact that static closures live in the data section.
557 /* end the name with _closure, to convince the mangler this is a closure */
559 StgIntCharlikeClosure CHARLIKE_closure[] = {
818 StgIntCharlikeClosure INTLIKE_closure[] = {
819 INTLIKE_HDR(-16), /* MIN_INTLIKE == -16 */
851 INTLIKE_HDR(16) /* MAX_INTLIKE == 16 */