ghc/rts/Apply.cmm

   1 /* -----------------------------------------------------------------------------
   2  *
   3  * (c) The University of Glasgow 2004
   4  *
   5  * Application-related bits.
   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  * Evaluate a closure and return it.
  17  *
  18  *      stg_ap_0_info   <--- Sp
  19  *
  20  * NOTE: this needs to be a polymorphic return point, because we can't
  21  * be sure that the thing being evaluated is not a function.
  22  */
  23
  24 #if MAX_VECTORED_RTN > 8
  25 #error MAX_VECTORED_RTN has changed: please modify stg_ap_0 too.
  26 #endif
  27
  28 STRING(stg_ap_0_ret_str,"stg_ap_0_ret... ")
  29
  30 INFO_TABLE_RET( stg_ap_0,
  31                 0/*framsize*/, 0/*bitmap*/, RET_SMALL,
  32                 RET_LBL(stg_ap_0),
  33                 RET_LBL(stg_ap_0),
  34                 RET_LBL(stg_ap_0),
  35                 RET_LBL(stg_ap_0),
  36                 RET_LBL(stg_ap_0),
  37                 RET_LBL(stg_ap_0),
  38                 RET_LBL(stg_ap_0),
  39                 RET_LBL(stg_ap_0) )
  40 {
  41     // fn is in R1, no args on the stack
  42
  43     IF_DEBUG(apply,
  44         foreign "C" debugBelch(stg_ap_0_ret_str) [R1];
  45         foreign "C" printClosure(R1 "ptr") [R1]);
  46
  47     IF_DEBUG(sanity,
  48         foreign "C" checkStackChunk(Sp+WDS(1) "ptr",
  49                                     CurrentTSO + TSO_OFFSET_StgTSO_stack +
  50                                     WDS(StgTSO_stack_size(CurrentTSO)) "ptr") [R1]);
  51
  52     Sp_adj(1);
  53     ENTER();
  54 }
  55
  56 /* -----------------------------------------------------------------------------
  57    Entry Code for a PAP.
  58
  59    This entry code is *only* called by one of the stg_ap functions.
  60    On entry: Sp points to the remaining arguments on the stack.  If
  61    the stack check fails, we can just push the PAP on the stack and
  62    return to the scheduler.
  63
  64    On entry: R1 points to the PAP.  The rest of the function's
  65    arguments (apart from those that are already in the PAP) are on the
  66    stack, starting at Sp(0).  R2 contains an info table which
  67    describes these arguments, which is used in the event that the
  68    stack check in the entry code below fails.  The info table is
  69    currently one of the stg_ap_*_ret family, as this code is always
  70    entered from those functions.
  71
  72    The idea is to copy the chunk of stack from the PAP object onto the
  73    stack / into registers, and enter the function.
  74    -------------------------------------------------------------------------- */
  75
  76 INFO_TABLE(stg_PAP,/*special layout*/0,0,PAP,"PAP","PAP")
  77 {
  78   W_ Words;
  79   W_ pap;
  80
  81   pap = R1;
  82
  83   Words = TO_W_(StgPAP_n_args(pap));
  84
  85   //
  86   // Check for stack overflow and bump the stack pointer.
  87   // We have a hand-rolled stack check fragment here, because none of
  88   // the canned ones suit this situation.
  89   //
  90   if ((Sp - WDS(Words)) < SpLim) {
  91       // there is a return address in R2 in the event of a
  92       // stack check failure.  The various stg_apply functions arrange
  93       // this before calling stg_PAP_entry.
  94       Sp_adj(-1);
  95       Sp(0) = R2;
  96       jump stg_gc_unpt_r1;
  97   }
  98   Sp_adj(-Words);
  99
 100   // profiling
 101   TICK_ENT_PAP();
 102   LDV_ENTER(pap);
 103   // Enter PAP cost centre
 104   ENTER_CCS_PAP_CL(pap);
 105
 106   R1 = StgPAP_fun(pap);
 107
 108   // Reload the stack
 109   W_ i;
 110   W_ p;
 111   p = pap + SIZEOF_StgHeader + OFFSET_StgPAP_payload;
 112   i = 0;
 113 for:
 114   if (i < Words) {
 115     Sp(i) = W_[p];
 116     p = p + WDS(1);
 117     i = i + 1;
 118     goto for;
 119   }
 120
 121   // Off we go!
 122   TICK_ENT_VIA_NODE();
 123
 124 #ifdef NO_ARG_REGS
 125   jump %GET_ENTRY(R1);
 126 #else
 127       W_ info;
 128       info = %GET_FUN_INFO(R1);
 129       W_ type;
 130       type = TO_W_(StgFunInfoExtra_fun_type(info));
 131       if (type == ARG_GEN) {
 132           jump StgFunInfoExtra_slow_apply(info);
 133       }
 134       if (type == ARG_GEN_BIG) {
 135           jump StgFunInfoExtra_slow_apply(info);
 136       }
 137       if (type == ARG_BCO) {
 138           Sp_adj(-2);
 139           Sp(1) = R1;
 140           Sp(0) = stg_apply_interp_info;
 141           jump stg_yield_to_interpreter;
 142       }
 143       jump W_[stg_ap_stack_entries +
 144                 WDS(TO_W_(StgFunInfoExtra_fun_type(info)))];
 145 #endif
 146 }
 147
 148 /* -----------------------------------------------------------------------------
 149    Entry Code for an AP (a PAP with arity zero).
 150
 151    The entry code is very similar to a PAP, except there are no
 152    further arguments on the stack to worry about, so the stack check
 153    is simpler.  We must also push an update frame on the stack before
 154    applying the function.
 155    -------------------------------------------------------------------------- */
 156
 157 INFO_TABLE(stg_AP,/*special layout*/0,0,AP,"AP","AP")
 158 {
 159   W_ Words;
 160   W_ ap;
 161
 162   ap = R1;
 163
 164   Words = TO_W_(StgAP_n_args(ap));
 165
 166   /*
 167    * Check for stack overflow.  IMPORTANT: use a _NP check here,
 168    * because if the check fails, we might end up blackholing this very
 169    * closure, in which case we must enter the blackhole on return rather
 170    * than continuing to evaluate the now-defunct closure.
 171    */
 172   STK_CHK_NP(WDS(Words) + SIZEOF_StgUpdateFrame);
 173
 174   PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);
 175   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words);
 176
 177   TICK_ENT_AP();
 178   LDV_ENTER(ap);
 179
 180   // Enter PAP cost centre
 181   ENTER_CCS_PAP_CL(ap);   // ToDo: ENTER_CC_AP_CL
 182
 183   R1 = StgAP_fun(ap);
 184
 185   // Reload the stack
 186   W_ i;
 187   W_ p;
 188   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_payload;
 189   i = 0;
 190 for:
 191   if (i < Words) {
 192     Sp(i) = W_[p];
 193     p = p + WDS(1);
 194     i = i + 1;
 195     goto for;
 196   }
 197
 198   // Off we go!
 199   TICK_ENT_VIA_NODE();
 200
 201 #ifdef NO_ARG_REGS
 202   jump %GET_ENTRY(R1);
 203 #else
 204       W_ info;
 205       info = %GET_FUN_INFO(R1);
 206       W_ type;
 207       type = TO_W_(StgFunInfoExtra_fun_type(info));
 208       if (type == ARG_GEN) {
 209           jump StgFunInfoExtra_slow_apply(info);
 210       }
 211       if (type == ARG_GEN_BIG) {
 212           jump StgFunInfoExtra_slow_apply(info);
 213       }
 214       if (type == ARG_BCO) {
 215           Sp_adj(-2);
 216           Sp(1) = R1;
 217           Sp(0) = stg_apply_interp_info;
 218           jump stg_yield_to_interpreter;
 219       }
 220       jump W_[stg_ap_stack_entries +
 221                 WDS(TO_W_(StgFunInfoExtra_fun_type(info)))];
 222 #endif
 223 }
 224
 225 /* -----------------------------------------------------------------------------
 226    Entry Code for an AP_STACK.
 227
 228    Very similar to a PAP and AP.  The layout is the same as PAP
 229    and AP, except that the payload is a chunk of stack instead of
 230    being described by the function's info table.  Like an AP,
 231    there are no further arguments on the stack to worry about.
 232    However, the function closure (ap->fun) does not necessarily point
 233    directly to a function, so we have to enter it using stg_ap_0.
 234    -------------------------------------------------------------------------- */
 235
 236 INFO_TABLE(stg_AP_STACK,/*special layout*/0,0,AP_STACK,"AP_STACK","AP_STACK")
 237 {
 238   W_ Words;
 239   W_ ap;
 240
 241   ap = R1;
 242
 243   Words = StgAP_STACK_size(ap);
 244
 245   /*
 246    * Check for stack overflow.  IMPORTANT: use a _NP check here,
 247    * because if the check fails, we might end up blackholing this very
 248    * closure, in which case we must enter the blackhole on return rather
 249    * than continuing to evaluate the now-defunct closure.
 250    */
 251   STK_CHK_NP(WDS(Words) + SIZEOF_StgUpdateFrame);
 252
 253   PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);
 254   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words);
 255
 256   TICK_ENT_AP();
 257   LDV_ENTER(ap);
 258
 259   // Enter PAP cost centre
 260   ENTER_CCS_PAP_CL(ap);   // ToDo: ENTER_CC_AP_CL
 261
 262   R1 = StgAP_STACK_fun(ap);
 263
 264   // Reload the stack
 265   W_ i;
 266   W_ p;
 267   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_STACK_payload;
 268   i = 0;
 269 for:
 270   if (i < Words) {
 271     Sp(i) = W_[p];
 272     p = p + WDS(1);
 273     i = i + 1;
 274     goto for;
 275   }
 276
 277   // Off we go!
 278   TICK_ENT_VIA_NODE();
 279
 280   ENTER();
 281 }