Be more specific about file-header pragmas
[ghc-hetmet.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" checkStackChunk(Sp "ptr",
34                                     CurrentTSO + TSO_OFFSET_StgTSO_stack +
35                                     WDS(TO_W_(StgTSO_stack_size(CurrentTSO))) "ptr") [R1]);
36
37     ENTER();
38 }
39
40 /* -----------------------------------------------------------------------------
41    Entry Code for a PAP.
42
43    This entry code is *only* called by one of the stg_ap functions.
44    On entry: Sp points to the remaining arguments on the stack.  If
45    the stack check fails, we can just push the PAP on the stack and
46    return to the scheduler.
47
48    On entry: R1 points to the PAP.  The rest of the function's
49    arguments (apart from those that are already in the PAP) are on the
50    stack, starting at Sp(0).  R2 contains an info table which
51    describes these arguments, which is used in the event that the
52    stack check in the entry code below fails.  The info table is
53    currently one of the stg_ap_*_ret family, as this code is always
54    entered from those functions.
55
56    The idea is to copy the chunk of stack from the PAP object onto the
57    stack / into registers, and enter the function.
58    -------------------------------------------------------------------------- */
59
60 INFO_TABLE(stg_PAP,/*special layout*/0,0,PAP,"PAP","PAP")
61 {  foreign "C" barf("PAP object entered!") never returns; }
62     
63 stg_PAP_apply
64 {
65   W_ Words;
66   W_ pap;
67     
68   pap = R1;
69
70   Words = TO_W_(StgPAP_n_args(pap));
71
72   //
73   // Check for stack overflow and bump the stack pointer.
74   // We have a hand-rolled stack check fragment here, because none of
75   // the canned ones suit this situation.
76   //
77   if ((Sp - WDS(Words)) < SpLim) {
78       // there is a return address in R2 in the event of a
79       // stack check failure.  The various stg_apply functions arrange
80       // this before calling stg_PAP_entry.
81       Sp_adj(-1); 
82       Sp(0) = R2;
83       jump stg_gc_unpt_r1;
84   }
85   Sp_adj(-Words);
86
87   // profiling
88   TICK_ENT_PAP();
89   LDV_ENTER(pap);
90   // Enter PAP cost centre 
91   ENTER_CCS_PAP_CL(pap);
92
93   // Reload the stack 
94   W_ i;
95   W_ p;
96   p = pap + SIZEOF_StgHeader + OFFSET_StgPAP_payload;
97   i = 0;
98 for:
99   if (i < Words) {
100     Sp(i) = W_[p];
101     p = p + WDS(1);
102     i = i + 1;
103     goto for;
104   }
105
106   R1 = StgPAP_fun(pap);
107
108 /* DEBUGGING CODE, ensures that arity 1 and 2 functions are entered tagged
109   if (TO_W_(StgFunInfoExtra_arity(%FUN_INFO(%INFO_PTR(UNTAG(R1))))) == 1 ) {
110     if (GETTAG(R1)!=1) {
111         W_[0]=1;
112     }
113   }
114
115   if (TO_W_(StgFunInfoExtra_arity(%FUN_INFO(%INFO_PTR(UNTAG(R1))))) == 2 ) {
116     if (GETTAG(R1)!=2) {
117         W_[0]=1;
118     }
119   }
120 */
121
122   // Off we go! 
123   TICK_ENT_VIA_NODE();
124
125 #ifdef NO_ARG_REGS
126   jump %GET_ENTRY(UNTAG(R1));
127 #else
128       W_ info;
129       info = %GET_FUN_INFO(UNTAG(R1));
130       W_ type;
131       type = TO_W_(StgFunInfoExtra_fun_type(info));
132       if (type == ARG_GEN) {
133           jump StgFunInfoExtra_slow_apply(info);
134       }
135       if (type == ARG_GEN_BIG) {
136           jump StgFunInfoExtra_slow_apply(info);
137       }
138       if (type == ARG_BCO) {
139           Sp_adj(-2);
140           Sp(1) = R1;
141           Sp(0) = stg_apply_interp_info;
142           jump stg_yield_to_interpreter;
143       }
144       jump W_[stg_ap_stack_entries + 
145                 WDS(TO_W_(StgFunInfoExtra_fun_type(info)))];
146 #endif
147 }
148
149 /* -----------------------------------------------------------------------------
150    Entry Code for an AP (a PAP with arity zero).
151
152    The entry code is very similar to a PAP, except there are no
153    further arguments on the stack to worry about, so the stack check
154    is simpler.  We must also push an update frame on the stack before
155    applying the function.
156    -------------------------------------------------------------------------- */
157
158 INFO_TABLE(stg_AP,/*special layout*/0,0,AP,"AP","AP")
159 {
160   W_ Words;
161   W_ ap;
162     
163   ap = R1;
164   
165   Words = TO_W_(StgAP_n_args(ap));
166
167   /* 
168    * Check for stack overflow.  IMPORTANT: use a _NP check here,
169    * because if the check fails, we might end up blackholing this very
170    * closure, in which case we must enter the blackhole on return rather
171    * than continuing to evaluate the now-defunct closure.
172    */
173   STK_CHK_NP(WDS(Words) + SIZEOF_StgUpdateFrame);
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
181   // Enter PAP cost centre
182   ENTER_CCS_PAP_CL(ap);   // ToDo: ENTER_CC_AP_CL 
183
184   // Reload the stack 
185   W_ i;
186   W_ p;
187   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_payload;
188   i = 0;
189 for:
190   if (i < Words) {
191     Sp(i) = W_[p];
192     p = p + WDS(1);
193     i = i + 1;
194     goto for;
195   }
196
197   R1 = StgAP_fun(ap);
198
199   // Off we go! 
200   TICK_ENT_VIA_NODE();
201
202 #ifdef NO_ARG_REGS
203   jump %GET_ENTRY(UNTAG(R1));
204 #else
205       W_ info;
206       info = %GET_FUN_INFO(UNTAG(R1));
207       W_ type;
208       type = TO_W_(StgFunInfoExtra_fun_type(info));
209       if (type == ARG_GEN) {
210           jump StgFunInfoExtra_slow_apply(info);
211       }
212       if (type == ARG_GEN_BIG) {
213           jump StgFunInfoExtra_slow_apply(info);
214       }
215       if (type == ARG_BCO) {
216           Sp_adj(-2);
217           Sp(1) = R1;
218           Sp(0) = stg_apply_interp_info;
219           jump stg_yield_to_interpreter;
220       }
221       jump W_[stg_ap_stack_entries + 
222                 WDS(TO_W_(StgFunInfoExtra_fun_type(info)))];
223 #endif
224 }
225
226 /* -----------------------------------------------------------------------------
227    Entry Code for an AP_STACK.
228
229    Very similar to a PAP and AP.  The layout is the same as PAP
230    and AP, except that the payload is a chunk of stack instead of
231    being described by the function's info table.  Like an AP,
232    there are no further arguments on the stack to worry about.
233    However, the function closure (ap->fun) does not necessarily point
234    directly to a function, so we have to enter it using stg_ap_0.
235    -------------------------------------------------------------------------- */
236
237 INFO_TABLE(stg_AP_STACK,/*special layout*/0,0,AP_STACK,"AP_STACK","AP_STACK")
238 {
239   W_ Words;
240   W_ ap;
241
242   ap = R1;
243   
244   Words = StgAP_STACK_size(ap);
245
246   /* 
247    * Check for stack overflow.  IMPORTANT: use a _NP check here,
248    * because if the check fails, we might end up blackholing this very
249    * closure, in which case we must enter the blackhole on return rather
250    * than continuing to evaluate the now-defunct closure.
251    */
252   STK_CHK_NP(WDS(Words) + SIZEOF_StgUpdateFrame + WDS(AP_STACK_SPLIM));
253   /* ensure there is at least AP_STACK_SPLIM words of headroom available
254    * after unpacking the AP_STACK. See bug #1466 */
255
256   PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);
257   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words);
258
259   TICK_ENT_AP();
260   LDV_ENTER(ap);
261
262   // Enter PAP cost centre
263   ENTER_CCS_PAP_CL(ap);   // ToDo: ENTER_CC_AP_CL 
264
265   // Reload the stack
266   W_ i;
267   W_ p;
268   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_STACK_payload;
269   i = 0;
270 for:
271   if (i < Words) {
272     Sp(i) = W_[p];
273     p = p + WDS(1);
274     i = i + 1;
275     goto for;
276   }
277
278   // Off we go!
279   TICK_ENT_VIA_NODE();
280
281   R1 = StgAP_STACK_fun(ap);
282
283   ENTER();
284 }