ghc/includes/ClosureMacros.h

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