[project @ 2004-08-13 13:57:04 by simonmar]
[ghc-hetmet.git] / ghc / includes / Updates.h
1 /* -----------------------------------------------------------------------------
2  *
3  * (c) The GHC Team, 1998-2004
4  *
5  * Performing updates.
6  *
7  * ---------------------------------------------------------------------------*/
8
9 #ifndef UPDATES_H
10 #define UPDATES_H
11
12 /* -----------------------------------------------------------------------------
13    Updates
14
15    We have two layers of update macros.  The top layer, UPD_IND() and
16    friends perform all the work of an update.  In detail:
17
18       - if the closure being updated is a blocking queue, then all the
19         threads waiting on the blocking queue are updated.
20
21       - then the lower level updateWithIndirection() macro is invoked 
22         to actually replace the closure with an indirection (see below).
23
24    -------------------------------------------------------------------------- */
25
26 #ifdef TICKY_TICKY
27 # define UPD_IND(updclosure, heapptr) \
28    UPD_PERM_IND(updclosure,heapptr)
29 # define UPD_SPEC_IND(updclosure, ind_info, heapptr, and_then) \
30    UPD_PERM_IND(updclosure,heapptr); and_then
31 #else
32 #  define SEMI ;
33 # define UPD_IND(updclosure, heapptr) \
34    UPD_REAL_IND(updclosure,INFO_PTR(stg_IND_info),heapptr,SEMI)
35 # define UPD_SPEC_IND(updclosure, ind_info, heapptr, and_then) \
36    UPD_REAL_IND(updclosure,ind_info,heapptr,and_then)
37 #endif
38
39 /* These macros have to work in both C and C--, so here's the
40  * impedence matching:
41  */
42 #ifdef CMINUSMINUS
43 #define DECLARE_IPTR(info)  W_ info
44 #define FCALL               foreign "C"
45 #define INFO_PTR(info)      info
46 #define ARG_PTR             "ptr"
47 #else
48 #define DECLARE_IPTR(info)  const StgInfoTable *(info)
49 #define FCALL               /* nothing */
50 #define INFO_PTR(info)      &info
51 #define StgBlockingQueue_blocking_queue(closure) \
52     (((StgBlockingQueue *)closure)->blocking_queue)
53 #define ARG_PTR             /* nothing */
54 #endif
55
56 /* UPD_IND actually does a PERM_IND if TICKY_TICKY is on;
57    if you *really* need an IND use UPD_REAL_IND
58  */
59 #define UPD_REAL_IND(updclosure, ind_info, heapptr, and_then)           \
60         DECLARE_IPTR(info);                                             \
61         info = GET_INFO(updclosure);                                    \
62         AWAKEN_BQ(info,updclosure);                                     \
63         updateWithIndirection(GET_INFO(updclosure), ind_info,           \
64                               updclosure,                               \
65                               heapptr,                                  \
66                               and_then);
67
68 #if defined(PROFILING) || defined(TICKY_TICKY)
69 #define UPD_PERM_IND(updclosure, heapptr)       \
70         DECLARE_IPTR(info);                     \
71         info = GET_INFO(updclosure);            \
72         AWAKEN_BQ(info,updclosure);             \
73         updateWithPermIndirection(info,         \
74                                   updclosure,   \
75                                   heapptr);
76 #endif
77
78 #if defined(RTS_SUPPORTS_THREADS)
79
80 # ifdef TICKY_TICKY
81 #  define UPD_IND_NOLOCK(updclosure, heapptr)   \
82         DECLARE_IPTR(info);                     \
83         info = GET_INFO(updclosure);            \
84         AWAKEN_BQ_NOLOCK(info,updclosure);      \
85         updateWithPermIndirection(info,         \
86                                   updclosure,   \
87                                   heapptr)
88 # else
89 #  define UPD_IND_NOLOCK(updclosure, heapptr)           \
90         DECLARE_IPTR(info);                             \
91         info = GET_INFO(updclosure);                    \
92         AWAKEN_BQ_NOLOCK(info,updclosure);              \
93         updateWithIndirection(info, INFO_PTR(stg_IND_info), \
94                               updclosure,               \
95                               heapptr,); 
96 # endif
97
98 #else
99 #define UPD_IND_NOLOCK(updclosure,heapptr) UPD_IND(updclosure,heapptr)
100 #endif
101
102 /* -----------------------------------------------------------------------------
103    Awaken any threads waiting on a blocking queue (BLACKHOLE_BQ).
104    -------------------------------------------------------------------------- */
105
106 #if defined(PAR) 
107
108 /* 
109    In a parallel setup several types of closures might have a blocking queue:
110      BLACKHOLE_BQ ... same as in the default concurrent setup; it will be
111                       reawakened via calling UPD_IND on that closure after
112                       having finished the computation of the graph
113      FETCH_ME_BQ  ... a global indirection (FETCH_ME) may be entered by a 
114                       local TSO, turning it into a FETCH_ME_BQ; it will be
115                       reawakened via calling processResume
116      RBH          ... a revertible black hole may be entered by another 
117                       local TSO, putting it onto its blocking queue; since
118                       RBHs only exist while the corresponding closure is in 
119                       transit, they will be reawakened via calling 
120                       convertToFetchMe (upon processing an ACK message)
121
122    In a parallel setup a blocking queue may contain 3 types of closures:
123      TSO           ... as in the default concurrent setup
124      BLOCKED_FETCH ... indicating that a TSO on another PE is waiting for
125                        the result of the current computation
126      CONSTR        ... an RBHSave closure (which contains data ripped out of
127                        the closure to make room for a blocking queue; since
128                        it only contains data we use the exisiting type of
129                        a CONSTR closure); this closure is the end of a 
130                        blocking queue for an RBH closure; it only exists in
131                        this kind of blocking queue and must be at the end
132                        of the queue
133 */                    
134 extern void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node);
135 #define DO_AWAKEN_BQ(bqe, node)  STGCALL2(awakenBlockedQueue, bqe, node);
136
137 #define AWAKEN_BQ(info,closure)                                         \
138         if (info == &stg_BLACKHOLE_BQ_info ||               \
139             info == &stg_FETCH_ME_BQ_info ||                \
140             get_itbl(closure)->type == RBH) {                           \
141                 DO_AWAKEN_BQ(((StgBlockingQueue *)closure)->blocking_queue, closure);                           \
142         }
143
144 #elif defined(GRAN)
145
146 extern void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node);
147 #define DO_AWAKEN_BQ(bq, node)  STGCALL2(awakenBlockedQueue, bq, node);
148
149 /* In GranSim we don't have FETCH_ME or FETCH_ME_BQ closures, so they are
150    not checked. The rest of the code is the same as for GUM.
151 */
152 #define AWAKEN_BQ(info,closure)                                         \
153         if (info == &stg_BLACKHOLE_BQ_info ||               \
154             get_itbl(closure)->type == RBH) {                           \
155                 DO_AWAKEN_BQ(((StgBlockingQueue *)closure)->blocking_queue, closure);                           \
156         }
157
158
159 #else /* !GRAN && !PAR */
160
161 #define DO_AWAKEN_BQ(closure)   \
162         FCALL awakenBlockedQueue(StgBlockingQueue_blocking_queue(closure) ARG_PTR);
163
164 #define AWAKEN_BQ(info,closure)                                         \
165         if (info == INFO_PTR(stg_BLACKHOLE_BQ_info)) {                  \
166           DO_AWAKEN_BQ(closure);                                        \
167         }
168
169 #define AWAKEN_STATIC_BQ(info,closure)                                  \
170         if (info == INFO_PTR(stg_BLACKHOLE_BQ_STATIC_info)) {           \
171           DO_AWAKEN_BQ(closure);                                        \
172         }
173
174 #ifdef RTS_SUPPORTS_THREADS
175 #define DO_AWAKEN_BQ_NOLOCK(closure) \
176         FCALL awakenBlockedQueueNoLock(StgBlockingQueue_blocking_queue(closure) ARG_PTR);
177
178 #define AWAKEN_BQ_NOLOCK(info,closure)                                  \
179         if (info == INFO_PTR(stg_BLACKHOLE_BQ_info)) {                  \
180           DO_AWAKEN_BQ_NOLOCK(closure);                                 \
181         }
182 #endif
183 #endif /* GRAN || PAR */
184
185 /* -----------------------------------------------------------------------------
186    Updates: lower-level macros which update a closure with an
187    indirection to another closure.
188
189    There are several variants of this code.
190
191        PROFILING:
192    -------------------------------------------------------------------------- */
193
194 /* LDV profiling:
195  * We call LDV_recordDead_FILL_SLOP_DYNAMIC(p1) regardless of the generation in 
196  * which p1 resides.
197  *
198  * Note: 
199  *   After all, we do *NOT* need to call LDV_RECORD_CREATE() for both IND and 
200  *   IND_OLDGEN closures because they are inherently used. But, it corrupts
201  *   the invariants that every closure keeps its creation time in the profiling
202  *  field. So, we call LDV_RECORD_CREATE().
203  */
204
205 /* In the DEBUG case, we also zero out the slop of the old closure,
206  * so that the sanity checker can tell where the next closure is.
207  *
208  * Two important invariants: we should never try to update a closure
209  * to point to itself, and the closure being updated should not
210  * already have been updated (the mutable list will get messed up
211  * otherwise).
212  */
213 #if !defined(DEBUG)
214
215 #define DEBUG_FILL_SLOP(p) /* nothing */
216
217 #else  /* DEBUG */
218
219 #ifdef CMINUSMINUS
220
221 #define DEBUG_FILL_SLOP(p)                      \
222   W_ inf;                                       \
223   W_ np;                                        \
224   W_ nw;                                        \
225   W_ i;                                         \
226   inf = %GET_STD_INFO(p);                       \
227   np = TO_W_(%INFO_PTRS(inf));                  \
228   nw = TO_W_(%INFO_NPTRS(inf));                 \
229   if (%INFO_TYPE(inf) != THUNK_SELECTOR::I16) { \
230     i = 0;                                      \
231     for:                                        \
232       if (i < np + nw) {                        \
233         StgClosure_payload(p,i) = 0;            \
234         i = i + 1;                              \
235         goto for;                               \
236       }                                         \
237   }
238
239
240 #else /* !CMINUSMINUS */
241
242 INLINE_HEADER void
243 DEBUG_FILL_SLOP(StgClosure *p)
244 {                                               
245     StgInfoTable *inf = get_itbl(p);            
246     nat np = inf->layout.payload.ptrs,          
247         nw = inf->layout.payload.nptrs, i;
248     if (inf->type != THUNK_SELECTOR) {
249         for (i = 0; i < np + nw; i++) {
250             ((StgClosure *)p)->payload[i] = 0;
251         }
252     }
253 }
254
255 #endif /* CMINUSMINUS */
256 #endif /* DEBUG */
257
258 /* We have two versions of this macro (sadly), one for use in C-- code,
259  * and the other for C.
260  *
261  * The and_then argument is a performance hack so that we can paste in
262  * the continuation code directly.  It helps shave a couple of
263  * instructions off the common case in the update code, which is
264  * worthwhile (the update code is often part of the inner loop).
265  * (except that gcc now appears to common up this code again and
266  * invert the optimisation.  Grrrr --SDM).
267  */
268 #ifdef CMINUSMINUS
269 #define generation(n) (W_[generations] + n*SIZEOF_generation)
270 #define updateWithIndirection(info, ind_info, p1, p2, and_then) \
271     W_ bd;                                                      \
272                                                                 \
273 /*    ASSERT( p1 != p2 && !closure_IND(p1) );                   \
274  */ LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1);                      \
275     bd = Bdescr(p1);                                            \
276     if (bdescr_gen_no(bd) == 0) {                               \
277       StgInd_indirectee(p1) = p2;                               \
278       SET_INFO(p1, ind_info);                                   \
279       LDV_RECORD_CREATE(p1);                                    \
280       TICK_UPD_NEW_IND();                                       \
281       and_then;                                                 \
282     } else {                                                    \
283       if (info != stg_BLACKHOLE_BQ_info) {                      \
284         DEBUG_FILL_SLOP(p1);                                    \
285         W_ __mut_once_list;                                     \
286         __mut_once_list = generation(bdescr_gen_no(bd)) +       \
287                              OFFSET_generation_mut_once_list;   \
288         StgMutClosure_mut_link(p1) = W_[__mut_once_list];       \
289         W_[__mut_once_list] = p1;                               \
290       }                                                         \
291       StgInd_indirectee(p1) = p2;                               \
292       SET_INFO(p1, stg_IND_OLDGEN_info);                        \
293       LDV_RECORD_CREATE(p1);                                    \
294       TICK_UPD_OLD_IND();                                       \
295       and_then;                                                 \
296   }
297 #else
298 #define updateWithIndirection(_info, ind_info, p1, p2, and_then)        \
299   {                                                                     \
300     bdescr *bd;                                                         \
301                                                                         \
302     ASSERT( (P_)p1 != (P_)p2 && !closure_IND(p1) );                     \
303     LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1);                              \
304     bd = Bdescr((P_)p1);                                                \
305     if (bd->gen_no == 0) {                                              \
306       SET_INFO(p1, ind_info);                                           \
307       LDV_RECORD_CREATE(p1);                                            \
308       TICK_UPD_NEW_IND();                                               \
309       and_then;                                                         \
310     }}
311 #endif
312
313 /* The permanent indirection version isn't performance critical.  We
314  * therefore use an inline C function instead of the C-- macro.
315  */
316 #ifndef CMINUSMINUS
317 INLINE_HEADER void
318 updateWithPermIndirection(const StgInfoTable *info, 
319                           StgClosure *p1,
320                           StgClosure *p2) 
321 {
322   bdescr *bd;
323
324   ASSERT( p1 != p2 && !closure_IND(p1) );
325
326   // @LDV profiling
327   // Destroy the old closure.
328   // Nb: LDV_* stuff cannot mix with ticky-ticky
329   LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1);
330
331   bd = Bdescr((P_)p1);
332   if (bd->gen_no == 0) {
333     ((StgInd *)p1)->indirectee = p2;
334     SET_INFO(p1, &stg_IND_PERM_info);
335     // @LDV profiling
336     // We have just created a new closure.
337     LDV_RECORD_CREATE(p1);
338     TICK_UPD_NEW_PERM_IND(p1);
339   } else {
340     if (info != &stg_BLACKHOLE_BQ_info) {
341       ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list;
342       generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1;
343     }
344     ((StgIndOldGen *)p1)->indirectee = p2;
345     SET_INFO(p1, &stg_IND_OLDGEN_PERM_info);
346     // @LDV profiling
347     // We have just created a new closure.
348     LDV_RECORD_CREATE(p1);
349     TICK_UPD_OLD_PERM_IND();
350   }
351 }
352 #endif
353
354 #endif /* UPDATES_H */