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