1 /* -----------------------------------------------------------------------------
2 * $Id: StgMiscClosures.hc,v 1.17 1999/03/15 16:30:29 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,0,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 recordMutable((StgMutClosure *)R1.cl);
151 /* stg_gen_block is too heavyweight, use a specialised one */
156 INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,const,EF_,0,0);
157 STGFUN(BLACKHOLE_BQ_entry)
162 /* Put ourselves on the blocking queue for this black hole */
163 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
164 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
166 /* stg_gen_block is too heavyweight, use a specialised one */
171 /* identical to BLACKHOLEs except for the infotag */
172 INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,const,EF_,0,0);
173 STGFUN(CAF_BLACKHOLE_entry)
178 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
179 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
180 /* Put ourselves on the blocking queue for this black hole */
181 CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
182 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
183 recordMutable((StgMutClosure *)R1.cl);
185 /* stg_gen_block is too heavyweight, use a specialised one */
190 /* -----------------------------------------------------------------------------
191 The code for a BCO returns to the scheduler
192 -------------------------------------------------------------------------- */
193 INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,const,EF_,0,0);
198 JMP_(stg_yield_to_Hugs);
202 /* -----------------------------------------------------------------------------
203 Some static info tables for things that don't get entered, and
204 therefore don't need entry code (i.e. boxed but unpointed objects)
205 -------------------------------------------------------------------------- */
207 #define NON_ENTERABLE_ENTRY_CODE(type) \
208 STGFUN(type##_entry) \
211 STGCALL1(fflush,stdout); \
212 STGCALL2(fprintf,stderr,#type " object entered!\n"); \
213 STGCALL1(raiseError, errorHandler); \
214 stg_exit(EXIT_FAILURE); /* not executed */ \
218 INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,const,EF_,0,0);
219 NON_ENTERABLE_ENTRY_CODE(TSO);
221 /* -----------------------------------------------------------------------------
222 Evacuees are left behind by the garbage collector. Any attempt to enter
224 -------------------------------------------------------------------------- */
226 INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,const,EF_,0,0);
227 NON_ENTERABLE_ENTRY_CODE(EVACUATED);
229 /* -----------------------------------------------------------------------------
232 Live weak pointers have a special closure type. Dead ones are just
233 nullary constructors (although they live on the heap - we overwrite
234 live weak pointers with dead ones).
235 -------------------------------------------------------------------------- */
237 INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,const,EF_,0,0);
238 NON_ENTERABLE_ENTRY_CODE(WEAK);
240 INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,const,EF_,0,0);
241 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
243 /* -----------------------------------------------------------------------------
246 This is a static nullary constructor (like []) that we use to mark an empty
247 finalizer in a weak pointer object.
248 -------------------------------------------------------------------------- */
250 INFO_TABLE_CONSTR(NO_FINALIZER_info,NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
251 NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
253 SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_)
256 /* -----------------------------------------------------------------------------
257 Foreign Objects are unlifted and therefore never entered.
258 -------------------------------------------------------------------------- */
260 INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,const,EF_,0,0);
261 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
263 /* -----------------------------------------------------------------------------
264 Stable Names are unlifted too.
265 -------------------------------------------------------------------------- */
267 INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,const,EF_,0,0);
268 NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
270 /* -----------------------------------------------------------------------------
273 There are two kinds of these: full and empty. We need an info table
274 and entry code for each type.
275 -------------------------------------------------------------------------- */
277 INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,const,EF_,0,0);
278 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
280 INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,const,EF_,0,0);
281 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
283 /* -----------------------------------------------------------------------------
286 This is a static nullary constructor (like []) that we use to mark the
287 end of a linked TSO queue.
288 -------------------------------------------------------------------------- */
290 INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
291 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
293 SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
296 /* -----------------------------------------------------------------------------
299 Mutable lists (used by the garbage collector) consist of a chain of
300 StgMutClosures connected through their mut_link fields, ending in
301 an END_MUT_LIST closure.
302 -------------------------------------------------------------------------- */
304 INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
305 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
307 SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
310 INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, const, EF_, 0, 0);
311 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
313 /* -----------------------------------------------------------------------------
316 These come in two basic flavours: arrays of data (StgArrWords) and arrays of
317 pointers (StgArrPtrs). They all have a similar layout:
319 ___________________________
320 | Info | No. of | data....
322 ---------------------------
324 These are *unpointed* objects: i.e. they cannot be entered.
326 -------------------------------------------------------------------------- */
328 #define ArrayInfo(type) \
329 INFO_TABLE(type##_info, type##_entry, 0, 0, type, const, EF_,0,0);
331 ArrayInfo(ARR_WORDS);
332 NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
333 ArrayInfo(MUT_ARR_PTRS);
334 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS);
335 ArrayInfo(MUT_ARR_PTRS_FROZEN);
336 NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
340 /* -----------------------------------------------------------------------------
342 -------------------------------------------------------------------------- */
344 INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, const, EF_, 0, 0);
345 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
347 /* -----------------------------------------------------------------------------
348 Standard Error Entry.
350 This is used for filling in vector-table entries that can never happen,
352 -------------------------------------------------------------------------- */
354 STGFUN(stg_error_entry) \
357 STGCALL1(fflush,stdout); \
358 STGCALL2(fprintf,stderr,"fatal: stg_error_entry"); \
359 STGCALL1(raiseError, errorHandler); \
360 exit(EXIT_FAILURE); /* not executed */ \
364 /* -----------------------------------------------------------------------------
367 Entering this closure will just return to the address on the top of the
368 stack. Useful for getting a thread in a canonical form where we can
369 just enter the top stack word to start the thread. (see deleteThread)
370 * -------------------------------------------------------------------------- */
372 INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, const, EF_, 0, 0);
379 JMP_(ENTRY_CODE(ret_addr));
382 SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_)
385 /* -----------------------------------------------------------------------------
386 Standard Infotables (for use in interpreter)
387 -------------------------------------------------------------------------- */
391 STGFUN(Hugs_CONSTR_entry)
394 ((StgPtr*)Sp)[0] = R1.p;
395 /* vectored: JMP_(RET_VEC(((StgPtr*)Sp)[1],constrTag(?))); */
396 JMP_(ENTRY_CODE(((StgPtr*)Sp)[1]));
399 #define RET_BCO_ENTRY_TEMPLATE(label) \
404 ((StgPtr*)Sp)[0] = R1.p; \
405 JMP_(stg_yield_to_Hugs); \
409 RET_BCO_ENTRY_TEMPLATE(ret_bco_entry );
410 RET_BCO_ENTRY_TEMPLATE(ret_bco_0_entry);
411 RET_BCO_ENTRY_TEMPLATE(ret_bco_1_entry);
412 RET_BCO_ENTRY_TEMPLATE(ret_bco_2_entry);
413 RET_BCO_ENTRY_TEMPLATE(ret_bco_3_entry);
414 RET_BCO_ENTRY_TEMPLATE(ret_bco_4_entry);
415 RET_BCO_ENTRY_TEMPLATE(ret_bco_5_entry);
416 RET_BCO_ENTRY_TEMPLATE(ret_bco_6_entry);
417 RET_BCO_ENTRY_TEMPLATE(ret_bco_7_entry);
419 VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO);
421 #endif /* INTERPRETER */
425 INFO_TABLE_CONSTR(Czh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,const,EF_,0,0);
426 INFO_TABLE_CONSTR(Izh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,const,EF_,0,0);
427 INFO_TABLE_CONSTR(I64zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,const,EF_,0,0);
428 INFO_TABLE_CONSTR(Fzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,const,EF_,0,0);
429 INFO_TABLE_CONSTR(Dzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,const,EF_,0,0);
430 INFO_TABLE_CONSTR(Azh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,const,EF_,0,0);
431 INFO_TABLE_CONSTR(Wzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,const,EF_,0,0);
432 INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,const,EF_,0,0);
434 /* These might seem redundant but {I,C}zh_static_info are used in
435 * {INT,CHAR}LIKE and the rest are used in RtsAPI.c
437 INFO_TABLE_CONSTR(Czh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
438 INFO_TABLE_CONSTR(Izh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
439 INFO_TABLE_CONSTR(I64zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
440 INFO_TABLE_CONSTR(Fzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
441 INFO_TABLE_CONSTR(Dzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
442 INFO_TABLE_CONSTR(Azh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
443 INFO_TABLE_CONSTR(Wzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
444 INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
446 #endif /* !defined(COMPILER) */
448 /* -----------------------------------------------------------------------------
449 CHARLIKE and INTLIKE closures.
451 These are static representations of Chars and small Ints, so that
452 we can remove dynamic Chars and Ints during garbage collection and
453 replace them with references to the static objects.
454 -------------------------------------------------------------------------- */
456 #ifdef HAVE_WIN32_DLL_SUPPORT
458 * When sticking the RTS in a DLL, we delay populating the
459 * Charlike and Intlike tables until load-time, which is only
460 * when we've got the real addresses to the C# and I# closures.
463 static const StgInfoTable czh_static_info;
464 static const StgInfoTable izh_static_info;
465 #define Char_hash_static_info czh_static_info
466 #define Int_hash_static_info izh_static_info
468 #define Char_hash_static_info Czh_static_info
469 #define Int_hash_static_info Izh_static_info
472 #define CHARLIKE_HDR(n) \
474 STATIC_HDR(Char_hash_static_info, /* C# */ \
479 #define INTLIKE_HDR(n) \
481 STATIC_HDR(Int_hash_static_info, /* I# */ \
486 /* put these in the *data* section, since the garbage collector relies
487 * on the fact that static closures live in the data section.
490 /* end the name with _closure, to convince the mangler this is a closure */
492 StgIntCharlikeClosure CHARLIKE_closure[] = {
751 StgIntCharlikeClosure INTLIKE_closure[] = {
752 INTLIKE_HDR(-16), /* MIN_INTLIKE == -16 */
784 INTLIKE_HDR(16) /* MAX_INTLIKE == 16 */