Fix numa001 failure with "too many NUMA nodes"
[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     ENTER(fun);
34 }
35
36 /* -----------------------------------------------------------------------------
37    Entry Code for a PAP.
38
39    This entry code is *only* called by one of the stg_ap functions.
40    On entry: Sp points to the remaining arguments on the stack.  If
41    the stack check fails, we can just push the PAP on the stack and
42    return to the scheduler.
43
44    On entry: R1 points to the PAP.  The rest of the function's
45    arguments (apart from those that are already in the PAP) are on the
46    stack, starting at Sp(0).  R2 contains an info table which
47    describes these arguments, which is used in the event that the
48    stack check in the entry code below fails.  The info table is
49    currently one of the stg_ap_*_ret family, as this code is always
50    entered from those functions.
51
52    The idea is to copy the chunk of stack from the PAP object onto the
53    stack / into registers, and enter the function.
54    -------------------------------------------------------------------------- */
55
56 INFO_TABLE(stg_PAP,/*special layout*/0,0,PAP,"PAP","PAP")
57 {  ccall barf("PAP object entered!") never returns; }
58
59 stg_PAP_apply /* no args => explicit stack */
60 {
61   W_ Words;
62   W_ pap;
63
64   pap = R1;
65
66   Words = TO_W_(StgPAP_n_args(pap));
67
68   //
69   // Check for stack overflow and bump the stack pointer.
70   // We have a hand-rolled stack check fragment here, because none of
71   // the canned ones suit this situation.
72   //
73   if (Sp - (WDS(Words) + 2/* see ARG_BCO below */) < SpLim) {
74       // there is a return address in R2 in the event of a
75       // stack check failure.  The various stg_apply functions arrange
76       // this before calling stg_PAP_entry.
77       Sp_adj(-1);
78       Sp(0) = R2;
79       jump stg_gc_unpt_r1 [R1];
80   }
81   Sp_adj(-Words);
82
83   // profiling
84   TICK_ENT_PAP();
85   LDV_ENTER(pap);
86 #ifdef PROFILING
87   ccall enterFunCCS(BaseReg "ptr", StgHeader_ccs(pap) "ptr");
88 #endif
89
90   // Reload the stack
91   W_ i;
92   W_ p;
93   p = pap + SIZEOF_StgHeader + OFFSET_StgPAP_payload;
94   i = 0;
95 for:
96   if (i < Words) {
97     Sp(i) = W_[p];
98     p = p + WDS(1);
99     i = i + 1;
100     goto for;
101   }
102
103   R1 = StgPAP_fun(pap);
104
105 /* DEBUGGING CODE, ensures that arity 1 and 2 functions are entered tagged
106   if (TO_W_(StgFunInfoExtra_arity(%FUN_INFO(%INFO_PTR(UNTAG(R1))))) == 1 ) {
107     if (GETTAG(R1)!=1) {
108         W_[0]=1;
109     }
110   }
111
112   if (TO_W_(StgFunInfoExtra_arity(%FUN_INFO(%INFO_PTR(UNTAG(R1))))) == 2 ) {
113     if (GETTAG(R1)!=2) {
114         W_[0]=1;
115     }
116   }
117 */
118
119   // Off we go!
120   TICK_ENT_VIA_NODE();
121
122 #ifdef NO_ARG_REGS
123   jump %GET_ENTRY(UNTAG(R1)) [R1];
124 #else
125       W_ info;
126       info = %GET_FUN_INFO(UNTAG(R1));
127       W_ type;
128       type = TO_W_(StgFunInfoExtra_fun_type(info));
129       if (type == ARG_GEN) {
130           jump StgFunInfoExtra_slow_apply(info) [R1];
131       }
132       if (type == ARG_GEN_BIG) {
133           jump StgFunInfoExtra_slow_apply(info) [R1];
134       }
135       if (type == ARG_BCO) {
136           Sp_adj(-2);
137           Sp(1) = R1;
138           Sp(0) = stg_apply_interp_info;
139           jump stg_yield_to_interpreter [];
140       }
141       jump W_[stg_ap_stack_entries +
142                 WDS(TO_W_(StgFunInfoExtra_fun_type(info)))] [R1];
143 #endif
144 }
145
146 /* -----------------------------------------------------------------------------
147    Entry Code for an AP (a PAP with arity zero).
148
149    The entry code is very similar to a PAP, except there are no
150    further arguments on the stack to worry about, so the stack check
151    is simpler.  We must also push an update frame on the stack before
152    applying the function.
153    -------------------------------------------------------------------------- */
154
155 INFO_TABLE(stg_AP,/*special layout*/0,0,AP,"AP","AP")
156  /* no args => explicit stack */
157 {
158   W_ Words;
159   W_ ap;
160
161   ap = R1;
162
163   Words = TO_W_(StgAP_n_args(ap));
164
165   /*
166    * Check for stack overflow.  IMPORTANT: use a _ENTER check here,
167    * because if the check fails, we might end up blackholing this very
168    * closure, in which case we must enter the blackhole on return rather
169    * than continuing to evaluate the now-defunct closure.
170    */
171   STK_CHK_ENTER(WDS(Words) +
172                 SIZEOF_StgUpdateFrame +
173                 2/* see ARG_BCO below */, R1);
174
175   PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);
176   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words);
177
178   TICK_ENT_AP();
179   LDV_ENTER(ap);
180   ENTER_CCS_THUNK(ap);
181
182   // Reload the stack
183   W_ i;
184   W_ p;
185   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_payload;
186   i = 0;
187 for:
188   if (i < Words) {
189     Sp(i) = W_[p];
190     p = p + WDS(1);
191     i = i + 1;
192     goto for;
193   }
194
195   R1 = StgAP_fun(ap);
196
197   // Off we go!
198   TICK_ENT_VIA_NODE();
199
200 #ifdef NO_ARG_REGS
201   jump %GET_ENTRY(UNTAG(R1)) [R1];
202 #else
203       W_ info;
204       info = %GET_FUN_INFO(UNTAG(R1));
205       W_ type;
206       type = TO_W_(StgFunInfoExtra_fun_type(info));
207       if (type == ARG_GEN) {
208           jump StgFunInfoExtra_slow_apply(info) [R1];
209       }
210       if (type == ARG_GEN_BIG) {
211           jump StgFunInfoExtra_slow_apply(info) [R1];
212       }
213       if (type == ARG_BCO) {
214           Sp_adj(-2);
215           Sp(1) = R1;
216           Sp(0) = stg_apply_interp_info;
217           jump stg_yield_to_interpreter [];
218       }
219       jump W_[stg_ap_stack_entries +
220                 WDS(TO_W_(StgFunInfoExtra_fun_type(info)))] [R1];
221 #endif
222 }
223
224 /* AP_NOUPD is exactly like AP, except that no update frame is pushed.
225    Use for thunks that are guaranteed to be entered once only, such as
226    those generated by the byte-code compiler for inserting breakpoints. */
227
228 INFO_TABLE(stg_AP_NOUPD,/*special layout*/0,0,AP,"AP_NOUPD","AP_NOUPD")
229    /* no args => explicit stack */
230 {
231   W_ Words;
232   W_ ap;
233
234   ap = R1;
235
236   Words = TO_W_(StgAP_n_args(ap));
237
238   /*
239    * Check for stack overflow.  IMPORTANT: use a _ENTER check here,
240    * because if the check fails, we might end up blackholing this very
241    * closure, in which case we must enter the blackhole on return rather
242    * than continuing to evaluate the now-defunct closure.
243    */
244   STK_CHK_ENTER(WDS(Words) +
245                 2/* see ARG_BCO below */, R1);
246   Sp = Sp - WDS(Words);
247
248   TICK_ENT_AP();
249   LDV_ENTER(ap);
250   ENTER_CCS_THUNK(ap);
251
252   // Reload the stack
253   W_ i;
254   W_ p;
255   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_payload;
256   i = 0;
257 for:
258   if (i < Words) {
259     Sp(i) = W_[p];
260     p = p + WDS(1);
261     i = i + 1;
262     goto for;
263   }
264
265   R1 = StgAP_fun(ap);
266
267   // Off we go!
268   TICK_ENT_VIA_NODE();
269
270 #ifdef NO_ARG_REGS
271   jump %GET_ENTRY(UNTAG(R1)) [R1];
272 #else
273       W_ info;
274       info = %GET_FUN_INFO(UNTAG(R1));
275       W_ type;
276       type = TO_W_(StgFunInfoExtra_fun_type(info));
277       if (type == ARG_GEN) {
278           jump StgFunInfoExtra_slow_apply(info) [R1];
279       }
280       if (type == ARG_GEN_BIG) {
281           jump StgFunInfoExtra_slow_apply(info) [R1];
282       }
283       if (type == ARG_BCO) {
284           Sp_adj(-2);
285           Sp(1) = R1;
286           Sp(0) = stg_apply_interp_info;
287           jump stg_yield_to_interpreter [];
288       }
289       jump W_[stg_ap_stack_entries +
290                 WDS(TO_W_(StgFunInfoExtra_fun_type(info)))] [R1];
291 #endif
292 }
293
294 /* -----------------------------------------------------------------------------
295    Entry Code for an AP_STACK.
296
297    Very similar to a PAP and AP.  The layout is the same as PAP
298    and AP, except that the payload is a chunk of stack instead of
299    being described by the function's info table.  Like an AP,
300    there are no further arguments on the stack to worry about.
301    However, the function closure (ap->fun) does not necessarily point
302    directly to a function, so we have to enter it using stg_ap_0.
303    -------------------------------------------------------------------------- */
304
305 INFO_TABLE(stg_AP_STACK,/*special layout*/0,0,AP_STACK,"AP_STACK","AP_STACK")
306   /* no args => explicit stack */
307 {
308   W_ Words;
309   W_ ap;
310
311   ap = R1;
312
313   Words = StgAP_STACK_size(ap);
314
315   /*
316    * Check for stack overflow.  IMPORTANT: use a _ENTER check here,
317    * because if the check fails, we might end up blackholing this very
318    * closure, in which case we must enter the blackhole on return rather
319    * than continuing to evaluate the now-defunct closure.
320    */
321   STK_CHK_ENTER(WDS(Words) + SIZEOF_StgUpdateFrame + WDS(AP_STACK_SPLIM), R1);
322   /* ensure there is at least AP_STACK_SPLIM words of headroom available
323    * after unpacking the AP_STACK. See bug #1466 */
324
325   PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);
326   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words);
327
328   TICK_ENT_AP();
329   LDV_ENTER(ap);
330   ENTER_CCS_THUNK(ap);
331
332   // Reload the stack
333   W_ i;
334   W_ p;
335   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_STACK_payload;
336   i = 0;
337 for:
338   if (i < Words) {
339     Sp(i) = W_[p];
340     p = p + WDS(1);
341     i = i + 1;
342     goto for;
343   }
344
345   // Off we go!
346   TICK_ENT_VIA_NODE();
347
348   R1 = StgAP_STACK_fun(ap);
349
350   ENTER_R1();
351 }
352
353 /* -----------------------------------------------------------------------------
354    AP_STACK_NOUPD - exactly like AP_STACK, but doesn't push an update frame.
355    -------------------------------------------------------------------------- */
356
357 INFO_TABLE(stg_AP_STACK_NOUPD,/*special layout*/0,0,AP_STACK,
358                                         "AP_STACK_NOUPD","AP_STACK_NOUPD")
359    /* no args => explicit stack */
360 {
361   W_ Words;
362   W_ ap;
363
364   ap = R1;
365
366   Words = StgAP_STACK_size(ap);
367
368   /*
369    * Check for stack overflow.  IMPORTANT: use a _NP check here,
370    * because if the check fails, we might end up blackholing this very
371    * closure, in which case we must enter the blackhole on return rather
372    * than continuing to evaluate the now-defunct closure.
373    */
374   STK_CHK_ENTER(WDS(Words) + WDS(AP_STACK_SPLIM), R1);
375   /* ensure there is at least AP_STACK_SPLIM words of headroom available
376    * after unpacking the AP_STACK. See bug #1466 */
377
378   Sp = Sp - WDS(Words);
379
380   TICK_ENT_AP();
381   LDV_ENTER(ap);
382   ENTER_CCS_THUNK(ap);
383
384   // Reload the stack
385   W_ i;
386   W_ p;
387   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_STACK_payload;
388   i = 0;
389 for:
390   if (i < Words) {
391     Sp(i) = W_[p];
392     p = p + WDS(1);
393     i = i + 1;
394     goto for;
395   }
396
397   // Off we go!
398   TICK_ENT_VIA_NODE();
399
400   R1 = StgAP_STACK_fun(ap);
401
402   ENTER_R1();
403 }