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_words)     \
 129    SET_HDR(c,info,costCentreStack);                     \
 130    (c)->words = n_words;
 131
 132 /* -----------------------------------------------------------------------------
 133    How to get hold of the static link field for a static closure.
 134    -------------------------------------------------------------------------- */
 135
 136 /* These are hard-coded. */
 137 #define FUN_STATIC_LINK(p)   (&(p)->payload[0])
 138 #define THUNK_STATIC_LINK(p) (&(p)->payload[1])
 139 #define IND_STATIC_LINK(p)   (&(p)->payload[1])
 140
 141 INLINE_HEADER StgClosure **
 142 STATIC_LINK(const StgInfoTable *info, StgClosure *p)
 143 {
 144     switch (info->type) {
 145     case THUNK_STATIC:
 146         return THUNK_STATIC_LINK(p);
 147     case FUN_STATIC:
 148         return FUN_STATIC_LINK(p);
 149     case IND_STATIC:
 150         return IND_STATIC_LINK(p);
 151     default:
 152         return &(p)->payload[info->layout.payload.ptrs +
 153                              info->layout.payload.nptrs];
 154     }
 155 }
 156
 157 #define STATIC_LINK2(info,p)                                                    \
 158    (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs +                  \
 159                                         info->layout.payload.nptrs + 1])))
 160
 161 /* -----------------------------------------------------------------------------
 162    INTLIKE and CHARLIKE closures.
 163    -------------------------------------------------------------------------- */
 164
 165 #define CHARLIKE_CLOSURE(n) ((P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE])
 166 #define INTLIKE_CLOSURE(n)  ((P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE])
 167
 168 /* ----------------------------------------------------------------------------
 169    Macros for untagging and retagging closure pointers
 170    For more information look at the comments in Cmm.h
 171    ------------------------------------------------------------------------- */
 172
 173 static inline StgWord
 174 GET_CLOSURE_TAG(StgClosure * p)
 175 {
 176     return (StgWord)p & TAG_MASK;
 177 }
 178
 179 static inline StgClosure *
 180 UNTAG_CLOSURE(StgClosure * p)
 181 {
 182     return (StgClosure*)((StgWord)p & ~TAG_MASK);
 183 }
 184
 185 static inline StgClosure *
 186 TAG_CLOSURE(StgWord tag,StgClosure * p)
 187 {
 188     return (StgClosure*)((StgWord)p | tag);
 189 }
 190
 191 /* -----------------------------------------------------------------------------
 192    Forwarding pointers
 193    -------------------------------------------------------------------------- */
 194
 195 #define IS_FORWARDING_PTR(p) ((((StgWord)p) & 1) != 0)
 196 #define MK_FORWARDING_PTR(p) (((StgWord)p) | 1)
 197 #define UN_FORWARDING_PTR(p) (((StgWord)p) - 1)
 198
 199 /* -----------------------------------------------------------------------------
 200    DEBUGGING predicates for pointers
 201
 202    LOOKS_LIKE_INFO_PTR(p)    returns False if p is definitely not an info ptr
 203    LOOKS_LIKE_CLOSURE_PTR(p) returns False if p is definitely not a closure ptr
 204
 205    These macros are complete but not sound.  That is, they might
 206    return false positives.  Do not rely on them to distinguish info
 207    pointers from closure pointers, for example.
 208
 209    We don't use address-space predicates these days, for portability
 210    reasons, and the fact that code/data can be scattered about the
 211    address space in a dynamically-linked environment.  Our best option
 212    is to look at the alleged info table and see whether it seems to
 213    make sense...
 214    -------------------------------------------------------------------------- */
 215
 216 INLINE_HEADER rtsBool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p)
 217 {
 218     StgInfoTable *info = INFO_PTR_TO_STRUCT(p);
 219     return info->type != INVALID_OBJECT && info->type < N_CLOSURE_TYPES;
 220 }
 221
 222 INLINE_HEADER rtsBool LOOKS_LIKE_INFO_PTR (StgWord p)
 223 {
 224     return p && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p));
 225 }
 226
 227 INLINE_HEADER rtsBool LOOKS_LIKE_CLOSURE_PTR (void *p)
 228 {
 229     return LOOKS_LIKE_INFO_PTR((StgWord)(UNTAG_CLOSURE((StgClosure *)(p)))->header.info);
 230 }
 231
 232 /* -----------------------------------------------------------------------------
 233    Macros for calculating the size of a closure
 234    -------------------------------------------------------------------------- */
 235
 236 INLINE_HEADER StgOffset PAP_sizeW   ( nat n_args )
 237 { return sizeofW(StgPAP) + n_args; }
 238
 239 INLINE_HEADER StgOffset AP_sizeW   ( nat n_args )
 240 { return sizeofW(StgAP) + n_args; }
 241
 242 INLINE_HEADER StgOffset AP_STACK_sizeW ( nat size )
 243 { return sizeofW(StgAP_STACK) + size; }
 244
 245 INLINE_HEADER StgOffset CONSTR_sizeW( nat p, nat np )
 246 { return sizeofW(StgHeader) + p + np; }
 247
 248 INLINE_HEADER StgOffset THUNK_SELECTOR_sizeW ( void )
 249 { return sizeofW(StgSelector); }
 250
 251 INLINE_HEADER StgOffset BLACKHOLE_sizeW ( void )
 252 { return sizeofW(StgHeader)+MIN_PAYLOAD_SIZE; }
 253
 254 /* --------------------------------------------------------------------------
 255    Sizes of closures
 256    ------------------------------------------------------------------------*/
 257
 258 INLINE_HEADER StgOffset sizeW_fromITBL( const StgInfoTable* itbl )
 259 { return sizeofW(StgClosure)
 260        + sizeofW(StgPtr)  * itbl->layout.payload.ptrs
 261        + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
 262
 263 INLINE_HEADER StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl )
 264 { return sizeofW(StgThunk)
 265        + sizeofW(StgPtr)  * itbl->layout.payload.ptrs
 266        + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
 267
 268 INLINE_HEADER StgOffset ap_stack_sizeW( StgAP_STACK* x )
 269 { return AP_STACK_sizeW(x->size); }
 270
 271 INLINE_HEADER StgOffset ap_sizeW( StgAP* x )
 272 { return AP_sizeW(x->n_args); }
 273
 274 INLINE_HEADER StgOffset pap_sizeW( StgPAP* x )
 275 { return PAP_sizeW(x->n_args); }
 276
 277 INLINE_HEADER StgOffset arr_words_sizeW( StgArrWords* x )
 278 { return sizeofW(StgArrWords) + x->words; }
 279
 280 INLINE_HEADER StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
 281 { return sizeofW(StgMutArrPtrs) + x->size; }
 282
 283 INLINE_HEADER StgWord tso_sizeW ( StgTSO *tso )
 284 { return TSO_STRUCT_SIZEW + tso->stack_size; }
 285
 286 INLINE_HEADER StgWord bco_sizeW ( StgBCO *bco )
 287 { return bco->size; }
 288
 289 INLINE_HEADER nat
 290 closure_sizeW_ (StgClosure *p, StgInfoTable *info)
 291 {
 292     switch (info->type) {
 293     case THUNK_0_1:
 294     case THUNK_1_0:
 295         return sizeofW(StgThunk) + 1;
 296     case FUN_0_1:
 297     case CONSTR_0_1:
 298     case FUN_1_0:
 299     case CONSTR_1_0:
 300         return sizeofW(StgHeader) + 1;
 301     case THUNK_0_2:
 302     case THUNK_1_1:
 303     case THUNK_2_0:
 304         return sizeofW(StgThunk) + 2;
 305     case FUN_0_2:
 306     case CONSTR_0_2:
 307     case FUN_1_1:
 308     case CONSTR_1_1:
 309     case FUN_2_0:
 310     case CONSTR_2_0:
 311         return sizeofW(StgHeader) + 2;
 312     case THUNK:
 313         return thunk_sizeW_fromITBL(info);
 314     case THUNK_SELECTOR:
 315         return THUNK_SELECTOR_sizeW();
 316     case AP_STACK:
 317         return ap_stack_sizeW((StgAP_STACK *)p);
 318     case AP:
 319         return ap_sizeW((StgAP *)p);
 320     case PAP:
 321         return pap_sizeW((StgPAP *)p);
 322     case IND:
 323     case IND_PERM:
 324     case IND_OLDGEN:
 325     case IND_OLDGEN_PERM:
 326         return sizeofW(StgInd);
 327     case ARR_WORDS:
 328         return arr_words_sizeW((StgArrWords *)p);
 329     case MUT_ARR_PTRS_CLEAN:
 330     case MUT_ARR_PTRS_DIRTY:
 331     case MUT_ARR_PTRS_FROZEN:
 332     case MUT_ARR_PTRS_FROZEN0:
 333         return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
 334     case TSO:
 335         return tso_sizeW((StgTSO *)p);
 336     case BCO:
 337         return bco_sizeW((StgBCO *)p);
 338     case TREC_CHUNK:
 339         return sizeofW(StgTRecChunk);
 340     default:
 341         return sizeW_fromITBL(info);
 342     }
 343 }
 344
 345 // The definitive way to find the size, in words, of a heap-allocated closure
 346 INLINE_HEADER nat
 347 closure_sizeW (StgClosure *p)
 348 {
 349     return closure_sizeW_(p, get_itbl(p));
 350 }
 351
 352 /* -----------------------------------------------------------------------------
 353    Sizes of stack frames
 354    -------------------------------------------------------------------------- */
 355
 356 INLINE_HEADER StgWord stack_frame_sizeW( StgClosure *frame )
 357 {
 358     StgRetInfoTable *info;
 359
 360     info = get_ret_itbl(frame);
 361     switch (info->i.type) {
 362
 363     case RET_DYN:
 364     {
 365         StgRetDyn *dyn = (StgRetDyn *)frame;
 366         return  sizeofW(StgRetDyn) + RET_DYN_BITMAP_SIZE +
 367             RET_DYN_NONPTR_REGS_SIZE +
 368             RET_DYN_PTRS(dyn->liveness) + RET_DYN_NONPTRS(dyn->liveness);
 369     }
 370
 371     case RET_FUN:
 372         return sizeofW(StgRetFun) + ((StgRetFun *)frame)->size;
 373
 374     case RET_BIG:
 375         return 1 + GET_LARGE_BITMAP(&info->i)->size;
 376
 377     case RET_BCO:
 378         return 2 + BCO_BITMAP_SIZE((StgBCO *)((P_)frame)[1]);
 379
 380     default:
 381         return 1 + BITMAP_SIZE(info->i.layout.bitmap);
 382     }
 383 }
 384
 385 /* -----------------------------------------------------------------------------
 386    StgMutArrPtrs macros
 387
 388    An StgMutArrPtrs has a card table to indicate which elements are
 389    dirty for the generational GC.  The card table is an array of
 390    bytes, where each byte covers (1 << MUT_ARR_PTRS_CARD_BITS)
 391    elements.  The card table is directly after the array data itself.
 392    -------------------------------------------------------------------------- */
 393
 394 // The number of card bytes needed
 395 INLINE_HEADER lnat mutArrPtrsCards (lnat elems)
 396 {
 397     return (lnat)((elems + (1 << MUT_ARR_PTRS_CARD_BITS) - 1)
 398                            >> MUT_ARR_PTRS_CARD_BITS);
 399 }
 400
 401 // The number of words in the card table
 402 INLINE_HEADER lnat mutArrPtrsCardTableSize (lnat elems)
 403 {
 404     return ROUNDUP_BYTES_TO_WDS(mutArrPtrsCards(elems));
 405 }
 406
 407 // The address of the card for a particular card number
 408 INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, lnat n)
 409 {
 410     return ((StgWord8 *)&(a->payload[a->ptrs]) + n);
 411 }
 412
 413 #endif /* RTS_STORAGE_CLOSUREMACROS_H */