ClosureMacros.h 22.8 KB
Newer Older
Simon Marlow's avatar
Simon Marlow committed
1 2
/* ----------------------------------------------------------------------------
 *
Gabor Greif's avatar
typo  
Gabor Greif committed
3
 * (c) The GHC Team, 1998-2012
Simon Marlow's avatar
Simon Marlow committed
4 5 6 7 8
 *
 * Macros for building and manipulating closures
 *
 * -------------------------------------------------------------------------- */

9
#pragma once
Simon Marlow's avatar
Simon Marlow committed
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26

/* -----------------------------------------------------------------------------
   Info tables are slammed up against the entry code, and the label
   for the info table is at the *end* of the table itself.  This
   inline function adjusts an info pointer to point to the beginning
   of the table, so we can use standard C structure indexing on it.

   Note: this works for SRT info tables as long as you don't want to
   access the SRT, since they are laid out the same with the SRT
   pointer as the first word in the table.

   NOTES ABOUT MANGLED C VS. MINI-INTERPRETER:

   A couple of definitions:

       "info pointer"    The first word of the closure.  Might point
                         to either the end or the beginning of the
27 28 29
                         info table, depending on whether we're using
                         the mini interpreter or not.  GET_INFO(c)
                         retrieves the info pointer of a closure.
Simon Marlow's avatar
Simon Marlow committed
30 31 32

       "info table"      The info table structure associated with a
                         closure.  This is always a pointer to the
33 34 35 36
                         beginning of the structure, so we can
                         use standard C structure indexing to pull out
                         the fields.  get_itbl(c) returns a pointer to
                         the info table for closure c.
Simon Marlow's avatar
Simon Marlow committed
37 38 39

   An address of the form xxxx_info points to the end of the info
   table or the beginning of the info table depending on whether we're
40
   mangling or not respectively.  So,
Simon Marlow's avatar
Simon Marlow committed
41

42
         c->header.info = xxx_info
Simon Marlow's avatar
Simon Marlow committed
43 44

   makes absolute sense, whether mangling or not.
45

Simon Marlow's avatar
Simon Marlow committed
46 47
   -------------------------------------------------------------------------- */

48 49 50 51 52 53
INLINE_HEADER void SET_INFO(StgClosure *c, const StgInfoTable *info) {
    c->header.info = info;
}
INLINE_HEADER const StgInfoTable *GET_INFO(StgClosure *c) {
    return c->header.info;
}
Simon Marlow's avatar
Simon Marlow committed
54

Ben Gamari's avatar
Ben Gamari committed
55
#if defined(TABLES_NEXT_TO_CODE)
56 57 58 59 60 61 62
EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info);
EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgInfoTable *)info - 1;}
EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info);
EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgRetInfoTable *)info - 1;}
INLINE_HEADER StgFunInfoTable *FUN_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgFunInfoTable *)info - 1;}
INLINE_HEADER StgThunkInfoTable *THUNK_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgThunkInfoTable *)info - 1;}
INLINE_HEADER StgConInfoTable *CON_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgConInfoTable *)info - 1;}
63 64 65 66
INLINE_HEADER StgFunInfoTable *itbl_to_fun_itbl(const StgInfoTable *i) {return (StgFunInfoTable *)(i + 1) - 1;}
INLINE_HEADER StgRetInfoTable *itbl_to_ret_itbl(const StgInfoTable *i) {return (StgRetInfoTable *)(i + 1) - 1;}
INLINE_HEADER StgThunkInfoTable *itbl_to_thunk_itbl(const StgInfoTable *i) {return (StgThunkInfoTable *)(i + 1) - 1;}
INLINE_HEADER StgConInfoTable *itbl_to_con_itbl(const StgInfoTable *i) {return (StgConInfoTable *)(i + 1) - 1;}
Simon Marlow's avatar
Simon Marlow committed
67
#else
68 69 70 71
EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info);
EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgInfoTable *)info;}
EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info);
EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgRetInfoTable *)info;}
72
INLINE_HEADER StgFunInfoTable *FUN_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgFunInfoTable *)info;}
73 74
INLINE_HEADER StgThunkInfoTable *THUNK_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgThunkInfoTable *)info;}
INLINE_HEADER StgConInfoTable *CON_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgConInfoTable *)info;}
75 76 77 78
INLINE_HEADER StgFunInfoTable *itbl_to_fun_itbl(const StgInfoTable *i) {return (StgFunInfoTable *)i;}
INLINE_HEADER StgRetInfoTable *itbl_to_ret_itbl(const StgInfoTable *i) {return (StgRetInfoTable *)i;}
INLINE_HEADER StgThunkInfoTable *itbl_to_thunk_itbl(const StgInfoTable *i) {return (StgThunkInfoTable *)i;}
INLINE_HEADER StgConInfoTable *itbl_to_con_itbl(const StgInfoTable *i) {return (StgConInfoTable *)i;}
Simon Marlow's avatar
Simon Marlow committed
79 80
#endif

