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