rts: More const correct-ness fixes
[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 rtsBool 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) ? rtsTrue : rtsFalse;
265 }
266
267 INLINE_HEADER rtsBool LOOKS_LIKE_INFO_PTR (StgWord p)
268 {
269 return (p && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p))) ? rtsTrue : rtsFalse;
270 }
271
272 INLINE_HEADER rtsBool 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 /*
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 #define ZERO_SLOP_FOR_LDV_PROF (defined(PROFILING))
520 #define ZERO_SLOP_FOR_SANITY_CHECK (defined(DEBUG) && !defined(THREADED_RTS))
521
522 #if ZERO_SLOP_FOR_LDV_PROF || ZERO_SLOP_FOR_SANITY_CHECK
523 #define OVERWRITING_CLOSURE(c) overwritingClosure(c)
524 #define OVERWRITING_CLOSURE_OFS(c,n) \
525 overwritingClosureOfs(c,n)
526 #else
527 #define OVERWRITING_CLOSURE(c) /* nothing */
528 #define OVERWRITING_CLOSURE_OFS(c,n) /* nothing */
529 #endif
530
531 #ifdef PROFILING
532 void LDV_recordDead (const StgClosure *c, uint32_t size);
533 #endif
534
535 EXTERN_INLINE void overwritingClosure (StgClosure *p);
536 EXTERN_INLINE void overwritingClosure (StgClosure *p)
537 {
538 uint32_t size, i;
539
540 #if ZERO_SLOP_FOR_LDV_PROF && !ZERO_SLOP_FOR_SANITY_CHECK
541 // see Note [zeroing slop], also #8402
542 if (era <= 0) return;
543 #endif
544
545 size = closure_sizeW(p);
546
547 // For LDV profiling, we need to record the closure as dead
548 #if defined(PROFILING)
549 LDV_recordDead(p, size);
550 #endif
551
552 for (i = 0; i < size - sizeofW(StgThunkHeader); i++) {
553 ((StgThunk *)(p))->payload[i] = 0;
554 }
555 }
556
557 // Version of 'overwritingClosure' which overwrites only a suffix of a
558 // closure. The offset is expressed in words relative to 'p' and shall
559 // be less than or equal to closure_sizeW(p), and usually at least as
560 // large as the respective thunk header.
561 //
562 // Note: As this calls LDV_recordDead() you have to call LDV_RECORD()
563 // on the final state of the closure at the call-site
564 EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, uint32_t offset);
565 EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, uint32_t offset)
566 {
567 uint32_t size, i;
568
569 #if ZERO_SLOP_FOR_LDV_PROF && !ZERO_SLOP_FOR_SANITY_CHECK
570 // see Note [zeroing slop], also #8402
571 if (era <= 0) return;
572 #endif
573
574 size = closure_sizeW(p);
575
576 ASSERT(offset <= size);
577
578 // For LDV profiling, we need to record the closure as dead
579 #if defined(PROFILING)
580 LDV_recordDead(p, size);
581 #endif
582
583 for (i = offset; i < size; i++)
584 ((StgWord *)p)[i] = 0;
585 }
586
587 #endif /* RTS_STORAGE_CLOSUREMACROS_H */