ghc/includes/ClosureMacros.h

   1 /* ----------------------------------------------------------------------------
   2  * $Id: ClosureMacros.h,v 1.25 2000/08/17 15:19:17 rrt 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 #define GET_ENTRY(c)  (ENTRY_CODE(GET_INFO(c)))
  63 #define get_itbl(c)   (INFO_PTR_TO_STRUCT((c)->header.info))
  64
  65 #ifdef TABLES_NEXT_TO_CODE
  66 #define INIT_ENTRY(e)    code : {}
  67 #define ENTRY_CODE(info) (info)
  68 #define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)(info) - 1)
  69 static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
  70     return (StgFunPtr)(itbl+1);
  71 }
  72 #else
  73 #define INIT_ENTRY(e)    entry : (F_)(e)
  74 #define ENTRY_CODE(info) (((StgInfoTable *)info)->entry)
  75 #define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)info)
  76 static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) {
  77     return itbl->entry;
  78 }
  79 #endif
  80
  81 /* -----------------------------------------------------------------------------
  82    Macros for distinguishing data pointers from code pointers
  83    -------------------------------------------------------------------------- */
  84 /*
  85  * We use some symbols inserted automatically by the linker to decide
  86  * whether a pointer points to text, data, or user space.  These tests
  87  * assume that text is lower in the address space than data, which in
  88  * turn is lower than user allocated memory.
  89  *
  90  * If this assumption is false (say on some strange architecture) then
  91  * the tests IS_CODE_PTR and IS_DATA_PTR below will need to be
  92  * modified (and that should be all that's necessary).
  93  *
  94  * _start      } start of read-only text space
  95  * _etext      } end   of read-only text space
  96  * _end } end of read-write data space
  97  */
  98 extern StgFun start;
  99
 100 extern void* TEXT_SECTION_END_MARKER_DECL;
 101 extern void* DATA_SECTION_END_MARKER_DECL;
 102
 103 #ifdef INTERPRETER
 104 /* Take into account code sections in dynamically loaded object files. */
 105 #define IS_CODE_PTR(p) (  ((P_)(p) < (P_)&TEXT_SECTION_END_MARKER) \
 106                        || is_dynamically_loaded_code_or_rodata_ptr(p) )
 107 #define IS_DATA_PTR(p) ( ((P_)(p) >= (P_)&TEXT_SECTION_END_MARKER && \
 108                           (P_)(p) < (P_)&DATA_SECTION_END_MARKER) \
 109                        || is_dynamically_loaded_rwdata_ptr(p) )
 110 #define IS_USER_PTR(p) ( ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER) \
 111                        && is_not_dynamically_loaded_ptr(p) )
 112 #else
 113 #define IS_CODE_PTR(p) ((P_)(p) < (P_)&TEXT_SECTION_END_MARKER)
 114 #define IS_DATA_PTR(p) ((P_)(p) >= (P_)&TEXT_SECTION_END_MARKER && (P_)(p) < (P_)&DATA_SECTION_END_MARKER)
 115 #define IS_USER_PTR(p) ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER)
 116 #endif
 117
 118
 119 #ifdef ENABLE_WIN32_DLL_SUPPORT /* needed for mingw DietHEP */
 120    extern int is_heap_alloced(const void* x);
 121 #  define HEAP_ALLOCED(x)  (is_heap_alloced(x))
 122 #else
 123 #  define HEAP_ALLOCED(x)  IS_USER_PTR(x)
 124 #endif
 125
 126 /* When working with Win32 DLLs, static closures are identified by
 127    being prefixed with a zero word. This is needed so that we can
 128    distinguish between pointers to static closures and (reversed!)
 129    info tables.
 130
 131    This 'scheme' breaks down for closure tables such as CHARLIKE,
 132    so we catch these separately.
 133
 134    LOOKS_LIKE_STATIC_CLOSURE()
 135        - discriminates between static closures and info tbls
 136          (needed by LOOKS_LIKE_GHC_INFO() below - [Win32 DLLs only.])
 137    LOOKS_LIKE_STATIC()
 138        - distinguishes between static and heap allocated data.
 139  */
 140 #if defined(ENABLE_WIN32_DLL_SUPPORT) && !defined(INTERPRETER)
 141             /* definitely do not enable for mingw DietHEP */
 142 #define LOOKS_LIKE_STATIC(r) (!(HEAP_ALLOCED(r)))
 143
 144 /* Tiresome predicates needed to check for pointers into the closure tables */
 145 #define IS_CHARLIKE_CLOSURE(p) \
 146     ( (P_)(p) >= (P_)CHARLIKE_closure && \
 147       (char*)(p) <= ((char*)CHARLIKE_closure + \
 148                      (MAX_CHARLIKE-MIN_CHARLIKE) * sizeof(StgIntCharlikeClosure)) )
 149 #define IS_INTLIKE_CLOSURE(p) \
 150     ( (P_)(p) >= (P_)INTLIKE_closure && \
 151       (char*)(p) <= ((char*)INTLIKE_closure + \
 152                      (MAX_INTLIKE-MIN_INTLIKE) * sizeof(StgIntCharlikeClosure)) )
 153
 154 #define LOOKS_LIKE_STATIC_CLOSURE(r) (((*(((unsigned long *)(r))-1)) == 0) || IS_CHARLIKE_CLOSURE(r) || IS_INTLIKE_CLOSURE(r))
 155 #else
 156 #define LOOKS_LIKE_STATIC(r) IS_DATA_PTR(r)
 157 #define LOOKS_LIKE_STATIC_CLOSURE(r) IS_DATA_PTR(r)
 158 #endif
 159
 160
 161 /* -----------------------------------------------------------------------------
 162    Macros for distinguishing infotables from closures.
 163
 164    You'd think it'd be easy to tell an info pointer from a closure pointer:
 165    closures live on the heap and infotables are in read only memory.  Right?
 166    Wrong!  Static closures live in read only memory and Hugs allocates
 167    infotables for constructors on the (writable) C heap.
 168
 169    ToDo: in the combined Hugs-GHC system, the following are but crude
 170    approximations.  This absolutely has to be fixed.
 171    -------------------------------------------------------------------------- */
 172
 173 #ifdef INTERPRETER
 174 #  ifdef USE_MINIINTERPRETER
 175      /* yoiks: one of the dreaded pointer equality tests */
 176 #    define IS_HUGS_CONSTR_INFO(info) \
 177             (((StgInfoTable *)(info))->entry == (StgFunPtr)&Hugs_CONSTR_entry)
 178 #  else
 179 #    define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
 180 #  endif
 181 #else
 182 #  define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
 183 #endif
 184
 185 #ifdef ENABLE_WIN32_DLL_SUPPORT /* needed for mingw DietHEP */
 186 #  define LOOKS_LIKE_GHC_INFO(info) (!HEAP_ALLOCED(info) \
 187                                      && !LOOKS_LIKE_STATIC_CLOSURE(info))
 188 #else
 189 #  define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
 190 #endif
 191
 192 /* -----------------------------------------------------------------------------
 193    Macros for calculating how big a closure will be (used during allocation)
 194    -------------------------------------------------------------------------- */
 195
 196 /* ToDo: replace unsigned int by nat.  The only fly in the ointment is that
 197  * nat comes from Rts.h which many folk dont include.  Sigh!
 198  */
 199 static __inline__ StgOffset AP_sizeW    ( unsigned int n_args )
 200 { return sizeofW(StgAP_UPD) + n_args; }
 201
 202 static __inline__ StgOffset PAP_sizeW   ( unsigned int n_args )
 203 { return sizeofW(StgPAP)    + n_args; }
 204
 205 static __inline__ StgOffset CONSTR_sizeW( unsigned int p, unsigned int np )
 206 { return sizeofW(StgHeader) + p + np; }
 207
 208 static __inline__ StgOffset BCO_sizeW   ( unsigned int p, unsigned int np, unsigned int is )
 209 { return sizeofW(StgBCO) + p + np + (is+sizeof(StgWord)-1)/sizeof(StgWord); }
 210
 211 static __inline__ StgOffset THUNK_SELECTOR_sizeW ( void )
 212 { return sizeofW(StgHeader) + MIN_UPD_SIZE; }
 213
 214 static __inline__ StgOffset BLACKHOLE_sizeW ( void )
 215 { return sizeofW(StgHeader) + MIN_UPD_SIZE; }
 216
 217 static __inline__ StgOffset CAF_sizeW ( void )
 218 { return sizeofW(StgCAF); }
 219
 220 /* --------------------------------------------------------------------------
 221  * Sizes of closures
 222  * ------------------------------------------------------------------------*/
 223
 224 static __inline__ StgOffset sizeW_fromITBL( const StgInfoTable* itbl )
 225 { return sizeofW(StgClosure)
 226        + sizeofW(StgPtr)  * itbl->layout.payload.ptrs
 227        + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
 228
 229 static __inline__ StgOffset pap_sizeW( StgPAP* x )
 230 { return PAP_sizeW(x->n_args); }
 231
 232 static __inline__ StgOffset arr_words_sizeW( StgArrWords* x )
 233 { return sizeofW(StgArrWords) + x->words; }
 234
 235 static __inline__ StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
 236 { return sizeofW(StgMutArrPtrs) + x->ptrs; }
 237
 238 static __inline__ StgWord bco_sizeW( StgBCO* bco )
 239 { return BCO_sizeW(bco->n_ptrs,bco->n_words,bco->n_instrs); }
 240
 241 static __inline__ StgWord tso_sizeW ( StgTSO *tso )
 242 { return TSO_STRUCT_SIZEW + tso->stack_size; }
 243
 244 /* -----------------------------------------------------------------------------
 245    Macros for building closures
 246    -------------------------------------------------------------------------- */
 247
 248 #ifdef PROFILING
 249 #define SET_PROF_HDR(c,ccs_)            (c)->header.prof.ccs = ccs_
 250 #define SET_STATIC_PROF_HDR(ccs_)       prof : { ccs : ccs_ },
 251 #else
 252 #define SET_PROF_HDR(c,ccs)
 253 #define SET_STATIC_PROF_HDR(ccs)
 254 #endif
 255
 256 #ifdef GRAN
 257 #define SET_GRAN_HDR(c,pe)              (c)->header.gran.procs = pe
 258 #define SET_STATIC_GRAN_HDR             gran : { procs : Everywhere },
 259 #else
 260 #define SET_GRAN_HDR(c,pe)
 261 #define SET_STATIC_GRAN_HDR
 262 #endif
 263
 264 #ifdef PAR
 265 #define SET_PAR_HDR(c,stuff)
 266 #define SET_STATIC_PAR_HDR(stuff)
 267 #else
 268 #define SET_PAR_HDR(c,stuff)
 269 #define SET_STATIC_PAR_HDR(stuff)
 270 #endif
 271
 272 #ifdef TICKY_TICKY
 273 #define SET_TICKY_HDR(c,stuff)       /* old: (c)->header.ticky.updated = stuff */
 274 #define SET_STATIC_TICKY_HDR(stuff)  /* old: ticky : { updated : stuff } */
 275 #else
 276 #define SET_TICKY_HDR(c,stuff)
 277 #define SET_STATIC_TICKY_HDR(stuff)
 278 #endif
 279 #define SET_HDR(c,info,ccs)                             \
 280    {                                                    \
 281         SET_INFO(c,info);                               \
 282         SET_GRAN_HDR((StgClosure *)(c),ThisPE);         \
 283         SET_PAR_HDR((StgClosure *)(c),LOCAL_GA);        \
 284         SET_PROF_HDR((StgClosure *)(c),ccs);            \
 285         SET_TICKY_HDR((StgClosure *)(c),0);             \
 286    }
 287
 288 #define SET_ARR_HDR(c,info,costCentreStack,n_words)     \
 289    SET_HDR(c,info,costCentreStack);                     \
 290    (c)->words = n_words;
 291
 292 /* -----------------------------------------------------------------------------
 293    Static closures are defined as follows:
 294
 295
 296    SET_STATIC_HDR(PrelBase_CZh_closure,PrelBase_CZh_info,costCentreStack,const);
 297
 298    The info argument must have type 'StgInfoTable' or
 299    'StgSRTInfoTable', since we use '&' to get its address in the macro.
 300    -------------------------------------------------------------------------- */
 301
 302 #define SET_STATIC_HDR(label,info,costCentreStack,closure_class,info_class)     \
 303    info_class info;                                                             \
 304    closure_class StgClosure label = {                                           \
 305    STATIC_HDR(info,costCentreStack)
 306
 307 #define STATIC_HDR(info,ccs)                    \
 308         header : {                              \
 309                 INIT_INFO(info),                \
 310                 SET_STATIC_GRAN_HDR             \
 311                 SET_STATIC_PAR_HDR(LOCAL_GA)    \
 312                 SET_STATIC_PROF_HDR(ccs)        \
 313                 SET_STATIC_TICKY_HDR(0)         \
 314         }
 315
 316 /* how to get hold of the static link field for a static closure.
 317  *
 318  * Note that we have to use (*cast(T*,&e)) instead of cast(T,e)
 319  * because C won't let us take the address of a casted expression. Huh?
 320  */
 321 #define STATIC_LINK(info,p)                                             \
 322    (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs +          \
 323                                         info->layout.payload.nptrs])))
 324
 325 /* These macros are optimised versions of the above for certain
 326  * closure types.  They *must* be equivalent to the generic
 327  * STATIC_LINK.
 328  */
 329 #define FUN_STATIC_LINK(p)   ((p)->payload[0])
 330 #define THUNK_STATIC_LINK(p) ((p)->payload[2])
 331 #define IND_STATIC_LINK(p)   ((p)->payload[1])
 332
 333 #define STATIC_LINK2(info,p)                                                    \
 334    (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs +                  \
 335                                         info->layout.payload.nptrs + 1])))
 336
 337 /* -----------------------------------------------------------------------------
 338    INTLIKE and CHARLIKE closures.
 339    -------------------------------------------------------------------------- */
 340
 341 #define CHARLIKE_CLOSURE(n) ((P_)&CHARLIKE_closure[(n)-MIN_CHARLIKE])
 342 #define INTLIKE_CLOSURE(n)  ((P_)&INTLIKE_closure[(n)-MIN_INTLIKE])
 343
 344 /* -----------------------------------------------------------------------------
 345    Closure Tables (for enumerated data types)
 346    -------------------------------------------------------------------------- */
 347
 348 #define CLOSURE_TBL(lbl) const StgClosure *lbl[] = {
 349
 350 /* -----------------------------------------------------------------------------
 351    CONSTRs.
 352    -------------------------------------------------------------------------- */
 353
 354 /* constructors don't have SRTs */
 355 #define GET_TAG(info) (INFO_PTR_TO_STRUCT(info)->srt_len)
 356
 357 /* -----------------------------------------------------------------------------
 358    BCOs.
 359    -------------------------------------------------------------------------- */
 360
 361 #define bcoConstPtr( bco, i )    (*stgCast(StgPtr*,       ((bco)->payload+(i))))
 362 #define bcoConstCPtr( bco, i )   (*stgCast(StgClosurePtr*,((bco)->payload+(i))))
 363 #define bcoConstInfoPtr( bco, i )(*stgCast(StgInfoTable**,((bco)->payload+(bco)->n_ptrs+i)))
 364 #define bcoConstInt( bco, i )    (*stgCast(StgInt*,       ((bco)->payload+(bco)->n_ptrs+i)))
 365 #define bcoConstInt64( bco, i )  (PK_Int64(stgCast(StgWord*,(bco)->payload+(bco)->n_ptrs+i)))
 366 #define bcoConstWord( bco, i )   (*stgCast(StgWord*,      ((bco)->payload+(bco)->n_ptrs+i)))
 367 #define bcoConstAddr( bco, i )   (*stgCast(StgAddr*,      ((bco)->payload+(bco)->n_ptrs+i)))
 368 #define bcoConstChar( bco, i )   (*stgCast(StgChar*,      ((bco)->payload+(bco)->n_ptrs+i)))
 369 #define bcoConstFloat( bco, i )  (PK_FLT(stgCast(StgWord*,(bco)->payload+(bco)->n_ptrs+i)))
 370 #define bcoConstDouble( bco, i ) (PK_DBL(stgCast(StgWord*,(bco)->payload+(bco)->n_ptrs+i)))
 371 #define bcoInstr( bco, i )       (stgCast(StgWord8*,      ((bco)->payload+(bco)->n_ptrs+(bco)->n_words))[i])
 372 static __inline__ StgInt bcoInstr16 ( StgBCO* bco, unsigned int i )
 373 { StgInt x = (bcoInstr(bco,i) << 8) + bcoInstr(bco,i+1); return x; }
 374
 375 #endif /* CLOSUREMACROS_H */