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 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
 *
 * Macros for building and manipulating closures
 *
 * -------------------------------------------------------------------------- */

#ifndef RTS_STORAGE_CLOSUREMACROS_H
#define RTS_STORAGE_CLOSUREMACROS_H

/* -----------------------------------------------------------------------------
   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
28 29 30
                         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
31 32 33

       "info table"      The info table structure associated with a
                         closure.  This is always a pointer to the
34 35 36 37
                         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
38 39 40

   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
41
   mangling or not respectively.  So,
Simon Marlow's avatar
Simon Marlow committed
42

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

   makes absolute sense, whether mangling or not.
46

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

49 50 51 52 53 54
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
55

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

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

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

87 88
EXTERN_INLINE StgRetInfoTable *get_ret_itbl(const StgClosure *c);
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 97 98 99
INLINE_HEADER StgHalfWord GET_TAG(const StgClosure *con) {
    return get_itbl(con)->srt_bitmap;
}

Simon Marlow's avatar
Simon Marlow committed
100 101 102 103 104 105
/* -----------------------------------------------------------------------------
   Macros for building closures
   -------------------------------------------------------------------------- */

#ifdef PROFILING
#ifdef DEBUG_RETAINER
106 107
/*
  For the sake of debugging, we take the safest way for the moment. Actually, this
Simon Marlow's avatar
Simon Marlow committed
108 109 110 111 112 113 114 115 116 117 118
  is useful to check the sanity of heap before beginning retainer profiling.
  flip is defined in RetainerProfile.c, and declared as extern in RetainerProfile.h.
  Note: change those functions building Haskell objects from C datatypes, i.e.,
  all rts_mk???() functions in RtsAPI.c, as well.
 */
#define SET_PROF_HDR(c,ccs_)            \
        ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip))
#else
/*
  For retainer profiling only: we do not have to set (c)->header.prof.hp.rs to
  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
Simon Marlow's avatar
Simon Marlow committed
120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138
  the closure *c is visited.
 */
/*
#define SET_PROF_HDR(c,ccs_)            \
        ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = NULL)
 */
/*
  The following macro works for both retainer profiling and LDV profiling:
  for retainer profiling, ldvTime remains 0, so rs fields are initialized to 0.
  See the invariants on ldvTime.
 */
#define SET_PROF_HDR(c,ccs_)            \
        ((c)->header.prof.ccs = ccs_,   \
        LDV_RECORD_CREATE((c)))
#endif /* DEBUG_RETAINER */
#else
#define SET_PROF_HDR(c,ccs)
#endif

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

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

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

Simon Marlow's avatar
Simon Marlow committed
155 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 FUN_STATIC_LINK(p)   (&(p)->payload[0])
#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 FUN_STATIC:
171
        return FUN_STATIC_LINK(p);
Simon Marlow's avatar
Simon Marlow committed
172
    case IND_STATIC:
173
        return IND_STATIC_LINK(p);
Simon Marlow's avatar
Simon Marlow committed
174
    default:
175 176
        return &(p)->payload[info->layout.payload.ptrs +
                             info->layout.payload.nptrs];
Simon Marlow's avatar
Simon Marlow committed
177 178 179
    }
}

180 181 182 183 184
INLINE_HEADER StgClosure *STATIC_LINK2(const StgInfoTable *info,
                                       StgClosure *p) {
    return (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs +
                            info->layout.payload.nptrs + 1])));
}
Simon Marlow's avatar
Simon Marlow committed
185 186 187 188 189

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

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
}
Simon Marlow's avatar
Simon Marlow committed
196 197 198 199 200 201 202 203 204 205 206 207 208 209 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 241 242 243 244 245 246

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

static inline StgWord
GET_CLOSURE_TAG(StgClosure * p)
{
    return (StgWord)p & TAG_MASK;
}

static inline StgClosure *
UNTAG_CLOSURE(StgClosure * p)
{
    return (StgClosure*)((StgWord)p & ~TAG_MASK);
}

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...
   -------------------------------------------------------------------------- */

INLINE_HEADER rtsBool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p)
{
247
    StgInfoTable *info = INFO_PTR_TO_STRUCT((StgInfoTable *)p);
248
    return (info->type != INVALID_OBJECT && info->type < N_CLOSURE_TYPES) ? rtsTrue : rtsFalse;
Simon Marlow's avatar
Simon Marlow committed
249 250 251 252
}

INLINE_HEADER rtsBool LOOKS_LIKE_INFO_PTR (StgWord p)
{
253
    return (p && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p))) ? rtsTrue : rtsFalse;
