ghc/rts/Updates.hc

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