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