1 /* -----------------------------------------------------------------------------
2 * $Id: StgStdThunks.hc,v 1.2 1998/12/02 13:28:56 simonm Exp $
4 * Canned "Standard Form" Thunks
6 * ---------------------------------------------------------------------------*/
10 /* -----------------------------------------------------------------------------
11 The code for a thunk that simply extracts a field from a
12 single-constructor datatype depends only on the offset of the field
15 Here we define some canned "selector" thunks that do just that; any
16 selector thunk appearing in a program will refer to one of these
17 instead of being compiled independently.
19 The garbage collector spots selector thunks and reduces them if
20 possible, in order to avoid space leaks resulting from lazy pattern
22 -------------------------------------------------------------------------- */
24 #define UPD_FRAME_SIZE (sizeofW(StgUpdateFrame)+sizeofW(StgHeader))
25 #define NOUPD_FRAME_SIZE (sizeofW(StgHeader))
28 #define SAVE_CCCS(fs) CCS_HDR(Sp-fs)=CCCS
29 #define GET_SAVED_CCCS RESTORE_CCCS(CCS_HDR(Sp))
32 #define SAVE_CCCS(fs) /* empty */
33 #define GET_SAVED_CCCS /* empty */
37 #define SELECTOR_CODE_UPD(offset) \
38 IF_(__sel_ret_##offset##_upd_ret); \
39 INFO_TABLE_SRT_BITMAP(__sel_ret_##offset##_upd_info,__sel_ret_##offset##_upd_ret, RET_BITMAP, 0, 0, 0, RET_SMALL, static const, IF_, 0, 0); \
40 IF_(__sel_ret_##offset##_upd_ret) { \
42 R1.p=(P_)R1.cl->payload[offset]; \
44 Sp=Sp+sizeofW(StgHeader); \
45 JMP_(ENTRY_CODE(*R1.p)); \
49 EF_(__sel_##offset##_upd_entry); \
50 INFO_TABLE_SELECTOR(__sel_##offset##_upd_info, __sel_##offset##_upd_entry, offset, const, EF_, 0,0);\
51 EF_(__sel_##offset##_upd_entry) { \
53 STK_CHK_NP(UPD_FRAME_SIZE,1,); \
54 UPD_BH_UPDATABLE(R1.p); \
55 PUSH_UPD_FRAME(R1.p,0); \
56 SAVE_CCCS(UPD_FRAME_SIZE); \
57 Sp[-UPD_FRAME_SIZE]=(W_)__sel_ret_##offset##_upd_ret; \
58 R1.p = (P_)R1.cl->payload[0]; \
59 Sp=Sp-UPD_FRAME_SIZE; \
60 JMP_(ENTRY_CODE(*R1.p)); \
74 SELECTOR_CODE_UPD(10);
75 SELECTOR_CODE_UPD(11);
76 SELECTOR_CODE_UPD(12);
77 SELECTOR_CODE_UPD(13);
78 SELECTOR_CODE_UPD(14);
79 SELECTOR_CODE_UPD(15);
81 #define SELECTOR_CODE_NOUPD(offset) \
82 IF_(__sel_ret_##offset##_noupd_ret); \
83 INFO_TABLE_SRT_BITMAP(__sel_ret_##offset##_noupd_info, __sel_ret_##offset##_noupd_ret, RET_BITMAP, 0, 0, 0, RET_SMALL, static const, IF_, 0, 0); \
84 IF_(__sel_ret_##offset##_noupd_ret) { \
86 R1.p=(P_)R1.cl->payload[offset]; \
88 Sp=Sp+sizeofW(StgHeader); \
89 JMP_(ENTRY_CODE(*R1.p)); \
93 EF_(__sel_##offset##_noupd_entry); \
94 INFO_TABLE_SELECTOR(__sel_##offset##_noupd_info, __sel_##offset##_noupd_entry, offset, const, EF_, 0,0);\
95 EF_(__sel_##offset##_noupd_entry) { \
97 STK_CHK_NP(NOUPD_FRAME_SIZE,1,) \
98 SAVE_CCCS(NOUPD_FRAME_SIZE); \
99 Sp[-NOUPD_FRAME_SIZE]=(W_)__sel_ret_##offset##_noupd_ret; \
100 R1.p = (P_)R1.cl->payload[0]; \
101 Sp=Sp-NOUPD_FRAME_SIZE; \
102 JMP_(ENTRY_CODE(*R1.p)); \
106 SELECTOR_CODE_NOUPD(0);
107 SELECTOR_CODE_NOUPD(1);
108 SELECTOR_CODE_NOUPD(2);
109 SELECTOR_CODE_NOUPD(3);
110 SELECTOR_CODE_NOUPD(4);
111 SELECTOR_CODE_NOUPD(5);
112 SELECTOR_CODE_NOUPD(6);
113 SELECTOR_CODE_NOUPD(7);
114 SELECTOR_CODE_NOUPD(8);
115 SELECTOR_CODE_NOUPD(9);
116 SELECTOR_CODE_NOUPD(10);
117 SELECTOR_CODE_NOUPD(11);
118 SELECTOR_CODE_NOUPD(12);
119 SELECTOR_CODE_NOUPD(13);
120 SELECTOR_CODE_NOUPD(14);
121 SELECTOR_CODE_NOUPD(15);
123 /* -----------------------------------------------------------------------------
126 An apply thunk is a thunk of the form
128 let z = [x1...xn] \u x1...xn
131 We pre-compile some of these because the code is always the same.
133 These have to be independent of the update frame size, so the code
134 works when profiling etc.
135 -------------------------------------------------------------------------- */
137 FN_(__ap_1_upd_entry);
138 FN_(__ap_2_upd_entry);
139 FN_(__ap_3_upd_entry);
140 FN_(__ap_4_upd_entry);
141 FN_(__ap_5_upd_entry);
142 FN_(__ap_6_upd_entry);
143 FN_(__ap_7_upd_entry);
144 FN_(__ap_8_upd_entry);
146 /* __ap_1_upd_info is a bit redundant, but there appears to be a bug
147 * in the compiler that means __ap_1 is generated occasionally (ToDo)
150 INFO_TABLE_SRT(__ap_1_upd_info,__ap_1_upd_entry,1,0,0,0,0,THUNK, const,EF_,0,0);
151 FN_(__ap_1_upd_entry) {
153 STK_CHK_NP(sizeofW(StgUpdateFrame),1,);
154 UPD_BH_UPDATABLE(R1.p);
155 PUSH_UPD_FRAME(R1.p,0);
156 R1.p=(P_)(R1.cl->payload[0]);
157 Sp = Sp - sizeofW(StgUpdateFrame);
158 JMP_(ENTRY_CODE(*R1.p));
162 INFO_TABLE_SRT(__ap_2_upd_info,__ap_2_upd_entry,2,0,0,0,0,THUNK, const,EF_,0,0);
163 FN_(__ap_2_upd_entry) {
165 STK_CHK_NP(sizeofW(StgUpdateFrame)+1,1,);
166 UPD_BH_UPDATABLE(R1.p);
167 PUSH_UPD_FRAME(R1.p,0);
168 Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[1]);
169 R1.p=(P_)(R1.cl->payload[0]);
170 Sp = Sp - (sizeofW(StgUpdateFrame)+1);
171 JMP_(ENTRY_CODE(*R1.p));
175 INFO_TABLE_SRT(__ap_3_upd_info,__ap_3_upd_entry,3,0,0,0,0,THUNK, const,EF_,0,0);
176 FN_(__ap_3_upd_entry) {
178 STK_CHK_NP(sizeofW(StgUpdateFrame)+2,1,);
179 UPD_BH_UPDATABLE(R1.p);
180 PUSH_UPD_FRAME(R1.p,0);
181 Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[2]);
182 Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[1]);
183 R1.p=(P_)(R1.cl->payload[0]);
184 Sp = Sp - (sizeofW(StgUpdateFrame)+2);
185 JMP_(ENTRY_CODE(*R1.p));
189 INFO_TABLE_SRT(__ap_4_upd_info,__ap_4_upd_entry,4,0,0,0,0,THUNK, const,EF_,0,0);
190 FN_(__ap_4_upd_entry) {
192 STK_CHK_NP(sizeofW(StgUpdateFrame)+3,1,);
193 UPD_BH_UPDATABLE(R1.p);
194 PUSH_UPD_FRAME(R1.p,0);
195 Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[3]);
196 Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[2]);
197 Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[1]);
198 R1.p=(P_)(R1.cl->payload[0]);
199 Sp = Sp - (sizeofW(StgUpdateFrame)+3);
200 JMP_(ENTRY_CODE(*R1.p));
204 INFO_TABLE_SRT(__ap_5_upd_info,__ap_5_upd_entry,5,0,0,0,0,THUNK, const,EF_,0,0);
205 FN_(__ap_5_upd_entry) {
207 STK_CHK_NP(sizeofW(StgUpdateFrame)+4,1,);
208 UPD_BH_UPDATABLE(R1.p);
209 PUSH_UPD_FRAME(R1.p,0);
210 Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[4]);
211 Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[3]);
212 Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[2]);
213 Sp[-UF_SIZE-4]=(W_)(R1.cl->payload[1]);
214 R1.p=(P_)(R1.cl->payload[0]);
215 Sp = Sp - (sizeofW(StgUpdateFrame)+4);
216 JMP_(ENTRY_CODE(*R1.p));
220 INFO_TABLE_SRT(__ap_6_upd_info,__ap_6_upd_entry,6,0,0,0,0,THUNK, const,EF_,0,0);
221 FN_(__ap_6_upd_entry) {
223 STK_CHK_NP(sizeofW(StgUpdateFrame)+5,1,);
224 UPD_BH_UPDATABLE(R1.p);
225 PUSH_UPD_FRAME(R1.p,0);
226 Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[5]);
227 Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[4]);
228 Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[3]);
229 Sp[-UF_SIZE-4]=(W_)(R1.cl->payload[2]);
230 Sp[-UF_SIZE-5]=(W_)(R1.cl->payload[1]);
231 R1.p=(P_)(R1.cl->payload[0]);
232 Sp = Sp - (sizeofW(StgUpdateFrame)+5);
233 JMP_(ENTRY_CODE(*R1.p));
237 INFO_TABLE_SRT(__ap_7_upd_info,__ap_7_upd_entry,7,0,0,0,0,THUNK, const,EF_,0,0);
238 FN_(__ap_7_upd_entry) {
240 STK_CHK_NP(sizeofW(StgUpdateFrame)+6,1,);
241 UPD_BH_UPDATABLE(R1.p);
242 PUSH_UPD_FRAME(R1.p,0);
243 Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[6]);
244 Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[5]);
245 Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[4]);
246 Sp[-UF_SIZE-4]=(W_)(R1.cl->payload[3]);
247 Sp[-UF_SIZE-5]=(W_)(R1.cl->payload[2]);
248 Sp[-UF_SIZE-6]=(W_)(R1.cl->payload[1]);
249 R1.p=(P_)(R1.cl->payload[0]);
250 Sp = Sp - (sizeofW(StgUpdateFrame)+6);
251 JMP_(ENTRY_CODE(*R1.p));
255 INFO_TABLE_SRT(__ap_8_upd_info,__ap_8_upd_entry,8,0,0,0,0,THUNK, const,EF_,0,0);
256 FN_(__ap_8_upd_entry) {
258 STK_CHK_NP(sizeofW(StgUpdateFrame)+7,1,);
259 UPD_BH_UPDATABLE(R1.p);
260 PUSH_UPD_FRAME(R1.p,0);
261 Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[7]);
262 Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[6]);
263 Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[5]);
264 Sp[-UF_SIZE-4]=(W_)(R1.cl->payload[4]);
265 Sp[-UF_SIZE-5]=(W_)(R1.cl->payload[3]);
266 Sp[-UF_SIZE-6]=(W_)(R1.cl->payload[2]);
267 Sp[-UF_SIZE-7]=(W_)(R1.cl->payload[1]);
268 R1.p=(P_)(R1.cl->payload[0]);
270 JMP_(ENTRY_CODE(*R1.p));