ghc/rts/Updates.hc

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