1 /* -----------------------------------------------------------------------------
3 * (c) The University of Glasgow, 1998-2004
5 * Canned "Standard Form" Thunks
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.
11 * ---------------------------------------------------------------------------*/
15 /* -----------------------------------------------------------------------------
16 The code for a thunk that simply extracts a field from a
17 single-constructor datatype depends only on the offset of the field
20 Here we define some canned "selector" thunks that do just that; any
21 selector thunk appearing in a program will refer to one of these
22 instead of being compiled independently.
24 The garbage collector spots selector thunks and reduces them if
25 possible, in order to avoid space leaks resulting from lazy pattern
27 -------------------------------------------------------------------------- */
29 #define WITHUPD_FRAME_SIZE (SIZEOF_StgUpdateFrame + SIZEOF_StgHeader)
30 #define NOUPD_FRAME_SIZE (SIZEOF_StgHeader)
33 #define SAVE_CCCS(fs) StgHeader_ccs(Sp-fs) = W_[CCCS]
34 #define GET_SAVED_CCCS W_[CCCS] = StgHeader_ccs(Sp)
35 #define RET_PARAMS W_ unused1, W_ unused2
37 #define SAVE_CCCS(fs) /* empty */
38 #define GET_SAVED_CCCS /* empty */
43 * TODO: On return, we can use a more efficient
44 * untagging (we know the constructor tag).
46 * When entering stg_sel_#_upd, we know R1 points to its closure,
48 * The payload might be a thunk or a constructor,
51 * When returning, we know for sure it is a constructor,
52 * so we untag it before accessing the field.
56 // When profiling, we cannot shortcut by checking the tag,
57 // because LDV profiling relies on entering closures to mark them as
59 #define SEL_ENTER(offset) \
63 #define SEL_ENTER(offset) \
64 if (GETTAG(R1) != 0) { \
65 jump RET_LBL(stg_sel_ret_##offset##_upd); \
70 #define SELECTOR_CODE_UPD(offset) \
71 INFO_TABLE_RET(stg_sel_ret_##offset##_upd, RET_SMALL, RET_PARAMS) \
73 R1 = StgClosure_payload(UNTAG(R1),offset); \
75 Sp = Sp + SIZEOF_StgHeader; \
79 INFO_TABLE_SELECTOR(stg_sel_##offset##_upd, offset, THUNK_SELECTOR, "stg_sel_upd", "stg_sel_upd") \
82 STK_CHK_NP(WITHUPD_FRAME_SIZE); \
85 PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1); \
86 ENTER_CCS_THUNK(R1); \
87 SAVE_CCCS(WITHUPD_FRAME_SIZE); \
88 W_[Sp-WITHUPD_FRAME_SIZE] = stg_sel_ret_##offset##_upd_info; \
89 Sp = Sp - WITHUPD_FRAME_SIZE; \
90 R1 = StgThunk_payload(R1,0); \
93 /* NOTE: no need to ENTER() here, we know the closure cannot evaluate to a function,
94 because we're going to do a field selection on the result. */
106 SELECTOR_CODE_UPD(10)
107 SELECTOR_CODE_UPD(11)
108 SELECTOR_CODE_UPD(12)
109 SELECTOR_CODE_UPD(13)
110 SELECTOR_CODE_UPD(14)
111 SELECTOR_CODE_UPD(15)
113 #define SELECTOR_CODE_NOUPD(offset) \
114 INFO_TABLE_RET(stg_sel_ret_##offset##_noupd, RET_SMALL, RET_PARAMS) \
116 R1 = StgClosure_payload(UNTAG(R1),offset); \
118 Sp = Sp + SIZEOF_StgHeader; \
122 INFO_TABLE_SELECTOR(stg_sel_##offset##_noupd, offset, THUNK_SELECTOR, "stg_sel_noupd", "stg_sel_noupd")\
124 TICK_ENT_DYN_THK(); \
125 STK_CHK_NP(NOUPD_FRAME_SIZE); \
126 UPD_BH_SINGLE_ENTRY(); \
128 TICK_UPDF_OMITTED(); \
129 ENTER_CCS_THUNK(R1); \
130 SAVE_CCCS(NOUPD_FRAME_SIZE); \
131 W_[Sp-NOUPD_FRAME_SIZE] = stg_sel_ret_##offset##_noupd_info; \
132 Sp = Sp - NOUPD_FRAME_SIZE; \
133 R1 = StgThunk_payload(R1,0); \
134 if (GETTAG(R1) != 0) { \
135 jump RET_LBL(stg_sel_ret_##offset##_noupd); \
137 jump %GET_ENTRY(R1); \
140 SELECTOR_CODE_NOUPD(0)
141 SELECTOR_CODE_NOUPD(1)
142 SELECTOR_CODE_NOUPD(2)
143 SELECTOR_CODE_NOUPD(3)
144 SELECTOR_CODE_NOUPD(4)
145 SELECTOR_CODE_NOUPD(5)
146 SELECTOR_CODE_NOUPD(6)
147 SELECTOR_CODE_NOUPD(7)
148 SELECTOR_CODE_NOUPD(8)
149 SELECTOR_CODE_NOUPD(9)
150 SELECTOR_CODE_NOUPD(10)
151 SELECTOR_CODE_NOUPD(11)
152 SELECTOR_CODE_NOUPD(12)
153 SELECTOR_CODE_NOUPD(13)
154 SELECTOR_CODE_NOUPD(14)
155 SELECTOR_CODE_NOUPD(15)
157 /* -----------------------------------------------------------------------------
160 An apply thunk is a thunk of the form
162 let z = [x1...xn] \u x1...xn
165 We pre-compile some of these because the code is always the same.
167 These have to be independent of the update frame size, so the code
168 works when profiling etc.
169 -------------------------------------------------------------------------- */
171 /* stg_ap_1_upd_info is a bit redundant, but there appears to be a bug
172 * in the compiler that means stg_ap_1 is generated occasionally (ToDo)
175 INFO_TABLE(stg_ap_1_upd,1,0,THUNK_1_0,"stg_ap_1_upd_info","stg_ap_1_upd_info")
178 STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(1));
182 PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
183 R1 = StgThunk_payload(R1,0);
184 Sp = Sp - SIZEOF_StgUpdateFrame;
188 INFO_TABLE(stg_ap_2_upd,2,0,THUNK_2_0,"stg_ap_2_upd_info","stg_ap_2_upd_info")
191 STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(2));
195 PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
196 W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,1);
197 R1 = StgThunk_payload(R1,0);
198 Sp = Sp - SIZEOF_StgUpdateFrame - WDS(1);
199 Sp_adj(-1); // for stg_ap_*_ret
202 jump RET_LBL(stg_ap_p);
205 INFO_TABLE(stg_ap_3_upd,3,0,THUNK,"stg_ap_3_upd_info","stg_ap_3_upd_info")
208 STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(3));
212 PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
213 W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,2);
214 W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,1);
215 R1 = StgThunk_payload(R1,0);
216 Sp = Sp - SIZEOF_StgUpdateFrame - WDS(2);
217 Sp_adj(-1); // for stg_ap_*_ret
220 jump RET_LBL(stg_ap_pp);
223 INFO_TABLE(stg_ap_4_upd,4,0,THUNK,"stg_ap_4_upd_info","stg_ap_4_upd_info")
226 STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(4));
230 PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
231 W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,3);
232 W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,2);
233 W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,1);
234 R1 = StgThunk_payload(R1,0);
235 Sp = Sp - SIZEOF_StgUpdateFrame - WDS(3);
236 Sp_adj(-1); // for stg_ap_*_ret
238 TICK_SLOW_CALL_ppp();
239 jump RET_LBL(stg_ap_ppp);
242 INFO_TABLE(stg_ap_5_upd,5,0,THUNK,"stg_ap_5_upd_info","stg_ap_5_upd_info")
245 STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(5));
249 PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
250 W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,4);
251 W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,3);
252 W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,2);
253 W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgThunk_payload(R1,1);
254 R1 = StgThunk_payload(R1,0);
255 Sp = Sp - SIZEOF_StgUpdateFrame - WDS(4);
256 Sp_adj(-1); // for stg_ap_*_ret
258 TICK_SLOW_CALL_pppp();
259 jump RET_LBL(stg_ap_pppp);
262 INFO_TABLE(stg_ap_6_upd,6,0,THUNK,"stg_ap_6_upd_info","stg_ap_6_upd_info")
265 STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(6));
269 PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
270 W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,5);
271 W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,4);
272 W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,3);
273 W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgThunk_payload(R1,2);
274 W_[Sp-SIZEOF_StgUpdateFrame-WDS(5)] = StgThunk_payload(R1,1);
275 R1 = StgThunk_payload(R1,0);
276 Sp = Sp - SIZEOF_StgUpdateFrame - WDS(5);
277 Sp_adj(-1); // for stg_ap_*_ret
279 TICK_SLOW_CALL_ppppp();
280 jump RET_LBL(stg_ap_ppppp);
283 INFO_TABLE(stg_ap_7_upd,7,0,THUNK,"stg_ap_7_upd_info","stg_ap_7_upd_info")
286 STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(7));
290 PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
291 W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,6);
292 W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,5);
293 W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,4);
294 W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgThunk_payload(R1,3);
295 W_[Sp-SIZEOF_StgUpdateFrame-WDS(5)] = StgThunk_payload(R1,2);
296 W_[Sp-SIZEOF_StgUpdateFrame-WDS(6)] = StgThunk_payload(R1,1);
297 R1 = StgThunk_payload(R1,0);
298 Sp = Sp - SIZEOF_StgUpdateFrame - WDS(6);
299 Sp_adj(-1); // for stg_ap_*_ret
301 TICK_SLOW_CALL_pppppp();
302 jump RET_LBL(stg_ap_pppppp);