ghc/includes/ClosureMacros.h

   1 /* ----------------------------------------------------------------------------
   2  * $Id: ClosureMacros.h,v 1.5 1999/03/02 19:44:08 sof 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 /* -----------------------------------------------------------------------------
  14    Fixed Header Size
  15
  16    The compiler tries to abstract away from the actual value of this
  17    constant.
  18    -------------------------------------------------------------------------- */
  19
  20 #define _FHS  sizeof(StgHeader)
  21
  22 /* -----------------------------------------------------------------------------
  23    Info tables are slammed up against the entry code, and the label
  24    for the info table is at the *end* of the table itself.  This
  25    inline function adjusts an info pointer to point to the beginning
  26    of the table, so we can use standard C structure indexing on it.
  27
  28    Note: this works for SRT info tables as long as you don't want to
  29    access the SRT, since they are laid out the same with the SRT
  30    pointer as the first word in the table.
  31
  32    NOTES ABOUT MANGLED C VS. MINI-INTERPRETER:
  33
  34    A couple of definitions:
  35
  36        "info pointer"    The first word of the closure.  Might point
  37                          to either the end or the beginning of the
  38                          info table, depending on whether we're using
  39                          the mini interpretter or not.  GET_INFO(c)
  40                          retrieves the info pointer of a closure.
  41
  42        "info table"      The info table structure associated with a
  43                          closure.  This is always a pointer to the
  44                          beginning of the structure, so we can
  45                          use standard C structure indexing to pull out
  46                          the fields.  get_itbl(c) returns a pointer to
  47                          the info table for closure c.
  48
  49    An address of the form xxxx_info points to the end of the info
  50    table or the beginning of the info table depending on whether we're
  51    mangling or not respectively.  So,
  52
  53          c->header.info = xxx_info
  54
  55    makes absolute sense, whether mangling or not.
  56
  57    -------------------------------------------------------------------------- */
  58
  59 #define INIT_INFO(i)  info : &(i)
  60 #define SET_INFO(c,i) ((c)->header.info = (i))
  61 #define GET_INFO(c)   ((c)->header.info)
  62
  63 #if USE_MINIINTERPRETER
  64 #define INIT_ENTRY(e)    entry : (F_)(e)
  65 #define GET_ENTRY(c)     ((c)->header.info->entry)
  66 #define ENTRY_CODE(info) (stgCast(StgInfoTable*,info)->entry)
  67 #define INFO_PTR_TO_STRUCT(info) (info)
  68 #define get_itbl(c)      ((c)->header.info)
  69 static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
  70     return itbl->entry;
  71 }
  72 #else
  73 #define INIT_ENTRY(e)    code : {}
  74 #define GET_ENTRY(c)     stgCast(StgFunPtr,((c)->header.info))
  75 #define ENTRY_CODE(info) (info)
  76 #define INFO_PTR_TO_STRUCT(info) (stgCast(StgInfoTable*,info) - 1)
  77 #define get_itbl(c)      (stgCast(StgInfoTable*,(c)->header.info) -1)
  78 static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
  79     return stgCast(StgFunPtr,itbl+1);
  80 }
  81 #endif
  82
  83 /* -----------------------------------------------------------------------------
  84    Macros for distinguishing data pointers from code pointers
  85    -------------------------------------------------------------------------- */
  86 /*
  87  * We use some symbols inserted automatically by the linker to decide
  88  * whether a pointer points to text, data, or user space.  These tests
  89  * assume that text is lower in the address space than data, which in
  90  * turn is lower than user allocated memory.
  91  *
  92  * If this assumption is false (say on some strange architecture) then
  93  * the tests IS_CODE_PTR and IS_DATA_PTR below will need to be
  94  * modified (and that should be all that's necessary).
  95  *
  96  * _start      } start of read-only text space
  97  * _etext      } end   of read-only text space
  98  * _end } end of read-write data space
  99  */
 100 extern StgFun start;
 101 extern StgFun TEXT_SECTION_END_MARKER_DECL;
 102 extern StgFun DATA_SECTION_END_MARKER_DECL;
 103
 104 #define IS_CODE_PTR(p) ((P_)(p) < (P_)&TEXT_SECTION_END_MARKER)
 105 #define IS_DATA_PTR(p) ((P_)(p) >= (P_)&TEXT_SECTION_END_MARKER && (P_)(p) < (P_)&DATA_SECTION_END_MARKER)
 106 #define IS_USER_PTR(p) ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER)
 107
 108 #ifdef HAVE_WIN32_DLL_SUPPORT
 109 /* ToDo: clean up */
 110 extern char* base_non_committed;
 111 #define HEAP_ALLOCED(x)  (((char*)(x) >= base_non_committed) && ((char*)(x) <= (base_non_committed + 128 * 1024 * 1024)))
 112 #endif
 113
 114 #ifndef HAVE_WIN32_DLL_SUPPORT
 115 #define LOOKS_LIKE_STATIC(r) IS_DATA_PTR(r)
 116 #else
 117 /* Static closures are 'identified' by being prefixed with a zero. This is
 118    so that they can be distinguished from pointers to info tables. Relies
 119    on the fact that info tables are reversed.
 120
 121    LOOKS_LIKE_STATIC_CLOSURE() - discriminates between static closures and info tbls
 122                                  (needed by LOOKS_LIKE_GHC_INFO() below - [Win32 DLLs only.])
 123    LOOKS_LIKE_STATIC() - distinguishes between static and heap allocated data.
 124  */
 125 #define LOOKS_LIKE_STATIC(r) (!(HEAP_ALLOCED(r)))
 126 #define LOOKS_LIKE_STATIC_CLOSURE(r) ((*(((unsigned long *)(r))-1)) == 0)
 127 #endif
 128
 129
 130 /* -----------------------------------------------------------------------------
 131    Macros for distinguishing infotables from closures.
 132
 133    You'd think it'd be easy to tell an info pointer from a closure pointer:
 134    closures live on the heap and infotables are in read only memory.  Right?
 135    Wrong!  Static closures live in read only memory and Hugs allocates
 136    infotables for constructors on the (writable) C heap.
 137
 138    ToDo: in the combined Hugs-GHC system, the following are but crude
 139    approximations.  This absolutely has to be fixed.
 140    -------------------------------------------------------------------------- */
 141
 142 #ifdef USE_MINIINTERPRETER
 143 /* yoiks: one of the dreaded pointer equality tests */
 144 #define IS_HUGS_CONSTR_INFO(info) (stgCast(StgInfoTable*,info)->entry == stgCast(StgFunPtr,&Hugs_CONSTR_entry))
 145 #else
 146 #define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
 147 #endif
 148
 149 #ifdef USE_MINIINTERPRETER
 150 /* in the mininterpreter, we put infotables on closures */
 151 #define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
 152 #else
 153 /* otherwise we have entry pointers on closures */
 154 # ifdef HAVE_WIN32_DLL_SUPPORT
 155 #  define LOOKS_LIKE_GHC_INFO(info) (!HEAP_ALLOCED(info) && !LOOKS_LIKE_STATIC_CLOSURE(info))
 156 # else
 157 #  define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
 158 # endif
 159 #endif
 160
 161 /* -----------------------------------------------------------------------------
 162    Macros for calculating how big a closure will be (used during allocation)
 163    -------------------------------------------------------------------------- */
 164
 165 /* ToDo: replace unsigned int by nat.  The only fly in the ointment is that
 166  * nat comes from Rts.h which many folk dont include.  Sigh!
 167  */
 168 static __inline__ StgOffset AP_sizeW    ( unsigned int n_args )
 169 { return sizeofW(StgAP_UPD) + n_args; }
 170
 171 static __inline__ StgOffset PAP_sizeW   ( unsigned int n_args )
 172 { return sizeofW(StgPAP)    + n_args; }
 173
 174 static __inline__ StgOffset CONSTR_sizeW( unsigned int p, unsigned int np )
 175 { return sizeofW(StgHeader) + p + np; }
 176
 177 static __inline__ StgOffset BCO_sizeW   ( unsigned int p, unsigned int np, unsigned int is )
 178 { return sizeofW(StgBCO) + p + np + (is+sizeof(StgWord)-1)/sizeof(StgWord); }
 179
 180 static __inline__ StgOffset THUNK_SELECTOR_sizeW ( void )
 181 { return sizeofW(StgHeader) + MIN_UPD_SIZE; }
 182
 183 static __inline__ StgOffset BLACKHOLE_sizeW ( void )
 184 { return sizeofW(StgHeader) + MIN_UPD_SIZE; }
 185
 186 static __inline__ StgOffset CAF_sizeW ( void )
 187 { return sizeofW(StgCAF); }
 188
 189 /* --------------------------------------------------------------------------
 190  * Sizes of closures
 191  * ------------------------------------------------------------------------*/
 192
 193 static __inline__ StgOffset size_fromITBL( const StgInfoTable* itbl )
 194 { return sizeof(StgClosure)
 195        + sizeof(StgPtr)  * itbl->layout.payload.ptrs
 196        + sizeof(StgWord) * itbl->layout.payload.nptrs; }
 197
 198 static __inline__ StgOffset sizeW_fromITBL( const StgInfoTable* itbl )
 199 { return sizeofW(StgClosure)
 200        + sizeofW(StgPtr)  * itbl->layout.payload.ptrs
 201        + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
 202
 203 static __inline__ StgOffset pap_size( StgPAP* x )
 204 { return sizeof(StgPAP)
 205        + sizeof(StgWord)  * x->n_args; }
 206
 207 static __inline__ StgOffset pap_sizeW( StgPAP* x )
 208 { return PAP_sizeW(x->n_args); }
 209
 210 /* These two functions give the same result - but have slightly
 211  * different types.
 212  */
 213 static __inline__ StgOffset arr_words_sizeW( StgArrWords* x )
 214 { return sizeofW(StgArrWords) + x->words; }
 215 static __inline__ StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
 216 { return sizeofW(StgMutArrPtrs) + x->ptrs; }
 217
 218 static __inline__ StgWord bco_sizeW( StgBCO* bco )
 219 { return BCO_sizeW(bco->n_ptrs,bco->n_words,bco->n_instrs); }
 220
 221 static __inline__ StgWord tso_sizeW ( StgTSO *tso )
 222 { return TSO_STRUCT_SIZEW + tso->stack_size; }
 223
 224 /* -----------------------------------------------------------------------------
 225    Macros for building closures
 226    -------------------------------------------------------------------------- */
 227
 228 #ifdef PROFILING
 229 #define SET_PROF_HDR(c,ccs_)            (c)->header.prof.ccs = ccs_
 230 #define SET_STATIC_PROF_HDR(ccs_)       prof : { ccs : ccs_ },
 231 #else
 232 #define SET_PROF_HDR(c,ccs)
 233 #define SET_STATIC_PROF_HDR(ccs)
 234 #endif
 235
 236 #ifdef GRAN
 237 #define SET_GRAN_HDR(c,pe)              (c)->header.gran.procs = pe
 238 #define SET_STATIC_GRAN_HDR             gran : { procs : Everywhere },
 239 #else
 240 #define SET_GRAN_HDR(c,pe)
 241 #define SET_STATIC_GRAN_HDR
 242 #endif
 243
 244 /* there is no PAR header, as far as I can tell -- SDM */
 245
 246 #ifdef PAR
 247 #define SET_PAR_HDR(c,stuff)
 248 #define SET_STATIC_PAR_HDR(stuff)
 249 #else
 250 #define SET_PAR_HDR(c,stuff)
 251 #define SET_STATIC_PAR_HDR(stuff)
 252 #endif
 253
 254 #ifdef TICKY
 255 #define SET_TICKY_HDR(c,stuff)          (c)->header.ticky.updated = stuff
 256 #define SET_STATIC_TICKY_HDR(stuff)     ticky : { updated : stuff }
 257 #else
 258 #define SET_TICKY_HDR(c,stuff)
 259 #define SET_STATIC_TICKY_HDR(stuff)
 260 #endif
 261 #define SET_HDR(c,info,ccs) \
 262    {                                    \
 263         SET_INFO(c,info);                               \
 264         SET_GRAN_HDR((StgClosure *)(c),ThisPE);         \
 265         SET_PAR_HDR((StgClosure *)(c),LOCAL_GA);        \
 266         SET_PROF_HDR((StgClosure *)(c),ccs);            \
 267         SET_TICKY_HDR((StgClosure *)(c),0);             \
 268    }
 269
 270 #define SET_ARR_HDR(c,info,costCentreStack,n_words) \
 271    SET_HDR(c,info,costCentreStack); \
 272    (c)->words = n_words;
 273
 274 /* -----------------------------------------------------------------------------
 275    Static closures are defined as follows:
 276
 277
 278 SET_STATIC_HDR(PrelBase_CZh_closure,PrelBase_CZh_info,costCentreStack,const);
 279
 280    The info argument must have type 'StgInfoTable' or
 281    'StgSRTInfoTable', since we use '&' to get its address in the macro.
 282    -------------------------------------------------------------------------- */
 283
 284 #define SET_STATIC_HDR(label,info,costCentreStack,closure_class,info_class) \
 285    info_class info;                        \
 286    closure_class StgClosure label = {                   \
 287    STATIC_HDR(info,costCentreStack)
 288
 289 #define STATIC_HDR(info,ccs) \
 290         header : {                            \
 291                 INIT_INFO(info),              \
 292                 SET_STATIC_GRAN_HDR           \
 293                 SET_STATIC_PAR_HDR(LOCAL_GA)  \
 294                 SET_STATIC_PROF_HDR(ccs)       \
 295                 SET_STATIC_TICKY_HDR(0)       \
 296         }
 297
 298 /* how to get hold of the static link field for a static closure.
 299  *
 300  * Note that we have to use (*cast(T*,&e)) instead of cast(T,e)
 301  * because C won't let us take the address of a casted expression. Huh?
 302  */
 303 #define STATIC_LINK(info,p) \
 304    (*stgCast(StgClosure**,&((p)->payload[info->layout.payload.ptrs + \
 305                                         info->layout.payload.nptrs])))
 306 #define STATIC_LINK2(info,p) \
 307    (*stgCast(StgClosure**,&((p)->payload[info->layout.payload.ptrs + \
 308                                         info->layout.payload.nptrs + 1])))
 309
 310 /* -----------------------------------------------------------------------------
 311    INTLIKE and CHARLIKE closures.
 312    -------------------------------------------------------------------------- */
 313
 314 #define CHARLIKE_CLOSURE(n) ((P_)&CHARLIKE_closure[n])
 315 #define INTLIKE_CLOSURE(n)  ((P_)&INTLIKE_closure[(n)-MIN_INTLIKE])
 316
 317 /* -----------------------------------------------------------------------------
 318    Payload access
 319    -------------------------------------------------------------------------- */
 320
 321 #define payloadPtr( c, i )    (*stgCast(StgPtr*,       ((c)->payload+(i))))
 322 #define payloadCPtr( c, i )   (*stgCast(StgClosure**,  ((c)->payload+(i))))
 323 #define payloadWord( c, i )   (*stgCast(StgWord*,      ((c)->payload+(i))))
 324
 325 /* -----------------------------------------------------------------------------
 326    CONSTRs.
 327    -------------------------------------------------------------------------- */
 328
 329 /* constructors don't have SRTs */
 330 #define GET_TAG(info) (INFO_PTR_TO_STRUCT(info)->srt_len)
 331
 332 /* -----------------------------------------------------------------------------
 333    BCOs.
 334    -------------------------------------------------------------------------- */
 335
 336 #define bcoConstPtr( bco, i )    (*stgCast(StgPtr*,       ((bco)->payload+(i))))
 337 #define bcoConstCPtr( bco, i )   (*stgCast(StgClosurePtr*,((bco)->payload+(i))))
 338 #define bcoConstInfoPtr( bco, i )(*stgCast(StgInfoTable**,((bco)->payload+(bco)->n_ptrs+i)))
 339 #define bcoConstInt( bco, i )    (*stgCast(StgInt*,       ((bco)->payload+(bco)->n_ptrs+i)))
 340 #define bcoConstInt64( bco, i )  (PK_Int64(stgCast(StgWord*,(bco)->payload+(bco)->n_ptrs+i)))
 341 #define bcoConstWord( bco, i )   (*stgCast(StgWord*,      ((bco)->payload+(bco)->n_ptrs+i)))
 342 #define bcoConstAddr( bco, i )   (*stgCast(StgAddr*,      ((bco)->payload+(bco)->n_ptrs+i)))
 343 #define bcoConstChar( bco, i )   (*stgCast(StgChar*,      ((bco)->payload+(bco)->n_ptrs+i)))
 344 #define bcoConstFloat( bco, i )  (PK_FLT(stgCast(StgWord*,(bco)->payload+(bco)->n_ptrs+i)))
 345 #define bcoConstDouble( bco, i ) (PK_DBL(stgCast(StgWord*,(bco)->payload+(bco)->n_ptrs+i)))
 346 #define bcoInstr( bco, i )       (stgCast(StgWord8*,      ((bco)->payload+(bco)->n_ptrs+(bco)->n_words))[i])
 347
 348 #endif /* CLOSUREMACROS_H */