ghc/rts/Updates.hc

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Updates.hc,v 1.36 2001/11/22 14:25:12 simonmar Exp $
   3  *
   4  * (c) The GHC Team, 1998-1999
   5  *
   6  * Code to perform updates.
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #include "Stg.h"
  11 #include "Rts.h"
  12 #include "RtsUtils.h"
  13 #include "RtsFlags.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 #if defined(PROFILING)
 121 #define UPD_FRAME_BITMAP 7
 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   LDV_ENTER(pap);
 211
 212   /* Enter PAP cost centre -- lexical scoping only */
 213   ENTER_CCS_PAP_CL(pap);
 214
 215   R1.cl = pap->fun;
 216   p = (P_)(pap->payload);
 217
 218   /* Reload the stack */
 219   for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
 220
 221   /* Off we go! */
 222   TICK_ENT_VIA_NODE();
 223   JMP_(GET_ENTRY(R1.cl));
 224   FE_
 225 }
 226
 227 /* -----------------------------------------------------------------------------
 228    stg_update_PAP: Update the current closure with a partial application.
 229
 230    This function is called whenever an argument satisfaction check fails.
 231    -------------------------------------------------------------------------- */
 232
 233 EXTFUN(__stg_update_PAP)
 234 {
 235   nat Words, PapSize;
 236 #ifdef PROFILING
 237   CostCentreStack *CCS_pap;
 238 #endif
 239   StgPAP* PapClosure;
 240   StgClosure *Fun, *Updatee;
 241   P_ p;
 242   I_ i;
 243
 244   FB_
 245
 246     /* Save the pointer to the function closure that just failed the
 247      * argument satisfaction check
 248      */
 249     Fun = R1.cl;
 250
 251     /* Just copy the whole block of stack between the stack pointer
 252      * and the update frame pointer.
 253      */
 254     Words    = (P_)Su - (P_)Sp;
 255     ASSERT((int)Words >= 0);
 256
 257 #if defined(PROFILING)
 258     /* pretend we just entered the function closure */
 259     ENTER_CCS_FCL(Fun);
 260     CCS_pap = CCCS;
 261 #endif
 262
 263     if (Words == 0) {
 264
 265         /*
 266          * No arguments, only Node.  Skip building the PAP and
 267          * just plan to update with an indirection.
 268          */
 269
 270         PapClosure = (StgPAP *)Fun;
 271
 272     } else {
 273            /* Build the PAP */
 274
 275         PapSize = Words + sizeofW(StgPAP);
 276
 277         /*
 278          * First we need to do a heap check, which involves saving
 279          * everything on the stack.  We only have one live pointer:
 280          * Fun, the function closure that was passed to us.  If the
 281          * heap check fails, we push the function closure on the stack
 282          * and instruct the scheduler to try entering it again when
 283          * the garbage collector has run.
 284          *
 285          * It's done this way because there's a possibility that the
 286          * garbage collector might have messed around with the stack,
 287          * such as removing the update frame.
 288          */
 289         if ((Hp += PapSize) > HpLim) {
 290 #ifdef PROFILING
 291           // @LDV profiling
 292           // Not filling the slop for the object (because there is none), but
 293           // filling in the trailing words in the current block.
 294           // This is unnecessary because we fills the entire nursery with
 295           // zeroes after each garbage collection.
 296           // FILL_SLOP(HpLim, PapSize - (Hp - HpLim));
 297 #endif
 298           Sp -= 1;
 299           Sp[0] = (W_)Fun;
 300           JMP_(stg_gc_entertop);
 301         }
 302
 303         TICK_ALLOC_UPD_PAP(1/*fun*/ + Words, 0);
 304 #ifdef PROFILING
 305         CCS_ALLOC(CCS_pap, PapSize);
 306 #endif
 307
 308         PapClosure = (StgPAP *)(Hp + 1 - PapSize); /* The new PapClosure */
 309
 310         SET_HDR(PapClosure,&stg_PAP_info,CCS_pap);
 311         PapClosure->n_args = Words;
 312         PapClosure->fun = Fun;
 313
 314         /* Now fill in the closure fields */
 315
 316         p = Hp;
 317         for (i = Words; --i >= 0; ) {
 318            *p-- = (W_) Sp[i];
 319         }
 320     }
 321
 322     /*
 323      * Finished constructing PAP closure; now update the updatee.
 324      */
 325
 326     /* ToDo: we'd like to just jump to the code for PAP_entry here,
 327      * which deals with a stack of update frames in one go.  What to
 328      * do about the special ticky and profiling stuff here?
 329      */
 330
 331     switch (get_itbl(Su)->type) {
 332
 333     case SEQ_FRAME:
 334       /* Set Sp to just above the SEQ frame (should be an activation rec.)*/
 335       Sp = (P_)Su + sizeofW(StgSeqFrame);
 336
 337       /* restore Su */
 338       Su = ((StgSeqFrame *)Su)->link;
 339
 340       /* return to the activation record, with the address of the PAP in R1 */
 341       R1.p = (P_)PapClosure;
 342       JMP_(ENTRY_CODE(*Sp));
 343
 344     case CATCH_FRAME:
 345       /* Set Sp to just above the CATCH frame (should be an activation rec.)*/
 346       Sp = (P_)Su + sizeofW(StgCatchFrame);
 347
 348       /* restore Su */
 349       Su = ((StgCatchFrame *)Su)->link;
 350
 351       /* restart by entering the PAP */
 352       R1.p = (P_)PapClosure;
 353       JMP_(GET_ENTRY(R1.cl));
 354
 355     case UPDATE_FRAME:
 356       /*
 357        * Now we have a standard update frame, so we update the updatee with
 358        * either the new PAP or Node.
 359        */
 360
 361       Updatee = Su->updatee;
 362
 363 #if defined(PROFILING)
 364       if (Words != 0) {
 365         UPD_IND(Updatee,PapClosure);
 366         TICK_UPD_PAP_IN_NEW(Words+1);
 367       } else {
 368         /* Lexical scoping requires a *permanent* indirection, and we
 369          * also have to set the cost centre for the indirection.
 370          */
 371         UPD_PERM_IND(Updatee,PapClosure);
 372         TICK_UPD_PAP_IN_PLACE();
 373         Updatee->header.prof.ccs = CCS_pap;
 374       }
 375 #else
 376       UPD_IND(Updatee,PapClosure);
 377       if (Words != 0) {
 378         TICK_UPD_PAP_IN_NEW(Words+1);
 379       } else {
 380         TICK_UPD_PAP_IN_PLACE();
 381       }
 382 #endif
 383
 384 #if defined(PROFILING)
 385       CCCS = Su->header.prof.ccs;
 386       ENTER_CCS_PAP(CCS_pap);
 387 #endif /* PROFILING */
 388
 389       /* Restore Su */
 390       Su = Su->link;
 391
 392       /*
 393        * Squeeze out update frame from stack.
 394        */
 395       for (i = Words; --i >= 0; ) {
 396         Sp[i+(sizeofW(StgUpdateFrame))] = Sp[i];
 397       }
 398       Sp += sizeofW(StgUpdateFrame);
 399       break;
 400
 401     default:
 402       barf("stg_update_PAP: strange activation record");
 403     }
 404
 405     /*
 406      * All done!  Restart by re-entering Node
 407      * Don't count this entry for ticky-ticky profiling.
 408      */
 409     JMP_(GET_ENTRY(R1.cl));
 410     FE_
 411 }
 412
 413
 414 /* -----------------------------------------------------------------------------
 415    Entry Code for an AP_UPD.
 416
 417    The idea is to copy the chunk of stack from the AP object and then
 418    enter the function closure.
 419
 420    (This code is a simplified copy of the PAP code - with all the
 421     update frame code stripped out.)
 422    -------------------------------------------------------------------------- */
 423
 424
 425 INFO_TABLE(stg_AP_UPD_info,stg_AP_UPD_entry,/*special layout*/0,0,AP_UPD,,EF_,"AP_UPD","AP_UPD");
 426 STGFUN(stg_AP_UPD_entry)
 427 {
 428   nat Words;
 429   P_ p;
 430   nat i;
 431   StgAP_UPD *ap;
 432
 433   FB_
 434
 435   ap = (StgAP_UPD *) R1.p;
 436
 437   Words = ap->n_args;
 438
 439   /*
 440    * Check for stack overflow.
 441    */
 442   STK_CHK_GEN(Words+sizeofW(StgUpdateFrame), R1_PTR, stg_AP_UPD_entry, );
 443
 444   PUSH_UPD_FRAME(R1.p, 0);
 445   Sp -= sizeofW(StgUpdateFrame) + Words;
 446
 447   TICK_ENT_AP_UPD(ap);
 448   LDV_ENTER(ap);
 449
 450   /* Enter PAP cost centre -- lexical scoping only */
 451   ENTER_CCS_PAP_CL(ap);   /* ToDo: ENTER_CC_AP_UPD_CL */
 452
 453   R1.cl = ap->fun;
 454   p = (P_)(ap->payload);
 455
 456   /* Reload the stack */
 457   for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
 458
 459   /* Off we go! */
 460   TICK_ENT_VIA_NODE();
 461   JMP_(GET_ENTRY(R1.cl));
 462   FE_
 463 }
 464
 465
 466 /*-----------------------------------------------------------------------------
 467   Seq frames
 468
 469   We don't have a primitive seq# operator: it is just a 'case'
 470   expression whose scrutinee has either a polymorphic or function type
 471   (constructor types can be handled by normal 'case' expressions).
 472
 473   To handle a polymorphic/function typed seq, we push a SEQ_FRAME on
 474   the stack.  This is a polymorphic activation record that just pops
 475   itself and returns when entered.  The purpose of the SEQ_FRAME is to
 476   act as a barrier in case the scrutinee is a partial application - in
 477   this way it is just like an update frame, except that it doesn't
 478   update anything.
 479   -------------------------------------------------------------------------- */
 480
 481 #define SEQ_FRAME_ENTRY_TEMPLATE(label,ret)     \
 482    IFN_(label)                                  \
 483    {                                            \
 484       FB_                                       \
 485       Su = ((StgSeqFrame *)Sp)->link;   \
 486       Sp += sizeofW(StgSeqFrame);               \
 487       JMP_(ret);                                \
 488       FE_                                       \
 489    }
 490
 491 SEQ_FRAME_ENTRY_TEMPLATE(stg_seq_frame_entry,  ENTRY_CODE(Sp[0]));
 492 SEQ_FRAME_ENTRY_TEMPLATE(stg_seq_frame_0_entry,ENTRY_CODE(Sp[0]));
 493 SEQ_FRAME_ENTRY_TEMPLATE(stg_seq_frame_1_entry,ENTRY_CODE(Sp[0]));
 494 SEQ_FRAME_ENTRY_TEMPLATE(stg_seq_frame_2_entry,ENTRY_CODE(Sp[0]));
 495 SEQ_FRAME_ENTRY_TEMPLATE(stg_seq_frame_3_entry,ENTRY_CODE(Sp[0]));
 496 SEQ_FRAME_ENTRY_TEMPLATE(stg_seq_frame_4_entry,ENTRY_CODE(Sp[0]));
 497 SEQ_FRAME_ENTRY_TEMPLATE(stg_seq_frame_5_entry,ENTRY_CODE(Sp[0]));
 498 SEQ_FRAME_ENTRY_TEMPLATE(stg_seq_frame_6_entry,ENTRY_CODE(Sp[0]));
 499 SEQ_FRAME_ENTRY_TEMPLATE(stg_seq_frame_7_entry,ENTRY_CODE(Sp[0]));
 500
 501 VEC_POLY_INFO_TABLE(stg_seq_frame, UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, SEQ_FRAME,, EF_);
 502
 503 /* -----------------------------------------------------------------------------
 504  * The seq infotable
 505  *
 506  * This closure takes one argument, which it evaluates and returns the
 507  * result with a direct return (never a vectored return!) in R1.  It
 508  * does this by pushing a SEQ_FRAME on the stack and
 509  * entering its argument.
 510  *
 511  * It is used in deleteThread when reverting blackholes.
 512  * -------------------------------------------------------------------------- */
 513
 514 INFO_TABLE(stg_seq_info,stg_seq_entry,1,0,FUN,,EF_,0,0);
 515 STGFUN(stg_seq_entry)
 516 {
 517   FB_
 518   STK_CHK_GEN(sizeofW(StgSeqFrame), NO_PTRS, stg_seq_entry, );
 519   Sp -= sizeofW(StgSeqFrame);
 520   PUSH_SEQ_FRAME(Sp);
 521   R1.cl = R1.cl->payload[0];
 522   JMP_(ENTRY_CODE(*R1.p));
 523   FE_
 524 }