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