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