1 /* -----------------------------------------------------------------------------
2 * $Id: StgMiscClosures.hc,v 1.9 1999/01/27 14:51:22 simonpj 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 /* -----------------------------------------------------------------------------
250 Stable Names are unlifted too.
251 -------------------------------------------------------------------------- */
253 INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,const,EF_,0,0);
254 NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
256 /* -----------------------------------------------------------------------------
259 There are two kinds of these: full and empty. We need an info table
260 and entry code for each type.
261 -------------------------------------------------------------------------- */
263 INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,const,EF_,0,0);
264 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
266 INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,const,EF_,0,0);
267 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
269 /* -----------------------------------------------------------------------------
272 This is a static nullary constructor (like []) that we use to mark the
273 end of a linked TSO queue.
274 -------------------------------------------------------------------------- */
276 INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
277 NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
279 SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
282 /* -----------------------------------------------------------------------------
285 Mutable lists (used by the garbage collector) consist of a chain of
286 StgMutClosures connected through their mut_link fields, ending in
287 an END_MUT_LIST closure.
288 -------------------------------------------------------------------------- */
290 INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
291 NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
293 SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
296 INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, const, EF_, 0, 0);
297 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
299 /* -----------------------------------------------------------------------------
302 These come in two basic flavours: arrays of data (StgArrWords) and arrays of
303 pointers (StgArrPtrs). They all have a similar layout:
305 ___________________________
306 | Info | No. of | data....
308 ---------------------------
310 These are *unpointed* objects: i.e. they cannot be entered.
312 -------------------------------------------------------------------------- */
314 #define ArrayInfo(type) \
315 INFO_TABLE(type##_info, type##_entry, 0, 0, type, const, EF_,0,0); \
316 NON_ENTERABLE_ENTRY_CODE(type);
318 ArrayInfo(ARR_WORDS);
319 ArrayInfo(MUT_ARR_WORDS);
320 ArrayInfo(MUT_ARR_PTRS);
321 ArrayInfo(MUT_ARR_PTRS_FROZEN);
325 /* -----------------------------------------------------------------------------
327 -------------------------------------------------------------------------- */
329 INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, const, EF_, 0, 0);
330 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
332 /* -----------------------------------------------------------------------------
333 Standard Error Entry.
335 This is used for filling in vector-table entries that can never happen,
337 -------------------------------------------------------------------------- */
339 STGFUN(stg_error_entry) \
342 STGCALL1(fflush,stdout); \
343 STGCALL2(fprintf,stderr,"fatal: stg_error_entry"); \
344 STGCALL1(raiseError, errorHandler); \
345 exit(EXIT_FAILURE); /* not executed */ \
349 /* -----------------------------------------------------------------------------
352 Entering this closure will just return to the address on the top of the
353 stack. Useful for getting a thread in a canonical form where we can
354 just enter the top stack word to start the thread. (see deleteThread)
355 * -------------------------------------------------------------------------- */
357 INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, const, EF_, 0, 0);
364 JMP_(ENTRY_CODE(ret_addr));
367 SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_)
370 /* -----------------------------------------------------------------------------
371 Standard Infotables (for use in interpreter)
372 -------------------------------------------------------------------------- */
376 STGFUN(Hugs_CONSTR_entry)
379 ((StgPtr*)Sp)[0] = R1.p;
380 /* vectored: JMP_(RET_VEC(((StgPtr*)Sp)[1],constrTag(?))); */
381 JMP_(ENTRY_CODE(((StgPtr*)Sp)[1]));
384 #define RET_BCO_ENTRY_TEMPLATE(label) \
389 ((StgPtr*)Sp)[0] = R1.p; \
390 JMP_(stg_yield_to_Hugs); \
394 RET_BCO_ENTRY_TEMPLATE(ret_bco_entry );
395 RET_BCO_ENTRY_TEMPLATE(ret_bco_0_entry);
396 RET_BCO_ENTRY_TEMPLATE(ret_bco_1_entry);
397 RET_BCO_ENTRY_TEMPLATE(ret_bco_2_entry);
398 RET_BCO_ENTRY_TEMPLATE(ret_bco_3_entry);
399 RET_BCO_ENTRY_TEMPLATE(ret_bco_4_entry);
400 RET_BCO_ENTRY_TEMPLATE(ret_bco_5_entry);
401 RET_BCO_ENTRY_TEMPLATE(ret_bco_6_entry);
402 RET_BCO_ENTRY_TEMPLATE(ret_bco_7_entry);
404 VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO);
406 #endif /* INTERPRETER */
410 INFO_TABLE_CONSTR(Czh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,const,EF_,0,0);
411 INFO_TABLE_CONSTR(Izh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,const,EF_,0,0);
412 INFO_TABLE_CONSTR(I64zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,const,EF_,0,0);
413 INFO_TABLE_CONSTR(Fzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,const,EF_,0,0);
414 INFO_TABLE_CONSTR(Dzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,const,EF_,0,0);
415 INFO_TABLE_CONSTR(Azh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,const,EF_,0,0);
416 INFO_TABLE_CONSTR(Wzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,const,EF_,0,0);
417 INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,const,EF_,0,0);
419 /* These might seem redundant but {I,C}zh_static_info are used in
420 * {INT,CHAR}LIKE and the rest are used in RtsAPI.c
422 INFO_TABLE_CONSTR(Czh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
423 INFO_TABLE_CONSTR(Izh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
424 INFO_TABLE_CONSTR(I64zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
425 INFO_TABLE_CONSTR(Fzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
426 INFO_TABLE_CONSTR(Dzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
427 INFO_TABLE_CONSTR(Azh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
428 INFO_TABLE_CONSTR(Wzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
429 INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
431 #endif /* !defined(COMPILER) */
433 /* -----------------------------------------------------------------------------
434 CHARLIKE and INTLIKE closures.
436 These are static representations of Chars and small Ints, so that
437 we can remove dynamic Chars and Ints during garbage collection and
438 replace them with references to the static objects.
439 -------------------------------------------------------------------------- */
441 #define CHARLIKE_HDR(n) \
443 STATIC_HDR(Czh_static_info, /* C# */ \
448 #define INTLIKE_HDR(n) \
450 STATIC_HDR(Izh_static_info, /* I# */ \
455 /* put these in the *data* section, since the garbage collector relies
456 * on the fact that static closures live in the data section.
459 /* end the name with _closure, to convince the mangler this is a closure */
461 StgIntCharlikeClosure CHARLIKE_closure[] = {
720 StgIntCharlikeClosure INTLIKE_closure[] = {
721 INTLIKE_HDR(-16), /* MIN_INTLIKE == -16 */
753 INTLIKE_HDR(16) /* MAX_INTLIKE == 16 */