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.
 167   STK_CHK_GEN(Words+sizeofW(StgUpdateFrame), R1_PTR, stg_AP_entry);
 168
 169   PUSH_UPD_FRAME(R1.p, 0);
 170   Sp -= sizeofW(StgUpdateFrame) + Words;
 171
 172   TICK_ENT_AP(ap);
 173   LDV_ENTER(ap);
 174
 175   // Enter PAP cost centre -- lexical scoping only
 176   ENTER_CCS_PAP_CL(ap);   /* ToDo: ENTER_CC_AP_CL */
 177
 178   R1.cl = ap->fun;
 179   p = (P_)(ap->payload);
 180
 181   // Reload the stack
 182   for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
 183
 184   // Off we go!
 185   TICK_ENT_VIA_NODE();
 186
 187 #ifdef NO_ARG_REGS
 188   JMP_(GET_ENTRY(R1.cl));
 189 #else
 190   {
 191       StgFunInfoTable *info;
 192       info = get_fun_itbl(R1.cl);
 193       if (info->fun_type == ARG_GEN || info->fun_type == ARG_GEN_BIG) {
 194           JMP_(info->slow_apply);
 195       } else if (info->fun_type == ARG_BCO) {
 196           Sp -= 2;
 197           Sp[1] = R1.w;
 198           Sp[0] = (W_)&stg_apply_interp_info;
 199           JMP_(stg_yield_to_interpreter);
 200       } else {
 201           JMP_(stg_ap_stack_entries[info->fun_type]);
 202       }
 203   }
 204 #endif
 205   FE_
 206 }
 207
 208 /* -----------------------------------------------------------------------------
 209    Entry Code for an AP_STACK.
 210
 211    Very similar to a PAP and AP.  The layout is the same as PAP
 212    and AP, except that the payload is a chunk of stack instead of
 213    being described by the function's info table.  Like an AP,
 214    there are no further arguments on the stack to worry about.
 215    However, the function closure (ap->fun) does not necessarily point
 216    directly to a function, so we have to enter it using stg_ap_0.
 217    -------------------------------------------------------------------------- */
 218
 219 INFO_TABLE(stg_AP_STACK_info,stg_AP_STACK_entry,/*special layout*/0,0,AP_STACK,,EF_,"AP_STACK","AP_STACK");
 220 STGFUN(stg_AP_STACK_entry)
 221 {
 222   nat Words;
 223   P_ p;
 224   nat i;
 225   StgAP_STACK *ap;
 226
 227   FB_
 228
 229   ap = (StgAP_STACK *) R1.p;
 230
 231   Words = ap->size;
 232
 233   // Check for stack overflow.
 234   STK_CHK_GEN(Words+sizeofW(StgUpdateFrame), R1_PTR, stg_AP_STACK_entry);
 235
 236   PUSH_UPD_FRAME(R1.p, 0);
 237   Sp -= sizeofW(StgUpdateFrame) + Words;
 238
 239   TICK_ENT_AP(ap);
 240   LDV_ENTER(ap);
 241
 242   // Enter PAP cost centre -- lexical scoping only */
 243   ENTER_CCS_PAP_CL(ap);   /* ToDo: ENTER_CC_AP_STACK_CL */
 244
 245   R1.cl = ap->fun;
 246   p = (P_)(ap->payload);
 247
 248   // Reload the stack
 249   for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
 250
 251   // Off we go!
 252   TICK_ENT_VIA_NODE();
 253   ENTER();
 254   FE_
 255 }