ClosureMacros.h 9.18 KB
Newer Older
1
/* ----------------------------------------------------------------------------
sof's avatar
sof committed
2
 * $Id: ClosureMacros.h,v 1.38 2003/11/12 17:27:00 sof Exp $
3 4
 *
 * (c) The GHC Team, 1998-1999
5 6 7 8 9 10 11 12
 *
 * Macros for building and manipulating closures
 *
 * -------------------------------------------------------------------------- */

#ifndef CLOSUREMACROS_H
#define CLOSUREMACROS_H

13 14 15 16 17
/* Say whether the code comes before the heap; on mingwin this may not be the
   case, not because of another random MS pathology, but because the static
   program may reside in a DLL
*/

18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
/* -----------------------------------------------------------------------------
   Info tables are slammed up against the entry code, and the label
   for the info table is at the *end* of the table itself.  This
   inline function adjusts an info pointer to point to the beginning
   of the table, so we can use standard C structure indexing on it.

   Note: this works for SRT info tables as long as you don't want to
   access the SRT, since they are laid out the same with the SRT
   pointer as the first word in the table.

   NOTES ABOUT MANGLED C VS. MINI-INTERPRETER:

   A couple of definitions:

       "info pointer"    The first word of the closure.  Might point
                         to either the end or the beginning of the
			 info table, depending on whether we're using
			 the mini interpretter or not.  GET_INFO(c)
			 retrieves the info pointer of a closure.

       "info table"      The info table structure associated with a
                         closure.  This is always a pointer to the
			 beginning of the structure, so we can
			 use standard C structure indexing to pull out
			 the fields.  get_itbl(c) returns a pointer to
			 the info table for closure c.

   An address of the form xxxx_info points to the end of the info
   table or the beginning of the info table depending on whether we're
   mangling or not respectively.  So, 

         c->header.info = xxx_info 

   makes absolute sense, whether mangling or not.
 
   -------------------------------------------------------------------------- */

55
#define INIT_INFO(i)  info : (StgInfoTable *)&(i)
56 57
#define SET_INFO(c,i) ((c)->header.info = (i))
#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 62 63 64
#define get_ret_itbl(c) (RET_INFO_PTR_TO_STRUCT((c)->header.info))
#define get_fun_itbl(c) (FUN_INFO_PTR_TO_STRUCT((c)->header.info))
#define get_thunk_itbl(c) (THUNK_INFO_PTR_TO_STRUCT((c)->header.info))

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 71 72
#define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)(info) - 1)
#define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)(info) - 1)
#define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)(info) - 1)
sof's avatar
sof committed
73
INLINE_HEADER StgFunPtr get_entry(const StgInfoTable *itbl) {
74
    return (StgFunPtr)(itbl+1);
75
}
76 77 78
#define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
#define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
#define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
79 80 81 82
#else
#define INIT_ENTRY(e)    entry : (F_)(e)
#define ENTRY_CODE(info) (((StgInfoTable *)info)->entry)
#define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)info)
83 84 85
#define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)info)
#define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)info)
#define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)info)
sof's avatar
sof committed
86
INLINE_HEADER StgFunPtr get_entry(const StgInfoTable *itbl) {
87 88
    return itbl->entry;
}
89 90 91
#define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(i))
#define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(i))
#define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(i))
92 93 94 95 96 97 98
#endif

/* -----------------------------------------------------------------------------
   Macros for building closures
   -------------------------------------------------------------------------- */

#ifdef PROFILING
99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
#ifdef DEBUG_RETAINER
/* 
  For the sake of debugging, we take the safest way for the moment. Actually, this 
  is useful to check the sanity of heap before beginning retainer profiling.
  flip is defined in RetainerProfile.c, and declared as extern in RetainerProfile.h.
  Note: change those functions building Haskell objects from C datatypes, i.e.,
  all rts_mk???() functions in RtsAPI.c, as well.
 */
extern StgWord flip;
#define SET_PROF_HDR(c,ccs_)            \
        ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip))
#else
/*
  For retainer profiling only: we do not have to set (c)->header.prof.hp.rs to
  NULL | flip (flip is defined in RetainerProfile.c) because even when flip
  is 1, rs is invalid and will be initialized to NULL | flip later when 
  the closure *c is visited.
 */
/*
#define SET_PROF_HDR(c,ccs_)            \
        ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = NULL)
 */
/*
  The following macro works for both retainer profiling and LDV profiling:
  for retainer profiling, ldvTime remains 0, so rs fields are initialized to 0.
  See the invariants on ldvTime.
 */
#define SET_PROF_HDR(c,ccs_)            \
        ((c)->header.prof.ccs = ccs_,   \
        LDV_recordCreate((c)))
#endif  // DEBUG_RETAINER
#define SET_STATIC_PROF_HDR(ccs_)       \
        prof : { ccs : ccs_, hp : { rs : NULL } },
132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
#else
#define SET_PROF_HDR(c,ccs)
#define SET_STATIC_PROF_HDR(ccs)
#endif

