includes/rts/storage/ClosureMacros.h

   1 /* ----------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team, 1998-2004
   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 interpretter 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 #define SET_INFO(c,i) ((c)->header.info = (i))
  50 #define GET_INFO(c)   ((c)->header.info)
  51 #define GET_ENTRY(c)  (ENTRY_CODE(GET_INFO(c)))
  52
  53 #define get_itbl(c)   (INFO_PTR_TO_STRUCT((c)->header.info))
  54 #define get_ret_itbl(c) (RET_INFO_PTR_TO_STRUCT((c)->header.info))
  55 #define get_fun_itbl(c) (FUN_INFO_PTR_TO_STRUCT((c)->header.info))
  56 #define get_thunk_itbl(c) (THUNK_INFO_PTR_TO_STRUCT((c)->header.info))
  57 #define get_con_itbl(c) (CON_INFO_PTR_TO_STRUCT((c)->header.info))
  58
  59 #define GET_TAG(con) (get_itbl(con)->srt_bitmap)
  60
  61 #ifdef TABLES_NEXT_TO_CODE
  62 #define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)(info) - 1)
  63 #define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)(info) - 1)
  64 #define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)(info) - 1)
  65 #define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)(info) - 1)
  66 #define CON_INFO_PTR_TO_STRUCT(info) ((StgConInfoTable *)(info) - 1)
  67 #define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
  68 #define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
  69 #define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
  70 #define itbl_to_con_itbl(i) ((StgConInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
  71 #else
  72 #define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)info)
  73 #define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)info)
  74 #define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)info)
  75 #define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)info)
  76 #define CON_INFO_PTR_TO_STRUCT(info) ((StgConInfoTable *)info)
  77 #define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(i))
  78 #define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(i))
  79 #define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(i))
  80 #define itbl_to_con_itbl(i) ((StgConInfoTable *)(i))
  81 #endif
  82
  83 /* -----------------------------------------------------------------------------
  84    Macros for building closures
  85    -------------------------------------------------------------------------- */
  86
  87 #ifdef PROFILING
  88 #ifdef DEBUG_RETAINER
  89 /*
  90   For the sake of debugging, we take the safest way for the moment. Actually, this
  91   is useful to check the sanity of heap before beginning retainer profiling.
  92   flip is defined in RetainerProfile.c, and declared as extern in RetainerProfile.h.
  93   Note: change those functions building Haskell objects from C datatypes, i.e.,
  94   all rts_mk???() functions in RtsAPI.c, as well.
  95  */
  96 #define SET_PROF_HDR(c,ccs_)            \
  97         ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip))
  98 #else
  99 /*
 100   For retainer profiling only: we do not have to set (c)->header.prof.hp.rs to
 101   NULL | flip (flip is defined in RetainerProfile.c) because even when flip
 102   is 1, rs is invalid and will be initialized to NULL | flip later when
 103   the closure *c is visited.
 104  */
 105 /*
 106 #define SET_PROF_HDR(c,ccs_)            \
 107         ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = NULL)
 108  */
 109 /*
 110   The following macro works for both retainer profiling and LDV profiling:
 111   for retainer profiling, ldvTime remains 0, so rs fields are initialized to 0.
 112   See the invariants on ldvTime.
 113  */
 114 #define SET_PROF_HDR(c,ccs_)            \
 115         ((c)->header.prof.ccs = ccs_,   \
 116         LDV_RECORD_CREATE((c)))
 117 #endif /* DEBUG_RETAINER */
 118 #else
 119 #define SET_PROF_HDR(c,ccs)
 120 #endif
 121
 122 #define SET_HDR(c,_info,ccs)                            \
 123    {                                                    \
 124         (c)->header.info = _info;                       \
 125         SET_PROF_HDR((StgClosure *)(c),ccs);            \
 126    }
 127
 128 #define SET_ARR_HDR(c,info,costCentreStack,n_bytes)     \
 129    SET_HDR(c,info,costCentreStack);                     \
 130    (c)->bytes = n_bytes;
 131
 132 // Use when changing a closure from one kind to another
 133 #define OVERWRITE_INFO(c, new_info)                             \
 134     OVERWRITING_CLOSURE((StgClosure *)(c));                     \
 135     SET_INFO((c), (new_info));                                  \
 136     LDV_RECORD_CREATE(c);
 137
 138 /* -----------------------------------------------------------------------------
 139    How to get hold of the static link field for a static closure.
 140    -------------------------------------------------------------------------- */
 141
 142 /* These are hard-coded. */
 143 #define FUN_STATIC_LINK(p)   (&(p)->payload[0])
 144 #define THUNK_STATIC_LINK(p) (&(p)->payload[1])
 145 #define IND_STATIC_LINK(p)   (&(p)->payload[1])
 146
 147 INLINE_HEADER StgClosure **
 148 STATIC_LINK(const StgInfoTable *info, StgClosure *p)
 149 {
 150     switch (info->type) {
 151     case THUNK_STATIC:
 152         return THUNK_STATIC_LINK(p);
 153     case FUN_STATIC:
 154         return FUN_STATIC_LINK(p);
 155     case IND_STATIC:
 156         return IND_STATIC_LINK(p);
 157     default:
 158         return &(p)->payload[info->layout.payload.ptrs +
 159                              info->layout.payload.nptrs];
 160     }
 161 }
 162
 163 #define STATIC_LINK2(info,p)                                                    \
 164    (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs +                  \
 165                                         info->layout.payload.nptrs + 1])))
 166
 167 /* -----------------------------------------------------------------------------
 168    INTLIKE and CHARLIKE closures.
 169    -------------------------------------------------------------------------- */
 170
 171 #define CHARLIKE_CLOSURE(n) ((P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE])
 172 #define INTLIKE_CLOSURE(n)  ((P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE])
 173
 174 /* ----------------------------------------------------------------------------
 175    Macros for untagging and retagging closure pointers
 176    For more information look at the comments in Cmm.h
 177    ------------------------------------------------------------------------- */
 178
 179 static inline StgWord
 180 GET_CLOSURE_TAG(StgClosure * p)
 181 {
 182     return (StgWord)p & TAG_MASK;
 183 }
 184
 185 static inline StgClosure *
 186 UNTAG_CLOSURE(StgClosure * p)
 187 {
 188     return (StgClosure*)((StgWord)p & ~TAG_MASK);
 189 }
 190
 191 static inline StgClosure *
 192 TAG_CLOSURE(StgWord tag,StgClosure * p)
 193 {
 194     return (StgClosure*)((StgWord)p | tag);
 195 }
 196
 197 /* -----------------------------------------------------------------------------
 198    Forwarding pointers
 199    -------------------------------------------------------------------------- */
 200
 201 #define IS_FORWARDING_PTR(p) ((((StgWord)p) & 1) != 0)
 202 #define MK_FORWARDING_PTR(p) (((StgWord)p) | 1)
 203 #define UN_FORWARDING_PTR(p) (((StgWord)p) - 1)
 204
 205 /* -----------------------------------------------------------------------------
 206    DEBUGGING predicates for pointers
 207
 208    LOOKS_LIKE_INFO_PTR(p)    returns False if p is definitely not an info ptr
 209    LOOKS_LIKE_CLOSURE_PTR(p) returns False if p is definitely not a closure ptr
 210
 211    These macros are complete but not sound.  That is, they might
 212    return false positives.  Do not rely on them to distinguish info
 213    pointers from closure pointers, for example.
 214
 215    We don't use address-space predicates these days, for portability
 216    reasons, and the fact that code/data can be scattered about the
 217    address space in a dynamically-linked environment.  Our best option
 218    is to look at the alleged info table and see whether it seems to
 219    make sense...
 220    -------------------------------------------------------------------------- */
 221
 222 INLINE_HEADER rtsBool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p)
 223 {
 224     StgInfoTable *info = INFO_PTR_TO_STRUCT(p);
 225     return info->type != INVALID_OBJECT && info->type < N_CLOSURE_TYPES;
 226 }
 227
 228 INLINE_HEADER rtsBool LOOKS_LIKE_INFO_PTR (StgWord p)
 229 {
 230     return p && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p));
 231 }
 232
 233 INLINE_HEADER rtsBool LOOKS_LIKE_CLOSURE_PTR (void *p)
 234 {
 235     return LOOKS_LIKE_INFO_PTR((StgWord)(UNTAG_CLOSURE((StgClosure *)(p)))->header.info);
 236 }
 237
 238 /* -----------------------------------------------------------------------------
 239    Macros for calculating the size of a closure
 240    -------------------------------------------------------------------------- */
 241
 242 EXTERN_INLINE StgOffset PAP_sizeW   ( nat n_args );
 243 EXTERN_INLINE StgOffset PAP_sizeW   ( nat n_args )
 244 { return sizeofW(StgPAP) + n_args; }
 245
 246 EXTERN_INLINE StgOffset AP_sizeW   ( nat n_args );
 247 EXTERN_INLINE StgOffset AP_sizeW   ( nat n_args )
 248 { return sizeofW(StgAP) + n_args; }
 249
 250 EXTERN_INLINE StgOffset AP_STACK_sizeW ( nat size );
 251 EXTERN_INLINE StgOffset AP_STACK_sizeW ( nat size )
 252 { return sizeofW(StgAP_STACK) + size; }
 253
 254 EXTERN_INLINE StgOffset CONSTR_sizeW( nat p, nat np );
 255 EXTERN_INLINE StgOffset CONSTR_sizeW( nat p, nat np )
 256 { return sizeofW(StgHeader) + p + np; }
 257
 258 EXTERN_INLINE StgOffset THUNK_SELECTOR_sizeW ( void );
 259 EXTERN_INLINE StgOffset THUNK_SELECTOR_sizeW ( void )
 260 { return sizeofW(StgSelector); }
 261
 262 EXTERN_INLINE StgOffset BLACKHOLE_sizeW ( void );
 263 EXTERN_INLINE StgOffset BLACKHOLE_sizeW ( void )
 264 { return sizeofW(StgInd); } // a BLACKHOLE is a kind of indirection
 265
 266 /* --------------------------------------------------------------------------
 267    Sizes of closures
 268    ------------------------------------------------------------------------*/
 269
 270 EXTERN_INLINE StgOffset sizeW_fromITBL( const StgInfoTable* itbl );
 271 EXTERN_INLINE StgOffset sizeW_fromITBL( const StgInfoTable* itbl )
 272 { return sizeofW(StgClosure)
 273        + sizeofW(StgPtr)  * itbl->layout.payload.ptrs
 274        + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
 275
 276 EXTERN_INLINE StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl );
 277 EXTERN_INLINE StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl )
 278 { return sizeofW(StgThunk)
 279        + sizeofW(StgPtr)  * itbl->layout.payload.ptrs
 280        + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
 281
 282 EXTERN_INLINE StgOffset ap_stack_sizeW( StgAP_STACK* x );
 283 EXTERN_INLINE StgOffset ap_stack_sizeW( StgAP_STACK* x )
 284 { return AP_STACK_sizeW(x->size); }
 285
 286 EXTERN_INLINE StgOffset ap_sizeW( StgAP* x );
 287 EXTERN_INLINE StgOffset ap_sizeW( StgAP* x )
 288 { return AP_sizeW(x->n_args); }
 289
 290 EXTERN_INLINE StgOffset pap_sizeW( StgPAP* x );
 291 EXTERN_INLINE StgOffset pap_sizeW( StgPAP* x )
 292 { return PAP_sizeW(x->n_args); }
 293
 294 EXTERN_INLINE StgWord arr_words_words( StgArrWords* x);
 295 EXTERN_INLINE StgWord arr_words_words( StgArrWords* x)
 296 { return ROUNDUP_BYTES_TO_WDS(x->bytes); }
 297
 298 EXTERN_INLINE StgOffset arr_words_sizeW( StgArrWords* x );
 299 EXTERN_INLINE StgOffset arr_words_sizeW( StgArrWords* x )
 300 { return sizeofW(StgArrWords) + arr_words_words(x); }
 301
 302 EXTERN_INLINE StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x );
 303 EXTERN_INLINE StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
 304 { return sizeofW(StgMutArrPtrs) + x->size; }
 305
 306 EXTERN_INLINE StgWord stack_sizeW ( StgStack *stack );
 307 EXTERN_INLINE StgWord stack_sizeW ( StgStack *stack )
 308 { return sizeofW(StgStack) + stack->stack_size; }
 309
 310 EXTERN_INLINE StgWord bco_sizeW ( StgBCO *bco );
 311 EXTERN_INLINE StgWord bco_sizeW ( StgBCO *bco )
 312 { return bco->size; }
 313
 314 EXTERN_INLINE nat closure_sizeW_ (StgClosure *p, StgInfoTable *info);
 315 EXTERN_INLINE nat
 316 closure_sizeW_ (StgClosure *p, StgInfoTable *info)
 317 {
 318     switch (info->type) {
 319     case THUNK_0_1:
 320     case THUNK_1_0:
 321         return sizeofW(StgThunk) + 1;
 322     case FUN_0_1:
 323     case CONSTR_0_1:
 324     case FUN_1_0:
 325     case CONSTR_1_0:
 326         return sizeofW(StgHeader) + 1;
 327     case THUNK_0_2:
 328     case THUNK_1_1:
 329     case THUNK_2_0:
 330         return sizeofW(StgThunk) + 2;
 331     case FUN_0_2:
 332     case CONSTR_0_2:
 333     case FUN_1_1:
 334     case CONSTR_1_1:
 335     case FUN_2_0:
 336     case CONSTR_2_0:
 337         return sizeofW(StgHeader) + 2;
 338     case THUNK:
 339         return thunk_sizeW_fromITBL(info);
 340     case THUNK_SELECTOR:
 341         return THUNK_SELECTOR_sizeW();
 342     case AP_STACK:
 343         return ap_stack_sizeW((StgAP_STACK *)p);
 344     case AP:
 345         return ap_sizeW((StgAP *)p);
 346     case PAP:
 347         return pap_sizeW((StgPAP *)p);
 348     case IND:
 349     case IND_PERM:
 350         return sizeofW(StgInd);
 351     case ARR_WORDS:
 352         return arr_words_sizeW((StgArrWords *)p);
 353     case MUT_ARR_PTRS_CLEAN:
 354     case MUT_ARR_PTRS_DIRTY:
 355     case MUT_ARR_PTRS_FROZEN:
 356     case MUT_ARR_PTRS_FROZEN0:
 357         return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
 358     case TSO:
 359         return sizeofW(StgTSO);
 360     case STACK:
 361         return stack_sizeW((StgStack*)p);
 362     case BCO:
 363         return bco_sizeW((StgBCO *)p);
 364     case TREC_CHUNK:
 365         return sizeofW(StgTRecChunk);
 366     default:
 367         return sizeW_fromITBL(info);
 368     }
 369 }
 370
 371 // The definitive way to find the size, in words, of a heap-allocated closure
 372 EXTERN_INLINE nat closure_sizeW (StgClosure *p);
 373 EXTERN_INLINE nat closure_sizeW (StgClosure *p)
 374 {
 375     return closure_sizeW_(p, get_itbl(p));
 376 }
 377
 378 /* -----------------------------------------------------------------------------
 379    Sizes of stack frames
 380    -------------------------------------------------------------------------- */
 381
 382 EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame );
 383 EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame )
 384 {
 385     StgRetInfoTable *info;
 386
 387     info = get_ret_itbl(frame);
 388     switch (info->i.type) {
 389
 390     case RET_DYN:
 391     {
 392         StgRetDyn *dyn = (StgRetDyn *)frame;
 393         return  sizeofW(StgRetDyn) + RET_DYN_BITMAP_SIZE +
 394             RET_DYN_NONPTR_REGS_SIZE +
 395             RET_DYN_PTRS(dyn->liveness) + RET_DYN_NONPTRS(dyn->liveness);
 396     }
 397
 398     case RET_FUN:
 399         return sizeofW(StgRetFun) + ((StgRetFun *)frame)->size;
 400
 401     case RET_BIG:
 402         return 1 + GET_LARGE_BITMAP(&info->i)->size;
 403
 404     case RET_BCO:
 405         return 2 + BCO_BITMAP_SIZE((StgBCO *)((P_)frame)[1]);
 406
 407     default:
 408         return 1 + BITMAP_SIZE(info->i.layout.bitmap);
 409     }
 410 }
 411
 412 /* -----------------------------------------------------------------------------
 413    StgMutArrPtrs macros
 414
 415    An StgMutArrPtrs has a card table to indicate which elements are
 416    dirty for the generational GC.  The card table is an array of
 417    bytes, where each byte covers (1 << MUT_ARR_PTRS_CARD_BITS)
 418    elements.  The card table is directly after the array data itself.
 419    -------------------------------------------------------------------------- */
 420
 421 // The number of card bytes needed
 422 INLINE_HEADER lnat mutArrPtrsCards (lnat elems)
 423 {
 424     return (lnat)((elems + (1 << MUT_ARR_PTRS_CARD_BITS) - 1)
 425                            >> MUT_ARR_PTRS_CARD_BITS);
 426 }
 427
 428 // The number of words in the card table
 429 INLINE_HEADER lnat mutArrPtrsCardTableSize (lnat elems)
 430 {
 431     return ROUNDUP_BYTES_TO_WDS(mutArrPtrsCards(elems));
 432 }
 433
 434 // The address of the card for a particular card number
 435 INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, lnat n)
 436 {
 437     return ((StgWord8 *)&(a->payload[a->ptrs]) + n);
 438 }
 439
 440 /* -----------------------------------------------------------------------------
 441    Replacing a closure with a different one.  We must call
 442    OVERWRITING_CLOSURE(p) on the old closure that is about to be
 443    overwritten.
 444
 445    In PROFILING mode, LDV profiling requires that we fill the slop
 446    with zeroes, and record the old closure as dead (LDV_recordDead()).
 447
 448    In DEBUG mode, we must overwrite the slop with zeroes, because the
 449    sanity checker wants to walk through the heap checking all the
 450    pointers.
 451
 452    In multicore mode, we *cannot* overwrite slop with zeroes, because
 453    another thread might be reading it.  So,
 454
 455       PROFILING is not compatible with  +RTS -N<n> (for n > 1)
 456
 457       THREADED_RTS can be used with DEBUG, but full heap sanity
 458       checking is disabled.
 459
 460    -------------------------------------------------------------------------- */
 461
 462 #if defined(PROFILING) || (!defined(THREADED_RTS) && defined(DEBUG))
 463 #define OVERWRITING_CLOSURE(c) overwritingClosure(c)
 464 #else
 465 #define OVERWRITING_CLOSURE(c) /* nothing */
 466 #endif
 467
 468 #ifdef PROFILING
 469 void LDV_recordDead (StgClosure *c, nat size);
 470 #endif
 471
 472 EXTERN_INLINE void overwritingClosure (StgClosure *p);
 473 EXTERN_INLINE void overwritingClosure (StgClosure *p)
 474 {
 475     nat size, i;
 476
 477 #if defined(PROFILING)
 478     if (era <= 0) return;
 479 #endif
 480
 481     size = closure_sizeW(p);
 482
 483     // For LDV profiling, we need to record the closure as dead
 484 #if defined(PROFILING)
 485     LDV_recordDead((StgClosure *)(p), size);
 486 #endif
 487
 488     for (i = 0; i < size - sizeofW(StgThunkHeader); i++) {
 489         ((StgThunk *)(p))->payload[i] = 0;
 490     }
 491 }
 492
 493 #endif /* RTS_STORAGE_CLOSUREMACROS_H */