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