ghc/rts/Updates.hc

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Updates.hc,v 1.32 2001/03/02 14:26:40 simonmar Exp $
   3  *
   4  * (c) The GHC Team, 1998-1999
   5  *
   6  * Code to perform updates.
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #include "Rts.h"
  11 #include "RtsUtils.h"
  12 #include "RtsFlags.h"
  13 #include "HeapStackCheck.h"
  14 #include "Storage.h"
  15 #if defined(GRAN) || defined(PAR)
  16 # include "FetchMe.h"
  17 #endif
  18
  19 /*
  20   The update frame return address must be *polymorphic*, that means
  21   we have to cope with both vectored and non-vectored returns.  This
  22   is done by putting the return vector right before the info table, and
  23   having a standard direct return address after the info table (pointed
  24   to by the return address itself, as usual).
  25
  26   Each entry in the vector table points to a specialised entry code fragment
  27   that knows how to return after doing the update.  It would be possible to
  28   use a single generic piece of code that simply entered the return value
  29   to return, but it's quicker this way.  The direct return code of course
  30   just does another direct return when it's finished.
  31
  32   Why is there necessarily an activation underneath us on the stack?
  33   Because if we're returning, that means we've got a constructor in
  34   our hands.  If there were any arguments to be applied to it, that
  35   would be a type error.  We don't ever return a PAP to an update frame,
  36   the update is handled manually by stg_update_PAP.
  37 */
  38
  39 /* on entry to the update code
  40    (1) R1 points to the closure being returned
  41    (2) R2 contains the tag (if we returned directly, non-vectored)
  42    (3) Sp points to the update frame
  43    */
  44
  45 /* Why updatee is placed in a temporary variable here: this helps
  46    gcc's aliasing by indicating that the location of the updatee
  47    doesn't change across assignments.  Saves one instruction in the
  48    update code.
  49    */
  50
  51 #if defined(REG_Su)
  52 #define UPD_FRAME_ENTRY_TEMPLATE(label,ret)                             \
  53         STGFUN(label);                                                  \
  54         STGFUN(label)                                                   \
  55         {                                                               \
  56           FB_                                                           \
  57                                                                         \
  58           Su = (StgUpdateFrame *)((StgUpdateFrame *)Sp)->updatee;       \
  59                                                                         \
  60           /* Tick - it must be a con, all the paps are handled          \
  61            * in stg_upd_PAP and PAP_entry below                         \
  62            */                                                           \
  63           TICK_UPD_CON_IN_NEW(sizeW_fromITBL(get_itbl(Su)));            \
  64                                                                         \
  65           UPD_IND(Su,R1.p);                                             \
  66                                                                         \
  67           /* reset Su to the next update frame */                       \
  68           Su = ((StgUpdateFrame *)Sp)->link;                            \
  69                                                                         \
  70           /* remove the update frame from the stack */                  \
  71           Sp += sizeofW(StgUpdateFrame);                                \
  72                                                                         \
  73           JMP_(ret);                                                    \
  74           FE_                                                           \
  75         }
  76 #else
  77
  78 #define UPD_FRAME_ENTRY_TEMPLATE(label,ret)                             \
  79         STGFUN(label);                                                  \
  80         STGFUN(label)                                                   \
  81         {                                                               \
  82           StgClosure *updatee;                                          \
  83           FB_                                                           \
  84                                                                         \
  85           updatee = ((StgUpdateFrame *)Sp)->updatee;                    \
  86                                                                         \
  87           /* Tick - it must be a con, all the paps are handled          \
  88            * in stg_upd_PAP and PAP_entry below                         \
  89            */                                                           \
  90           TICK_UPD_CON_IN_NEW(sizeW_fromITBL(get_itbl(updatee)));       \
  91                                                                         \
  92           UPD_IND(updatee, R1.cl);                                      \
  93                                                                         \
  94           /* reset Su to the next update frame */                       \
  95           Su = ((StgUpdateFrame *)Sp)->link;                            \
  96                                                                         \
  97           /* remove the update frame from the stack */                  \
  98           Sp += sizeofW(StgUpdateFrame);                                \
  99                                                                         \
 100           JMP_(ret);                                                    \
 101           FE_                                                           \
 102         }
 103 #endif
 104
 105 UPD_FRAME_ENTRY_TEMPLATE(stg_upd_frame_entry,ENTRY_CODE(Sp[0]));
 106 UPD_FRAME_ENTRY_TEMPLATE(stg_upd_frame_0_entry,RET_VEC(Sp[0],0));
 107 UPD_FRAME_ENTRY_TEMPLATE(stg_upd_frame_1_entry,RET_VEC(Sp[0],1));
 108 UPD_FRAME_ENTRY_TEMPLATE(stg_upd_frame_2_entry,RET_VEC(Sp[0],2));
 109 UPD_FRAME_ENTRY_TEMPLATE(stg_upd_frame_3_entry,RET_VEC(Sp[0],3));
 110 UPD_FRAME_ENTRY_TEMPLATE(stg_upd_frame_4_entry,RET_VEC(Sp[0],4));
 111 UPD_FRAME_ENTRY_TEMPLATE(stg_upd_frame_5_entry,RET_VEC(Sp[0],5));
 112 UPD_FRAME_ENTRY_TEMPLATE(stg_upd_frame_6_entry,RET_VEC(Sp[0],6));
 113 UPD_FRAME_ENTRY_TEMPLATE(stg_upd_frame_7_entry,RET_VEC(Sp[0],7));
 114
 115 /*
 116   Make sure this table is big enough to handle the maximum vectored
 117   return size!
 118   */
 119
 120 #ifdef PROFILING
 121 #define UPD_FRAME_BITMAP 3
 122 #else
 123 #define UPD_FRAME_BITMAP 1
 124 #endif
 125
 126 /* this bitmap indicates that the first word of an update frame is a
 127  * non-pointer - this is the update frame link.  (for profiling,
 128  * there's a cost-centre-stack in there too).
 129  */
 130
 131 VEC_POLY_INFO_TABLE(stg_upd_frame,UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, UPDATE_FRAME,, EF_);
 132
 133 /* -----------------------------------------------------------------------------
 134    Entry Code for a PAP.
 135
 136    The idea is to copy the chunk of stack from the PAP object and then
 137    re-enter the function closure that failed it's args check in the
 138    first place.
 139
 140    In fact, we do a little optimisation too, by performing the updates
 141    for any update frames sitting on top of the stack. (ToDo: is this
 142    really an optimisation? --SDM)
 143    -------------------------------------------------------------------------- */
 144
 145 INFO_TABLE(stg_PAP_info,stg_PAP_entry,/*special layout*/0,0,PAP,,EF_,"PAP","PAP");
 146 STGFUN(stg_PAP_entry)
 147 {
 148   nat Words;
 149   P_ p;
 150   nat i;
 151   StgPAP *pap;
 152
 153   FB_
 154
 155   pap = (StgPAP *) R1.p;
 156
 157   /*
 158    * remove any update frames on the top of the stack, by just
 159    * performing the update here.
 160    */
 161   while ((W_)Su - (W_)Sp == 0) {
 162
 163     switch (get_itbl(Su)->type) {
 164
 165     case UPDATE_FRAME:
 166       /* We're sitting on top of an update frame, so let's do the business */
 167       UPD_IND(Su->updatee, pap);
 168
 169 #if defined(PROFILING)
 170       /*
 171        * Restore the Cost Centre too (if required); again see Sansom
 172        * thesis p 183.  Take the CC out of the update frame if a
 173        * CAF/DICT.
 174        */
 175
 176       CCCS = Su->header.prof.ccs;
 177 #endif /* PROFILING */
 178
 179       Su = Su->link;
 180       Sp += sizeofW(StgUpdateFrame);
 181       continue;
 182
 183     case SEQ_FRAME:
 184       /* Just pop the seq frame and return to the activation record
 185        * underneath us - R1 already contains the address of the PAP.
 186        */
 187       Su = ((StgSeqFrame *)Su)->link;
 188       Sp += sizeofW(StgSeqFrame);
 189       JMP_(ENTRY_CODE(*Sp));
 190
 191     case CATCH_FRAME:
 192       /* can't happen, see stg_update_PAP */
 193       barf("PAP_entry: CATCH_FRAME");
 194
 195     default:
 196       barf("PAP_entry: strange activation record");
 197     }
 198
 199   }
 200
 201   Words = pap->n_args;
 202
 203   /*
 204    * Check for stack overflow.
 205    */
 206   STK_CHK_NP(Words,1,);
 207   Sp -= Words;
 208
 209   TICK_ENT_PAP(pap);
 210
 211   /* Enter PAP cost centre -- lexical scoping only */
 212   ENTER_CCS_PAP_CL(pap);
 213
 214   R1.cl = pap->fun;
 215   p = (P_)(pap->payload);
 216
 217   /* Reload the stack */
 218   for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
 219
 220   /* Off we go! */
 221   TICK_ENT_VIA_NODE();
 222   JMP_(GET_ENTRY(R1.cl));
 223   FE_
 224 }
 225
 226 /* -----------------------------------------------------------------------------
 227    stg_update_PAP: Update the current closure with a partial application.
 228
 229    This function is called whenever an argument satisfaction check fails.
 230    -------------------------------------------------------------------------- */
 231
 232 EXTFUN(stg_update_PAP)
 233 {
 234   nat Words, PapSize;
 235 #ifdef PROFILING
 236   CostCentreStack *CCS_pap;
 237 #endif
 238   StgPAP* PapClosure;
 239   StgClosure *Fun, *Updatee;
 240   P_ p;
 241   I_ i;
 242
 243   FB_
 244
 245     /* Save the pointer to the function closure that just failed the
 246      * argument satisfaction check
 247      */
 248     Fun = R1.cl;
 249
 250     /* Just copy the whole block of stack between the stack pointer
 251      * and the update frame pointer.
 252      */
 253     Words    = (P_)Su - (P_)Sp;
 254     ASSERT((int)Words >= 0);
 255
 256 #if defined(PROFILING)
 257     /* pretend we just entered the function closure */
 258     ENTER_CCS_FCL(Fun);
 259     CCS_pap = CCCS;
 260 #endif
 261
 262     if (Words == 0) {
 263
 264         /*
 265          * No arguments, only Node.  Skip building the PAP and
 266          * just plan to update with an indirection.
 267          */
 268
 269         PapClosure = (StgPAP *)Fun;
 270
 271     } else {
 272            /* Build the PAP */
 273
 274         PapSize = Words + sizeofW(StgPAP);
 275
 276         /*
 277          * First we need to do a heap check, which involves saving
 278          * everything on the stack.  We only have one live pointer:
 279          * Fun, the function closure that was passed to us.  If the
 280          * heap check fails, we push the function closure on the stack
 281          * and instruct the scheduler to try entering it again when
 282          * the garbage collector has run.
 283          *
 284          * It's done this way because there's a possibility that the
 285          * garbage collector might have messed around with the stack,
 286          * such as removing the update frame.
 287          */
 288         if ((Hp += PapSize) > HpLim) {
 289           Sp -= 1;
 290           Sp[0] = (W_)Fun;
 291           JMP_(stg_gc_entertop);
 292         }
 293
 294         TICK_ALLOC_UPD_PAP(1/*fun*/ + Words, 0);
 295 #ifdef PROFILING
 296         CCS_ALLOC(CCS_pap, PapSize);
 297 #endif
 298
 299         PapClosure = (StgPAP *)(Hp + 1 - PapSize); /* The new PapClosure */
 300
 301         SET_HDR(PapClosure,&stg_PAP_info,CCS_pap);
 302         PapClosure->n_args = Words;
 303         PapClosure->fun = Fun;
 304
 305         /* Now fill in the closure fields */
 306
 307         p = Hp;
 308         for (i = Words-1; i >= 0; i--) {
 309            *p-- = (W_) Sp[i];
 310         }
 311     }
 312
 313     /*
 314      * Finished constructing PAP closure; now update the updatee.
 315      */
 316
 317     /* ToDo: we'd like to just jump to the code for PAP_entry here,
 318      * which deals with a stack of update frames in one go.  What to
 319      * do about the special ticky and profiling stuff here?
 320      */
 321
 322     switch (get_itbl(Su)->type) {
 323
 324     case SEQ_FRAME:
 325       /* Set Sp to just above the SEQ frame (should be an activation rec.)*/
 326       Sp = (P_)Su + sizeofW(StgSeqFrame);
 327
 328       /* restore Su */
 329       Su = ((StgSeqFrame *)Su)->link;
 330
 331       /* return to the activation record, with the address of the PAP in R1 */
 332       R1.p = (P_)PapClosure;
 333       JMP_(ENTRY_CODE(*Sp));
 334
 335     case CATCH_FRAME:
 336       /* Set Sp to just above the CATCH frame (should be an activation rec.)*/
 337       Sp = (P_)Su + sizeofW(StgCatchFrame);
 338
 339       /* restore Su */
 340       Su = ((StgCatchFrame *)Su)->link;
 341
 342       /* restart by entering the PAP */
 343       R1.p = (P_)PapClosure;
 344       JMP_(GET_ENTRY(R1.cl));
 345
 346     case UPDATE_FRAME:
 347       /*
 348        * Now we have a standard update frame, so we update the updatee with
 349        * either the new PAP or Node.
 350        */
 351
 352       Updatee = Su->updatee;
 353
 354 #if defined(PROFILING)
 355       if (Words != 0) {
 356         UPD_IND(Updatee,PapClosure);
 357         TICK_UPD_PAP_IN_NEW(Words+1);
 358       } else {
 359         /* Lexical scoping requires a *permanent* indirection, and we
 360          * also have to set the cost centre for the indirection.
 361          */
 362         UPD_PERM_IND(Updatee,PapClosure);
 363         TICK_UPD_PAP_IN_PLACE();
 364         Updatee->header.prof.ccs = CCS_pap;
 365       }
 366 #else
 367       UPD_IND(Updatee,PapClosure);
 368       if (Words != 0) {
 369         TICK_UPD_PAP_IN_NEW(Words+1);
 370       } else {
 371         TICK_UPD_PAP_IN_PLACE();
 372       }
 373 #endif
 374
 375 #if defined(PROFILING)
 376       CCCS = Su->header.prof.ccs;
 377       ENTER_CCS_PAP(CCS_pap);
 378 #endif /* PROFILING */
 379
 380       /* Restore Su */
 381       Su = Su->link;
 382
 383       /*
 384        * Squeeze out update frame from stack.
 385        */
 386       for (i = Words-1; i >= 0; i--) {
 387         Sp[i+(sizeofW(StgUpdateFrame))] = Sp[i];
 388       }
 389       Sp += sizeofW(StgUpdateFrame);
 390       break;
 391
 392     default:
 393       barf("stg_update_PAP: strange activation record");
 394     }
 395
 396     /*
 397      * All done!  Restart by re-entering Node
 398      * Don't count this entry for ticky-ticky profiling.
 399      */
 400     JMP_(GET_ENTRY(R1.cl));
 401     FE_
 402 }
 403
 404
 405 /* -----------------------------------------------------------------------------
 406    Entry Code for an AP_UPD.
 407
 408    The idea is to copy the chunk of stack from the AP object and then
 409    enter the function closure.
 410
 411    (This code is a simplified copy of the PAP code - with all the
 412     update frame code stripped out.)
 413    -------------------------------------------------------------------------- */
 414
 415
 416 INFO_TABLE(stg_AP_UPD_info,stg_AP_UPD_entry,/*special layout*/0,0,AP_UPD,,EF_,"AP_UPD","AP_UPD");
 417 STGFUN(stg_AP_UPD_entry)
 418 {
 419   nat Words;
 420   P_ p;
 421   nat i;
 422   StgAP_UPD *ap;
 423
 424   FB_
 425
 426   ap = (StgAP_UPD *) R1.p;
 427
 428   Words = ap->n_args;
 429
 430   /*
 431    * Check for stack overflow.
 432    */
 433   STK_CHK_GEN(Words+sizeofW(StgUpdateFrame), R1_PTR, stg_AP_UPD_entry, );
 434
 435   PUSH_UPD_FRAME(R1.p, 0);
 436   Sp -= sizeofW(StgUpdateFrame) + Words;
 437
 438   TICK_ENT_AP_UPD(ap);
 439
 440   /* Enter PAP cost centre -- lexical scoping only */
 441   ENTER_CCS_PAP_CL(ap);   /* ToDo: ENTER_CC_AP_UPD_CL */
 442
 443   R1.cl = ap->fun;
 444   p = (P_)(ap->payload);
 445
 446   /* Reload the stack */
 447   for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
 448
 449   /* Off we go! */
 450   TICK_ENT_VIA_NODE();
 451   JMP_(GET_ENTRY(R1.cl));
 452   FE_
 453 }
 454
 455
 456 /*-----------------------------------------------------------------------------
 457   Seq frames
 458
 459   We don't have a primitive seq# operator: it is just a 'case'
 460   expression whose scrutinee has either a polymorphic or function type
 461   (constructor types can be handled by normal 'case' expressions).
 462
 463   To handle a polymorphic/function typed seq, we push a SEQ_FRAME on
 464   the stack.  This is a polymorphic activation record that just pops
 465   itself and returns when entered.  The purpose of the SEQ_FRAME is to
 466   act as a barrier in case the scrutinee is a partial application - in
 467   this way it is just like an update frame, except that it doesn't
 468   update anything.
 469   -------------------------------------------------------------------------- */
 470
 471 #define SEQ_FRAME_ENTRY_TEMPLATE(label,ret)     \
 472    IFN_(label)                                  \
 473    {                                            \
 474       FB_                                       \
 475       Su = ((StgSeqFrame *)Sp)->link;   \
 476       Sp += sizeofW(StgSeqFrame);               \
 477       JMP_(ret);                                \
 478       FE_                                       \
 479    }
 480
 481 SEQ_FRAME_ENTRY_TEMPLATE(stg_seq_frame_entry,  ENTRY_CODE(Sp[0]));
 482 SEQ_FRAME_ENTRY_TEMPLATE(stg_seq_frame_0_entry,ENTRY_CODE(Sp[0]));
 483 SEQ_FRAME_ENTRY_TEMPLATE(stg_seq_frame_1_entry,ENTRY_CODE(Sp[0]));
 484 SEQ_FRAME_ENTRY_TEMPLATE(stg_seq_frame_2_entry,ENTRY_CODE(Sp[0]));
 485 SEQ_FRAME_ENTRY_TEMPLATE(stg_seq_frame_3_entry,ENTRY_CODE(Sp[0]));
 486 SEQ_FRAME_ENTRY_TEMPLATE(stg_seq_frame_4_entry,ENTRY_CODE(Sp[0]));
 487 SEQ_FRAME_ENTRY_TEMPLATE(stg_seq_frame_5_entry,ENTRY_CODE(Sp[0]));
 488 SEQ_FRAME_ENTRY_TEMPLATE(stg_seq_frame_6_entry,ENTRY_CODE(Sp[0]));
 489 SEQ_FRAME_ENTRY_TEMPLATE(stg_seq_frame_7_entry,ENTRY_CODE(Sp[0]));
 490
 491 VEC_POLY_INFO_TABLE(stg_seq_frame, UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, SEQ_FRAME,, EF_);
 492
 493 /* -----------------------------------------------------------------------------
 494  * The seq infotable
 495  *
 496  * This closure takes one argument, which it evaluates and returns the
 497  * result with a direct return (never a vectored return!) in R1.  It
 498  * does this by pushing a SEQ_FRAME on the stack and
 499  * entering its argument.
 500  *
 501  * It is used in deleteThread when reverting blackholes.
 502  * -------------------------------------------------------------------------- */
 503
 504 INFO_TABLE(stg_seq_info,stg_seq_entry,1,0,FUN,,EF_,0,0);
 505 STGFUN(stg_seq_entry)
 506 {
 507   FB_
 508   STK_CHK_GEN(sizeofW(StgSeqFrame), NO_PTRS, stg_seq_entry, );
 509   Sp -= sizeofW(StgSeqFrame);
 510   PUSH_SEQ_FRAME(Sp);
 511   R1.cl = R1.cl->payload[0];
 512   JMP_(ENTRY_CODE(*R1.p));
 513   FE_
 514 }