Add several new record features
[ghc-hetmet.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
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
18    to be selected.
19
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.
23
24    The garbage collector spots selector thunks and reduces them if
25    possible, in order to avoid space leaks resulting from lazy pattern
26    matching.
27    -------------------------------------------------------------------------- */
28
29 #define WITHUPD_FRAME_SIZE  (SIZEOF_StgUpdateFrame + SIZEOF_StgHeader)
30 #define NOUPD_FRAME_SIZE    (SIZEOF_StgHeader)
31
32 #ifdef PROFILING
33 #define SAVE_CCCS(fs)   StgHeader_ccs(Sp-fs) = W_[CCCS]
34 #define GET_SAVED_CCCS  W_[CCCS] = StgHeader_ccs(Sp)
35 #define RET_BITMAP    3
36 #define RET_FRAMESIZE 2
37 #else
38 #define SAVE_CCCS(fs)   /* empty */
39 #define GET_SAVED_CCCS  /* empty */
40 #define RET_BITMAP    0
41 #define RET_FRAMESIZE 0
42 #endif
43
44 #define SELECTOR_CODE_UPD(offset) \
45   INFO_TABLE_RET(stg_sel_ret_##offset##_upd, RET_FRAMESIZE, RET_BITMAP, RET_SMALL)      \
46   {                                                                     \
47       R1 = StgClosure_payload(R1,offset);                               \
48       GET_SAVED_CCCS;                                                   \
49       Sp = Sp + SIZEOF_StgHeader;                                       \
50       ENTER();                                                          \
51   }                                                                     \
52                                                                         \
53   INFO_TABLE_SELECTOR(stg_sel_##offset##_upd, offset, THUNK_SELECTOR, "stg_sel_upd", "stg_sel_upd") \
54   {                                                                     \
55       TICK_ENT_DYN_THK();                                               \
56       STK_CHK_NP(WITHUPD_FRAME_SIZE);                                   \
57       UPD_BH_UPDATABLE();                                               \
58       LDV_ENTER(R1);                                                    \
59       PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);                   \
60       ENTER_CCS_THUNK(R1);                                              \
61       SAVE_CCCS(WITHUPD_FRAME_SIZE);                                    \
62       W_[Sp-WITHUPD_FRAME_SIZE] = stg_sel_ret_##offset##_upd_info;      \
63       R1 = StgThunk_payload(R1,0);                                      \
64       Sp = Sp - WITHUPD_FRAME_SIZE;                                     \
65       jump %GET_ENTRY(R1);                                              \
66   }
67   /* NOTE: no need to ENTER() here, we know the closure cannot evaluate to a function,
68      because we're going to do a field selection on the result. */
69
70 SELECTOR_CODE_UPD(0)
71 SELECTOR_CODE_UPD(1)
72 SELECTOR_CODE_UPD(2)
73 SELECTOR_CODE_UPD(3)
74 SELECTOR_CODE_UPD(4)
75 SELECTOR_CODE_UPD(5)
76 SELECTOR_CODE_UPD(6)
77 SELECTOR_CODE_UPD(7)
78 SELECTOR_CODE_UPD(8)
79 SELECTOR_CODE_UPD(9)
80 SELECTOR_CODE_UPD(10)
81 SELECTOR_CODE_UPD(11)
82 SELECTOR_CODE_UPD(12)
83 SELECTOR_CODE_UPD(13)
84 SELECTOR_CODE_UPD(14)
85 SELECTOR_CODE_UPD(15)
86
87 #define SELECTOR_CODE_NOUPD(offset) \
88   INFO_TABLE_RET(stg_sel_ret_##offset##_noupd, RET_FRAMESIZE, RET_BITMAP, RET_SMALL)    \
89   {                                                                     \
90       R1 = StgClosure_payload(R1,offset);                               \
91       GET_SAVED_CCCS;                                                   \
92       Sp = Sp + SIZEOF_StgHeader;                                       \
93       jump %GET_ENTRY(R1);                                              \
94   }                                                                     \
95                                                                         \
96   INFO_TABLE_SELECTOR(stg_sel_##offset##_noupd, offset, THUNK_SELECTOR, "stg_sel_noupd", "stg_sel_noupd")\
97   {                                                                     \
98       TICK_ENT_DYN_THK();                                               \
99       STK_CHK_NP(NOUPD_FRAME_SIZE);                                     \
100       UPD_BH_SINGLE_ENTRY();                                            \
101       LDV_ENTER(R1);                                                    \
102       TICK_UPDF_OMITTED();                                              \
103       ENTER_CCS_THUNK(R1);                                              \
104       SAVE_CCCS(NOUPD_FRAME_SIZE);                                      \
105       W_[Sp-NOUPD_FRAME_SIZE] = stg_sel_ret_##offset##_noupd_info;      \
106       R1 = StgThunk_payload(R1,0);                                      \
107       Sp = Sp - NOUPD_FRAME_SIZE;                                       \
108       jump %GET_ENTRY(R1);                                              \
109   }
110
111 SELECTOR_CODE_NOUPD(0)
112 SELECTOR_CODE_NOUPD(1)
113 SELECTOR_CODE_NOUPD(2)
114 SELECTOR_CODE_NOUPD(3)
115 SELECTOR_CODE_NOUPD(4)
116 SELECTOR_CODE_NOUPD(5)
117 SELECTOR_CODE_NOUPD(6)
118 SELECTOR_CODE_NOUPD(7)
119 SELECTOR_CODE_NOUPD(8)
120 SELECTOR_CODE_NOUPD(9)
121 SELECTOR_CODE_NOUPD(10)
122 SELECTOR_CODE_NOUPD(11)
123 SELECTOR_CODE_NOUPD(12)
124 SELECTOR_CODE_NOUPD(13)
125 SELECTOR_CODE_NOUPD(14)
126 SELECTOR_CODE_NOUPD(15)
127
128 /* -----------------------------------------------------------------------------
129    Apply thunks
130
131    An apply thunk is a thunk of the form
132         
133                 let z = [x1...xn] \u x1...xn
134                 in ...
135
136    We pre-compile some of these because the code is always the same.
137
138    These have to be independent of the update frame size, so the code
139    works when profiling etc.
140    -------------------------------------------------------------------------- */
141
142 /* stg_ap_1_upd_info is a bit redundant, but there appears to be a bug
143  * in the compiler that means stg_ap_1 is generated occasionally (ToDo)
144  */
145
146 INFO_TABLE(stg_ap_1_upd,1,1,THUNK_1_0,"stg_ap_1_upd_info","stg_ap_1_upd_info")
147 {
148   TICK_ENT_DYN_THK();
149   STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(1));
150   UPD_BH_UPDATABLE();
151   LDV_ENTER(R1);
152   ENTER_CCS_THUNK(R1);
153   PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
154   R1 = StgThunk_payload(R1,0);
155   Sp = Sp - SIZEOF_StgUpdateFrame;
156   jump stg_ap_0_fast;
157 }
158
159 INFO_TABLE(stg_ap_2_upd,2,0,THUNK_2_0,"stg_ap_2_upd_info","stg_ap_2_upd_info")
160 {
161   TICK_ENT_DYN_THK();
162   STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(2));
163   UPD_BH_UPDATABLE();
164   LDV_ENTER(R1);
165   ENTER_CCS_THUNK(R1);
166   PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
167   W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,1);
168   R1 = StgThunk_payload(R1,0);
169   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(1);
170   Sp_adj(-1); // for stg_ap_*_ret
171   TICK_UNKNOWN_CALL();
172   TICK_SLOW_CALL_p();
173   jump RET_LBL(stg_ap_p);
174 }
175
176 INFO_TABLE(stg_ap_3_upd,3,0,THUNK,"stg_ap_3_upd_info","stg_ap_3_upd_info")
177 {
178   TICK_ENT_DYN_THK();
179   STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(3));
180   UPD_BH_UPDATABLE();
181   LDV_ENTER(R1);
182   ENTER_CCS_THUNK(R1);
183   PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
184   W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,2);
185   W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,1);
186   R1 = StgThunk_payload(R1,0);
187   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(2);
188   Sp_adj(-1); // for stg_ap_*_ret
189   TICK_UNKNOWN_CALL();
190   TICK_SLOW_CALL_pp();
191   jump RET_LBL(stg_ap_pp);
192 }
193
194 INFO_TABLE(stg_ap_4_upd,4,0,THUNK,"stg_ap_4_upd_info","stg_ap_4_upd_info")
195 {
196   TICK_ENT_DYN_THK();
197   STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(4));
198   UPD_BH_UPDATABLE();
199   LDV_ENTER(R1);
200   ENTER_CCS_THUNK(R1);
201   PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
202   W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,3);
203   W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,2);
204   W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,1);
205   R1 = StgThunk_payload(R1,0);
206   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(3);
207   Sp_adj(-1); // for stg_ap_*_ret
208   TICK_UNKNOWN_CALL();
209   TICK_SLOW_CALL_ppp();
210   jump RET_LBL(stg_ap_ppp);
211 }
212
213 INFO_TABLE(stg_ap_5_upd,5,0,THUNK,"stg_ap_5_upd_info","stg_ap_5_upd_info")
214 {
215   TICK_ENT_DYN_THK();
216   STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(5));
217   UPD_BH_UPDATABLE();
218   LDV_ENTER(R1);
219   ENTER_CCS_THUNK(R1);
220   PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
221   W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,4);
222   W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,3);
223   W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,2);
224   W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgThunk_payload(R1,1);
225   R1 = StgThunk_payload(R1,0);
226   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(4);
227   Sp_adj(-1); // for stg_ap_*_ret
228   TICK_UNKNOWN_CALL();
229   TICK_SLOW_CALL_pppp();
230   jump RET_LBL(stg_ap_pppp);
231 }
232
233 INFO_TABLE(stg_ap_6_upd,6,0,THUNK,"stg_ap_6_upd_info","stg_ap_6_upd_info")
234 {
235   TICK_ENT_DYN_THK();
236   STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(6));
237   UPD_BH_UPDATABLE();
238   LDV_ENTER(R1);
239   ENTER_CCS_THUNK(R1);
240   PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
241   W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,5);
242   W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,4);
243   W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,3);
244   W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgThunk_payload(R1,2);
245   W_[Sp-SIZEOF_StgUpdateFrame-WDS(5)] = StgThunk_payload(R1,1);
246   R1 = StgThunk_payload(R1,0);
247   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(5);
248   Sp_adj(-1); // for stg_ap_*_ret
249   TICK_UNKNOWN_CALL();
250   TICK_SLOW_CALL_ppppp();
251   jump RET_LBL(stg_ap_ppppp);
252 }
253
254 INFO_TABLE(stg_ap_7_upd,7,0,THUNK,"stg_ap_7_upd_info","stg_ap_7_upd_info")
255 {
256   TICK_ENT_DYN_THK();
257   STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(7));
258   UPD_BH_UPDATABLE();
259   LDV_ENTER(R1);
260   ENTER_CCS_THUNK(R1);
261   PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
262   W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,6);
263   W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,5);
264   W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,4);
265   W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgThunk_payload(R1,3);
266   W_[Sp-SIZEOF_StgUpdateFrame-WDS(5)] = StgThunk_payload(R1,2);
267   W_[Sp-SIZEOF_StgUpdateFrame-WDS(6)] = StgThunk_payload(R1,1);
268   R1 = StgThunk_payload(R1,0);
269   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(6);
270   Sp_adj(-1); // for stg_ap_*_ret
271   TICK_UNKNOWN_CALL();
272   TICK_SLOW_CALL_pppppp();
273   jump RET_LBL(stg_ap_pppppp);
274 }