1 /* -----------------------------------------------------------------------------
2 * $Id: StgMiscClosures.hc,v 1.7 1999/01/21 10:31:51 simonm Exp $
4 * Entry code for various built-in closure types.
6 * ---------------------------------------------------------------------------*/
10 #include "StgMiscClosures.h"
11 #include "HeapStackCheck.h" /* for stg_gen_yield */
13 #include "StoragePriv.h"
19 /* -----------------------------------------------------------------------------
20 Entry code for an indirection.
22 This code assumes R1 is in a register for now.
23 -------------------------------------------------------------------------- */
25 INFO_TABLE(IND_info,IND_entry,1,0,IND,const,EF_,0,0);
29 TICK_ENT_IND(Node); /* tick */
31 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
37 INFO_TABLE(IND_STATIC_info,IND_STATIC_entry,1,0,IND_STATIC,const,EF_,0,0);
38 STGFUN(IND_STATIC_entry)
41 TICK_ENT_IND(Node); /* tick */
43 R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
49 INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,0,IND_PERM,const,EF_,0,0);
50 STGFUN(IND_PERM_entry)
53 /* Don't add INDs to granularity cost */
55 /* Dont: ENT_IND(Node); for ticky-ticky; this ind is here only to help profi
58 /* Enter PAP cost centre -- lexical scoping only */
59 ENTER_CCS_PAP_CL(R1.cl);
61 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
63 /* Dont: TICK_ENT_VIA_NODE(); for ticky-ticky; as above */
69 INFO_TABLE(IND_OLDGEN_info,IND_OLDGEN_entry,1,1,IND_OLDGEN,const,EF_,0,0);
70 STGFUN(IND_OLDGEN_entry)
73 TICK_ENT_IND(Node); /* tick */
75 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
81 INFO_TABLE(IND_OLDGEN_PERM_info,IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,const,EF_,0,0);
82 STGFUN(IND_OLDGEN_PERM_entry)
85 TICK_ENT_IND(Node); /* tick */
87 R1.p = (P_) ((StgInd*)R1.p)->indirectee;
93 /* -----------------------------------------------------------------------------
96 This code assumes R1 is in a register for now.
97 -------------------------------------------------------------------------- */
99 INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,2,CAF_UNENTERED,const,EF_,0,0);
100 STGFUN(CAF_UNENTERED_entry)
103 /* ToDo: implement directly in GHC */
106 JMP_(stg_yield_to_Hugs);
110 INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,2,1,CAF_ENTERED,const,EF_,0,0);
111 STGFUN(CAF_ENTERED_entry)
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)
141 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
142 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
143 /* Put ourselves on the blocking queue for this black hole */
144 CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
145 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
146 ((StgBlockingQueue *)R1.p)->mut_link = NULL;
147 recordMutable((StgMutClosure *)R1.cl);
149 /* stg_gen_block is too heavyweight, use a specialised one */
154 INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,const,EF_,0,0);
155 STGFUN(BLACKHOLE_BQ_entry)
160 /* Put ourselves on the blocking queue for this black hole */
161 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
162 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
164 /* stg_gen_block is too heavyweight, use a specialised one */
169 /* identical to BLACKHOLEs except for the infotag */
170 INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,const,EF_,0,0);
171 STGFUN(CAF_BLACKHOLE_entry)
176 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
177 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
178 /* Put ourselves on the blocking queue for this black hole */
179 CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
180 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
181 ((StgBlockingQueue *)R1.p)->mut_link = NULL;
182 recordMutable((StgMutClosure *)R1.cl);
184 /* stg_gen_block is too heavyweight, use a specialised one */
189 /* -----------------------------------------------------------------------------
190 The code for a BCO returns to the scheduler
191 -------------------------------------------------------------------------- */
192 INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,const,EF_,0,0);
197 JMP_(stg_yield_to_Hugs);
201 /* -----------------------------------------------------------------------------
202 Some static info tables for things that don't get entered, and
203 therefore don't need entry code (i.e. boxed but unpointed objects)
204 -------------------------------------------------------------------------- */
206 #define NON_ENTERABLE_ENTRY_CODE(type) \
207 STGFUN(type##_entry) \
210 STGCALL1(fflush,stdout); \
211 STGCALL2(fprintf,stderr,#type " object entered!\n"); \
212 STGCALL1(raiseError, errorHandler); \
213 stg_exit(EXIT_FAILURE); /* not executed */ \
217 INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,const,EF_,0,0);
218 NON_ENTERABLE_ENTRY_CODE(TSO);
220 /* -----------------------------------------------------------------------------
221 Evacuees are left behind by the garbage collector. Any attempt to enter
223 -------------------------------------------------------------------------- */
225 INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,const,EF_,0,0);
226 NON_ENTERABLE_ENTRY_CODE(EVACUATED);
228 /* -----------------------------------------------------------------------------
231 Live weak pointers have a special closure type. Dead ones are just
232 nullary constructors (although they live on the heap - we overwrite
233 live weak pointers with dead ones).
234 -------------------------------------------------------------------------- */
236 INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,const,EF_,0,0);
237 NON_ENTERABLE_ENTRY_CODE(WEAK);
239 INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,const,EF_,0,0);
240 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
242 /* -----------------------------------------------------------------------------
243 Foreign Objects are unlifted and therefore never entered.
244 -------------------------------------------------------------------------- */
246 INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,const,EF_,0,0);
247 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
249 /* -----------------------------------------------------------------------------
252 There are two kinds of these: full and empty. We need an info table
253 and entry code for each type.
254 -------------------------------------------------------------------------- */
256 INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,const,EF_,0,0);
257 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
259 INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,const,EF_,0,0);
260 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
262 /* -----------------------------------------------------------------------------
265 This is a static nullary constructor (like []) that we use to mark the
266 end of a linked TSO queue.
267 -------------------------------------------------------------------------- */
269 INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
270 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
272 SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
275 /* -----------------------------------------------------------------------------
278 Mutable lists (used by the garbage collector) consist of a chain of
279 StgMutClosures connected through their mut_link fields, ending in
280 an END_MUT_LIST closure.
281 -------------------------------------------------------------------------- */
283 INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
284 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
286 SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
289 INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, const, EF_, 0, 0);
290 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
292 /* -----------------------------------------------------------------------------
295 These come in two basic flavours: arrays of data (StgArrWords) and arrays of
296 pointers (StgArrPtrs). They all have a similar layout:
298 ___________________________
299 | Info | No. of | data....
301 ---------------------------
303 These are *unpointed* objects: i.e. they cannot be entered.
305 -------------------------------------------------------------------------- */
307 #define ArrayInfo(type) \
308 INFO_TABLE(type##_info, type##_entry, 0, 0, type, const, EF_,0,0); \
309 NON_ENTERABLE_ENTRY_CODE(type);
311 ArrayInfo(ARR_WORDS);
312 ArrayInfo(MUT_ARR_WORDS);
313 ArrayInfo(MUT_ARR_PTRS);
314 ArrayInfo(MUT_ARR_PTRS_FROZEN);
318 /* -----------------------------------------------------------------------------
320 -------------------------------------------------------------------------- */
322 INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, const, EF_, 0, 0);
323 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
325 /* -----------------------------------------------------------------------------
326 Standard Error Entry.
328 This is used for filling in vector-table entries that can never happen,
330 -------------------------------------------------------------------------- */
332 STGFUN(stg_error_entry) \
335 STGCALL1(fflush,stdout); \
336 STGCALL2(fprintf,stderr,"fatal: stg_error_entry"); \
337 STGCALL1(raiseError, errorHandler); \
338 exit(EXIT_FAILURE); /* not executed */ \
342 /* -----------------------------------------------------------------------------
345 Entering this closure will just return to the address on the top of the
346 stack. Useful for getting a thread in a canonical form where we can
347 just enter the top stack word to start the thread. (see deleteThread)
348 * -------------------------------------------------------------------------- */
350 INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, const, EF_, 0, 0);
357 JMP_(ENTRY_CODE(ret_addr));
360 SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_)
363 /* -----------------------------------------------------------------------------
364 Standard Infotables (for use in interpreter)
365 -------------------------------------------------------------------------- */
369 STGFUN(Hugs_CONSTR_entry)
372 ((StgPtr*)Sp)[0] = R1.p;
373 /* vectored: JMP_(RET_VEC(((StgPtr*)Sp)[1],constrTag(?))); */
374 JMP_(ENTRY_CODE(((StgPtr*)Sp)[1]));
377 #define RET_BCO_ENTRY_TEMPLATE(label) \
382 ((StgPtr*)Sp)[0] = R1.p; \
383 JMP_(stg_yield_to_Hugs); \
387 RET_BCO_ENTRY_TEMPLATE(ret_bco_entry );
388 RET_BCO_ENTRY_TEMPLATE(ret_bco_0_entry);
389 RET_BCO_ENTRY_TEMPLATE(ret_bco_1_entry);
390 RET_BCO_ENTRY_TEMPLATE(ret_bco_2_entry);
391 RET_BCO_ENTRY_TEMPLATE(ret_bco_3_entry);
392 RET_BCO_ENTRY_TEMPLATE(ret_bco_4_entry);
393 RET_BCO_ENTRY_TEMPLATE(ret_bco_5_entry);
394 RET_BCO_ENTRY_TEMPLATE(ret_bco_6_entry);
395 RET_BCO_ENTRY_TEMPLATE(ret_bco_7_entry);
397 VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO);
399 #endif /* INTERPRETER */
403 INFO_TABLE_CONSTR(CZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,const,EF_,0,0);
404 INFO_TABLE_CONSTR(IZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,const,EF_,0,0);
405 INFO_TABLE_CONSTR(I64Zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,const,EF_,0,0);
406 INFO_TABLE_CONSTR(FZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,const,EF_,0,0);
407 INFO_TABLE_CONSTR(DZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,const,EF_,0,0);
408 INFO_TABLE_CONSTR(AZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,const,EF_,0,0);
409 INFO_TABLE_CONSTR(WZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,const,EF_,0,0);
410 INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,const,EF_,0,0);
412 /* These might seem redundant but {I,C}Zh_static_info are used in
413 * {INT,CHAR}LIKE and the rest are used in RtsAPI.c
415 INFO_TABLE_CONSTR(CZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
416 INFO_TABLE_CONSTR(IZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
417 INFO_TABLE_CONSTR(I64Zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
418 INFO_TABLE_CONSTR(FZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
419 INFO_TABLE_CONSTR(DZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
420 INFO_TABLE_CONSTR(AZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
421 INFO_TABLE_CONSTR(WZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
422 INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
424 #endif /* !defined(COMPILER) */
426 /* -----------------------------------------------------------------------------
427 CHARLIKE and INTLIKE closures.
429 These are static representations of Chars and small Ints, so that
430 we can remove dynamic Chars and Ints during garbage collection and
431 replace them with references to the static objects.
432 -------------------------------------------------------------------------- */
434 #define CHARLIKE_HDR(n) \
436 STATIC_HDR(CZh_static_info, /* C# */ \
441 #define INTLIKE_HDR(n) \
443 STATIC_HDR(IZh_static_info, /* I# */ \
448 /* put these in the *data* section, since the garbage collector relies
449 * on the fact that static closures live in the data section.
452 /* end the name with _closure, to convince the mangler this is a closure */
454 StgIntCharlikeClosure CHARLIKE_closure[] = {
713 StgIntCharlikeClosure INTLIKE_closure[] = {
714 INTLIKE_HDR(-16), /* MIN_INTLIKE == -16 */
746 INTLIKE_HDR(16) /* MAX_INTLIKE == 16 */