ghc/rts/Apply.hc

   1 // -----------------------------------------------------------------------------
   2 // Apply.hc
   3 //
   4 // (c) The University of Glasgow 2002
   5 //
   6 // Application-related bits.
   7 //
   8 // -----------------------------------------------------------------------------
   9
  10 #include "Stg.h"
  11 #include "Rts.h"
  12 #include "RtsFlags.h"
  13 #include "Storage.h"
  14 #include "RtsUtils.h"
  15 #include "Printer.h"
  16 #include "Sanity.h"
  17 #include "Apply.h"
  18
  19 #include <stdio.h>
  20
  21 // ----------------------------------------------------------------------------
  22 // Evaluate a closure and return it.
  23 //
  24 //      stg_ap_0_info   <--- Sp
  25 //
  26 // NOTE: this needs to be a polymorphic return point, because we can't
  27 // be sure that the thing being evaluated is not a function.
  28
  29 // These names are just to keep VEC_POLY_INFO_TABLE() happy - all the
  30 // entry points in the polymorphic info table point to the same code.
  31 #define stg_ap_0_0_ret stg_ap_0_ret
  32 #define stg_ap_0_1_ret stg_ap_0_ret
  33 #define stg_ap_0_2_ret stg_ap_0_ret
  34 #define stg_ap_0_3_ret stg_ap_0_ret
  35 #define stg_ap_0_4_ret stg_ap_0_ret
  36 #define stg_ap_0_5_ret stg_ap_0_ret
  37 #define stg_ap_0_6_ret stg_ap_0_ret
  38 #define stg_ap_0_7_ret stg_ap_0_ret
  39
  40 VEC_POLY_INFO_TABLE(stg_ap_0,
  41                MK_SMALL_BITMAP(0/*framsize*/, 0/*bitmap*/),
  42                0,0,0,RET_SMALL,,EF_);
  43 F_
  44 stg_ap_0_ret(void)
  45 {
  46     // fn is in R1, no args on the stack
  47     StgInfoTable *info;
  48     nat arity;
  49     FB_;
  50
  51     IF_DEBUG(apply,fprintf(stderr, "stg_ap_0_ret... "); printClosure(R1.cl));
  52     IF_DEBUG(sanity,checkStackChunk(Sp+1,CurrentTSO->stack + CurrentTSO->stack_size));
  53
  54     Sp++;
  55     ENTER();
  56     FE_
  57 }
  58
  59 /* -----------------------------------------------------------------------------
  60    Entry Code for a PAP.
  61
  62    This entry code is *only* called by one of the stg_ap functions.
  63    On entry: Sp points to the remaining arguments on the stack.  If
  64    the stack check fails, we can just push the PAP on the stack and
  65    return to the scheduler.
  66
  67    On entry: R1 points to the PAP.  The rest of the function's
  68    arguments (apart from those that are already in the PAP) are on the
  69    stack, starting at Sp[0].  R2 contains an info table which
  70    describes these arguments, which is used in the event that the
  71    stack check in the entry code below fails.  The info table is
  72    currently one of the stg_ap_*_ret family, as this code is always
  73    entered from those functions.
  74
  75    The idea is to copy the chunk of stack from the PAP object onto the
  76    stack / into registers, and enter the function.
  77    -------------------------------------------------------------------------- */
  78
  79 INFO_TABLE(stg_PAP_info,stg_PAP_entry,/*special layout*/0,0,PAP,,EF_,"PAP","PAP");
  80 STGFUN(stg_PAP_entry)
  81 {
  82   nat Words;
  83   StgPtr p;
  84   nat i;
  85   StgPAP *pap;
  86   FB_
  87
  88   pap = (StgPAP *) R1.p;
  89
  90   Words = pap->n_args;
  91
  92   // Check for stack overflow and bump the stack pointer.
  93   // We have a hand-rolled stack check fragment here, because none of
  94   // the canned ones suit this situation.
  95   if ((Sp - Words) < SpLim) {
  96       // there is a return address in R2 in the event of a
  97       // stack check failure.  The various stg_apply functions arrange
  98       // this before calling stg_PAP_entry.
  99       Sp--;
 100       Sp[0] = R2.w;
 101       JMP_(stg_gc_unpt_r1);
 102   }
 103   Sp -= Words;
 104
 105   // profiling
 106   TICK_ENT_PAP(pap);
 107   LDV_ENTER(pap);
 108   // Enter PAP cost centre -- lexical scoping only
 109   ENTER_CCS_PAP_CL(pap);
 110
 111   R1.cl = pap->fun;
 112   p = (P_)(pap->payload);
 113
 114   // Reload the stack
 115   for (i=0; i<Words; i++) {
 116       Sp[i] = (W_) *p++;
 117   }
 118
 119   // Off we go!
 120   TICK_ENT_VIA_NODE();
 121
 122 #ifdef NO_ARG_REGS
 123   JMP_(GET_ENTRY(R1.cl));
 124 #else
 125   {
 126       StgFunInfoTable *info;
 127       info = get_fun_itbl(R1.cl);
 128       if (info->fun_type == ARG_GEN || info->fun_type == ARG_GEN_BIG) {
 129           JMP_(info->slow_apply);
 130       } else if (info->fun_type == ARG_BCO) {
 131           Sp -= 2;
 132           Sp[1] = R1.w;
 133           Sp[0] = (W_)&stg_apply_interp_info;
 134           JMP_(stg_yield_to_interpreter);
 135       } else {
 136           JMP_(stg_ap_stack_entries[info->fun_type]);
 137       }
 138   }
 139 #endif
 140   FE_
 141 }
 142
 143 /* -----------------------------------------------------------------------------
 144    Entry Code for an AP (a PAP with arity zero).
 145
 146    The entry code is very similar to a PAP, except there are no
 147    further arguments on the stack to worry about, so the stack check
 148    is simpler.  We must also push an update frame on the stack before
 149    applying the function.
 150    -------------------------------------------------------------------------- */
 151
 152 INFO_TABLE(stg_AP_info,stg_AP_entry,/*special layout*/0,0,AP,,EF_,"AP","AP");
 153 STGFUN(stg_AP_entry)
 154 {
 155   nat Words;
 156   P_ p;
 157   nat i;
 158   StgAP *ap;
 159
 160   FB_
 161
 162   ap = (StgAP *) R1.p;
 163
 164   Words = ap->n_args;
 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   STK_CHK_NP(Words+sizeofW(StgUpdateFrame),);
 171
 172   PUSH_UPD_FRAME(R1.p, 0);
 173   Sp -= sizeofW(StgUpdateFrame) + Words;
 174
 175   TICK_ENT_AP(ap);
 176   LDV_ENTER(ap);
 177
 178   // Enter PAP cost centre -- lexical scoping only
 179   ENTER_CCS_PAP_CL(ap);   /* ToDo: ENTER_CC_AP_CL */
 180
 181   R1.cl = ap->fun;
 182   p = (P_)(ap->payload);
 183
 184   // Reload the stack
 185   for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
 186
 187   // Off we go!
 188   TICK_ENT_VIA_NODE();
 189
 190 #ifdef NO_ARG_REGS
 191   JMP_(GET_ENTRY(R1.cl));
 192 #else
 193   {
 194       StgFunInfoTable *info;
 195       info = get_fun_itbl(R1.cl);
 196       if (info->fun_type == ARG_GEN || info->fun_type == ARG_GEN_BIG) {
 197           JMP_(info->slow_apply);
 198       } else if (info->fun_type == ARG_BCO) {
 199           Sp -= 2;
 200           Sp[1] = R1.w;
 201           Sp[0] = (W_)&stg_apply_interp_info;
 202           JMP_(stg_yield_to_interpreter);
 203       } else {
 204           JMP_(stg_ap_stack_entries[info->fun_type]);
 205       }
 206   }
 207 #endif
 208   FE_
 209 }
 210
 211 /* -----------------------------------------------------------------------------
 212    Entry Code for an AP_STACK.
 213
 214    Very similar to a PAP and AP.  The layout is the same as PAP
 215    and AP, except that the payload is a chunk of stack instead of
 216    being described by the function's info table.  Like an AP,
 217    there are no further arguments on the stack to worry about.
 218    However, the function closure (ap->fun) does not necessarily point
 219    directly to a function, so we have to enter it using stg_ap_0.
 220    -------------------------------------------------------------------------- */
 221
 222 INFO_TABLE(stg_AP_STACK_info,stg_AP_STACK_entry,/*special layout*/0,0,AP_STACK,,EF_,"AP_STACK","AP_STACK");
 223 STGFUN(stg_AP_STACK_entry)
 224 {
 225   nat Words;
 226   P_ p;
 227   nat i;
 228   StgAP_STACK *ap;
 229
 230   FB_
 231
 232   ap = (StgAP_STACK *) R1.p;
 233
 234   Words = ap->size;
 235
 236   // Check for stack overflow.  IMPORTANT: use a _NP check here,
 237   // because if the check fails, we might end up blackholing this very
 238   // closure, in which case we must enter the blackhole on return rather
 239   // than continuing to evaluate the now-defunct closure.
 240   STK_CHK_NP(Words+sizeofW(StgUpdateFrame),);
 241
 242   PUSH_UPD_FRAME(R1.p, 0);
 243   Sp -= sizeofW(StgUpdateFrame) + Words;
 244
 245   TICK_ENT_AP(ap);
 246   LDV_ENTER(ap);
 247
 248   // Enter PAP cost centre -- lexical scoping only */
 249   ENTER_CCS_PAP_CL(ap);   /* ToDo: ENTER_CC_AP_STACK_CL */
 250
 251   R1.cl = ap->fun;
 252   p = (P_)(ap->payload);
 253
 254   // Reload the stack
 255   for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
 256
 257   // Off we go!
 258   TICK_ENT_VIA_NODE();
 259   ENTER();
 260   FE_
 261 }