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