Print PAP object address in stg_PAP_info entry code
[ghc.git] / rts / Apply.cmm
1 /* -----------------------------------------------------------------------------
2  *
3  * (c) The University of Glasgow 2004
4  *
5  * Application-related bits.
6  *
7  * This file is written in a subset of C--, extended with various
8  * features specific to GHC.  It is compiled by GHC directly.  For the
9  * syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
10  *
11  * -------------------------------------------------------------------------- */
12
13 #include "Cmm.h"
14
15 /* ----------------------------------------------------------------------------
16  * Evaluate a closure and return it.
17  *
18  * There isn't an info table / return address version of stg_ap_0, because
19  * everything being returned is guaranteed evaluated, so it would be a no-op.
20  */
21
22 STRING(stg_ap_0_ret_str,"stg_ap_0_ret... ")
23
24 stg_ap_0_fast ( P_ fun )
25 {
26     IF_DEBUG(apply,
27         ccall debugBelch(stg_ap_0_ret_str);
28         ccall printClosure(R1 "ptr"));
29
30     IF_DEBUG(sanity,
31         ccall checkStackFrame(Sp "ptr"));
32
33 #if !defined(PROFILING)
34
35     ENTER(fun);
36
37 #else
38
39 /*
40   Note [Evaluating functions with profiling]
41
42   If we evaluate something like
43
44     let f = {-# SCC "f" #-} g
45
46   where g is a function, then updating the thunk for f to point to g
47   would be incorrect: we've lost the SCC annotation.  In general, when
48   we evaluate a function and the current CCS is different from the one
49   stored in the function, we need to return a function with the
50   correct CCS in it.
51
52   The mechanism we use to wrap the function is to create a
53   zero-argument PAP as a proxy object to hold the new CCS, and return
54   that.
55
56   If the closure we evaluated is itself a PAP, we cannot make a nested
57   PAP, so we copy the original PAP and set the CCS in the new PAP to
58   enterFunCCS(pap->header.prof.ccs).
59 */
60
61 again:
62     W_  info;
63     P_ untaggedfun;
64     W_ arity;
65     untaggedfun = UNTAG(fun);
66     info = %INFO_PTR(untaggedfun);
67     switch [INVALID_OBJECT .. N_CLOSURE_TYPES]
68         (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) {
69         case
70             IND,
71             IND_STATIC:
72         {
73             fun = StgInd_indirectee(fun);
74             goto again;
75         }
76         case BCO:
77         {
78             arity = TO_W_(StgBCO_arity(untaggedfun));
79             goto dofun;
80         }
81         case
82             FUN,
83             FUN_1_0,
84             FUN_0_1,
85             FUN_2_0,
86             FUN_1_1,
87             FUN_0_2,
88             FUN_STATIC:
89         {
90             arity = TO_W_(StgFunInfoExtra_arity(%FUN_INFO(info)));
91         dofun:
92             if (CCCS == StgHeader_ccs(untaggedfun)) {
93                 return (fun);
94             } else {
95                 // We're going to build a new PAP, with zero extra
96                 // arguments and therefore the same arity as the
97                 // original function.  In other words, we're using a
98                 // zero-argument PAP as an indirection to the
99                 // function, so that we can attach a different CCS to
100                 // it.
101                 HP_CHK_GEN(SIZEOF_StgPAP);
102                 TICK_ALLOC_PAP(SIZEOF_StgPAP, 0);
103                 // attribute this allocation to the "overhead of profiling"
104                 CCS_ALLOC(BYTES_TO_WDS(SIZEOF_StgPAP), CCS_OVERHEAD);
105                 P_ pap;
106                 pap = Hp - SIZEOF_StgPAP + WDS(1);
107                 SET_HDR(pap, stg_PAP_info, CCCS);
108                 StgPAP_arity(pap) = arity;
109                 if (arity <= TAG_MASK) {
110                   // TODO: Shouldn't this already be tagged? If not why did we
111                   // untag it at the beginning of this function?
112                   fun = untaggedfun + arity;
113                 }
114                 StgPAP_fun(pap)   = fun;
115                 StgPAP_n_args(pap) = 0;
116                 return (pap);
117             }
118         }
119         case PAP:
120         {
121             if (CCCS == StgHeader_ccs(untaggedfun)) {
122                 return (fun);
123             } else {
124                 // We're going to copy this PAP, and put the new CCS in it
125                 W_ size;
126                 size = SIZEOF_StgPAP + WDS(TO_W_(StgPAP_n_args(untaggedfun)));
127                 HP_CHK_GEN(size);
128                 TICK_ALLOC_PAP(size, 0);
129                 // attribute this allocation to the "overhead of profiling"
130                 CCS_ALLOC(BYTES_TO_WDS(SIZEOF_StgPAP), CCS_OVERHEAD);
131                 P_ pap;
132                 pap = Hp - size + WDS(1);
133                 // We'll lose the original PAP, so we should enter its CCS
134                 ccall enterFunCCS(BaseReg "ptr", StgHeader_ccs(untaggedfun) "ptr");
135                 SET_HDR(pap, stg_PAP_info, CCCS);
136                 StgPAP_arity(pap) = StgPAP_arity(untaggedfun);
137                 StgPAP_n_args(pap) = StgPAP_n_args(untaggedfun);
138                 StgPAP_fun(pap)   = StgPAP_fun(fun);
139                 W_ i;
140                 i = TO_W_(StgPAP_n_args(untaggedfun));
141             loop:
142                 if (i == 0) {
143                     return (pap);
144                 }
145                 i = i - 1;
146                 StgPAP_payload(pap,i) = StgPAP_payload(fun,i);
147                 goto loop;
148             }
149         }
150         case AP,
151              AP_STACK,
152              BLACKHOLE,
153              WHITEHOLE,
154              THUNK,
155              THUNK_1_0,
156              THUNK_0_1,
157              THUNK_2_0,
158              THUNK_1_1,
159              THUNK_0_2,
160              THUNK_STATIC,
161              THUNK_SELECTOR:
162         {
163             // We have a thunk of some kind, so evaluate it.
164
165             // The thunk might evaluate to a function, so we have to
166             // come back here again to adjust its CCS if necessary.
167             // Therefore we need to push a stack frame to look at the
168             // function that gets returned (a stg_restore_ccs_eval
169             // frame), and therefore we need a stack check.
170             STK_CHK_GEN();
171
172             // We can't use the value of 'info' any more, because if
173             // STK_CHK_GEN() did a GC then the closure we're looking
174             // at may have changed, e.g. a THUNK_SELECTOR may have
175             // been evaluated by the GC.  So we reload the info
176             // pointer now.
177             untaggedfun = UNTAG(fun);
178             info = %INFO_PTR(untaggedfun);
179
180             jump %ENTRY_CODE(info)
181                 (stg_restore_cccs_eval_info, CCCS)
182                 (untaggedfun);
183         }
184         default:
185         {
186             jump %ENTRY_CODE(info) (UNTAG(fun));
187         }
188     }
189 #endif
190 }
191
192 /* -----------------------------------------------------------------------------
193    Entry Code for a PAP.
194
195    This entry code is *only* called by one of the stg_ap functions.
196    On entry: Sp points to the remaining arguments on the stack.  If
197    the stack check fails, we can just push the PAP on the stack and
198    return to the scheduler.
199
200    On entry: R1 points to the PAP.  The rest of the function's
201    arguments (apart from those that are already in the PAP) are on the
202    stack, starting at Sp(0).  R2 contains an info table which
203    describes these arguments, which is used in the event that the
204    stack check in the entry code below fails.  The info table is
205    currently one of the stg_ap_*_ret family, as this code is always
206    entered from those functions.
207
208    The idea is to copy the chunk of stack from the PAP object onto the
209    stack / into registers, and enter the function.
210    -------------------------------------------------------------------------- */
211
212 INFO_TABLE(stg_PAP,/*special layout*/0,0,PAP,"PAP","PAP")
213 {  ccall barf("PAP object (%p) entered!", R1) never returns; }
214
215 stg_PAP_apply /* no args => explicit stack */
216 {
217   W_ Words;
218   W_ pap;
219
220   pap = R1;
221
222   Words = TO_W_(StgPAP_n_args(pap));
223
224   //
225   // Check for stack overflow and bump the stack pointer.
226   // We have a hand-rolled stack check fragment here, because none of
227   // the canned ones suit this situation.
228   //
229   if (Sp - (WDS(Words) + 2/* see ARG_BCO below */) < SpLim) {
230       // there is a return address in R2 in the event of a
231       // stack check failure.  The various stg_apply functions arrange
232       // this before calling stg_PAP_entry.
233       Sp_adj(-1);
234       Sp(0) = R2;
235       jump stg_gc_unpt_r1 [R1];
236   }
237   Sp_adj(-Words);
238
239   // profiling
240   TICK_ENT_PAP();
241   LDV_ENTER(pap);
242 #if defined(PROFILING)
243   ccall enterFunCCS(BaseReg "ptr", StgHeader_ccs(pap) "ptr");
244 #endif
245
246   // Reload the stack
247   W_ i;
248   W_ p;
249   p = pap + SIZEOF_StgHeader + OFFSET_StgPAP_payload;
250   i = 0;
251 for:
252   if (i < Words) {
253     Sp(i) = W_[p];
254     p = p + WDS(1);
255     i = i + 1;
256     goto for;
257   }
258
259   R1 = StgPAP_fun(pap);
260
261 /* DEBUGGING CODE, ensures that arity 1 and 2 functions are entered tagged
262   if (TO_W_(StgFunInfoExtra_arity(%FUN_INFO(%INFO_PTR(UNTAG(R1))))) == 1 ) {
263     if (GETTAG(R1)!=1) {
264         W_[0]=1;
265     }
266   }
267
268   if (TO_W_(StgFunInfoExtra_arity(%FUN_INFO(%INFO_PTR(UNTAG(R1))))) == 2 ) {
269     if (GETTAG(R1)!=2) {
270         W_[0]=1;
271     }
272   }
273 */
274
275   // Off we go!
276   TICK_ENT_VIA_NODE();
277
278 #if defined(NO_ARG_REGS)
279   jump %GET_ENTRY(UNTAG(R1)) [R1];
280 #else
281       W_ info;
282       info = %GET_FUN_INFO(UNTAG(R1));
283       W_ type;
284       type = TO_W_(StgFunInfoExtra_fun_type(info));
285       if (type == ARG_GEN) {
286           jump StgFunInfoExtra_slow_apply(info) [R1];
287       }
288       if (type == ARG_GEN_BIG) {
289           jump StgFunInfoExtra_slow_apply(info) [R1];
290       }
291       if (type == ARG_BCO) {
292           Sp_adj(-2);
293           Sp(1) = R1;
294           Sp(0) = stg_apply_interp_info;
295           jump stg_yield_to_interpreter [];
296       }
297       jump W_[stg_ap_stack_entries +
298                 WDS(TO_W_(StgFunInfoExtra_fun_type(info)))] [R1];
299 #endif
300 }
301
302 /* -----------------------------------------------------------------------------
303    Entry Code for an AP (a PAP with arity zero).
304
305    The entry code is very similar to a PAP, except there are no
306    further arguments on the stack to worry about, so the stack check
307    is simpler.  We must also push an update frame on the stack before
308    applying the function.
309    -------------------------------------------------------------------------- */
310
311 INFO_TABLE(stg_AP,/*special layout*/0,0,AP,"AP","AP")
312  /* no args => explicit stack */
313 {
314   W_ Words;
315   W_ ap;
316
317   ap = R1;
318
319   Words = TO_W_(StgAP_n_args(ap));
320
321   /*
322    * Check for stack overflow.  IMPORTANT: use a _ENTER check here,
323    * because if the check fails, we might end up blackholing this very
324    * closure, in which case we must enter the blackhole on return rather
325    * than continuing to evaluate the now-defunct closure.
326    */
327   STK_CHK_ENTER(WDS(Words) +
328                 SIZEOF_StgUpdateFrame +
329                 2/* see ARG_BCO below */, R1);
330
331   PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);
332   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words);
333
334   TICK_ENT_AP();
335   LDV_ENTER(ap);
336   ENTER_CCS_THUNK(ap);
337
338   // Reload the stack
339   W_ i;
340   W_ p;
341   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_payload;
342   i = 0;
343 for:
344   if (i < Words) {
345     Sp(i) = W_[p];
346     p = p + WDS(1);
347     i = i + 1;
348     goto for;
349   }
350
351   R1 = StgAP_fun(ap);
352
353   // Off we go!
354   TICK_ENT_VIA_NODE();
355
356 #if defined(NO_ARG_REGS)
357   jump %GET_ENTRY(UNTAG(R1)) [R1];
358 #else
359       W_ info;
360       info = %GET_FUN_INFO(UNTAG(R1));
361       W_ type;
362       type = TO_W_(StgFunInfoExtra_fun_type(info));
363       if (type == ARG_GEN) {
364           jump StgFunInfoExtra_slow_apply(info) [R1];
365       }
366       if (type == ARG_GEN_BIG) {
367           jump StgFunInfoExtra_slow_apply(info) [R1];
368       }
369       if (type == ARG_BCO) {
370           Sp_adj(-2);
371           Sp(1) = R1;
372           Sp(0) = stg_apply_interp_info;
373           jump stg_yield_to_interpreter [];
374       }
375       jump W_[stg_ap_stack_entries +
376                 WDS(TO_W_(StgFunInfoExtra_fun_type(info)))] [R1];
377 #endif
378 }
379
380 /* AP_NOUPD is exactly like AP, except that no update frame is pushed.
381    Use for thunks that are guaranteed to be entered once only, such as
382    those generated by the byte-code compiler for inserting breakpoints. */
383
384 INFO_TABLE(stg_AP_NOUPD,/*special layout*/0,0,AP,"AP_NOUPD","AP_NOUPD")
385    /* no args => explicit stack */
386 {
387   W_ Words;
388   W_ ap;
389
390   ap = R1;
391
392   Words = TO_W_(StgAP_n_args(ap));
393
394   /*
395    * Check for stack overflow.  IMPORTANT: use a _ENTER check here,
396    * because if the check fails, we might end up blackholing this very
397    * closure, in which case we must enter the blackhole on return rather
398    * than continuing to evaluate the now-defunct closure.
399    */
400   STK_CHK_ENTER(WDS(Words) +
401                 2/* see ARG_BCO below */, R1);
402   Sp = Sp - WDS(Words);
403
404   TICK_ENT_AP();
405   LDV_ENTER(ap);
406   ENTER_CCS_THUNK(ap);
407
408   // Reload the stack
409   W_ i;
410   W_ p;
411   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_payload;
412   i = 0;
413 for:
414   if (i < Words) {
415     Sp(i) = W_[p];
416     p = p + WDS(1);
417     i = i + 1;
418     goto for;
419   }
420
421   R1 = StgAP_fun(ap);
422
423   // Off we go!
424   TICK_ENT_VIA_NODE();
425
426 #if defined(NO_ARG_REGS)
427   jump %GET_ENTRY(UNTAG(R1)) [R1];
428 #else
429       W_ info;
430       info = %GET_FUN_INFO(UNTAG(R1));
431       W_ type;
432       type = TO_W_(StgFunInfoExtra_fun_type(info));
433       if (type == ARG_GEN) {
434           jump StgFunInfoExtra_slow_apply(info) [R1];
435       }
436       if (type == ARG_GEN_BIG) {
437           jump StgFunInfoExtra_slow_apply(info) [R1];
438       }
439       if (type == ARG_BCO) {
440           Sp_adj(-2);
441           Sp(1) = R1;
442           Sp(0) = stg_apply_interp_info;
443           jump stg_yield_to_interpreter [];
444       }
445       jump W_[stg_ap_stack_entries +
446                 WDS(TO_W_(StgFunInfoExtra_fun_type(info)))] [R1];
447 #endif
448 }
449
450 /* -----------------------------------------------------------------------------
451    Entry Code for an AP_STACK.
452
453    Very similar to a PAP and AP.  The layout is the same as PAP
454    and AP, except that the payload is a chunk of stack instead of
455    being described by the function's info table.  Like an AP,
456    there are no further arguments on the stack to worry about.
457    However, the function closure (ap->fun) does not necessarily point
458    directly to a function, so we have to enter it using stg_ap_0.
459    -------------------------------------------------------------------------- */
460
461 /*
462  Note [AP_STACKs must be eagerly blackholed]
463  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
464 #13615 describes a nasty concurrency issue where we can enter into the
465 middle of an ST action multiple times, resulting in duplication of effects.
466 In short, the construction of an AP_STACK allows us to suspend a computation
467 which should not be duplicated. When running with lazy blackholing, we can then
468 enter this AP_STACK multiple times, duplicating the computation with potentially
469 disastrous consequences.
470
471 For instance, consider the case of a simple ST program which computes a sum
472 using in─place mutation,
473
474    inplaceSum :: Num a => [a] ─> a
475    inplaceSum xs0 = runST $ do
476      y <─ newSTRef 0
477      let go [] = readSTRef y
478          go (x : xs) = do
479            modifySTRef y (+x)
480            go xs
481      go xs0
482
483 Of course, it is fine if we enter an inplaceSum thunk more than once: the two
484 threads will inhabit different worlds with different STRefs. However, if we
485 suspend some part of inplaceSum (for instance, due to the heap check at the
486 beginning of go) and then multiple threads resume that suspension (as is safe in
487 pure computation) we will have multiple threads concurrently mutating the same
488 STRef. Disaster!
489
490 Let's consider how this might happen: Consider this situation,
491
492   ┌─────────┐            ┌───────┐      ┌───────┐          ┌─────────┐
493   │  TSO 1  │      ╭────→│ go    │      │ fun   │          │  TSO 2  │
494   └─────────┘      │     └───────┘      └───────┘          └─────────┘
495                    │                        │
496   ┌─────────┐      │                        │              ┌─────────┐
497   │         │──────╯                        ╰──────────────│         │
498   ├─────────┤           ┌─────────┐                        ├─────────┤
499   │ UPDATE_ │──────────→│ THUNK A │               ╭────────│ UPDATE_ │
500   │ FRAME   │ updatee   └─────────┘               │updatee │ FRAME   │
501   ├─────────┤                                     │        ├─────────┤
502   │ ...     │                                     │        │ etc.    │
503   ├─────────┤ updatee              ┌─────────┐    │
504   │ UPDATE_ │─────────────────────→│ THUNK B │←───╯
505   │ FRAME   │                      └─────────┘
506   ├─────────┤
507   │ etc.    │
508
509 Here we have two threads (TSO 1 and TSO 2) which are in currently pausing (e.g.
510 in threadPaused). Since they are pausing, their stacks are headed by a pointer
511 to the continuation code which we will run on resumption (go and fun,
512 respectively). We also see that there are two thunks on the heap: THUNK A and
513 THUNK B where THUNK B depends upon THUNK A (as in, evaluation of B will force
514 A). We see that thread 1 has THUNK A under evaluation, and both threads have
515 THUNK B under evaluation.
516
517 As each thread enters threadPaused, threadPaused will walk its stack looking for
518 duplicate computation (see Note [suspend duplicate work], although there is some
519 background described below as well). Let's consider what this check does:
520
521 Say that TSO 2 begins this check first. The check will walk TSO 2's stack, until
522 it finds the first update frame, which updates THUNK B. Upon finding this frame,
523 it will try to lock THUNK B, replacing it with a BLACKHOLE owned by its TSO. We
524 now have,
525
526   ┌─────────┐            ┌───────┐   ┌───────┐             ┌─────────┐
527   │  TSO 1  │      ╭────→│ go    │   │ fun   │   ╭────────→│  TSO 2  │
528   └─────────┘      │     └───────┘   └───────┘   │         └─────────┘
529                    │                     ↑ ╭─────╯
530   ┌─────────┐      │                     │ │               ┌─────────┐
531   │         │──────╯                     ╰─────────────────│         │
532   ├─────────┤ updatee   ┌─────────┐        │               ├─────────┤
533   │ UPDATE_ │──────────→│ THUNK A │        │    ╭──────────│ UPDATE_ │
534   │ FRAME   │           └─────────┘        │    │  updatee │ FRAME   │
535   ├─────────┤                              │    │          ├─────────┤
536   │ ...     │                         owner│    │          │ etc.    │
537   ├─────────┤ updatee           ┌────────────┐  │
538   │ UPDATE_ │──────────────────→│ BLACKHOLE  │←─╯
539   │ FRAME   │                   └────────────┘
540   ├─────────┤
541   │ etc.    │
542
543 Now consider what happens when TSO 1 runs its duplicate-computation check.
544 Again, we start walking the stack from the top, where we find the update
545 frame updating THUNK A. We will lock this thunk, replacing it with a BLACKHOLE
546 owned by its TSO. We now have,
547
548   ┌─────────┐            ┌───────┐   ┌───────┐             ┌─────────┐
549   │  TSO 1  │←──╮  ╭────→│ go    │   │ fun   │   ╭────────→│  TSO 2  │
550   └─────────┘   │  │     └───────┘   └───────┘   │         └─────────┘
551                 │  │                     ↑ ╭─────╯
552   ┌─────────┐   ╰──│─────────╮           │ │               ┌─────────┐
553   │         │──────╯         │owner      ╰─────────────────│         │
554   ├─────────┤           ┌───────────┐      │               ├─────────┤
555   │ UPDATE_ │──────────→│ BLACKHOLE │      │    ╭──────────│ UPDATE_ │
556   │ FRAME   │ updatee   └───────────┘      │    │  updatee │ FRAME   │
557   ├─────────┤                              │    │          ├─────────┤
558   │ ...     │                         owner│    │          │ etc.    │
559   ├─────────┤ updatee           ┌────────────┐  │
560   │ UPDATE_ │──────────────────→│ BLACKHOLE  │←─╯
561   │ FRAME   │                   └────────────┘
562   ├─────────┤
563   │ etc.    │
564
565 Now we will continue walking down TSO 1's stack, next coming across the second
566 update frame, pointing to the now-BLACKHOLE'd THUNK B. At this point
567 threadPaused will correctly conclude that TSO 1 is duplicating a computation
568 being carried out by TSO 2 and attempt to suspend it.
569
570 The suspension process proceeds by invoking raiseAsync, which walks the stack
571 from the top looking for update frames. For each update frame we take any stack
572 frames preceeding it and construct an AP_STACK heap object from them. We then
573 replace the updatee of the frame with an indirection pointing to the AP_STACK.
574 So, after suspending the first update frame we have,
575
576   ┌─────────┐            ┌───────┐    ┌───────┐            ┌─────────┐
577   │  TSO 1  │  ╭────────→│ go    │←─╮ │ fun   │   ╭───────→│  TSO 2  │
578   └─────────┘  │         └───────┘  │ └───────┘   │        └─────────┘
579                │      ┌───────────┐ │     ↑ ╭─────╯
580   ┌─────────┐  │      │ AP_STACK  │ │     │ │              ┌─────────┐
581   │         │──╯      ├───────────┤ │     ╰────────────────│         │
582   ├─────────┤         │           │─╯       │              ├─────────┤
583   │ UPDATE_ │───────╮ └───────────┘         │   ╭──────────│ UPDATE_ │
584   │ FRAME   │updatee│     ↑                 │   │  updatee │ FRAME   │
585   ├─────────┤       │     │indirectee       │   │          ├─────────┤
586   │ ...     │       ╰→┌───────────┐         │   │          │ etc.    │
587   ├─────────┤updatee  │ BLACKHOLE │         │   │
588   │ UPDATE_ │──╮      └───────────┘    owner│   │
589   │ FRAME   │  │                ┌────────────┐  │
590   ├─────────┤  ╰───────────────→│ BLACKHOLE  │←─╯
591   │ etc.    │                   └────────────┘
592
593 Finally, we will replace the second update frame with a blackhole so that TSO 1
594 will block on TSO 2's computation of THUNK B,
595
596   ┌─────────┐            ┌───────┐    ┌───────┐            ┌─────────┐
597   │  TSO 1  │  ╭────────→│ go    │←─╮ │ fun   │   ╭───────→│  TSO 2  │
598   └─────────┘  │         └───────┘  │ └───────┘   │        └─────────┘
599                │      ┌───────────┐ │     ↑ ╭─────╯
600   ┌─────────┐  │      │ AP_STACK  │ │     │ │              ┌─────────┐
601   │         │──╯      ├───────────┤ │     ╰────────────────│         │
602   ├─────────┤         │           │─╯       │              ├─────────┤
603   │ UPDATE_ │───────╮ └───────────┘         │   ╭──────────│ UPDATE_ │
604   │ FRAME   │updatee│     ↑                 │   │  updatee │ FRAME   │
605   ├─────────┤       │     │indirectee       │   │          ├─────────┤
606   │ ...     │       ╰→┌───────────┐         │   │          │ etc.    │
607   ├─────────┤         │ BLACKHOLE │         │   │
608   │ BLACK   │         └───────────┘    owner│   │
609   │ HOLE    │───────────╮       ┌────────────┐  │
610   ├─────────┤indirectee ╰──────→│ BLACKHOLE  │←─╯
611   │ etc.    │                   └────────────┘
612
613 At first glance there's still nothing terribly alarming here. However, consider
614 what would happen if some other closure held a reference to THUNK A. We would
615 now have leaked an AP_STACK capturing the state of a potentially
616 non-duplicatable computation to heap. Even worse, if two threads had references
617 to THUNK A and both attempted to enter at the same time, they would both succeed
618 if we allowed AP_STACKs to be lazily blackholed. This is the reason why we must
619 be very careful when entering AP_STACKS: they introduce the possibility that we
620 duplicate a computation which could never otherwise be duplicated.
621
622 For this reason we employ an atomic blackholing strategy when entering AP_STACK
623 closures.
624  */
625
626
627 INFO_TABLE(stg_AP_STACK,/*special layout*/0,0,AP_STACK,"AP_STACK","AP_STACK")
628   /* no args => explicit stack */
629 {
630   W_ Words;
631   W_ ap;
632
633   ap = R1;
634
635   Words = StgAP_STACK_size(ap);
636
637   /*
638    * Check for stack overflow.  IMPORTANT: use a _ENTER check here,
639    * because if the check fails, we might end up blackholing this very
640    * closure, in which case we must enter the blackhole on return rather
641    * than continuing to evaluate the now-defunct closure.
642    */
643   STK_CHK_ENTER(WDS(Words) + SIZEOF_StgUpdateFrame + WDS(AP_STACK_SPLIM), R1);
644
645   /*
646    * It is imperative that we blackhole lest we may duplicate computation which
647    * must not be duplicated. See Note [AP_STACKs must be eagerly blackholed].
648    */
649   W_ old_info;
650   (old_info) = prim %cmpxchgW(ap, stg_AP_STACK_info, stg_WHITEHOLE_info);
651   if (old_info != stg_AP_STACK_info) {
652     /* someone else beat us to it */
653     jump ENTRY_LBL(stg_WHITEHOLE) (ap);
654   }
655   StgInd_indirectee(ap) = CurrentTSO;
656   prim_write_barrier;
657   SET_INFO(ap, __stg_EAGER_BLACKHOLE_info);
658
659   /* ensure there is at least AP_STACK_SPLIM words of headroom available
660    * after unpacking the AP_STACK. See bug #1466 */
661   PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);
662   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words);
663
664   TICK_ENT_AP();
665   LDV_ENTER(ap);
666   ENTER_CCS_THUNK(ap);
667
668   // Reload the stack
669   W_ i;
670   W_ p;
671   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_STACK_payload;
672   i = 0;
673 for:
674   if (i < Words) {
675     Sp(i) = W_[p];
676     p = p + WDS(1);
677     i = i + 1;
678     goto for;
679   }
680
681   // Off we go!
682   TICK_ENT_VIA_NODE();
683
684   R1 = StgAP_STACK_fun(ap);
685
686   // Because of eager blackholing the closure no longer has correct size so
687   // threadPaused() can't correctly zero the slop, so we do it here. See #15571
688   // and Note [zeroing slop].
689   OVERWRITING_CLOSURE_SIZE(ap, BYTES_TO_WDS(SIZEOF_StgThunkHeader) + 2 + Words);
690
691   ENTER_R1();
692 }
693
694 /* -----------------------------------------------------------------------------
695    AP_STACK_NOUPD - exactly like AP_STACK, but doesn't push an update frame.
696    -------------------------------------------------------------------------- */
697
698 INFO_TABLE(stg_AP_STACK_NOUPD,/*special layout*/0,0,AP_STACK,
699                                         "AP_STACK_NOUPD","AP_STACK_NOUPD")
700    /* no args => explicit stack */
701 {
702   W_ Words;
703   W_ ap;
704
705   ap = R1;
706
707   Words = StgAP_STACK_size(ap);
708
709   /*
710    * Check for stack overflow.  IMPORTANT: use a _NP check here,
711    * because if the check fails, we might end up blackholing this very
712    * closure, in which case we must enter the blackhole on return rather
713    * than continuing to evaluate the now-defunct closure.
714    */
715   STK_CHK_ENTER(WDS(Words) + WDS(AP_STACK_SPLIM), R1);
716   /* ensure there is at least AP_STACK_SPLIM words of headroom available
717    * after unpacking the AP_STACK. See bug #1466 */
718
719   Sp = Sp - WDS(Words);
720
721   TICK_ENT_AP();
722   LDV_ENTER(ap);
723   ENTER_CCS_THUNK(ap);
724
725   // Reload the stack
726   W_ i;
727   W_ p;
728   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_STACK_payload;
729   i = 0;
730 for:
731   if (i < Words) {
732     Sp(i) = W_[p];
733     p = p + WDS(1);
734     i = i + 1;
735     goto for;
736   }
737
738   // Off we go!
739   TICK_ENT_VIA_NODE();
740
741   R1 = StgAP_STACK_fun(ap);
742
743   ENTER_R1();
744 }