StgStdThunks.cmm 10 KB
Newer Older
1 2 3 4 5 6 7 8
/* -----------------------------------------------------------------------------
 *
 * (c) The University of Glasgow, 1998-2004
 *
 * Canned "Standard Form" Thunks
 *
 * This file is written in a subset of C--, extended with various
 * features specific to GHC.  It is compiled by GHC directly.  For the
9
 * syntax of .cmm files, see the parser in ghc/compiler/GHC/Cmm/Parser.y.
10 11 12 13
 *
 * ---------------------------------------------------------------------------*/

#include "Cmm.h"
14
#include "Updates.h"
15 16 17 18 19 20 21 22 23 24 25 26 27 28 29

/* -----------------------------------------------------------------------------
   The code for a thunk that simply extracts a field from a
   single-constructor datatype depends only on the offset of the field
   to be selected.

   Here we define some canned "selector" thunks that do just that; any
   selector thunk appearing in a program will refer to one of these
   instead of being compiled independently.

   The garbage collector spots selector thunks and reduces them if
   possible, in order to avoid space leaks resulting from lazy pattern
   matching.
   -------------------------------------------------------------------------- */

Ben Gamari's avatar
Ben Gamari committed
30
#if defined(PROFILING)
Simon Marlow's avatar
Simon Marlow committed
31 32
#define SAVE_CCS        W_ saved_ccs; saved_ccs = CCCS;
#define RESTORE_CCS     CCCS = saved_ccs;
33
#else
Simon Marlow's avatar
Simon Marlow committed
34 35
#define SAVE_CCS        /* nothing */
#define RESTORE_CCS     /* nothing */
36 37
#endif

Simon Marlow's avatar
Simon Marlow committed
38 39 40
/*
 * TODO: On return, we can use a more efficient
 *       untagging (we know the constructor tag).
41
 *
Simon Marlow's avatar
Simon Marlow committed
42 43 44 45 46 47 48 49 50
 * When entering stg_sel_#_upd, we know R1 points to its closure,
 * so it's untagged.
 * The payload might be a thunk or a constructor,
 * so we enter it.
 *
 * When returning, we know for sure it is a constructor,
 * so we untag it before accessing the field.
 *
 */
Ben Gamari's avatar
Ben Gamari committed
51
#if defined(PROFILING)
52 53 54 55 56 57 58 59 60
/* When profiling, we cannot shortcut by checking the tag,
 * because LDV profiling relies on entering closures to mark them as
 * "used".
 *
 * Note [untag for prof]: when we enter a closure, the convention is
 * that the closure pointer passed in the first argument is
 * *untagged*.  Without profiling we don't have to worry about this,
 * because we never enter a tagged pointer.
 */
61
#define NEED_EVAL(__x__) 1
62
#else
63
#define NEED_EVAL(__x__) GETTAG(__x__) == 0
64 65 66
#endif

#define SELECTOR_CODE_UPD(offset)                                       \
67
  INFO_TABLE_SELECTOR(stg_sel_##offset##_upd, offset, THUNK_SELECTOR, "stg_sel_upd", "stg_sel_upd") \
68 69
      (P_ node)                                                         \
  {                                                                     \
70
      P_ selectee, field, dest;                                         \
71 72 73 74 75
      TICK_ENT_DYN_THK();                                               \
      STK_CHK_NP(node);                                                 \
      UPD_BH_UPDATABLE(node);                                           \
      LDV_ENTER(node);                                                  \
      selectee = StgThunk_payload(node,0);                              \
Simon Marlow's avatar
Simon Marlow committed
76
      push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info,CCCS,0,node)) {    \
Simon Marlow's avatar
Simon Marlow committed
77
        ENTER_CCS_THUNK(node);                                          \
78
        if (NEED_EVAL(selectee)) {                                      \
Simon Marlow's avatar
Simon Marlow committed
79
          SAVE_CCS;                                                     \
80 81
          dest = UNTAG_IF_PROF(selectee); /* Note [untag for prof] */   \
          (P_ constr) = call %GET_ENTRY(dest) (dest);                   \
Simon Marlow's avatar
Simon Marlow committed
82
          RESTORE_CCS;                                                  \
83 84 85 86 87
          selectee = constr;                                            \
        }                                                               \
        field = StgClosure_payload(UNTAG(selectee),offset);             \
        jump stg_ap_0_fast(field);                                      \
     }                                                                  \
