REDO: Add -r option to darcs-all, and remove push-all (#3375)
[ghc-hetmet.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     }
321 }