Simon Marlow's avatar
Simon Marlow committed
254 255 256 257 258 259 260 261 262 263 264
}

INLINE_HEADER rtsBool LOOKS_LIKE_CLOSURE_PTR (void *p)
{
    return LOOKS_LIKE_INFO_PTR((StgWord)(UNTAG_CLOSURE((StgClosure *)(p)))->header.info);
}

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

265 266
EXTERN_INLINE StgOffset PAP_sizeW   ( nat n_args );
EXTERN_INLINE StgOffset PAP_sizeW   ( nat n_args )
Simon Marlow's avatar
Simon Marlow committed
267 268
{ return sizeofW(StgPAP) + n_args; }

269 270
EXTERN_INLINE StgOffset AP_sizeW   ( nat n_args );
EXTERN_INLINE StgOffset AP_sizeW   ( nat n_args )
Simon Marlow's avatar
Simon Marlow committed
271 272
{ return sizeofW(StgAP) + n_args; }

273 274
EXTERN_INLINE StgOffset AP_STACK_sizeW ( nat size );
EXTERN_INLINE StgOffset AP_STACK_sizeW ( nat size )
Simon Marlow's avatar
Simon Marlow committed
275 276
{ return sizeofW(StgAP_STACK) + size; }

277 278
EXTERN_INLINE StgOffset CONSTR_sizeW( nat p, nat np );
EXTERN_INLINE StgOffset CONSTR_sizeW( nat p, nat np )
Simon Marlow's avatar
Simon Marlow committed
279 280
{ return sizeofW(StgHeader) + p + np; }

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

474
   Note [zeroing slop]
475

476 477 478
   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.
479

480
   Zeroing slop is required for:
481

482 483
    - full-heap sanity checks (DEBUG, and +RTS -DS)
    - LDV profiling (PROFILING, and +RTS -hb)
484

485 486 487 488 489 490 491 492 493 494 495 496 497 498
   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
499 500 501

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

502 503 504 505
#define ZERO_SLOP_FOR_LDV_PROF     (defined(PROFILING))
#define ZERO_SLOP_FOR_SANITY_CHECK (defined(DEBUG) && !defined(THREADED_RTS))

#if ZERO_SLOP_FOR_LDV_PROF || ZERO_SLOP_FOR_SANITY_CHECK
506
#define OVERWRITING_CLOSURE(c) overwritingClosure(c)
507 508
#define OVERWRITING_CLOSURE_OFS(c,n) \
    overwritingClosureOfs(c,n)
509 510
#else
#define OVERWRITING_CLOSURE(c) /* nothing */
511
#define OVERWRITING_CLOSURE_OFS(c,n) /* nothing */
512 513 514 515 516 517
#endif

#ifdef PROFILING
void LDV_recordDead (StgClosure *c, nat size);
#endif

518 519
EXTERN_INLINE void overwritingClosure (StgClosure *p);
EXTERN_INLINE void overwritingClosure (StgClosure *p)
520 521 522
{
    nat size, i;

523 524
#if ZERO_SLOP_FOR_LDV_PROF && !ZERO_SLOP_FOR_SANITY_CHECK
    // see Note [zeroing slop], also #8402
525 526 527
    if (era <= 0) return;
#endif

528 529 530 531
    size = closure_sizeW(p);

    // For LDV profiling, we need to record the closure as dead
#if defined(PROFILING)
ian@well-typed.com's avatar
ian@well-typed.com committed
532
    LDV_recordDead(p, size);
533 534 535 536 537 538 539
#endif

    for (i = 0; i < size - sizeofW(StgThunkHeader); i++) {
        ((StgThunk *)(p))->payload[i] = 0;
    }
}

540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569
// 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
EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, nat offset);
EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, nat offset)
{
    nat size, i;

#if ZERO_SLOP_FOR_LDV_PROF && !ZERO_SLOP_FOR_SANITY_CHECK
    // see Note [zeroing slop], also #8402
    if (era <= 0) return;
#endif

    size = closure_sizeW(p);

    ASSERT(offset <= size);

    // For LDV profiling, we need to record the closure as dead
#if defined(PROFILING)
    LDV_recordDead(p, size);
#endif

    for (i = offset; i < size; i++)
        ((StgWord *)p)[i] = 0;
}

Simon Marlow's avatar
Simon Marlow committed
570
#endif /* RTS_STORAGE_CLOSUREMACROS_H */