#ifdef GRAN
#define SET_GRAN_HDR(c,pe)		(c)->header.gran.procs = pe
#define SET_STATIC_GRAN_HDR		gran : { procs : Everywhere },
#else
#define SET_GRAN_HDR(c,pe)
#define SET_STATIC_GRAN_HDR
#endif

#ifdef PAR
#define SET_PAR_HDR(c,stuff)
#define SET_STATIC_PAR_HDR(stuff)
#else
#define SET_PAR_HDR(c,stuff)
#define SET_STATIC_PAR_HDR(stuff)
#endif

153
#ifdef TICKY_TICKY
154 155
#define SET_TICKY_HDR(c,stuff)	     /* old: (c)->header.ticky.updated = stuff */
#define SET_STATIC_TICKY_HDR(stuff)  /* old: ticky : { updated : stuff } */
156 157 158 159
#else
#define SET_TICKY_HDR(c,stuff)
#define SET_STATIC_TICKY_HDR(stuff)
#endif
160

161 162 163
#define SET_HDR(c,info,ccs)				\
   {							\
	SET_INFO(c,info);				\
164 165 166 167 168 169
	SET_GRAN_HDR((StgClosure *)(c),ThisPE);		\
	SET_PAR_HDR((StgClosure *)(c),LOCAL_GA);	\
	SET_PROF_HDR((StgClosure *)(c),ccs);		\
	SET_TICKY_HDR((StgClosure *)(c),0);		\
   }

170 171
#define SET_ARR_HDR(c,info,costCentreStack,n_words)	\
   SET_HDR(c,info,costCentreStack);			\
172 173 174 175 176 177
   (c)->words = n_words;

/* -----------------------------------------------------------------------------
   Static closures are defined as follows:


rrt's avatar
rrt committed
178
   SET_STATIC_HDR(PrelBase_CZh_closure,PrelBase_CZh_info,costCentreStack,closure_class,info_class);
179 180 181 182 183

   The info argument must have type 'StgInfoTable' or
   'StgSRTInfoTable', since we use '&' to get its address in the macro.
   -------------------------------------------------------------------------- */

184 185 186
#define SET_STATIC_HDR(label,info,costCentreStack,closure_class,info_class)	\
   info_class info;								\
   closure_class StgClosure label = {						\
187 188
   STATIC_HDR(info,costCentreStack)

189 190 191 192 193 194 195
#define STATIC_HDR(info,ccs)			\
	header : {				\
		INIT_INFO(info),		\
		SET_STATIC_GRAN_HDR		\
		SET_STATIC_PAR_HDR(LOCAL_GA)	\
		SET_STATIC_PROF_HDR(ccs)	\
		SET_STATIC_TICKY_HDR(0)		\
196 197 198 199 200 201 202
	}

/* how to get hold of the static link field for a static closure.
 *
 * Note that we have to use (*cast(T*,&e)) instead of cast(T,e)
 * because C won't let us take the address of a casted expression. Huh?
 */
203 204
#define STATIC_LINK(info,p)						\
   (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs +		\
205
					info->layout.payload.nptrs])))
206

207 208 209
/* These macros are optimised versions of the above for certain
 * closure types.  They *must* be equivalent to the generic
 * STATIC_LINK.
210 211 212 213 214 215 216
 *
 * You may be surprised that the STATIC_LINK field for a THUNK_STATIC
 * is at offset 2; that's because a THUNK_STATIC always has two words
 * of (non-ptr) padding, to make room for the IND_STATIC that is
 * going to overwrite it.  It doesn't do any harm, because a
 * THUNK_STATIC needs this extra word for the IND_STATIC's saved_info
 * field anyhow.  Hmm, this is all rather delicate. --SDM
217 218 219 220 221
 */
#define FUN_STATIC_LINK(p)   ((p)->payload[0])
#define THUNK_STATIC_LINK(p) ((p)->payload[2])
#define IND_STATIC_LINK(p)   ((p)->payload[1])

222 223
#define STATIC_LINK2(info,p)							\
   (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs +			\
224 225 226 227 228 229
					info->layout.payload.nptrs + 1])))

/* -----------------------------------------------------------------------------
   INTLIKE and CHARLIKE closures.
   -------------------------------------------------------------------------- */

230 231
#define CHARLIKE_CLOSURE(n) ((P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE])
#define INTLIKE_CLOSURE(n)  ((P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE])
232

233 234 235 236 237 238
/* -----------------------------------------------------------------------------
   Closure Tables (for enumerated data types)
   -------------------------------------------------------------------------- */

#define CLOSURE_TBL(lbl) const StgClosure *lbl[] = {

239 240 241 242 243
/* -----------------------------------------------------------------------------
   CONSTRs.
   -------------------------------------------------------------------------- */

/* constructors don't have SRTs */
244
#define GET_TAG(info) (INFO_PTR_TO_STRUCT(info)->srt_bitmap)
245 246

#endif /* CLOSUREMACROS_H */