Implement stack chunks and separate TSO/STACK objects
[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
25
26     // fn is in R1, no args on the stack
27
28     IF_DEBUG(apply,
29         foreign "C" debugBelch(stg_ap_0_ret_str) [R1];
30         foreign "C" printClosure(R1 "ptr") [R1]);
31
32     IF_DEBUG(sanity,
33         foreign "C" checkStackFrame(Sp "ptr") [R1]);
34
35     ENTER();
36 }
37
38 /* -----------------------------------------------------------------------------
39    Entry Code for a PAP.
40
41    This entry code is *only* called by one of the stg_ap functions.
42    On entry: Sp points to the remaining arguments on the stack.  If
43    the stack check fails, we can just push the PAP on the stack and
44    return to the scheduler.
45
46    On entry: R1 points to the PAP.  The rest of the function's
47    arguments (apart from those that are already in the PAP) are on the
48    stack, starting at Sp(0).  R2 contains an info table which
49    describes these arguments, which is used in the event that the
50    stack check in the entry code below fails.  The info table is
51    currently one of the stg_ap_*_ret family, as this code is always
52    entered from those functions.
53
54    The idea is to copy the chunk of stack from the PAP object onto the
55    stack / into registers, and enter the function.
56    -------------------------------------------------------------------------- */
57
58 INFO_TABLE(stg_PAP,/*special layout*/0,0,PAP,"PAP","PAP")
59 {  foreign "C" barf("PAP object entered!") never returns; }
60     
61 stg_PAP_apply
62 {
63   W_ Words;
64   W_ pap;
65     
66   pap = R1;
67
68   Words = TO_W_(StgPAP_n_args(pap));
69
70   //
71   // Check for stack overflow and bump the stack pointer.
72   // We have a hand-rolled stack check fragment here, because none of
73   // the canned ones suit this situation.
74   //
75   if ((Sp - WDS(Words)) < SpLim) {
76       // there is a return address in R2 in the event of a
77       // stack check failure.  The various stg_apply functions arrange
78       // this before calling stg_PAP_entry.
79       Sp_adj(-1); 
80       Sp(0) = R2;
81       jump stg_gc_unpt_r1;
82   }
83   Sp_adj(-Words);
84
85   // profiling
86   TICK_ENT_PAP();
87   LDV_ENTER(pap);
88   // Enter PAP cost centre 
89   ENTER_CCS_PAP_CL(pap);
90
91   // Reload the stack 
92   W_ i;
93   W_ p;
94   p = pap + SIZEOF_StgHeader + OFFSET_StgPAP_payload;
95   i = 0;
96 for:
97   if (i < Words) {
98     Sp(i) = W_[p];
99     p = p + WDS(1);
100     i = i + 1;
101     goto for;
102   }
103
104   R1 = StgPAP_fun(pap);
105
106 /* DEBUGGING CODE, ensures that arity 1 and 2 functions are entered tagged
107   if (TO_W_(StgFunInfoExtra_arity(%FUN_INFO(%INFO_PTR(UNTAG(R1))))) == 1 ) {
108     if (GETTAG(R1)!=1) {
109         W_[0]=1;
110     }
111   }
112
113   if (TO_W_(StgFunInfoExtra_arity(%FUN_INFO(%INFO_PTR(UNTAG(R1))))) == 2 ) {
114     if (GETTAG(R1)!=2) {
115         W_[0]=1;
116     }
117   }
118 */
119
120   // Off we go! 
121   TICK_ENT_VIA_NODE();
122
123 #ifdef NO_ARG_REGS
124   jump %GET_ENTRY(UNTAG(R1));
125 #else
126       W_ info;
127       info = %GET_FUN_INFO(UNTAG(R1));
128       W_ type;
129       type = TO_W_(StgFunInfoExtra_fun_type(info));
130       if (type == ARG_GEN) {
131           jump StgFunInfoExtra_slow_apply(info);
132       }
133       if (type == ARG_GEN_BIG) {
134           jump StgFunInfoExtra_slow_apply(info);
135       }
136       if (type == ARG_BCO) {
137           Sp_adj(-2);
138           Sp(1) = R1;
139           Sp(0) = stg_apply_interp_info;
140           jump stg_yield_to_interpreter;
141       }
142       jump W_[stg_ap_stack_entries + 
143                 WDS(TO_W_(StgFunInfoExtra_fun_type(info)))];
144 #endif
145 }
146
147 /* -----------------------------------------------------------------------------
148    Entry Code for an AP (a PAP with arity zero).
149
150    The entry code is very similar to a PAP, except there are no
151    further arguments on the stack to worry about, so the stack check
152    is simpler.  We must also push an update frame on the stack before
153    applying the function.
154    -------------------------------------------------------------------------- */
155
156 INFO_TABLE(stg_AP,/*special layout*/0,0,AP,"AP","AP")
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 _NP 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_NP(WDS(Words) + SIZEOF_StgUpdateFrame);
172
173   PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);
174   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words);
175
176   TICK_ENT_AP();
177   LDV_ENTER(ap);
178
179   // Enter PAP cost centre
180   ENTER_CCS_PAP_CL(ap);   // ToDo: ENTER_CC_AP_CL 
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));
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);
209       }
210       if (type == ARG_GEN_BIG) {
211           jump StgFunInfoExtra_slow_apply(info);
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)))];
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 {
230   W_ Words;
231   W_ ap;
232     
233   ap = R1;
234   
235   Words = TO_W_(StgAP_n_args(ap));
236
237   /* 
238    * Check for stack overflow.  IMPORTANT: use a _NP check here,
239    * because if the check fails, we might end up blackholing this very
240    * closure, in which case we must enter the blackhole on return rather
241    * than continuing to evaluate the now-defunct closure.
242    */
243   STK_CHK_NP(WDS(Words));
244   Sp = Sp - WDS(Words);
245
246   TICK_ENT_AP();
247   LDV_ENTER(ap);
248
249   // Enter PAP cost centre
250   ENTER_CCS_PAP_CL(ap);   // ToDo: ENTER_CC_AP_CL 
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));
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);
279       }
280       if (type == ARG_GEN_BIG) {
281           jump StgFunInfoExtra_slow_apply(info);
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)))];
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 {
307   W_ Words;
308   W_ ap;
309
310   ap = R1;
311   
312   Words = StgAP_STACK_size(ap);
313
314   /* 
315    * Check for stack overflow.  IMPORTANT: use a _NP check here,
316    * because if the check fails, we might end up blackholing this very
317    * closure, in which case we must enter the blackhole on return rather
318    * than continuing to evaluate the now-defunct closure.
319    */
320   STK_CHK_NP(WDS(Words) + SIZEOF_StgUpdateFrame + WDS(AP_STACK_SPLIM));
321   /* ensure there is at least AP_STACK_SPLIM words of headroom available
322    * after unpacking the AP_STACK. See bug #1466 */
323
324   PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);
325   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words);
326
327   TICK_ENT_AP();
328   LDV_ENTER(ap);
329
330   // Enter PAP cost centre
331   ENTER_CCS_PAP_CL(ap);   // ToDo: ENTER_CC_AP_CL 
332
333   // Reload the stack
334   W_ i;
335   W_ p;
336   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_STACK_payload;
337   i = 0;
338 for:
339   if (i < Words) {
340     Sp(i) = W_[p];
341     p = p + WDS(1);
342     i = i + 1;
343     goto for;
344   }
345
346   // Off we go!
347   TICK_ENT_VIA_NODE();
348
349   R1 = StgAP_STACK_fun(ap);
350
351   ENTER();
352 }
353
354 /* -----------------------------------------------------------------------------
355    AP_STACK_NOUPD - exactly like AP_STACK, but doesn't push an update frame.
356    -------------------------------------------------------------------------- */
357
358 INFO_TABLE(stg_AP_STACK_NOUPD,/*special layout*/0,0,AP_STACK,
359                                         "AP_STACK_NOUPD","AP_STACK_NOUPD")
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_NP(WDS(Words) + WDS(AP_STACK_SPLIM));
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
383   // Enter PAP cost centre
384   ENTER_CCS_PAP_CL(ap);   // ToDo: ENTER_CC_AP_CL 
385
386   // Reload the stack
387   W_ i;
388   W_ p;
389   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_STACK_payload;
390   i = 0;
391 for:
392   if (i < Words) {
393     Sp(i) = W_[p];
394     p = p + WDS(1);
395     i = i + 1;
396     goto for;
397   }
398
399   // Off we go!
400   TICK_ENT_VIA_NODE();
401
402   R1 = StgAP_STACK_fun(ap);
403
404   ENTER();
405 }