ghc/rts/Updates.hc

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