/* -----------------------------------------------------------------------------
- * $Id: Updates.hc,v 1.6 1999/01/15 17:57:11 simonm Exp $
+ * $Id: Updates.hc,v 1.19 1999/09/14 12:16:36 simonmar Exp $
+ *
+ * (c) The GHC Team, 1998-1999
*
* Code to perform updates.
*
#include "Rts.h"
#include "RtsUtils.h"
+#include "RtsFlags.h"
#include "HeapStackCheck.h"
#include "Storage.h"
+#include "ProfRts.h"
/*
The update frame return address must be *polymorphic*, that means
{ \
StgClosure *updatee; \
FB_ \
- /* tick - ToDo: check this is right */ \
- TICK_UPD_EXISTING(); \
\
updatee = ((StgUpdateFrame *)Sp)->updatee; \
- \
+ \
+ /* Tick - it must be a con, all the paps are handled \
+ * in stg_upd_PAP and PAP_entry below \
+ */ \
+ TICK_UPD_CON_IN_NEW(sizeW_fromITBL(get_itbl(updatee))); \
+ \
/* update the updatee with an indirection to the return value */\
UPD_IND(updatee,R1.p); \
\
* there's a cost-centre-stack in there too).
*/
-VEC_POLY_INFO_TABLE(Upd_frame,UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, UPDATE_FRAME);
+VEC_POLY_INFO_TABLE(Upd_frame,UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, UPDATE_FRAME,, EF_);
/* -----------------------------------------------------------------------------
Entry Code for a PAP.
really an optimisation? --SDM)
-------------------------------------------------------------------------- */
-INFO_TABLE(PAP_info,PAP_entry,/*special layout*/0,0,PAP,const,EF_,0,0);
+INFO_TABLE(PAP_info,PAP_entry,/*special layout*/0,0,PAP,,EF_,0,0);
STGFUN(PAP_entry)
{
nat Words;
-#ifdef PROFILING
- CostCentreStack *CCS_pap;
-#endif
P_ p;
nat i;
StgPAP *pap;
* CAF/DICT.
*/
- CCS_pap = pap->header.prof.ccs;
- CCCS = (IS_CAF_OR_DICT_OR_SUB_CCS(CCS_pap))
- ? Su->header.prof.ccs
- : CCS_pap;
+ CCCS = Su->header.prof.ccs;
#endif /* PROFILING */
Su = Su->link;
FB_
/* Save the pointer to the function closure that just failed the
- argument satisfaction check
- */
+ * argument satisfaction check
+ */
Fun = R1.cl;
#if defined(GRAN_COUNT)
#endif
/* Just copy the whole block of stack between the stack pointer
- * and the update frame pointer for now. This might include some
- * tagging, which the garbage collector will have to pay attention
- * to, but it's much easier than sorting the words into pointers
- * and non-pointers.
+ * 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 = (CostCentreStack *) Fun->header.prof.ccs;
- if (IS_CAF_OR_DICT_OR_SUB_CCS(CCS_pap)) {
- CCS_pap = CCCS;
- }
+ /* pretend we just entered the function closure */
+ ENTER_CCS_FCL(Fun);
+ CCS_pap = CCCS;
#endif
if (Words == 0) {
JMP_(stg_gc_entertop);
}
- TICK_ALLOC_UPD_PAP(DYN_HS, NArgWords, 0, PapSize);
+ 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);
*/
Updatee = Su->updatee;
- UPD_IND(Updatee,PapClosure);
-
+
+#if defined(PROFILING)
if (Words != 0) {
- TICK_UPD_PAP_IN_NEW(NArgWords);
-
+ UPD_IND(Updatee,PapClosure);
+ TICK_UPD_PAP_IN_NEW(Words+1);
} else {
- TICK_UPD_PAP_IN_PLACE();
-
-#if defined(PROFILING)
- /*
- * Lexical scoping requires a *permanent* indirection, and we
+ /* Lexical scoping requires a *permanent* indirection, and we
* also have to set the cost centre for the indirection.
*/
- SET_INFO(Updatee, &IND_PERM_info);
+ UPD_PERM_IND(Updatee,PapClosure);
+ TICK_UPD_PAP_IN_PLACE();
Updatee->header.prof.ccs = CCS_pap;
-#endif /* PROFILING */
}
-
+#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 = IS_CAF_OR_DICT_OR_SUB_CCS(CCS_pap)
- ? Su->header.prof.ccs
- : CCS_pap;
+ CCCS = Su->header.prof.ccs;
+ ENTER_CCS_PAP(CCS_pap);
#endif /* PROFILING */
/* Restore Su */
*/
JMP_(GET_ENTRY(R1.cl));
FE_
-}
+}
/* -----------------------------------------------------------------------------
-------------------------------------------------------------------------- */
-INFO_TABLE(AP_UPD_info,AP_UPD_entry,/*special layout*/0,0,AP_UPD,const,EF_,0,0);
+INFO_TABLE(AP_UPD_info,AP_UPD_entry,/*special layout*/0,0,AP_UPD,,EF_,0,0);
STGFUN(AP_UPD_entry)
{
nat Words;
PUSH_UPD_FRAME(R1.p, 0);
Sp -= sizeofW(StgUpdateFrame) + Words;
- TICK_ENT_PAP(ap); /* ToDo: TICK_ENT_AP_UPD */
+ TICK_ENT_AP_UPD(ap);
/* Enter PAP cost centre -- lexical scoping only */
ENTER_CCS_PAP_CL(ap); /* ToDo: ENTER_CC_AP_UPD_CL */
SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_6_entry,ENTRY_CODE(Sp[0]));
SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_7_entry,ENTRY_CODE(Sp[0]));
-VEC_POLY_INFO_TABLE(seq_frame,1, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, SEQ_FRAME);
+VEC_POLY_INFO_TABLE(seq_frame, UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, SEQ_FRAME,, EF_);
/* -----------------------------------------------------------------------------
* The seq infotable
* It is used in deleteThread when reverting blackholes.
* -------------------------------------------------------------------------- */
-INFO_TABLE(seq_info,seq_entry,1,0,FUN,const,EF_,0,0);
+INFO_TABLE(seq_info,seq_entry,1,0,FUN,,EF_,0,0);
STGFUN(seq_entry)
{
FB_
STK_CHK_GEN(sizeofW(StgSeqFrame), NO_PTRS, seq_entry, );
- Sp -= sizeof(StgSeqFrame);
+ Sp -= sizeofW(StgSeqFrame);
PUSH_SEQ_FRAME(Sp);
R1.cl = R1.cl->payload[0];
JMP_(ENTRY_CODE(*R1.p));
Exception Primitives
-------------------------------------------------------------------------- */
-FN_(catchZh_fast);
-FN_(raiseZh_fast);
+FN_(catchzh_fast);
+FN_(raisezh_fast);
#define CATCH_FRAME_ENTRY_TEMPLATE(label,ret) \
FN_(label); \
* kind of return to the activation record underneath us on the stack.
*/
-VEC_POLY_INFO_TABLE(catch_frame, CATCH_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, CATCH_FRAME);
+VEC_POLY_INFO_TABLE(catch_frame, CATCH_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, CATCH_FRAME,, EF_);
/* -----------------------------------------------------------------------------
* The catch infotable
* It is used in deleteThread when reverting blackholes.
* -------------------------------------------------------------------------- */
-INFO_TABLE(catch_info,catch_entry,2,0,FUN,const,EF_,0,0);
+INFO_TABLE(catch_info,catch_entry,2,0,FUN,,EF_,0,0);
STGFUN(catch_entry)
{
FB_
R2.cl = payloadCPtr(R1.cl,1); /* h */
R1.cl = payloadCPtr(R1.cl,0); /* x */
- JMP_(catchZh_fast);
+ JMP_(catchzh_fast);
FE_
}
-FN_(catchZh_fast)
+FN_(catchzh_fast)
{
StgCatchFrame *fp;
FB_
/* args: R1 = m, R2 = k */
- STK_CHK_GEN(sizeofW(StgCatchFrame), R1_PTR | R2_PTR, catchZh_fast, );
+ STK_CHK_GEN(sizeofW(StgCatchFrame), R1_PTR | R2_PTR, catchzh_fast, );
Sp -= sizeofW(StgCatchFrame);
fp = (StgCatchFrame *)Sp;
SET_HDR(fp,(StgInfoTable *)&catch_frame_info,CCCS);
fp -> handler = R2.cl;
fp -> link = Su;
Su = (StgUpdateFrame *)fp;
+ TICK_CATCHF_PUSHED();
TICK_ENT_VIA_NODE();
JMP_(ENTRY_CODE(*R1.p));
*
* raise = {err} \n {} -> raise#{err}
*
- * It is used in raiseZh_fast to update thunks on the update list
+ * It is used in raisezh_fast to update thunks on the update list
* -------------------------------------------------------------------------- */
-INFO_TABLE(raise_info,raise_entry,1,0,FUN,const,EF_,0,0);
+INFO_TABLE(raise_info,raise_entry,1,0,FUN,,EF_,0,0);
STGFUN(raise_entry)
{
FB_
R1.cl = R1.cl->payload[0];
- JMP_(raiseZh_fast);
+ JMP_(raisezh_fast);
FE_
}
-FN_(raiseZh_fast)
+FN_(raisezh_fast)
{
StgClosure *handler;
StgUpdateFrame *p;
break;
case STOP_FRAME:
- barf("raiseZh_fast: STOP_FRAME");
+ barf("raisezh_fast: STOP_FRAME");
default:
- barf("raiseZh_fast: weird activation record");
+ barf("raisezh_fast: weird activation record");
}
break;
projects / ghc-hetmet.git / blobdiff