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  * There isn't an info table / return address version of stg_ap_0, because
  19  * everything being returned is guaranteed evaluated, so it would be a no-op.
  20  */
  21
  22 STRING(stg_ap_0_ret_str,"stg_ap_0_ret... ")
  23
  24 stg_ap_0_fast
  25 {
  26     // fn is in R1, no args on the stack
  27
  28     IF_DEBUG(apply,
  29         foreign "C" debugBelch(stg_ap_0_ret_str) [R1];
  30         foreign "C" printClosure(R1 "ptr") [R1]);
  31
  32     IF_DEBUG(sanity,
  33         foreign "C" checkStackChunk(Sp "ptr",
  34                                     CurrentTSO + TSO_OFFSET_StgTSO_stack +
  35                                     WDS(TO_W_(StgTSO_stack_size(CurrentTSO))) "ptr") [R1]);
  36
  37     ENTER();
  38 }
  39
  40 /* -----------------------------------------------------------------------------
  41    Entry Code for a PAP.
  42
  43    This entry code is *only* called by one of the stg_ap functions.
  44    On entry: Sp points to the remaining arguments on the stack.  If
  45    the stack check fails, we can just push the PAP on the stack and
  46    return to the scheduler.
  47
  48    On entry: R1 points to the PAP.  The rest of the function's
  49    arguments (apart from those that are already in the PAP) are on the
  50    stack, starting at Sp(0).  R2 contains an info table which
  51    describes these arguments, which is used in the event that the
  52    stack check in the entry code below fails.  The info table is
  53    currently one of the stg_ap_*_ret family, as this code is always
  54    entered from those functions.
  55
  56    The idea is to copy the chunk of stack from the PAP object onto the
  57    stack / into registers, and enter the function.
  58    -------------------------------------------------------------------------- */
  59
  60 INFO_TABLE(stg_PAP,/*special layout*/0,0,PAP,"PAP","PAP")
  61 {  foreign "C" barf("PAP object entered!") never returns; }
  62
  63 stg_PAP_apply
  64 {
  65   W_ Words;
  66   W_ pap;
  67
  68   pap = R1;
  69
  70   Words = TO_W_(StgPAP_n_args(pap));
  71
  72   //
  73   // Check for stack overflow and bump the stack pointer.
  74   // We have a hand-rolled stack check fragment here, because none of
  75   // the canned ones suit this situation.
  76   //
  77   if ((Sp - WDS(Words)) < SpLim) {
  78       // there is a return address in R2 in the event of a
  79       // stack check failure.  The various stg_apply functions arrange
  80       // this before calling stg_PAP_entry.
  81       Sp_adj(-1);
  82       Sp(0) = R2;
  83       jump stg_gc_unpt_r1;
  84   }
  85   Sp_adj(-Words);
  86
  87   // profiling
  88   TICK_ENT_PAP();
  89   LDV_ENTER(pap);
  90   // Enter PAP cost centre
  91   ENTER_CCS_PAP_CL(pap);
  92
  93   // Reload the stack
  94   W_ i;
  95   W_ p;
  96   p = pap + SIZEOF_StgHeader + OFFSET_StgPAP_payload;
  97   i = 0;
  98 for:
  99   if (i < Words) {
 100     Sp(i) = W_[p];
 101     p = p + WDS(1);
 102     i = i + 1;
 103     goto for;
 104   }
 105
 106   R1 = StgPAP_fun(pap);
 107
 108 /* DEBUGGING CODE, ensures that arity 1 and 2 functions are entered tagged
 109   if (TO_W_(StgFunInfoExtra_arity(%FUN_INFO(%INFO_PTR(UNTAG(R1))))) == 1 ) {
 110     if (GETTAG(R1)!=1) {
 111         W_[0]=1;
 112     }
 113   }
 114
 115   if (TO_W_(StgFunInfoExtra_arity(%FUN_INFO(%INFO_PTR(UNTAG(R1))))) == 2 ) {
 116     if (GETTAG(R1)!=2) {
 117         W_[0]=1;
 118     }
 119   }
 120 */
 121
 122   // Off we go!
 123   TICK_ENT_VIA_NODE();
 124
 125 #ifdef NO_ARG_REGS
 126   jump %GET_ENTRY(UNTAG(R1));
 127 #else
 128       W_ info;
 129       info = %GET_FUN_INFO(UNTAG(R1));
 130       W_ type;
 131       type = TO_W_(StgFunInfoExtra_fun_type(info));
 132       if (type == ARG_GEN) {
 133           jump StgFunInfoExtra_slow_apply(info);
 134       }
 135       if (type == ARG_GEN_BIG) {
 136           jump StgFunInfoExtra_slow_apply(info);
 137       }
 138       if (type == ARG_BCO) {
 139           Sp_adj(-2);
 140           Sp(1) = R1;
 141           Sp(0) = stg_apply_interp_info;
 142           jump stg_yield_to_interpreter;
 143       }
 144       jump W_[stg_ap_stack_entries +
 145                 WDS(TO_W_(StgFunInfoExtra_fun_type(info)))];
 146 #endif
 147 }
 148
 149 /* -----------------------------------------------------------------------------
 150    Entry Code for an AP (a PAP with arity zero).
 151
 152    The entry code is very similar to a PAP, except there are no
 153    further arguments on the stack to worry about, so the stack check
 154    is simpler.  We must also push an update frame on the stack before
 155    applying the function.
 156    -------------------------------------------------------------------------- */
 157
 158 INFO_TABLE(stg_AP,/*special layout*/0,0,AP,"AP","AP")
 159 {
 160   W_ Words;
 161   W_ ap;
 162
 163   ap = R1;
 164
 165   Words = TO_W_(StgAP_n_args(ap));
 166
 167   /*
 168    * Check for stack overflow.  IMPORTANT: use a _NP check here,
 169    * because if the check fails, we might end up blackholing this very
 170    * closure, in which case we must enter the blackhole on return rather
 171    * than continuing to evaluate the now-defunct closure.
 172    */
 173   STK_CHK_NP(WDS(Words) + SIZEOF_StgUpdateFrame);
 174
 175   PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);
 176   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words);
 177
 178   TICK_ENT_AP();
 179   LDV_ENTER(ap);
 180
 181   // Enter PAP cost centre
 182   ENTER_CCS_PAP_CL(ap);   // ToDo: ENTER_CC_AP_CL
 183
 184   // Reload the stack
 185   W_ i;
 186   W_ p;
 187   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_payload;
 188   i = 0;
 189 for:
 190   if (i < Words) {
 191     Sp(i) = W_[p];
 192     p = p + WDS(1);
 193     i = i + 1;
 194     goto for;
 195   }
 196
 197   R1 = StgAP_fun(ap);
 198
 199   // Off we go!
 200   TICK_ENT_VIA_NODE();
 201
 202 #ifdef NO_ARG_REGS
 203   jump %GET_ENTRY(UNTAG(R1));
 204 #else
 205       W_ info;
 206       info = %GET_FUN_INFO(UNTAG(R1));
 207       W_ type;
 208       type = TO_W_(StgFunInfoExtra_fun_type(info));
 209       if (type == ARG_GEN) {
 210           jump StgFunInfoExtra_slow_apply(info);
 211       }
 212       if (type == ARG_GEN_BIG) {
 213           jump StgFunInfoExtra_slow_apply(info);
 214       }
 215       if (type == ARG_BCO) {
 216           Sp_adj(-2);
 217           Sp(1) = R1;
 218           Sp(0) = stg_apply_interp_info;
 219           jump stg_yield_to_interpreter;
 220       }
 221       jump W_[stg_ap_stack_entries +
 222                 WDS(TO_W_(StgFunInfoExtra_fun_type(info)))];
 223 #endif
 224 }
 225
 226 /* AP_NOUPD is exactly like AP, except that no update frame is pushed.
 227    Use for thunks that are guaranteed to be entered once only, such as
 228    those generated by the byte-code compiler for inserting breakpoints. */
 229
 230 INFO_TABLE(stg_AP_NOUPD,/*special layout*/0,0,AP,"AP_NOUPD","AP_NOUPD")
 231 {
 232   W_ Words;
 233   W_ ap;
 234
 235   ap = R1;
 236
 237   Words = TO_W_(StgAP_n_args(ap));
 238
 239   /*
 240    * Check for stack overflow.  IMPORTANT: use a _NP check here,
 241    * because if the check fails, we might end up blackholing this very
 242    * closure, in which case we must enter the blackhole on return rather
 243    * than continuing to evaluate the now-defunct closure.
 244    */
 245   STK_CHK_NP(WDS(Words));
 246   Sp = Sp - WDS(Words);
 247
 248   TICK_ENT_AP();
 249   LDV_ENTER(ap);
 250
 251   // Enter PAP cost centre
 252   ENTER_CCS_PAP_CL(ap);   // ToDo: ENTER_CC_AP_CL
 253
 254   // Reload the stack
 255   W_ i;
 256   W_ p;
 257   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_payload;
 258   i = 0;
 259 for:
 260   if (i < Words) {
 261     Sp(i) = W_[p];
 262     p = p + WDS(1);
 263     i = i + 1;
 264     goto for;
 265   }
 266
 267   R1 = StgAP_fun(ap);
 268
 269   // Off we go!
 270   TICK_ENT_VIA_NODE();
 271
 272 #ifdef NO_ARG_REGS
 273   jump %GET_ENTRY(UNTAG(R1));
 274 #else
 275       W_ info;
 276       info = %GET_FUN_INFO(UNTAG(R1));
 277       W_ type;
 278       type = TO_W_(StgFunInfoExtra_fun_type(info));
 279       if (type == ARG_GEN) {
 280           jump StgFunInfoExtra_slow_apply(info);
 281       }
 282       if (type == ARG_GEN_BIG) {
 283           jump StgFunInfoExtra_slow_apply(info);
 284       }
 285       if (type == ARG_BCO) {
 286           Sp_adj(-2);
 287           Sp(1) = R1;
 288           Sp(0) = stg_apply_interp_info;
 289           jump stg_yield_to_interpreter;
 290       }
 291       jump W_[stg_ap_stack_entries +
 292                 WDS(TO_W_(StgFunInfoExtra_fun_type(info)))];
 293 #endif
 294 }
 295
 296 /* -----------------------------------------------------------------------------
 297    Entry Code for an AP_STACK.
 298
 299    Very similar to a PAP and AP.  The layout is the same as PAP
 300    and AP, except that the payload is a chunk of stack instead of
 301    being described by the function's info table.  Like an AP,
 302    there are no further arguments on the stack to worry about.
 303    However, the function closure (ap->fun) does not necessarily point
 304    directly to a function, so we have to enter it using stg_ap_0.
 305    -------------------------------------------------------------------------- */
 306
 307 INFO_TABLE(stg_AP_STACK,/*special layout*/0,0,AP_STACK,"AP_STACK","AP_STACK")
 308 {
 309   W_ Words;
 310   W_ ap;
 311
 312   ap = R1;
 313
 314   Words = StgAP_STACK_size(ap);
 315
 316   /*
 317    * Check for stack overflow.  IMPORTANT: use a _NP check here,
 318    * because if the check fails, we might end up blackholing this very
 319    * closure, in which case we must enter the blackhole on return rather
 320    * than continuing to evaluate the now-defunct closure.
 321    */
 322   STK_CHK_NP(WDS(Words) + SIZEOF_StgUpdateFrame + WDS(AP_STACK_SPLIM));
 323   /* ensure there is at least AP_STACK_SPLIM words of headroom available
 324    * after unpacking the AP_STACK. See bug #1466 */
 325
 326   PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);
 327   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words);
 328
 329   TICK_ENT_AP();
 330   LDV_ENTER(ap);
 331
 332   // Enter PAP cost centre
 333   ENTER_CCS_PAP_CL(ap);   // ToDo: ENTER_CC_AP_CL
 334
 335   // Reload the stack
 336   W_ i;
 337   W_ p;
 338   p = ap + SIZEOF_StgHeader + OFFSET_StgAP_STACK_payload;
 339   i = 0;
 340 for:
 341   if (i < Words) {
 342     Sp(i) = W_[p];
 343     p = p + WDS(1);
 344     i = i + 1;
 345     goto for;
 346   }
 347
 348   // Off we go!
 349   TICK_ENT_VIA_NODE();
 350
 351   R1 = StgAP_STACK_fun(ap);
 352
 353   ENTER();
 354 }