ghc/rts/Updates.hc

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