Fix numa001 failure with "too many NUMA nodes"
[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  *
56  * Note [untag for prof]: when we enter a closure, the convention is
57  * that the closure pointer passed in the first argument is
58  * *untagged*.  Without profiling we don't have to worry about this,
59  * because we never enter a tagged pointer.
60  */
61 #define NEED_EVAL(__x__) 1
62 #else
63 #define NEED_EVAL(__x__) GETTAG(__x__) == 0
64 #endif
65
66 #define SELECTOR_CODE_UPD(offset)                                       \
67   INFO_TABLE_SELECTOR(stg_sel_##offset##_upd, offset, THUNK_SELECTOR, "stg_sel_upd", "stg_sel_upd") \
68       (P_ node)                                                         \
69   {                                                                     \
70       P_ selectee, field, dest;                                         \
71       TICK_ENT_DYN_THK();                                               \
72       STK_CHK_NP(node);                                                 \
73       UPD_BH_UPDATABLE(node);                                           \
74       LDV_ENTER(node);                                                  \
75       selectee = StgThunk_payload(node,0);                              \
76       push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info,CCCS,0,node)) {    \
77         ENTER_CCS_THUNK(node);                                          \
78         if (NEED_EVAL(selectee)) {                                      \
79           SAVE_CCS;                                                     \
80           dest = UNTAG_IF_PROF(selectee); /* Note [untag for prof] */   \
81           (P_ constr) = call %GET_ENTRY(dest) (dest);                   \
82           RESTORE_CCS;                                                  \
83           selectee = constr;                                            \
84         }                                                               \
85         field = StgClosure_payload(UNTAG(selectee),offset);             \
86         jump stg_ap_0_fast(field);                                      \
87      }                                                                  \
88   }
89   /* NOTE: no need to ENTER() here, we know the closure cannot
90      evaluate to a function, because we're going to do a field
91      selection on the result. */
92
93 SELECTOR_CODE_UPD(0)
94 SELECTOR_CODE_UPD(1)
95 SELECTOR_CODE_UPD(2)
96 SELECTOR_CODE_UPD(3)
97 SELECTOR_CODE_UPD(4)
98 SELECTOR_CODE_UPD(5)
99 SELECTOR_CODE_UPD(6)
100 SELECTOR_CODE_UPD(7)
101 SELECTOR_CODE_UPD(8)
102 SELECTOR_CODE_UPD(9)
103 SELECTOR_CODE_UPD(10)
104 SELECTOR_CODE_UPD(11)
105 SELECTOR_CODE_UPD(12)
106 SELECTOR_CODE_UPD(13)
107 SELECTOR_CODE_UPD(14)
108 SELECTOR_CODE_UPD(15)
109
110
111 #define SELECTOR_CODE_NOUPD(offset)                                     \
112   INFO_TABLE_SELECTOR(stg_sel_##offset##_noupd, offset, THUNK_SELECTOR, "stg_sel_noupd", "stg_sel_noupd") \
113       (P_ node)                                                         \
114   {                                                                     \
115       P_ selectee, field, dest;                                         \
116       TICK_ENT_DYN_THK();                                               \
117       STK_CHK_NP(node);                                                 \
118       UPD_BH_UPDATABLE(node);                                           \
119       LDV_ENTER(node);                                                  \
120       selectee = StgThunk_payload(node,0);                              \
121       ENTER_CCS_THUNK(node);                                            \
122       if (NEED_EVAL(selectee)) {                                        \
123           SAVE_CCS;                                                     \
124           dest = UNTAG_IF_PROF(selectee); /* Note [untag for prof] */   \
125           (P_ constr) = call %GET_ENTRY(dest) (dest);                   \
126           RESTORE_CCS;                                                  \
127           selectee = constr;                                            \
128       }                                                                 \
129       field = StgClosure_payload(UNTAG(selectee),offset);               \
130       jump stg_ap_0_fast(field);                                        \
131   }
132
133
134 SELECTOR_CODE_NOUPD(0)
135 SELECTOR_CODE_NOUPD(1)
136 SELECTOR_CODE_NOUPD(2)
137 SELECTOR_CODE_NOUPD(3)
138 SELECTOR_CODE_NOUPD(4)
139 SELECTOR_CODE_NOUPD(5)
140 SELECTOR_CODE_NOUPD(6)
141 SELECTOR_CODE_NOUPD(7)
142 SELECTOR_CODE_NOUPD(8)
143 SELECTOR_CODE_NOUPD(9)
144 SELECTOR_CODE_NOUPD(10)
145 SELECTOR_CODE_NOUPD(11)
146 SELECTOR_CODE_NOUPD(12)
147 SELECTOR_CODE_NOUPD(13)
148 SELECTOR_CODE_NOUPD(14)
149 SELECTOR_CODE_NOUPD(15)
150
151 /* -----------------------------------------------------------------------------
152    Apply thunks
153
154    An apply thunk is a thunk of the form
155
156                 let z = [x1...xn] \u x1...xn
157                 in ...
158
159    We pre-compile some of these because the code is always the same.
160
161    These have to be independent of the update frame size, so the code
162    works when profiling etc.
163    -------------------------------------------------------------------------- */
164
165 /* stg_ap_1_upd_info is a bit redundant, but there appears to be a bug
166  * in the compiler that means stg_ap_1 is generated occasionally (ToDo)
167  */
168
169 INFO_TABLE(stg_ap_1_upd,1,0,THUNK_1_0,"stg_ap_1_upd_info","stg_ap_1_upd_info")
170     (P_ node)
171 {
172     TICK_ENT_DYN_THK();
173     STK_CHK_NP(node);
174     UPD_BH_UPDATABLE(node);
175     LDV_ENTER(node);
176     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
177         ENTER_CCS_THUNK(node);
178         jump stg_ap_0_fast
179             (StgThunk_payload(node,0));
180     }
181 }
182
183 INFO_TABLE(stg_ap_2_upd,2,0,THUNK_2_0,"stg_ap_2_upd_info","stg_ap_2_upd_info")
184     (P_ node)
185 {
186     TICK_ENT_DYN_THK();
187     STK_CHK_NP(node);
188     UPD_BH_UPDATABLE(node);
189     LDV_ENTER(node);
190     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
191         ENTER_CCS_THUNK(node);
192         jump stg_ap_p_fast
193             (StgThunk_payload(node,0),
194              StgThunk_payload(node,1));
195     }
196 }
197
198 INFO_TABLE(stg_ap_3_upd,3,0,THUNK,"stg_ap_3_upd_info","stg_ap_3_upd_info")
199     (P_ node)
200 {
201     TICK_ENT_DYN_THK();
202     STK_CHK_NP(node);
203     UPD_BH_UPDATABLE(node);
204     LDV_ENTER(node);
205     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
206         ENTER_CCS_THUNK(node);
207         jump stg_ap_pp_fast
208             (StgThunk_payload(node,0),
209              StgThunk_payload(node,1),
210              StgThunk_payload(node,2));
211     }
212 }
213
214 INFO_TABLE(stg_ap_4_upd,4,0,THUNK,"stg_ap_4_upd_info","stg_ap_4_upd_info")
215     (P_ node)
216 {
217     TICK_ENT_DYN_THK();
218     STK_CHK_NP(node);
219     UPD_BH_UPDATABLE(node);
220     LDV_ENTER(node);
221     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
222         ENTER_CCS_THUNK(node);
223         jump stg_ap_ppp_fast
224             (StgThunk_payload(node,0),
225              StgThunk_payload(node,1),
226              StgThunk_payload(node,2),
227              StgThunk_payload(node,3));
228     }
229 }
230
231 INFO_TABLE(stg_ap_5_upd,5,0,THUNK,"stg_ap_5_upd_info","stg_ap_5_upd_info")
232     (P_ node)
233 {
234     TICK_ENT_DYN_THK();
235     STK_CHK_NP(node);
236     UPD_BH_UPDATABLE(node);
237     LDV_ENTER(node);
238     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
239         ENTER_CCS_THUNK(node);
240         jump stg_ap_pppp_fast
241             (StgThunk_payload(node,0),
242              StgThunk_payload(node,1),
243              StgThunk_payload(node,2),
244              StgThunk_payload(node,3),
245              StgThunk_payload(node,4));
246     }
247 }
248
249 INFO_TABLE(stg_ap_6_upd,6,0,THUNK,"stg_ap_6_upd_info","stg_ap_6_upd_info")
250     (P_ node)
251 {
252     TICK_ENT_DYN_THK();
253     STK_CHK_NP(node);
254     UPD_BH_UPDATABLE(node);
255     LDV_ENTER(node);
256     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
257         ENTER_CCS_THUNK(node);
258         jump stg_ap_ppppp_fast
259             (StgThunk_payload(node,0),
260              StgThunk_payload(node,1),
261              StgThunk_payload(node,2),
262              StgThunk_payload(node,3),
263              StgThunk_payload(node,4),
264              StgThunk_payload(node,5));
265     }
266 }
267
268 INFO_TABLE(stg_ap_7_upd,7,0,THUNK,"stg_ap_7_upd_info","stg_ap_7_upd_info")
269     (P_ node)
270 {
271     TICK_ENT_DYN_THK();
272     STK_CHK_NP(node);
273     UPD_BH_UPDATABLE(node);
274     LDV_ENTER(node);
275     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
276       ENTER_CCS_THUNK(node);
277       jump stg_ap_pppppp_fast
278           (StgThunk_payload(node,0),
279            StgThunk_payload(node,1),
280            StgThunk_payload(node,2),
281            StgThunk_payload(node,3),
282            StgThunk_payload(node,4),
283            StgThunk_payload(node,5),
284            StgThunk_payload(node,6));
285     }
286 }