1 /* ----------------------------------------------------------------------------
3 * (c) The GHC Team, 1998-2004
5 * Macros for building and manipulating closures
7 * -------------------------------------------------------------------------- */
9 #ifndef RTS_STORAGE_CLOSUREMACROS_H
10 #define RTS_STORAGE_CLOSUREMACROS_H
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.
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.
22 NOTES ABOUT MANGLED C VS. MINI-INTERPRETER:
24 A couple of definitions:
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.
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.
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,
43 c->header.info = xxx_info
45 makes absolute sense, whether mangling or not.
47 -------------------------------------------------------------------------- */
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)))
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))
59 #define GET_TAG(con) (get_itbl(con)->srt_bitmap)
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)
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))
83 /* -----------------------------------------------------------------------------
84 Macros for building closures
85 -------------------------------------------------------------------------- */
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.
96 #define SET_PROF_HDR(c,ccs_) \
97 ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip))
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.
106 #define SET_PROF_HDR(c,ccs_) \
107 ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = NULL)
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.
114 #define SET_PROF_HDR(c,ccs_) \
115 ((c)->header.prof.ccs = ccs_, \
116 LDV_RECORD_CREATE((c)))
117 #endif /* DEBUG_RETAINER */
119 #define SET_PROF_HDR(c,ccs)
122 #define SET_HDR(c,_info,ccs) \
124 (c)->header.info = _info; \
125 SET_PROF_HDR((StgClosure *)(c),ccs); \
128 #define SET_ARR_HDR(c,info,costCentreStack,n_bytes) \
129 SET_HDR(c,info,costCentreStack); \
130 (c)->bytes = n_bytes;
132 // Use when changing a closure from one kind to another
133 #define OVERWRITE_INFO(c, new_info) \
134 LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC((StgClosure *)(c)); \
135 SET_INFO((c), (new_info)); \
136 LDV_RECORD_CREATE(c);
138 /* -----------------------------------------------------------------------------
139 How to get hold of the static link field for a static closure.
140 -------------------------------------------------------------------------- */
142 /* These are hard-coded. */
143 #define FUN_STATIC_LINK(p) (&(p)->payload[0])
144 #define THUNK_STATIC_LINK(p) (&(p)->payload[1])
145 #define IND_STATIC_LINK(p) (&(p)->payload[1])
147 INLINE_HEADER StgClosure **
148 STATIC_LINK(const StgInfoTable *info, StgClosure *p)
150 switch (info->type) {
152 return THUNK_STATIC_LINK(p);
154 return FUN_STATIC_LINK(p);
156 return IND_STATIC_LINK(p);
158 return &(p)->payload[info->layout.payload.ptrs +
159 info->layout.payload.nptrs];
163 #define STATIC_LINK2(info,p) \
164 (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs + \
165 info->layout.payload.nptrs + 1])))
167 /* -----------------------------------------------------------------------------
168 INTLIKE and CHARLIKE closures.
169 -------------------------------------------------------------------------- */
171 #define CHARLIKE_CLOSURE(n) ((P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE])
172 #define INTLIKE_CLOSURE(n) ((P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE])
174 /* ----------------------------------------------------------------------------
175 Macros for untagging and retagging closure pointers
176 For more information look at the comments in Cmm.h
177 ------------------------------------------------------------------------- */
179 static inline StgWord
180 GET_CLOSURE_TAG(StgClosure * p)
182 return (StgWord)p & TAG_MASK;
185 static inline StgClosure *
186 UNTAG_CLOSURE(StgClosure * p)
188 return (StgClosure*)((StgWord)p & ~TAG_MASK);
191 static inline StgClosure *
192 TAG_CLOSURE(StgWord tag,StgClosure * p)
194 return (StgClosure*)((StgWord)p | tag);
197 /* -----------------------------------------------------------------------------
199 -------------------------------------------------------------------------- */
201 #define IS_FORWARDING_PTR(p) ((((StgWord)p) & 1) != 0)
202 #define MK_FORWARDING_PTR(p) (((StgWord)p) | 1)
203 #define UN_FORWARDING_PTR(p) (((StgWord)p) - 1)
205 /* -----------------------------------------------------------------------------
206 DEBUGGING predicates for pointers
208 LOOKS_LIKE_INFO_PTR(p) returns False if p is definitely not an info ptr
209 LOOKS_LIKE_CLOSURE_PTR(p) returns False if p is definitely not a closure ptr
211 These macros are complete but not sound. That is, they might
212 return false positives. Do not rely on them to distinguish info
213 pointers from closure pointers, for example.
215 We don't use address-space predicates these days, for portability
216 reasons, and the fact that code/data can be scattered about the
217 address space in a dynamically-linked environment. Our best option
218 is to look at the alleged info table and see whether it seems to
220 -------------------------------------------------------------------------- */
222 INLINE_HEADER rtsBool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p)
224 StgInfoTable *info = INFO_PTR_TO_STRUCT(p);
225 return info->type != INVALID_OBJECT && info->type < N_CLOSURE_TYPES;
228 INLINE_HEADER rtsBool LOOKS_LIKE_INFO_PTR (StgWord p)
230 return p && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p));
233 INLINE_HEADER rtsBool LOOKS_LIKE_CLOSURE_PTR (void *p)
235 return LOOKS_LIKE_INFO_PTR((StgWord)(UNTAG_CLOSURE((StgClosure *)(p)))->header.info);
238 /* -----------------------------------------------------------------------------
239 Macros for calculating the size of a closure
240 -------------------------------------------------------------------------- */
242 INLINE_HEADER StgOffset PAP_sizeW ( nat n_args )
243 { return sizeofW(StgPAP) + n_args; }
245 INLINE_HEADER StgOffset AP_sizeW ( nat n_args )
246 { return sizeofW(StgAP) + n_args; }
248 INLINE_HEADER StgOffset AP_STACK_sizeW ( nat size )
249 { return sizeofW(StgAP_STACK) + size; }
251 INLINE_HEADER StgOffset CONSTR_sizeW( nat p, nat np )
252 { return sizeofW(StgHeader) + p + np; }
254 INLINE_HEADER StgOffset THUNK_SELECTOR_sizeW ( void )
255 { return sizeofW(StgSelector); }
257 INLINE_HEADER StgOffset BLACKHOLE_sizeW ( void )
258 { return sizeofW(StgInd); } // a BLACKHOLE is a kind of indirection
260 /* --------------------------------------------------------------------------
262 ------------------------------------------------------------------------*/
264 INLINE_HEADER StgOffset sizeW_fromITBL( const StgInfoTable* itbl )
265 { return sizeofW(StgClosure)
266 + sizeofW(StgPtr) * itbl->layout.payload.ptrs
267 + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
269 INLINE_HEADER StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl )
270 { return sizeofW(StgThunk)
271 + sizeofW(StgPtr) * itbl->layout.payload.ptrs
272 + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
274 INLINE_HEADER StgOffset ap_stack_sizeW( StgAP_STACK* x )
275 { return AP_STACK_sizeW(x->size); }
277 INLINE_HEADER StgOffset ap_sizeW( StgAP* x )
278 { return AP_sizeW(x->n_args); }
280 INLINE_HEADER StgOffset pap_sizeW( StgPAP* x )
281 { return PAP_sizeW(x->n_args); }
283 INLINE_HEADER StgWord arr_words_words( StgArrWords* x)
284 { return ROUNDUP_BYTES_TO_WDS(x->bytes); }
286 INLINE_HEADER StgOffset arr_words_sizeW( StgArrWords* x )
287 { return sizeofW(StgArrWords) + arr_words_words(x); }
289 INLINE_HEADER StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
290 { return sizeofW(StgMutArrPtrs) + x->size; }
292 INLINE_HEADER StgWord tso_sizeW ( StgTSO *tso )
293 { return TSO_STRUCT_SIZEW + tso->stack_size; }
295 INLINE_HEADER StgWord bco_sizeW ( StgBCO *bco )
296 { return bco->size; }
299 closure_sizeW_ (StgClosure *p, StgInfoTable *info)
301 switch (info->type) {
304 return sizeofW(StgThunk) + 1;
309 return sizeofW(StgHeader) + 1;
313 return sizeofW(StgThunk) + 2;
320 return sizeofW(StgHeader) + 2;
322 return thunk_sizeW_fromITBL(info);
324 return THUNK_SELECTOR_sizeW();
326 return ap_stack_sizeW((StgAP_STACK *)p);
328 return ap_sizeW((StgAP *)p);
330 return pap_sizeW((StgPAP *)p);
333 return sizeofW(StgInd);
335 return arr_words_sizeW((StgArrWords *)p);
336 case MUT_ARR_PTRS_CLEAN:
337 case MUT_ARR_PTRS_DIRTY:
338 case MUT_ARR_PTRS_FROZEN:
339 case MUT_ARR_PTRS_FROZEN0:
340 return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
342 return tso_sizeW((StgTSO *)p);
344 return bco_sizeW((StgBCO *)p);
346 return sizeofW(StgTRecChunk);
348 return sizeW_fromITBL(info);
352 // The definitive way to find the size, in words, of a heap-allocated closure
354 closure_sizeW (StgClosure *p)
356 return closure_sizeW_(p, get_itbl(p));
359 /* -----------------------------------------------------------------------------
360 Sizes of stack frames
361 -------------------------------------------------------------------------- */
363 INLINE_HEADER StgWord stack_frame_sizeW( StgClosure *frame )
365 StgRetInfoTable *info;
367 info = get_ret_itbl(frame);
368 switch (info->i.type) {
372 StgRetDyn *dyn = (StgRetDyn *)frame;
373 return sizeofW(StgRetDyn) + RET_DYN_BITMAP_SIZE +
374 RET_DYN_NONPTR_REGS_SIZE +
375 RET_DYN_PTRS(dyn->liveness) + RET_DYN_NONPTRS(dyn->liveness);
379 return sizeofW(StgRetFun) + ((StgRetFun *)frame)->size;
382 return 1 + GET_LARGE_BITMAP(&info->i)->size;
385 return 2 + BCO_BITMAP_SIZE((StgBCO *)((P_)frame)[1]);
388 return 1 + BITMAP_SIZE(info->i.layout.bitmap);
392 /* -----------------------------------------------------------------------------
395 An StgMutArrPtrs has a card table to indicate which elements are
396 dirty for the generational GC. The card table is an array of
397 bytes, where each byte covers (1 << MUT_ARR_PTRS_CARD_BITS)
398 elements. The card table is directly after the array data itself.
399 -------------------------------------------------------------------------- */
401 // The number of card bytes needed
402 INLINE_HEADER lnat mutArrPtrsCards (lnat elems)
404 return (lnat)((elems + (1 << MUT_ARR_PTRS_CARD_BITS) - 1)
405 >> MUT_ARR_PTRS_CARD_BITS);
408 // The number of words in the card table
409 INLINE_HEADER lnat mutArrPtrsCardTableSize (lnat elems)
411 return ROUNDUP_BYTES_TO_WDS(mutArrPtrsCards(elems));
414 // The address of the card for a particular card number
415 INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, lnat n)
417 return ((StgWord8 *)&(a->payload[a->ptrs]) + n);
420 #endif /* RTS_STORAGE_CLOSUREMACROS_H */