typo
[ghc.git] / includes / rts / storage / ClosureMacros.h
1 /* ----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team, 1998-2012
4 *
5 * Macros for building and manipulating closures
6 *
7 * -------------------------------------------------------------------------- */
8
9 #ifndef RTS_STORAGE_CLOSUREMACROS_H
10 #define RTS_STORAGE_CLOSUREMACROS_H
11
12 /* -----------------------------------------------------------------------------
13 Info tables are slammed up against the entry code, and the label
14 for the info table is at the *end* of the table itself. This
15 inline function adjusts an info pointer to point to the beginning
16 of the table, so we can use standard C structure indexing on it.
17
18 Note: this works for SRT info tables as long as you don't want to
19 access the SRT, since they are laid out the same with the SRT
20 pointer as the first word in the table.
21
22 NOTES ABOUT MANGLED C VS. MINI-INTERPRETER:
23
24 A couple of definitions:
25
26 "info pointer" The first word of the closure. Might point
27 to either the end or the beginning of the
28 info table, depending on whether we're using
29 the mini interpreter or not. GET_INFO(c)
30 retrieves the info pointer of a closure.
31
32 "info table" The info table structure associated with a
33 closure. This is always a pointer to the
34 beginning of the structure, so we can
35 use standard C structure indexing to pull out
36 the fields. get_itbl(c) returns a pointer to
37 the info table for closure c.
38
39 An address of the form xxxx_info points to the end of the info
40 table or the beginning of the info table depending on whether we're
41 mangling or not respectively. So,
42
43 c->header.info = xxx_info
44
45 makes absolute sense, whether mangling or not.
46
47 -------------------------------------------------------------------------- */
48
49 INLINE_HEADER void SET_INFO(StgClosure *c, const StgInfoTable *info) {
50 c->header.info = info;
51 }
52 INLINE_HEADER const StgInfoTable *GET_INFO(StgClosure *c) {
53 return c->header.info;
54 }
55
56 #define GET_ENTRY(c) (ENTRY_CODE(GET_INFO(c)))
57
58 #ifdef TABLES_NEXT_TO_CODE
59 EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info);
60 EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgInfoTable *)info - 1;}
61 EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info);
62 EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgRetInfoTable *)info - 1;}
63 INLINE_HEADER StgFunInfoTable *FUN_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgFunInfoTable *)info - 1;}
64 INLINE_HEADER StgThunkInfoTable *THUNK_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgThunkInfoTable *)info - 1;}
65 INLINE_HEADER StgConInfoTable *CON_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgConInfoTable *)info - 1;}
66 INLINE_HEADER StgFunInfoTable *itbl_to_fun_itbl(const StgInfoTable *i) {return (StgFunInfoTable *)(i + 1) - 1;}
67 INLINE_HEADER StgRetInfoTable *itbl_to_ret_itbl(const StgInfoTable *i) {return (StgRetInfoTable *)(i + 1) - 1;}
68 INLINE_HEADER StgThunkInfoTable *itbl_to_thunk_itbl(const StgInfoTable *i) {return (StgThunkInfoTable *)(i + 1) - 1;}
69 INLINE_HEADER StgConInfoTable *itbl_to_con_itbl(const StgInfoTable *i) {return (StgConInfoTable *)(i + 1) - 1;}
70 #else
71 EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info);
72 EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgInfoTable *)info;}
73 EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info);
74 EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgRetInfoTable *)info;}
75 INLINE_HEADER StgFunInfoTable *FUN_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgFunInfoTable *)info;}
76 INLINE_HEADER StgThunkInfoTable *THUNK_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgThunkInfoTable *)info;}
77 INLINE_HEADER StgConInfoTable *CON_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgConInfoTable *)info;}
78 INLINE_HEADER StgFunInfoTable *itbl_to_fun_itbl(const StgInfoTable *i) {return (StgFunInfoTable *)i;}
79 INLINE_HEADER StgRetInfoTable *itbl_to_ret_itbl(const StgInfoTable *i) {return (StgRetInfoTable *)i;}
80 INLINE_HEADER StgThunkInfoTable *itbl_to_thunk_itbl(const StgInfoTable *i) {return (StgThunkInfoTable *)i;}
81 INLINE_HEADER StgConInfoTable *itbl_to_con_itbl(const StgInfoTable *i) {return (StgConInfoTable *)i;}
82 #endif
83
84 EXTERN_INLINE StgInfoTable *get_itbl(const StgClosure *c);
85 EXTERN_INLINE StgInfoTable *get_itbl(const StgClosure *c) {return INFO_PTR_TO_STRUCT(c->header.info);}
86
87 EXTERN_INLINE StgRetInfoTable *get_ret_itbl(const StgClosure *c);
88 EXTERN_INLINE StgRetInfoTable *get_ret_itbl(const StgClosure *c) {return RET_INFO_PTR_TO_STRUCT(c->header.info);}
89
90 INLINE_HEADER StgFunInfoTable *get_fun_itbl(const StgClosure *c) {return FUN_INFO_PTR_TO_STRUCT(c->header.info);}
91
92 INLINE_HEADER StgThunkInfoTable *get_thunk_itbl(const StgClosure *c) {return THUNK_INFO_PTR_TO_STRUCT(c->header.info);}
93
94 INLINE_HEADER StgConInfoTable *get_con_itbl(const StgClosure *c) {return CON_INFO_PTR_TO_STRUCT((c)->header.info);}
95
96 INLINE_HEADER StgHalfWord GET_TAG(const StgClosure *con) {
97 return get_itbl(con)->srt_bitmap;
98 }
99
100 /* -----------------------------------------------------------------------------
101 Macros for building closures
102 -------------------------------------------------------------------------- */
103
104 #ifdef PROFILING
105 #ifdef DEBUG_RETAINER
106 /*
107 For the sake of debugging, we take the safest way for the moment. Actually, this
108 is useful to check the sanity of heap before beginning retainer profiling.
109 flip is defined in RetainerProfile.c, and declared as extern in RetainerProfile.h.
110 Note: change those functions building Haskell objects from C datatypes, i.e.,
111 all rts_mk???() functions in RtsAPI.c, as well.
112 */
113 #define SET_PROF_HDR(c,ccs_) \
114 ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip))
115 #else
116 /*
117 For retainer profiling only: we do not have to set (c)->header.prof.hp.rs to
118 NULL | flip (flip is defined in RetainerProfile.c) because even when flip
119 is 1, rs is invalid and will be initialized to NULL | flip later when
120 the closure *c is visited.
121 */
122 /*
123 #define SET_PROF_HDR(c,ccs_) \
124 ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = NULL)
125 */
126 /*
127 The following macro works for both retainer profiling and LDV profiling:
128 for retainer profiling, ldvTime remains 0, so rs fields are initialized to 0.
129 See the invariants on ldvTime.
130 */
131 #define SET_PROF_HDR(c,ccs_) \
132 ((c)->header.prof.ccs = ccs_, \
133 LDV_RECORD_CREATE((c)))
134 #endif /* DEBUG_RETAINER */
135 #else
136 #define SET_PROF_HDR(c,ccs)
137 #endif
138
139 #define SET_HDR(c,_info,ccs) \
140 { \
141 (c)->header.info = _info; \
142 SET_PROF_HDR((StgClosure *)(c),ccs); \
143 }
144
145 #define SET_ARR_HDR(c,info,costCentreStack,n_bytes) \
146 SET_HDR(c,info,costCentreStack); \
147 (c)->bytes = n_bytes;
148
149 // Use when changing a closure from one kind to another
150 #define OVERWRITE_INFO(c, new_info) \
151 OVERWRITING_CLOSURE((StgClosure *)(c)); \
152 SET_INFO((StgClosure *)(c), (new_info)); \
153 LDV_RECORD_CREATE(c);
154
155 /* -----------------------------------------------------------------------------
156 How to get hold of the static link field for a static closure.
157 -------------------------------------------------------------------------- */
158
159 /* These are hard-coded. */
160 #define FUN_STATIC_LINK(p) (&(p)->payload[0])
161 #define THUNK_STATIC_LINK(p) (&(p)->payload[1])
162 #define IND_STATIC_LINK(p) (&(p)->payload[1])
163
164 INLINE_HEADER StgClosure **
165 STATIC_LINK(const StgInfoTable *info, StgClosure *p)
166 {
167 switch (info->type) {
168 case THUNK_STATIC:
169 return THUNK_STATIC_LINK(p);
170 case FUN_STATIC:
171 return FUN_STATIC_LINK(p);
172 case IND_STATIC:
173 return IND_STATIC_LINK(p);
174 default:
175 return &(p)->payload[info->layout.payload.ptrs +
176 info->layout.payload.nptrs];
177 }
178 }
179
180 INLINE_HEADER StgClosure *STATIC_LINK2(const StgInfoTable *info,
181 StgClosure *p) {
182 return (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs +
183 info->layout.payload.nptrs + 1])));
184 }
185
186 /* -----------------------------------------------------------------------------
187 INTLIKE and CHARLIKE closures.
188 -------------------------------------------------------------------------- */
189
190 INLINE_HEADER P_ CHARLIKE_CLOSURE(int n) {
191 return (P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE];
192 }
193 INLINE_HEADER P_ INTLIKE_CLOSURE(int n) {
194 return (P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE];
195 }
196
197 /* ----------------------------------------------------------------------------
198 Macros for untagging and retagging closure pointers
199 For more information look at the comments in Cmm.h
200 ------------------------------------------------------------------------- */
201
202 static inline StgWord
203 GET_CLOSURE_TAG(StgClosure * p)
204 {
205 return (StgWord)p & TAG_MASK;
206 }
207
208 static inline StgClosure *
209 UNTAG_CLOSURE(StgClosure * p)
210 {
211 return (StgClosure*)((StgWord)p & ~TAG_MASK);
212 }
213
214 static inline StgClosure *
215 TAG_CLOSURE(StgWord tag,StgClosure * p)
216 {
217 return (StgClosure*)((StgWord)p | tag);
218 }
219
220 /* -----------------------------------------------------------------------------
221 Forwarding pointers
222 -------------------------------------------------------------------------- */
223
224 #define IS_FORWARDING_PTR(p) ((((StgWord)p) & 1) != 0)
225 #define MK_FORWARDING_PTR(p) (((StgWord)p) | 1)
226 #define UN_FORWARDING_PTR(p) (((StgWord)p) - 1)
227
228 /* -----------------------------------------------------------------------------
229 DEBUGGING predicates for pointers
230
231 LOOKS_LIKE_INFO_PTR(p) returns False if p is definitely not an info ptr
232 LOOKS_LIKE_CLOSURE_PTR(p) returns False if p is definitely not a closure ptr
233
234 These macros are complete but not sound. That is, they might
235 return false positives. Do not rely on them to distinguish info
236 pointers from closure pointers, for example.
237
238 We don't use address-space predicates these days, for portability
239 reasons, and the fact that code/data can be scattered about the
240 address space in a dynamically-linked environment. Our best option
241 is to look at the alleged info table and see whether it seems to
242 make sense...
243 -------------------------------------------------------------------------- */
244
245 INLINE_HEADER rtsBool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p)
246 {
247 StgInfoTable *info = INFO_PTR_TO_STRUCT((StgInfoTable *)p);
248 return info->type != INVALID_OBJECT && info->type < N_CLOSURE_TYPES;
249 }
250
251 INLINE_HEADER rtsBool LOOKS_LIKE_INFO_PTR (StgWord p)
252 {
253 return p && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p));
254 }
255
256 INLINE_HEADER rtsBool LOOKS_LIKE_CLOSURE_PTR (void *p)
257 {
258 return LOOKS_LIKE_INFO_PTR((StgWord)(UNTAG_CLOSURE((StgClosure *)(p)))->header.info);
259 }
260
261 /* -----------------------------------------------------------------------------
262 Macros for calculating the size of a closure
263 -------------------------------------------------------------------------- */
264
265 EXTERN_INLINE StgOffset PAP_sizeW ( nat n_args );
266 EXTERN_INLINE StgOffset PAP_sizeW ( nat n_args )
267 { return sizeofW(StgPAP) + n_args; }
268
269 EXTERN_INLINE StgOffset AP_sizeW ( nat n_args );
270 EXTERN_INLINE StgOffset AP_sizeW ( nat n_args )
271 { return sizeofW(StgAP) + n_args; }
272
273 EXTERN_INLINE StgOffset AP_STACK_sizeW ( nat size );
274 EXTERN_INLINE StgOffset AP_STACK_sizeW ( nat size )
275 { return sizeofW(StgAP_STACK) + size; }
276
277 EXTERN_INLINE StgOffset CONSTR_sizeW( nat p, nat np );
278 EXTERN_INLINE StgOffset CONSTR_sizeW( nat p, nat np )
279 { return sizeofW(StgHeader) + p + np; }
280
281 EXTERN_INLINE StgOffset THUNK_SELECTOR_sizeW ( void );
282 EXTERN_INLINE StgOffset THUNK_SELECTOR_sizeW ( void )
283 { return sizeofW(StgSelector); }
284
285 EXTERN_INLINE StgOffset BLACKHOLE_sizeW ( void );
286 EXTERN_INLINE StgOffset BLACKHOLE_sizeW ( void )
287 { return sizeofW(StgInd); } // a BLACKHOLE is a kind of indirection
288
289 /* --------------------------------------------------------------------------
290 Sizes of closures
291 ------------------------------------------------------------------------*/
292
293 EXTERN_INLINE StgOffset sizeW_fromITBL( const StgInfoTable* itbl );
294 EXTERN_INLINE StgOffset sizeW_fromITBL( const StgInfoTable* itbl )
295 { return sizeofW(StgClosure)
296 + sizeofW(StgPtr) * itbl->layout.payload.ptrs
297 + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
298
299 EXTERN_INLINE StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl );
300 EXTERN_INLINE StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl )
301 { return sizeofW(StgThunk)
302 + sizeofW(StgPtr) * itbl->layout.payload.ptrs
303 + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
304
305 EXTERN_INLINE StgOffset ap_stack_sizeW( StgAP_STACK* x );
306 EXTERN_INLINE StgOffset ap_stack_sizeW( StgAP_STACK* x )
307 { return AP_STACK_sizeW(x->size); }
308
309 EXTERN_INLINE StgOffset ap_sizeW( StgAP* x );
310 EXTERN_INLINE StgOffset ap_sizeW( StgAP* x )
311 { return AP_sizeW(x->n_args); }
312
313 EXTERN_INLINE StgOffset pap_sizeW( StgPAP* x );
314 EXTERN_INLINE StgOffset pap_sizeW( StgPAP* x )
315 { return PAP_sizeW(x->n_args); }
316
317 EXTERN_INLINE StgWord arr_words_words( StgArrWords* x);
318 EXTERN_INLINE StgWord arr_words_words( StgArrWords* x)
319 { return ROUNDUP_BYTES_TO_WDS(x->bytes); }
320
321 EXTERN_INLINE StgOffset arr_words_sizeW( StgArrWords* x );
322 EXTERN_INLINE StgOffset arr_words_sizeW( StgArrWords* x )
323 { return sizeofW(StgArrWords) + arr_words_words(x); }
324
325 EXTERN_INLINE StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x );
326 EXTERN_INLINE StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
327 { return sizeofW(StgMutArrPtrs) + x->size; }
328
329 EXTERN_INLINE StgWord stack_sizeW ( StgStack *stack );
330 EXTERN_INLINE StgWord stack_sizeW ( StgStack *stack )
331 { return sizeofW(StgStack) + stack->stack_size; }
332
333 EXTERN_INLINE StgWord bco_sizeW ( StgBCO *bco );
334 EXTERN_INLINE StgWord bco_sizeW ( StgBCO *bco )
335 { return bco->size; }
336
337 EXTERN_INLINE nat closure_sizeW_ (StgClosure *p, StgInfoTable *info);
338 EXTERN_INLINE nat
339 closure_sizeW_ (StgClosure *p, StgInfoTable *info)
340 {
341 switch (info->type) {
342 case THUNK_0_1:
343 case THUNK_1_0:
344 return sizeofW(StgThunk) + 1;
345 case FUN_0_1:
346 case CONSTR_0_1:
347 case FUN_1_0:
348 case CONSTR_1_0:
349 return sizeofW(StgHeader) + 1;
350 case THUNK_0_2:
351 case THUNK_1_1:
352 case THUNK_2_0:
353 return sizeofW(StgThunk) + 2;
354 case FUN_0_2:
355 case CONSTR_0_2:
356 case FUN_1_1:
357 case CONSTR_1_1:
358 case FUN_2_0:
359 case CONSTR_2_0:
360 return sizeofW(StgHeader) + 2;
361 case THUNK:
362 return thunk_sizeW_fromITBL(info);
363 case THUNK_SELECTOR:
364 return THUNK_SELECTOR_sizeW();
365 case AP_STACK:
366 return ap_stack_sizeW((StgAP_STACK *)p);
367 case AP:
368 return ap_sizeW((StgAP *)p);
369 case PAP:
370 return pap_sizeW((StgPAP *)p);
371 case IND:
372 case IND_PERM:
373 return sizeofW(StgInd);
374 case ARR_WORDS:
375 return arr_words_sizeW((StgArrWords *)p);
376 case MUT_ARR_PTRS_CLEAN:
377 case MUT_ARR_PTRS_DIRTY:
378 case MUT_ARR_PTRS_FROZEN:
379 case MUT_ARR_PTRS_FROZEN0:
380 return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
381 case TSO:
382 return sizeofW(StgTSO);
383 case STACK:
384 return stack_sizeW((StgStack*)p);
385 case BCO:
386 return bco_sizeW((StgBCO *)p);
387 case TREC_CHUNK:
388 return sizeofW(StgTRecChunk);
389 default:
390 return sizeW_fromITBL(info);
391 }
392 }
393
394 // The definitive way to find the size, in words, of a heap-allocated closure
395 EXTERN_INLINE nat closure_sizeW (StgClosure *p);
396 EXTERN_INLINE nat closure_sizeW (StgClosure *p)
397 {
398 return closure_sizeW_(p, get_itbl(p));
399 }
400
401 /* -----------------------------------------------------------------------------
402 Sizes of stack frames
403 -------------------------------------------------------------------------- */
404
405 EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame );
406 EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame )
407 {
408 StgRetInfoTable *info;
409
410 info = get_ret_itbl(frame);
411 switch (info->i.type) {
412
413 case RET_FUN:
414 return sizeofW(StgRetFun) + ((StgRetFun *)frame)->size;
415
416 case RET_BIG:
417 return 1 + GET_LARGE_BITMAP(&info->i)->size;
418
419 case RET_BCO:
420 return 2 + BCO_BITMAP_SIZE((StgBCO *)((P_)frame)[1]);
421
422 default:
423 return 1 + BITMAP_SIZE(info->i.layout.bitmap);
424 }
425 }
426
427 /* -----------------------------------------------------------------------------
428 StgMutArrPtrs macros
429
430 An StgMutArrPtrs has a card table to indicate which elements are
431 dirty for the generational GC. The card table is an array of
432 bytes, where each byte covers (1 << MUT_ARR_PTRS_CARD_BITS)
433 elements. The card table is directly after the array data itself.
434 -------------------------------------------------------------------------- */
435
436 // The number of card bytes needed
437 INLINE_HEADER W_ mutArrPtrsCards (W_ elems)
438 {
439 return (W_)((elems + (1 << MUT_ARR_PTRS_CARD_BITS) - 1)
440 >> MUT_ARR_PTRS_CARD_BITS);
441 }
442
443 // The number of words in the card table
444 INLINE_HEADER W_ mutArrPtrsCardTableSize (W_ elems)
445 {
446 return ROUNDUP_BYTES_TO_WDS(mutArrPtrsCards(elems));
447 }
448
449 // The address of the card for a particular card number
450 INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, W_ n)
451 {
452 return ((StgWord8 *)&(a->payload[a->ptrs]) + n);
453 }
454
455 /* -----------------------------------------------------------------------------
456 Replacing a closure with a different one. We must call
457 OVERWRITING_CLOSURE(p) on the old closure that is about to be
458 overwritten.
459
460 In PROFILING mode, LDV profiling requires that we fill the slop
461 with zeroes, and record the old closure as dead (LDV_recordDead()).
462
463 In DEBUG mode, we must overwrite the slop with zeroes, because the
464 sanity checker wants to walk through the heap checking all the
465 pointers.
466
467 In multicore mode, we *cannot* overwrite slop with zeroes, because
468 another thread might be reading it. So,
469
470 LDV PROFILING is not compatible with +RTS -N<n> (for n > 1)
471
472 THREADED_RTS can be used with DEBUG, but full heap sanity
473 checking is disabled except after major GC.
474
475 -------------------------------------------------------------------------- */
476
477 #if defined(PROFILING) || (!defined(THREADED_RTS) && defined(DEBUG))
478 #define OVERWRITING_CLOSURE(c) overwritingClosure(c)
479 #else
480 #define OVERWRITING_CLOSURE(c) /* nothing */
481 #endif
482
483 #ifdef PROFILING
484 void LDV_recordDead (StgClosure *c, nat size);
485 #endif
486
487 EXTERN_INLINE void overwritingClosure (StgClosure *p);
488 EXTERN_INLINE void overwritingClosure (StgClosure *p)
489 {
490 nat size, i;
491
492 #if defined(PROFILING)
493 if (era <= 0) return;
494 #endif
495
496 size = closure_sizeW(p);
497
498 // For LDV profiling, we need to record the closure as dead
499 #if defined(PROFILING)
500 LDV_recordDead(p, size);
501 #endif
502
503 for (i = 0; i < size - sizeofW(StgThunkHeader); i++) {
504 ((StgThunk *)(p))->payload[i] = 0;
505 }
506 }
507
508 #endif /* RTS_STORAGE_CLOSUREMACROS_H */