Remove the concept of stableRoots.
[ghc-hetmet.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
63 #define GET_TAG(con) (get_itbl(con)->srt_bitmap)
64
65 #ifdef TABLES_NEXT_TO_CODE
66 #define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)(info) - 1)
67 #define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)(info) - 1)
68 #define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)(info) - 1)
69 #define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)(info) - 1)
70 #define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
71 #define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
72 #define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
73 #else
74 #define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)info)
75 #define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)info)
76 #define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)info)
77 #define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)info)
78 #define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(i))
79 #define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(i))
80 #define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(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 #define SET_STATIC_PROF_HDR(ccs_)       \
119         prof : { ccs : (CostCentreStack *)ccs_, hp : { rs : NULL } },
120 #else
121 #define SET_PROF_HDR(c,ccs)
122 #define SET_STATIC_PROF_HDR(ccs)
123 #endif
124
125 #ifdef GRAN
126 #define SET_GRAN_HDR(c,pe)              (c)->header.gran.procs = pe
127 #define SET_STATIC_GRAN_HDR             gran : { procs : Everywhere },
128 #else
129 #define SET_GRAN_HDR(c,pe)
130 #define SET_STATIC_GRAN_HDR
131 #endif
132
133 #ifdef PAR
134 #define SET_PAR_HDR(c,stuff)
135 #define SET_STATIC_PAR_HDR(stuff)
136 #else
137 #define SET_PAR_HDR(c,stuff)
138 #define SET_STATIC_PAR_HDR(stuff)
139 #endif
140
141 #ifdef TICKY_TICKY
142 #define SET_TICKY_HDR(c,stuff)       /* old: (c)->header.ticky.updated = stuff */
143 #define SET_STATIC_TICKY_HDR(stuff)  /* old: ticky : { updated : stuff } */
144 #else
145 #define SET_TICKY_HDR(c,stuff)
146 #define SET_STATIC_TICKY_HDR(stuff)
147 #endif
148
149 #define SET_HDR(c,_info,ccs)                            \
150    {                                                    \
151         (c)->header.info = _info;                       \
152         SET_GRAN_HDR((StgClosure *)(c),ThisPE);         \
153         SET_PAR_HDR((StgClosure *)(c),LOCAL_GA);        \
154         SET_PROF_HDR((StgClosure *)(c),ccs);            \
155         SET_TICKY_HDR((StgClosure *)(c),0);             \
156    }
157
158 #define SET_ARR_HDR(c,info,costCentreStack,n_words)     \
159    SET_HDR(c,info,costCentreStack);                     \
160    (c)->words = n_words;
161
162 /* -----------------------------------------------------------------------------
163    How to get hold of the static link field for a static closure.
164    -------------------------------------------------------------------------- */
165
166 /* These are hard-coded. */
167 #define FUN_STATIC_LINK(p)   (&(p)->payload[0])
168 #define THUNK_STATIC_LINK(p) (&(p)->payload[1])
169 #define IND_STATIC_LINK(p)   (&(p)->payload[1])
170
171 INLINE_HEADER StgClosure **
172 STATIC_LINK(const StgInfoTable *info, StgClosure *p)
173
174     switch (info->type) {
175     case THUNK_STATIC:
176         return THUNK_STATIC_LINK(p);
177     case FUN_STATIC:
178         return FUN_STATIC_LINK(p);
179     case IND_STATIC:
180         return IND_STATIC_LINK(p);
181     default:
182         return &(p)->payload[info->layout.payload.ptrs +
183                              info->layout.payload.nptrs];
184     }
185 }
186
187 #define STATIC_LINK2(info,p)                                                    \
188    (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs +                  \
189                                         info->layout.payload.nptrs + 1])))
190
191 /* -----------------------------------------------------------------------------
192    INTLIKE and CHARLIKE closures.
193    -------------------------------------------------------------------------- */
194
195 #define CHARLIKE_CLOSURE(n) ((P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE])
196 #define INTLIKE_CLOSURE(n)  ((P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE])
197
198 #endif /* CLOSUREMACROS_H */