81 82 83 84 85
EXTERN_INLINE const StgInfoTable *get_itbl(const StgClosure *c);
EXTERN_INLINE const StgInfoTable *get_itbl(const StgClosure *c)
{
   return INFO_PTR_TO_STRUCT(c->header.info);
}
86

87 88 89 90 91
EXTERN_INLINE const StgRetInfoTable *get_ret_itbl(const StgClosure *c);
EXTERN_INLINE const StgRetInfoTable *get_ret_itbl(const StgClosure *c)
{
   return RET_INFO_PTR_TO_STRUCT(c->header.info);
}
92

93 94 95 96
INLINE_HEADER const StgFunInfoTable *get_fun_itbl(const StgClosure *c)
{
   return FUN_INFO_PTR_TO_STRUCT(c->header.info);
}
97

98 99 100 101
INLINE_HEADER const StgThunkInfoTable *get_thunk_itbl(const StgClosure *c)
{
   return THUNK_INFO_PTR_TO_STRUCT(c->header.info);
}
102

103 104 105 106
INLINE_HEADER const StgConInfoTable *get_con_itbl(const StgClosure *c)
{
   return CON_INFO_PTR_TO_STRUCT((c)->header.info);
}
107

108 109
INLINE_HEADER StgHalfWord GET_TAG(const StgClosure *con)
{
110
    return get_itbl(con)->srt;
111 112
}

Simon Marlow's avatar
Simon Marlow committed
113 114 115 116
/* -----------------------------------------------------------------------------
   Macros for building closures
   -------------------------------------------------------------------------- */

Ben Gamari's avatar
Ben Gamari committed
117
#if defined(PROFILING)
118
/*
119 120 121 122 123 124 125 126
  The following macro works for both retainer profiling and LDV profiling. For
 retainer profiling, 'era' remains 0, so by setting the 'ldvw' field we also set
 'rs' to zero.

 Note that we don't have to bother handling the 'flip' bit properly[1] since the
 retainer profiling code will just set 'rs' to NULL upon visiting a closure with
 an invalid 'flip' bit anyways.

127 128
 See Note [Profiling heap traversal visited bit] for details.

129
 [1]: Technically we should set 'rs' to `NULL | flip`.
Simon Marlow's avatar
Simon Marlow committed
130 131 132 133 134 135 136 137
 */
#define SET_PROF_HDR(c,ccs_)            \
        ((c)->header.prof.ccs = ccs_,   \
        LDV_RECORD_CREATE((c)))
#else
#define SET_PROF_HDR(c,ccs)
#endif

138 139 140 141
#define SET_HDR(c,_info,ccs)                            \
   {                                                    \
        (c)->header.info = _info;                       \
        SET_PROF_HDR((StgClosure *)(c),ccs);            \
Simon Marlow's avatar
Simon Marlow committed
142 143
   }

144 145
#define SET_ARR_HDR(c,info,costCentreStack,n_bytes)     \
   SET_HDR(c,info,costCentreStack);                     \
146
   (c)->bytes = n_bytes;
Simon Marlow's avatar
Simon Marlow committed
147

