Typos in comments [ci skip]
[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 #ifdef 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 #ifdef 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 #ifdef 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 #ifdef 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 INFO_TABLE(stg_AP_STACK,/*special layout*/0,0,AP_STACK,"AP_STACK","AP_STACK")
458   /* no args => explicit stack */
459 {
460   W_ Words;
461   W_ ap;
462
463   ap = R1;
464
465   Words = StgAP_STACK_size(ap);
466
467   /*
468    * Check for stack overflow.  IMPORTANT: use a _ENTER check here,
469    * because if the check fails, we might end up blackholing this very
470    * closure, in which case we must enter the blackhole on return rather
471    * than continuing to evaluate the now-defunct closure.
472    */
473   STK_CHK_ENTER(WDS(Words) + SIZEOF_StgUpdateFrame + WDS(AP_STACK_SPLIM), R1);
474   /* ensure there is at least AP_STACK_SPLIM words of headroom available
475    * after unpacking the AP_STACK. See bug #1466 */
476
477   PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);
478   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words);
479
480   TICK_ENT_AP();
481   LDV_ENTER(ap);
482   ENTER_CCS_THUNK(ap);
483
484   // Reload the stack
485   W_ i;
486   W_ p;
487   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_STACK_payload;
488   i = 0;
489 for:
490   if (i < Words) {
491     Sp(i) = W_[p];
492     p = p + WDS(1);
493     i = i + 1;
494     goto for;
495   }
496
497   // Off we go!
498   TICK_ENT_VIA_NODE();
499
500   R1 = StgAP_STACK_fun(ap);
501
502   ENTER_R1();
503 }
504
505 /* -----------------------------------------------------------------------------
506    AP_STACK_NOUPD - exactly like AP_STACK, but doesn't push an update frame.
507    -------------------------------------------------------------------------- */
508
509 INFO_TABLE(stg_AP_STACK_NOUPD,/*special layout*/0,0,AP_STACK,
510                                         "AP_STACK_NOUPD","AP_STACK_NOUPD")
511    /* no args => explicit stack */
512 {
513   W_ Words;
514   W_ ap;
515
516   ap = R1;
517
518   Words = StgAP_STACK_size(ap);
519
520   /*
521    * Check for stack overflow.  IMPORTANT: use a _NP check here,
522    * because if the check fails, we might end up blackholing this very
523    * closure, in which case we must enter the blackhole on return rather
524    * than continuing to evaluate the now-defunct closure.
525    */
526   STK_CHK_ENTER(WDS(Words) + WDS(AP_STACK_SPLIM), R1);
527   /* ensure there is at least AP_STACK_SPLIM words of headroom available
528    * after unpacking the AP_STACK. See bug #1466 */
529
530   Sp = Sp - WDS(Words);
531
532   TICK_ENT_AP();
533   LDV_ENTER(ap);
534   ENTER_CCS_THUNK(ap);
535
536   // Reload the stack
537   W_ i;
538   W_ p;
539   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_STACK_payload;
540   i = 0;
541 for:
542   if (i < Words) {
543     Sp(i) = W_[p];
544     p = p + WDS(1);
545     i = i + 1;
546     goto for;
547   }
548
549   // Off we go!
550   TICK_ENT_VIA_NODE();
551
552   R1 = StgAP_STACK_fun(ap);
553
554   ENTER_R1();
555 }