ClosureMacros.h 20.9 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

55
#define GET_ENTRY(c)  (ENTRY_CODE(GET_INFO(c)))
Simon Marlow's avatar
Simon Marlow committed
56

Ben Gamari's avatar
Ben Gamari committed
57
#if defined(TABLES_NEXT_TO_CODE)
58 59 60 61 62 63 64
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;}
65 66 67 68
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
69
#else
70 71 72 73
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;}
74
INLINE_HEADER StgFunInfoTable *FUN_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgFunInfoTable *)info;}
75 76
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;}
77 78 79 80
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
81 82
#endif

83 84 85 86 87
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);
}
88

89 90 91 92 93
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);
}
94

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

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

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

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

Simon Marlow's avatar
Simon Marlow committed
115 116 117 118
/* -----------------------------------------------------------------------------
   Macros for building closures
   -------------------------------------------------------------------------- */

Ben Gamari's avatar
Ben Gamari committed
119
#if defined(PROFILING)
120
/*
121 122 123 124 125 126 127 128
  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.

129 130
 See Note [Profiling heap traversal visited bit] for details.

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

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

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

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

Simon Marlow's avatar
Simon Marlow committed
156 157 158 159 160 161 162 163 164 165
/* -----------------------------------------------------------------------------
   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)
166
{
Simon Marlow's avatar
Simon Marlow committed
167 168
    switch (info->type) {
    case THUNK_STATIC:
169
        return THUNK_STATIC_LINK(p);
Simon Marlow's avatar
Simon Marlow committed
170
    case IND_STATIC:
171
        return IND_STATIC_LINK(p);
Simon Marlow's avatar
Simon Marlow committed
172
    default:
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
173 174
        return &p->payload[info->layout.payload.ptrs +
                           info->layout.payload.nptrs];
Simon Marlow's avatar
Simon Marlow committed
175 176 177 178 179 180 181
    }
}

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

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

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

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

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

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

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

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

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

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

264 265
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
266 267
{ return sizeofW(StgPAP) + n_args; }

268 269
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
270 271
{ return sizeofW(StgAP) + n_args; }

272 273
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
274 275
{ return sizeofW(StgAP_STACK) + size; }

276 277
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
278 279
{ return sizeofW(StgHeader) + p + np; }

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

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

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

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

298 299
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
300 301 302 303
{ return sizeofW(StgThunk)
       + sizeofW(StgPtr)  * itbl->layout.payload.ptrs
       + sizeofW(StgWord) * itbl->layout.payload.nptrs; }

304 305
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
306 307
{ return AP_STACK_sizeW(x->size); }

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

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

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

siddhanathan's avatar
siddhanathan committed
320 321 322
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
323

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

328 329 330 331
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; }

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

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

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

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

// The definitive way to find the size, in words, of a heap-allocated closure
412 413
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
414 415 416 417 418 419 420 421
{
    return closure_sizeW_(p, get_itbl(p));
}

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

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

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

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

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

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

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

444 445 446 447 448 449 450 451 452 453
/* -----------------------------------------------------------------------------
   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
454
INLINE_HEADER W_ mutArrPtrsCards (W_ elems)
455
{
456
    return (W_)((elems + (1 << MUT_ARR_PTRS_CARD_BITS) - 1)
457 458 459 460
                           >> MUT_ARR_PTRS_CARD_BITS);
}

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

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

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

477
   Note [zeroing slop]
478

479 480 481
   In some scenarios we write zero words into "slop"; memory that is
   left unoccupied after we overwrite a closure in the heap with a
   smaller closure.
482

483
   Zeroing slop is required for:
484

485 486
    - full-heap sanity checks (DEBUG, and +RTS -DS)
    - LDV profiling (PROFILING, and +RTS -hb)
487

488 489 490 491 492 493 494 495 496 497 498 499 500 501
   Zeroing slop must be disabled for:

    - THREADED_RTS with +RTS -N2 and greater, because we cannot
      overwrite slop when another thread might be reading it.

   Hence, slop is zeroed when either:

    - PROFILING && era <= 0 (LDV is on)
    - !THREADED_RTS && DEBUG

   And additionally:

    - LDV profiling and +RTS -N2 are incompatible
    - full-heap sanity checks are disabled for THREADED_RTS
502 503 504

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

505 506 507 508 509 510 511 512 513 514 515
#if defined(PROFILING)
#define ZERO_SLOP_FOR_LDV_PROF 1
#else
#define ZERO_SLOP_FOR_LDV_PROF 0
#endif

#if defined(DEBUG) && !defined(THREADED_RTS)
#define ZERO_SLOP_FOR_SANITY_CHECK 1
#else
#define ZERO_SLOP_FOR_SANITY_CHECK 0
#endif
516 517

#if ZERO_SLOP_FOR_LDV_PROF || ZERO_SLOP_FOR_SANITY_CHECK
518
#define OVERWRITING_CLOSURE(c) overwritingClosure(c)
519
#define OVERWRITING_CLOSURE_OFS(c,n) overwritingClosureOfs(c,n)
520 521
#else
#define OVERWRITING_CLOSURE(c) /* nothing */
522
#define OVERWRITING_CLOSURE_OFS(c,n) /* nothing */
523 524
#endif

Ben Gamari's avatar
Ben Gamari committed
525
#if defined(PROFILING)
526
void LDV_recordDead (const StgClosure *c, uint32_t size);
527 528
#endif

529 530
EXTERN_INLINE void overwritingClosure_ (StgClosure *p,
                                        uint32_t offset /* in words */,
531 532 533 534
                                        uint32_t size /* closure size, in words */,
                                        bool prim /* Whether to call LDV_recordDead */
                                        );
EXTERN_INLINE void overwritingClosure_ (StgClosure *p, uint32_t offset, uint32_t size, bool prim USED_IF_PROFILING)
535
{
536 537
#if ZERO_SLOP_FOR_LDV_PROF && !ZERO_SLOP_FOR_SANITY_CHECK
    // see Note [zeroing slop], also #8402
538 539 540
    if (era <= 0) return;
#endif

541 542
    // For LDV profiling, we need to record the closure as dead
#if defined(PROFILING)
543
    if (!prim) { LDV_recordDead(p, size); };
544 545
#endif

546 547
    for (uint32_t i = offset; i < size; i++) {
        ((StgWord *)p)[i] = 0;
548 549 550
    }
}

551 552 553
EXTERN_INLINE void overwritingClosure (StgClosure *p);
EXTERN_INLINE void overwritingClosure (StgClosure *p)
{
554
    overwritingClosure_(p, sizeofW(StgThunkHeader), closure_sizeW(p), false);
555 556
}

557 558 559 560 561 562 563
// 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.
//
// Note: As this calls LDV_recordDead() you have to call LDV_RECORD()
//       on the final state of the closure at the call-site
564 565
EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, uint32_t offset);
EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, uint32_t offset)
566
{
567 568 569
    // Set prim = true because only called on ARR_WORDS with the
    // shrinkMutableByteArray# primop
    overwritingClosure_(p, offset, closure_sizeW(p), true);
570
}
571

572 573 574 575
// 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)
{
576
    overwritingClosure_(p, sizeofW(StgThunkHeader), size, false);
577
}