includes/ClosureMacros.h

   1 /* ----------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team, 1998-2004
   4  *
   5  * Macros for building and manipulating closures
   6  *
   7  * -------------------------------------------------------------------------- */
   8
   9 #ifndef CLOSUREMACROS_H
  10 #define CLOSUREMACROS_H
  11
  12 /* Say whether the code comes before the heap; on mingwin this may not be the
  13    case, not because of another random MS pathology, but because the static
  14    program may reside in a DLL
  15 */
  16
  17 /* -----------------------------------------------------------------------------
  18    Info tables are slammed up against the entry code, and the label
  19    for the info table is at the *end* of the table itself.  This
  20    inline function adjusts an info pointer to point to the beginning
  21    of the table, so we can use standard C structure indexing on it.
  22
  23    Note: this works for SRT info tables as long as you don't want to
  24    access the SRT, since they are laid out the same with the SRT
  25    pointer as the first word in the table.
  26
  27    NOTES ABOUT MANGLED C VS. MINI-INTERPRETER:
  28
  29    A couple of definitions:
  30
  31        "info pointer"    The first word of the closure.  Might point
  32                          to either the end or the beginning of the
  33                          info table, depending on whether we're using
  34                          the mini interpretter or not.  GET_INFO(c)
  35                          retrieves the info pointer of a closure.
  36
  37        "info table"      The info table structure associated with a
  38                          closure.  This is always a pointer to the
  39                          beginning of the structure, so we can
  40                          use standard C structure indexing to pull out
  41                          the fields.  get_itbl(c) returns a pointer to
  42                          the info table for closure c.
  43
  44    An address of the form xxxx_info points to the end of the info
  45    table or the beginning of the info table depending on whether we're
  46    mangling or not respectively.  So,
  47
  48          c->header.info = xxx_info
  49
  50    makes absolute sense, whether mangling or not.
  51
  52    -------------------------------------------------------------------------- */
  53
  54 #define SET_INFO(c,i) ((c)->header.info = (i))
  55 #define GET_INFO(c)   ((c)->header.info)
  56 #define GET_ENTRY(c)  (ENTRY_CODE(GET_INFO(c)))
  57
  58 #define get_itbl(c)   (INFO_PTR_TO_STRUCT((c)->header.info))
  59 #define get_ret_itbl(c) (RET_INFO_PTR_TO_STRUCT((c)->header.info))
  60 #define get_fun_itbl(c) (FUN_INFO_PTR_TO_STRUCT((c)->header.info))
  61 #define get_thunk_itbl(c) (THUNK_INFO_PTR_TO_STRUCT((c)->header.info))
  62 #define get_con_itbl(c) (CON_INFO_PTR_TO_STRUCT((c)->header.info))
  63
  64 #define GET_TAG(con) (get_itbl(con)->srt_bitmap)
  65
  66 #ifdef TABLES_NEXT_TO_CODE
  67 #define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)(info) - 1)
  68 #define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)(info) - 1)
  69 #define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)(info) - 1)
  70 #define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)(info) - 1)
  71 #define CON_INFO_PTR_TO_STRUCT(info) ((StgConInfoTable *)(info) - 1)
  72 #define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
  73 #define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
  74 #define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
  75 #define itbl_to_con_itbl(i) ((StgConInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
  76 #else
  77 #define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)info)
  78 #define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)info)
  79 #define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)info)
  80 #define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)info)
  81 #define CON_INFO_PTR_TO_STRUCT(info) ((StgConInfoTable *)info)
  82 #define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(i))
  83 #define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(i))
  84 #define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(i))
  85 #define itbl_to_con_itbl(i) ((StgConInfoTable *)(i))
  86 #endif
  87
  88 /* -----------------------------------------------------------------------------
  89    Macros for building closures
  90    -------------------------------------------------------------------------- */
  91
  92 #ifdef PROFILING
  93 #ifdef DEBUG_RETAINER
  94 /*
  95   For the sake of debugging, we take the safest way for the moment. Actually, this
  96   is useful to check the sanity of heap before beginning retainer profiling.
  97   flip is defined in RetainerProfile.c, and declared as extern in RetainerProfile.h.
  98   Note: change those functions building Haskell objects from C datatypes, i.e.,
  99   all rts_mk???() functions in RtsAPI.c, as well.
 100  */
 101 #define SET_PROF_HDR(c,ccs_)            \
 102         ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip))
 103 #else
 104 /*
 105   For retainer profiling only: we do not have to set (c)->header.prof.hp.rs to
 106   NULL | flip (flip is defined in RetainerProfile.c) because even when flip
 107   is 1, rs is invalid and will be initialized to NULL | flip later when
 108   the closure *c is visited.
 109  */
 110 /*
 111 #define SET_PROF_HDR(c,ccs_)            \
 112         ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = NULL)
 113  */
 114 /*
 115   The following macro works for both retainer profiling and LDV profiling:
 116   for retainer profiling, ldvTime remains 0, so rs fields are initialized to 0.
 117   See the invariants on ldvTime.
 118  */
 119 #define SET_PROF_HDR(c,ccs_)            \
 120         ((c)->header.prof.ccs = ccs_,   \
 121         LDV_RECORD_CREATE((c)))
 122 #endif /* DEBUG_RETAINER */
 123 #define SET_STATIC_PROF_HDR(ccs_)       \
 124         prof : { ccs : (CostCentreStack *)ccs_, hp : { rs : NULL } },
 125 #else
 126 #define SET_PROF_HDR(c,ccs)
 127 #define SET_STATIC_PROF_HDR(ccs)
 128 #endif
 129
 130 #ifdef TICKY_TICKY
 131 #define SET_TICKY_HDR(c,stuff)       /* old: (c)->header.ticky.updated = stuff */
 132 #define SET_STATIC_TICKY_HDR(stuff)  /* old: ticky : { updated : stuff } */
 133 #else
 134 #define SET_TICKY_HDR(c,stuff)
 135 #define SET_STATIC_TICKY_HDR(stuff)
 136 #endif
 137
 138 #define SET_HDR(c,_info,ccs)                            \
 139    {                                                    \
 140         (c)->header.info = _info;                       \
 141         SET_PROF_HDR((StgClosure *)(c),ccs);            \
 142         SET_TICKY_HDR((StgClosure *)(c),0);             \
 143    }
 144
 145 #define SET_ARR_HDR(c,info,costCentreStack,n_words)     \
 146    SET_HDR(c,info,costCentreStack);                     \
 147    (c)->words = n_words;
 148
 149 /* -----------------------------------------------------------------------------
 150    How to get hold of the static link field for a static closure.
 151    -------------------------------------------------------------------------- */
 152
 153 /* These are hard-coded. */
 154 #define FUN_STATIC_LINK(p)   (&(p)->payload[0])
 155 #define THUNK_STATIC_LINK(p) (&(p)->payload[1])
 156 #define IND_STATIC_LINK(p)   (&(p)->payload[1])
 157
 158 INLINE_HEADER StgClosure **
 159 STATIC_LINK(const StgInfoTable *info, StgClosure *p)
 160 {
 161     switch (info->type) {
 162     case THUNK_STATIC:
 163         return THUNK_STATIC_LINK(p);
 164     case FUN_STATIC:
 165         return FUN_STATIC_LINK(p);
 166     case IND_STATIC:
 167         return IND_STATIC_LINK(p);
 168     default:
 169         return &(p)->payload[info->layout.payload.ptrs +
 170                              info->layout.payload.nptrs];
 171     }
 172 }
 173
 174 #define STATIC_LINK2(info,p)                                                    \
 175    (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs +                  \
 176                                         info->layout.payload.nptrs + 1])))
 177
 178 /* -----------------------------------------------------------------------------
 179    INTLIKE and CHARLIKE closures.
 180    -------------------------------------------------------------------------- */
 181
 182 #define CHARLIKE_CLOSURE(n) ((P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE])
 183 #define INTLIKE_CLOSURE(n)  ((P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE])
 184
 185 #endif /* CLOSUREMACROS_H */