148 149
// Use when changing a closure from one kind to another
#define OVERWRITE_INFO(c, new_info)                             \
150
    OVERWRITING_CLOSURE((StgClosure *)(c));                     \
151
    SET_INFO((StgClosure *)(c), (new_info));                    \
152
    LDV_RECORD_CREATE(c);
153

Simon Marlow's avatar
Simon Marlow committed
154 155 156 157 158 159 160 161 162 163
/* -----------------------------------------------------------------------------
   How to get hold of the static link field for a static closure.
   -------------------------------------------------------------------------- */

/* These are hard-coded. */
#define THUNK_STATIC_LINK(p) (&(p)->payload[1])
#define IND_STATIC_LINK(p)   (&(p)->payload[1])

INLINE_HEADER StgClosure **
STATIC_LINK(const StgInfoTable *info, StgClosure *p)
164
{
Simon Marlow's avatar
Simon Marlow committed
165 166
    switch (info->type) {
    case THUNK_STATIC:
167
        return THUNK_STATIC_LINK(p);
Simon Marlow's avatar
Simon Marlow committed
168
    case IND_STATIC:
169
        return IND_STATIC_LINK(p);
Simon Marlow's avatar
Simon Marlow committed
170
    default:
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
171 172
        return &p->payload[info->layout.payload.ptrs +
                           info->layout.payload.nptrs];
Simon Marlow's avatar
Simon Marlow committed
173 174 175 176 177 178 179
    }
}

/* -----------------------------------------------------------------------------
   INTLIKE and CHARLIKE closures.
   -------------------------------------------------------------------------- */

180
INLINE_HEADER P_ CHARLIKE_CLOSURE(int n) {
181
    return (P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE];
182 183
}
INLINE_HEADER P_ INTLIKE_CLOSURE(int n) {
184
    return (P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE];
185
}
Simon Marlow's avatar
Simon Marlow committed
186 187 188 189 190 191 192

/* ----------------------------------------------------------------------------
   Macros for untagging and retagging closure pointers
   For more information look at the comments in Cmm.h
   ------------------------------------------------------------------------- */

static inline StgWord
193
GET_CLOSURE_TAG(const StgClosure * p)
Simon Marlow's avatar
Simon Marlow committed
194 195 196 197 198
{
    return (StgWord)p & TAG_MASK;
}

static inline StgClosure *
199
UNTAG_CLOSURE(StgClosure * p)
Simon Marlow's avatar
Simon Marlow committed
200 201 202 203
{
    return (StgClosure*)((StgWord)p & ~TAG_MASK);
}

204 205 206 207 208 209
static inline const StgClosure *
UNTAG_CONST_CLOSURE(const StgClosure * p)
{
    return (const StgClosure*)((StgWord)p & ~TAG_MASK);
}

Simon Marlow's avatar
Simon Marlow committed
210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240
static inline StgClosure *
TAG_CLOSURE(StgWord tag,StgClosure * p)
{
    return (StgClosure*)((StgWord)p | tag);
}

/* -----------------------------------------------------------------------------
   Forwarding pointers
   -------------------------------------------------------------------------- */

#define IS_FORWARDING_PTR(p) ((((StgWord)p) & 1) != 0)
#define MK_FORWARDING_PTR(p) (((StgWord)p) | 1)
#define UN_FORWARDING_PTR(p) (((StgWord)p) - 1)

/* -----------------------------------------------------------------------------
   DEBUGGING predicates for pointers

   LOOKS_LIKE_INFO_PTR(p)    returns False if p is definitely not an info ptr
   LOOKS_LIKE_CLOSURE_PTR(p) returns False if p is definitely not a closure ptr

   These macros are complete but not sound.  That is, they might
   return false positives.  Do not rely on them to distinguish info
   pointers from closure pointers, for example.

   We don't use address-space predicates these days, for portability
   reasons, and the fact that code/data can be scattered about the
   address space in a dynamically-linked environment.  Our best option
   is to look at the alleged info table and see whether it seems to
   make sense...
   -------------------------------------------------------------------------- */

