ghc/rts/StgStdThunks.hc

   1 /* -----------------------------------------------------------------------------
   2  * $Id: StgStdThunks.hc,v 1.18 2001/11/22 14:25:12 simonmar Exp $
   3  *
   4  * (c) The GHC Team, 1998-2000
   5  *
   6  * Canned "Standard Form" Thunks
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #include "Stg.h"
  11 #include "Rts.h"
  12 #include "StoragePriv.h"
  13
  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
  17    to be selected.
  18
  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.
  22
  23    The garbage collector spots selector thunks and reduces them if
  24    possible, in order to avoid space leaks resulting from lazy pattern
  25    matching.
  26    -------------------------------------------------------------------------- */
  27
  28 #define UPD_FRAME_SIZE (sizeofW(StgUpdateFrame)+sizeofW(StgHeader))
  29 #define NOUPD_FRAME_SIZE (sizeofW(StgHeader))
  30
  31 #ifdef PROFILING
  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)
  35 #define RET_BITMAP 3
  36 #else
  37 #define SAVE_CCCS(fs)   /* empty */
  38 #define GET_SAVED_CCCS  /* empty */
  39 #define ENTER_CCS(p)    /* empty */
  40 #define RET_BITMAP 0
  41 #endif
  42
  43 #define SELECTOR_CODE_UPD(offset) \
  44   IF_(stg_sel_ret_##offset##_upd_ret);                                  \
  45   INFO_TABLE_SRT_BITMAP(stg_sel_ret_##offset##_upd_info,stg_sel_ret_##offset##_upd_ret, RET_BITMAP, 0, 0, 0, RET_SMALL, static, EF_, 0, 0);                     \
  46   EF_(stg_sel_ret_##offset##_upd_ret) {                                 \
  47     FB_                                                                 \
  48       R1.p=(P_)R1.cl->payload[offset];                                  \
  49       GET_SAVED_CCCS;                                                   \
  50       Sp=Sp+sizeofW(StgHeader);                                         \
  51       JMP_(ENTRY_CODE(*R1.p));                                          \
  52     FE_                                                                 \
  53   }                                                                     \
  54                                                                         \
  55   EF_(stg_sel_##offset##_upd_entry);                                    \
  56   INFO_TABLE_SELECTOR(stg_sel_##offset##_upd_info, stg_sel_##offset##_upd_entry, offset,, EF_, "stg_sel" #offset "_upd_entry", "stg_sel" #offset "_upd_entry");\
  57   EF_(stg_sel_##offset##_upd_entry) {                                   \
  58     FB_                                                                 \
  59       STK_CHK_NP(UPD_FRAME_SIZE,1,);                                    \
  60       UPD_BH_UPDATABLE(&stg_sel_##offset##_upd_info);                   \
  61       LDV_ENTER(R1.cl);                                                 \
  62       PUSH_UPD_FRAME(R1.p,0);                                           \
  63       ENTER_CCS(R1.p);                                                  \
  64       SAVE_CCCS(UPD_FRAME_SIZE);                                        \
  65       Sp[-UPD_FRAME_SIZE]=(W_)&stg_sel_ret_##offset##_upd_info;         \
  66       R1.p = (P_)R1.cl->payload[0];                                     \
  67       Sp=Sp-UPD_FRAME_SIZE;                                             \
  68       JMP_(ENTRY_CODE(*R1.p));                                          \
  69     FE_                                                                 \
  70   }
  71
  72 SELECTOR_CODE_UPD(0);
  73 SELECTOR_CODE_UPD(1);
  74 SELECTOR_CODE_UPD(2);
  75 SELECTOR_CODE_UPD(3);
  76 SELECTOR_CODE_UPD(4);
  77 SELECTOR_CODE_UPD(5);
  78 SELECTOR_CODE_UPD(6);
  79 SELECTOR_CODE_UPD(7);
  80 SELECTOR_CODE_UPD(8);
  81 SELECTOR_CODE_UPD(9);
  82 SELECTOR_CODE_UPD(10);
  83 SELECTOR_CODE_UPD(11);
  84 SELECTOR_CODE_UPD(12);
  85 SELECTOR_CODE_UPD(13);
  86 SELECTOR_CODE_UPD(14);
  87 SELECTOR_CODE_UPD(15);
  88
  89 #define SELECTOR_CODE_NOUPD(offset) \
  90   IF_(stg_sel_ret_##offset##_noupd_ret); \
  91   INFO_TABLE_SRT_BITMAP(stg_sel_ret_##offset##_noupd_info, stg_sel_ret_##offset##_noupd_ret, RET_BITMAP, 0, 0, 0, RET_SMALL, static, EF_, 0, 0);        \
  92   IF_(stg_sel_ret_##offset##_noupd_ret) {                                       \
  93     FB_                                                                 \
  94       R1.p=(P_)R1.cl->payload[offset];                                  \
  95       GET_SAVED_CCCS;                                                   \
  96       Sp=Sp+sizeofW(StgHeader);                                         \
  97       JMP_(ENTRY_CODE(*R1.p));                                          \
  98     FE_                                                                 \
  99   }                                                                     \
 100                                                                         \
 101   EF_(stg_sel_##offset##_noupd_entry);                                  \
 102   INFO_TABLE_SELECTOR(stg_sel_##offset##_noupd_info, stg_sel_##offset##_noupd_entry, offset,, EF_, "stg_sel" #offset "_noupd_entry", "stg_sel" #offset "_noupd_entry");\
 103   EF_(stg_sel_##offset##_noupd_entry) {                                 \
 104     FB_                                                                 \
 105       STK_CHK_NP(NOUPD_FRAME_SIZE,1,)                                   \
 106       UPD_BH_SINGLE_ENTRY(&stg_sel_##offset##_noupd_info);              \
 107       LDV_ENTER(R1.cl);                                                 \
 108       ENTER_CCS(R1.p);                                                  \
 109       SAVE_CCCS(NOUPD_FRAME_SIZE);                                      \
 110       Sp[-NOUPD_FRAME_SIZE]=(W_)&stg_sel_ret_##offset##_noupd_info;     \
 111       R1.p = (P_)R1.cl->payload[0];                                     \
 112       Sp=Sp-NOUPD_FRAME_SIZE;                                           \
 113       JMP_(ENTRY_CODE(*R1.p));                                          \
 114     FE_                                                                 \
 115   }
 116
 117 SELECTOR_CODE_NOUPD(0);
 118 SELECTOR_CODE_NOUPD(1);
 119 SELECTOR_CODE_NOUPD(2);
 120 SELECTOR_CODE_NOUPD(3);
 121 SELECTOR_CODE_NOUPD(4);
 122 SELECTOR_CODE_NOUPD(5);
 123 SELECTOR_CODE_NOUPD(6);
 124 SELECTOR_CODE_NOUPD(7);
 125 SELECTOR_CODE_NOUPD(8);
 126 SELECTOR_CODE_NOUPD(9);
 127 SELECTOR_CODE_NOUPD(10);
 128 SELECTOR_CODE_NOUPD(11);
 129 SELECTOR_CODE_NOUPD(12);
 130 SELECTOR_CODE_NOUPD(13);
 131 SELECTOR_CODE_NOUPD(14);
 132 SELECTOR_CODE_NOUPD(15);
 133
 134 /* -----------------------------------------------------------------------------
 135    Apply thunks
 136
 137    An apply thunk is a thunk of the form
 138
 139                 let z = [x1...xn] \u x1...xn
 140                 in ...
 141
 142    We pre-compile some of these because the code is always the same.
 143
 144    These have to be independent of the update frame size, so the code
 145    works when profiling etc.
 146    -------------------------------------------------------------------------- */
 147
 148 FN_(stg_ap_1_upd_entry);
 149 FN_(stg_ap_2_upd_entry);
 150 FN_(stg_ap_3_upd_entry);
 151 FN_(stg_ap_4_upd_entry);
 152 FN_(stg_ap_5_upd_entry);
 153 FN_(stg_ap_6_upd_entry);
 154 FN_(stg_ap_7_upd_entry);
 155 FN_(stg_ap_8_upd_entry);
 156
 157 #define UF_SIZE (sizeofW(StgUpdateFrame))
 158
 159 /* stg_ap_1_upd_info is a bit redundant, but there appears to be a bug
 160  * in the compiler that means stg_ap_1 is generated occasionally (ToDo)
 161  */
 162
 163 INFO_TABLE_SRT(stg_ap_1_upd_info,stg_ap_1_upd_entry,1,1,0,0,0,THUNK_1_0,,EF_,"stg_ap_1_upd_info","stg_ap_1_upd_info");
 164 FN_(stg_ap_1_upd_entry) {
 165   FB_
 166   STK_CHK_NP(sizeofW(StgUpdateFrame),1,);
 167   UPD_BH_UPDATABLE(&stg_ap_1_upd_info);
 168   LDV_ENTER(R1.cl);
 169   ENTER_CCS(R1.p);
 170   PUSH_UPD_FRAME(R1.p,0);
 171   R1.p=(P_)(R1.cl->payload[0]);
 172   Sp = Sp - sizeofW(StgUpdateFrame);
 173   JMP_(ENTRY_CODE(*R1.p));
 174   FE_
 175 }
 176
 177 INFO_TABLE_SRT(stg_ap_2_upd_info,stg_ap_2_upd_entry,2,0,0,0,0,THUNK_2_0,,EF_,"stg_ap_2_upd_info","stg_ap_2_upd_info");
 178 FN_(stg_ap_2_upd_entry) {
 179   FB_
 180   STK_CHK_NP(sizeofW(StgUpdateFrame)+1,1,);
 181   UPD_BH_UPDATABLE(&stg_ap_2_upd_info);
 182   LDV_ENTER(R1.cl);
 183   ENTER_CCS(R1.p);
 184   PUSH_UPD_FRAME(R1.p,0);
 185   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[1]);
 186   R1.p=(P_)(R1.cl->payload[0]);
 187   Sp = Sp - (sizeofW(StgUpdateFrame)+1);
 188   JMP_(ENTRY_CODE(*R1.p));
 189   FE_
 190 }
 191
 192 INFO_TABLE_SRT(stg_ap_3_upd_info,stg_ap_3_upd_entry,3,0,0,0,0,THUNK,,EF_,"stg_ap_3_upd_info","stg_ap_3_upd_info");
 193 FN_(stg_ap_3_upd_entry) {
 194   FB_
 195   STK_CHK_NP(sizeofW(StgUpdateFrame)+2,1,);
 196   UPD_BH_UPDATABLE(&stg_ap_3_upd_info);
 197   LDV_ENTER(R1.cl);
 198   ENTER_CCS(R1.p);
 199   PUSH_UPD_FRAME(R1.p,0);
 200   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[2]);
 201   Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[1]);
 202   R1.p=(P_)(R1.cl->payload[0]);
 203   Sp = Sp - (sizeofW(StgUpdateFrame)+2);
 204   JMP_(ENTRY_CODE(*R1.p));
 205   FE_
 206 }
 207
 208 INFO_TABLE_SRT(stg_ap_4_upd_info,stg_ap_4_upd_entry,4,0,0,0,0,THUNK,,EF_,"stg_ap_4_upd_info","stg_ap_4_upd_info");
 209 FN_(stg_ap_4_upd_entry) {
 210   FB_
 211   STK_CHK_NP(sizeofW(StgUpdateFrame)+3,1,);
 212   UPD_BH_UPDATABLE(&stg_ap_4_upd_info);
 213   LDV_ENTER(R1.cl);
 214   ENTER_CCS(R1.p);
 215   PUSH_UPD_FRAME(R1.p,0);
 216   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[3]);
 217   Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[2]);
 218   Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[1]);
 219   R1.p=(P_)(R1.cl->payload[0]);
 220   Sp = Sp - (sizeofW(StgUpdateFrame)+3);
 221   JMP_(ENTRY_CODE(*R1.p));
 222   FE_
 223 }
 224
 225 INFO_TABLE_SRT(stg_ap_5_upd_info,stg_ap_5_upd_entry,5,0,0,0,0,THUNK,,EF_,"stg_ap_5_upd_info","stg_ap_5_upd_info");
 226 FN_(stg_ap_5_upd_entry) {
 227   FB_
 228   STK_CHK_NP(sizeofW(StgUpdateFrame)+4,1,);
 229   UPD_BH_UPDATABLE(&stg_ap_5_upd_info);
 230   LDV_ENTER(R1.cl);
 231   ENTER_CCS(R1.p);
 232   PUSH_UPD_FRAME(R1.p,0);
 233   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[4]);
 234   Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[3]);
 235   Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[2]);
 236   Sp[-UF_SIZE-4]=(W_)(R1.cl->payload[1]);
 237   R1.p=(P_)(R1.cl->payload[0]);
 238   Sp = Sp - (sizeofW(StgUpdateFrame)+4);
 239   JMP_(ENTRY_CODE(*R1.p));
 240   FE_
 241 }
 242
 243 INFO_TABLE_SRT(stg_ap_6_upd_info,stg_ap_6_upd_entry,6,0,0,0,0,THUNK,,EF_,"stg_ap_6_upd_info","stg_ap_6_upd_info");
 244 FN_(stg_ap_6_upd_entry) {
 245   FB_
 246   STK_CHK_NP(sizeofW(StgUpdateFrame)+5,1,);
 247   UPD_BH_UPDATABLE(&stg_ap_6_upd_info);
 248   LDV_ENTER(R1.cl);
 249   ENTER_CCS(R1.p);
 250   PUSH_UPD_FRAME(R1.p,0);
 251   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[5]);
 252   Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[4]);
 253   Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[3]);
 254   Sp[-UF_SIZE-4]=(W_)(R1.cl->payload[2]);
 255   Sp[-UF_SIZE-5]=(W_)(R1.cl->payload[1]);
 256   R1.p=(P_)(R1.cl->payload[0]);
 257   Sp = Sp - (sizeofW(StgUpdateFrame)+5);
 258   JMP_(ENTRY_CODE(*R1.p));
 259   FE_
 260 }
 261
 262 INFO_TABLE_SRT(stg_ap_7_upd_info,stg_ap_7_upd_entry,7,0,0,0,0,THUNK,,EF_,"stg_ap_7_upd_info","stg_ap_7_upd_info");
 263 FN_(stg_ap_7_upd_entry) {
 264   FB_
 265   STK_CHK_NP(sizeofW(StgUpdateFrame)+6,1,);
 266   UPD_BH_UPDATABLE(&stg_ap_7_upd_info);
 267   LDV_ENTER(R1.cl);
 268   ENTER_CCS(R1.p);
 269   PUSH_UPD_FRAME(R1.p,0);
 270   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[6]);
 271   Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[5]);
 272   Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[4]);
 273   Sp[-UF_SIZE-4]=(W_)(R1.cl->payload[3]);
 274   Sp[-UF_SIZE-5]=(W_)(R1.cl->payload[2]);
 275   Sp[-UF_SIZE-6]=(W_)(R1.cl->payload[1]);
 276   R1.p=(P_)(R1.cl->payload[0]);
 277   Sp = Sp - (sizeofW(StgUpdateFrame)+6);
 278   JMP_(ENTRY_CODE(*R1.p));
 279   FE_
 280 }
 281
 282 INFO_TABLE_SRT(stg_ap_8_upd_info,stg_ap_8_upd_entry,8,0,0,0,0,THUNK,,EF_,"stg_ap_8_upd_info","stg_ap_8_upd_info");
 283 FN_(stg_ap_8_upd_entry) {
 284   FB_
 285   STK_CHK_NP(sizeofW(StgUpdateFrame)+7,1,);
 286   UPD_BH_UPDATABLE(&stg_ap_8_upd_info);
 287   LDV_ENTER(R1.cl);
 288   ENTER_CCS(R1.p);
 289   PUSH_UPD_FRAME(R1.p,0);
 290   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[7]);
 291   Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[6]);
 292   Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[5]);
 293   Sp[-UF_SIZE-4]=(W_)(R1.cl->payload[4]);
 294   Sp[-UF_SIZE-5]=(W_)(R1.cl->payload[3]);
 295   Sp[-UF_SIZE-6]=(W_)(R1.cl->payload[2]);
 296   Sp[-UF_SIZE-7]=(W_)(R1.cl->payload[1]);
 297   R1.p=(P_)(R1.cl->payload[0]);
 298   Sp=Sp-10;
 299   JMP_(ENTRY_CODE(*R1.p));
 300   FE_
 301 }