[project @ 1999-07-16 09:34:38 by simonpj]
[ghc-hetmet.git] / ghc / rts / Updates.hc
index daecd28..5c64e4d 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Updates.hc,v 1.10 1999/03/18 17:57:24 simonm Exp $
+ * $Id: Updates.hc,v 1.18 1999/07/06 16:40:28 sewardj Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -9,8 +9,10 @@
 
 #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
          FE_                                                           \
        }
 
-UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_entry,ENTRY_CODE(Sp[0]));
+//UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_entry,ENTRY_CODE(Sp[0]));
+        STGFUN(Upd_frame_entry);                                                       
+       STGFUN(Upd_frame_entry)                                                 
+       {                                                               
+          StgClosure *updatee;                                         
+         FB_                                                           
+         /* tick - ToDo: check this is right */                        
+         TICK_UPD_EXISTING();                                          
+                                                                       
+          updatee = ((StgUpdateFrame *)Sp)->updatee;                   
+                                               
+         /* update the updatee with an indirection to the return value */
+         UPD_IND(updatee,R1.p);                                        
+                                                                       
+         /* reset Su to the next update frame */                       
+         Su = ((StgUpdateFrame *)Sp)->link;                            
+                                                                       
+         /* remove the update frame from the stack */                  
+         Sp += sizeofW(StgUpdateFrame);                                
+                                                                       
+         JMP_(ENTRY_CODE(Sp[0]));                                                      
+         FE_                                                           
+       }
+
+
 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_0_entry,RET_VEC(Sp[0],0));
 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_1_entry,RET_VEC(Sp[0],1));
 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_2_entry,RET_VEC(Sp[0],2));
@@ -94,7 +120,7 @@ UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_7_entry,RET_VEC(Sp[0],7));
  * 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.
@@ -108,13 +134,10 @@ VEC_POLY_INFO_TABLE(Upd_frame,UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*sr
    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;
@@ -142,10 +165,7 @@ STGFUN(PAP_entry)
        * 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;
@@ -215,8 +235,8 @@ EXTFUN(stg_update_PAP)
   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)
@@ -225,22 +245,15 @@ EXTFUN(stg_update_PAP)
 #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) { 
@@ -333,7 +346,7 @@ EXTFUN(stg_update_PAP)
        * either the new PAP or Node.
        */
       
-      Updatee = Su->updatee;
+      Updatee = Su->updatee; 
 
 #if defined(PROFILING)
       if (Words != 0) {
@@ -357,13 +370,8 @@ EXTFUN(stg_update_PAP)
 #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 */
@@ -388,7 +396,7 @@ EXTFUN(stg_update_PAP)
      */
     JMP_(GET_ENTRY(R1.cl));
     FE_
-} 
+}
 
 
 /* -----------------------------------------------------------------------------
@@ -402,7 +410,7 @@ EXTFUN(stg_update_PAP)
    -------------------------------------------------------------------------- */
 
 
-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;
@@ -477,7 +485,7 @@ SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_5_entry,ENTRY_CODE(Sp[0]));
 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
@@ -490,12 +498,12 @@ VEC_POLY_INFO_TABLE(seq_frame,1, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, SEQ_FR
  * 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));         
@@ -542,7 +550,7 @@ CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_7_entry,RET_VEC(Sp[0],7));
  * 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
@@ -554,7 +562,7 @@ VEC_POLY_INFO_TABLE(catch_frame, CATCH_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/,
  * 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_
@@ -594,7 +602,7 @@ FN_(catchzh_fast)
  * 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_