-VEC_POLY_INFO_TABLE(Upd_frame,UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, UPDATE_FRAME);
-
-/* -----------------------------------------------------------------------------
- Entry Code for a PAP.
-
- The idea is to copy the chunk of stack from the PAP object and then
- re-enter the function closure that failed it's args check in the
- first place.
-
- In fact, we do a little optimisation too, by performing the updates
- for any update frames sitting on top of the stack. (ToDo: is this
- really an optimisation? --SDM)
- -------------------------------------------------------------------------- */
-
-INFO_TABLE(PAP_info,PAP_entry,/*special layout*/0,0,PAP,const,EF_,0,0);
-STGFUN(PAP_entry)
-{
- nat Words;
- P_ p;
- nat i;
- StgPAP *pap;
-
- FB_
-
- pap = (StgPAP *) R1.p;
-
- /*
- * remove any update frames on the top of the stack, by just
- * performing the update here.
- */
- while ((W_)Su - (W_)Sp == 0) {
-
- switch (get_itbl(Su)->type) {
-
- case UPDATE_FRAME:
- /* We're sitting on top of an update frame, so let's do the business */
- UPD_IND(Su->updatee, pap);
-
-#if defined(PROFILING)
- /*
- * Restore the Cost Centre too (if required); again see Sansom
- * thesis p 183. Take the CC out of the update frame if a
- * CAF/DICT.
- */
-
- CCCS = Su->header.prof.ccs;
- ENTER_CCS_PAP(pap->header.prof.ccs);
-#endif /* PROFILING */
-
- Su = Su->link;
- Sp += sizeofW(StgUpdateFrame);
- continue;
-
- case SEQ_FRAME:
- /* Just pop the seq frame and return to the activation record
- * underneath us - R1 already contains the address of the PAP.
- */
- Su = ((StgSeqFrame *)Su)->link;
- Sp += sizeofW(StgSeqFrame);
- JMP_(ENTRY_CODE(*Sp));
-
- case CATCH_FRAME:
- /* can't happen, see stg_update_PAP */
- barf("PAP_entry: CATCH_FRAME");
-
- default:
- barf("PAP_entry: strange activation record");
- }
-
- }
-
- Words = pap->n_args;
-
- /*
- * Check for stack overflow.
- */
- STK_CHK_NP(Words,1,);
- Sp -= Words;
-
- TICK_ENT_PAP(pap);
-
- /* Enter PAP cost centre -- lexical scoping only */
- ENTER_CCS_PAP_CL(pap);
-
- R1.cl = pap->fun;
- p = (P_)(pap->payload);
-
- /* Reload the stack */
- for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
-
- /* Off we go! */
- TICK_ENT_VIA_NODE();
- JMP_(GET_ENTRY(R1.cl));
- FE_
-}
-
-/* -----------------------------------------------------------------------------
- stg_update_PAP: Update the current closure with a partial application.
-
- This function is called whenever an argument satisfaction check fails.
- -------------------------------------------------------------------------- */
-
-EXTFUN(stg_update_PAP)
-{
- nat Words, PapSize;
-#ifdef PROFILING
- CostCentreStack *CCS_pap;
-#endif
- StgPAP* PapClosure;
- StgClosure *Fun, *Updatee;
- P_ p;
- I_ i;
-
- FB_
-
- /* Save the pointer to the function closure that just failed the
- * argument satisfaction check
- */
- Fun = R1.cl;
-
-#if defined(GRAN_COUNT)
-#error Fixme.
- ++nPAPs;
-#endif
-
- /* Just copy the whole block of stack between the stack pointer
- * and the update frame pointer.
- */
- Words = (P_)Su - (P_)Sp;
- ASSERT((int)Words >= 0);
-
-#if defined(PROFILING)
- /* set "CC_pap" to go in the updatee (see Sansom thesis, p 183) */
- CCS_pap = Fun->header.prof.ccs;
-#endif
-
- if (Words == 0) {
-
- /*
- * No arguments, only Node. Skip building the PAP and
- * just plan to update with an indirection.
- */
-
- PapClosure = (StgPAP *)Fun;
-
- } else {
- /* Build the PAP */
-
- PapSize = Words + sizeofW(StgPAP);
-
- /*
- * First we need to do a heap check, which involves saving
- * everything on the stack. We only have one live pointer:
- * Fun, the function closure that was passed to us. If the
- * heap check fails, we push the function closure on the stack
- * and instruct the scheduler to try entering it again when
- * the garbage collector has run.
- *
- * It's done this way because there's a possibility that the
- * garbage collector might have messed around with the stack,
- * such as removing the update frame.
- */
- if ((Hp += PapSize) > HpLim) {
- Sp -= 1;
- Sp[0] = (W_)Fun;
- JMP_(stg_gc_entertop);
- }
-
- TICK_ALLOC_UPD_PAP(1/*fun*/ + Words, 0);
-#ifdef PROFILING
- CCS_ALLOC(CCS_pap, PapSize);
-#endif
-
- PapClosure = (StgPAP *)(Hp + 1 - PapSize); /* The new PapClosure */
-
- SET_HDR(PapClosure,&PAP_info,CCS_pap);
- PapClosure->n_args = Words;
- PapClosure->fun = Fun;
-
- /* Now fill in the closure fields */
-
- p = Hp;
- for (i = Words-1; i >= 0; i--) {
- *p-- = (W_) Sp[i];
- }
- }
-
- /*
- * Finished constructing PAP closure; now update the updatee.
- */
-
- /* ToDo: we'd like to just jump to the code for PAP_entry here,
- * which deals with a stack of update frames in one go. What to
- * do about the special ticky and profiling stuff here?
- */
-
- switch (get_itbl(Su)->type) {
-
- case SEQ_FRAME:
- /* Set Sp to just above the SEQ frame (should be an activation rec.)*/
- Sp = (P_)Su + sizeofW(StgSeqFrame);
-
- /* restore Su */
- Su = ((StgSeqFrame *)Su)->link;
-
- /* return to the activation record, with the address of the PAP in R1 */
- R1.p = (P_)PapClosure;
- JMP_(ENTRY_CODE(*Sp));
-
- case CATCH_FRAME:
- /* Set Sp to just above the CATCH frame (should be an activation rec.)*/
- Sp = (P_)Su + sizeofW(StgCatchFrame);
-
- /* restore Su */
- Su = ((StgCatchFrame *)Su)->link;
-
- /* restart by entering the PAP */
- R1.p = (P_)PapClosure;
- JMP_(GET_ENTRY(R1.cl));
-
- case UPDATE_FRAME:
- /*
- * Now we have a standard update frame, so we update the updatee with
- * either the new PAP or Node.
- */
-
- Updatee = Su->updatee;
-
-#if defined(PROFILING)
- if (Words != 0) {
- UPD_IND(Updatee,PapClosure);
- TICK_UPD_PAP_IN_NEW(Words+1);
- } else {
- /* Lexical scoping requires a *permanent* indirection, and we
- * also have to set the cost centre for the indirection.
- */
- UPD_PERM_IND(Updatee,PapClosure);
- TICK_UPD_PAP_IN_PLACE();
- Updatee->header.prof.ccs = CCS_pap;
- }
-#else
- UPD_IND(Updatee,PapClosure);
- if (Words != 0) {
- TICK_UPD_PAP_IN_NEW(Words+1);
- } else {
- TICK_UPD_PAP_IN_PLACE();
- }
-#endif
-
-#if defined(PROFILING)
- /*
- * Restore the Cost Centre too (if required); again see Sansom
- * thesis p 183. Take the CC out of the update frame if a CAF/DICT.
- */
- CCCS = Su->header.prof.ccs;
- ENTER_CCS_PAP(CCS_pap);
-#endif /* PROFILING */
-
- /* Restore Su */
- Su = Su->link;
-
- /*
- * Squeeze out update frame from stack.
- */
- for (i = Words-1; i >= 0; i--) {
- Sp[i+(sizeofW(StgUpdateFrame))] = Sp[i];
- }
- Sp += sizeofW(StgUpdateFrame);
- break;
-
- default:
- barf("stg_update_PAP: strange activation record");
- }
-
- /*
- * All done! Restart by re-entering Node
- * Don't count this entry for ticky-ticky profiling.
- */
- JMP_(GET_ENTRY(R1.cl));
- FE_
-}
-
-
-/* -----------------------------------------------------------------------------
- Entry Code for an AP_UPD.
-
- The idea is to copy the chunk of stack from the AP object and then
- enter the function closure.
-
- (This code is a simplified copy of the PAP code - with all the
- update frame code stripped out.)
- -------------------------------------------------------------------------- */
-
-
-INFO_TABLE(AP_UPD_info,AP_UPD_entry,/*special layout*/0,0,AP_UPD,const,EF_,0,0);
-STGFUN(AP_UPD_entry)
-{
- nat Words;
- P_ p;
- nat i;
- StgAP_UPD *ap;
-
- FB_
-
- ap = (StgAP_UPD *) R1.p;
-
- Words = ap->n_args;
-
- /*
- * Check for stack overflow.
- */
- STK_CHK(Words+sizeofW(StgUpdateFrame),AP_UPD_entry,R2.p,1,);
-
- PUSH_UPD_FRAME(R1.p, 0);
- Sp -= sizeofW(StgUpdateFrame) + Words;
-
- TICK_ENT_AP_UPD(ap);
-
- /* Enter PAP cost centre -- lexical scoping only */
- ENTER_CCS_PAP_CL(ap); /* ToDo: ENTER_CC_AP_UPD_CL */
-
- R1.cl = ap->fun;
- p = (P_)(ap->payload);
-
- /* Reload the stack */
- for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
-
- /* Off we go! */
- TICK_ENT_VIA_NODE();
- JMP_(GET_ENTRY(R1.cl));
- FE_
-}
-