96a23673a7348da0011a6bf2a24a4e65353c3c6d
[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
18 #include <string.h> // for memmove()
19
20 /* -----------------------------------------------------------------------------
21 * Stack squeezing
22 *
23 * Code largely pinched from old RTS, then hacked to bits. We also do
24 * lazy black holing here.
25 *
26 * -------------------------------------------------------------------------- */
27
28 struct stack_gap { StgWord gap_size; struct stack_gap *next_gap; };
29
30 static void
31 stackSqueeze(StgTSO *tso, StgPtr bottom)
32 {
33 StgPtr frame;
34 rtsBool prev_was_update_frame;
35 StgClosure *updatee = NULL;
36 StgRetInfoTable *info;
37 StgWord current_gap_size;
38 struct stack_gap *gap;
39
40 // Stage 1:
41 // Traverse the stack upwards, replacing adjacent update frames
42 // with a single update frame and a "stack gap". A stack gap
43 // contains two values: the size of the gap, and the distance
44 // to the next gap (or the stack top).
45
46 frame = tso->sp;
47
48 ASSERT(frame < bottom);
49
50 prev_was_update_frame = rtsFalse;
51 current_gap_size = 0;
52 gap = (struct stack_gap *) (tso->sp - sizeofW(StgUpdateFrame));
53
54 while (frame <= bottom) {
55
56 info = get_ret_itbl((StgClosure *)frame);
57 switch (info->i.type) {
58
59 case UPDATE_FRAME:
60 {
61 StgUpdateFrame *upd = (StgUpdateFrame *)frame;
62
63 if (prev_was_update_frame) {
64
65 TICK_UPD_SQUEEZED();
66 /* wasn't there something about update squeezing and ticky to be
67 * sorted out? oh yes: we aren't counting each enter properly
68 * in this case. See the log somewhere. KSW 1999-04-21
69 *
70 * Check two things: that the two update frames don't point to
71 * the same object, and that the updatee_bypass isn't already an
72 * indirection. Both of these cases only happen when we're in a
73 * block hole-style loop (and there are multiple update frames
74 * on the stack pointing to the same closure), but they can both
75 * screw us up if we don't check.
76 */
77 if (upd->updatee != updatee && !closure_IND(upd->updatee)) {
78 UPD_IND(upd->updatee, updatee);
79 }
80
81 // now mark this update frame as a stack gap. The gap
82 // marker resides in the bottom-most update frame of
83 // the series of adjacent frames, and covers all the
84 // frames in this series.
85 current_gap_size += sizeofW(StgUpdateFrame);
86 ((struct stack_gap *)frame)->gap_size = current_gap_size;
87 ((struct stack_gap *)frame)->next_gap = gap;
88
89 frame += sizeofW(StgUpdateFrame);
90 continue;
91 }
92
93 // single update frame, or the topmost update frame in a series
94 else {
95 prev_was_update_frame = rtsTrue;
96 updatee = upd->updatee;
97 frame += sizeofW(StgUpdateFrame);
98 continue;
99 }
100 }
101
102 default:
103 prev_was_update_frame = rtsFalse;
104
105 // we're not in a gap... check whether this is the end of a gap
106 // (an update frame can't be the end of a gap).
107 if (current_gap_size != 0) {
108 gap = (struct stack_gap *) (frame - sizeofW(StgUpdateFrame));
109 }
110 current_gap_size = 0;
111
112 frame += stack_frame_sizeW((StgClosure *)frame);
113 continue;
114 }
115 }
116
117 if (current_gap_size != 0) {
118 gap = (struct stack_gap *) (frame - sizeofW(StgUpdateFrame));
119 }
120
121 // Now we have a stack with gaps in it, and we have to walk down
122 // shoving the stack up to fill in the gaps. A diagram might
123 // help:
124 //
125 // +| ********* |
126 // | ********* | <- sp
127 // | |
128 // | | <- gap_start
129 // | ......... | |
130 // | stack_gap | <- gap | chunk_size
131 // | ......... | |
132 // | ......... | <- gap_end v
133 // | ********* |
134 // | ********* |
135 // | ********* |
136 // -| ********* |
137 //
138 // 'sp' points the the current top-of-stack
139 // 'gap' points to the stack_gap structure inside the gap
140 // ***** indicates real stack data
141 // ..... indicates gap
142 // <empty> indicates unused
143 //
144 {
145 StgWord8 *sp;
146 StgWord8 *gap_start, *next_gap_start, *gap_end;
147 nat chunk_size;
148
149 next_gap_start = (StgWord8*)gap + sizeof(StgUpdateFrame);
150 sp = next_gap_start;
151
152 while ((StgPtr)gap > tso->sp) {
153
154 // we're working in *bytes* now...
155 gap_start = next_gap_start;
156 gap_end = gap_start - gap->gap_size * sizeof(W_);
157
158 gap = gap->next_gap;
159 next_gap_start = (StgWord8*)gap + sizeof(StgUpdateFrame);
160
161 chunk_size = gap_end - next_gap_start;
162 sp -= chunk_size;
163 memmove(sp, next_gap_start, chunk_size);
164 }
165
166 tso->sp = (StgPtr)sp;
167 }
168 }
169
170 /* -----------------------------------------------------------------------------
171 * Pausing a thread
172 *
173 * We have to prepare for GC - this means doing lazy black holing
174 * here. We also take the opportunity to do stack squeezing if it's
175 * turned on.
176 * -------------------------------------------------------------------------- */
177 void
178 threadPaused(Capability *cap, StgTSO *tso)
179 {
180 StgClosure *frame;
181 StgRetInfoTable *info;
182 const StgInfoTable *bh_info;
183 const StgInfoTable *cur_bh_info USED_IF_THREADS;
184 StgClosure *bh;
185 StgPtr stack_end;
186 nat words_to_squeeze = 0;
187 nat weight = 0;
188 nat weight_pending = 0;
189 rtsBool prev_was_update_frame = rtsFalse;
190
191 // Check to see whether we have threads waiting to raise
192 // exceptions, and we're not blocking exceptions, or are blocked
193 // interruptibly. This is important; if a thread is running with
194 // TSO_BLOCKEX and becomes blocked interruptibly, this is the only
195 // place we ensure that the blocked_exceptions get a chance.
196 maybePerformBlockedException (cap, tso);
197 if (tso->what_next == ThreadKilled) { return; }
198
199 // NB. Blackholing is *not* optional, we must either do lazy
200 // blackholing, or eager blackholing consistently. See Note
201 // [upd-black-hole] in sm/Scav.c.
202
203 stack_end = &tso->stack[tso->stack_size];
204
205 frame = (StgClosure *)tso->sp;
206
207 while (1) {
208 // If we've already marked this frame, then stop here.
209 if (frame->header.info == (StgInfoTable *)&stg_marked_upd_frame_info) {
210 if (prev_was_update_frame) {
211 words_to_squeeze += sizeofW(StgUpdateFrame);
212 weight += weight_pending;
213 weight_pending = 0;
214 }
215 goto end;
216 }
217
218 info = get_ret_itbl(frame);
219
220 switch (info->i.type) {
221
222 case UPDATE_FRAME:
223
224 SET_INFO(frame, (StgInfoTable *)&stg_marked_upd_frame_info);
225
226 bh = ((StgUpdateFrame *)frame)->updatee;
227 bh_info = bh->header.info;
228
229 #ifdef THREADED_RTS
230 retry:
231 #endif
232 if (closure_flags[INFO_PTR_TO_STRUCT(bh_info)->type] & _IND
233 || bh_info == &stg_BLACKHOLE_info) {
234 debugTrace(DEBUG_squeeze,
235 "suspending duplicate work: %ld words of stack",
236 (long)((StgPtr)frame - tso->sp));
237
238 // If this closure is already an indirection, then
239 // suspend the computation up to this point.
240 // NB. check raiseAsync() to see what happens when
241 // we're in a loop (#2783).
242 suspendComputation(cap,tso,(StgUpdateFrame*)frame);
243
244 // Now drop the update frame, and arrange to return
245 // the value to the frame underneath:
246 tso->sp = (StgPtr)frame + sizeofW(StgUpdateFrame) - 2;
247 tso->sp[1] = (StgWord)bh;
248 tso->sp[0] = (W_)&stg_enter_info;
249
250 // And continue with threadPaused; there might be
251 // yet more computation to suspend.
252 frame = (StgClosure *)tso->sp + 2;
253 prev_was_update_frame = rtsFalse;
254 continue;
255 }
256
257 if (bh->header.info != &stg_CAF_BLACKHOLE_info) {
258 // zero out the slop so that the sanity checker can tell
259 // where the next closure is.
260 DEBUG_FILL_SLOP(bh);
261 #ifdef PROFILING
262 // @LDV profiling
263 // We pretend that bh is now dead.
264 LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh);
265 #endif
266 // an EAGER_BLACKHOLE gets turned into a BLACKHOLE here.
267 #ifdef THREADED_RTS
268 cur_bh_info = (const StgInfoTable *)
269 cas((StgVolatilePtr)&bh->header.info,
270 (StgWord)bh_info,
271 (StgWord)&stg_BLACKHOLE_info);
272
273 if (cur_bh_info != bh_info) {
274 bh_info = cur_bh_info;
275 goto retry;
276 }
277 #else
278 SET_INFO(bh,&stg_BLACKHOLE_info);
279 #endif
280
281 // We pretend that bh has just been created.
282 LDV_RECORD_CREATE(bh);
283 }
284
285 frame = (StgClosure *) ((StgUpdateFrame *)frame + 1);
286 if (prev_was_update_frame) {
287 words_to_squeeze += sizeofW(StgUpdateFrame);
288 weight += weight_pending;
289 weight_pending = 0;
290 }
291 prev_was_update_frame = rtsTrue;
292 break;
293
294 case STOP_FRAME:
295 goto end;
296
297 // normal stack frames; do nothing except advance the pointer
298 default:
299 {
300 nat frame_size = stack_frame_sizeW(frame);
301 weight_pending += frame_size;
302 frame = (StgClosure *)((StgPtr)frame + frame_size);
303 prev_was_update_frame = rtsFalse;
304 }
305 }
306 }
307
308 end:
309 debugTrace(DEBUG_squeeze,
310 "words_to_squeeze: %d, weight: %d, squeeze: %s",
311 words_to_squeeze, weight,
312 weight < words_to_squeeze ? "YES" : "NO");
313
314 // Should we squeeze or not? Arbitrary heuristic: we squeeze if
315 // the number of words we have to shift down is less than the
316 // number of stack words we squeeze away by doing so.
317 if (RtsFlags.GcFlags.squeezeUpdFrames == rtsTrue &&
318 ((weight <= 5 && words_to_squeeze > 0) || weight < words_to_squeeze)) {
319 stackSqueeze(tso, (StgPtr)frame);
320 tso->flags |= TSO_SQUEEZED;
321 // This flag tells threadStackOverflow() that the stack was
322 // squeezed, because it may not need to be expanded.
323 } else {
324 tso->flags &= ~TSO_SQUEEZED;
325 }
326 }