ghc/rts/StgStdThunks.hc

   1 /* -----------------------------------------------------------------------------
   2  * $Id: StgStdThunks.hc,v 1.11 2000/04/19 10:53:11 simonmar Exp $
   3  *
   4  * (c) The GHC Team, 1998-2000
   5  *
   6  * Canned "Standard Form" Thunks
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #include "Rts.h"
  11 #include "StoragePriv.h"
  12 #include "HeapStackCheck.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 1
  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   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) {                                   \
  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_(__sel_##offset##_upd_entry);                                      \
  56   INFO_TABLE_SELECTOR(__sel_##offset##_upd_info, __sel_##offset##_upd_entry, offset,, EF_, "__sel" #offset "_upd_entry", "__sel" #offset "_upd_entry");\
  57   EF_(__sel_##offset##_upd_entry) {                                     \
  58     FB_                                                                 \
  59       STK_CHK_NP(UPD_FRAME_SIZE,1,);                                    \
  60       UPD_BH_UPDATABLE(&__sel_##offset##_upd_info);                     \
  61       PUSH_UPD_FRAME(R1.p,0);                                           \
  62       ENTER_CCS(R1.p);                                                  \
  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));                                          \
  68     FE_                                                                 \
  69   }
  70
  71 SELECTOR_CODE_UPD(0);
  72 SELECTOR_CODE_UPD(1);
  73 SELECTOR_CODE_UPD(2);
  74 SELECTOR_CODE_UPD(3);
  75 SELECTOR_CODE_UPD(4);
  76 SELECTOR_CODE_UPD(5);
  77 SELECTOR_CODE_UPD(6);
  78 SELECTOR_CODE_UPD(7);
  79 SELECTOR_CODE_UPD(8);
  80 SELECTOR_CODE_UPD(9);
  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);
  87
  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) {                                 \
  91     FB_                                                                 \
  92       R1.p=(P_)R1.cl->payload[offset];                                  \
  93       GET_SAVED_CCCS;                                                   \
  94       Sp=Sp+sizeofW(StgHeader);                                         \
  95       JMP_(ENTRY_CODE(*R1.p));                                          \
  96     FE_                                                                 \
  97   }                                                                     \
  98                                                                         \
  99   EF_(__sel_##offset##_noupd_entry);                                    \
 100   INFO_TABLE_SELECTOR(__sel_##offset##_noupd_info, __sel_##offset##_noupd_entry, offset,, EF_, "__sel" #offset "_noupd_entry", "__sel" #offset "_noupd_entry");\
 101   EF_(__sel_##offset##_noupd_entry) {                                   \
 102     FB_                                                                 \
 103       STK_CHK_NP(NOUPD_FRAME_SIZE,1,)                                   \
 104       UPD_BH_SINGLE_ENTRY(&__sel_##offset##_noupd_info);                \
 105       ENTER_CCS(R1.p);                                                  \
 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));                                          \
 111     FE_                                                                 \
 112   }
 113
 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);
 130
 131 /* -----------------------------------------------------------------------------
 132    Apply thunks
 133
 134    An apply thunk is a thunk of the form
 135
 136                 let z = [x1...xn] \u x1...xn
 137                 in ...
 138
 139    We pre-compile some of these because the code is always the same.
 140
 141    These have to be independent of the update frame size, so the code
 142    works when profiling etc.
 143    -------------------------------------------------------------------------- */
 144
 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);
 153
 154 #define UF_SIZE (sizeofW(StgUpdateFrame))
 155
 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)
 158  */
 159
 160 INFO_TABLE_SRT(__ap_1_upd_info,__ap_1_upd_entry,1,0,0,0,0,THUNK,,EF_,"__ap_1_upd_info","__ap_1_upd_info");
 161 FN_(__ap_1_upd_entry) {
 162   FB_
 163   STK_CHK_NP(sizeofW(StgUpdateFrame),1,);
 164   UPD_BH_UPDATABLE(&__ap_1_upd_info);
 165   ENTER_CCS(R1.p);
 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));
 170   FE_
 171 }
 172
 173 INFO_TABLE_SRT(__ap_2_upd_info,__ap_2_upd_entry,2,0,0,0,0,THUNK,,EF_,"__ap_2_upd_info","__ap_2_upd_info");
 174 FN_(__ap_2_upd_entry) {
 175   FB_
 176   STK_CHK_NP(sizeofW(StgUpdateFrame)+1,1,);
 177   UPD_BH_UPDATABLE(&__ap_2_upd_info);
 178   ENTER_CCS(R1.p);
 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));
 184   FE_
 185 }
 186
 187 INFO_TABLE_SRT(__ap_3_upd_info,__ap_3_upd_entry,3,0,0,0,0,THUNK,,EF_,"__ap_3_upd_info","__ap_3_upd_info");
 188 FN_(__ap_3_upd_entry) {
 189   FB_
 190   STK_CHK_NP(sizeofW(StgUpdateFrame)+2,1,);
 191   UPD_BH_UPDATABLE(&__ap_3_upd_info);
 192   ENTER_CCS(R1.p);
 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));
 199   FE_
 200 }
 201
 202 INFO_TABLE_SRT(__ap_4_upd_info,__ap_4_upd_entry,4,0,0,0,0,THUNK,,EF_,"__ap_4_upd_info","__ap_4_upd_info");
 203 FN_(__ap_4_upd_entry) {
 204   FB_
 205   STK_CHK_NP(sizeofW(StgUpdateFrame)+3,1,);
 206   UPD_BH_UPDATABLE(&__ap_4_upd_info);
 207   ENTER_CCS(R1.p);
 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));
 215   FE_
 216 }
 217
 218 INFO_TABLE_SRT(__ap_5_upd_info,__ap_5_upd_entry,5,0,0,0,0,THUNK,,EF_,"__ap_5_upd_info","__ap_5_upd_info");
 219 FN_(__ap_5_upd_entry) {
 220   FB_
 221   STK_CHK_NP(sizeofW(StgUpdateFrame)+4,1,);
 222   UPD_BH_UPDATABLE(&__ap_5_upd_info);
 223   ENTER_CCS(R1.p);
 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));
 232   FE_
 233 }
 234
 235 INFO_TABLE_SRT(__ap_6_upd_info,__ap_6_upd_entry,6,0,0,0,0,THUNK,,EF_,"__ap_6_upd_info","__ap_6_upd_info");
 236 FN_(__ap_6_upd_entry) {
 237   FB_
 238   STK_CHK_NP(sizeofW(StgUpdateFrame)+5,1,);
 239   UPD_BH_UPDATABLE(&__ap_6_upd_info);
 240   ENTER_CCS(R1.p);
 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));
 250   FE_
 251 }
 252
 253 INFO_TABLE_SRT(__ap_7_upd_info,__ap_7_upd_entry,7,0,0,0,0,THUNK,,EF_,"__ap_7_upd_info","__ap_7_upd_info");
 254 FN_(__ap_7_upd_entry) {
 255   FB_
 256   STK_CHK_NP(sizeofW(StgUpdateFrame)+6,1,);
 257   UPD_BH_UPDATABLE(&__ap_7_upd_info);
 258   ENTER_CCS(R1.p);
 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));
 269   FE_
 270 }
 271
 272 INFO_TABLE_SRT(__ap_8_upd_info,__ap_8_upd_entry,8,0,0,0,0,THUNK,,EF_,"__ap_8_upd_info","__ap_8_upd_info");
 273 FN_(__ap_8_upd_entry) {
 274   FB_
 275   STK_CHK_NP(sizeofW(StgUpdateFrame)+7,1,);
 276   UPD_BH_UPDATABLE(&__ap_8_upd_info);
 277   ENTER_CCS(R1.p);
 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]);
 287   Sp=Sp-10;
 288   JMP_(ENTRY_CODE(*R1.p));
 289   FE_
 290 }