Eliminate atomic_inc_by and instead medofiy atomic_inc.
[ghc.git] / rts / StgStdThunks.cmm
1 /* -----------------------------------------------------------------------------
2  *
3  * (c) The University of Glasgow, 1998-2004
4  *
5  * Canned "Standard Form" Thunks
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 #include "Updates.h"
15
16 /* -----------------------------------------------------------------------------
17    The code for a thunk that simply extracts a field from a
18    single-constructor datatype depends only on the offset of the field
19    to be selected.
20
21    Here we define some canned "selector" thunks that do just that; any
22    selector thunk appearing in a program will refer to one of these
23    instead of being compiled independently.
24
25    The garbage collector spots selector thunks and reduces them if
26    possible, in order to avoid space leaks resulting from lazy pattern
27    matching.
28    -------------------------------------------------------------------------- */
29
30 #ifdef PROFILING
31 #define SAVE_CCS        W_ saved_ccs; saved_ccs = CCCS;
32 #define RESTORE_CCS     CCCS = saved_ccs;
33 #else
34 #define SAVE_CCS        /* nothing */
35 #define RESTORE_CCS     /* nothing */
36 #endif
37
38 /*
39  * TODO: On return, we can use a more efficient
40  *       untagging (we know the constructor tag).
41  * 
42  * When entering stg_sel_#_upd, we know R1 points to its closure,
43  * so it's untagged.
44  * The payload might be a thunk or a constructor,
45  * so we enter it.
46  *
47  * When returning, we know for sure it is a constructor,
48  * so we untag it before accessing the field.
49  *
50  */
51 #ifdef PROFILING
52 // When profiling, we cannot shortcut by checking the tag,
53 // because LDV profiling relies on entering closures to mark them as
54 // "used".
55 #define NEED_EVAL(__x__) 1
56 #else
57 #define NEED_EVAL(__x__) GETTAG(__x__) == 0
58 #endif
59
60 #define SELECTOR_CODE_UPD(offset)                                       \
61   INFO_TABLE_SELECTOR(stg_sel_##offset##_upd, offset, THUNK_SELECTOR, "stg_sel_upd", "stg_sel_upd") \
62       (P_ node)                                                         \
63   {                                                                     \
64       P_ selectee, field;                                               \
65       TICK_ENT_DYN_THK();                                               \
66       STK_CHK_NP(node);                                                 \
67       UPD_BH_UPDATABLE(node);                                           \
68       LDV_ENTER(node);                                                  \
69       selectee = StgThunk_payload(node,0);                              \
70       push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info,CCCS,0,node)) {    \
71         ENTER_CCS_THUNK(node);                                          \
72         if (NEED_EVAL(selectee)) {                                      \
73           SAVE_CCS;                                                     \
74           (P_ constr) = call %GET_ENTRY(UNTAG_IF_PROF(selectee)) (selectee); \
75           RESTORE_CCS;                                                  \
76           selectee = constr;                                            \
77         }                                                               \
78         field = StgClosure_payload(UNTAG(selectee),offset);             \
79         jump stg_ap_0_fast(field);                                      \
80      }                                                                  \
81   }
82   /* NOTE: no need to ENTER() here, we know the closure cannot
83      evaluate to a function, because we're going to do a field
84      selection on the result. */
85
86 SELECTOR_CODE_UPD(0)
87 SELECTOR_CODE_UPD(1)
88 SELECTOR_CODE_UPD(2)
89 SELECTOR_CODE_UPD(3)
90 SELECTOR_CODE_UPD(4)
91 SELECTOR_CODE_UPD(5)
92 SELECTOR_CODE_UPD(6)
93 SELECTOR_CODE_UPD(7)
94 SELECTOR_CODE_UPD(8)
95 SELECTOR_CODE_UPD(9)
96 SELECTOR_CODE_UPD(10)
97 SELECTOR_CODE_UPD(11)
98 SELECTOR_CODE_UPD(12)
99 SELECTOR_CODE_UPD(13)
100 SELECTOR_CODE_UPD(14)
101 SELECTOR_CODE_UPD(15)
102
103
104 #define SELECTOR_CODE_NOUPD(offset)                                     \
105   INFO_TABLE_SELECTOR(stg_sel_##offset##_noupd, offset, THUNK_SELECTOR, "stg_sel_noupd", "stg_sel_noupd") \
106       (P_ node)                                                         \
107   {                                                                     \
108       P_ selectee, field;                                               \
109       TICK_ENT_DYN_THK();                                               \
110       STK_CHK_NP(node);                                                 \
111       UPD_BH_UPDATABLE(node);                                           \
112       LDV_ENTER(node);                                                  \
113       selectee = StgThunk_payload(node,0);                              \
114       ENTER_CCS_THUNK(node);                                            \
115       if (NEED_EVAL(selectee)) {                                        \
116           SAVE_CCS;                                                     \
117           (P_ constr) = call %GET_ENTRY(UNTAG_IF_PROF(selectee)) (selectee);           \
118           RESTORE_CCS;                                                  \
119           selectee = constr;                                            \
120       }                                                                 \
121       field = StgClosure_payload(UNTAG(selectee),offset);               \
122       jump stg_ap_0_fast(field);                                        \
123   }
124
125
126 SELECTOR_CODE_NOUPD(0)
127 SELECTOR_CODE_NOUPD(1)
128 SELECTOR_CODE_NOUPD(2)
129 SELECTOR_CODE_NOUPD(3)
130 SELECTOR_CODE_NOUPD(4)
131 SELECTOR_CODE_NOUPD(5)
132 SELECTOR_CODE_NOUPD(6)
133 SELECTOR_CODE_NOUPD(7)
134 SELECTOR_CODE_NOUPD(8)
135 SELECTOR_CODE_NOUPD(9)
136 SELECTOR_CODE_NOUPD(10)
137 SELECTOR_CODE_NOUPD(11)
138 SELECTOR_CODE_NOUPD(12)
139 SELECTOR_CODE_NOUPD(13)
140 SELECTOR_CODE_NOUPD(14)
141 SELECTOR_CODE_NOUPD(15)
142
143 /* -----------------------------------------------------------------------------
144    Apply thunks
145
146    An apply thunk is a thunk of the form
147         
148                 let z = [x1...xn] \u x1...xn
149                 in ...
150
151    We pre-compile some of these because the code is always the same.
152
153    These have to be independent of the update frame size, so the code
154    works when profiling etc.
155    -------------------------------------------------------------------------- */
156
157 /* stg_ap_1_upd_info is a bit redundant, but there appears to be a bug
158  * in the compiler that means stg_ap_1 is generated occasionally (ToDo)
159  */
160
161 INFO_TABLE(stg_ap_1_upd,1,0,THUNK_1_0,"stg_ap_1_upd_info","stg_ap_1_upd_info")
162     (P_ node)
163 {
164     TICK_ENT_DYN_THK();
165     STK_CHK_NP(node);
166     UPD_BH_UPDATABLE(node);
167     LDV_ENTER(node);
168     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
169         ENTER_CCS_THUNK(node);
170         jump stg_ap_0_fast
171             (StgThunk_payload(node,0));
172     }
173 }
174
175 INFO_TABLE(stg_ap_2_upd,2,0,THUNK_2_0,"stg_ap_2_upd_info","stg_ap_2_upd_info")
176     (P_ node)
177 {
178     TICK_ENT_DYN_THK();
179     STK_CHK_NP(node);
180     UPD_BH_UPDATABLE(node);
181     LDV_ENTER(node);
182     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
183         ENTER_CCS_THUNK(node);
184         jump stg_ap_p_fast
185             (StgThunk_payload(node,0),
186              StgThunk_payload(node,1));
187     }
188 }
189
190 INFO_TABLE(stg_ap_3_upd,3,0,THUNK,"stg_ap_3_upd_info","stg_ap_3_upd_info")
191     (P_ node)
192 {
193     TICK_ENT_DYN_THK();
194     STK_CHK_NP(node);
195     UPD_BH_UPDATABLE(node);
196     LDV_ENTER(node);
197     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
198         ENTER_CCS_THUNK(node);
199         jump stg_ap_pp_fast
200             (StgThunk_payload(node,0),
201              StgThunk_payload(node,1),
202              StgThunk_payload(node,2));
203     }
204 }
205
206 INFO_TABLE(stg_ap_4_upd,4,0,THUNK,"stg_ap_4_upd_info","stg_ap_4_upd_info")
207     (P_ node)
208 {
209     TICK_ENT_DYN_THK();
210     STK_CHK_NP(node);
211     UPD_BH_UPDATABLE(node);
212     LDV_ENTER(node);
213     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
214         ENTER_CCS_THUNK(node);
215         jump stg_ap_ppp_fast
216             (StgThunk_payload(node,0),
217              StgThunk_payload(node,1),
218              StgThunk_payload(node,2),
219              StgThunk_payload(node,3));
220     }
221 }
222
223 INFO_TABLE(stg_ap_5_upd,5,0,THUNK,"stg_ap_5_upd_info","stg_ap_5_upd_info")
224     (P_ node)
225 {
226     TICK_ENT_DYN_THK();
227     STK_CHK_NP(node);
228     UPD_BH_UPDATABLE(node);
229     LDV_ENTER(node);
230     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
231         ENTER_CCS_THUNK(node);
232         jump stg_ap_pppp_fast
233             (StgThunk_payload(node,0),
234              StgThunk_payload(node,1),
235              StgThunk_payload(node,2),
236              StgThunk_payload(node,3),
237              StgThunk_payload(node,4));
238     }
239 }
240
241 INFO_TABLE(stg_ap_6_upd,6,0,THUNK,"stg_ap_6_upd_info","stg_ap_6_upd_info")
242     (P_ node)
243 {
244     TICK_ENT_DYN_THK();
245     STK_CHK_NP(node);
246     UPD_BH_UPDATABLE(node);
247     LDV_ENTER(node);
248     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
249         ENTER_CCS_THUNK(node);
250         jump stg_ap_ppppp_fast
251             (StgThunk_payload(node,0),
252              StgThunk_payload(node,1),
253              StgThunk_payload(node,2),
254              StgThunk_payload(node,3),
255              StgThunk_payload(node,4),
256              StgThunk_payload(node,5));
257     }
258 }
259
260 INFO_TABLE(stg_ap_7_upd,7,0,THUNK,"stg_ap_7_upd_info","stg_ap_7_upd_info")
261     (P_ node)
262 {
263     TICK_ENT_DYN_THK();
264     STK_CHK_NP(node);
265     UPD_BH_UPDATABLE(node);
266     LDV_ENTER(node);
267     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
268       ENTER_CCS_THUNK(node);
269       jump stg_ap_pppppp_fast
270           (StgThunk_payload(node,0),
271            StgThunk_payload(node,1),
272            StgThunk_payload(node,2),
273            StgThunk_payload(node,3),
274            StgThunk_payload(node,4),
275            StgThunk_payload(node,5),
276            StgThunk_payload(node,6));
277     }
278 }