Zonk the existential type variables in tcPatSynDecl
[ghc.git] / rts / ThreadPaused.c
1 /* -----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team 1998-2006
4 *
5 * Tidying up a thread when it stops running
6 *
7 * ---------------------------------------------------------------------------*/
8
9 // #include "PosixSource.h"
10 #include "Rts.h"
11
12 #include "ThreadPaused.h"
13 #include "sm/Storage.h"
14 #include "Updates.h"
15 #include "RaiseAsync.h"
16 #include "Trace.h"
17 #include "Threads.h"
18
19 #include <string.h> // for memmove()
20
21 /* -----------------------------------------------------------------------------
22 * Stack squeezing
23 *
24 * Code largely pinched from old RTS, then hacked to bits. We also do
25 * lazy black holing here.
26 *
27 * -------------------------------------------------------------------------- */
28
29 struct stack_gap { StgWord gap_size; struct stack_gap *next_gap; };
30
31 static struct stack_gap *
32 updateAdjacentFrames (Capability *cap, StgTSO *tso,
33 StgUpdateFrame *upd, nat count, struct stack_gap *next)
34 {
35 StgClosure *updatee;
36 struct stack_gap *gap;
37 nat i;
38
39 // The first one (highest address) is the frame we take the
40 // "master" updatee from; all the others will be made indirections
41 // to this one. It is essential that we do it this way around: we
42 // used to make the lowest-addressed frame the "master" frame and
43 // shuffle it down, but a bad case cropped up (#5505) where this
44 // happened repeatedly, generating a chain of indirections which
45 // the GC repeatedly traversed (indirection chains longer than one
46 // are not supposed to happen). So now after identifying a block
47 // of adjacent update frames we walk downwards again updating them
48 // all to point to the highest one, before squeezing out all but
49 // the highest one.
50 updatee = upd->updatee;
51 count--;
52
53 upd--;
54 gap = (struct stack_gap*)upd;
55
56 for (i = count; i > 0; i--, upd--) {
57 /*
58 * Check two things: that the two update frames
59 * don't point to the same object, and that the
60 * updatee_bypass isn't already an indirection.
61 * Both of these cases only happen when we're in a
62 * block hole-style loop (and there are multiple
63 * update frames on the stack pointing to the same
64 * closure), but they can both screw us up if we
65 * don't check.
66 */
67 if (upd->updatee != updatee && !closure_IND(upd->updatee)) {
68 updateThunk(cap, tso, upd->updatee, updatee);
69 }
70 }
71
72 gap->gap_size = count * sizeofW(StgUpdateFrame);
73 gap->next_gap = next;
74
75 return gap;
76 }
77
78 static void
79 stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom)
80 {
81 StgPtr frame;
82 nat adjacent_update_frames;
83 struct stack_gap *gap;
84
85 // Stage 1:
86 // Traverse the stack upwards, replacing adjacent update frames
87 // with a single update frame and a "stack gap". A stack gap
88 // contains two values: the size of the gap, and the distance
89 // to the next gap (or the stack top).
90
91 frame = tso->stackobj->sp;
92
93 ASSERT(frame < bottom);
94
95 adjacent_update_frames = 0;
96 gap = (struct stack_gap *) (frame - sizeofW(StgUpdateFrame));
97
98 while (frame <= bottom)
99 {
100 switch (get_ret_itbl((StgClosure *)frame)->i.type) {
101
102 case UPDATE_FRAME:
103 {
104 if (adjacent_update_frames > 0) {
105 TICK_UPD_SQUEEZED();
106 }
107 adjacent_update_frames++;
108
109 frame += sizeofW(StgUpdateFrame);
110 continue;
111 }
112
113 default:
114 // we're not in a gap... check whether this is the end of a gap
115 // (an update frame can't be the end of a gap).
116 if (adjacent_update_frames > 1) {
117 gap = updateAdjacentFrames(cap, tso,
118 (StgUpdateFrame*)(frame - sizeofW(StgUpdateFrame)),
119 adjacent_update_frames, gap);
120 }
121 adjacent_update_frames = 0;
122
123 frame += stack_frame_sizeW((StgClosure *)frame);
124 continue;
125 }
126 }
127
128 if (adjacent_update_frames > 1) {
129 gap = updateAdjacentFrames(cap, tso,
130 (StgUpdateFrame*)(frame - sizeofW(StgUpdateFrame)),
131 adjacent_update_frames, gap);
132 }
133
134 // Now we have a stack with gaps in it, and we have to walk down
135 // shoving the stack up to fill in the gaps. A diagram might
136 // help:
137 //
138 // +| ********* |
139 // | ********* | <- sp
140 // | |
141 // | | <- gap_start
142 // | ......... | |
143 // | stack_gap | <- gap | chunk_size
144 // | ......... | |
145 // | ......... | <- gap_end v
146 // | ********* |
147 // | ********* |
148 // | ********* |
149 // -| ********* |
150 //
151 // 'sp' points the the current top-of-stack
152 // 'gap' points to the stack_gap structure inside the gap
153 // ***** indicates real stack data
154 // ..... indicates gap
155 // <empty> indicates unused
156 //
157 {
158 StgWord8 *sp;
159 StgWord8 *gap_start, *next_gap_start, *gap_end;
160 nat chunk_size;
161
162 next_gap_start = (StgWord8*)gap + sizeof(StgUpdateFrame);
163 sp = next_gap_start;
164
165 while ((StgPtr)gap > tso->stackobj->sp) {
166
167 // we're working in *bytes* now...
168 gap_start = next_gap_start;
169 gap_end = gap_start - gap->gap_size * sizeof(W_);
170
171 gap = gap->next_gap;
172 next_gap_start = (StgWord8*)gap + sizeof(StgUpdateFrame);
173
174 chunk_size = gap_end - next_gap_start;
175 sp -= chunk_size;
176 memmove(sp, next_gap_start, chunk_size);
177 }
178
179 tso->stackobj->sp = (StgPtr)sp;
180 }
181 }
182
183 /* -----------------------------------------------------------------------------
184 * Pausing a thread
185 *
186 * We have to prepare for GC - this means doing lazy black holing
187 * here. We also take the opportunity to do stack squeezing if it's
188 * turned on.
189 * -------------------------------------------------------------------------- */
190 void
191 threadPaused(Capability *cap, StgTSO *tso)
192 {
193 StgClosure *frame;
194 StgRetInfoTable *info;
195 const StgInfoTable *bh_info;
196 const StgInfoTable *cur_bh_info USED_IF_THREADS;
197 StgClosure *bh;
198 StgPtr stack_end;
199 nat words_to_squeeze = 0;
200 nat weight = 0;
201 nat weight_pending = 0;
202 rtsBool prev_was_update_frame = rtsFalse;
203
204 // Check to see whether we have threads waiting to raise
205 // exceptions, and we're not blocking exceptions, or are blocked
206 // interruptibly. This is important; if a thread is running with
207 // TSO_BLOCKEX and becomes blocked interruptibly, this is the only
208 // place we ensure that the blocked_exceptions get a chance.
209 maybePerformBlockedException (cap, tso);
210 if (tso->what_next == ThreadKilled) { return; }
211
212 // NB. Blackholing is *compulsory*, we must either do lazy
213 // blackholing, or eager blackholing consistently. See Note
214 // [upd-black-hole] in sm/Scav.c.
215
216 stack_end = tso->stackobj->stack + tso->stackobj->stack_size;
217
218 frame = (StgClosure *)tso->stackobj->sp;
219
220 while ((P_)frame < stack_end) {
221 info = get_ret_itbl(frame);
222
223 switch (info->i.type) {
224
225 case UPDATE_FRAME:
226
227 // If we've already marked this frame, then stop here.
228 if (frame->header.info == (StgInfoTable *)&stg_marked_upd_frame_info) {
229 if (prev_was_update_frame) {
230 words_to_squeeze += sizeofW(StgUpdateFrame);
231 weight += weight_pending;
232 weight_pending = 0;
233 }
234 goto end;
235 }
236
237 SET_INFO(frame, (StgInfoTable *)&stg_marked_upd_frame_info);
238
239 bh = ((StgUpdateFrame *)frame)->updatee;
240 bh_info = bh->header.info;
241
242 #ifdef THREADED_RTS
243 retry:
244 #endif
245 // If the info table is a WHITEHOLE or a BLACKHOLE, then
246 // another thread has claimed it (via the SET_INFO()
247 // below), or is in the process of doing so. In that case
248 // we want to suspend the work that the current thread has
249 // done on this thunk and wait until the other thread has
250 // finished.
251 //
252 // If eager blackholing is taking place, it could be the
253 // case that the blackhole points to the current
254 // TSO. e.g.:
255 //
256 // this thread other thread
257 // --------------------------------------------------------
258 // c->indirectee = other_tso;
259 // c->header.info = EAGER_BH
260 // threadPaused():
261 // c->header.info = WHITEHOLE
262 // c->indirectee = other_tso
263 // c->indirectee = this_tso;
264 // c->header.info = EAGER_BH
265 // c->header.info = BLACKHOLE
266 // threadPaused()
267 // *** c->header.info is now BLACKHOLE,
268 // c->indirectee points to this_tso
269 //
270 // So in this case do *not* suspend the work of the
271 // current thread, because the current thread will become
272 // deadlocked on itself. See #5226 for an instance of
273 // this bug.
274 //
275 if ((bh_info == &stg_WHITEHOLE_info ||
276 bh_info == &stg_BLACKHOLE_info)
277 &&
278 ((StgInd*)bh)->indirectee != (StgClosure*)tso)
279 {
280 debugTrace(DEBUG_squeeze,
281 "suspending duplicate work: %ld words of stack",
282 (long)((StgPtr)frame - tso->stackobj->sp));
283
284 // If this closure is already an indirection, then
285 // suspend the computation up to this point.
286 // NB. check raiseAsync() to see what happens when
287 // we're in a loop (#2783).
288 suspendComputation(cap,tso,(StgUpdateFrame*)frame);
289
290 // Now drop the update frame, and arrange to return
291 // the value to the frame underneath:
292 tso->stackobj->sp = (StgPtr)frame + sizeofW(StgUpdateFrame) - 2;
293 tso->stackobj->sp[1] = (StgWord)bh;
294 ASSERT(bh->header.info != &stg_TSO_info);
295 tso->stackobj->sp[0] = (W_)&stg_enter_info;
296
297 // And continue with threadPaused; there might be
298 // yet more computation to suspend.
299 frame = (StgClosure *)(tso->stackobj->sp + 2);
300 prev_was_update_frame = rtsFalse;
301 continue;
302 }
303
304
305 // zero out the slop so that the sanity checker can tell
306 // where the next closure is.
307 OVERWRITING_CLOSURE(bh);
308
309 // an EAGER_BLACKHOLE or CAF_BLACKHOLE gets turned into a
310 // BLACKHOLE here.
311 #ifdef THREADED_RTS
312 // first we turn it into a WHITEHOLE to claim it, and if
313 // successful we write our TSO and then the BLACKHOLE info pointer.
314 cur_bh_info = (const StgInfoTable *)
315 cas((StgVolatilePtr)&bh->header.info,
316 (StgWord)bh_info,
317 (StgWord)&stg_WHITEHOLE_info);
318
319 if (cur_bh_info != bh_info) {
320 bh_info = cur_bh_info;
321 goto retry;
322 }
323 #endif
324
325 // The payload of the BLACKHOLE points to the TSO
326 ((StgInd *)bh)->indirectee = (StgClosure *)tso;
327 write_barrier();
328 SET_INFO(bh,&stg_BLACKHOLE_info);
329
330 // .. and we need a write barrier, since we just mutated the closure:
331 recordClosureMutated(cap,bh);
332
333 // We pretend that bh has just been created.
334 LDV_RECORD_CREATE(bh);
335
336 frame = (StgClosure *) ((StgUpdateFrame *)frame + 1);
337 if (prev_was_update_frame) {
338 words_to_squeeze += sizeofW(StgUpdateFrame);
339 weight += weight_pending;
340 weight_pending = 0;
341 }
342 prev_was_update_frame = rtsTrue;
343 break;
344
345 case UNDERFLOW_FRAME:
346 case STOP_FRAME:
347 goto end;
348
349 // normal stack frames; do nothing except advance the pointer
350 default:
351 {
352 nat frame_size = stack_frame_sizeW(frame);
353 weight_pending += frame_size;
354 frame = (StgClosure *)((StgPtr)frame + frame_size);
355 prev_was_update_frame = rtsFalse;
356 }
357 }
358 }
359
360 end:
361 debugTrace(DEBUG_squeeze,
362 "words_to_squeeze: %d, weight: %d, squeeze: %s",
363 words_to_squeeze, weight,
364 ((weight <= 8 && words_to_squeeze > 0) || weight < words_to_squeeze) ? "YES" : "NO");
365
366 // Should we squeeze or not? Arbitrary heuristic: we squeeze if
367 // the number of words we have to shift down is less than the
368 // number of stack words we squeeze away by doing so.
369 if (RtsFlags.GcFlags.squeezeUpdFrames == rtsTrue &&
370 ((weight <= 8 && words_to_squeeze > 0) || weight < words_to_squeeze)) {
371 // threshold above bumped from 5 to 8 as a result of #2797
372 stackSqueeze(cap, tso, (StgPtr)frame);
373 tso->flags |= TSO_SQUEEZED;
374 // This flag tells threadStackOverflow() that the stack was
375 // squeezed, because it may not need to be expanded.
376 } else {
377 tso->flags &= ~TSO_SQUEEZED;
378 }
379 }