c8c270fdfe9eb2f8b4193d14523ee3877f84cb54
[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 const StgInfoTable *get_itbl(const StgClosure *c);
85 EXTERN_INLINE const StgInfoTable *get_itbl(const StgClosure *c)
86 {
87 return INFO_PTR_TO_STRUCT(c->header.info);
88 }
89
90 EXTERN_INLINE const StgRetInfoTable *get_ret_itbl(const StgClosure *c);
91 EXTERN_INLINE const StgRetInfoTable *get_ret_itbl(const StgClosure *c)
92 {
93 return RET_INFO_PTR_TO_STRUCT(c->header.info);
94 }
95
96 INLINE_HEADER const StgFunInfoTable *get_fun_itbl(const StgClosure *c)
97 {
98 return FUN_INFO_PTR_TO_STRUCT(c->header.info);
99 }
100
101 INLINE_HEADER const StgThunkInfoTable *get_thunk_itbl(const StgClosure *c)
102 {
103 return THUNK_INFO_PTR_TO_STRUCT(c->header.info);
104 }
105
106 INLINE_HEADER const StgConInfoTable *get_con_itbl(const StgClosure *c)
107 {
108 return CON_INFO_PTR_TO_STRUCT((c)->header.info);
109 }
110
111 INLINE_HEADER StgHalfWord GET_TAG(const StgClosure *con)
112 {
113 return get_itbl(con)->srt_bitmap;
114 }
115
116 /* -----------------------------------------------------------------------------
117 Macros for building closures
118 -------------------------------------------------------------------------- */
119
120 #ifdef PROFILING
121 #ifdef DEBUG_RETAINER
122 /*
123 For the sake of debugging, we take the safest way for the moment. Actually, this
124 is useful to check the sanity of heap before beginning retainer profiling.
125 flip is defined in RetainerProfile.c, and declared as extern in RetainerProfile.h.
126 Note: change those functions building Haskell objects from C datatypes, i.e.,
127 all rts_mk???() functions in RtsAPI.c, as well.
128 */
129 #define SET_PROF_HDR(c,ccs_) \
130 ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip))
131 #else
132 /*
133 For retainer profiling only: we do not have to set (c)->header.prof.hp.rs to
134 NULL | flip (flip is defined in RetainerProfile.c) because even when flip
135 is 1, rs is invalid and will be initialized to NULL | flip later when
136 the closure *c is visited.
137 */
138 /*
139 #define SET_PROF_HDR(c,ccs_) \
140 ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = NULL)
141 */
142 /*
143 The following macro works for both retainer profiling and LDV profiling:
144 for retainer profiling, ldvTime remains 0, so rs fields are initialized to 0.
145 See the invariants on ldvTime.
146 */
147 #define SET_PROF_HDR(c,ccs_) \
148 ((c)->header.prof.ccs = ccs_, \
149 LDV_RECORD_CREATE((c)))
150 #endif /* DEBUG_RETAINER */
151 #else
152 #define SET_PROF_HDR(c,ccs)
153 #endif
154
155 #define SET_HDR(c,_info,ccs) \
156 { \
157 (c)->header.info = _info; \
158 SET_PROF_HDR((StgClosure *)(c),ccs); \
159 }
160
161 #define SET_ARR_HDR(c,info,costCentreStack,n_bytes) \
162 SET_HDR(c,info,costCentreStack); \
163 (c)->bytes = n_bytes;
164
165 // Use when changing a closure from one kind to another
166 #define OVERWRITE_INFO(c, new_info) \
167 OVERWRITING_CLOSURE((StgClosure *)(c)); \
168 SET_INFO((StgClosure *)(c), (new_info)); \
169 LDV_RECORD_CREATE(c);
170
171 /* -----------------------------------------------------------------------------
172 How to get hold of the static link field for a static closure.
173 -------------------------------------------------------------------------- */
174
175 /* These are hard-coded. */
176 #define FUN_STATIC_LINK(p) (&(p)->payload[0])
177 #define THUNK_STATIC_LINK(p) (&(p)->payload[1])
178 #define IND_STATIC_LINK(p) (&(p)->payload[1])
179
180 INLINE_HEADER StgClosure **
181 STATIC_LINK(const StgInfoTable *info, StgClosure *p)
182 {
183 switch (info->type) {
184 case THUNK_STATIC:
185 return THUNK_STATIC_LINK(p);
186 case FUN_STATIC:
187 return FUN_STATIC_LINK(p);
188 case IND_STATIC:
189 return IND_STATIC_LINK(p);
190 default:
191 return &(p)->payload[info->layout.payload.ptrs +
192 info->layout.payload.nptrs];
193 }
194 }
195
196 /* -----------------------------------------------------------------------------
197 INTLIKE and CHARLIKE closures.
198 -------------------------------------------------------------------------- */
199
200 INLINE_HEADER P_ CHARLIKE_CLOSURE(int n) {
201 return (P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE];
202 }
203 INLINE_HEADER P_ INTLIKE_CLOSURE(int n) {
204 return (P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE];
205 }
206
207 /* ----------------------------------------------------------------------------
208 Macros for untagging and retagging closure pointers
209 For more information look at the comments in Cmm.h
210 ------------------------------------------------------------------------- */
211
212 static inline StgWord
213 GET_CLOSURE_TAG(const StgClosure * p)
214 {
215 return (StgWord)p & TAG_MASK;
216 }
217
218 static inline StgClosure *
219 UNTAG_CLOSURE(StgClosure * p)
220 {
221 return (StgClosure*)((StgWord)p & ~TAG_MASK);
222 }
223
224 static inline const StgClosure *
225 UNTAG_CONST_CLOSURE(const StgClosure * p)
226 {
227 return (const StgClosure*)((StgWord)p & ~TAG_MASK);
228 }
229
230 static inline StgClosure *
231 TAG_CLOSURE(StgWord tag,StgClosure * p)
232 {
233 return (StgClosure*)((StgWord)p | tag);
234 }
235
236 /* -----------------------------------------------------------------------------
237 Forwarding pointers
238 -------------------------------------------------------------------------- */
239
240 #define IS_FORWARDING_PTR(p) ((((StgWord)p) & 1) != 0)
241 #define MK_FORWARDING_PTR(p) (((StgWord)p) | 1)
242 #define UN_FORWARDING_PTR(p) (((StgWord)p) - 1)
243
244 /* -----------------------------------------------------------------------------
245 DEBUGGING predicates for pointers
246
247 LOOKS_LIKE_INFO_PTR(p) returns False if p is definitely not an info ptr
248 LOOKS_LIKE_CLOSURE_PTR(p) returns False if p is definitely not a closure ptr
249
250 These macros are complete but not sound. That is, they might
251 return false positives. Do not rely on them to distinguish info
252 pointers from closure pointers, for example.
253
254 We don't use address-space predicates these days, for portability
255 reasons, and the fact that code/data can be scattered about the
256 address space in a dynamically-linked environment. Our best option
257 is to look at the alleged info table and see whether it seems to
258 make sense...
259 -------------------------------------------------------------------------- */
260
261 INLINE_HEADER bool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p)
262 {
263 StgInfoTable *info = INFO_PTR_TO_STRUCT((StgInfoTable *)p);
264 return info->type != INVALID_OBJECT && info->type < N_CLOSURE_TYPES;
265 }
266
267 INLINE_HEADER bool LOOKS_LIKE_INFO_PTR (StgWord p)
268 {
269 return p && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p));
270 }
271
272 INLINE_HEADER bool LOOKS_LIKE_CLOSURE_PTR (const void *p)
273 {
274 return LOOKS_LIKE_INFO_PTR((StgWord)
275 (UNTAG_CONST_CLOSURE((const StgClosure *)(p)))->header.info);
276 }
277
278 /* -----------------------------------------------------------------------------
279 Macros for calculating the size of a closure
280 -------------------------------------------------------------------------- */
281
282 EXTERN_INLINE StgOffset PAP_sizeW ( uint32_t n_args );
283 EXTERN_INLINE StgOffset PAP_sizeW ( uint32_t n_args )
284 { return sizeofW(StgPAP) + n_args; }
285
286 EXTERN_INLINE StgOffset AP_sizeW ( uint32_t n_args );
287 EXTERN_INLINE StgOffset AP_sizeW ( uint32_t n_args )
288 { return sizeofW(StgAP) + n_args; }
289
290 EXTERN_INLINE StgOffset AP_STACK_sizeW ( uint32_t size );
291 EXTERN_INLINE StgOffset AP_STACK_sizeW ( uint32_t size )
292 { return sizeofW(StgAP_STACK) + size; }
293
294 EXTERN_INLINE StgOffset CONSTR_sizeW( uint32_t p, uint32_t np );
295 EXTERN_INLINE StgOffset CONSTR_sizeW( uint32_t p, uint32_t np )
296 { return sizeofW(StgHeader) + p + np; }
297
298 EXTERN_INLINE StgOffset THUNK_SELECTOR_sizeW ( void );
299 EXTERN_INLINE StgOffset THUNK_SELECTOR_sizeW ( void )
300 { return sizeofW(StgSelector); }
301
302 EXTERN_INLINE StgOffset BLACKHOLE_sizeW ( void );
303 EXTERN_INLINE StgOffset BLACKHOLE_sizeW ( void )
304 { return sizeofW(StgInd); } // a BLACKHOLE is a kind of indirection
305
306 /* --------------------------------------------------------------------------
307 Sizes of closures
308 ------------------------------------------------------------------------*/
309
310 EXTERN_INLINE StgOffset sizeW_fromITBL( const StgInfoTable* itbl );
311 EXTERN_INLINE StgOffset sizeW_fromITBL( const StgInfoTable* itbl )
312 { return sizeofW(StgClosure)
313 + sizeofW(StgPtr) * itbl->layout.payload.ptrs
314 + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
315
316 EXTERN_INLINE StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl );
317 EXTERN_INLINE StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl )
318 { return sizeofW(StgThunk)
319 + sizeofW(StgPtr) * itbl->layout.payload.ptrs
320 + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
321
322 EXTERN_INLINE StgOffset ap_stack_sizeW( StgAP_STACK* x );
323 EXTERN_INLINE StgOffset ap_stack_sizeW( StgAP_STACK* x )
324 { return AP_STACK_sizeW(x->size); }
325
326 EXTERN_INLINE StgOffset ap_sizeW( StgAP* x );
327 EXTERN_INLINE StgOffset ap_sizeW( StgAP* x )
328 { return AP_sizeW(x->n_args); }
329
330 EXTERN_INLINE StgOffset pap_sizeW( StgPAP* x );
331 EXTERN_INLINE StgOffset pap_sizeW( StgPAP* x )
332 { return PAP_sizeW(x->n_args); }
333
334 EXTERN_INLINE StgWord arr_words_words( StgArrBytes* x);
335 EXTERN_INLINE StgWord arr_words_words( StgArrBytes* x)
336 { return ROUNDUP_BYTES_TO_WDS(x->bytes); }
337
338 EXTERN_INLINE StgOffset arr_words_sizeW( StgArrBytes* x );
339 EXTERN_INLINE StgOffset arr_words_sizeW( StgArrBytes* x )
340 { return sizeofW(StgArrBytes) + arr_words_words(x); }
341
342 EXTERN_INLINE StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x );
343 EXTERN_INLINE StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
344 { return sizeofW(StgMutArrPtrs) + x->size; }
345
346 EXTERN_INLINE StgOffset small_mut_arr_ptrs_sizeW( StgSmallMutArrPtrs* x );
347 EXTERN_INLINE StgOffset small_mut_arr_ptrs_sizeW( StgSmallMutArrPtrs* x )
348 { return sizeofW(StgSmallMutArrPtrs) + x->ptrs; }
349
350 EXTERN_INLINE StgWord stack_sizeW ( StgStack *stack );
351 EXTERN_INLINE StgWord stack_sizeW ( StgStack *stack )
352 { return sizeofW(StgStack) + stack->stack_size; }
353
354 EXTERN_INLINE StgWord bco_sizeW ( StgBCO *bco );
355 EXTERN_INLINE StgWord bco_sizeW ( StgBCO *bco )
356 { return bco->size; }
357
358 EXTERN_INLINE StgWord compact_nfdata_full_sizeW ( StgCompactNFData *str );
359 EXTERN_INLINE StgWord compact_nfdata_full_sizeW ( StgCompactNFData *str )
360 { return str->totalW; }
361
362 /*
363 * TODO: Consider to switch return type from 'uint32_t' to 'StgWord' #8742
364 *
365 * (Also for 'closure_sizeW' below)
366 */
367 EXTERN_INLINE uint32_t
368 closure_sizeW_ (const StgClosure *p, const StgInfoTable *info);
369 EXTERN_INLINE uint32_t
370 closure_sizeW_ (const StgClosure *p, const StgInfoTable *info)
371 {
372 switch (info->type) {
373 case THUNK_0_1:
374 case THUNK_1_0:
375 return sizeofW(StgThunk) + 1;
376 case FUN_0_1:
377 case CONSTR_0_1:
378 case FUN_1_0:
379 case CONSTR_1_0:
380 return sizeofW(StgHeader) + 1;
381 case THUNK_0_2:
382 case THUNK_1_1:
383 case THUNK_2_0:
384 return sizeofW(StgThunk) + 2;
385 case FUN_0_2:
386 case CONSTR_0_2:
387 case FUN_1_1:
388 case CONSTR_1_1:
389 case FUN_2_0:
390 case CONSTR_2_0:
391 return sizeofW(StgHeader) + 2;
392 case THUNK:
393 return thunk_sizeW_fromITBL(info);
394 case THUNK_SELECTOR:
395 return THUNK_SELECTOR_sizeW();
396 case AP_STACK:
397 return ap_stack_sizeW((StgAP_STACK *)p);
398 case AP:
399 return ap_sizeW((StgAP *)p);
400 case PAP:
401 return pap_sizeW((StgPAP *)p);
402 case IND:
403 return sizeofW(StgInd);
404 case ARR_WORDS:
405 return arr_words_sizeW((StgArrBytes *)p);
406 case MUT_ARR_PTRS_CLEAN:
407 case MUT_ARR_PTRS_DIRTY:
408 case MUT_ARR_PTRS_FROZEN:
409 case MUT_ARR_PTRS_FROZEN0:
410 return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
411 case SMALL_MUT_ARR_PTRS_CLEAN:
412 case SMALL_MUT_ARR_PTRS_DIRTY:
413 case SMALL_MUT_ARR_PTRS_FROZEN:
414 case SMALL_MUT_ARR_PTRS_FROZEN0:
415 return small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs*)p);
416 case TSO:
417 return sizeofW(StgTSO);
418 case STACK:
419 return stack_sizeW((StgStack*)p);
420 case BCO:
421 return bco_sizeW((StgBCO *)p);
422 case TREC_CHUNK:
423 return sizeofW(StgTRecChunk);
424 default:
425 return sizeW_fromITBL(info);
426 }
427 }
428
429 // The definitive way to find the size, in words, of a heap-allocated closure
430 EXTERN_INLINE uint32_t closure_sizeW (const StgClosure *p);
431 EXTERN_INLINE uint32_t closure_sizeW (const StgClosure *p)
432 {
433 return closure_sizeW_(p, get_itbl(p));
434 }
435
436 /* -----------------------------------------------------------------------------
437 Sizes of stack frames
438 -------------------------------------------------------------------------- */
439
440 EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame );
441 EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame )
442 {
443 const StgRetInfoTable *info;
444
445 info = get_ret_itbl(frame);
446 switch (info->i.type) {
447
448 case RET_FUN:
449 return sizeofW(StgRetFun) + ((StgRetFun *)frame)->size;
450
451 case RET_BIG:
452 return 1 + GET_LARGE_BITMAP(&info->i)->size;
453
454 case RET_BCO:
455 return 2 + BCO_BITMAP_SIZE((StgBCO *)((P_)frame)[1]);
456
457 default:
458 return 1 + BITMAP_SIZE(info->i.layout.bitmap);
459 }
460 }
461
462 /* -----------------------------------------------------------------------------
463 StgMutArrPtrs macros
464
465 An StgMutArrPtrs has a card table to indicate which elements are
466 dirty for the generational GC. The card table is an array of
467 bytes, where each byte covers (1 << MUT_ARR_PTRS_CARD_BITS)
468 elements. The card table is directly after the array data itself.
469 -------------------------------------------------------------------------- */
470
471 // The number of card bytes needed
472 INLINE_HEADER W_ mutArrPtrsCards (W_ elems)
473 {
474 return (W_)((elems + (1 << MUT_ARR_PTRS_CARD_BITS) - 1)
475 >> MUT_ARR_PTRS_CARD_BITS);
476 }
477
478 // The number of words in the card table
479 INLINE_HEADER W_ mutArrPtrsCardTableSize (W_ elems)
480 {
481 return ROUNDUP_BYTES_TO_WDS(mutArrPtrsCards(elems));
482 }
483
484 // The address of the card for a particular card number
485 INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, W_ n)
486 {
487 return ((StgWord8 *)&(a->payload[a->ptrs]) + n);
488 }
489
490 /* -----------------------------------------------------------------------------
491 Replacing a closure with a different one. We must call
492 OVERWRITING_CLOSURE(p) on the old closure that is about to be
493 overwritten.
494
495 Note [zeroing slop]
496
497 In some scenarios we write zero words into "slop"; memory that is
498 left unoccupied after we overwrite a closure in the heap with a
499 smaller closure.
500
501 Zeroing slop is required for:
502
503 - full-heap sanity checks (DEBUG, and +RTS -DS)
504 - LDV profiling (PROFILING, and +RTS -hb)
505
506 Zeroing slop must be disabled for:
507
508 - THREADED_RTS with +RTS -N2 and greater, because we cannot
509 overwrite slop when another thread might be reading it.
510
511 Hence, slop is zeroed when either:
512
513 - PROFILING && era <= 0 (LDV is on)
514 - !THREADED_RTS && DEBUG
515
516 And additionally:
517
518 - LDV profiling and +RTS -N2 are incompatible
519 - full-heap sanity checks are disabled for THREADED_RTS
520
521 -------------------------------------------------------------------------- */
522
523 #if defined(PROFILING)
524 #define ZERO_SLOP_FOR_LDV_PROF 1
525 #else
526 #define ZERO_SLOP_FOR_LDV_PROF 0
527 #endif
528
529 #if defined(DEBUG) && !defined(THREADED_RTS)
530 #define ZERO_SLOP_FOR_SANITY_CHECK 1
531 #else
532 #define ZERO_SLOP_FOR_SANITY_CHECK 0
533 #endif
534
535 #if ZERO_SLOP_FOR_LDV_PROF || ZERO_SLOP_FOR_SANITY_CHECK
536 #define OVERWRITING_CLOSURE(c) overwritingClosure(c)
537 #define OVERWRITING_CLOSURE_OFS(c,n) \
538 overwritingClosureOfs(c,n)
539 #else
540 #define OVERWRITING_CLOSURE(c) /* nothing */
541 #define OVERWRITING_CLOSURE_OFS(c,n) /* nothing */
542 #endif
543
544 #ifdef PROFILING
545 void LDV_recordDead (const StgClosure *c, uint32_t size);
546 #endif
547
548 EXTERN_INLINE void overwritingClosure (StgClosure *p);
549 EXTERN_INLINE void overwritingClosure (StgClosure *p)
550 {
551 uint32_t size, i;
552
553 #if ZERO_SLOP_FOR_LDV_PROF && !ZERO_SLOP_FOR_SANITY_CHECK
554 // see Note [zeroing slop], also #8402
555 if (era <= 0) return;
556 #endif
557
558 size = closure_sizeW(p);
559
560 // For LDV profiling, we need to record the closure as dead
561 #if defined(PROFILING)
562 LDV_recordDead(p, size);
563 #endif
564
565 for (i = 0; i < size - sizeofW(StgThunkHeader); i++) {
566 ((StgThunk *)(p))->payload[i] = 0;
567 }
568 }
569
570 // Version of 'overwritingClosure' which overwrites only a suffix of a
571 // closure. The offset is expressed in words relative to 'p' and shall
572 // be less than or equal to closure_sizeW(p), and usually at least as
573 // large as the respective thunk header.
574 //
575 // Note: As this calls LDV_recordDead() you have to call LDV_RECORD()
576 // on the final state of the closure at the call-site
577 EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, uint32_t offset);
578 EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, uint32_t offset)
579 {
580 uint32_t size, i;
581
582 #if ZERO_SLOP_FOR_LDV_PROF && !ZERO_SLOP_FOR_SANITY_CHECK
583 // see Note [zeroing slop], also #8402
584 if (era <= 0) return;
585 #endif
586
587 size = closure_sizeW(p);
588
589 ASSERT(offset <= size);
590
591 // For LDV profiling, we need to record the closure as dead
592 #if defined(PROFILING)
593 LDV_recordDead(p, size);
594 #endif
595
596 for (i = offset; i < size; i++)
597 ((StgWord *)p)[i] = 0;
598 }
599
600 #endif /* RTS_STORAGE_CLOSUREMACROS_H */