ghc/includes/ClosureMacros.h

   1 /* ----------------------------------------------------------------------------
   2  * $Id: ClosureMacros.h,v 1.37 2003/06/30 14:17:02 simonmar Exp $
   3  *
   4  * (c) The GHC Team, 1998-1999
   5  *
   6  * Macros for building and manipulating closures
   7  *
   8  * -------------------------------------------------------------------------- */
   9
  10 #ifndef CLOSUREMACROS_H
  11 #define CLOSUREMACROS_H
  12
  13 /* Say whether the code comes before the heap; on mingwin this may not be the
  14    case, not because of another random MS pathology, but because the static
  15    program may reside in a DLL
  16 */
  17
  18 /* -----------------------------------------------------------------------------
  19    Info tables are slammed up against the entry code, and the label
  20    for the info table is at the *end* of the table itself.  This
  21    inline function adjusts an info pointer to point to the beginning
  22    of the table, so we can use standard C structure indexing on it.
  23
  24    Note: this works for SRT info tables as long as you don't want to
  25    access the SRT, since they are laid out the same with the SRT
  26    pointer as the first word in the table.
  27
  28    NOTES ABOUT MANGLED C VS. MINI-INTERPRETER:
  29
  30    A couple of definitions:
  31
  32        "info pointer"    The first word of the closure.  Might point
  33                          to either the end or the beginning of the
  34                          info table, depending on whether we're using
  35                          the mini interpretter or not.  GET_INFO(c)
  36                          retrieves the info pointer of a closure.
  37
  38        "info table"      The info table structure associated with a
  39                          closure.  This is always a pointer to the
  40                          beginning of the structure, so we can
  41                          use standard C structure indexing to pull out
  42                          the fields.  get_itbl(c) returns a pointer to
  43                          the info table for closure c.
  44
  45    An address of the form xxxx_info points to the end of the info
  46    table or the beginning of the info table depending on whether we're
  47    mangling or not respectively.  So,
  48
  49          c->header.info = xxx_info
  50
  51    makes absolute sense, whether mangling or not.
  52
  53    -------------------------------------------------------------------------- */
  54
  55 #define INIT_INFO(i)  info : (StgInfoTable *)&(i)
  56 #define SET_INFO(c,i) ((c)->header.info = (i))
  57 #define GET_INFO(c)   ((c)->header.info)
  58 #define GET_ENTRY(c)  (ENTRY_CODE(GET_INFO(c)))
  59
  60 #define get_itbl(c)   (INFO_PTR_TO_STRUCT((c)->header.info))
  61 #define get_ret_itbl(c) (RET_INFO_PTR_TO_STRUCT((c)->header.info))
  62 #define get_fun_itbl(c) (FUN_INFO_PTR_TO_STRUCT((c)->header.info))
  63 #define get_thunk_itbl(c) (THUNK_INFO_PTR_TO_STRUCT((c)->header.info))
  64
  65
  66 #ifdef TABLES_NEXT_TO_CODE
  67 #define INIT_ENTRY(e)
  68 #define ENTRY_CODE(info) (info)
  69 #define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)(info) - 1)
  70 #define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)(info) - 1)
  71 #define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)(info) - 1)
  72 #define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)(info) - 1)
  73 static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
  74     return (StgFunPtr)(itbl+1);
  75 }
  76 #define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
  77 #define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
  78 #define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
  79 #else
  80 #define INIT_ENTRY(e)    entry : (F_)(e)
  81 #define ENTRY_CODE(info) (((StgInfoTable *)info)->entry)
  82 #define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)info)
  83 #define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)info)
  84 #define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)info)
  85 #define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)info)
  86 static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
  87     return itbl->entry;
  88 }
  89 #define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(i))
  90 #define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(i))
  91 #define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(i))
  92 #endif
  93
  94 /* -----------------------------------------------------------------------------
  95    Macros for building closures
  96    -------------------------------------------------------------------------- */
  97
  98 #ifdef PROFILING
  99 #ifdef DEBUG_RETAINER
 100 /*
 101   For the sake of debugging, we take the safest way for the moment. Actually, this
 102   is useful to check the sanity of heap before beginning retainer profiling.
 103   flip is defined in RetainerProfile.c, and declared as extern in RetainerProfile.h.
 104   Note: change those functions building Haskell objects from C datatypes, i.e.,
 105   all rts_mk???() functions in RtsAPI.c, as well.
 106  */
 107 extern StgWord flip;
 108 #define SET_PROF_HDR(c,ccs_)            \
 109         ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip))
 110 #else
 111 /*
 112   For retainer profiling only: we do not have to set (c)->header.prof.hp.rs to
 113   NULL | flip (flip is defined in RetainerProfile.c) because even when flip
 114   is 1, rs is invalid and will be initialized to NULL | flip later when
 115   the closure *c is visited.
 116  */
 117 /*
 118 #define SET_PROF_HDR(c,ccs_)            \
 119         ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = NULL)
 120  */
 121 /*
 122   The following macro works for both retainer profiling and LDV profiling:
 123   for retainer profiling, ldvTime remains 0, so rs fields are initialized to 0.
 124   See the invariants on ldvTime.
 125  */
 126 #define SET_PROF_HDR(c,ccs_)            \
 127         ((c)->header.prof.ccs = ccs_,   \
 128         LDV_recordCreate((c)))
 129 #endif  // DEBUG_RETAINER
 130 #define SET_STATIC_PROF_HDR(ccs_)       \
 131         prof : { ccs : ccs_, hp : { rs : NULL } },
 132 #else
 133 #define SET_PROF_HDR(c,ccs)
 134 #define SET_STATIC_PROF_HDR(ccs)
 135 #endif
 136
 137 #ifdef GRAN
 138 #define SET_GRAN_HDR(c,pe)              (c)->header.gran.procs = pe
 139 #define SET_STATIC_GRAN_HDR             gran : { procs : Everywhere },
 140 #else
 141 #define SET_GRAN_HDR(c,pe)
 142 #define SET_STATIC_GRAN_HDR
 143 #endif
 144
 145 #ifdef PAR
 146 #define SET_PAR_HDR(c,stuff)
 147 #define SET_STATIC_PAR_HDR(stuff)
 148 #else
 149 #define SET_PAR_HDR(c,stuff)
 150 #define SET_STATIC_PAR_HDR(stuff)
 151 #endif
 152
 153 #ifdef TICKY_TICKY
 154 #define SET_TICKY_HDR(c,stuff)       /* old: (c)->header.ticky.updated = stuff */
 155 #define SET_STATIC_TICKY_HDR(stuff)  /* old: ticky : { updated : stuff } */
 156 #else
 157 #define SET_TICKY_HDR(c,stuff)
 158 #define SET_STATIC_TICKY_HDR(stuff)
 159 #endif
 160
 161 #define SET_HDR(c,info,ccs)                             \
 162    {                                                    \
 163         SET_INFO(c,info);                               \
 164         SET_GRAN_HDR((StgClosure *)(c),ThisPE);         \
 165         SET_PAR_HDR((StgClosure *)(c),LOCAL_GA);        \
 166         SET_PROF_HDR((StgClosure *)(c),ccs);            \
 167         SET_TICKY_HDR((StgClosure *)(c),0);             \
 168    }
 169
 170 #define SET_ARR_HDR(c,info,costCentreStack,n_words)     \
 171    SET_HDR(c,info,costCentreStack);                     \
 172    (c)->words = n_words;
 173
 174 /* -----------------------------------------------------------------------------
 175    Static closures are defined as follows:
 176
 177
 178    SET_STATIC_HDR(PrelBase_CZh_closure,PrelBase_CZh_info,costCentreStack,closure_class,info_class);
 179
 180    The info argument must have type 'StgInfoTable' or
 181    'StgSRTInfoTable', since we use '&' to get its address in the macro.
 182    -------------------------------------------------------------------------- */
 183
 184 #define SET_STATIC_HDR(label,info,costCentreStack,closure_class,info_class)     \
 185    info_class info;                                                             \
 186    closure_class StgClosure label = {                                           \
 187    STATIC_HDR(info,costCentreStack)
 188
 189 #define STATIC_HDR(info,ccs)                    \
 190         header : {                              \
 191                 INIT_INFO(info),                \
 192                 SET_STATIC_GRAN_HDR             \
 193                 SET_STATIC_PAR_HDR(LOCAL_GA)    \
 194                 SET_STATIC_PROF_HDR(ccs)        \
 195                 SET_STATIC_TICKY_HDR(0)         \
 196         }
 197
 198 /* how to get hold of the static link field for a static closure.
 199  *
 200  * Note that we have to use (*cast(T*,&e)) instead of cast(T,e)
 201  * because C won't let us take the address of a casted expression. Huh?
 202  */
 203 #define STATIC_LINK(info,p)                                             \
 204    (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs +          \
 205                                         info->layout.payload.nptrs])))
 206
 207 /* These macros are optimised versions of the above for certain
 208  * closure types.  They *must* be equivalent to the generic
 209  * STATIC_LINK.
 210  *
 211  * You may be surprised that the STATIC_LINK field for a THUNK_STATIC
 212  * is at offset 2; that's because a THUNK_STATIC always has two words
 213  * of (non-ptr) padding, to make room for the IND_STATIC that is
 214  * going to overwrite it.  It doesn't do any harm, because a
 215  * THUNK_STATIC needs this extra word for the IND_STATIC's saved_info
 216  * field anyhow.  Hmm, this is all rather delicate. --SDM
 217  */
 218 #define FUN_STATIC_LINK(p)   ((p)->payload[0])
 219 #define THUNK_STATIC_LINK(p) ((p)->payload[2])
 220 #define IND_STATIC_LINK(p)   ((p)->payload[1])
 221
 222 #define STATIC_LINK2(info,p)                                                    \
 223    (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs +                  \
 224                                         info->layout.payload.nptrs + 1])))
 225
 226 /* -----------------------------------------------------------------------------
 227    INTLIKE and CHARLIKE closures.
 228    -------------------------------------------------------------------------- */
 229
 230 #define CHARLIKE_CLOSURE(n) ((P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE])
 231 #define INTLIKE_CLOSURE(n)  ((P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE])
 232
 233 /* -----------------------------------------------------------------------------
 234    Closure Tables (for enumerated data types)
 235    -------------------------------------------------------------------------- */
 236
 237 #define CLOSURE_TBL(lbl) const StgClosure *lbl[] = {
 238
 239 /* -----------------------------------------------------------------------------
 240    CONSTRs.
 241    -------------------------------------------------------------------------- */
 242
 243 /* constructors don't have SRTs */
 244 #define GET_TAG(info) (INFO_PTR_TO_STRUCT(info)->srt_bitmap)
 245
 246 #endif /* CLOSUREMACROS_H */