1 /* -----------------------------------------------------------------------------
2 * $Id: StgStdThunks.hc,v 1.10 1999/11/09 15:46:58 simonmar Exp $
4 * (c) The GHC Team, 1998-1999
6 * Canned "Standard Form" Thunks
8 * ---------------------------------------------------------------------------*/
11 #include "StoragePriv.h"
12 #include "HeapStackCheck.h"
14 /* -----------------------------------------------------------------------------
15 The code for a thunk that simply extracts a field from a
16 single-constructor datatype depends only on the offset of the field
19 Here we define some canned "selector" thunks that do just that; any
20 selector thunk appearing in a program will refer to one of these
21 instead of being compiled independently.
23 The garbage collector spots selector thunks and reduces them if
24 possible, in order to avoid space leaks resulting from lazy pattern
26 -------------------------------------------------------------------------- */
28 #define UPD_FRAME_SIZE (sizeofW(StgUpdateFrame)+sizeofW(StgHeader))
29 #define NOUPD_FRAME_SIZE (sizeofW(StgHeader))
32 #define SAVE_CCCS(fs) CCS_HDR(Sp-fs)=CCCS
33 #define GET_SAVED_CCCS RESTORE_CCCS(CCS_HDR(Sp))
34 #define ENTER_CCS(p) ENTER_CCS_TCL(p)
37 #define SAVE_CCCS(fs) /* empty */
38 #define GET_SAVED_CCCS /* empty */
39 #define ENTER_CCS(p) /* empty */
43 #define SELECTOR_CODE_UPD(offset) \
44 EF_(__sel_ret_##offset##_upd_ret); \
45 INFO_TABLE_SRT_BITMAP(__sel_ret_##offset##_upd_info,__sel_ret_##offset##_upd_ret, RET_BITMAP, 0, 0, 0, RET_SMALL, static, EF_, 0, 0); \
46 EF_(__sel_ret_##offset##_upd_ret) { \
48 R1.p=(P_)R1.cl->payload[offset]; \
50 Sp=Sp+sizeofW(StgHeader); \
51 JMP_(ENTRY_CODE(*R1.p)); \
55 EF_(__sel_##offset##_upd_entry); \
56 INFO_TABLE_SELECTOR(__sel_##offset##_upd_info, __sel_##offset##_upd_entry, offset,, EF_, 0,0);\
57 EF_(__sel_##offset##_upd_entry) { \
59 STK_CHK_NP(UPD_FRAME_SIZE,1,); \
60 UPD_BH_UPDATABLE(&__sel_##offset##_upd_info); \
61 PUSH_UPD_FRAME(R1.p,0); \
63 SAVE_CCCS(UPD_FRAME_SIZE); \
64 Sp[-UPD_FRAME_SIZE]=(W_)&__sel_ret_##offset##_upd_info; \
65 R1.p = (P_)R1.cl->payload[0]; \
66 Sp=Sp-UPD_FRAME_SIZE; \
67 JMP_(ENTRY_CODE(*R1.p)); \
81 SELECTOR_CODE_UPD(10);
82 SELECTOR_CODE_UPD(11);
83 SELECTOR_CODE_UPD(12);
84 SELECTOR_CODE_UPD(13);
85 SELECTOR_CODE_UPD(14);
86 SELECTOR_CODE_UPD(15);
88 #define SELECTOR_CODE_NOUPD(offset) \
89 INFO_TABLE_SRT_BITMAP(__sel_ret_##offset##_noupd_info, __sel_ret_##offset##_noupd_ret, RET_BITMAP, 0, 0, 0, RET_SMALL, static, EF_, 0, 0); \
90 EF_(__sel_ret_##offset##_noupd_ret) { \
92 R1.p=(P_)R1.cl->payload[offset]; \
94 Sp=Sp+sizeofW(StgHeader); \
95 JMP_(ENTRY_CODE(*R1.p)); \
99 EF_(__sel_##offset##_noupd_entry); \
100 INFO_TABLE_SELECTOR(__sel_##offset##_noupd_info, __sel_##offset##_noupd_entry, offset,, EF_, 0,0);\
101 EF_(__sel_##offset##_noupd_entry) { \
103 STK_CHK_NP(NOUPD_FRAME_SIZE,1,) \
104 UPD_BH_SINGLE_ENTRY(&__sel_##offset##_noupd_info); \
106 SAVE_CCCS(NOUPD_FRAME_SIZE); \
107 Sp[-NOUPD_FRAME_SIZE]=(W_)&__sel_ret_##offset##_noupd_info; \
108 R1.p = (P_)R1.cl->payload[0]; \
109 Sp=Sp-NOUPD_FRAME_SIZE; \
110 JMP_(ENTRY_CODE(*R1.p)); \
114 SELECTOR_CODE_NOUPD(0);
115 SELECTOR_CODE_NOUPD(1);
116 SELECTOR_CODE_NOUPD(2);
117 SELECTOR_CODE_NOUPD(3);
118 SELECTOR_CODE_NOUPD(4);
119 SELECTOR_CODE_NOUPD(5);
120 SELECTOR_CODE_NOUPD(6);
121 SELECTOR_CODE_NOUPD(7);
122 SELECTOR_CODE_NOUPD(8);
123 SELECTOR_CODE_NOUPD(9);
124 SELECTOR_CODE_NOUPD(10);
125 SELECTOR_CODE_NOUPD(11);
126 SELECTOR_CODE_NOUPD(12);
127 SELECTOR_CODE_NOUPD(13);
128 SELECTOR_CODE_NOUPD(14);
129 SELECTOR_CODE_NOUPD(15);
131 /* -----------------------------------------------------------------------------
134 An apply thunk is a thunk of the form
136 let z = [x1...xn] \u x1...xn
139 We pre-compile some of these because the code is always the same.
141 These have to be independent of the update frame size, so the code
142 works when profiling etc.
143 -------------------------------------------------------------------------- */
145 FN_(__ap_1_upd_entry);
146 FN_(__ap_2_upd_entry);
147 FN_(__ap_3_upd_entry);
148 FN_(__ap_4_upd_entry);
149 FN_(__ap_5_upd_entry);
150 FN_(__ap_6_upd_entry);
151 FN_(__ap_7_upd_entry);
152 FN_(__ap_8_upd_entry);
154 #define UF_SIZE (sizeofW(StgUpdateFrame))
156 /* __ap_1_upd_info is a bit redundant, but there appears to be a bug
157 * in the compiler that means __ap_1 is generated occasionally (ToDo)
160 INFO_TABLE_SRT(__ap_1_upd_info,__ap_1_upd_entry,1,0,0,0,0,THUNK,,EF_,0,0);
161 FN_(__ap_1_upd_entry) {
163 STK_CHK_NP(sizeofW(StgUpdateFrame),1,);
164 UPD_BH_UPDATABLE(&__ap_1_upd_info);
166 PUSH_UPD_FRAME(R1.p,0);
167 R1.p=(P_)(R1.cl->payload[0]);
168 Sp = Sp - sizeofW(StgUpdateFrame);
169 JMP_(ENTRY_CODE(*R1.p));
173 INFO_TABLE_SRT(__ap_2_upd_info,__ap_2_upd_entry,2,0,0,0,0,THUNK,,EF_,0,0);
174 FN_(__ap_2_upd_entry) {
176 STK_CHK_NP(sizeofW(StgUpdateFrame)+1,1,);
177 UPD_BH_UPDATABLE(&__ap_2_upd_info);
179 PUSH_UPD_FRAME(R1.p,0);
180 Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[1]);
181 R1.p=(P_)(R1.cl->payload[0]);
182 Sp = Sp - (sizeofW(StgUpdateFrame)+1);
183 JMP_(ENTRY_CODE(*R1.p));
187 INFO_TABLE_SRT(__ap_3_upd_info,__ap_3_upd_entry,3,0,0,0,0,THUNK,,EF_,0,0);
188 FN_(__ap_3_upd_entry) {
190 STK_CHK_NP(sizeofW(StgUpdateFrame)+2,1,);
191 UPD_BH_UPDATABLE(&__ap_3_upd_info);
193 PUSH_UPD_FRAME(R1.p,0);
194 Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[2]);
195 Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[1]);
196 R1.p=(P_)(R1.cl->payload[0]);
197 Sp = Sp - (sizeofW(StgUpdateFrame)+2);
198 JMP_(ENTRY_CODE(*R1.p));
202 INFO_TABLE_SRT(__ap_4_upd_info,__ap_4_upd_entry,4,0,0,0,0,THUNK,,EF_,0,0);
203 FN_(__ap_4_upd_entry) {
205 STK_CHK_NP(sizeofW(StgUpdateFrame)+3,1,);
206 UPD_BH_UPDATABLE(&__ap_4_upd_info);
208 PUSH_UPD_FRAME(R1.p,0);
209 Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[3]);
210 Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[2]);
211 Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[1]);
212 R1.p=(P_)(R1.cl->payload[0]);
213 Sp = Sp - (sizeofW(StgUpdateFrame)+3);
214 JMP_(ENTRY_CODE(*R1.p));
218 INFO_TABLE_SRT(__ap_5_upd_info,__ap_5_upd_entry,5,0,0,0,0,THUNK,,EF_,0,0);
219 FN_(__ap_5_upd_entry) {
221 STK_CHK_NP(sizeofW(StgUpdateFrame)+4,1,);
222 UPD_BH_UPDATABLE(&__ap_5_upd_info);
224 PUSH_UPD_FRAME(R1.p,0);
225 Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[4]);
226 Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[3]);
227 Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[2]);
228 Sp[-UF_SIZE-4]=(W_)(R1.cl->payload[1]);
229 R1.p=(P_)(R1.cl->payload[0]);
230 Sp = Sp - (sizeofW(StgUpdateFrame)+4);
231 JMP_(ENTRY_CODE(*R1.p));
235 INFO_TABLE_SRT(__ap_6_upd_info,__ap_6_upd_entry,6,0,0,0,0,THUNK,,EF_,0,0);
236 FN_(__ap_6_upd_entry) {
238 STK_CHK_NP(sizeofW(StgUpdateFrame)+5,1,);
239 UPD_BH_UPDATABLE(&__ap_6_upd_info);
241 PUSH_UPD_FRAME(R1.p,0);
242 Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[5]);
243 Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[4]);
244 Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[3]);
245 Sp[-UF_SIZE-4]=(W_)(R1.cl->payload[2]);
246 Sp[-UF_SIZE-5]=(W_)(R1.cl->payload[1]);
247 R1.p=(P_)(R1.cl->payload[0]);
248 Sp = Sp - (sizeofW(StgUpdateFrame)+5);
249 JMP_(ENTRY_CODE(*R1.p));
253 INFO_TABLE_SRT(__ap_7_upd_info,__ap_7_upd_entry,7,0,0,0,0,THUNK,,EF_,0,0);
254 FN_(__ap_7_upd_entry) {
256 STK_CHK_NP(sizeofW(StgUpdateFrame)+6,1,);
257 UPD_BH_UPDATABLE(&__ap_7_upd_info);
259 PUSH_UPD_FRAME(R1.p,0);
260 Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[6]);
261 Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[5]);
262 Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[4]);
263 Sp[-UF_SIZE-4]=(W_)(R1.cl->payload[3]);
264 Sp[-UF_SIZE-5]=(W_)(R1.cl->payload[2]);
265 Sp[-UF_SIZE-6]=(W_)(R1.cl->payload[1]);
266 R1.p=(P_)(R1.cl->payload[0]);
267 Sp = Sp - (sizeofW(StgUpdateFrame)+6);
268 JMP_(ENTRY_CODE(*R1.p));
272 INFO_TABLE_SRT(__ap_8_upd_info,__ap_8_upd_entry,8,0,0,0,0,THUNK,,EF_,0,0);
273 FN_(__ap_8_upd_entry) {
275 STK_CHK_NP(sizeofW(StgUpdateFrame)+7,1,);
276 UPD_BH_UPDATABLE(&__ap_8_upd_info);
278 PUSH_UPD_FRAME(R1.p,0);
279 Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[7]);
280 Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[6]);
281 Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[5]);
282 Sp[-UF_SIZE-4]=(W_)(R1.cl->payload[4]);
283 Sp[-UF_SIZE-5]=(W_)(R1.cl->payload[3]);
284 Sp[-UF_SIZE-6]=(W_)(R1.cl->payload[2]);
285 Sp[-UF_SIZE-7]=(W_)(R1.cl->payload[1]);
286 R1.p=(P_)(R1.cl->payload[0]);
288 JMP_(ENTRY_CODE(*R1.p));