1 /* -----------------------------------------------------------------------------
2 * $Id: StgMiscClosures.hc,v 1.6 1999/01/18 15:21:39 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 TICK_ENT_CAF_ENTERED(Node); /* tick */
116 R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */
118 JMP_(GET_ENTRY(R1.cl));
122 /* -----------------------------------------------------------------------------
123 Entry code for a black hole.
125 Entering a black hole normally causes a cyclic data dependency, but
126 in the concurrent world, black holes are synchronization points,
127 and they are turned into blocking queues when there are threads
128 waiting for the evaluation of the closure to finish.
129 -------------------------------------------------------------------------- */
131 /* Note: a black hole must be big enough to be overwritten with an
132 * indirection/evacuee/catch. Thus we claim it has 1 non-pointer word of
133 * payload (in addition to the pointer word for the blocking queue), which
134 * should be big enough for an old-generation indirection.
137 INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,const,EF_,0,0);
138 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)
158 /* Put ourselves on the blocking queue for this black hole */
159 CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
160 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
162 /* stg_gen_block is too heavyweight, use a specialised one */
167 /* identical to BLACKHOLEs except for the infotag */
168 INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,const,EF_,0,0);
169 STGFUN(CAF_BLACKHOLE_entry)
172 /* Change the BLACKHOLE into a BLACKHOLE_BQ */
173 ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
174 /* Put ourselves on the blocking queue for this black hole */
175 CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
176 ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
177 ((StgBlockingQueue *)R1.p)->mut_link = NULL;
178 recordMutable((StgMutClosure *)R1.cl);
180 /* stg_gen_block is too heavyweight, use a specialised one */
185 /* -----------------------------------------------------------------------------
186 The code for a BCO returns to the scheduler
187 -------------------------------------------------------------------------- */
188 INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,const,EF_,0,0);
193 JMP_(stg_yield_to_Hugs);
197 /* -----------------------------------------------------------------------------
198 Some static info tables for things that don't get entered, and
199 therefore don't need entry code (i.e. boxed but unpointed objects)
200 -------------------------------------------------------------------------- */
202 #define NON_ENTERABLE_ENTRY_CODE(type) \
203 STGFUN(type##_entry) \
206 STGCALL1(fflush,stdout); \
207 STGCALL2(fprintf,stderr,#type " object entered!\n"); \
208 STGCALL1(raiseError, errorHandler); \
209 stg_exit(EXIT_FAILURE); /* not executed */ \
213 INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,const,EF_,0,0);
214 NON_ENTERABLE_ENTRY_CODE(TSO);
216 /* -----------------------------------------------------------------------------
217 Evacuees are left behind by the garbage collector. Any attempt to enter
219 -------------------------------------------------------------------------- */
221 INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,const,EF_,0,0);
222 NON_ENTERABLE_ENTRY_CODE(EVACUATED);
224 /* -----------------------------------------------------------------------------
227 Live weak pointers have a special closure type. Dead ones are just
228 nullary constructors (although they live on the heap - we overwrite
229 live weak pointers with dead ones).
230 -------------------------------------------------------------------------- */
232 INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,const,EF_,0,0);
233 NON_ENTERABLE_ENTRY_CODE(WEAK);
235 INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,const,EF_,0,0);
236 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
238 /* -----------------------------------------------------------------------------
239 Foreign Objects are unlifted and therefore never entered.
240 -------------------------------------------------------------------------- */
242 INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,const,EF_,0,0);
243 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
245 /* -----------------------------------------------------------------------------
248 There are two kinds of these: full and empty. We need an info table
249 and entry code for each type.
250 -------------------------------------------------------------------------- */
252 INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,const,EF_,0,0);
253 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
255 INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,const,EF_,0,0);
256 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
258 /* -----------------------------------------------------------------------------
261 This is a static nullary constructor (like []) that we use to mark the
262 end of a linked TSO queue.
263 -------------------------------------------------------------------------- */
265 INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
266 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
268 SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
271 /* -----------------------------------------------------------------------------
274 Mutable lists (used by the garbage collector) consist of a chain of
275 StgMutClosures connected through their mut_link fields, ending in
276 an END_MUT_LIST closure.
277 -------------------------------------------------------------------------- */
279 INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
280 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
282 SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
285 INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, const, EF_, 0, 0);
286 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
288 /* -----------------------------------------------------------------------------
291 These come in two basic flavours: arrays of data (StgArrWords) and arrays of
292 pointers (StgArrPtrs). They all have a similar layout:
294 ___________________________
295 | Info | No. of | data....
297 ---------------------------
299 These are *unpointed* objects: i.e. they cannot be entered.
301 -------------------------------------------------------------------------- */
303 #define ArrayInfo(type) \
304 INFO_TABLE(type##_info, type##_entry, 0, 0, type, const, EF_,0,0); \
305 NON_ENTERABLE_ENTRY_CODE(type);
307 ArrayInfo(ARR_WORDS);
308 ArrayInfo(MUT_ARR_WORDS);
309 ArrayInfo(MUT_ARR_PTRS);
310 ArrayInfo(MUT_ARR_PTRS_FROZEN);
314 /* -----------------------------------------------------------------------------
316 -------------------------------------------------------------------------- */
318 INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, const, EF_, 0, 0);
319 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
321 /* -----------------------------------------------------------------------------
322 Standard Error Entry.
324 This is used for filling in vector-table entries that can never happen,
326 -------------------------------------------------------------------------- */
328 STGFUN(stg_error_entry) \
331 STGCALL1(fflush,stdout); \
332 STGCALL2(fprintf,stderr,"fatal: stg_error_entry"); \
333 STGCALL1(raiseError, errorHandler); \
334 exit(EXIT_FAILURE); /* not executed */ \
338 /* -----------------------------------------------------------------------------
341 Entering this closure will just return to the address on the top of the
342 stack. Useful for getting a thread in a canonical form where we can
343 just enter the top stack word to start the thread. (see deleteThread)
344 * -------------------------------------------------------------------------- */
346 INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, const, EF_, 0, 0);
353 JMP_(ENTRY_CODE(ret_addr));
356 SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_)
359 /* -----------------------------------------------------------------------------
360 Standard Infotables (for use in interpreter)
361 -------------------------------------------------------------------------- */
365 STGFUN(Hugs_CONSTR_entry)
368 ((StgPtr*)Sp)[0] = R1.p;
369 /* vectored: JMP_(RET_VEC(((StgPtr*)Sp)[1],constrTag(?))); */
370 JMP_(ENTRY_CODE(((StgPtr*)Sp)[1]));
373 #define RET_BCO_ENTRY_TEMPLATE(label) \
378 ((StgPtr*)Sp)[0] = R1.p; \
379 JMP_(stg_yield_to_Hugs); \
383 RET_BCO_ENTRY_TEMPLATE(ret_bco_entry );
384 RET_BCO_ENTRY_TEMPLATE(ret_bco_0_entry);
385 RET_BCO_ENTRY_TEMPLATE(ret_bco_1_entry);
386 RET_BCO_ENTRY_TEMPLATE(ret_bco_2_entry);
387 RET_BCO_ENTRY_TEMPLATE(ret_bco_3_entry);
388 RET_BCO_ENTRY_TEMPLATE(ret_bco_4_entry);
389 RET_BCO_ENTRY_TEMPLATE(ret_bco_5_entry);
390 RET_BCO_ENTRY_TEMPLATE(ret_bco_6_entry);
391 RET_BCO_ENTRY_TEMPLATE(ret_bco_7_entry);
393 VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO);
395 #endif /* INTERPRETER */
399 INFO_TABLE_CONSTR(CZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,const,EF_,0,0);
400 INFO_TABLE_CONSTR(IZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,const,EF_,0,0);
401 INFO_TABLE_CONSTR(I64Zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,const,EF_,0,0);
402 INFO_TABLE_CONSTR(FZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,const,EF_,0,0);
403 INFO_TABLE_CONSTR(DZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,const,EF_,0,0);
404 INFO_TABLE_CONSTR(AZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,const,EF_,0,0);
405 INFO_TABLE_CONSTR(WZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,const,EF_,0,0);
406 INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,const,EF_,0,0);
408 /* These might seem redundant but {I,C}Zh_static_info are used in
409 * {INT,CHAR}LIKE and the rest are used in RtsAPI.c
411 INFO_TABLE_CONSTR(CZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
412 INFO_TABLE_CONSTR(IZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
413 INFO_TABLE_CONSTR(I64Zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
414 INFO_TABLE_CONSTR(FZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
415 INFO_TABLE_CONSTR(DZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
416 INFO_TABLE_CONSTR(AZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
417 INFO_TABLE_CONSTR(WZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
418 INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
420 #endif /* !defined(COMPILER) */
422 /* -----------------------------------------------------------------------------
423 CHARLIKE and INTLIKE closures.
425 These are static representations of Chars and small Ints, so that
426 we can remove dynamic Chars and Ints during garbage collection and
427 replace them with references to the static objects.
428 -------------------------------------------------------------------------- */
430 #define CHARLIKE_HDR(n) \
432 STATIC_HDR(CZh_static_info, /* C# */ \
437 #define INTLIKE_HDR(n) \
439 STATIC_HDR(IZh_static_info, /* I# */ \
444 /* put these in the *data* section, since the garbage collector relies
445 * on the fact that static closures live in the data section.
448 /* end the name with _closure, to convince the mangler this is a closure */
450 StgIntCharlikeClosure CHARLIKE_closure[] = {
709 StgIntCharlikeClosure INTLIKE_closure[] = {
710 INTLIKE_HDR(-16), /* MIN_INTLIKE == -16 */
742 INTLIKE_HDR(16) /* MAX_INTLIKE == 16 */