Use message-passing to implement throwTo in the RTS
[ghc.git] / includes / rts / storage / ClosureMacros.h
1 /* ----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team, 1998-2004
4 *
5 * Macros for building and manipulating closures
6 *
7 * -------------------------------------------------------------------------- */
8
9 #ifndef RTS_STORAGE_CLOSUREMACROS_H
10 #define RTS_STORAGE_CLOSUREMACROS_H
11
12 /* -----------------------------------------------------------------------------
13 Info tables are slammed up against the entry code, and the label
14 for the info table is at the *end* of the table itself. This
15 inline function adjusts an info pointer to point to the beginning
16 of the table, so we can use standard C structure indexing on it.
17
18 Note: this works for SRT info tables as long as you don't want to
19 access the SRT, since they are laid out the same with the SRT
20 pointer as the first word in the table.
21
22 NOTES ABOUT MANGLED C VS. MINI-INTERPRETER:
23
24 A couple of definitions:
25
26 "info pointer" The first word of the closure. Might point
27 to either the end or the beginning of the
28 info table, depending on whether we're using
29 the mini interpretter or not. GET_INFO(c)
30 retrieves the info pointer of a closure.
31
32 "info table" The info table structure associated with a
33 closure. This is always a pointer to the
34 beginning of the structure, so we can
35 use standard C structure indexing to pull out
36 the fields. get_itbl(c) returns a pointer to
37 the info table for closure c.
38
39 An address of the form xxxx_info points to the end of the info
40 table or the beginning of the info table depending on whether we're
41 mangling or not respectively. So,
42
43 c->header.info = xxx_info
44
45 makes absolute sense, whether mangling or not.
46
47 -------------------------------------------------------------------------- */
48
49 #define SET_INFO(c,i) ((c)->header.info = (i))
50 #define GET_INFO(c) ((c)->header.info)
51 #define GET_ENTRY(c) (ENTRY_CODE(GET_INFO(c)))
52
53 #define get_itbl(c) (INFO_PTR_TO_STRUCT((c)->header.info))
54 #define get_ret_itbl(c) (RET_INFO_PTR_TO_STRUCT((c)->header.info))
55 #define get_fun_itbl(c) (FUN_INFO_PTR_TO_STRUCT((c)->header.info))
56 #define get_thunk_itbl(c) (THUNK_INFO_PTR_TO_STRUCT((c)->header.info))
57 #define get_con_itbl(c) (CON_INFO_PTR_TO_STRUCT((c)->header.info))
58
59 #define GET_TAG(con) (get_itbl(con)->srt_bitmap)
60
61 #ifdef TABLES_NEXT_TO_CODE
62 #define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)(info) - 1)
63 #define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)(info) - 1)
64 #define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)(info) - 1)
65 #define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)(info) - 1)
66 #define CON_INFO_PTR_TO_STRUCT(info) ((StgConInfoTable *)(info) - 1)
67 #define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
68 #define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
69 #define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
70 #define itbl_to_con_itbl(i) ((StgConInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
71 #else
72 #define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)info)
73 #define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)info)
74 #define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)info)
75 #define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)info)
76 #define CON_INFO_PTR_TO_STRUCT(info) ((StgConInfoTable *)info)
77 #define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(i))
78 #define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(i))
79 #define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(i))
80 #define itbl_to_con_itbl(i) ((StgConInfoTable *)(i))
81 #endif
82
83 /* -----------------------------------------------------------------------------
84 Macros for building closures
85 -------------------------------------------------------------------------- */
86
87 #ifdef PROFILING
88 #ifdef DEBUG_RETAINER
89 /*
90 For the sake of debugging, we take the safest way for the moment. Actually, this
91 is useful to check the sanity of heap before beginning retainer profiling.
92 flip is defined in RetainerProfile.c, and declared as extern in RetainerProfile.h.
93 Note: change those functions building Haskell objects from C datatypes, i.e.,
94 all rts_mk???() functions in RtsAPI.c, as well.
95 */
96 #define SET_PROF_HDR(c,ccs_) \
97 ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip))
98 #else
99 /*
100 For retainer profiling only: we do not have to set (c)->header.prof.hp.rs to
101 NULL | flip (flip is defined in RetainerProfile.c) because even when flip
102 is 1, rs is invalid and will be initialized to NULL | flip later when
103 the closure *c is visited.
104 */
105 /*
106 #define SET_PROF_HDR(c,ccs_) \
107 ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = NULL)
108 */
109 /*
110 The following macro works for both retainer profiling and LDV profiling:
111 for retainer profiling, ldvTime remains 0, so rs fields are initialized to 0.
112 See the invariants on ldvTime.
113 */
114 #define SET_PROF_HDR(c,ccs_) \
115 ((c)->header.prof.ccs = ccs_, \
116 LDV_RECORD_CREATE((c)))
117 #endif /* DEBUG_RETAINER */
118 #else
119 #define SET_PROF_HDR(c,ccs)
120 #endif
121
122 #define SET_HDR(c,_info,ccs) \
123 { \
124 (c)->header.info = _info; \
125 SET_PROF_HDR((StgClosure *)(c),ccs); \
126 }
127
128 #define SET_ARR_HDR(c,info,costCentreStack,n_words) \
129 SET_HDR(c,info,costCentreStack); \
130 (c)->words = n_words;
131
132 /* -----------------------------------------------------------------------------
133 How to get hold of the static link field for a static closure.
134 -------------------------------------------------------------------------- */
135
136 /* These are hard-coded. */
137 #define FUN_STATIC_LINK(p) (&(p)->payload[0])
138 #define THUNK_STATIC_LINK(p) (&(p)->payload[1])
139 #define IND_STATIC_LINK(p) (&(p)->payload[1])
140
141 INLINE_HEADER StgClosure **
142 STATIC_LINK(const StgInfoTable *info, StgClosure *p)
143 {
144 switch (info->type) {
145 case THUNK_STATIC:
146 return THUNK_STATIC_LINK(p);
147 case FUN_STATIC:
148 return FUN_STATIC_LINK(p);
149 case IND_STATIC:
150 return IND_STATIC_LINK(p);
151 default:
152 return &(p)->payload[info->layout.payload.ptrs +
153 info->layout.payload.nptrs];
154 }
155 }
156
157 #define STATIC_LINK2(info,p) \
158 (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs + \
159 info->layout.payload.nptrs + 1])))
160
161 /* -----------------------------------------------------------------------------
162 INTLIKE and CHARLIKE closures.
163 -------------------------------------------------------------------------- */
164
165 #define CHARLIKE_CLOSURE(n) ((P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE])
166 #define INTLIKE_CLOSURE(n) ((P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE])
167
168 /* ----------------------------------------------------------------------------
169 Macros for untagging and retagging closure pointers
170 For more information look at the comments in Cmm.h
171 ------------------------------------------------------------------------- */
172
173 static inline StgWord
174 GET_CLOSURE_TAG(StgClosure * p)
175 {
176 return (StgWord)p & TAG_MASK;
177 }
178
179 static inline StgClosure *
180 UNTAG_CLOSURE(StgClosure * p)
181 {
182 return (StgClosure*)((StgWord)p & ~TAG_MASK);
183 }
184
185 static inline StgClosure *
186 TAG_CLOSURE(StgWord tag,StgClosure * p)
187 {
188 return (StgClosure*)((StgWord)p | tag);
189 }
190
191 /* -----------------------------------------------------------------------------
192 Forwarding pointers
193 -------------------------------------------------------------------------- */
194
195 #define IS_FORWARDING_PTR(p) ((((StgWord)p) & 1) != 0)
196 #define MK_FORWARDING_PTR(p) (((StgWord)p) | 1)
197 #define UN_FORWARDING_PTR(p) (((StgWord)p) - 1)
198
199 /* -----------------------------------------------------------------------------
200 DEBUGGING predicates for pointers
201
202 LOOKS_LIKE_INFO_PTR(p) returns False if p is definitely not an info ptr
203 LOOKS_LIKE_CLOSURE_PTR(p) returns False if p is definitely not a closure ptr
204
205 These macros are complete but not sound. That is, they might
206 return false positives. Do not rely on them to distinguish info
207 pointers from closure pointers, for example.
208
209 We don't use address-space predicates these days, for portability
210 reasons, and the fact that code/data can be scattered about the
211 address space in a dynamically-linked environment. Our best option
212 is to look at the alleged info table and see whether it seems to
213 make sense...
214 -------------------------------------------------------------------------- */
215
216 INLINE_HEADER rtsBool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p)
217 {
218 StgInfoTable *info = INFO_PTR_TO_STRUCT(p);
219 return info->type != INVALID_OBJECT && info->type < N_CLOSURE_TYPES;
220 }
221
222 INLINE_HEADER rtsBool LOOKS_LIKE_INFO_PTR (StgWord p)
223 {
224 return p && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p));
225 }
226
227 INLINE_HEADER rtsBool LOOKS_LIKE_CLOSURE_PTR (void *p)
228 {
229 return LOOKS_LIKE_INFO_PTR((StgWord)(UNTAG_CLOSURE((StgClosure *)(p)))->header.info);
230 }
231
232 /* -----------------------------------------------------------------------------
233 Macros for calculating the size of a closure
234 -------------------------------------------------------------------------- */
235
236 INLINE_HEADER StgOffset PAP_sizeW ( nat n_args )
237 { return sizeofW(StgPAP) + n_args; }
238
239 INLINE_HEADER StgOffset AP_sizeW ( nat n_args )
240 { return sizeofW(StgAP) + n_args; }
241
242 INLINE_HEADER StgOffset AP_STACK_sizeW ( nat size )
243 { return sizeofW(StgAP_STACK) + size; }
244
245 INLINE_HEADER StgOffset CONSTR_sizeW( nat p, nat np )
246 { return sizeofW(StgHeader) + p + np; }
247
248 INLINE_HEADER StgOffset THUNK_SELECTOR_sizeW ( void )
249 { return sizeofW(StgSelector); }
250
251 INLINE_HEADER StgOffset BLACKHOLE_sizeW ( void )
252 { return sizeofW(StgHeader)+MIN_PAYLOAD_SIZE; }
253
254 /* --------------------------------------------------------------------------
255 Sizes of closures
256 ------------------------------------------------------------------------*/
257
258 INLINE_HEADER StgOffset sizeW_fromITBL( const StgInfoTable* itbl )
259 { return sizeofW(StgClosure)
260 + sizeofW(StgPtr) * itbl->layout.payload.ptrs
261 + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
262
263 INLINE_HEADER StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl )
264 { return sizeofW(StgThunk)
265 + sizeofW(StgPtr) * itbl->layout.payload.ptrs
266 + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
267
268 INLINE_HEADER StgOffset ap_stack_sizeW( StgAP_STACK* x )
269 { return AP_STACK_sizeW(x->size); }
270
271 INLINE_HEADER StgOffset ap_sizeW( StgAP* x )
272 { return AP_sizeW(x->n_args); }
273
274 INLINE_HEADER StgOffset pap_sizeW( StgPAP* x )
275 { return PAP_sizeW(x->n_args); }
276
277 INLINE_HEADER StgOffset arr_words_sizeW( StgArrWords* x )
278 { return sizeofW(StgArrWords) + x->words; }
279
280 INLINE_HEADER StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
281 { return sizeofW(StgMutArrPtrs) + x->size; }
282
283 INLINE_HEADER StgWord tso_sizeW ( StgTSO *tso )
284 { return TSO_STRUCT_SIZEW + tso->stack_size; }
285
286 INLINE_HEADER StgWord bco_sizeW ( StgBCO *bco )
287 { return bco->size; }
288
289 INLINE_HEADER nat
290 closure_sizeW_ (StgClosure *p, StgInfoTable *info)
291 {
292 switch (info->type) {
293 case THUNK_0_1:
294 case THUNK_1_0:
295 return sizeofW(StgThunk) + 1;
296 case FUN_0_1:
297 case CONSTR_0_1:
298 case FUN_1_0:
299 case CONSTR_1_0:
300 return sizeofW(StgHeader) + 1;
301 case THUNK_0_2:
302 case THUNK_1_1:
303 case THUNK_2_0:
304 return sizeofW(StgThunk) + 2;
305 case FUN_0_2:
306 case CONSTR_0_2:
307 case FUN_1_1:
308 case CONSTR_1_1:
309 case FUN_2_0:
310 case CONSTR_2_0:
311 return sizeofW(StgHeader) + 2;
312 case THUNK:
313 return thunk_sizeW_fromITBL(info);
314 case THUNK_SELECTOR:
315 return THUNK_SELECTOR_sizeW();
316 case AP_STACK:
317 return ap_stack_sizeW((StgAP_STACK *)p);
318 case AP:
319 return ap_sizeW((StgAP *)p);
320 case PAP:
321 return pap_sizeW((StgPAP *)p);
322 case IND:
323 case IND_PERM:
324 case IND_OLDGEN:
325 case IND_OLDGEN_PERM:
326 return sizeofW(StgInd);
327 case ARR_WORDS:
328 return arr_words_sizeW((StgArrWords *)p);
329 case MUT_ARR_PTRS_CLEAN:
330 case MUT_ARR_PTRS_DIRTY:
331 case MUT_ARR_PTRS_FROZEN:
332 case MUT_ARR_PTRS_FROZEN0:
333 return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
334 case TSO:
335 return tso_sizeW((StgTSO *)p);
336 case BCO:
337 return bco_sizeW((StgBCO *)p);
338 case TREC_CHUNK:
339 return sizeofW(StgTRecChunk);
340 default:
341 return sizeW_fromITBL(info);
342 }
343 }
344
345 // The definitive way to find the size, in words, of a heap-allocated closure
346 INLINE_HEADER nat
347 closure_sizeW (StgClosure *p)
348 {
349 return closure_sizeW_(p, get_itbl(p));
350 }
351
352 /* -----------------------------------------------------------------------------
353 Sizes of stack frames
354 -------------------------------------------------------------------------- */
355
356 INLINE_HEADER StgWord stack_frame_sizeW( StgClosure *frame )
357 {
358 StgRetInfoTable *info;
359
360 info = get_ret_itbl(frame);
361 switch (info->i.type) {
362
363 case RET_DYN:
364 {
365 StgRetDyn *dyn = (StgRetDyn *)frame;
366 return sizeofW(StgRetDyn) + RET_DYN_BITMAP_SIZE +
367 RET_DYN_NONPTR_REGS_SIZE +
368 RET_DYN_PTRS(dyn->liveness) + RET_DYN_NONPTRS(dyn->liveness);
369 }
370
371 case RET_FUN:
372 return sizeofW(StgRetFun) + ((StgRetFun *)frame)->size;
373
374 case RET_BIG:
375 return 1 + GET_LARGE_BITMAP(&info->i)->size;
376
377 case RET_BCO:
378 return 2 + BCO_BITMAP_SIZE((StgBCO *)((P_)frame)[1]);
379
380 default:
381 return 1 + BITMAP_SIZE(info->i.layout.bitmap);
382 }
383 }
384
385 /* -----------------------------------------------------------------------------
386 StgMutArrPtrs macros
387
388 An StgMutArrPtrs has a card table to indicate which elements are
389 dirty for the generational GC. The card table is an array of
390 bytes, where each byte covers (1 << MUT_ARR_PTRS_CARD_BITS)
391 elements. The card table is directly after the array data itself.
392 -------------------------------------------------------------------------- */
393
394 // The number of card bytes needed
395 INLINE_HEADER lnat mutArrPtrsCards (lnat elems)
396 {
397 return (lnat)((elems + (1 << MUT_ARR_PTRS_CARD_BITS) - 1)
398 >> MUT_ARR_PTRS_CARD_BITS);
399 }
400
401 // The number of words in the card table
402 INLINE_HEADER lnat mutArrPtrsCardTableSize (lnat elems)
403 {
404 return ROUNDUP_BYTES_TO_WDS(mutArrPtrsCards(elems));
405 }
406
407 // The address of the card for a particular card number
408 INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, lnat n)
409 {
410 return ((StgWord8 *)&(a->payload[a->ptrs]) + n);
411 }
412
413 #endif /* RTS_STORAGE_CLOSUREMACROS_H */