ghc/rts/StgStdThunks.hc

   1 /* -----------------------------------------------------------------------------
   2  * $Id: StgStdThunks.hc,v 1.14 2000/12/04 12:31:21 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   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       PUSH_UPD_FRAME(R1.p,0);                                           \
  62       ENTER_CCS(R1.p);                                                  \
  63       SAVE_CCCS(UPD_FRAME_SIZE);                                        \
  64       Sp[-UPD_FRAME_SIZE]=(W_)&stg_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   IF_(stg_sel_ret_##offset##_noupd_ret); \
  90   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);        \
  91   IF_(stg_sel_ret_##offset##_noupd_ret) {                                       \
  92     FB_                                                                 \
  93       R1.p=(P_)R1.cl->payload[offset];                                  \
  94       GET_SAVED_CCCS;                                                   \
  95       Sp=Sp+sizeofW(StgHeader);                                         \
  96       JMP_(ENTRY_CODE(*R1.p));                                          \
  97     FE_                                                                 \
  98   }                                                                     \
  99                                                                         \
 100   EF_(stg_sel_##offset##_noupd_entry);                                  \
 101   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");\
 102   EF_(stg_sel_##offset##_noupd_entry) {                                 \
 103     FB_                                                                 \
 104       STK_CHK_NP(NOUPD_FRAME_SIZE,1,)                                   \
 105       UPD_BH_SINGLE_ENTRY(&stg_sel_##offset##_noupd_info);              \
 106       ENTER_CCS(R1.p);                                                  \
 107       SAVE_CCCS(NOUPD_FRAME_SIZE);                                      \
 108       Sp[-NOUPD_FRAME_SIZE]=(W_)&stg_sel_ret_##offset##_noupd_info;     \
 109       R1.p = (P_)R1.cl->payload[0];                                     \
 110       Sp=Sp-NOUPD_FRAME_SIZE;                                           \
 111       JMP_(ENTRY_CODE(*R1.p));                                          \
 112     FE_                                                                 \
 113   }
 114
 115 SELECTOR_CODE_NOUPD(0);
 116 SELECTOR_CODE_NOUPD(1);
 117 SELECTOR_CODE_NOUPD(2);
 118 SELECTOR_CODE_NOUPD(3);
 119 SELECTOR_CODE_NOUPD(4);
 120 SELECTOR_CODE_NOUPD(5);
 121 SELECTOR_CODE_NOUPD(6);
 122 SELECTOR_CODE_NOUPD(7);
 123 SELECTOR_CODE_NOUPD(8);
 124 SELECTOR_CODE_NOUPD(9);
 125 SELECTOR_CODE_NOUPD(10);
 126 SELECTOR_CODE_NOUPD(11);
 127 SELECTOR_CODE_NOUPD(12);
 128 SELECTOR_CODE_NOUPD(13);
 129 SELECTOR_CODE_NOUPD(14);
 130 SELECTOR_CODE_NOUPD(15);
 131
 132 /* -----------------------------------------------------------------------------
 133    Apply thunks
 134
 135    An apply thunk is a thunk of the form
 136
 137                 let z = [x1...xn] \u x1...xn
 138                 in ...
 139
 140    We pre-compile some of these because the code is always the same.
 141
 142    These have to be independent of the update frame size, so the code
 143    works when profiling etc.
 144    -------------------------------------------------------------------------- */
 145
 146 FN_(stg_ap_1_upd_entry);
 147 FN_(stg_ap_2_upd_entry);
 148 FN_(stg_ap_3_upd_entry);
 149 FN_(stg_ap_4_upd_entry);
 150 FN_(stg_ap_5_upd_entry);
 151 FN_(stg_ap_6_upd_entry);
 152 FN_(stg_ap_7_upd_entry);
 153 FN_(stg_ap_8_upd_entry);
 154
 155 #define UF_SIZE (sizeofW(StgUpdateFrame))
 156
 157 /* stg_ap_1_upd_info is a bit redundant, but there appears to be a bug
 158  * in the compiler that means stg_ap_1 is generated occasionally (ToDo)
 159  */
 160
 161 INFO_TABLE_SRT(stg_ap_1_upd_info,stg_ap_1_upd_entry,1,0,0,0,0,THUNK,,EF_,"stg_ap_1_upd_info","stg_ap_1_upd_info");
 162 FN_(stg_ap_1_upd_entry) {
 163   FB_
 164   STK_CHK_NP(sizeofW(StgUpdateFrame),1,);
 165   UPD_BH_UPDATABLE(&stg_ap_1_upd_info);
 166   ENTER_CCS(R1.p);
 167   PUSH_UPD_FRAME(R1.p,0);
 168   R1.p=(P_)(R1.cl->payload[0]);
 169   Sp = Sp - sizeofW(StgUpdateFrame);
 170   JMP_(ENTRY_CODE(*R1.p));
 171   FE_
 172 }
 173
 174 INFO_TABLE_SRT(stg_ap_2_upd_info,stg_ap_2_upd_entry,2,0,0,0,0,THUNK,,EF_,"stg_ap_2_upd_info","stg_ap_2_upd_info");
 175 FN_(stg_ap_2_upd_entry) {
 176   FB_
 177   STK_CHK_NP(sizeofW(StgUpdateFrame)+1,1,);
 178   UPD_BH_UPDATABLE(&stg_ap_2_upd_info);
 179   ENTER_CCS(R1.p);
 180   PUSH_UPD_FRAME(R1.p,0);
 181   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[1]);
 182   R1.p=(P_)(R1.cl->payload[0]);
 183   Sp = Sp - (sizeofW(StgUpdateFrame)+1);
 184   JMP_(ENTRY_CODE(*R1.p));
 185   FE_
 186 }
 187
 188 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");
 189 FN_(stg_ap_3_upd_entry) {
 190   FB_
 191   STK_CHK_NP(sizeofW(StgUpdateFrame)+2,1,);
 192   UPD_BH_UPDATABLE(&stg_ap_3_upd_info);
 193   ENTER_CCS(R1.p);
 194   PUSH_UPD_FRAME(R1.p,0);
 195   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[2]);
 196   Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[1]);
 197   R1.p=(P_)(R1.cl->payload[0]);
 198   Sp = Sp - (sizeofW(StgUpdateFrame)+2);
 199   JMP_(ENTRY_CODE(*R1.p));
 200   FE_
 201 }
 202
 203 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");
 204 FN_(stg_ap_4_upd_entry) {
 205   FB_
 206   STK_CHK_NP(sizeofW(StgUpdateFrame)+3,1,);
 207   UPD_BH_UPDATABLE(&stg_ap_4_upd_info);
 208   ENTER_CCS(R1.p);
 209   PUSH_UPD_FRAME(R1.p,0);
 210   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[3]);
 211   Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[2]);
 212   Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[1]);
 213   R1.p=(P_)(R1.cl->payload[0]);
 214   Sp = Sp - (sizeofW(StgUpdateFrame)+3);
 215   JMP_(ENTRY_CODE(*R1.p));
 216   FE_
 217 }
 218
 219 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");
 220 FN_(stg_ap_5_upd_entry) {
 221   FB_
 222   STK_CHK_NP(sizeofW(StgUpdateFrame)+4,1,);
 223   UPD_BH_UPDATABLE(&stg_ap_5_upd_info);
 224   ENTER_CCS(R1.p);
 225   PUSH_UPD_FRAME(R1.p,0);
 226   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[4]);
 227   Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[3]);
 228   Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[2]);
 229   Sp[-UF_SIZE-4]=(W_)(R1.cl->payload[1]);
 230   R1.p=(P_)(R1.cl->payload[0]);
 231   Sp = Sp - (sizeofW(StgUpdateFrame)+4);
 232   JMP_(ENTRY_CODE(*R1.p));
 233   FE_
 234 }
 235
 236 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");
 237 FN_(stg_ap_6_upd_entry) {
 238   FB_
 239   STK_CHK_NP(sizeofW(StgUpdateFrame)+5,1,);
 240   UPD_BH_UPDATABLE(&stg_ap_6_upd_info);
 241   ENTER_CCS(R1.p);
 242   PUSH_UPD_FRAME(R1.p,0);
 243   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[5]);
 244   Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[4]);
 245   Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[3]);
 246   Sp[-UF_SIZE-4]=(W_)(R1.cl->payload[2]);
 247   Sp[-UF_SIZE-5]=(W_)(R1.cl->payload[1]);
 248   R1.p=(P_)(R1.cl->payload[0]);
 249   Sp = Sp - (sizeofW(StgUpdateFrame)+5);
 250   JMP_(ENTRY_CODE(*R1.p));
 251   FE_
 252 }
 253
 254 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");
 255 FN_(stg_ap_7_upd_entry) {
 256   FB_
 257   STK_CHK_NP(sizeofW(StgUpdateFrame)+6,1,);
 258   UPD_BH_UPDATABLE(&stg_ap_7_upd_info);
 259   ENTER_CCS(R1.p);
 260   PUSH_UPD_FRAME(R1.p,0);
 261   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[6]);
 262   Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[5]);
 263   Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[4]);
 264   Sp[-UF_SIZE-4]=(W_)(R1.cl->payload[3]);
 265   Sp[-UF_SIZE-5]=(W_)(R1.cl->payload[2]);
 266   Sp[-UF_SIZE-6]=(W_)(R1.cl->payload[1]);
 267   R1.p=(P_)(R1.cl->payload[0]);
 268   Sp = Sp - (sizeofW(StgUpdateFrame)+6);
 269   JMP_(ENTRY_CODE(*R1.p));
 270   FE_
 271 }
 272
 273 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");
 274 FN_(stg_ap_8_upd_entry) {
 275   FB_
 276   STK_CHK_NP(sizeofW(StgUpdateFrame)+7,1,);
 277   UPD_BH_UPDATABLE(&stg_ap_8_upd_info);
 278   ENTER_CCS(R1.p);
 279   PUSH_UPD_FRAME(R1.p,0);
 280   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[7]);
 281   Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[6]);
 282   Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[5]);
 283   Sp[-UF_SIZE-4]=(W_)(R1.cl->payload[4]);
 284   Sp[-UF_SIZE-5]=(W_)(R1.cl->payload[3]);
 285   Sp[-UF_SIZE-6]=(W_)(R1.cl->payload[2]);
 286   Sp[-UF_SIZE-7]=(W_)(R1.cl->payload[1]);
 287   R1.p=(P_)(R1.cl->payload[0]);
 288   Sp=Sp-10;
 289   JMP_(ENTRY_CODE(*R1.p));
 290   FE_
 291 }