Building GHC with hadrian on FreeBSD
[ghc.git] / rts / RtsAPI.c
1 /* ----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team, 1998-2001
4 *
5 * API for invoking Haskell functions via the RTS
6 *
7 * --------------------------------------------------------------------------*/
8
9 #include "PosixSource.h"
10 #include "Rts.h"
11 #include "RtsAPI.h"
12 #include "HsFFI.h"
13
14 #include "RtsUtils.h"
15 #include "Prelude.h"
16 #include "Schedule.h"
17 #include "Capability.h"
18 #include "StablePtr.h"
19 #include "Threads.h"
20 #include "Weak.h"
21
22 /* ----------------------------------------------------------------------------
23 Building Haskell objects from C datatypes.
24
25 TODO: Currently this code does not tag created pointers,
26 however it is not unsafe (the constructor code will do it)
27 just inefficient.
28 ------------------------------------------------------------------------- */
29 HaskellObj
30 rts_mkChar (Capability *cap, HsChar c)
31 {
32 StgClosure *p = (StgClosure *)allocate(cap, CONSTR_sizeW(0,1));
33 SET_HDR(p, Czh_con_info, CCS_SYSTEM);
34 p->payload[0] = (StgClosure *)(StgWord)(StgChar)c;
35 return p;
36 }
37
38 HaskellObj
39 rts_mkInt (Capability *cap, HsInt i)
40 {
41 StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
42 SET_HDR(p, Izh_con_info, CCS_SYSTEM);
43 p->payload[0] = (StgClosure *)(StgInt)i;
44 return p;
45 }
46
47 HaskellObj
48 rts_mkInt8 (Capability *cap, HsInt8 i)
49 {
50 StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
51 SET_HDR(p, I8zh_con_info, CCS_SYSTEM);
52 /* Make sure we mask out the bits above the lowest 8 */
53 p->payload[0] = (StgClosure *)(StgInt)i;
54 return p;
55 }
56
57 HaskellObj
58 rts_mkInt16 (Capability *cap, HsInt16 i)
59 {
60 StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
61 SET_HDR(p, I16zh_con_info, CCS_SYSTEM);
62 /* Make sure we mask out the relevant bits */
63 p->payload[0] = (StgClosure *)(StgInt)i;
64 return p;
65 }
66
67 HaskellObj
68 rts_mkInt32 (Capability *cap, HsInt32 i)
69 {
70 StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
71 SET_HDR(p, I32zh_con_info, CCS_SYSTEM);
72 p->payload[0] = (StgClosure *)(StgInt)i;
73 return p;
74 }
75
76 HaskellObj
77 rts_mkInt64 (Capability *cap, HsInt64 i)
78 {
79 StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,2));
80 SET_HDR(p, I64zh_con_info, CCS_SYSTEM);
81 ASSIGN_Int64((P_)&(p->payload[0]), i);
82 return p;
83 }
84
85 HaskellObj
86 rts_mkWord (Capability *cap, HsWord i)
87 {
88 StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
89 SET_HDR(p, Wzh_con_info, CCS_SYSTEM);
90 p->payload[0] = (StgClosure *)(StgWord)i;
91 return p;
92 }
93
94 HaskellObj
95 rts_mkWord8 (Capability *cap, HsWord8 w)
96 {
97 /* see rts_mkInt* comments */
98 StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
99 SET_HDR(p, W8zh_con_info, CCS_SYSTEM);
100 p->payload[0] = (StgClosure *)(StgWord)(w & 0xff);
101 return p;
102 }
103
104 HaskellObj
105 rts_mkWord16 (Capability *cap, HsWord16 w)
106 {
107 /* see rts_mkInt* comments */
108 StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
109 SET_HDR(p, W16zh_con_info, CCS_SYSTEM);
110 p->payload[0] = (StgClosure *)(StgWord)(w & 0xffff);
111 return p;
112 }
113
114 HaskellObj
115 rts_mkWord32 (Capability *cap, HsWord32 w)
116 {
117 /* see rts_mkInt* comments */
118 StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
119 SET_HDR(p, W32zh_con_info, CCS_SYSTEM);
120 p->payload[0] = (StgClosure *)(StgWord)(w & 0xffffffff);
121 return p;
122 }
123
124 HaskellObj
125 rts_mkWord64 (Capability *cap, HsWord64 w)
126 {
127 StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,2));
128 /* see mk_Int8 comment */
129 SET_HDR(p, W64zh_con_info, CCS_SYSTEM);
130 ASSIGN_Word64((P_)&(p->payload[0]), w);
131 return p;
132 }
133
134
135 HaskellObj
136 rts_mkFloat (Capability *cap, HsFloat f)
137 {
138 StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
139 SET_HDR(p, Fzh_con_info, CCS_SYSTEM);
140 ASSIGN_FLT((P_)p->payload, (StgFloat)f);
141 return p;
142 }
143
144 HaskellObj
145 rts_mkDouble (Capability *cap, HsDouble d)
146 {
147 StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,sizeofW(StgDouble)));
148 SET_HDR(p, Dzh_con_info, CCS_SYSTEM);
149 ASSIGN_DBL((P_)p->payload, (StgDouble)d);
150 return p;
151 }
152
153 HaskellObj
154 rts_mkStablePtr (Capability *cap, HsStablePtr s)
155 {
156 StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1);
157 SET_HDR(p, StablePtr_con_info, CCS_SYSTEM);
158 p->payload[0] = (StgClosure *)s;
159 return p;
160 }
161
162 HaskellObj
163 rts_mkPtr (Capability *cap, HsPtr a)
164 {
165 StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1);
166 SET_HDR(p, Ptr_con_info, CCS_SYSTEM);
167 p->payload[0] = (StgClosure *)a;
168 return p;
169 }
170
171 HaskellObj
172 rts_mkFunPtr (Capability *cap, HsFunPtr a)
173 {
174 StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1);
175 SET_HDR(p, FunPtr_con_info, CCS_SYSTEM);
176 p->payload[0] = (StgClosure *)a;
177 return p;
178 }
179
180 HaskellObj
181 rts_mkBool (Capability *cap STG_UNUSED, HsBool b)
182 {
183 if (b) {
184 return (StgClosure *)True_closure;
185 } else {
186 return (StgClosure *)False_closure;
187 }
188 }
189
190 HaskellObj
191 rts_mkString (Capability *cap, char *s)
192 {
193 return rts_apply(cap, (StgClosure *)unpackCString_closure, rts_mkPtr(cap,s));
194 }
195
196 HaskellObj
197 rts_apply (Capability *cap, HaskellObj f, HaskellObj arg)
198 {
199 StgThunk *ap;
200
201 ap = (StgThunk *)allocate(cap,sizeofW(StgThunk) + 2);
202 // Here we don't want to use CCS_SYSTEM, because it's a hidden cost centre,
203 // and evaluating Haskell code under a hidden cost centre leads to
204 // confusing profiling output. (#7753)
205 SET_HDR(ap, (StgInfoTable *)&stg_ap_2_upd_info, CCS_MAIN);
206 ap->payload[0] = f;
207 ap->payload[1] = arg;
208 return (StgClosure *)ap;
209 }
210
211 /* ----------------------------------------------------------------------------
212 Deconstructing Haskell objects
213
214 We would like to assert that we have the right kind of object in
215 each case, but this is problematic because in GHCi the info table
216 for the D# constructor (say) might be dynamically loaded. Hence we
217 omit these assertions for now.
218 ------------------------------------------------------------------------- */
219
220 HsChar
221 rts_getChar (HaskellObj p)
222 {
223 // See comment above:
224 // ASSERT(p->header.info == Czh_con_info ||
225 // p->header.info == Czh_static_info);
226 return (StgChar)(StgWord)(UNTAG_CLOSURE(p)->payload[0]);
227 }
228
229 HsInt
230 rts_getInt (HaskellObj p)
231 {
232 // See comment above:
233 // ASSERT(p->header.info == Izh_con_info ||
234 // p->header.info == Izh_static_info);
235 return (HsInt)(UNTAG_CLOSURE(p)->payload[0]);
236 }
237
238 HsInt8
239 rts_getInt8 (HaskellObj p)
240 {
241 // See comment above:
242 // ASSERT(p->header.info == I8zh_con_info ||
243 // p->header.info == I8zh_static_info);
244 return (HsInt8)(HsInt)(UNTAG_CLOSURE(p)->payload[0]);
245 }
246
247 HsInt16
248 rts_getInt16 (HaskellObj p)
249 {
250 // See comment above:
251 // ASSERT(p->header.info == I16zh_con_info ||
252 // p->header.info == I16zh_static_info);
253 return (HsInt16)(HsInt)(UNTAG_CLOSURE(p)->payload[0]);
254 }
255
256 HsInt32
257 rts_getInt32 (HaskellObj p)
258 {
259 // See comment above:
260 // ASSERT(p->header.info == I32zh_con_info ||
261 // p->header.info == I32zh_static_info);
262 return (HsInt32)(HsInt)(UNTAG_CLOSURE(p)->payload[0]);
263 }
264
265 HsInt64
266 rts_getInt64 (HaskellObj p)
267 {
268 // See comment above:
269 // ASSERT(p->header.info == I64zh_con_info ||
270 // p->header.info == I64zh_static_info);
271 return PK_Int64((P_)&(UNTAG_CLOSURE(p)->payload[0]));
272 }
273
274 HsWord
275 rts_getWord (HaskellObj p)
276 {
277 // See comment above:
278 // ASSERT(p->header.info == Wzh_con_info ||
279 // p->header.info == Wzh_static_info);
280 return (HsWord)(UNTAG_CLOSURE(p)->payload[0]);
281 }
282
283 HsWord8
284 rts_getWord8 (HaskellObj p)
285 {
286 // See comment above:
287 // ASSERT(p->header.info == W8zh_con_info ||
288 // p->header.info == W8zh_static_info);
289 return (HsWord8)(HsWord)(UNTAG_CLOSURE(p)->payload[0]);
290 }
291
292 HsWord16
293 rts_getWord16 (HaskellObj p)
294 {
295 // See comment above:
296 // ASSERT(p->header.info == W16zh_con_info ||
297 // p->header.info == W16zh_static_info);
298 return (HsWord16)(HsWord)(UNTAG_CLOSURE(p)->payload[0]);
299 }
300
301 HsWord32
302 rts_getWord32 (HaskellObj p)
303 {
304 // See comment above:
305 // ASSERT(p->header.info == W32zh_con_info ||
306 // p->header.info == W32zh_static_info);
307 return (HsWord32)(HsWord)(UNTAG_CLOSURE(p)->payload[0]);
308 }
309
310 HsWord64
311 rts_getWord64 (HaskellObj p)
312 {
313 // See comment above:
314 // ASSERT(p->header.info == W64zh_con_info ||
315 // p->header.info == W64zh_static_info);
316 return PK_Word64((P_)&(UNTAG_CLOSURE(p)->payload[0]));
317 }
318
319 HsFloat
320 rts_getFloat (HaskellObj p)
321 {
322 // See comment above:
323 // ASSERT(p->header.info == Fzh_con_info ||
324 // p->header.info == Fzh_static_info);
325 return (float)(PK_FLT((P_)UNTAG_CLOSURE(p)->payload));
326 }
327
328 HsDouble
329 rts_getDouble (HaskellObj p)
330 {
331 // See comment above:
332 // ASSERT(p->header.info == Dzh_con_info ||
333 // p->header.info == Dzh_static_info);
334 return (double)(PK_DBL((P_)UNTAG_CLOSURE(p)->payload));
335 }
336
337 HsStablePtr
338 rts_getStablePtr (HaskellObj p)
339 {
340 // See comment above:
341 // ASSERT(p->header.info == StablePtr_con_info ||
342 // p->header.info == StablePtr_static_info);
343 return (StgStablePtr)(UNTAG_CLOSURE(p)->payload[0]);
344 }
345
346 HsPtr
347 rts_getPtr (HaskellObj p)
348 {
349 // See comment above:
350 // ASSERT(p->header.info == Ptr_con_info ||
351 // p->header.info == Ptr_static_info);
352 return (Capability *)(UNTAG_CLOSURE(p)->payload[0]);
353 }
354
355 HsFunPtr
356 rts_getFunPtr (HaskellObj p)
357 {
358 // See comment above:
359 // ASSERT(p->header.info == FunPtr_con_info ||
360 // p->header.info == FunPtr_static_info);
361 return (void *)(UNTAG_CLOSURE(p)->payload[0]);
362 }
363
364 HsBool
365 rts_getBool (HaskellObj p)
366 {
367 const StgInfoTable *info;
368
369 info = get_itbl((const StgClosure *)UNTAG_CONST_CLOSURE(p));
370 if (info->srt == 0) { // srt is the constructor tag
371 return 0;
372 } else {
373 return 1;
374 }
375 }
376
377 /* -----------------------------------------------------------------------------
378 Creating threads
379 -------------------------------------------------------------------------- */
380
381 INLINE_HEADER void pushClosure (StgTSO *tso, StgWord c) {
382 tso->stackobj->sp--;
383 tso->stackobj->sp[0] = (W_) c;
384 }
385
386 StgTSO *
387 createGenThread (Capability *cap, W_ stack_size, StgClosure *closure)
388 {
389 StgTSO *t;
390 t = createThread (cap, stack_size);
391 pushClosure(t, (W_)closure);
392 pushClosure(t, (W_)&stg_enter_info);
393 return t;
394 }
395
396 StgTSO *
397 createIOThread (Capability *cap, W_ stack_size, StgClosure *closure)
398 {
399 StgTSO *t;
400 t = createThread (cap, stack_size);
401 pushClosure(t, (W_)&stg_ap_v_info);
402 pushClosure(t, (W_)closure);
403 pushClosure(t, (W_)&stg_enter_info);
404 return t;
405 }
406
407 /*
408 * Same as above, but also evaluate the result of the IO action
409 * to whnf while we're at it.
410 */
411
412 StgTSO *
413 createStrictIOThread(Capability *cap, W_ stack_size, StgClosure *closure)
414 {
415 StgTSO *t;
416 t = createThread(cap, stack_size);
417 pushClosure(t, (W_)&stg_forceIO_info);
418 pushClosure(t, (W_)&stg_ap_v_info);
419 pushClosure(t, (W_)closure);
420 pushClosure(t, (W_)&stg_enter_info);
421 return t;
422 }
423
424 /* ----------------------------------------------------------------------------
425 Evaluating Haskell expressions
426 ------------------------------------------------------------------------- */
427
428 void rts_eval (/* inout */ Capability **cap,
429 /* in */ HaskellObj p,
430 /* out */ HaskellObj *ret)
431 {
432 StgTSO *tso;
433
434 tso = createGenThread(*cap, RtsFlags.GcFlags.initialStkSize, p);
435 scheduleWaitThread(tso,ret,cap);
436 }
437
438 void rts_eval_ (/* inout */ Capability **cap,
439 /* in */ HaskellObj p,
440 /* in */ unsigned int stack_size,
441 /* out */ HaskellObj *ret)
442 {
443 StgTSO *tso;
444
445 tso = createGenThread(*cap, stack_size, p);
446 scheduleWaitThread(tso,ret,cap);
447 }
448
449 /*
450 * rts_evalIO() evaluates a value of the form (IO a), forcing the action's
451 * result to WHNF before returning.
452 */
453 void rts_evalIO (/* inout */ Capability **cap,
454 /* in */ HaskellObj p,
455 /* out */ HaskellObj *ret)
456 {
457 StgTSO* tso;
458
459 tso = createStrictIOThread(*cap, RtsFlags.GcFlags.initialStkSize, p);
460 scheduleWaitThread(tso,ret,cap);
461 }
462
463 /*
464 * rts_evalStableIOMain() is suitable for calling main Haskell thread
465 * stored in (StablePtr (IO a)) it calls rts_evalStableIO but wraps
466 * function in GHC.TopHandler.runMainIO that installs top_handlers.
467 * See Trac #12903.
468 */
469 void rts_evalStableIOMain(/* inout */ Capability **cap,
470 /* in */ HsStablePtr s,
471 /* out */ HsStablePtr *ret)
472 {
473 StgTSO* tso;
474 StgClosure *p, *r, *w;
475 SchedulerStatus stat;
476
477 p = (StgClosure *)deRefStablePtr(s);
478 w = rts_apply(*cap, &base_GHCziTopHandler_runMainIO_closure, p);
479 tso = createStrictIOThread(*cap, RtsFlags.GcFlags.initialStkSize, w);
480 // async exceptions are always blocked by default in the created
481 // thread. See #1048.
482 tso->flags |= TSO_BLOCKEX | TSO_INTERRUPTIBLE;
483 scheduleWaitThread(tso,&r,cap);
484 stat = rts_getSchedStatus(*cap);
485
486 if (stat == Success && ret != NULL) {
487 ASSERT(r != NULL);
488 *ret = getStablePtr((StgPtr)r);
489 }
490 }
491
492 /*
493 * rts_evalStableIO() is suitable for calling from Haskell. It
494 * evaluates a value of the form (StablePtr (IO a)), forcing the
495 * action's result to WHNF before returning. The result is returned
496 * in a StablePtr.
497 */
498 void rts_evalStableIO (/* inout */ Capability **cap,
499 /* in */ HsStablePtr s,
500 /* out */ HsStablePtr *ret)
501 {
502 StgTSO* tso;
503 StgClosure *p, *r;
504 SchedulerStatus stat;
505
506 p = (StgClosure *)deRefStablePtr(s);
507 tso = createStrictIOThread(*cap, RtsFlags.GcFlags.initialStkSize, p);
508 // async exceptions are always blocked by default in the created
509 // thread. See #1048.
510 tso->flags |= TSO_BLOCKEX | TSO_INTERRUPTIBLE;
511 scheduleWaitThread(tso,&r,cap);
512 stat = rts_getSchedStatus(*cap);
513
514 if (stat == Success && ret != NULL) {
515 ASSERT(r != NULL);
516 *ret = getStablePtr((StgPtr)r);
517 }
518 }
519
520 /*
521 * Like rts_evalIO(), but doesn't force the action's result.
522 */
523 void rts_evalLazyIO (/* inout */ Capability **cap,
524 /* in */ HaskellObj p,
525 /* out */ HaskellObj *ret)
526 {
527 StgTSO *tso;
528
529 tso = createIOThread(*cap, RtsFlags.GcFlags.initialStkSize, p);
530 scheduleWaitThread(tso,ret,cap);
531 }
532
533 void rts_evalLazyIO_ (/* inout */ Capability **cap,
534 /* in */ HaskellObj p,
535 /* in */ unsigned int stack_size,
536 /* out */ HaskellObj *ret)
537 {
538 StgTSO *tso;
539
540 tso = createIOThread(*cap, stack_size, p);
541 scheduleWaitThread(tso,ret,cap);
542 }
543
544 /* Convenience function for decoding the returned status. */
545
546 void
547 rts_checkSchedStatus (char* site, Capability *cap)
548 {
549 SchedulerStatus rc = cap->running_task->incall->rstat;
550 switch (rc) {
551 case Success:
552 return;
553 case Killed:
554 errorBelch("%s: uncaught exception",site);
555 stg_exit(EXIT_FAILURE);
556 case Interrupted:
557 errorBelch("%s: interrupted", site);
558 #if defined(THREADED_RTS)
559 // The RTS is shutting down, and the process will probably
560 // soon exit. We don't want to preempt the shutdown
561 // by exiting the whole process here, so we just terminate the
562 // current thread. Don't forget to release the cap first though.
563 rts_unlock(cap);
564 shutdownThread();
565 #else
566 stg_exit(EXIT_FAILURE);
567 #endif
568 default:
569 errorBelch("%s: Return code (%d) not ok",(site),(rc));
570 stg_exit(EXIT_FAILURE);
571 }
572 }
573
574 SchedulerStatus
575 rts_getSchedStatus (Capability *cap)
576 {
577 return cap->running_task->incall->rstat;
578 }
579
580 Capability *
581 rts_lock (void)
582 {
583 Capability *cap;
584 Task *task;
585
586 task = newBoundTask();
587
588 if (task->running_finalizers) {
589 errorBelch("error: a C finalizer called back into Haskell.\n"
590 " This was previously allowed, but is disallowed in GHC 6.10.2 and later.\n"
591 " To create finalizers that may call back into Haskell, use\n"
592 " Foreign.Concurrent.newForeignPtr instead of Foreign.newForeignPtr.");
593 stg_exit(EXIT_FAILURE);
594 }
595
596 cap = NULL;
597 waitForCapability(&cap, task);
598
599 if (task->incall->prev_stack == NULL) {
600 // This is a new outermost call from C into Haskell land.
601 // Until the corresponding call to rts_unlock, this task
602 // is doing work on behalf of the RTS.
603 traceTaskCreate(task, cap);
604 }
605
606 return (Capability *)cap;
607 }
608
609 // Exiting the RTS: we hold a Capability that is not necessarily the
610 // same one that was originally returned by rts_lock(), because
611 // rts_evalIO() etc. may return a new one. Now that we have
612 // investigated the return value, we can release the Capability,
613 // and free the Task (in that order).
614
615 void
616 rts_unlock (Capability *cap)
617 {
618 Task *task;
619
620 task = cap->running_task;
621 ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
622
623 // Now release the Capability. With the capability released, GC
624 // may happen. NB. does not try to put the current Task on the
625 // worker queue.
626 // NB. keep cap->lock held while we call boundTaskExiting(). This
627 // is necessary during shutdown, where we want the invariant that
628 // after shutdownCapability(), all the Tasks associated with the
629 // Capability have completed their shutdown too. Otherwise we
630 // could have boundTaskExiting()/workerTaskStop() running at some
631 // random point in the future, which causes problems for
632 // freeTaskManager().
633 ACQUIRE_LOCK(&cap->lock);
634 releaseCapability_(cap,false);
635
636 // Finally, we can release the Task to the free list.
637 boundTaskExiting(task);
638 RELEASE_LOCK(&cap->lock);
639
640 if (task->incall == NULL) {
641 // This is the end of an outermost call from C into Haskell land.
642 // From here on, the task goes back to C land and we should not count
643 // it as doing work on behalf of the RTS.
644 traceTaskDelete(task);
645 }
646 }
647
648 void rts_done (void)
649 {
650 freeMyTask();
651 }
652
653 /* -----------------------------------------------------------------------------
654 tryPutMVar from outside Haskell
655
656 The C call
657
658 hs_try_putmvar(cap, mvar)
659
660 is equivalent to the Haskell call
661
662 tryPutMVar mvar ()
663
664 but it is
665
666 * non-blocking: takes a bounded, short, amount of time
667 * asynchronous: the actual putMVar may be performed after the
668 call returns. That's why hs_try_putmvar() doesn't return a
669 result to say whether the put succeeded.
670
671 NOTE: this call transfers ownership of the StablePtr to the RTS, which will
672 free it after the tryPutMVar has taken place. The reason is that otherwise,
673 it would be very difficult for the caller to arrange to free the StablePtr
674 in all circumstances.
675
676 For more details, see the section "Waking up Haskell threads from C" in the
677 User's Guide.
678 -------------------------------------------------------------------------- */
679
680 void hs_try_putmvar (/* in */ int capability,
681 /* in */ HsStablePtr mvar)
682 {
683 Task *task = getTask();
684 Capability *cap;
685
686 if (capability < 0) {
687 capability = task->preferred_capability;
688 if (capability < 0) {
689 capability = 0;
690 }
691 }
692 cap = capabilities[capability % enabled_capabilities];
693
694 #if !defined(THREADED_RTS)
695
696 performTryPutMVar(cap, (StgMVar*)deRefStablePtr(mvar), Unit_closure);
697 freeStablePtr(mvar);
698
699 #else
700
701 ACQUIRE_LOCK(&cap->lock);
702 // If the capability is free, we can perform the tryPutMVar immediately
703 if (cap->running_task == NULL) {
704 cap->running_task = task;
705 task->cap = cap;
706 RELEASE_LOCK(&cap->lock);
707
708 performTryPutMVar(cap, (StgMVar*)deRefStablePtr(mvar), Unit_closure);
709
710 freeStablePtr(mvar);
711
712 // Wake up the capability, which will start running the thread that we
713 // just awoke (if there was one).
714 releaseCapability(cap);
715 } else {
716 PutMVar *p = stgMallocBytes(sizeof(PutMVar),"hs_try_putmvar");
717 // We cannot deref the StablePtr if we don't have a capability,
718 // so we have to store it and deref it later.
719 p->mvar = mvar;
720 p->link = cap->putMVars;
721 cap->putMVars = p;
722 RELEASE_LOCK(&cap->lock);
723 }
724
725 #endif
726 }