rts/StgStdThunks.cmm

   1 /* -----------------------------------------------------------------------------
   2  *
   3  * (c) The University of Glasgow, 1998-2004
   4  *
   5  * Canned "Standard Form" Thunks
   6  *
   7  * This file is written in a subset of C--, extended with various
   8  * features specific to GHC.  It is compiled by GHC directly.  For the
   9  * syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
  10  *
  11  * ---------------------------------------------------------------------------*/
  12
  13 #include "Cmm.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 WITHUPD_FRAME_SIZE  (SIZEOF_StgUpdateFrame + SIZEOF_StgHeader)
  30 #define NOUPD_FRAME_SIZE    (SIZEOF_StgHeader)
  31
  32 #ifdef PROFILING
  33 #define SAVE_CCCS(fs)   StgHeader_ccs(Sp-fs) = W_[CCCS]
  34 #define GET_SAVED_CCCS  W_[CCCS] = StgHeader_ccs(Sp)
  35 #define RET_PARAMS      W_ unused1, W_ unused2
  36 #else
  37 #define SAVE_CCCS(fs)   /* empty */
  38 #define GET_SAVED_CCCS  /* empty */
  39 #define RET_PARAMS
  40 #endif
  41
  42 /*
  43  * TODO: On return, we can use a more efficient
  44  *       untagging (we know the constructor tag).
  45  *
  46  * When entering stg_sel_#_upd, we know R1 points to its closure,
  47  * so it's untagged.
  48  * The payload might be a thunk or a constructor,
  49  * so we enter it.
  50  *
  51  * When returning, we know for sure it is a constructor,
  52  * so we untag it before accessing the field.
  53  *
  54  */
  55 #define SELECTOR_CODE_UPD(offset) \
  56   INFO_TABLE_RET(stg_sel_ret_##offset##_upd, RET_SMALL, RET_PARAMS)     \
  57   {                                                                     \
  58       R1 = StgClosure_payload(UNTAG(R1),offset);                        \
  59       GET_SAVED_CCCS;                                                   \
  60       Sp = Sp + SIZEOF_StgHeader;                                       \
  61       ENTER();                                                          \
  62   }                                                                     \
  63                                                                         \
  64   INFO_TABLE_SELECTOR(stg_sel_##offset##_upd, offset, THUNK_SELECTOR, "stg_sel_upd", "stg_sel_upd") \
  65   {                                                                     \
  66       TICK_ENT_DYN_THK();                                               \
  67       STK_CHK_NP(WITHUPD_FRAME_SIZE);                                   \
  68       UPD_BH_UPDATABLE();                                               \
  69       LDV_ENTER(R1);                                                    \
  70       PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);                   \
  71       ENTER_CCS_THUNK(R1);                                              \
  72       SAVE_CCCS(WITHUPD_FRAME_SIZE);                                    \
  73       W_[Sp-WITHUPD_FRAME_SIZE] = stg_sel_ret_##offset##_upd_info;      \
  74       Sp = Sp - WITHUPD_FRAME_SIZE;                                     \
  75       R1 = StgThunk_payload(R1,0);                                      \
  76       if (GETTAG(R1) != 0) {                                            \
  77           jump RET_LBL(stg_sel_ret_##offset##_upd);                     \
  78       }                                                                 \
  79       jump %GET_ENTRY(R1);                                              \
  80   }
  81   /* NOTE: no need to ENTER() here, we know the closure cannot evaluate to a function,
  82      because we're going to do a field selection on the result. */
  83
  84 SELECTOR_CODE_UPD(0)
  85 SELECTOR_CODE_UPD(1)
  86 SELECTOR_CODE_UPD(2)
  87 SELECTOR_CODE_UPD(3)
  88 SELECTOR_CODE_UPD(4)
  89 SELECTOR_CODE_UPD(5)
  90 SELECTOR_CODE_UPD(6)
  91 SELECTOR_CODE_UPD(7)
  92 SELECTOR_CODE_UPD(8)
  93 SELECTOR_CODE_UPD(9)
  94 SELECTOR_CODE_UPD(10)
  95 SELECTOR_CODE_UPD(11)
  96 SELECTOR_CODE_UPD(12)
  97 SELECTOR_CODE_UPD(13)
  98 SELECTOR_CODE_UPD(14)
  99 SELECTOR_CODE_UPD(15)
 100
 101 #define SELECTOR_CODE_NOUPD(offset) \
 102   INFO_TABLE_RET(stg_sel_ret_##offset##_noupd, RET_SMALL, RET_PARAMS)   \
 103   {                                                                     \
 104       R1 = StgClosure_payload(UNTAG(R1),offset);                        \
 105       GET_SAVED_CCCS;                                                   \
 106       Sp = Sp + SIZEOF_StgHeader;                                       \
 107       ENTER();                                                          \
 108   }                                                                     \
 109                                                                         \
 110   INFO_TABLE_SELECTOR(stg_sel_##offset##_noupd, offset, THUNK_SELECTOR, "stg_sel_noupd", "stg_sel_noupd")\
 111   {                                                                     \
 112       TICK_ENT_DYN_THK();                                               \
 113       STK_CHK_NP(NOUPD_FRAME_SIZE);                                     \
 114       UPD_BH_SINGLE_ENTRY();                                            \
 115       LDV_ENTER(R1);                                                    \
 116       TICK_UPDF_OMITTED();                                              \
 117       ENTER_CCS_THUNK(R1);                                              \
 118       SAVE_CCCS(NOUPD_FRAME_SIZE);                                      \
 119       W_[Sp-NOUPD_FRAME_SIZE] = stg_sel_ret_##offset##_noupd_info;      \
 120       Sp = Sp - NOUPD_FRAME_SIZE;                                       \
 121       R1 = StgThunk_payload(R1,0);                                      \
 122       if (GETTAG(R1) != 0) {                                            \
 123           jump RET_LBL(stg_sel_ret_##offset##_noupd);                   \
 124       }                                                                 \
 125       jump %GET_ENTRY(R1);                                              \
 126   }
 127
 128 SELECTOR_CODE_NOUPD(0)
 129 SELECTOR_CODE_NOUPD(1)
 130 SELECTOR_CODE_NOUPD(2)
 131 SELECTOR_CODE_NOUPD(3)
 132 SELECTOR_CODE_NOUPD(4)
 133 SELECTOR_CODE_NOUPD(5)
 134 SELECTOR_CODE_NOUPD(6)
 135 SELECTOR_CODE_NOUPD(7)
 136 SELECTOR_CODE_NOUPD(8)
 137 SELECTOR_CODE_NOUPD(9)
 138 SELECTOR_CODE_NOUPD(10)
 139 SELECTOR_CODE_NOUPD(11)
 140 SELECTOR_CODE_NOUPD(12)
 141 SELECTOR_CODE_NOUPD(13)
 142 SELECTOR_CODE_NOUPD(14)
 143 SELECTOR_CODE_NOUPD(15)
 144
 145 /* -----------------------------------------------------------------------------
 146    Apply thunks
 147
 148    An apply thunk is a thunk of the form
 149
 150                 let z = [x1...xn] \u x1...xn
 151                 in ...
 152
 153    We pre-compile some of these because the code is always the same.
 154
 155    These have to be independent of the update frame size, so the code
 156    works when profiling etc.
 157    -------------------------------------------------------------------------- */
 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(stg_ap_1_upd,1,0,THUNK_1_0,"stg_ap_1_upd_info","stg_ap_1_upd_info")
 164 {
 165   TICK_ENT_DYN_THK();
 166   STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(1));
 167   UPD_BH_UPDATABLE();
 168   LDV_ENTER(R1);
 169   ENTER_CCS_THUNK(R1);
 170   PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
 171   R1 = StgThunk_payload(R1,0);
 172   Sp = Sp - SIZEOF_StgUpdateFrame;
 173   jump stg_ap_0_fast;
 174 }
 175
 176 INFO_TABLE(stg_ap_2_upd,2,0,THUNK_2_0,"stg_ap_2_upd_info","stg_ap_2_upd_info")
 177 {
 178   TICK_ENT_DYN_THK();
 179   STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(2));
 180   UPD_BH_UPDATABLE();
 181   LDV_ENTER(R1);
 182   ENTER_CCS_THUNK(R1);
 183   PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
 184   W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,1);
 185   R1 = StgThunk_payload(R1,0);
 186   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(1);
 187   Sp_adj(-1); // for stg_ap_*_ret
 188   TICK_UNKNOWN_CALL();
 189   TICK_SLOW_CALL_p();
 190   jump RET_LBL(stg_ap_p);
 191 }
 192
 193 INFO_TABLE(stg_ap_3_upd,3,0,THUNK,"stg_ap_3_upd_info","stg_ap_3_upd_info")
 194 {
 195   TICK_ENT_DYN_THK();
 196   STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(3));
 197   UPD_BH_UPDATABLE();
 198   LDV_ENTER(R1);
 199   ENTER_CCS_THUNK(R1);
 200   PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
 201   W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,2);
 202   W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,1);
 203   R1 = StgThunk_payload(R1,0);
 204   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(2);
 205   Sp_adj(-1); // for stg_ap_*_ret
 206   TICK_UNKNOWN_CALL();
 207   TICK_SLOW_CALL_pp();
 208   jump RET_LBL(stg_ap_pp);
 209 }
 210
 211 INFO_TABLE(stg_ap_4_upd,4,0,THUNK,"stg_ap_4_upd_info","stg_ap_4_upd_info")
 212 {
 213   TICK_ENT_DYN_THK();
 214   STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(4));
 215   UPD_BH_UPDATABLE();
 216   LDV_ENTER(R1);
 217   ENTER_CCS_THUNK(R1);
 218   PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
 219   W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,3);
 220   W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,2);
 221   W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,1);
 222   R1 = StgThunk_payload(R1,0);
 223   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(3);
 224   Sp_adj(-1); // for stg_ap_*_ret
 225   TICK_UNKNOWN_CALL();
 226   TICK_SLOW_CALL_ppp();
 227   jump RET_LBL(stg_ap_ppp);
 228 }
 229
 230 INFO_TABLE(stg_ap_5_upd,5,0,THUNK,"stg_ap_5_upd_info","stg_ap_5_upd_info")
 231 {
 232   TICK_ENT_DYN_THK();
 233   STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(5));
 234   UPD_BH_UPDATABLE();
 235   LDV_ENTER(R1);
 236   ENTER_CCS_THUNK(R1);
 237   PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
 238   W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,4);
 239   W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,3);
 240   W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,2);
 241   W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgThunk_payload(R1,1);
 242   R1 = StgThunk_payload(R1,0);
 243   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(4);
 244   Sp_adj(-1); // for stg_ap_*_ret
 245   TICK_UNKNOWN_CALL();
 246   TICK_SLOW_CALL_pppp();
 247   jump RET_LBL(stg_ap_pppp);
 248 }
 249
 250 INFO_TABLE(stg_ap_6_upd,6,0,THUNK,"stg_ap_6_upd_info","stg_ap_6_upd_info")
 251 {
 252   TICK_ENT_DYN_THK();
 253   STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(6));
 254   UPD_BH_UPDATABLE();
 255   LDV_ENTER(R1);
 256   ENTER_CCS_THUNK(R1);
 257   PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
 258   W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,5);
 259   W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,4);
 260   W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,3);
 261   W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgThunk_payload(R1,2);
 262   W_[Sp-SIZEOF_StgUpdateFrame-WDS(5)] = StgThunk_payload(R1,1);
 263   R1 = StgThunk_payload(R1,0);
 264   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(5);
 265   Sp_adj(-1); // for stg_ap_*_ret
 266   TICK_UNKNOWN_CALL();
 267   TICK_SLOW_CALL_ppppp();
 268   jump RET_LBL(stg_ap_ppppp);
 269 }
 270
 271 INFO_TABLE(stg_ap_7_upd,7,0,THUNK,"stg_ap_7_upd_info","stg_ap_7_upd_info")
 272 {
 273   TICK_ENT_DYN_THK();
 274   STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(7));
 275   UPD_BH_UPDATABLE();
 276   LDV_ENTER(R1);
 277   ENTER_CCS_THUNK(R1);
 278   PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
 279   W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,6);
 280   W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,5);
 281   W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,4);
 282   W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgThunk_payload(R1,3);
 283   W_[Sp-SIZEOF_StgUpdateFrame-WDS(5)] = StgThunk_payload(R1,2);
 284   W_[Sp-SIZEOF_StgUpdateFrame-WDS(6)] = StgThunk_payload(R1,1);
 285   R1 = StgThunk_payload(R1,0);
 286   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(6);
 287   Sp_adj(-1); // for stg_ap_*_ret
 288   TICK_UNKNOWN_CALL();
 289   TICK_SLOW_CALL_pppppp();
 290   jump RET_LBL(stg_ap_pppppp);
 291 }