1 /* -----------------------------------------------------------------------------
2 * $Id: StgMiscClosures.hc,v 1.5 1999/01/15 17:57:11 simonm Exp $
4 * Entry code for various built-in closure types.
6 * ---------------------------------------------------------------------------*/
10 #include "StgMiscClosures.h"
11 #include "HeapStackCheck.h" /* for stg_gen_yield */
17 /* -----------------------------------------------------------------------------
18 Entry code for an indirection.
20 This code assumes R1 is in a register for now.
21 -------------------------------------------------------------------------- */
23 INFO_TABLE(IND_info,IND_entry,1,0,IND,const,EF_,0,0);
27 TICK_ENT_IND(Node); /* tick */
29 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
35 INFO_TABLE(IND_STATIC_info,IND_STATIC_entry,1,0,IND_STATIC,const,EF_,0,0);
36 STGFUN(IND_STATIC_entry)
39 TICK_ENT_IND(Node); /* tick */
41 R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
47 INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,0,IND_PERM,const,EF_,0,0);
48 STGFUN(IND_PERM_entry)
51 /* Don't add INDs to granularity cost */
53 /* Dont: ENT_IND(Node); for ticky-ticky; this ind is here only to help profi
56 /* Enter PAP cost centre -- lexical scoping only */
57 ENTER_CCS_PAP_CL(R1.cl);
59 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
61 /* Dont: TICK_ENT_VIA_NODE(); for ticky-ticky; as above */
67 INFO_TABLE(IND_OLDGEN_info,IND_OLDGEN_entry,1,1,IND_OLDGEN,const,EF_,0,0);
68 STGFUN(IND_OLDGEN_entry)
71 TICK_ENT_IND(Node); /* tick */
73 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
79 INFO_TABLE(IND_OLDGEN_PERM_info,IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,const,EF_,0,0);
80 STGFUN(IND_OLDGEN_PERM_entry)
83 TICK_ENT_IND(Node); /* tick */
85 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
91 /* -----------------------------------------------------------------------------
94 This code assumes R1 is in a register for now.
95 -------------------------------------------------------------------------- */
97 INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,2,CAF_UNENTERED,const,EF_,0,0);
98 STGFUN(CAF_UNENTERED_entry)
101 /* ToDo: implement directly in GHC */
104 JMP_(stg_yield_to_Hugs);
108 INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,2,1,CAF_ENTERED,const,EF_,0,0);
109 STGFUN(CAF_ENTERED_entry)
112 TICK_ENT_CAF_ENTERED(Node); /* tick */
114 R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */
116 JMP_(GET_ENTRY(R1.cl));
120 /* -----------------------------------------------------------------------------
121 Entry code for a black hole.
123 Entering a black hole normally causes a cyclic data dependency, but
124 in the concurrent world, black holes are synchronization points,
125 and they are turned into blocking queues when there are threads
126 waiting for the evaluation of the closure to finish.
127 -------------------------------------------------------------------------- */
129 /* Note: a black hole must be big enough to be overwritten with an
130 * indirection/evacuee/catch. Thus we claim it has 1 non-pointer word of
131 * payload (in addition to the pointer word for the blocking queue), which
132 * should be big enough for an old-generation indirection.
135 INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,const,EF_,0,0);
136 STGFUN(BLACKHOLE_entry)
139 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
140 ((StgBlackHole *)R1.p)->header.info = &BLACKHOLE_BQ_info;
141 /* Put ourselves on the blocking queue for this black hole */
142 CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
143 ((StgBlackHole *)R1.p)->blocking_queue = CurrentTSO;
145 /* stg_gen_block is too heavyweight, use a specialised one */
150 INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,const,EF_,0,0);
151 STGFUN(BLACKHOLE_BQ_entry)
154 /* Put ourselves on the blocking queue for this black hole */
155 CurrentTSO->link = ((StgBlackHole *)R1.p)->blocking_queue;
156 ((StgBlackHole *)R1.p)->blocking_queue = CurrentTSO;
158 /* stg_gen_block is too heavyweight, use a specialised one */
163 /* identical to BLACKHOLEs except for the infotag */
164 INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,const,EF_,0,0);
165 STGFUN(CAF_BLACKHOLE_entry)
168 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
169 ((StgBlackHole *)R1.p)->header.info = &BLACKHOLE_BQ_info;
170 /* Put ourselves on the blocking queue for this black hole */
171 CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
172 ((StgBlackHole *)R1.p)->blocking_queue = CurrentTSO;
174 /* stg_gen_block is too heavyweight, use a specialised one */
179 /* -----------------------------------------------------------------------------
180 The code for a BCO returns to the scheduler
181 -------------------------------------------------------------------------- */
182 INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,const,EF_,0,0);
187 JMP_(stg_yield_to_Hugs);
191 /* -----------------------------------------------------------------------------
192 Some static info tables for things that don't get entered, and
193 therefore don't need entry code (i.e. boxed but unpointed objects)
194 -------------------------------------------------------------------------- */
196 #define NON_ENTERABLE_ENTRY_CODE(type) \
197 STGFUN(type##_entry) \
200 STGCALL1(fflush,stdout); \
201 STGCALL2(fprintf,stderr,#type " object entered!\n"); \
202 STGCALL1(raiseError, errorHandler); \
203 stg_exit(EXIT_FAILURE); /* not executed */ \
207 INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,const,EF_,0,0);
208 NON_ENTERABLE_ENTRY_CODE(TSO);
210 /* -----------------------------------------------------------------------------
211 Evacuees are left behind by the garbage collector. Any attempt to enter
213 -------------------------------------------------------------------------- */
215 INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,const,EF_,0,0);
216 NON_ENTERABLE_ENTRY_CODE(EVACUATED);
218 /* -----------------------------------------------------------------------------
221 Live weak pointers have a special closure type. Dead ones are just
222 nullary constructors (although they live on the heap - we overwrite
223 live weak pointers with dead ones).
224 -------------------------------------------------------------------------- */
226 INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,const,EF_,0,0);
227 NON_ENTERABLE_ENTRY_CODE(WEAK);
229 INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,const,EF_,0,0);
230 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
232 /* -----------------------------------------------------------------------------
233 Foreign Objects are unlifted and therefore never entered.
234 -------------------------------------------------------------------------- */
236 INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,const,EF_,0,0);
237 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
239 /* -----------------------------------------------------------------------------
242 There are two kinds of these: full and empty. We need an info table
243 and entry code for each type.
244 -------------------------------------------------------------------------- */
246 INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,const,EF_,0,0);
247 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
249 INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,const,EF_,0,0);
250 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
252 /* -----------------------------------------------------------------------------
255 This is a static nullary constructor (like []) that we use to mark the
256 end of a linked TSO queue.
257 -------------------------------------------------------------------------- */
259 INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
260 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
262 SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
265 /* -----------------------------------------------------------------------------
268 Mutable lists (used by the garbage collector) consist of a chain of
269 StgMutClosures connected through their mut_link fields, ending in
270 an END_MUT_LIST closure.
271 -------------------------------------------------------------------------- */
273 INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
274 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
276 SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
279 INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, const, EF_, 0, 0);
280 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
282 /* -----------------------------------------------------------------------------
285 These come in two basic flavours: arrays of data (StgArrWords) and arrays of
286 pointers (StgArrPtrs). They all have a similar layout:
288 ___________________________
289 | Info | No. of | data....
291 ---------------------------
293 These are *unpointed* objects: i.e. they cannot be entered.
295 -------------------------------------------------------------------------- */
297 #define ArrayInfo(type) \
298 INFO_TABLE(type##_info, type##_entry, 0, 0, type, const, EF_,0,0); \
299 NON_ENTERABLE_ENTRY_CODE(type);
301 ArrayInfo(ARR_WORDS);
302 ArrayInfo(MUT_ARR_WORDS);
303 ArrayInfo(MUT_ARR_PTRS);
304 ArrayInfo(MUT_ARR_PTRS_FROZEN);
308 /* -----------------------------------------------------------------------------
310 -------------------------------------------------------------------------- */
312 INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, const, EF_, 0, 0);
313 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
315 /* -----------------------------------------------------------------------------
316 Standard Error Entry.
318 This is used for filling in vector-table entries that can never happen,
320 -------------------------------------------------------------------------- */
322 STGFUN(stg_error_entry) \
325 STGCALL1(fflush,stdout); \
326 STGCALL2(fprintf,stderr,"fatal: stg_error_entry"); \
327 STGCALL1(raiseError, errorHandler); \
328 exit(EXIT_FAILURE); /* not executed */ \
332 /* -----------------------------------------------------------------------------
335 Entering this closure will just return to the address on the top of the
336 stack. Useful for getting a thread in a canonical form where we can
337 just enter the top stack word to start the thread. (see deleteThread)
338 * -------------------------------------------------------------------------- */
340 INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, const, EF_, 0, 0);
347 JMP_(ENTRY_CODE(ret_addr));
349 SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_)
352 /* -----------------------------------------------------------------------------
353 Standard Infotables (for use in interpreter)
354 -------------------------------------------------------------------------- */
358 STGFUN(Hugs_CONSTR_entry)
361 ((StgPtr*)Sp)[0] = R1.p;
362 /* vectored: JMP_(RET_VEC(((StgPtr*)Sp)[1],constrTag(?))); */
363 JMP_(ENTRY_CODE(((StgPtr*)Sp)[1]));
366 #define RET_BCO_ENTRY_TEMPLATE(label) \
371 ((StgPtr*)Sp)[0] = R1.p; \
372 JMP_(stg_yield_to_Hugs); \
376 RET_BCO_ENTRY_TEMPLATE(ret_bco_entry );
377 RET_BCO_ENTRY_TEMPLATE(ret_bco_0_entry);
378 RET_BCO_ENTRY_TEMPLATE(ret_bco_1_entry);
379 RET_BCO_ENTRY_TEMPLATE(ret_bco_2_entry);
380 RET_BCO_ENTRY_TEMPLATE(ret_bco_3_entry);
381 RET_BCO_ENTRY_TEMPLATE(ret_bco_4_entry);
382 RET_BCO_ENTRY_TEMPLATE(ret_bco_5_entry);
383 RET_BCO_ENTRY_TEMPLATE(ret_bco_6_entry);
384 RET_BCO_ENTRY_TEMPLATE(ret_bco_7_entry);
386 VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO);
388 #endif /* INTERPRETER */
392 INFO_TABLE_CONSTR(CZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,const,EF_,0,0);
393 INFO_TABLE_CONSTR(IZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,const,EF_,0,0);
394 INFO_TABLE_CONSTR(I64Zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,const,EF_,0,0);
395 INFO_TABLE_CONSTR(FZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,const,EF_,0,0);
396 INFO_TABLE_CONSTR(DZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,const,EF_,0,0);
397 INFO_TABLE_CONSTR(AZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,const,EF_,0,0);
398 INFO_TABLE_CONSTR(WZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,const,EF_,0,0);
399 INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,const,EF_,0,0);
401 /* These might seem redundant but {I,C}Zh_static_info are used in
402 * {INT,CHAR}LIKE and the rest are used in RtsAPI.c
404 INFO_TABLE_CONSTR(CZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
405 INFO_TABLE_CONSTR(IZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
406 INFO_TABLE_CONSTR(I64Zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
407 INFO_TABLE_CONSTR(FZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
408 INFO_TABLE_CONSTR(DZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
409 INFO_TABLE_CONSTR(AZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
410 INFO_TABLE_CONSTR(WZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
411 INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
413 #endif /* !defined(COMPILER) */
415 /* -----------------------------------------------------------------------------
416 CHARLIKE and INTLIKE closures.
418 These are static representations of Chars and small Ints, so that
419 we can remove dynamic Chars and Ints during garbage collection and
420 replace them with references to the static objects.
421 -------------------------------------------------------------------------- */
423 #define CHARLIKE_HDR(n) \
425 STATIC_HDR(CZh_static_info, /* C# */ \
430 #define INTLIKE_HDR(n) \
432 STATIC_HDR(IZh_static_info, /* I# */ \
437 /* put these in the *data* section, since the garbage collector relies
438 * on the fact that static closures live in the data section.
441 /* end the name with _closure, to convince the mangler this is a closure */
443 StgIntCharlikeClosure CHARLIKE_closure[] = {
702 StgIntCharlikeClosure INTLIKE_closure[] = {
703 INTLIKE_HDR(-16), /* MIN_INTLIKE == -16 */
735 INTLIKE_HDR(16) /* MAX_INTLIKE == 16 */