88
  }
89 90 91
  /* NOTE: no need to ENTER() here, we know the closure cannot
     evaluate to a function, because we're going to do a field
     selection on the result. */
92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109

SELECTOR_CODE_UPD(0)
SELECTOR_CODE_UPD(1)
SELECTOR_CODE_UPD(2)
SELECTOR_CODE_UPD(3)
SELECTOR_CODE_UPD(4)
SELECTOR_CODE_UPD(5)
SELECTOR_CODE_UPD(6)
SELECTOR_CODE_UPD(7)
SELECTOR_CODE_UPD(8)
SELECTOR_CODE_UPD(9)
SELECTOR_CODE_UPD(10)
SELECTOR_CODE_UPD(11)
SELECTOR_CODE_UPD(12)
SELECTOR_CODE_UPD(13)
SELECTOR_CODE_UPD(14)
SELECTOR_CODE_UPD(15)

110 111 112 113 114

#define SELECTOR_CODE_NOUPD(offset)                                     \
  INFO_TABLE_SELECTOR(stg_sel_##offset##_noupd, offset, THUNK_SELECTOR, "stg_sel_noupd", "stg_sel_noupd") \
      (P_ node)                                                         \
  {                                                                     \
115
      P_ selectee, field, dest;                                         \
116 117 118 119 120
      TICK_ENT_DYN_THK();                                               \
      STK_CHK_NP(node);                                                 \
      UPD_BH_UPDATABLE(node);                                           \
      LDV_ENTER(node);                                                  \
      selectee = StgThunk_payload(node,0);                              \
121
      ENTER_CCS_THUNK(node);                                            \
122
      if (NEED_EVAL(selectee)) {                                        \
Simon Marlow's avatar
Simon Marlow committed
123
          SAVE_CCS;                                                     \
124 125
          dest = UNTAG_IF_PROF(selectee); /* Note [untag for prof] */   \
          (P_ constr) = call %GET_ENTRY(dest) (dest);                   \
Simon Marlow's avatar
Simon Marlow committed
126
          RESTORE_CCS;                                                  \
127
          selectee = constr;                                            \
Simon Marlow's avatar
Simon Marlow committed
128
      }                                                                 \
129 130
      field = StgClosure_payload(UNTAG(selectee),offset);               \
      jump stg_ap_0_fast(field);                                        \
131 132
  }

133

134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154
SELECTOR_CODE_NOUPD(0)
SELECTOR_CODE_NOUPD(1)
SELECTOR_CODE_NOUPD(2)
SELECTOR_CODE_NOUPD(3)
SELECTOR_CODE_NOUPD(4)
SELECTOR_CODE_NOUPD(5)
SELECTOR_CODE_NOUPD(6)
SELECTOR_CODE_NOUPD(7)
SELECTOR_CODE_NOUPD(8)
SELECTOR_CODE_NOUPD(9)
SELECTOR_CODE_NOUPD(10)
SELECTOR_CODE_NOUPD(11)
SELECTOR_CODE_NOUPD(12)
SELECTOR_CODE_NOUPD(13)
SELECTOR_CODE_NOUPD(14)
SELECTOR_CODE_NOUPD(15)

/* -----------------------------------------------------------------------------
   Apply thunks

   An apply thunk is a thunk of the form
155 156 157

                let z = [x1...xn] \u x1...xn
                in ...
158 159 160 161 162 163 164 165 166 167 168

   We pre-compile some of these because the code is always the same.

   These have to be independent of the update frame size, so the code
   works when profiling etc.
   -------------------------------------------------------------------------- */

/* stg_ap_1_upd_info is a bit redundant, but there appears to be a bug
 * in the compiler that means stg_ap_1 is generated occasionally (ToDo)
 */

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 173 174 175
    TICK_ENT_DYN_THK();
    STK_CHK_NP(node);
    UPD_BH_UPDATABLE(node);
    LDV_ENTER(node);
Simon Marlow's avatar
Simon Marlow committed
176
    push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
Simon Marlow's avatar
Simon Marlow committed
177
        ENTER_CCS_THUNK(node);
178 179 180
        jump stg_ap_0_fast
            (StgThunk_payload(node,0));
    }
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 187 188 189
    TICK_ENT_DYN_THK();
    STK_CHK_NP(node);
    UPD_BH_UPDATABLE(node);
    LDV_ENTER(node);