Ben Gamari's avatar
Ben Gamari committed
241
INLINE_HEADER bool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p)
Simon Marlow's avatar
Simon Marlow committed
242
{
243
    StgInfoTable *info = INFO_PTR_TO_STRUCT((StgInfoTable *)p);
Ben Gamari's avatar
Ben Gamari committed
244
    return info->type != INVALID_OBJECT && info->type < N_CLOSURE_TYPES;
Simon Marlow's avatar
Simon Marlow committed
245 246
}

Ben Gamari's avatar
Ben Gamari committed
247
INLINE_HEADER bool LOOKS_LIKE_INFO_PTR (StgWord p)
Simon Marlow's avatar
Simon Marlow committed
248
{
Ben Gamari's avatar
Ben Gamari committed
249
    return p && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p));
Simon Marlow's avatar
Simon Marlow committed
250 251
}

Ben Gamari's avatar
Ben Gamari committed
252
INLINE_HEADER bool LOOKS_LIKE_CLOSURE_PTR (const void *p)
Simon Marlow's avatar
Simon Marlow committed
253
{
254 255
    return LOOKS_LIKE_INFO_PTR((StgWord)
            (UNTAG_CONST_CLOSURE((const StgClosure *)(p)))->header.info);
Simon Marlow's avatar
Simon Marlow committed
256 257 258 259 260 261
}

/* -----------------------------------------------------------------------------
   Macros for calculating the size of a closure
   -------------------------------------------------------------------------- */

262 263
EXTERN_INLINE StgOffset PAP_sizeW   ( uint32_t n_args );
EXTERN_INLINE StgOffset PAP_sizeW   ( uint32_t n_args )
Simon Marlow's avatar
Simon Marlow committed
264 265
{ return sizeofW(StgPAP) + n_args; }

266 267
EXTERN_INLINE StgOffset AP_sizeW   ( uint32_t n_args );
EXTERN_INLINE StgOffset AP_sizeW   ( uint32_t n_args )
Simon Marlow's avatar
Simon Marlow committed
268 269
{ return sizeofW(StgAP) + n_args; }

270 271
EXTERN_INLINE StgOffset AP_STACK_sizeW ( uint32_t size );
EXTERN_INLINE StgOffset AP_STACK_sizeW ( uint32_t size )
Simon Marlow's avatar
Simon Marlow committed
272 273
{ return sizeofW(StgAP_STACK) + size; }

274 275
EXTERN_INLINE StgOffset CONSTR_sizeW( uint32_t p, uint32_t np );
EXTERN_INLINE StgOffset CONSTR_sizeW( uint32_t p, uint32_t np )
Simon Marlow's avatar
Simon Marlow committed
276 277
{ return sizeofW(StgHeader) + p + np; }

278 279
EXTERN_INLINE StgOffset THUNK_SELECTOR_sizeW ( void );
EXTERN_INLINE StgOffset THUNK_SELECTOR_sizeW ( void )
Simon Marlow's avatar
Simon Marlow committed
280 281
{ return sizeofW(StgSelector); }

282 283
EXTERN_INLINE StgOffset BLACKHOLE_sizeW ( void );
EXTERN_INLINE StgOffset BLACKHOLE_sizeW ( void )
284
{ return sizeofW(StgInd); } // a BLACKHOLE is a kind of indirection
Simon Marlow's avatar
Simon Marlow committed
285 286 287 288 289

/* --------------------------------------------------------------------------
   Sizes of closures
   ------------------------------------------------------------------------*/

290 291
EXTERN_INLINE StgOffset sizeW_fromITBL( const StgInfoTable* itbl );
EXTERN_INLINE StgOffset sizeW_fromITBL( const StgInfoTable* itbl )
Simon Marlow's avatar
Simon Marlow committed
292 293 294 295
{ return sizeofW(StgClosure)
       + sizeofW(StgPtr)  * itbl->layout.payload.ptrs
       + sizeofW(StgWord) * itbl->layout.payload.nptrs; }

