ghc/rts/Updates.hc

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Updates.hc,v 1.21 1999/11/09 15:47:00 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           if (Bdescr(updatee)->back != BaseReg) {                       \
  64                 LOCK_CLOSURE(Su);                                       \
  65           }                                                             \
  66                                                                         \
  67           UPD_IND_NOLOCK(Su,R1.p);                                      \
  68                                                                         \
  69           /* update the updatee with an indirection                     \
  70            * to the return value                                        \
  71            */                                                           \
  72                                                                         \
  73           /* reset Su to the next update frame */                       \
  74           Su = ((StgUpdateFrame *)Sp)->link;                            \
  75                                                                         \
  76           /* remove the update frame from the stack */                  \
  77           Sp += sizeofW(StgUpdateFrame);                                \
  78                                                                         \
  79           JMP_(ret);                                                    \
  80           FE_                                                           \
  81         }
  82 #else
  83
  84 #define UPD_FRAME_ENTRY_TEMPLATE(label,ret)                             \
  85         STGFUN(label);                                                  \
  86         STGFUN(label)                                                   \
  87         {                                                               \
  88           StgClosure *updatee;                                          \
  89           FB_                                                           \
  90                                                                         \
  91           updatee = ((StgUpdateFrame *)Sp)->updatee;                    \
  92                                                                         \
  93           /* Tick - it must be a con, all the paps are handled          \
  94            * in stg_upd_PAP and PAP_entry below                         \
  95            */                                                           \
  96           TICK_UPD_CON_IN_NEW(sizeW_fromITBL(get_itbl(updatee)));       \
  97                                                                         \
  98           UPD_IND(updatee, R1.cl);                                      \
  99                                                                         \
 100           /* reset Su to the next update frame */                       \
 101           Su = ((StgUpdateFrame *)Sp)->link;                            \
 102                                                                         \
 103           /* remove the update frame from the stack */                  \
 104           Sp += sizeofW(StgUpdateFrame);                                \
 105                                                                         \
 106           JMP_(ret);                                                    \
 107           FE_                                                           \
 108         }
 109 #endif
 110
 111 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_entry,ENTRY_CODE(Sp[0]));
 112 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_0_entry,RET_VEC(Sp[0],0));
 113 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_1_entry,RET_VEC(Sp[0],1));
 114 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_2_entry,RET_VEC(Sp[0],2));
 115 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_3_entry,RET_VEC(Sp[0],3));
 116 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_4_entry,RET_VEC(Sp[0],4));
 117 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_5_entry,RET_VEC(Sp[0],5));
 118 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_6_entry,RET_VEC(Sp[0],6));
 119 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_7_entry,RET_VEC(Sp[0],7));
 120
 121 /*
 122   Make sure this table is big enough to handle the maximum vectored
 123   return size!
 124   */
 125
 126 #ifdef PROFILING
 127 #define UPD_FRAME_BITMAP 3
 128 #else
 129 #define UPD_FRAME_BITMAP 1
 130 #endif
 131
 132 /* this bitmap indicates that the first word of an update frame is a
 133  * non-pointer - this is the update frame link.  (for profiling,
 134  * there's a cost-centre-stack in there too).
 135  */
 136
 137 VEC_POLY_INFO_TABLE(Upd_frame,UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, UPDATE_FRAME,, EF_);
 138
 139 /* -----------------------------------------------------------------------------
 140    Entry Code for a PAP.
 141
 142    The idea is to copy the chunk of stack from the PAP object and then
 143    re-enter the function closure that failed it's args check in the
 144    first place.
 145
 146    In fact, we do a little optimisation too, by performing the updates
 147    for any update frames sitting on top of the stack. (ToDo: is this
 148    really an optimisation? --SDM)
 149    -------------------------------------------------------------------------- */
 150
 151 INFO_TABLE(PAP_info,PAP_entry,/*special layout*/0,0,PAP,,EF_,0,0);
 152 STGFUN(PAP_entry)
 153 {
 154   nat Words;
 155   P_ p;
 156   nat i;
 157   StgPAP *pap;
 158
 159   FB_
 160
 161   pap = (StgPAP *) R1.p;
 162
 163   /*
 164    * remove any update frames on the top of the stack, by just
 165    * performing the update here.
 166    */
 167   while ((W_)Su - (W_)Sp == 0) {
 168
 169     switch (get_itbl(Su)->type) {
 170
 171     case UPDATE_FRAME:
 172       /* We're sitting on top of an update frame, so let's do the business */
 173       UPD_IND(Su->updatee, pap);
 174
 175 #if defined(PROFILING)
 176       /*
 177        * Restore the Cost Centre too (if required); again see Sansom
 178        * thesis p 183.  Take the CC out of the update frame if a
 179        * CAF/DICT.
 180        */
 181
 182       CCCS = Su->header.prof.ccs;
 183 #endif /* PROFILING */
 184
 185       Su = Su->link;
 186       Sp += sizeofW(StgUpdateFrame);
 187       continue;
 188
 189     case SEQ_FRAME:
 190       /* Just pop the seq frame and return to the activation record
 191        * underneath us - R1 already contains the address of the PAP.
 192        */
 193       Su = ((StgSeqFrame *)Su)->link;
 194       Sp += sizeofW(StgSeqFrame);
 195       JMP_(ENTRY_CODE(*Sp));
 196
 197     case CATCH_FRAME:
 198       /* can't happen, see stg_update_PAP */
 199       barf("PAP_entry: CATCH_FRAME");
 200
 201     default:
 202       barf("PAP_entry: strange activation record");
 203     }
 204
 205   }
 206
 207   Words = pap->n_args;
 208
 209   /*
 210    * Check for stack overflow.
 211    */
 212   STK_CHK_NP(Words,1,);
 213   Sp -= Words;
 214
 215   TICK_ENT_PAP(pap);
 216
 217   /* Enter PAP cost centre -- lexical scoping only */
 218   ENTER_CCS_PAP_CL(pap);
 219
 220   R1.cl = pap->fun;
 221   p = (P_)(pap->payload);
 222
 223   /* Reload the stack */
 224   for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
 225
 226   /* Off we go! */
 227   TICK_ENT_VIA_NODE();
 228   JMP_(GET_ENTRY(R1.cl));
 229   FE_
 230 }
 231
 232 /* -----------------------------------------------------------------------------
 233    stg_update_PAP: Update the current closure with a partial application.
 234
 235    This function is called whenever an argument satisfaction check fails.
 236    -------------------------------------------------------------------------- */
 237
 238 EXTFUN(stg_update_PAP)
 239 {
 240   nat Words, PapSize;
 241 #ifdef PROFILING
 242   CostCentreStack *CCS_pap;
 243 #endif
 244   StgPAP* PapClosure;
 245   StgClosure *Fun, *Updatee;
 246   P_ p;
 247   I_ i;
 248
 249   FB_
 250
 251     /* Save the pointer to the function closure that just failed the
 252      * argument satisfaction check
 253      */
 254     Fun = R1.cl;
 255
 256 #if defined(GRAN_COUNT)
 257 #error Fixme.
 258       ++nPAPs;
 259 #endif
 260
 261     /* Just copy the whole block of stack between the stack pointer
 262      * and the update frame pointer.
 263      */
 264     Words    = (P_)Su - (P_)Sp;
 265     ASSERT((int)Words >= 0);
 266
 267 #if defined(PROFILING)
 268     /* pretend we just entered the function closure */
 269     ENTER_CCS_FCL(Fun);
 270     CCS_pap = CCCS;
 271 #endif
 272
 273     if (Words == 0) {
 274
 275         /*
 276          * No arguments, only Node.  Skip building the PAP and
 277          * just plan to update with an indirection.
 278          */
 279
 280         PapClosure = (StgPAP *)Fun;
 281
 282     } else {
 283            /* Build the PAP */
 284
 285         PapSize = Words + sizeofW(StgPAP);
 286
 287         /*
 288          * First we need to do a heap check, which involves saving
 289          * everything on the stack.  We only have one live pointer:
 290          * Fun, the function closure that was passed to us.  If the
 291          * heap check fails, we push the function closure on the stack
 292          * and instruct the scheduler to try entering it again when
 293          * the garbage collector has run.
 294          *
 295          * It's done this way because there's a possibility that the
 296          * garbage collector might have messed around with the stack,
 297          * such as removing the update frame.
 298          */
 299         if ((Hp += PapSize) > HpLim) {
 300           Sp -= 1;
 301           Sp[0] = (W_)Fun;
 302           JMP_(stg_gc_entertop);
 303         }
 304
 305         TICK_ALLOC_UPD_PAP(1/*fun*/ + Words, 0);
 306 #ifdef PROFILING
 307         CCS_ALLOC(CCS_pap, PapSize);
 308 #endif
 309
 310         PapClosure = (StgPAP *)(Hp + 1 - PapSize); /* The new PapClosure */
 311
 312         SET_HDR(PapClosure,&PAP_info,CCS_pap);
 313         PapClosure->n_args = Words;
 314         PapClosure->fun = Fun;
 315
 316         /* Now fill in the closure fields */
 317
 318         p = Hp;
 319         for (i = Words-1; i >= 0; i--) {
 320            *p-- = (W_) Sp[i];
 321         }
 322     }
 323
 324     /*
 325      * Finished constructing PAP closure; now update the updatee.
 326      */
 327
 328     /* ToDo: we'd like to just jump to the code for PAP_entry here,
 329      * which deals with a stack of update frames in one go.  What to
 330      * do about the special ticky and profiling stuff here?
 331      */
 332
 333     switch (get_itbl(Su)->type) {
 334
 335     case SEQ_FRAME:
 336       /* Set Sp to just above the SEQ frame (should be an activation rec.)*/
 337       Sp = (P_)Su + sizeofW(StgSeqFrame);
 338
 339       /* restore Su */
 340       Su = ((StgSeqFrame *)Su)->link;
 341
 342       /* return to the activation record, with the address of the PAP in R1 */
 343       R1.p = (P_)PapClosure;
 344       JMP_(ENTRY_CODE(*Sp));
 345
 346     case CATCH_FRAME:
 347       /* Set Sp to just above the CATCH frame (should be an activation rec.)*/
 348       Sp = (P_)Su + sizeofW(StgCatchFrame);
 349
 350       /* restore Su */
 351       Su = ((StgCatchFrame *)Su)->link;
 352
 353       /* restart by entering the PAP */
 354       R1.p = (P_)PapClosure;
 355       JMP_(GET_ENTRY(R1.cl));
 356
 357     case UPDATE_FRAME:
 358       /*
 359        * Now we have a standard update frame, so we update the updatee with
 360        * either the new PAP or Node.
 361        */
 362
 363       Updatee = Su->updatee;
 364
 365 #if defined(PROFILING)
 366       if (Words != 0) {
 367         UPD_IND(Updatee,PapClosure);
 368         TICK_UPD_PAP_IN_NEW(Words+1);
 369       } else {
 370         /* Lexical scoping requires a *permanent* indirection, and we
 371          * also have to set the cost centre for the indirection.
 372          */
 373         UPD_PERM_IND(Updatee,PapClosure);
 374         TICK_UPD_PAP_IN_PLACE();
 375         Updatee->header.prof.ccs = CCS_pap;
 376       }
 377 #else
 378       UPD_IND(Updatee,PapClosure);
 379       if (Words != 0) {
 380         TICK_UPD_PAP_IN_NEW(Words+1);
 381       } else {
 382         TICK_UPD_PAP_IN_PLACE();
 383       }
 384 #endif
 385
 386 #if defined(PROFILING)
 387       CCCS = Su->header.prof.ccs;
 388       ENTER_CCS_PAP(CCS_pap);
 389 #endif /* PROFILING */
 390
 391       /* Restore Su */
 392       Su = Su->link;
 393
 394       /*
 395        * Squeeze out update frame from stack.
 396        */
 397       for (i = Words-1; i >= 0; i--) {
 398         Sp[i+(sizeofW(StgUpdateFrame))] = Sp[i];
 399       }
 400       Sp += sizeofW(StgUpdateFrame);
 401       break;
 402
 403     default:
 404       barf("stg_update_PAP: strange activation record");
 405     }
 406
 407     /*
 408      * All done!  Restart by re-entering Node
 409      * Don't count this entry for ticky-ticky profiling.
 410      */
 411     JMP_(GET_ENTRY(R1.cl));
 412     FE_
 413 }
 414
 415
 416 /* -----------------------------------------------------------------------------
 417    Entry Code for an AP_UPD.
 418
 419    The idea is to copy the chunk of stack from the AP object and then
 420    enter the function closure.
 421
 422    (This code is a simplified copy of the PAP code - with all the
 423     update frame code stripped out.)
 424    -------------------------------------------------------------------------- */
 425
 426
 427 INFO_TABLE(AP_UPD_info,AP_UPD_entry,/*special layout*/0,0,AP_UPD,,EF_,0,0);
 428 STGFUN(AP_UPD_entry)
 429 {
 430   nat Words;
 431   P_ p;
 432   nat i;
 433   StgAP_UPD *ap;
 434
 435   FB_
 436
 437   ap = (StgAP_UPD *) R1.p;
 438
 439   Words = ap->n_args;
 440
 441   /*
 442    * Check for stack overflow.
 443    */
 444   STK_CHK(Words+sizeofW(StgUpdateFrame),AP_UPD_entry,R2.p,1,);
 445
 446   PUSH_UPD_FRAME(R1.p, 0);
 447   Sp -= sizeofW(StgUpdateFrame) + Words;
 448
 449   TICK_ENT_AP_UPD(ap);
 450
 451   /* Enter PAP cost centre -- lexical scoping only */
 452   ENTER_CCS_PAP_CL(ap);   /* ToDo: ENTER_CC_AP_UPD_CL */
 453
 454   R1.cl = ap->fun;
 455   p = (P_)(ap->payload);
 456
 457   /* Reload the stack */
 458   for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
 459
 460   /* Off we go! */
 461   TICK_ENT_VIA_NODE();
 462   JMP_(GET_ENTRY(R1.cl));
 463   FE_
 464 }
 465
 466
 467 /*-----------------------------------------------------------------------------
 468   Seq frames
 469
 470   We don't have a primitive seq# operator: it is just a 'case'
 471   expression whose scrutinee has either a polymorphic or function type
 472   (constructor types can be handled by normal 'case' expressions).
 473
 474   To handle a polymorphic/function typed seq, we push a SEQ_FRAME on
 475   the stack.  This is a polymorphic activation record that just pops
 476   itself and returns when entered.  The purpose of the SEQ_FRAME is to
 477   act as a barrier in case the scrutinee is a partial application - in
 478   this way it is just like an update frame, except that it doesn't
 479   update anything.
 480   -------------------------------------------------------------------------- */
 481
 482 #define SEQ_FRAME_ENTRY_TEMPLATE(label,ret)     \
 483    IFN_(label)                                  \
 484    {                                            \
 485       FB_                                       \
 486       Su = ((StgSeqFrame *)Sp)->link;   \
 487       Sp += sizeofW(StgSeqFrame);               \
 488       JMP_(ret);                                \
 489       FE_                                       \
 490    }
 491
 492 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_entry,  ENTRY_CODE(Sp[0]));
 493 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_0_entry,ENTRY_CODE(Sp[0]));
 494 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_1_entry,ENTRY_CODE(Sp[0]));
 495 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_2_entry,ENTRY_CODE(Sp[0]));
 496 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_3_entry,ENTRY_CODE(Sp[0]));
 497 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_4_entry,ENTRY_CODE(Sp[0]));
 498 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_5_entry,ENTRY_CODE(Sp[0]));
 499 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_6_entry,ENTRY_CODE(Sp[0]));
 500 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_7_entry,ENTRY_CODE(Sp[0]));
 501
 502 VEC_POLY_INFO_TABLE(seq_frame, UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, SEQ_FRAME,, EF_);
 503
 504 /* -----------------------------------------------------------------------------
 505  * The seq infotable
 506  *
 507  * This closure takes one argument, which it evaluates and returns the
 508  * result with a direct return (never a vectored return!) in R1.  It
 509  * does this by pushing a SEQ_FRAME on the stack and
 510  * entering its argument.
 511  *
 512  * It is used in deleteThread when reverting blackholes.
 513  * -------------------------------------------------------------------------- */
 514
 515 INFO_TABLE(seq_info,seq_entry,1,0,FUN,,EF_,0,0);
 516 STGFUN(seq_entry)
 517 {
 518   FB_
 519   STK_CHK_GEN(sizeofW(StgSeqFrame), NO_PTRS, seq_entry, );
 520   Sp -= sizeofW(StgSeqFrame);
 521   PUSH_SEQ_FRAME(Sp);
 522   R1.cl = R1.cl->payload[0];
 523   JMP_(ENTRY_CODE(*R1.p));
 524   FE_
 525 }
 526
 527
 528 /* -----------------------------------------------------------------------------
 529    Exception Primitives
 530    -------------------------------------------------------------------------- */
 531
 532 FN_(catchzh_fast);
 533 FN_(raisezh_fast);
 534
 535 #define CATCH_FRAME_ENTRY_TEMPLATE(label,ret)   \
 536    FN_(label);                                  \
 537    FN_(label)                                   \
 538    {                                            \
 539       FB_                                       \
 540       Su = ((StgCatchFrame *)Sp)->link;         \
 541       Sp += sizeofW(StgCatchFrame);             \
 542       JMP_(ret);                                \
 543       FE_                                       \
 544    }
 545
 546 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_entry,ENTRY_CODE(Sp[0]));
 547 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_0_entry,RET_VEC(Sp[0],0));
 548 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_1_entry,RET_VEC(Sp[0],1));
 549 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_2_entry,RET_VEC(Sp[0],2));
 550 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_3_entry,RET_VEC(Sp[0],3));
 551 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_4_entry,RET_VEC(Sp[0],4));
 552 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_5_entry,RET_VEC(Sp[0],5));
 553 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_6_entry,RET_VEC(Sp[0],6));
 554 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_7_entry,RET_VEC(Sp[0],7));
 555
 556 #ifdef PROFILING
 557 #define CATCH_FRAME_BITMAP 3
 558 #else
 559 #define CATCH_FRAME_BITMAP 1
 560 #endif
 561
 562 /* Catch frames are very similar to update frames, but when entering
 563  * one we just pop the frame off the stack and perform the correct
 564  * kind of return to the activation record underneath us on the stack.
 565  */
 566
 567 VEC_POLY_INFO_TABLE(catch_frame, CATCH_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, CATCH_FRAME,, EF_);
 568
 569 /* -----------------------------------------------------------------------------
 570  * The catch infotable
 571  *
 572  * This should be exactly the same as would be generated by this STG code
 573  *
 574  * catch = {x,h} \n {} -> catch#{x,h}
 575  *
 576  * It is used in deleteThread when reverting blackholes.
 577  * -------------------------------------------------------------------------- */
 578
 579 INFO_TABLE(catch_info,catch_entry,2,0,FUN,,EF_,0,0);
 580 STGFUN(catch_entry)
 581 {
 582   FB_
 583   R2.cl = payloadCPtr(R1.cl,1); /* h */
 584   R1.cl = payloadCPtr(R1.cl,0); /* x */
 585   JMP_(catchzh_fast);
 586   FE_
 587 }
 588
 589 FN_(catchzh_fast)
 590 {
 591   StgCatchFrame *fp;
 592   FB_
 593
 594     /* args: R1 = m, R2 = k */
 595     STK_CHK_GEN(sizeofW(StgCatchFrame), R1_PTR | R2_PTR, catchzh_fast, );
 596     Sp -= sizeofW(StgCatchFrame);
 597     fp = (StgCatchFrame *)Sp;
 598     SET_HDR(fp,(StgInfoTable *)&catch_frame_info,CCCS);
 599     fp -> handler = R2.cl;
 600     fp -> link = Su;
 601     Su = (StgUpdateFrame *)fp;
 602     TICK_CATCHF_PUSHED();
 603     TICK_ENT_VIA_NODE();
 604     JMP_(ENTRY_CODE(*R1.p));
 605
 606   FE_
 607 }
 608
 609 /* -----------------------------------------------------------------------------
 610  * The raise infotable
 611  *
 612  * This should be exactly the same as would be generated by this STG code
 613  *
 614  *   raise = {err} \n {} -> raise#{err}
 615  *
 616  * It is used in raisezh_fast to update thunks on the update list
 617  * -------------------------------------------------------------------------- */
 618
 619 INFO_TABLE(raise_info,raise_entry,1,0,FUN,,EF_,0,0);
 620 STGFUN(raise_entry)
 621 {
 622   FB_
 623   R1.cl = R1.cl->payload[0];
 624   JMP_(raisezh_fast);
 625   FE_
 626 }
 627
 628 FN_(raisezh_fast)
 629 {
 630   StgClosure *handler;
 631   StgUpdateFrame *p;
 632   StgClosure *raise_closure;
 633   FB_
 634     /* args : R1 = error */
 635
 636     p = Su;
 637
 638     /* This closure represents the expression 'raise# E' where E
 639      * is the exception raise.  It is used to overwrite all the
 640      * thunks which are currently under evaluataion.
 641      */
 642     raise_closure = (StgClosure *)RET_STGCALL1(P_,allocate,
 643                                                sizeofW(StgClosure)+1);
 644     raise_closure->header.info = &raise_info;
 645     raise_closure->payload[0] = R1.cl;
 646
 647     while (1) {
 648
 649       switch (get_itbl(p)->type) {
 650
 651       case UPDATE_FRAME:
 652         UPD_IND(p->updatee,raise_closure);
 653         p = p->link;
 654         continue;
 655
 656       case SEQ_FRAME:
 657         p = ((StgSeqFrame *)p)->link;
 658         continue;
 659
 660       case CATCH_FRAME:
 661         /* found it! */
 662         break;
 663
 664       case STOP_FRAME:
 665         barf("raisezh_fast: STOP_FRAME");
 666
 667       default:
 668         barf("raisezh_fast: weird activation record");
 669       }
 670
 671       break;
 672
 673     }
 674
 675     /* Ok, p points to the enclosing CATCH_FRAME.  Pop everything down to
 676      * and including this frame, update Su, push R1, and enter the handler.
 677      */
 678     Su = ((StgCatchFrame *)p)->link;
 679     handler = ((StgCatchFrame *)p)->handler;
 680
 681     Sp = (P_)p + sizeofW(StgCatchFrame) - 1;
 682     *Sp = R1.w;
 683
 684     TICK_ENT_VIA_NODE();
 685     R1.cl = handler;
 686     JMP_(ENTRY_CODE(handler->header.info));
 687
 688   FE_
 689 }
 690