Add warning comment about Mach-O section name hack.
[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)) < 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) + SIZEOF_StgUpdateFrame, R1);
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   ENTER_CCS_THUNK(ap);
179
180   // Reload the stack
181   W_ i;
182   W_ p;
183   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_payload;
184   i = 0;
185 for:
186   if (i < Words) {
187     Sp(i) = W_[p];
188     p = p + WDS(1);
189     i = i + 1;
190     goto for;
191   }
192
193   R1 = StgAP_fun(ap);
194
195   // Off we go! 
196   TICK_ENT_VIA_NODE();
197
198 #ifdef NO_ARG_REGS
199   jump %GET_ENTRY(UNTAG(R1)) [R1];
200 #else
201       W_ info;
202       info = %GET_FUN_INFO(UNTAG(R1));
203       W_ type;
204       type = TO_W_(StgFunInfoExtra_fun_type(info));
205       if (type == ARG_GEN) {
206           jump StgFunInfoExtra_slow_apply(info) [R1];
207       }
208       if (type == ARG_GEN_BIG) {
209           jump StgFunInfoExtra_slow_apply(info) [R1];
210       }
211       if (type == ARG_BCO) {
212           Sp_adj(-2);
213           Sp(1) = R1;
214           Sp(0) = stg_apply_interp_info;
215           jump stg_yield_to_interpreter [];
216       }
217       jump W_[stg_ap_stack_entries + 
218                 WDS(TO_W_(StgFunInfoExtra_fun_type(info)))] [R1];
219 #endif
220 }
221
222 /* AP_NOUPD is exactly like AP, except that no update frame is pushed.
223    Use for thunks that are guaranteed to be entered once only, such as 
224    those generated by the byte-code compiler for inserting breakpoints. */
225
226 INFO_TABLE(stg_AP_NOUPD,/*special layout*/0,0,AP,"AP_NOUPD","AP_NOUPD")
227    /* no args => explicit stack */
228 {
229   W_ Words;
230   W_ ap;
231     
232   ap = R1;
233   
234   Words = TO_W_(StgAP_n_args(ap));
235
236   /* 
237    * Check for stack overflow.  IMPORTANT: use a _ENTER check here,
238    * because if the check fails, we might end up blackholing this very
239    * closure, in which case we must enter the blackhole on return rather
240    * than continuing to evaluate the now-defunct closure.
241    */
242   STK_CHK_ENTER(WDS(Words), R1);
243   Sp = Sp - WDS(Words);
244
245   TICK_ENT_AP();
246   LDV_ENTER(ap);
247   ENTER_CCS_THUNK(ap);
248
249   // Reload the stack
250   W_ i;
251   W_ p;
252   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_payload;
253   i = 0;
254 for:
255   if (i < Words) {
256     Sp(i) = W_[p];
257     p = p + WDS(1);
258     i = i + 1;
259     goto for;
260   }
261
262   R1 = StgAP_fun(ap);
263
264   // Off we go! 
265   TICK_ENT_VIA_NODE();
266
267 #ifdef NO_ARG_REGS
268   jump %GET_ENTRY(UNTAG(R1)) [R1];
269 #else
270       W_ info;
271       info = %GET_FUN_INFO(UNTAG(R1));
272       W_ type;
273       type = TO_W_(StgFunInfoExtra_fun_type(info));
274       if (type == ARG_GEN) {
275           jump StgFunInfoExtra_slow_apply(info) [R1];
276       }
277       if (type == ARG_GEN_BIG) {
278           jump StgFunInfoExtra_slow_apply(info) [R1];
279       }
280       if (type == ARG_BCO) {
281           Sp_adj(-2);
282           Sp(1) = R1;
283           Sp(0) = stg_apply_interp_info;
284           jump stg_yield_to_interpreter [];
285       }
286       jump W_[stg_ap_stack_entries + 
287                 WDS(TO_W_(StgFunInfoExtra_fun_type(info)))] [R1];
288 #endif
289 }
290
291 /* -----------------------------------------------------------------------------
292    Entry Code for an AP_STACK.
293
294    Very similar to a PAP and AP.  The layout is the same as PAP
295    and AP, except that the payload is a chunk of stack instead of
296    being described by the function's info table.  Like an AP,
297    there are no further arguments on the stack to worry about.
298    However, the function closure (ap->fun) does not necessarily point
299    directly to a function, so we have to enter it using stg_ap_0.
300    -------------------------------------------------------------------------- */
301
302 INFO_TABLE(stg_AP_STACK,/*special layout*/0,0,AP_STACK,"AP_STACK","AP_STACK")
303   /* no args => explicit stack */
304 {
305   W_ Words;
306   W_ ap;
307
308   ap = R1;
309   
310   Words = StgAP_STACK_size(ap);
311
312   /* 
313    * Check for stack overflow.  IMPORTANT: use a _ENTER check here,
314    * because if the check fails, we might end up blackholing this very
315    * closure, in which case we must enter the blackhole on return rather
316    * than continuing to evaluate the now-defunct closure.
317    */
318   STK_CHK_ENTER(WDS(Words) + SIZEOF_StgUpdateFrame + WDS(AP_STACK_SPLIM), R1);
319   /* ensure there is at least AP_STACK_SPLIM words of headroom available
320    * after unpacking the AP_STACK. See bug #1466 */
321
322   PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);
323   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words);
324
325   TICK_ENT_AP();
326   LDV_ENTER(ap);
327   ENTER_CCS_THUNK(ap);
328
329   // Reload the stack
330   W_ i;
331   W_ p;
332   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_STACK_payload;
333   i = 0;
334 for:
335   if (i < Words) {
336     Sp(i) = W_[p];
337     p = p + WDS(1);
338     i = i + 1;
339     goto for;
340   }
341
342   // Off we go!
343   TICK_ENT_VIA_NODE();
344
345   R1 = StgAP_STACK_fun(ap);
346
347   ENTER_R1();
348 }
349
350 /* -----------------------------------------------------------------------------
351    AP_STACK_NOUPD - exactly like AP_STACK, but doesn't push an update frame.
352    -------------------------------------------------------------------------- */
353
354 INFO_TABLE(stg_AP_STACK_NOUPD,/*special layout*/0,0,AP_STACK,
355                                         "AP_STACK_NOUPD","AP_STACK_NOUPD")
356    /* no args => explicit stack */
357 {
358   W_ Words;
359   W_ ap;
360
361   ap = R1;
362   
363   Words = StgAP_STACK_size(ap);
364
365   /* 
366    * Check for stack overflow.  IMPORTANT: use a _NP check here,
367    * because if the check fails, we might end up blackholing this very
368    * closure, in which case we must enter the blackhole on return rather
369    * than continuing to evaluate the now-defunct closure.
370    */
371   STK_CHK_ENTER(WDS(Words) + WDS(AP_STACK_SPLIM), R1);
372   /* ensure there is at least AP_STACK_SPLIM words of headroom available
373    * after unpacking the AP_STACK. See bug #1466 */
374
375   Sp = Sp - WDS(Words);
376
377   TICK_ENT_AP();
378   LDV_ENTER(ap);
379   ENTER_CCS_THUNK(ap);
380
381   // Reload the stack
382   W_ i;
383   W_ p;
384   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_STACK_payload;
385   i = 0;
386 for:
387   if (i < Words) {
388     Sp(i) = W_[p];
389     p = p + WDS(1);
390     i = i + 1;
391     goto for;
392   }
393
394   // Off we go!
395   TICK_ENT_VIA_NODE();
396
397   R1 = StgAP_STACK_fun(ap);
398
399   ENTER_R1();
400 }