296 297
EXTERN_INLINE StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl );
EXTERN_INLINE StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl )
Simon Marlow's avatar
Simon Marlow committed
298 299 300 301
{ return sizeofW(StgThunk)
       + sizeofW(StgPtr)  * itbl->layout.payload.ptrs
       + sizeofW(StgWord) * itbl->layout.payload.nptrs; }

302 303
EXTERN_INLINE StgOffset ap_stack_sizeW( StgAP_STACK* x );
EXTERN_INLINE StgOffset ap_stack_sizeW( StgAP_STACK* x )
Simon Marlow's avatar
Simon Marlow committed
304 305
{ return AP_STACK_sizeW(x->size); }

306 307
EXTERN_INLINE StgOffset ap_sizeW( StgAP* x );
EXTERN_INLINE StgOffset ap_sizeW( StgAP* x )
Simon Marlow's avatar
Simon Marlow committed
308 309
{ return AP_sizeW(x->n_args); }

310 311
EXTERN_INLINE StgOffset pap_sizeW( StgPAP* x );
EXTERN_INLINE StgOffset pap_sizeW( StgPAP* x )
Simon Marlow's avatar
Simon Marlow committed
312 313
{ return PAP_sizeW(x->n_args); }

siddhanathan's avatar
siddhanathan committed
314 315
EXTERN_INLINE StgWord arr_words_words( StgArrBytes* x);
EXTERN_INLINE StgWord arr_words_words( StgArrBytes* x)
316 317
{ return ROUNDUP_BYTES_TO_WDS(x->bytes); }

siddhanathan's avatar
siddhanathan committed
318 319 320
EXTERN_INLINE StgOffset arr_words_sizeW( StgArrBytes* x );
EXTERN_INLINE StgOffset arr_words_sizeW( StgArrBytes* x )
{ return sizeofW(StgArrBytes) + arr_words_words(x); }
Simon Marlow's avatar
Simon Marlow committed
321

322 323
EXTERN_INLINE StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x );
EXTERN_INLINE StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
324
{ return sizeofW(StgMutArrPtrs) + x->size; }
Simon Marlow's avatar
Simon Marlow committed
325

326 327 328 329
EXTERN_INLINE StgOffset small_mut_arr_ptrs_sizeW( StgSmallMutArrPtrs* x );
EXTERN_INLINE StgOffset small_mut_arr_ptrs_sizeW( StgSmallMutArrPtrs* x )
{ return sizeofW(StgSmallMutArrPtrs) + x->ptrs; }

330 331
EXTERN_INLINE StgWord stack_sizeW ( StgStack *stack );
EXTERN_INLINE StgWord stack_sizeW ( StgStack *stack )
332
{ return sizeofW(StgStack) + stack->stack_size; }
Simon Marlow's avatar
Simon Marlow committed
333

334 335
EXTERN_INLINE StgWord bco_sizeW ( StgBCO *bco );
EXTERN_INLINE StgWord bco_sizeW ( StgBCO *bco )
Simon Marlow's avatar
Simon Marlow committed
336 337
{ return bco->size; }

gcampax's avatar
gcampax committed
338 339 340 341
EXTERN_INLINE StgWord compact_nfdata_full_sizeW ( StgCompactNFData *str );
EXTERN_INLINE StgWord compact_nfdata_full_sizeW ( StgCompactNFData *str )
{ return str->totalW; }

342
/*
343
 * TODO: Consider to switch return type from 'uint32_t' to 'StgWord' #8742
344 345 346
 *
 * (Also for 'closure_sizeW' below)
 */
