[project @ 2003-04-28 10:02:15 by simonmar]
[ghc-hetmet.git] / ghc / includes / Updates.h
1 /* -----------------------------------------------------------------------------
2  * $Id: Updates.h,v 1.31 2003/04/08 15:32:38 sof Exp $
3  *
4  * (c) The GHC Team, 1998-1999
5  *
6  * Definitions related to updates.
7  *
8  * ---------------------------------------------------------------------------*/
9
10 #ifndef UPDATES_H
11 #define UPDATES_H
12
13 /* -----------------------------------------------------------------------------
14    Update a closure with an indirection.  This may also involve waking
15    up a queue of blocked threads waiting on the result of this
16    computation.
17    -------------------------------------------------------------------------- */
18
19 /* ToDo: overwrite slop words with something safe in case sanity checking 
20  *       is turned on.  
21  *       (I think the fancy version of the GC is supposed to do this too.)
22  */
23
24 /* This expands to a fair chunk of code, what with waking up threads 
25  * and checking whether we're updating something in a old generation.
26  * preferably don't use this macro inline in compiled code.
27  */
28
29 #ifdef TICKY_TICKY
30 # define UPD_IND(updclosure, heapptr) \
31    UPD_PERM_IND(updclosure,heapptr)
32 # define UPD_SPEC_IND(updclosure, ind_info, heapptr, and_then) \
33    UPD_PERM_IND(updclosure,heapptr); and_then
34 #else
35 # define UPD_IND(updclosure, heapptr) \
36    UPD_REAL_IND(updclosure,&stg_IND_info,heapptr,)
37 # define UPD_SPEC_IND(updclosure, ind_info, heapptr, and_then) \
38    UPD_REAL_IND(updclosure,ind_info,heapptr,and_then)
39 #endif
40
41 /* UPD_IND actually does a PERM_IND if TICKY_TICKY is on;
42    if you *really* need an IND use UPD_REAL_IND
43  */
44 #ifdef SMP
45 #define UPD_REAL_IND(updclosure, ind_info, heapptr, and_then)           \
46    {                                                                    \
47         const StgInfoTable *info;                                       \
48         if (Bdescr((P_)updclosure)->u.back != (bdescr *)BaseReg) {      \
49                 info = LOCK_CLOSURE(updclosure);                        \
50         } else {                                                        \
51                 info = updclosure->header.info;                         \
52         }                                                               \
53         AWAKEN_BQ(info,updclosure);                                     \
54         updateWithIndirection(info, ind_info,                           \
55                               (StgClosure *)updclosure,                 \
56                               (StgClosure *)heapptr,                    \
57                               and_then);                                \
58    }
59 #else
60 #define UPD_REAL_IND(updclosure, ind_info, heapptr, and_then)   \
61    {                                                    \
62         const StgInfoTable *info;                       \
63         info = ((StgClosure *)updclosure)->header.info; \
64         AWAKEN_BQ(info,updclosure);                     \
65         updateWithIndirection(((StgClosure *)updclosure)->header.info, ind_info,                \
66                               (StgClosure *)updclosure, \
67                               (StgClosure *)heapptr,    \
68                               and_then);                \
69    }
70 #endif
71
72 #define UPD_STATIC_IND(updclosure, heapptr)                     \
73    {                                                            \
74         const StgInfoTable *info;                               \
75         info = ((StgClosure *)updclosure)->header.info;         \
76         AWAKEN_STATIC_BQ(info,updclosure);                      \
77         updateWithStaticIndirection(info,                       \
78                                     (StgClosure *)updclosure,   \
79                                     (StgClosure *)heapptr);     \
80    }
81
82 #if defined(PROFILING) || defined(TICKY_TICKY)
83 #define UPD_PERM_IND(updclosure, heapptr)                       \
84    {                                                            \
85         const StgInfoTable *info;                               \
86         info = ((StgClosure *)updclosure)->header.info;         \
87         AWAKEN_BQ(info,updclosure);                             \
88         updateWithPermIndirection(info,                         \
89                                   (StgClosure *)updclosure,     \
90                                   (StgClosure *)heapptr);       \
91    }
92 #endif
93
94 #ifdef SMP
95 #define UPD_IND_NOLOCK(updclosure, heapptr)                             \
96    {                                                                    \
97         const StgInfoTable *info;                                       \
98         info = updclosure->header.info;                                 \
99         AWAKEN_BQ(info,updclosure);                                     \
100         updateWithIndirection(info,&stg_IND_info,                       \
101                               (StgClosure *)updclosure,                 \
102                               (StgClosure *)heapptr,);                  \
103    }
104 #elif defined(RTS_SUPPORTS_THREADS)
105
106 # ifdef TICKY_TICKY
107 #  define UPD_IND_NOLOCK(updclosure, heapptr)                   \
108    {                                                            \
109         const StgInfoTable *info;                               \
110         info = ((StgClosure *)updclosure)->header.info;         \
111         AWAKEN_BQ_NOLOCK(info,updclosure);                      \
112         updateWithPermIndirection(info,                         \
113                                   (StgClosure *)updclosure,     \
114                                   (StgClosure *)heapptr);       \
115    }
116 # else
117 #  define UPD_IND_NOLOCK(updclosure, heapptr)           \
118    {                                                    \
119         const StgInfoTable *info;                       \
120         info = ((StgClosure *)updclosure)->header.info; \
121         AWAKEN_BQ_NOLOCK(info,updclosure);              \
122         updateWithIndirection(info,&stg_IND_info,       \
123                               (StgClosure *)updclosure, \
124                               (StgClosure *)heapptr,);  \
125    }
126 # endif
127
128 #else
129 #define UPD_IND_NOLOCK(updclosure,heapptr) UPD_IND(updclosure,heapptr)
130 #endif
131
132 /* -----------------------------------------------------------------------------
133    Awaken any threads waiting on this computation
134    -------------------------------------------------------------------------- */
135
136 #if defined(PAR) 
137
138 /* 
139    In a parallel setup several types of closures might have a blocking queue:
140      BLACKHOLE_BQ ... same as in the default concurrent setup; it will be
141                       reawakened via calling UPD_IND on that closure after
142                       having finished the computation of the graph
143      FETCH_ME_BQ  ... a global indirection (FETCH_ME) may be entered by a 
144                       local TSO, turning it into a FETCH_ME_BQ; it will be
145                       reawakened via calling processResume
146      RBH          ... a revertible black hole may be entered by another 
147                       local TSO, putting it onto its blocking queue; since
148                       RBHs only exist while the corresponding closure is in 
149                       transit, they will be reawakened via calling 
150                       convertToFetchMe (upon processing an ACK message)
151
152    In a parallel setup a blocking queue may contain 3 types of closures:
153      TSO           ... as in the default concurrent setup
154      BLOCKED_FETCH ... indicating that a TSO on another PE is waiting for
155                        the result of the current computation
156      CONSTR        ... an RBHSave closure (which contains data ripped out of
157                        the closure to make room for a blocking queue; since
158                        it only contains data we use the exisiting type of
159                        a CONSTR closure); this closure is the end of a 
160                        blocking queue for an RBH closure; it only exists in
161                        this kind of blocking queue and must be at the end
162                        of the queue
163 */                    
164 extern void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node);
165 #define DO_AWAKEN_BQ(bqe, node)  STGCALL2(awakenBlockedQueue, bqe, node);
166
167 #define AWAKEN_BQ(info,closure)                                         \
168         if (info == &stg_BLACKHOLE_BQ_info ||               \
169             info == &stg_FETCH_ME_BQ_info ||                \
170             get_itbl(closure)->type == RBH) {                           \
171                 DO_AWAKEN_BQ(((StgBlockingQueue *)closure)->blocking_queue, closure);                           \
172         }
173
174 #elif defined(GRAN)
175
176 extern void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node);
177 #define DO_AWAKEN_BQ(bq, node)  STGCALL2(awakenBlockedQueue, bq, node);
178
179 /* In GranSim we don't have FETCH_ME or FETCH_ME_BQ closures, so they are
180    not checked. The rest of the code is the same as for GUM.
181 */
182 #define AWAKEN_BQ(info,closure)                                         \
183         if (info == &stg_BLACKHOLE_BQ_info ||               \
184             get_itbl(closure)->type == RBH) {                           \
185                 DO_AWAKEN_BQ(((StgBlockingQueue *)closure)->blocking_queue, closure);                           \
186         }
187
188
189 #else /* !GRAN && !PAR */
190
191 extern void awakenBlockedQueue(StgTSO *q);
192 #define DO_AWAKEN_BQ(closure)   \
193         STGCALL1(awakenBlockedQueue,            \
194                  ((StgBlockingQueue *)closure)->blocking_queue);
195
196 #define AWAKEN_BQ(info,closure)                                         \
197         if (info == &stg_BLACKHOLE_BQ_info) {                           \
198           DO_AWAKEN_BQ(closure);                                        \
199         }
200
201 #define AWAKEN_STATIC_BQ(info,closure)                                  \
202         if (info == &stg_BLACKHOLE_BQ_STATIC_info) {                    \
203           DO_AWAKEN_BQ(closure);                                        \
204         }
205
206 #ifdef RTS_SUPPORTS_THREADS
207 extern void awakenBlockedQueueNoLock(StgTSO *q);
208 #define DO_AWAKEN_BQ_NOLOCK(closure)                                    \
209         STGCALL1(awakenBlockedQueueNoLock,                              \
210                  ((StgBlockingQueue *)closure)->blocking_queue);
211
212 #define AWAKEN_BQ_NOLOCK(info,closure)                                  \
213         if (info == &stg_BLACKHOLE_BQ_info) {                           \
214           DO_AWAKEN_BQ_NOLOCK(closure);                                 \
215         }
216 #endif
217 #endif /* GRAN || PAR */
218
219 /* -------------------------------------------------------------------------
220    Push an update frame on the stack.
221    ------------------------------------------------------------------------- */
222
223 #if defined(PROFILING)
224 // frame->header.prof.hp.rs = NULL (or frame-header.prof.hp.ldvw = 0) is unnecessary 
225 // because it is not used anyhow.
226 #define PUSH_STD_CCCS(frame) (frame->header.prof.ccs = CCCS)
227 #else
228 #define PUSH_STD_CCCS(frame)
229 #endif
230
231 extern DLL_IMPORT_RTS const StgPolyInfoTable stg_upd_frame_info; 
232 extern DLL_IMPORT_RTS const StgPolyInfoTable stg_noupd_frame_info; 
233
234 #define PUSH_UPD_FRAME(target, Sp_offset)                       \
235         {                                                       \
236                 StgUpdateFrame *__frame;                        \
237                 TICK_UPDF_PUSHED(target, GET_INFO((StgClosure*)target)); \
238                 __frame = (StgUpdateFrame *)(Sp + (Sp_offset)) - 1; \
239                 SET_INFO(__frame, (StgInfoTable *)&stg_upd_frame_info);   \
240                 __frame->updatee = (StgClosure *)(target);      \
241                 PUSH_STD_CCCS(__frame);                         \
242         }
243
244 /* -----------------------------------------------------------------------------
245    Entering CAFs
246
247    When a CAF is first entered, it creates a black hole in the heap,
248    and updates itself with an indirection to this new black hole.
249
250    We update the CAF with an indirection to a newly-allocated black
251    hole in the heap.  We also set the blocking queue on the newly
252    allocated black hole to be empty.
253
254    Why do we make a black hole in the heap when we enter a CAF?
255       
256        - for a  generational garbage collector, which needs a fast
257          test for whether an updatee is in an old generation or not
258
259        - for the parallel system, which can implement updates more
260          easily if the updatee is always in the heap. (allegedly).
261
262    When debugging, we maintain a separate CAF list so we can tell when
263    a CAF has been garbage collected.
264    -------------------------------------------------------------------------- */
265    
266 /* ToDo: only call newCAF when debugging. */
267
268 extern void newCAF(StgClosure*);
269
270 /* newCAF must be called before the itbl ptr is overwritten, since
271    newCAF records the old itbl ptr in order to do CAF reverting
272    (which Hugs needs to do in order that combined mode works right.)
273 */
274 #define UPD_CAF(cafptr, bhptr)                                          \
275   {                                                                     \
276     LOCK_CLOSURE(cafptr);                                               \
277     STGCALL1(newCAF,(StgClosure *)cafptr);                              \
278     ((StgInd *)cafptr)->indirectee   = (StgClosure *)(bhptr);           \
279     SET_INFO((StgInd *)cafptr,(const StgInfoTable*)&stg_IND_STATIC_info);\
280   }
281
282 /* -----------------------------------------------------------------------------
283    Update-related prototypes
284    -------------------------------------------------------------------------- */
285
286 #endif /* UPDATES_H */