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