347
EXTERN_INLINE uint32_t
348 349 350
closure_sizeW_ (const StgClosure *p, const StgInfoTable *info);
EXTERN_INLINE uint32_t
closure_sizeW_ (const StgClosure *p, const StgInfoTable *info)
Simon Marlow's avatar
Simon Marlow committed
351 352 353 354
{
    switch (info->type) {
    case THUNK_0_1:
    case THUNK_1_0:
355
        return sizeofW(StgThunk) + 1;
Simon Marlow's avatar
Simon Marlow committed
356 357 358 359
    case FUN_0_1:
    case CONSTR_0_1:
    case FUN_1_0:
    case CONSTR_1_0:
360
        return sizeofW(StgHeader) + 1;
Simon Marlow's avatar
Simon Marlow committed
361 362 363
    case THUNK_0_2:
    case THUNK_1_1:
    case THUNK_2_0:
364
        return sizeofW(StgThunk) + 2;
Simon Marlow's avatar
Simon Marlow committed
365 366 367 368 369 370
    case FUN_0_2:
    case CONSTR_0_2:
    case FUN_1_1:
    case CONSTR_1_1:
    case FUN_2_0:
    case CONSTR_2_0:
371
        return sizeofW(StgHeader) + 2;
Simon Marlow's avatar
Simon Marlow committed
372
    case THUNK:
373
        return thunk_sizeW_fromITBL(info);
Simon Marlow's avatar
Simon Marlow committed
374
    case THUNK_SELECTOR:
375
        return THUNK_SELECTOR_sizeW();
Simon Marlow's avatar
Simon Marlow committed
376
    case AP_STACK:
377
        return ap_stack_sizeW((StgAP_STACK *)p);
Simon Marlow's avatar
Simon Marlow committed
378
    case AP:
379
        return ap_sizeW((StgAP *)p);
Simon Marlow's avatar
Simon Marlow committed
380
    case PAP:
381
        return pap_sizeW((StgPAP *)p);
Simon Marlow's avatar
Simon Marlow committed
382
    case IND:
383
        return sizeofW(StgInd);
Simon Marlow's avatar
Simon Marlow committed
384
    case ARR_WORDS:
siddhanathan's avatar
siddhanathan committed
385
        return arr_words_sizeW((StgArrBytes *)p);
Simon Marlow's avatar
Simon Marlow committed
386 387
    case MUT_ARR_PTRS_CLEAN:
    case MUT_ARR_PTRS_DIRTY:
388 389
    case MUT_ARR_PTRS_FROZEN_CLEAN:
    case MUT_ARR_PTRS_FROZEN_DIRTY:
390
        return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
391 392
    case SMALL_MUT_ARR_PTRS_CLEAN:
    case SMALL_MUT_ARR_PTRS_DIRTY:
393 394
    case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN:
    case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY:
395
        return small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs*)p);
Simon Marlow's avatar
Simon Marlow committed
396
    case TSO:
397 398 399
        return sizeofW(StgTSO);
    case STACK:
        return stack_sizeW((StgStack*)p);
Simon Marlow's avatar
Simon Marlow committed
400
    case BCO:
401
        return bco_sizeW((StgBCO *)p);
Simon Marlow's avatar
Simon Marlow committed
402 403 404
    case TREC_CHUNK:
        return sizeofW(StgTRecChunk);
    default:
405
        return sizeW_fromITBL(info);
Simon Marlow's avatar
Simon Marlow committed
406 407 408 409
    }
}

// The definitive way to find the size, in words, of a heap-allocated closure
410 411
EXTERN_INLINE uint32_t closure_sizeW (const StgClosure *p);
EXTERN_INLINE uint32_t closure_sizeW (const StgClosure *p)
Simon Marlow's avatar
Simon Marlow committed
412 413 414 415 416 417 418 419
{
    return closure_sizeW_(p, get_itbl(p));
}

/* -----------------------------------------------------------------------------
   Sizes of stack frames
   -------------------------------------------------------------------------- */

420 421
EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame );
EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame )
Simon Marlow's avatar
Simon Marlow committed
422
{
423
    const StgRetInfoTable *info;
Simon Marlow's avatar
Simon Marlow committed
424 425 426 427 428

    info = get_ret_itbl(frame);
    switch (info->i.type) {

    case RET_FUN:
429
        return sizeofW(StgRetFun) + ((StgRetFun *)frame)->size;
Simon Marlow's avatar
Simon Marlow committed
430 431

    case RET_BIG:
432
        return 1 + GET_LARGE_BITMAP(&info->i)->size;
Simon Marlow's avatar
Simon Marlow committed
433 434

    case RET_BCO:
435
        return 2 + BCO_BITMAP_SIZE((StgBCO *)((P_)frame)[1]);
Simon Marlow's avatar
Simon Marlow committed
436 437

    default:
438
        return 1 + BITMAP_SIZE(info->i.layout.bitmap);
Simon Marlow's avatar
Simon Marlow committed
439 440 441
    }
}

