ghc/runtime/main/StgUpdate.lhc

   1 %************************************************************************
   2 %*                                                                      *
   3 \section[update-code]{Code required for update abstraction}
   4 %*                                                                      *
   5 %************************************************************************
   6
   7 This code is required by the update interface which sits on top of the
   8 storage manager interface (See \tr{SMupdate.lh}).
   9
  10 \begin{itemize}
  11 \item Indirection entry code and info table.
  12 \item Black Hole entry code and info table.
  13 \item Update frame code and return vectors.
  14 \item PAP update code.
  15 \item PAP entry code and info table.
  16 \end{itemize}
  17
  18 System-wide constants need to be included:
  19 \begin{code}
  20 #define MAIN_REG_MAP        /* STG world */
  21
  22 #include "rtsdefs.h"
  23 #include "SMupdate.h"
  24 #if 0
  25 #ifdef PAR
  26 # include "Statistics.h"
  27 #endif
  28 #endif
  29
  30 EXTDATA(PrelBase_Z91Z93_closure);
  31
  32 #if defined(TICKY_TICKY)
  33 void PrintTickyInfo(STG_NO_ARGS);
  34 #endif
  35 \end{code}
  36
  37 %************************************************************************
  38 %*                                                                      *
  39 \subsection[indirection-code]{Indirection code}
  40 %*                                                                      *
  41 %************************************************************************
  42
  43 The entry code for indirections and the indirection info-table.
  44 \begin{code}
  45 STGFUN(Ind_entry)
  46 {
  47     FB_
  48     ENT_IND(Node);      /* Ticky-ticky profiling info */
  49
  50     Node = (P_) IND_CLOSURE_PTR((P_) Node);
  51     ENT_VIA_NODE();
  52     InfoPtr=(D_)(INFO_PTR(Node));
  53     JMP_(ENTRY_CODE(InfoPtr));
  54     FE_
  55 }
  56
  57 IND_ITBL(Ind_info,Ind_entry,const,EF_);
  58 \end{code}
  59
  60 We also need a special @CAF@ indirection info table which is used to
  61 indirect @CAF@s to evaluated results in the heap.
  62 \begin{code}
  63 STGFUN(Caf_entry)       /* same as Ind_entry */
  64 {
  65     FB_
  66     ENT_IND(Node);
  67
  68     Node = (P_) IND_CLOSURE_PTR((P_) Node);
  69     ENT_VIA_NODE();
  70     InfoPtr=(D_)(INFO_PTR(Node));
  71     JMP_(ENTRY_CODE(InfoPtr));
  72     FE_
  73 }
  74
  75 CAF_ITBL(Caf_info,Caf_entry,const,EF_);
  76 \end{code}
  77
  78 %************************************************************************
  79 %*                                                                      *
  80 \subsection[black-hole-code]{Black Hole code}
  81 %*                                                                      *
  82 %************************************************************************
  83
  84 The entry code for black holes abort indicating a cyclic data dependency.
  85 It is used to overwrite closures currently being evaluated.
  86
  87 In the concurrent world, black holes are synchronization points, and they
  88 are turned into blocking queues when there are threads waiting for the
  89 evaluation of the closure to finish.
  90
  91 \begin{code}
  92 #ifdef CONCURRENT
  93 EXTFUN(EnterNodeCode);
  94 EXTFUN(StackUnderflowEnterNode);
  95 EXTDATA_RO(BQ_info);
  96 #else
  97 void raiseError PROTO((StgStablePtr));
  98 extern StgStablePtr errorHandler; /* NB: prone to magic-value-ery (WDP 95/12) */
  99 #endif
 100
 101 STGFUN(BH_UPD_entry)
 102 {
 103 #ifndef CONCURRENT
 104     FB_
 105     (void) STGCALL1(int,(void *, FILE *),fflush,stdout);
 106     (void) STGCALL2(int,(),fprintf,stderr,"Entered a `black hole': the program has a cyclic data dependency.\n");
 107
 108 # if defined(PROFILING)
 109     {
 110         CostCentre cc = (CostCentre) CC_HDR(Node);
 111         (void) STGCALL5(int,(),fprintf,stderr,"Cost Centre: %s  Module: %s  Group %s\n",cc->label, cc->module, cc->group);
 112     }
 113 # endif
 114
 115 # if defined(TICKY_TICKY)
 116     if (RTSflags.TickyFlags.showTickyStats) {
 117         (void) STGCALL0(void,(),PrintTickyInfo);
 118     }
 119 # endif
 120
 121     (void) STGCALL1(void,(void *, StgStablePtr), raiseError, errorHandler);
 122     FE_
 123
 124 #else /* threads! */
 125
 126     FB_
 127
 128 # if 0
 129     if ( RTSflags.GranFlags.debug & 0x80 )
 130       (void) STGCALL4(int,(),fprintf,stderr,"GRAN_CHECK in BH_UPD_entry: Entered a `black hole' @ 0x%x (CurrentTSO @ 0x%x\n ",Node,CurrentTSO);
 131 # endif
 132
 133 # if defined(GRAN)
 134     /* Do this before losing its TSO_LINK */
 135     STGCALL3(void,(),GranSimBlock,CurrentTSO,CurrentProc,Node);
 136 # endif
 137
 138     TSO_LINK(CurrentTSO) = PrelBase_Z91Z93_closure;
 139     SET_INFO_PTR(Node, BQ_info);
 140     BQ_ENTRIES(Node) = (W_) CurrentTSO;
 141
 142 # if defined(GCap) || defined(GCgn)
 143     /* If we modify a black hole in the old generation,
 144        we have to make sure it goes on the mutables list */
 145
 146     if(Node <= StorageMgrInfo.OldLim) {
 147         MUT_LINK(Node) = (W_) StorageMgrInfo.OldMutables;
 148         StorageMgrInfo.OldMutables = Node;
 149     } else
 150         MUT_LINK(Node) = MUT_NOT_LINKED;
 151 # endif
 152
 153     LivenessReg = LIVENESS_R1;
 154     SaveAllStgRegs();
 155     TSO_PC1(CurrentTSO) = EnterNodeCode;
 156
 157     if (DO_QP_PROF) {
 158         QP_Event1("GR", CurrentTSO);
 159     }
 160
 161 # ifdef PAR
 162     if(RTSflags.ParFlags.granSimStats) {
 163         TIME now = CURRENT_TIME;
 164         TSO_EXECTIME(CurrentTSO) += now - TSO_BLOCKEDAT(CurrentTSO);
 165         TSO_BLOCKCOUNT(CurrentTSO)++;
 166         TSO_QUEUE(CurrentTSO) = Q_BLOCKED;
 167         TSO_BLOCKEDAT(CurrentTSO) = now;
 168         DumpGranEvent(GR_BLOCK, CurrentTSO);
 169     }
 170 # endif
 171
 172 # if defined(GRAN)
 173     /* CurrentTSO = PrelBase_Z91Z93_closure; */
 174     ReSchedule(SAME_THREAD);
 175 # else
 176     ReSchedule(0);
 177 # endif
 178
 179     FE_
 180
 181 #endif /* threads */
 182 }
 183
 184 /* made external so that debugger can get at it more effectively */
 185 STGFUN(BH_SINGLE_entry)
 186 {
 187     FB_
 188
 189     (void) STGCALL1(int,(void *, FILE *),fflush,stdout);
 190     (void) STGCALL2(int,(),fprintf,stderr,"Entered a single-entry `black hole' --\n");
 191     (void) STGCALL2(int,(),fprintf,stderr,"either the compiler made a mistake on single-entryness,\n");
 192     (void) STGCALL2(int,(),fprintf,stderr,"or the program has a cyclic data dependency.\n");
 193
 194 #if defined(PROFILING)
 195     {
 196         CostCentre cc = (CostCentre) CC_HDR(Node);
 197         (void) STGCALL5(int,(),fprintf,stderr, "Cost Centre: %s  Module: %s  Group %s\n",cc->label, cc->module, cc->group);
 198     }
 199 #endif
 200
 201 # if defined(TICKY_TICKY)
 202     if (RTSflags.TickyFlags.showTickyStats) {
 203         (void) STGCALL0(void,(),PrintTickyInfo);
 204     }
 205 # endif
 206
 207 #ifndef CONCURRENT
 208     (void) STGCALL1(void,(void *, StgStablePtr), raiseError, errorHandler);
 209 #else
 210     EXIT(EXIT_FAILURE);
 211 #endif
 212
 213     FE_
 214 }
 215 \end{code}
 216
 217 Updatable closures are overwritten with a black hole of a fixed size,
 218 @MIN_UPD_SIZE@.
 219
 220 \begin{code}
 221 CAT_DECLARE(BH,BH_K,"BH","BH")  /* just one, shared */
 222
 223 BH_ITBL(BH_UPD_info,BH_UPD_entry,U,const,EF_);
 224 \end{code}
 225
 226 Single-Entry closures, which are not updated, are also overwritten
 227 with a black hole. They have size @MIN_NONUPD_SIZE@.
 228
 229 \begin{code}
 230 BH_ITBL(BH_SINGLE_info,BH_SINGLE_entry,N,const,EF_);
 231 \end{code}
 232
 233 %************************************************************************
 234 %*                                                                      *
 235 \subsection[static-update-code]{Static update code in update frames}
 236 %*                                                                      *
 237 %************************************************************************
 238
 239 This code is pointed to from update frames.  It has to cope with
 240 any kind of algebraic return: vectored or unvectored.
 241
 242 See \tr{SMupdate.lh} for a description of the various update frames
 243 and the macros defining their layout.
 244
 245 On entry to this code:
 246 \begin{itemize}
 247 \item @R1@ points to a recently created heap object (return in heap) or
 248 is dead (return in regs).
 249 \item @R2@ points to the info table for the constructor.
 250 \item When returning in regs, any of the return-regs (@R3@...) may be live,
 251 but aren't used by this code.  They must be preserved.
 252 \item @SpB@ points to the topmost word of the update frame.
 253 \end{itemize}
 254
 255 NEW update mechanism (Jan '94):
 256
 257 When returning to an update frame, we want to jump directly to the
 258 update code for the constructor in hand.  Because of the various
 259 possible return conventions (all of which must be handled by the
 260 generic update frame), we actually end up with a somewhat indirect
 261 jump.
 262
 263 \begin{code}
 264
 265 STGFUN(StdUpdFrameDirectReturn)
 266 {
 267     FB_
 268     JMP_(UPDATE_CODE(InfoPtr));
 269     FE_
 270 }
 271
 272 /*
 273    NB: For direct returns to work properly, the name of the routine must be
 274    the same as the name of the vector table with vtbl_ removed and DirectReturn
 275    appended.  This is all the mangler understands.
 276 */
 277
 278 const
 279 W_
 280 vtbl_StdUpdFrame[] = {
 281     /* at least "MAX_VECTORED_RTN" elements (see GhcConstants.lh) */
 282     (W_) StdUpdFrameDirectReturn/*0*/,
 283     (W_) StdUpdFrameDirectReturn/*1*/,
 284     (W_) StdUpdFrameDirectReturn/*2*/,
 285     (W_) StdUpdFrameDirectReturn/*3*/,
 286     (W_) StdUpdFrameDirectReturn/*4*/,
 287     (W_) StdUpdFrameDirectReturn/*5*/,
 288     (W_) StdUpdFrameDirectReturn/*6*/,
 289     (W_) StdUpdFrameDirectReturn/*7*/
 290 };
 291
 292 \end{code}
 293
 294 %************************************************************************
 295 %*                                                                      *
 296 \subsection[seq-update-code]{Update code for seq}
 297 %*                                                                      *
 298 %************************************************************************
 299
 300
 301 \begin{code}
 302
 303 IFN_(seqDirectReturn) {
 304     void *cont;
 305
 306     FB_
 307     RetReg = (StgRetAddr) SpB[BREL(0)];
 308     cont = (void *) SpB[BREL(1)];
 309     /* SpB += BREL(2); */
 310     JMP_(cont);
 311     FE_
 312 }
 313
 314 /*
 315    NB: For direct returns to work properly, the name of the routine must be
 316    the same as the name of the vector table with vtbl_ removed and DirectReturn
 317    appended.  This is all the mangler understands.
 318  */
 319
 320 const W_
 321 vtbl_seq[] = {
 322     (W_) seqDirectReturn,
 323     (W_) seqDirectReturn,
 324     (W_) seqDirectReturn,
 325     (W_) seqDirectReturn,
 326     (W_) seqDirectReturn,
 327     (W_) seqDirectReturn,
 328     (W_) seqDirectReturn,
 329     (W_) seqDirectReturn
 330 };
 331 \end{code}
 332
 333 %************************************************************************
 334 %*                                                                      *
 335 \subsection[existing-con-update-code]{Update code for existing constructors}
 336 %*                                                                      *
 337 %************************************************************************
 338
 339 Here is the standard update code for objects that are returned in the
 340 heap (or those which are initially returned in registers, but have
 341 already been allocated in the heap earlier in the update chain).  In
 342 either case, @Node@ points to the heap object.  The update code grabs
 343 the address of the updatee out of the partial update frame (the return
 344 address has already been popped), makes the updatee an indirection to
 345 @Node@, and returns according to the convention for the constructor.
 346
 347 \begin{code}
 348 #define IND_UPD_TEMPLATE(label, retvector)                      \
 349   STGFUN(label)                                                 \
 350   {                                                             \
 351     FB_                                                         \
 352     UPD_EXISTING();     /* Ticky-ticky profiling info */        \
 353     /* Update thing off stk with an indirection to Node */      \
 354     UPD_IND(GRAB_UPDATEE(SpB), Node);                           \
 355     /* Pop the standard update frame */                         \
 356     POP_STD_UPD_FRAME()                                         \
 357                                                                 \
 358     JMP_(retvector);                                            \
 359     FE_                                                         \
 360   }
 361
 362 IND_UPD_TEMPLATE(IndUpdRetDir, DIRECT(((P_)RetReg)))
 363 IND_UPD_TEMPLATE(IndUpdRetV0, ((P_)RetReg)[RVREL(0)])
 364 IND_UPD_TEMPLATE(IndUpdRetV1, ((P_)RetReg)[RVREL(1)])
 365 IND_UPD_TEMPLATE(IndUpdRetV2, ((P_)RetReg)[RVREL(2)])
 366 IND_UPD_TEMPLATE(IndUpdRetV3, ((P_)RetReg)[RVREL(3)])
 367 IND_UPD_TEMPLATE(IndUpdRetV4, ((P_)RetReg)[RVREL(4)])
 368 IND_UPD_TEMPLATE(IndUpdRetV5, ((P_)RetReg)[RVREL(5)])
 369 IND_UPD_TEMPLATE(IndUpdRetV6, ((P_)RetReg)[RVREL(6)])
 370 IND_UPD_TEMPLATE(IndUpdRetV7, ((P_)RetReg)[RVREL(7)])
 371 \end{code}
 372
 373 %************************************************************************
 374 %*                                                                      *
 375 \subsection[no-update-code]{Code for Erroneous Updates}
 376 %*                                                                      *
 377 %************************************************************************
 378
 379 \begin{code}
 380
 381 STGFUN(UpdErr)
 382 {
 383     FB_
 384
 385     fflush(stdout);
 386     fprintf(stderr, "Update error: not a constructor!\n");
 387     abort();
 388
 389     FE_
 390 }
 391
 392 STGFUN(StdErrorCode)
 393 {
 394     FB_
 395
 396     fflush(stdout);
 397     fprintf(stderr, "Standard error: should never happen!\n");
 398     abort();
 399
 400     FE_
 401 }
 402 \end{code}
 403
 404 %************************************************************************
 405 %*                                                                      *
 406 \subsection[permanent-indirections]{Lexical Scoping Updates}
 407 %*                                                                      *
 408 %************************************************************************
 409
 410 A function entered without any arguments is updated with an
 411 indirection. For lexically scoped profiling we still need to set the
 412 cost centre if we enter the PAP. As the indirection is removed by the
 413 garbage collector this would not be possible.
 414
 415 To solve this problem we introduce a permanent indirection which sets
 416 the cost centre when entered. The heap profiler ignores the space
 417 occupied by it as it would not reside in the heap during normal
 418 execution.
 419
 420 In ticky-land: If we are trying to collect update-entry counts
 421 (controlled by an RTS flag), then we must use permanent indirections
 422 (the shorting-out of regular indirections loses the counts).
 423
 424 \begin{code}
 425 #if defined(PROFILING) || defined(TICKY_TICKY)
 426
 427 STGFUN(Perm_Ind_entry)
 428 {
 429     FB_
 430
 431     /* Don't add INDs to granularity cost */
 432
 433     /* Dont: ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
 434
 435     /* Enter PAP cost centre -- lexical scoping only */
 436     ENTER_CC_PAP_CL(Node);
 437
 438     Node = (P_) IND_CLOSURE_PTR((P_) Node);
 439
 440     /* Dont: ENT_VIA_NODE(); for ticky-ticky; as above */
 441
 442     InfoPtr=(D_)(INFO_PTR(Node));
 443
 444     JMP_(ENTRY_CODE(InfoPtr));
 445     FE_
 446 }
 447
 448 PERM_IND_ITBL(Perm_Ind_info,Perm_Ind_entry,const,EF_);
 449
 450 #endif /* PROFILING or TICKY */
 451 \end{code}
 452
 453 %************************************************************************
 454 %*                                                                      *
 455 \subsection[partial-application-updates]{Partial applications}
 456 %*                                                                      *
 457 %************************************************************************
 458
 459 See STG paper implementation section of Partial application updates.
 460
 461 We jump here when the current function fails an argument satisfaction
 462 check.  There can be two reasons for this.  In the usual case, there
 463 is an update frame blocking our access to anything deeper on the
 464 stack.  We then update the updatee in the frame with a partial
 465 application node and squeeze out the update frame.  The other
 466 possibility is that we are running threaded code, and we are sitting
 467 on the bottom of a stack chunk.  In this case, we still build the
 468 partial application, but we have nothing in our hands to update, so we
 469 underflow the stack (awakening the previous chunk) and enter the
 470 partial application node just built.
 471
 472 On entry to @UpdatePAP@, we assume the following:
 473 \begin{itemize}
 474 \item SuB points to topmost word of an update frame or to the bottom of a
 475 stack chunk.
 476 \item SpA and SpB point to the topmost words of their respective stacks.
 477 \item Node points to the closure which needs more arguments than are there.
 478 \end{itemize}
 479
 480 \begin{code}
 481 STGFUN(UpdatePAP)
 482 {
 483     /*
 484      * Use STG registers for these locals which must survive the HEAP_CHK.
 485      * Don't squash Node (R1), because it's an implicit argument.
 486      */
 487
 488 #define NNonPtrWords    (R2.i)
 489 #define NPtrWords       (R3.i)
 490 #define NArgWords       (R4.i)
 491 #define PapSize         (R5.i)
 492 #if defined(PROFILING)
 493 # define CC_pap ((CostCentre)(R7.p))
 494 #endif
 495
 496     /* These other locals do not have to survive a HEAP_CHK */
 497
 498     P_ PapClosure;
 499     P_ Updatee;
 500     P_ p;
 501     I_ i;
 502
 503     FB_
 504
 505 #if defined(GRAN_COUNT)
 506       ++nPAPs;
 507 #endif
 508
 509     NPtrWords    = AREL(SuA - SpA);
 510     NNonPtrWords = BREL(SuB - SpB);
 511
 512     ASSERT(NPtrWords >= 0);
 513     ASSERT(NNonPtrWords >= 0);
 514
 515     NArgWords = NPtrWords + NNonPtrWords + 1;   /* +1 for Node */
 516
 517 #if defined(PROFILING)
 518       /* set "CC_pap" to go in the updatee (see Sansom thesis, p 183) */
 519
 520     CC_pap /*really cc_enter*/ = (CostCentre) CC_HDR(Node);
 521     if (IS_CAF_OR_DICT_OR_SUB_CC(CC_pap) /*really cc_enter*/)
 522         CC_pap = CCC;
 523 #endif
 524
 525     if (NArgWords == 1) {
 526
 527         /*
 528          * No arguments, only Node.  Skip building the PAP and
 529          * just plan to update with an indirection.
 530          */
 531
 532         PapClosure = Node;
 533
 534     } else {
 535
 536         /* Build the PAP.  A generic PAP closure is laid out thus:
 537          *      code ptr, size, no of words of ptrs, Node, ptrs, non-ptrs
 538          * (i.e. a DYN closure)
 539          * ToDo: add stuff for special cases, to omit size and no. of ptrs
 540          *      (Still ToDo?  (JSM))
 541          */
 542
 543         PapSize = NArgWords + DYN_HS;
 544
 545         ALLOC_UPD_PAP(DYN_HS, NArgWords, 0, PapSize);
 546         CC_ALLOC(CC_pap, PapSize, PAP_K);
 547
 548         /* Allocate PapClosure -- Only Node (R1) is live */
 549         HEAP_CHK(LIVENESS_R1, PapSize, 0);
 550
 551         PapClosure = Hp + 1 - PapSize;  /* The new PapClosure */
 552
 553         SET_DYN_HDR(PapClosure, PAP_info, CC_pap, NArgWords + DYN_VHS, NPtrWords + 1);
 554
 555         /* Now fill in the closure fields */
 556
 557         p = Hp;
 558         for (i = NNonPtrWords - 1; i >= 0; i--) *p-- = (W_) SpB[BREL(i)];
 559         for (i = NPtrWords    - 1; i >= 0; i--) *p-- = (W_) SpA[AREL(i)];
 560         *p = (W_) Node;
 561         }
 562
 563     /*
 564      * Finished constructing PAP closure; now update the updatee.  But
 565      * wait!  What if there is no updatee?  Then we fall off the
 566      * stack.
 567      */
 568
 569 #ifdef CONCURRENT
 570     if (SuB < STKO_BSTK_BOT(StkOReg)) {
 571             Node = PapClosure;
 572 # ifdef PAR
 573             LivenessReg = LIVENESS_R1;
 574 # endif
 575         JMP_(StackUnderflowEnterNode);
 576         }
 577 #endif
 578
 579     /*
 580      * Now we have a standard update frame, so we update the updatee with
 581      * either the new PAP or Node.
 582      *
 583      * Supposedly, it is not possible to get a constructor update frame,
 584      * (Why not?  (JSM))
 585      * (Because they have *never* been implemented.  (WDP))
 586      */
 587
 588     Updatee = GRAB_UPDATEE(SuB);
 589     UPD_IND(Updatee, PapClosure);   /* Indirect Updatee to PapClosure */
 590
 591     if (NArgWords != 1) {
 592         UPD_PAP_IN_NEW(NArgWords);
 593
 594     } else {
 595         UPD_PAP_IN_PLACE();
 596
 597 #if defined(PROFILING)
 598         /*
 599          * Lexical scoping requires a *permanent* indirection, and we
 600          * also have to set the cost centre for the indirection.
 601          */
 602         INFO_PTR(Updatee) = (W_) Perm_Ind_info;
 603         SET_CC_HDR(Updatee, CC_pap);
 604
 605 #endif /* PROFILING */
 606     }
 607
 608 #if defined(PROFILING)
 609     /*
 610      * Restore the Cost Centre too (if required); again see Sansom thesis p 183.
 611      * Take the CC out of the update frame if a CAF/DICT.
 612      */
 613
 614     CCC = (IS_CAF_OR_DICT_OR_SUB_CC(CC_pap)) ? GRAB_COST_CENTRE(SuB) : CC_pap;
 615
 616 #endif /* PROFILING */
 617
 618     /* Restore SuA, SuB, RetReg */
 619     RetReg = GRAB_RET(SuB);
 620     SuA = GRAB_SuA(SuB);
 621     SuB = GRAB_SuB(SuB);
 622
 623     /*
 624      * Squeeze out update frame from B stack.  Note that despite our best
 625      * efforts with [AB]REL and friends, the loop order depends on the B
 626      * stack growing up.
 627      */
 628     for (i = NNonPtrWords - 1; i >= 0; i--)
 629         SpB[BREL(i+STD_UF_SIZE)] = SpB[BREL(i)];
 630
 631     SpB += BREL(STD_UF_SIZE);
 632
 633     /*
 634      * All done!  Restart by re-entering Node
 635      * Don't count this entry for ticky-ticky profiling.
 636     */
 637
 638 #if 0 /* defined(GRAN) */
 639     GRAN_EXEC(16,4,7,4,0);
 640 #endif
 641     InfoPtr=(D_)(INFO_PTR(Node));
 642     JMP_(ENTRY_CODE(InfoPtr));
 643     FE_
 644
 645 #undef NNonPtrWords
 646 #undef NPtrWords
 647 #undef NArgWords
 648 #undef PapSize
 649 #ifdef PROFILING
 650 # undef CC_pap
 651 #endif
 652 }
 653 \end{code}
 654
 655 The entry code for a generic PAP. @Node@ points to the PAP closure.
 656 Reload the stacks from the PAP, and enter the closure stored in the
 657 PAP. PAPs are in HNF so no update frame is needed.
 658
 659 \begin{code}
 660 STGFUN(PAP_entry)
 661 {
 662     /* Use STG registers for these locals which must survive the STK_CHK */
 663 #define NPtrWords       (R2.i)
 664 #define NNonPtrWords    (R3.i)
 665 #if defined(PROFILING)
 666 # define CC_pap ((CostCentre)(R7.p))
 667 #endif
 668
 669     /* These locals don't have to survive the STK_CHK */
 670     P_ Updatee;
 671     P_ p;
 672     I_ i;
 673     I_ aWords, bWords;
 674
 675     FB_
 676
 677       /* Concurrent World:
 678          If we come from StackUnderflowEnterNode the old StkO has been
 679          nuked and the PAP carries over data from the old StkO.
 680          The underflow code must restore RetReg to the right value
 681          because it is not grabbed from the update frame if there is data
 682          on one of the two stacks.
 683           -- HWL
 684       */
 685     while (AREL(SuA - SpA) == 0 && BREL(SuB - SpB) == 0) {
 686 #ifdef CONCURRENT
 687         if (SuB < STKO_BSTK_BOT(StkOReg)) {
 688 # ifdef PAR
 689             LivenessReg = LIVENESS_R1;
 690 # endif
 691             JMP_(StackUnderflowEnterNode);
 692         }
 693 #endif
 694
 695         /* We're sitting on top of an update frame, so let's do the business */
 696
 697         Updatee = GRAB_UPDATEE(SuB);
 698         UPD_IND(Updatee, Node);
 699
 700 #if defined(PROFILING)
 701         /*
 702          * Restore the Cost Centre too (if required); again see Sansom
 703          * thesis p 183.  Take the CC out of the update frame if a
 704          * CAF/DICT.
 705          */
 706
 707         CC_pap = (CostCentre) CC_HDR(Node);
 708         CCC = (IS_CAF_OR_DICT_OR_SUB_CC(CC_pap)) ? GRAB_COST_CENTRE(SuB) : CC_pap;
 709
 710 #endif /* PROFILING */
 711
 712         RetReg = GRAB_RET(SuB);
 713         SuA = GRAB_SuA(SuB);
 714         SuB = GRAB_SuB(SuB);
 715         SpB += BREL(STD_UF_SIZE);
 716     }
 717
 718     NPtrWords    = DYN_CLOSURE_NoPTRS(Node) - 1; /* The saved Node counts as one */
 719     NNonPtrWords = DYN_CLOSURE_NoNONPTRS(Node);
 720
 721     /* Ticky-ticky profiling info */
 722     ENT_PAP(Node);
 723
 724     /* Enter PAP cost centre -- lexical scoping only */
 725     ENTER_CC_PAP_CL(Node);
 726
 727     /*
 728      * Check for stack overflow.  Ask to take all of the current frame with
 729      * us to the new world.  If there is no update frame on the current stack,
 730      * bWords will exceed the size of the B stack, but StackOverflow will deal
 731      * with it.
 732      */
 733
 734     aWords = AREL(SuA - SpA);
 735     bWords = BREL(SuB - SpB) + STD_UF_SIZE;
 736
 737     STK_CHK(LIVENESS_R1, NPtrWords, NNonPtrWords, aWords, bWords, 0, 0);
 738
 739     SpA -= AREL(NPtrWords);
 740     SpB -= BREL(NNonPtrWords);
 741
 742     /* Reload Node */
 743     p = Node + DYN_HS;     /* Point to first pointer word */
 744     Node = (P_) *p++;
 745
 746     /* Reload the stacks */
 747
 748     for (i=0; i<NPtrWords;    i++) SpA[AREL(i)] = (P_) *p++;
 749     for (i=0; i<NNonPtrWords; i++) SpB[BREL(i)] = *p++;
 750
 751     /* Off we go! */
 752     ENT_VIA_NODE();
 753     InfoPtr=(D_)(INFO_PTR(Node));
 754     JMP_(ENTRY_CODE(InfoPtr));
 755     FE_
 756
 757 #undef NPtrWords
 758 #undef NNonPtrWords
 759 #ifdef PROFILING
 760 # undef CC_pap
 761 #endif
 762 }
 763 \end{code}
 764
 765 The info table for a generic PAP:
 766 \begin{code}
 767 DYN_ITBL(PAP_info,PAP_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,EF_,PAP_K,"PAP","->");
 768 \end{code}