ghc/rts/StgStdThunks.hc

   1 /* -----------------------------------------------------------------------------
   2  * $Id: StgStdThunks.hc,v 1.15 2001/03/23 16:36:21 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 #include "HeapStackCheck.h"
  14
  15 /* -----------------------------------------------------------------------------
  16    The code for a thunk that simply extracts a field from a
  17    single-constructor datatype depends only on the offset of the field
  18    to be selected.
  19
  20    Here we define some canned "selector" thunks that do just that; any
  21    selector thunk appearing in a program will refer to one of these
  22    instead of being compiled independently.
  23
  24    The garbage collector spots selector thunks and reduces them if
  25    possible, in order to avoid space leaks resulting from lazy pattern
  26    matching.
  27    -------------------------------------------------------------------------- */
  28
  29 #define UPD_FRAME_SIZE (sizeofW(StgUpdateFrame)+sizeofW(StgHeader))
  30 #define NOUPD_FRAME_SIZE (sizeofW(StgHeader))
  31
  32 #ifdef PROFILING
  33 #define SAVE_CCCS(fs)   CCS_HDR(Sp-fs)=CCCS
  34 #define GET_SAVED_CCCS  RESTORE_CCCS(CCS_HDR(Sp))
  35 #define ENTER_CCS(p)    ENTER_CCS_TCL(p)
  36 #define RET_BITMAP 1
  37 #else
  38 #define SAVE_CCCS(fs)   /* empty */
  39 #define GET_SAVED_CCCS  /* empty */
  40 #define ENTER_CCS(p)    /* empty */
  41 #define RET_BITMAP 0
  42 #endif
  43
  44 #define SELECTOR_CODE_UPD(offset) \
  45   IF_(stg_sel_ret_##offset##_upd_ret);                                  \
  46   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);                     \
  47   EF_(stg_sel_ret_##offset##_upd_ret) {                                 \
  48     FB_                                                                 \
  49       R1.p=(P_)R1.cl->payload[offset];                                  \
  50       GET_SAVED_CCCS;                                                   \
  51       Sp=Sp+sizeofW(StgHeader);                                         \
  52       JMP_(ENTRY_CODE(*R1.p));                                          \
  53     FE_                                                                 \
  54   }                                                                     \
  55                                                                         \
  56   EF_(stg_sel_##offset##_upd_entry);                                    \
  57   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");\
  58   EF_(stg_sel_##offset##_upd_entry) {                                   \
  59     FB_                                                                 \
  60       STK_CHK_NP(UPD_FRAME_SIZE,1,);                                    \
  61       UPD_BH_UPDATABLE(&stg_sel_##offset##_upd_info);                   \
  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       ENTER_CCS(R1.p);                                                  \
 108       SAVE_CCCS(NOUPD_FRAME_SIZE);                                      \
 109       Sp[-NOUPD_FRAME_SIZE]=(W_)&stg_sel_ret_##offset##_noupd_info;     \
 110       R1.p = (P_)R1.cl->payload[0];                                     \
 111       Sp=Sp-NOUPD_FRAME_SIZE;                                           \
 112       JMP_(ENTRY_CODE(*R1.p));                                          \
 113     FE_                                                                 \
 114   }
 115
 116 SELECTOR_CODE_NOUPD(0);
 117 SELECTOR_CODE_NOUPD(1);
 118 SELECTOR_CODE_NOUPD(2);
 119 SELECTOR_CODE_NOUPD(3);
 120 SELECTOR_CODE_NOUPD(4);
 121 SELECTOR_CODE_NOUPD(5);
 122 SELECTOR_CODE_NOUPD(6);
 123 SELECTOR_CODE_NOUPD(7);
 124 SELECTOR_CODE_NOUPD(8);
 125 SELECTOR_CODE_NOUPD(9);
 126 SELECTOR_CODE_NOUPD(10);
 127 SELECTOR_CODE_NOUPD(11);
 128 SELECTOR_CODE_NOUPD(12);
 129 SELECTOR_CODE_NOUPD(13);
 130 SELECTOR_CODE_NOUPD(14);
 131 SELECTOR_CODE_NOUPD(15);
 132
 133 /* -----------------------------------------------------------------------------
 134    Apply thunks
 135
 136    An apply thunk is a thunk of the form
 137
 138                 let z = [x1...xn] \u x1...xn
 139                 in ...
 140
 141    We pre-compile some of these because the code is always the same.
 142
 143    These have to be independent of the update frame size, so the code
 144    works when profiling etc.
 145    -------------------------------------------------------------------------- */
 146
 147 FN_(stg_ap_1_upd_entry);
 148 FN_(stg_ap_2_upd_entry);
 149 FN_(stg_ap_3_upd_entry);
 150 FN_(stg_ap_4_upd_entry);
 151 FN_(stg_ap_5_upd_entry);
 152 FN_(stg_ap_6_upd_entry);
 153 FN_(stg_ap_7_upd_entry);
 154 FN_(stg_ap_8_upd_entry);
 155
 156 #define UF_SIZE (sizeofW(StgUpdateFrame))
 157
 158 /* stg_ap_1_upd_info is a bit redundant, but there appears to be a bug
 159  * in the compiler that means stg_ap_1 is generated occasionally (ToDo)
 160  */
 161
 162 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");
 163 FN_(stg_ap_1_upd_entry) {
 164   FB_
 165   STK_CHK_NP(sizeofW(StgUpdateFrame),1,);
 166   UPD_BH_UPDATABLE(&stg_ap_1_upd_info);
 167   ENTER_CCS(R1.p);
 168   PUSH_UPD_FRAME(R1.p,0);
 169   R1.p=(P_)(R1.cl->payload[0]);
 170   Sp = Sp - sizeofW(StgUpdateFrame);
 171   JMP_(ENTRY_CODE(*R1.p));
 172   FE_
 173 }
 174
 175 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");
 176 FN_(stg_ap_2_upd_entry) {
 177   FB_
 178   STK_CHK_NP(sizeofW(StgUpdateFrame)+1,1,);
 179   UPD_BH_UPDATABLE(&stg_ap_2_upd_info);
 180   ENTER_CCS(R1.p);
 181   PUSH_UPD_FRAME(R1.p,0);
 182   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[1]);
 183   R1.p=(P_)(R1.cl->payload[0]);
 184   Sp = Sp - (sizeofW(StgUpdateFrame)+1);
 185   JMP_(ENTRY_CODE(*R1.p));
 186   FE_
 187 }
 188
 189 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");
 190 FN_(stg_ap_3_upd_entry) {
 191   FB_
 192   STK_CHK_NP(sizeofW(StgUpdateFrame)+2,1,);
 193   UPD_BH_UPDATABLE(&stg_ap_3_upd_info);
 194   ENTER_CCS(R1.p);
 195   PUSH_UPD_FRAME(R1.p,0);
 196   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[2]);
 197   Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[1]);
 198   R1.p=(P_)(R1.cl->payload[0]);
 199   Sp = Sp - (sizeofW(StgUpdateFrame)+2);
 200   JMP_(ENTRY_CODE(*R1.p));
 201   FE_
 202 }
 203
 204 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");
 205 FN_(stg_ap_4_upd_entry) {
 206   FB_
 207   STK_CHK_NP(sizeofW(StgUpdateFrame)+3,1,);
 208   UPD_BH_UPDATABLE(&stg_ap_4_upd_info);
 209   ENTER_CCS(R1.p);
 210   PUSH_UPD_FRAME(R1.p,0);
 211   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[3]);
 212   Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[2]);
 213   Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[1]);
 214   R1.p=(P_)(R1.cl->payload[0]);
 215   Sp = Sp - (sizeofW(StgUpdateFrame)+3);
 216   JMP_(ENTRY_CODE(*R1.p));
 217   FE_
 218 }
 219
 220 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");
 221 FN_(stg_ap_5_upd_entry) {
 222   FB_
 223   STK_CHK_NP(sizeofW(StgUpdateFrame)+4,1,);
 224   UPD_BH_UPDATABLE(&stg_ap_5_upd_info);
 225   ENTER_CCS(R1.p);
 226   PUSH_UPD_FRAME(R1.p,0);
 227   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[4]);
 228   Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[3]);
 229   Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[2]);
 230   Sp[-UF_SIZE-4]=(W_)(R1.cl->payload[1]);
 231   R1.p=(P_)(R1.cl->payload[0]);
 232   Sp = Sp - (sizeofW(StgUpdateFrame)+4);
 233   JMP_(ENTRY_CODE(*R1.p));
 234   FE_
 235 }
 236
 237 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");
 238 FN_(stg_ap_6_upd_entry) {
 239   FB_
 240   STK_CHK_NP(sizeofW(StgUpdateFrame)+5,1,);
 241   UPD_BH_UPDATABLE(&stg_ap_6_upd_info);
 242   ENTER_CCS(R1.p);
 243   PUSH_UPD_FRAME(R1.p,0);
 244   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[5]);
 245   Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[4]);
 246   Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[3]);
 247   Sp[-UF_SIZE-4]=(W_)(R1.cl->payload[2]);
 248   Sp[-UF_SIZE-5]=(W_)(R1.cl->payload[1]);
 249   R1.p=(P_)(R1.cl->payload[0]);
 250   Sp = Sp - (sizeofW(StgUpdateFrame)+5);
 251   JMP_(ENTRY_CODE(*R1.p));
 252   FE_
 253 }
 254
 255 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");
 256 FN_(stg_ap_7_upd_entry) {
 257   FB_
 258   STK_CHK_NP(sizeofW(StgUpdateFrame)+6,1,);
 259   UPD_BH_UPDATABLE(&stg_ap_7_upd_info);
 260   ENTER_CCS(R1.p);
 261   PUSH_UPD_FRAME(R1.p,0);
 262   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[6]);
 263   Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[5]);
 264   Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[4]);
 265   Sp[-UF_SIZE-4]=(W_)(R1.cl->payload[3]);
 266   Sp[-UF_SIZE-5]=(W_)(R1.cl->payload[2]);
 267   Sp[-UF_SIZE-6]=(W_)(R1.cl->payload[1]);
 268   R1.p=(P_)(R1.cl->payload[0]);
 269   Sp = Sp - (sizeofW(StgUpdateFrame)+6);
 270   JMP_(ENTRY_CODE(*R1.p));
 271   FE_
 272 }
 273
 274 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");
 275 FN_(stg_ap_8_upd_entry) {
 276   FB_
 277   STK_CHK_NP(sizeofW(StgUpdateFrame)+7,1,);
 278   UPD_BH_UPDATABLE(&stg_ap_8_upd_info);
 279   ENTER_CCS(R1.p);
 280   PUSH_UPD_FRAME(R1.p,0);
 281   Sp[-UF_SIZE-1]=(W_)(R1.cl->payload[7]);
 282   Sp[-UF_SIZE-2]=(W_)(R1.cl->payload[6]);
 283   Sp[-UF_SIZE-3]=(W_)(R1.cl->payload[5]);
 284   Sp[-UF_SIZE-4]=(W_)(R1.cl->payload[4]);
 285   Sp[-UF_SIZE-5]=(W_)(R1.cl->payload[3]);
 286   Sp[-UF_SIZE-6]=(W_)(R1.cl->payload[2]);
 287   Sp[-UF_SIZE-7]=(W_)(R1.cl->payload[1]);
 288   R1.p=(P_)(R1.cl->payload[0]);
 289   Sp=Sp-10;
 290   JMP_(ENTRY_CODE(*R1.p));
 291   FE_
 292 }