[project @ 1999-04-23 09:47:30 by simonm]

[ghc-hetmet.git] / ghc / rts / StgMiscClosures.hc

diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc
index 1058a2d..3b83f5b 100644 (file)
--- a/ghc/rts/StgMiscClosures.hc
+++ b/ghc/rts/StgMiscClosures.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.16 1999/03/09 14:24:45 sewardj Exp $
+ * $Id: StgMiscClosures.hc,v 1.20 1999/04/23 09:47:33 simonm Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -13,6 +13,7 @@
 #include "HeapStackCheck.h"   /* for stg_gen_yield */
 #include "Storage.h"
 #include "StoragePriv.h"
+#include "ProfRts.h"
 
 #ifdef HAVE_STDIO_H
 #include <stdio.h>
@@ -48,13 +49,13 @@ STGFUN(IND_STATIC_entry)
     FE_
 }
 
-INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,0,IND_PERM,const,EF_,0,0);
+INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,const,EF_,0,0);
 STGFUN(IND_PERM_entry)
 {
     FB_
     /* Don't add INDs to granularity cost */
 
-    /* Dont: ENT_IND(Node); for ticky-ticky; this ind is here only to help profi
+    /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profi
 ling */
 
     /* Enter PAP cost centre -- lexical scoping only */
@@ -86,6 +87,12 @@ STGFUN(IND_OLDGEN_PERM_entry)
     FB_
     TICK_ENT_IND(Node);        /* tick */
   
+    /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profi
+ling */
+
+    /* Enter PAP cost centre -- lexical scoping only */
+    ENTER_CCS_PAP_CL(R1.cl);
+
     R1.p = (P_) ((StgInd*)R1.p)->indirectee;
     TICK_ENT_VIA_NODE();
     JMP_(*R1.p);
@@ -146,6 +153,7 @@ STGFUN(BLACKHOLE_entry)
     /* Put ourselves on the blocking queue for this black hole */
     CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
+    CurrentTSO->blocked_on = R1.cl;
     recordMutable((StgMutClosure *)R1.cl);
 
     /* stg_gen_block is too heavyweight, use a specialised one */
@@ -160,6 +168,7 @@ STGFUN(BLACKHOLE_BQ_entry)
     TICK_ENT_BH();
 
     /* Put ourselves on the blocking queue for this black hole */
+    CurrentTSO->blocked_on = R1.cl;
     CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
 
@@ -180,6 +189,7 @@ STGFUN(CAF_BLACKHOLE_entry)
     /* Put ourselves on the blocking queue for this black hole */
     CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
+    CurrentTSO->blocked_on = R1.cl;
     recordMutable((StgMutClosure *)R1.cl);
 
     /* stg_gen_block is too heavyweight, use a specialised one */
@@ -325,13 +335,15 @@ NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
 
    -------------------------------------------------------------------------- */
 
-#define ArrayInfo(type)                                                        \
-INFO_TABLE(type##_info, type##_entry, 0, 0, type, const, EF_,0,0);     \
-NON_ENTERABLE_ENTRY_CODE(type);
+#define ArrayInfo(type)                                        \
+INFO_TABLE(type##_info, type##_entry, 0, 0, type, const, EF_,0,0);
 
 ArrayInfo(ARR_WORDS);
+NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
 ArrayInfo(MUT_ARR_PTRS);
+NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS);
 ArrayInfo(MUT_ARR_PTRS_FROZEN);
+NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
 
 #undef ArrayInfo