Add GHCi help message for :def! and :: commands
[ghc.git] / rts / Messages.c
1 /* ---------------------------------------------------------------------------
2 *
3 * (c) The GHC Team, 2010
4 *
5 * Inter-Capability message passing
6 *
7 * --------------------------------------------------------------------------*/
8
9 #include "Rts.h"
10 #include "Messages.h"
11 #include "Trace.h"
12 #include "Capability.h"
13 #include "Schedule.h"
14 #include "Threads.h"
15 #include "RaiseAsync.h"
16 #include "sm/Storage.h"
17
18 /* ----------------------------------------------------------------------------
19 Send a message to another Capability
20 ------------------------------------------------------------------------- */
21
22 #if defined(THREADED_RTS)
23
24 void sendMessage(Capability *from_cap, Capability *to_cap, Message *msg)
25 {
26 ACQUIRE_LOCK(&to_cap->lock);
27
28 #if defined(DEBUG)
29 {
30 const StgInfoTable *i = msg->header.info;
31 if (i != &stg_MSG_THROWTO_info &&
32 i != &stg_MSG_BLACKHOLE_info &&
33 i != &stg_MSG_TRY_WAKEUP_info &&
34 i != &stg_IND_info && // can happen if a MSG_BLACKHOLE is revoked
35 i != &stg_WHITEHOLE_info) {
36 barf("sendMessage: %p", i);
37 }
38 }
39 #endif
40
41 msg->link = to_cap->inbox;
42 to_cap->inbox = msg;
43
44 recordClosureMutated(from_cap,(StgClosure*)msg);
45
46 if (to_cap->running_task == NULL) {
47 to_cap->running_task = myTask();
48 // precond for releaseCapability_()
49 releaseCapability_(to_cap,false);
50 } else {
51 interruptCapability(to_cap);
52 }
53
54 RELEASE_LOCK(&to_cap->lock);
55 }
56
57 #endif /* THREADED_RTS */
58
59 /* ----------------------------------------------------------------------------
60 Handle a message
61 ------------------------------------------------------------------------- */
62
63 #if defined(THREADED_RTS)
64
65 void
66 executeMessage (Capability *cap, Message *m)
67 {
68 const StgInfoTable *i;
69
70 loop:
71 write_barrier(); // allow m->header to be modified by another thread
72 i = m->header.info;
73 if (i == &stg_MSG_TRY_WAKEUP_info)
74 {
75 StgTSO *tso = ((MessageWakeup *)m)->tso;
76 debugTraceCap(DEBUG_sched, cap, "message: try wakeup thread %ld",
77 (W_)tso->id);
78 tryWakeupThread(cap, tso);
79 }
80 else if (i == &stg_MSG_THROWTO_info)
81 {
82 MessageThrowTo *t = (MessageThrowTo *)m;
83 uint32_t r;
84 const StgInfoTable *i;
85
86 i = lockClosure((StgClosure*)m);
87 if (i != &stg_MSG_THROWTO_info) {
88 unlockClosure((StgClosure*)m, i);
89 goto loop;
90 }
91
92 debugTraceCap(DEBUG_sched, cap, "message: throwTo %ld -> %ld",
93 (W_)t->source->id, (W_)t->target->id);
94
95 ASSERT(t->source->why_blocked == BlockedOnMsgThrowTo);
96 ASSERT(t->source->block_info.closure == (StgClosure *)m);
97
98 r = throwToMsg(cap, t);
99
100 switch (r) {
101 case THROWTO_SUCCESS: {
102 // this message is done
103 StgTSO *source = t->source;
104 doneWithMsgThrowTo(t);
105 tryWakeupThread(cap, source);
106 break;
107 }
108 case THROWTO_BLOCKED:
109 // unlock the message
110 unlockClosure((StgClosure*)m, &stg_MSG_THROWTO_info);
111 break;
112 }
113 }
114 else if (i == &stg_MSG_BLACKHOLE_info)
115 {
116 uint32_t r;
117 MessageBlackHole *b = (MessageBlackHole*)m;
118
119 r = messageBlackHole(cap, b);
120 if (r == 0) {
121 tryWakeupThread(cap, b->tso);
122 }
123 return;
124 }
125 else if (i == &stg_IND_info || i == &stg_MSG_NULL_info)
126 {
127 // message was revoked
128 return;
129 }
130 else if (i == &stg_WHITEHOLE_info)
131 {
132 #if defined(PROF_SPIN)
133 ++whitehole_executeMessage_spin;
134 #endif
135 goto loop;
136 }
137 else
138 {
139 barf("executeMessage: %p", i);
140 }
141 }
142
143 #endif
144
145 /* ----------------------------------------------------------------------------
146 Handle a MSG_BLACKHOLE message
147
148 This is called from two places: either we just entered a BLACKHOLE
149 (stg_BLACKHOLE_info), or we received a MSG_BLACKHOLE in our
150 cap->inbox.
151
152 We need to establish whether the BLACKHOLE belongs to
153 this Capability, and
154 - if so, arrange to block the current thread on it
155 - otherwise, forward the message to the right place
156
157 Returns:
158 - 0 if the blocked thread can be woken up by the caller
159 - 1 if the thread is still blocked, and we promise to send a MSG_TRY_WAKEUP
160 at some point in the future.
161
162 ------------------------------------------------------------------------- */
163
164 uint32_t messageBlackHole(Capability *cap, MessageBlackHole *msg)
165 {
166 const StgInfoTable *info;
167 StgClosure *p;
168 StgBlockingQueue *bq;
169 StgClosure *bh = UNTAG_CLOSURE(msg->bh);
170 StgTSO *owner;
171
172 debugTraceCap(DEBUG_sched, cap, "message: thread %d blocking on "
173 "blackhole %p", (W_)msg->tso->id, msg->bh);
174
175 info = bh->header.info;
176 load_load_barrier(); // See Note [Heap memory barriers] in SMP.h
177
178 // If we got this message in our inbox, it might be that the
179 // BLACKHOLE has already been updated, and GC has shorted out the
180 // indirection, so the pointer no longer points to a BLACKHOLE at
181 // all.
182 if (info != &stg_BLACKHOLE_info &&
183 info != &stg_CAF_BLACKHOLE_info &&
184 info != &__stg_EAGER_BLACKHOLE_info &&
185 info != &stg_WHITEHOLE_info) {
186 // if it is a WHITEHOLE, then a thread is in the process of
187 // trying to BLACKHOLE it. But we know that it was once a
188 // BLACKHOLE, so there is at least a valid pointer in the
189 // payload, so we can carry on.
190 return 0;
191 }
192
193 // The blackhole must indirect to a TSO, a BLOCKING_QUEUE, an IND,
194 // or a value.
195 loop:
196 // NB. VOLATILE_LOAD(), because otherwise gcc hoists the load
197 // and turns this into an infinite loop.
198 p = UNTAG_CLOSURE((StgClosure*)VOLATILE_LOAD(&((StgInd*)bh)->indirectee));
199 info = p->header.info;
200 load_load_barrier(); // See Note [Heap memory barriers] in SMP.h
201
202 if (info == &stg_IND_info)
203 {
204 // This could happen, if e.g. we got a BLOCKING_QUEUE that has
205 // just been replaced with an IND by another thread in
206 // updateThunk(). In which case, if we read the indirectee
207 // again we should get the value.
208 // See Note [BLACKHOLE pointing to IND] in sm/Evac.c
209 goto loop;
210 }
211
212 else if (info == &stg_TSO_info)
213 {
214 owner = (StgTSO*)p;
215
216 #if defined(THREADED_RTS)
217 if (owner->cap != cap) {
218 sendMessage(cap, owner->cap, (Message*)msg);
219 debugTraceCap(DEBUG_sched, cap, "forwarding message to cap %d",
220 owner->cap->no);
221 return 1;
222 }
223 #endif
224 // owner is the owner of the BLACKHOLE, and resides on this
225 // Capability. msg->tso is the first thread to block on this
226 // BLACKHOLE, so we first create a BLOCKING_QUEUE object.
227
228 bq = (StgBlockingQueue*)allocate(cap, sizeofW(StgBlockingQueue));
229
230 // initialise the BLOCKING_QUEUE object
231 bq->bh = bh;
232 bq->queue = msg;
233 bq->owner = owner;
234
235 msg->link = (MessageBlackHole*)END_TSO_QUEUE;
236
237 // All BLOCKING_QUEUES are linked in a list on owner->bq, so
238 // that we can search through them in the event that there is
239 // a collision to update a BLACKHOLE and a BLOCKING_QUEUE
240 // becomes orphaned (see updateThunk()).
241 bq->link = owner->bq;
242 SET_HDR(bq, &stg_BLOCKING_QUEUE_DIRTY_info, CCS_SYSTEM);
243 // We are about to make the newly-constructed message visible to other cores;
244 // a barrier is necessary to ensure that all writes are visible.
245 // See Note [Heap memory barriers] in SMP.h.
246 write_barrier();
247 owner->bq = bq;
248 dirty_TSO(cap, owner); // we modified owner->bq
249
250 // If the owner of the blackhole is currently runnable, then
251 // bump it to the front of the run queue. This gives the
252 // blocked-on thread a little boost which should help unblock
253 // this thread, and may avoid a pile-up of other threads
254 // becoming blocked on the same BLACKHOLE (#3838).
255 //
256 // NB. we check to make sure that the owner is not the same as
257 // the current thread, since in that case it will not be on
258 // the run queue.
259 if (owner->why_blocked == NotBlocked && owner->id != msg->tso->id) {
260 promoteInRunQueue(cap, owner);
261 }
262
263 // point to the BLOCKING_QUEUE from the BLACKHOLE
264 write_barrier(); // make the BQ visible, see Note [Heap memory barriers].
265 ((StgInd*)bh)->indirectee = (StgClosure *)bq;
266 recordClosureMutated(cap,bh); // bh was mutated
267
268 debugTraceCap(DEBUG_sched, cap, "thread %d blocked on thread %d",
269 (W_)msg->tso->id, (W_)owner->id);
270
271 return 1; // blocked
272 }
273 else if (info == &stg_BLOCKING_QUEUE_CLEAN_info ||
274 info == &stg_BLOCKING_QUEUE_DIRTY_info)
275 {
276 StgBlockingQueue *bq = (StgBlockingQueue *)p;
277
278 ASSERT(bq->bh == bh);
279
280 owner = bq->owner;
281
282 ASSERT(owner != END_TSO_QUEUE);
283
284 #if defined(THREADED_RTS)
285 if (owner->cap != cap) {
286 sendMessage(cap, owner->cap, (Message*)msg);
287 debugTraceCap(DEBUG_sched, cap, "forwarding message to cap %d",
288 owner->cap->no);
289 return 1;
290 }
291 #endif
292
293 msg->link = bq->queue;
294 bq->queue = msg;
295 // No barrier is necessary here: we are only exposing the
296 // closure to the GC. See Note [Heap memory barriers] in SMP.h.
297 recordClosureMutated(cap,(StgClosure*)msg);
298
299 if (info == &stg_BLOCKING_QUEUE_CLEAN_info) {
300 bq->header.info = &stg_BLOCKING_QUEUE_DIRTY_info;
301 // No barrier is necessary here: we are only exposing the
302 // closure to the GC. See Note [Heap memory barriers] in SMP.h.
303 recordClosureMutated(cap,(StgClosure*)bq);
304 }
305
306 debugTraceCap(DEBUG_sched, cap,
307 "thread %d blocked on existing BLOCKING_QUEUE "
308 "owned by thread %d",
309 (W_)msg->tso->id, (W_)owner->id);
310
311 // See above, #3838
312 if (owner->why_blocked == NotBlocked && owner->id != msg->tso->id) {
313 promoteInRunQueue(cap, owner);
314 }
315
316 return 1; // blocked
317 }
318
319 return 0; // not blocked
320 }
321
322 // A shorter version of messageBlackHole(), that just returns the
323 // owner (or NULL if the owner cannot be found, because the blackhole
324 // has been updated in the meantime).
325
326 StgTSO * blackHoleOwner (StgClosure *bh)
327 {
328 const StgInfoTable *info;
329 StgClosure *p;
330
331 info = bh->header.info;
332
333 if (info != &stg_BLACKHOLE_info &&
334 info != &stg_CAF_BLACKHOLE_info &&
335 info != &__stg_EAGER_BLACKHOLE_info &&
336 info != &stg_WHITEHOLE_info) {
337 return NULL;
338 }
339
340 // The blackhole must indirect to a TSO, a BLOCKING_QUEUE, an IND,
341 // or a value.
342 loop:
343 // NB. VOLATILE_LOAD(), because otherwise gcc hoists the load
344 // and turns this into an infinite loop.
345 p = UNTAG_CLOSURE((StgClosure*)VOLATILE_LOAD(&((StgInd*)bh)->indirectee));
346 info = p->header.info;
347
348 if (info == &stg_IND_info) goto loop;
349
350 else if (info == &stg_TSO_info)
351 {
352 return (StgTSO*)p;
353 }
354 else if (info == &stg_BLOCKING_QUEUE_CLEAN_info ||
355 info == &stg_BLOCKING_QUEUE_DIRTY_info)
356 {
357 StgBlockingQueue *bq = (StgBlockingQueue *)p;
358 return bq->owner;
359 }
360
361 return NULL; // not blocked
362 }