442 443 444 445 446 447 448 449 450 451
/* -----------------------------------------------------------------------------
   StgMutArrPtrs macros

   An StgMutArrPtrs has a card table to indicate which elements are
   dirty for the generational GC.  The card table is an array of
   bytes, where each byte covers (1 << MUT_ARR_PTRS_CARD_BITS)
   elements.  The card table is directly after the array data itself.
   -------------------------------------------------------------------------- */

// 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 456 457 458
                           >> MUT_ARR_PTRS_CARD_BITS);
}

// The number of words in the card table
459
INLINE_HEADER W_ mutArrPtrsCardTableSize (W_ elems)
460 461 462 463 464
{
    return ROUNDUP_BYTES_TO_WDS(mutArrPtrsCards(elems));
}

// The address of the card for a particular card number
465
INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, W_ n)
466 467 468 469
{
    return ((StgWord8 *)&(a->payload[a->ptrs]) + n);
}

470 471 472 473 474
/* -----------------------------------------------------------------------------
   Replacing a closure with a different one.  We must call
   OVERWRITING_CLOSURE(p) on the old closure that is about to be
   overwritten.

475
   Note [zeroing slop when overwriting closures]
476
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
477

478 479 480
   When we overwrite a closure in the heap with a smaller one, in some scenarios
   we need to write zero words into "slop"; the memory that is left
   unoccupied. See Note [slop on the heap]
481

482
   Zeroing slop is required for:
483

484
    - full-heap sanity checks (DEBUG, and +RTS -DS),
485

486
    - LDV profiling (PROFILING, and +RTS -hb) and
487

488 489 490 491
   However we can get into trouble if we're zeroing slop for ordinarily
   immutable closures when using multiple threads, since there is nothing
   preventing another thread from still being in the process of reading the
   memory we're about to zero.
492

493 494
   Thus, with the THREADED RTS and +RTS -N2 or greater we must not zero
   immutable closure's slop.
495

496
   Hence, an immutable closure's slop is zeroed when either:
497

498 499
    - PROFILING && era > 0 (LDV is on) or
    - !THREADED && DEBUG
500

501 502 503 504 505 506 507
   Additionally:

    - LDV profiling and +RTS -N2 are incompatible,

    - full-heap sanity checks are disabled for the THREADED RTS, at least when
      they don't run right after GC when there is no slop.
      See Note [heap sanity checking with SMP].
508 509 510

   -------------------------------------------------------------------------- */

511 512 513 514 515
#if defined(PROFILING) || defined(DEBUG)
#define OVERWRITING_CLOSURE(c) \
    overwritingClosure(c)
#define OVERWRITING_CLOSURE_MUTABLE(c, off) \
    overwritingMutableClosureOfs(c, off)
516
#else
517 518 519 520
#define OVERWRITING_CLOSURE(c) \
    do { (void) sizeof(c); } while(0)
#define OVERWRITING_CLOSURE_MUTABLE(c, off) \
    do { (void) sizeof(c); (void) sizeof(off); } while(0)
521 522
#endif

Ben Gamari's avatar
Ben Gamari committed
523
#if defined(PROFILING)
524
void LDV_recordDead (const StgClosure *c, uint32_t size);
525
RTS_PRIVATE bool isInherentlyUsed ( StgHalfWord closure_type );
526 527
#endif

528 529 530 531 532
EXTERN_INLINE void
zeroSlop (
    StgClosure *p,
    uint32_t offset, /*< offset to start zeroing at, in words */
    uint32_t size,   /*< total closure size, in words */
533
    bool known_mutable /*< is this a closure who's slop we can always zero? */
534 535 536
    );

