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 #include "Updates.h"
  15
  16 /* -----------------------------------------------------------------------------
  17    The code for a thunk that simply extracts a field from a
  18    single-constructor datatype depends only on the offset of the field
  19    to be selected.
  20
  21    Here we define some canned "selector" thunks that do just that; any
  22    selector thunk appearing in a program will refer to one of these
  23    instead of being compiled independently.
  24
  25    The garbage collector spots selector thunks and reduces them if
  26    possible, in order to avoid space leaks resulting from lazy pattern
  27    matching.
  28    -------------------------------------------------------------------------- */
  29
  30 #ifdef PROFILING
  31 #define SAVE_CCS        W_ saved_ccs; saved_ccs = CCCS;
  32 #define RESTORE_CCS     CCCS = saved_ccs;
  33 #else
  34 #define SAVE_CCS        /* nothing */
  35 #define RESTORE_CCS     /* nothing */
  36 #endif
  37
  38 /*
  39  * TODO: On return, we can use a more efficient
  40  *       untagging (we know the constructor tag).
  41  *
  42  * When entering stg_sel_#_upd, we know R1 points to its closure,
  43  * so it's untagged.
  44  * The payload might be a thunk or a constructor,
  45  * so we enter it.
  46  *
  47  * When returning, we know for sure it is a constructor,
  48  * so we untag it before accessing the field.
  49  *
  50  */
  51 #ifdef PROFILING
  52 /* When profiling, we cannot shortcut by checking the tag,
  53  * because LDV profiling relies on entering closures to mark them as
  54  * "used".
  55  *
  56  * Note [untag for prof]: when we enter a closure, the convention is
  57  * that the closure pointer passed in the first argument is
  58  * *untagged*.  Without profiling we don't have to worry about this,
  59  * because we never enter a tagged pointer.
  60  */
  61 #define NEED_EVAL(__x__) 1
  62 #else
  63 #define NEED_EVAL(__x__) GETTAG(__x__) == 0
  64 #endif
  65
  66 #define SELECTOR_CODE_UPD(offset)                                       \
  67   INFO_TABLE_SELECTOR(stg_sel_##offset##_upd, offset, THUNK_SELECTOR, "stg_sel_upd", "stg_sel_upd") \
  68       (P_ node)                                                         \
  69   {                                                                     \
  70       P_ selectee, field, dest;                                         \
  71       TICK_ENT_DYN_THK();                                               \
  72       STK_CHK_NP(node);                                                 \
  73       UPD_BH_UPDATABLE(node);                                           \
  74       LDV_ENTER(node);                                                  \
  75       selectee = StgThunk_payload(node,0);                              \
  76       push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info,CCCS,0,node)) {    \
  77         ENTER_CCS_THUNK(node);                                          \
  78         if (NEED_EVAL(selectee)) {                                      \
  79           SAVE_CCS;                                                     \
  80           dest = UNTAG_IF_PROF(selectee); /* Note [untag for prof] */   \
  81           (P_ constr) = call %GET_ENTRY(dest) (dest);                   \
  82           RESTORE_CCS;                                                  \
  83           selectee = constr;                                            \
  84         }                                                               \
  85         field = StgClosure_payload(UNTAG(selectee),offset);             \
  86         jump stg_ap_0_fast(field);                                      \
  87      }                                                                  \
  88   }
  89   /* NOTE: no need to ENTER() here, we know the closure cannot
  90      evaluate to a function, because we're going to do a field
  91      selection on the result. */
  92
  93 SELECTOR_CODE_UPD(0)
  94 SELECTOR_CODE_UPD(1)
  95 SELECTOR_CODE_UPD(2)
  96 SELECTOR_CODE_UPD(3)
  97 SELECTOR_CODE_UPD(4)
  98 SELECTOR_CODE_UPD(5)
  99 SELECTOR_CODE_UPD(6)
 100 SELECTOR_CODE_UPD(7)
 101 SELECTOR_CODE_UPD(8)
 102 SELECTOR_CODE_UPD(9)
 103 SELECTOR_CODE_UPD(10)
 104 SELECTOR_CODE_UPD(11)
 105 SELECTOR_CODE_UPD(12)
 106 SELECTOR_CODE_UPD(13)
 107 SELECTOR_CODE_UPD(14)
 108 SELECTOR_CODE_UPD(15)
 109
 110
 111 #define SELECTOR_CODE_NOUPD(offset)                                     \
 112   INFO_TABLE_SELECTOR(stg_sel_##offset##_noupd, offset, THUNK_SELECTOR, "stg_sel_noupd", "stg_sel_noupd") \
 113       (P_ node)                                                         \
 114   {                                                                     \
 115       P_ selectee, field, dest;                                         \
 116       TICK_ENT_DYN_THK();                                               \
 117       STK_CHK_NP(node);                                                 \
 118       UPD_BH_UPDATABLE(node);                                           \
 119       LDV_ENTER(node);                                                  \
 120       selectee = StgThunk_payload(node,0);                              \
 121       ENTER_CCS_THUNK(node);                                            \
 122       if (NEED_EVAL(selectee)) {                                        \
 123           SAVE_CCS;                                                     \
 124           dest = UNTAG_IF_PROF(selectee); /* Note [untag for prof] */   \
 125           (P_ constr) = call %GET_ENTRY(dest) (dest);                   \
 126           RESTORE_CCS;                                                  \
 127           selectee = constr;                                            \
 128       }                                                                 \
 129       field = StgClosure_payload(UNTAG(selectee),offset);               \
 130       jump stg_ap_0_fast(field);                                        \
 131   }
 132
 133
 134 SELECTOR_CODE_NOUPD(0)
 135 SELECTOR_CODE_NOUPD(1)
 136 SELECTOR_CODE_NOUPD(2)
 137 SELECTOR_CODE_NOUPD(3)
 138 SELECTOR_CODE_NOUPD(4)
 139 SELECTOR_CODE_NOUPD(5)
 140 SELECTOR_CODE_NOUPD(6)
 141 SELECTOR_CODE_NOUPD(7)
 142 SELECTOR_CODE_NOUPD(8)
 143 SELECTOR_CODE_NOUPD(9)
 144 SELECTOR_CODE_NOUPD(10)
 145 SELECTOR_CODE_NOUPD(11)
 146 SELECTOR_CODE_NOUPD(12)
 147 SELECTOR_CODE_NOUPD(13)
 148 SELECTOR_CODE_NOUPD(14)
 149 SELECTOR_CODE_NOUPD(15)
 150
 151 /* -----------------------------------------------------------------------------
 152    Apply thunks
 153
 154    An apply thunk is a thunk of the form
 155
 156                 let z = [x1...xn] \u x1...xn
 157                 in ...
 158
 159    We pre-compile some of these because the code is always the same.
 160
 161    These have to be independent of the update frame size, so the code
 162    works when profiling etc.
 163    -------------------------------------------------------------------------- */
 164
 165 /* stg_ap_1_upd_info is a bit redundant, but there appears to be a bug
 166  * in the compiler that means stg_ap_1 is generated occasionally (ToDo)
 167  */
 168
 169 INFO_TABLE(stg_ap_1_upd,1,0,THUNK_1_0,"stg_ap_1_upd_info","stg_ap_1_upd_info")
 170     (P_ node)
 171 {
 172     TICK_ENT_DYN_THK();
 173     STK_CHK_NP(node);
 174     UPD_BH_UPDATABLE(node);
 175     LDV_ENTER(node);
 176     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
 177         ENTER_CCS_THUNK(node);
 178         jump stg_ap_0_fast
 179             (StgThunk_payload(node,0));
 180     }
 181 }
 182
 183 INFO_TABLE(stg_ap_2_upd,2,0,THUNK_2_0,"stg_ap_2_upd_info","stg_ap_2_upd_info")
 184     (P_ node)
 185 {
 186     TICK_ENT_DYN_THK();
 187     STK_CHK_NP(node);
 188     UPD_BH_UPDATABLE(node);
 189     LDV_ENTER(node);
 190     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
 191         ENTER_CCS_THUNK(node);
 192         jump stg_ap_p_fast
 193             (StgThunk_payload(node,0),
 194              StgThunk_payload(node,1));
 195     }
 196 }
 197
 198 INFO_TABLE(stg_ap_3_upd,3,0,THUNK,"stg_ap_3_upd_info","stg_ap_3_upd_info")
 199     (P_ node)
 200 {
 201     TICK_ENT_DYN_THK();
 202     STK_CHK_NP(node);
 203     UPD_BH_UPDATABLE(node);
 204     LDV_ENTER(node);
 205     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
 206         ENTER_CCS_THUNK(node);
 207         jump stg_ap_pp_fast
 208             (StgThunk_payload(node,0),
 209              StgThunk_payload(node,1),
 210              StgThunk_payload(node,2));
 211     }
 212 }
 213
 214 INFO_TABLE(stg_ap_4_upd,4,0,THUNK,"stg_ap_4_upd_info","stg_ap_4_upd_info")
 215     (P_ node)
 216 {
 217     TICK_ENT_DYN_THK();
 218     STK_CHK_NP(node);
 219     UPD_BH_UPDATABLE(node);
 220     LDV_ENTER(node);
 221     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
 222         ENTER_CCS_THUNK(node);
 223         jump stg_ap_ppp_fast
 224             (StgThunk_payload(node,0),
 225              StgThunk_payload(node,1),
 226              StgThunk_payload(node,2),
 227              StgThunk_payload(node,3));
 228     }
 229 }
 230
 231 INFO_TABLE(stg_ap_5_upd,5,0,THUNK,"stg_ap_5_upd_info","stg_ap_5_upd_info")
 232     (P_ node)
 233 {
 234     TICK_ENT_DYN_THK();
 235     STK_CHK_NP(node);
 236     UPD_BH_UPDATABLE(node);
 237     LDV_ENTER(node);
 238     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
 239         ENTER_CCS_THUNK(node);
 240         jump stg_ap_pppp_fast
 241             (StgThunk_payload(node,0),
 242              StgThunk_payload(node,1),
 243              StgThunk_payload(node,2),
 244              StgThunk_payload(node,3),
 245              StgThunk_payload(node,4));
 246     }
 247 }
 248
 249 INFO_TABLE(stg_ap_6_upd,6,0,THUNK,"stg_ap_6_upd_info","stg_ap_6_upd_info")
 250     (P_ node)
 251 {
 252     TICK_ENT_DYN_THK();
 253     STK_CHK_NP(node);
 254     UPD_BH_UPDATABLE(node);
 255     LDV_ENTER(node);
 256     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
 257         ENTER_CCS_THUNK(node);
 258         jump stg_ap_ppppp_fast
 259             (StgThunk_payload(node,0),
 260              StgThunk_payload(node,1),
 261              StgThunk_payload(node,2),
 262              StgThunk_payload(node,3),
 263              StgThunk_payload(node,4),
 264              StgThunk_payload(node,5));
 265     }
 266 }
 267
 268 INFO_TABLE(stg_ap_7_upd,7,0,THUNK,"stg_ap_7_upd_info","stg_ap_7_upd_info")
 269     (P_ node)
 270 {
 271     TICK_ENT_DYN_THK();
 272     STK_CHK_NP(node);
 273     UPD_BH_UPDATABLE(node);
 274     LDV_ENTER(node);
 275     push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
 276       ENTER_CCS_THUNK(node);
 277       jump stg_ap_pppppp_fast
 278           (StgThunk_payload(node,0),
 279            StgThunk_payload(node,1),
 280            StgThunk_payload(node,2),
 281            StgThunk_payload(node,3),
 282            StgThunk_payload(node,4),
 283            StgThunk_payload(node,5),
 284            StgThunk_payload(node,6));
 285     }
 286 }