Improve handling of -fdph-* flags
[ghc.git] / includes / ClosureMacros.h
1 /* ----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team, 1998-2004
4 *
5 * Macros for building and manipulating closures
6 *
7 * -------------------------------------------------------------------------- */
8
9 #ifndef CLOSUREMACROS_H
10 #define CLOSUREMACROS_H
11
12 /* Say whether the code comes before the heap; on mingwin this may not be the
13 case, not because of another random MS pathology, but because the static
14 program may reside in a DLL
15 */
16
17 /* -----------------------------------------------------------------------------
18 Info tables are slammed up against the entry code, and the label
19 for the info table is at the *end* of the table itself. This
20 inline function adjusts an info pointer to point to the beginning
21 of the table, so we can use standard C structure indexing on it.
22
23 Note: this works for SRT info tables as long as you don't want to
24 access the SRT, since they are laid out the same with the SRT
25 pointer as the first word in the table.
26
27 NOTES ABOUT MANGLED C VS. MINI-INTERPRETER:
28
29 A couple of definitions:
30
31 "info pointer" The first word of the closure. Might point
32 to either the end or the beginning of the
33 info table, depending on whether we're using
34 the mini interpretter or not. GET_INFO(c)
35 retrieves the info pointer of a closure.
36
37 "info table" The info table structure associated with a
38 closure. This is always a pointer to the
39 beginning of the structure, so we can
40 use standard C structure indexing to pull out
41 the fields. get_itbl(c) returns a pointer to
42 the info table for closure c.
43
44 An address of the form xxxx_info points to the end of the info
45 table or the beginning of the info table depending on whether we're
46 mangling or not respectively. So,
47
48 c->header.info = xxx_info
49
50 makes absolute sense, whether mangling or not.
51
52 -------------------------------------------------------------------------- */
53
54 #define SET_INFO(c,i) ((c)->header.info = (i))
55 #define GET_INFO(c) ((c)->header.info)
56 #define GET_ENTRY(c) (ENTRY_CODE(GET_INFO(c)))
57
58 #define get_itbl(c) (INFO_PTR_TO_STRUCT((c)->header.info))
59 #define get_ret_itbl(c) (RET_INFO_PTR_TO_STRUCT((c)->header.info))
60 #define get_fun_itbl(c) (FUN_INFO_PTR_TO_STRUCT((c)->header.info))
61 #define get_thunk_itbl(c) (THUNK_INFO_PTR_TO_STRUCT((c)->header.info))
62 #define get_con_itbl(c) (CON_INFO_PTR_TO_STRUCT((c)->header.info))
63
64 #define GET_TAG(con) (get_itbl(con)->srt_bitmap)
65
66 #ifdef TABLES_NEXT_TO_CODE
67 #define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)(info) - 1)
68 #define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)(info) - 1)
69 #define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)(info) - 1)
70 #define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)(info) - 1)
71 #define CON_INFO_PTR_TO_STRUCT(info) ((StgConInfoTable *)(info) - 1)
72 #define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
73 #define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
74 #define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
75 #define itbl_to_con_itbl(i) ((StgConInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
76 #else
77 #define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)info)
78 #define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)info)
79 #define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)info)
80 #define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)info)
81 #define CON_INFO_PTR_TO_STRUCT(info) ((StgConInfoTable *)info)
82 #define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(i))
83 #define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(i))
84 #define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(i))
85 #define itbl_to_con_itbl(i) ((StgConInfoTable *)(i))
86 #endif
87
88 /* -----------------------------------------------------------------------------
89 Macros for building closures
90 -------------------------------------------------------------------------- */
91
92 #ifdef PROFILING
93 #ifdef DEBUG_RETAINER
94 /*
95 For the sake of debugging, we take the safest way for the moment. Actually, this
96 is useful to check the sanity of heap before beginning retainer profiling.
97 flip is defined in RetainerProfile.c, and declared as extern in RetainerProfile.h.
98 Note: change those functions building Haskell objects from C datatypes, i.e.,
99 all rts_mk???() functions in RtsAPI.c, as well.
100 */
101 #define SET_PROF_HDR(c,ccs_) \
102 ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip))
103 #else
104 /*
105 For retainer profiling only: we do not have to set (c)->header.prof.hp.rs to
106 NULL | flip (flip is defined in RetainerProfile.c) because even when flip
107 is 1, rs is invalid and will be initialized to NULL | flip later when
108 the closure *c is visited.
109 */
110 /*
111 #define SET_PROF_HDR(c,ccs_) \
112 ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = NULL)
113 */
114 /*
115 The following macro works for both retainer profiling and LDV profiling:
116 for retainer profiling, ldvTime remains 0, so rs fields are initialized to 0.
117 See the invariants on ldvTime.
118 */
119 #define SET_PROF_HDR(c,ccs_) \
120 ((c)->header.prof.ccs = ccs_, \
121 LDV_RECORD_CREATE((c)))
122 #endif /* DEBUG_RETAINER */
123 #define SET_STATIC_PROF_HDR(ccs_) \
124 prof : { ccs : (CostCentreStack *)ccs_, hp : { rs : NULL } },
125 #else
126 #define SET_PROF_HDR(c,ccs)
127 #define SET_STATIC_PROF_HDR(ccs)
128 #endif
129
130 #ifdef GRAN
131 #define SET_GRAN_HDR(c,pe) (c)->header.gran.procs = pe
132 #define SET_STATIC_GRAN_HDR gran : { procs : Everywhere },
133 #else
134 #define SET_GRAN_HDR(c,pe)
135 #define SET_STATIC_GRAN_HDR
136 #endif
137
138 #ifdef PAR
139 #define SET_PAR_HDR(c,stuff)
140 #define SET_STATIC_PAR_HDR(stuff)
141 #else
142 #define SET_PAR_HDR(c,stuff)
143 #define SET_STATIC_PAR_HDR(stuff)
144 #endif
145
146 #ifdef TICKY_TICKY
147 #define SET_TICKY_HDR(c,stuff) /* old: (c)->header.ticky.updated = stuff */
148 #define SET_STATIC_TICKY_HDR(stuff) /* old: ticky : { updated : stuff } */
149 #else
150 #define SET_TICKY_HDR(c,stuff)
151 #define SET_STATIC_TICKY_HDR(stuff)
152 #endif
153
154 #define SET_HDR(c,_info,ccs) \
155 { \
156 (c)->header.info = _info; \
157 SET_GRAN_HDR((StgClosure *)(c),ThisPE); \
158 SET_PAR_HDR((StgClosure *)(c),LOCAL_GA); \
159 SET_PROF_HDR((StgClosure *)(c),ccs); \
160 SET_TICKY_HDR((StgClosure *)(c),0); \
161 }
162
163 #define SET_ARR_HDR(c,info,costCentreStack,n_words) \
164 SET_HDR(c,info,costCentreStack); \
165 (c)->words = n_words;
166
167 /* -----------------------------------------------------------------------------
168 How to get hold of the static link field for a static closure.
169 -------------------------------------------------------------------------- */
170
171 /* These are hard-coded. */
172 #define FUN_STATIC_LINK(p) (&(p)->payload[0])
173 #define THUNK_STATIC_LINK(p) (&(p)->payload[1])
174 #define IND_STATIC_LINK(p) (&(p)->payload[1])
175
176 INLINE_HEADER StgClosure **
177 STATIC_LINK(const StgInfoTable *info, StgClosure *p)
178 {
179 switch (info->type) {
180 case THUNK_STATIC:
181 return THUNK_STATIC_LINK(p);
182 case FUN_STATIC:
183 return FUN_STATIC_LINK(p);
184 case IND_STATIC:
185 return IND_STATIC_LINK(p);
186 default:
187 return &(p)->payload[info->layout.payload.ptrs +
188 info->layout.payload.nptrs];
189 }
190 }
191
192 #define STATIC_LINK2(info,p) \
193 (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs + \
194 info->layout.payload.nptrs + 1])))
195
196 /* -----------------------------------------------------------------------------
197 INTLIKE and CHARLIKE closures.
198 -------------------------------------------------------------------------- */
199
200 #define CHARLIKE_CLOSURE(n) ((P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE])
201 #define INTLIKE_CLOSURE(n) ((P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE])
202
203 #endif /* CLOSUREMACROS_H */