EXTERN_INLINE void
537
zeroSlop (StgClosure *p, uint32_t offset, uint32_t size, bool known_mutable)
538
{
539
    // see Note [zeroing slop when overwriting closures], also #8402
540 541 542 543 544 545 546

    const bool want_to_zero_immutable_slop = false
        // Sanity checking (-DS) is enabled
        || RTS_DEREF(RtsFlags).DebugFlags.sanity
#if defined(PROFILING)
        // LDV profiler is enabled
        || era > 0
547
#endif
548 549 550 551 552 553 554 555 556
        ;

    const bool can_zero_immutable_slop =
        // Only if we're running single threaded.
        RTS_DEREF(RtsFlags).ParFlags.nCapabilities <= 1;

    const bool zero_slop_immutable =
        want_to_zero_immutable_slop && can_zero_immutable_slop;

557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577
    const bool zero_slop_mutable =
#if defined(PROFILING)
        // Always zero mutable closure slop when profiling. We do this to cover
        // the case of shrinking mutable arrays in pinned blocks for the heap
        // profiler, see Note [skipping slop in the heap profiler]
        //
        // TODO: We could make this check more specific and only zero if the
        // object is in a BF_PINNED bdescr here. Update Note [slop on the heap]
        // and [zeroing slop when overwriting closures] if you change this.
        true
#else
        zero_slop_immutable
#endif
        ;

    const bool zero_slop =
        // If we're not sure this is a mutable closure treat it like an
        // immutable one.
        known_mutable ? zero_slop_mutable : zero_slop_immutable;

    if(!zero_slop)
578
        return;
579

580 581
    for (uint32_t i = offset; i < size; i++) {
        ((StgWord *)p)[i] = 0;
582 583 584
    }
}

585 586 587
EXTERN_INLINE void overwritingClosure (StgClosure *p);
EXTERN_INLINE void overwritingClosure (StgClosure *p)
{
588
    W_ size = closure_sizeW(p);
589
#if defined(PROFILING)
590 591
    if(era > 0 && !isInherentlyUsed(get_itbl(p)->type))
        LDV_recordDead(p, size);
592
#endif
593
    zeroSlop(p, sizeofW(StgThunkHeader), size, /*known_mutable=*/false);
594 595
}

596 597 598 599
// Version of 'overwritingClosure' which overwrites only a suffix of a
// closure.  The offset is expressed in words relative to 'p' and shall
// be less than or equal to closure_sizeW(p), and usually at least as
// large as the respective thunk header.
600 601 602 603 604
EXTERN_INLINE void
overwritingMutableClosureOfs (StgClosure *p, uint32_t offset);

EXTERN_INLINE void
overwritingMutableClosureOfs (StgClosure *p, uint32_t offset)
605
{
606 607 608 609 610 611
    // Since overwritingClosureOfs is only ever called by:
    //
    //   - shrinkMutableByteArray# (ARR_WORDS) and
    //
    //   - shrinkSmallMutableArray# (SMALL_MUT_ARR_PTRS)
    //
612 613 614 615 616
    // we can safely omit the Ldv_recordDead call. Since these closures are
    // considered inherenlty used we don't need to track their destruction.
#if defined(PROFILING)
    ASSERT(isInherentlyUsed(get_itbl(p)->type) == true);
#endif
617
    zeroSlop(p, offset, closure_sizeW(p), /*known_mutable=*/true);
618
}
619

620 621 622 623
// Version of 'overwritingClosure' which takes closure size as argument.
EXTERN_INLINE void overwritingClosureSize (StgClosure *p, uint32_t size /* in words */);
EXTERN_INLINE void overwritingClosureSize (StgClosure *p, uint32_t size)
{
624 625
    // This function is only called from stg_AP_STACK so we can assume it's not
    // inherently used.
626
#if defined(PROFILING)
627 628 629
    ASSERT(isInherentlyUsed(get_itbl(p)->type) == false);
    if(era > 0)
        LDV_recordDead(p, size);
630
#endif
631
    zeroSlop(p, sizeofW(StgThunkHeader), size, /*known_mutable=*/false);
632
}