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