ghc/rts/Updates.hc

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