Simon Marlow's avatar
Simon Marlow committed
190
    push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
Simon Marlow's avatar
Simon Marlow committed
191
        ENTER_CCS_THUNK(node);
192 193 194 195
        jump stg_ap_p_fast
            (StgThunk_payload(node,0),
             StgThunk_payload(node,1));
    }
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 202 203 204
    TICK_ENT_DYN_THK();
    STK_CHK_NP(node);
    UPD_BH_UPDATABLE(node);
    LDV_ENTER(node);
Simon Marlow's avatar
Simon Marlow committed
205
    push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
Simon Marlow's avatar
Simon Marlow committed
206
        ENTER_CCS_THUNK(node);
207 208 209 210 211
        jump stg_ap_pp_fast
            (StgThunk_payload(node,0),
             StgThunk_payload(node,1),
             StgThunk_payload(node,2));
    }
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 218 219 220
    TICK_ENT_DYN_THK();
    STK_CHK_NP(node);
    UPD_BH_UPDATABLE(node);
    LDV_ENTER(node);
Simon Marlow's avatar
Simon Marlow committed
221
    push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
Simon Marlow's avatar
Simon Marlow committed
222
        ENTER_CCS_THUNK(node);
223 224 225 226 227 228
        jump stg_ap_ppp_fast
            (StgThunk_payload(node,0),
             StgThunk_payload(node,1),
             StgThunk_payload(node,2),
             StgThunk_payload(node,3));
    }
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 235 236 237
    TICK_ENT_DYN_THK();
    STK_CHK_NP(node);
    UPD_BH_UPDATABLE(node);
    LDV_ENTER(node);
Simon Marlow's avatar
Simon Marlow committed
238
    push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
Simon Marlow's avatar
Simon Marlow committed
239
        ENTER_CCS_THUNK(node);
240 241 242 243 244 245 246
        jump stg_ap_pppp_fast
            (StgThunk_payload(node,0),
             StgThunk_payload(node,1),
             StgThunk_payload(node,2),
             StgThunk_payload(node,3),
             StgThunk_payload(node,4));
    }
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 253 254 255
    TICK_ENT_DYN_THK();
    STK_CHK_NP(node);
    UPD_BH_UPDATABLE(node);
    LDV_ENTER(node);
Simon Marlow's avatar
Simon Marlow committed
256
    push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
Simon Marlow's avatar
Simon Marlow committed
257
        ENTER_CCS_THUNK(node);
258 259 260 261 262 263 264 265
        jump stg_ap_ppppp_fast
            (StgThunk_payload(node,0),
             StgThunk_payload(node,1),
             StgThunk_payload(node,2),
             StgThunk_payload(node,3),
             StgThunk_payload(node,4),
             StgThunk_payload(node,5));
    }
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 272 273 274
    TICK_ENT_DYN_THK();
    STK_CHK_NP(node);
    UPD_BH_UPDATABLE(node);
    LDV_ENTER(node);
Simon Marlow's avatar
Simon Marlow committed
275
    push (UPDATE_FRAME_FIELDS(,,stg_upd_frame_info, CCCS, 0, node)) {
Simon Marlow's avatar
Simon Marlow committed
276
      ENTER_CCS_THUNK(node);
277 278 279 280 281 282 283 284 285
      jump stg_ap_pppppp_fast
          (StgThunk_payload(node,0),
           StgThunk_payload(node,1),
           StgThunk_payload(node,2),
           StgThunk_payload(node,3),
           StgThunk_payload(node,4),
           StgThunk_payload(node,5),
           StgThunk_payload(node,6));
    }
286
}