add another SMP assertion

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

diff --git a/ghc/rts/StgMiscClosures.cmm b/ghc/rts/StgMiscClosures.cmm
index 07a5ff2..70d08ae 100644 (file)
--- a/ghc/rts/StgMiscClosures.cmm
+++ b/ghc/rts/StgMiscClosures.cmm
@@ -325,11 +325,9 @@ INFO_TABLE(stg_IND_OLDGEN_PERM,1,0,IND_OLDGEN_PERM,"IND_OLDGEN_PERM","IND_OLDGEN
    waiting for the evaluation of the closure to finish.
    ------------------------------------------------------------------------- */
 
    waiting for the evaluation of the closure to finish.
    ------------------------------------------------------------------------- */
 

-/* Note: a BLACKHOLE and BLACKHOLE_BQ must be big enough to be
+/* Note: a BLACKHOLE must be big enough to be

  * overwritten with an indirection/evacuee/catch.  Thus we claim it
  * overwritten with an indirection/evacuee/catch.  Thus we claim it

- * has 1 non-pointer word of payload (in addition to the pointer word
- * for the blocking queue in a BQ), which should be big enough for an
- * old-generation indirection. 
+ * has 1 non-pointer word of payload. 

  */
 INFO_TABLE(stg_BLACKHOLE,0,1,BLACKHOLE,"BLACKHOLE","BLACKHOLE")
 {
  */
 INFO_TABLE(stg_BLACKHOLE,0,1,BLACKHOLE,"BLACKHOLE","BLACKHOLE")
 {

@@ -340,76 +338,29 @@ INFO_TABLE(stg_BLACKHOLE,0,1,BLACKHOLE,"BLACKHOLE","BLACKHOLE")
 
     TICK_ENT_BH();
 
 
     TICK_ENT_BH();
 

-    /* Actually this is not necessary because R1 is about to be destroyed. */
-    LDV_ENTER(R1);
-
-    /* Put ourselves on the blocking queue for this black hole */
-    StgTSO_link(CurrentTSO) = stg_END_TSO_QUEUE_closure;
-    StgBlockingQueue_blocking_queue(R1) = CurrentTSO;
-
-    /* jot down why and on what closure we are blocked */
-    StgTSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16;
-    StgTSO_block_info(CurrentTSO) = R1;
-
-    /* Change the BLACKHOLE into a BLACKHOLE_BQ */
-#ifdef PROFILING
-    /* The size remains the same, so we call LDV_recordDead() - 
-       no need to fill slop. */
-    foreign "C" LDV_recordDead(R1 "ptr", BYTES_TO_WDS(SIZEOF_StgBlockingQueue));
+#ifdef THREADED_RTS
+    // foreign "C" debugBelch("BLACKHOLE entry\n");

 #endif
 #endif

-    /*
-     * Todo: maybe use SET_HDR() and remove LDV_RECORD_CREATE()?
-     */ 
-    StgHeader_info(R1) = stg_BLACKHOLE_BQ_info;
-#ifdef PROFILING
-    foreign "C" LDV_RECORD_CREATE(R1);
-#endif
-
-    /* closure is mutable since something has just been added to its BQ */
-    foreign "C" recordMutable(R1 "ptr");

 
 

-    /* PAR: dumping of event now done in blockThread -- HWL */
-
-    /* stg_gen_block is too heavyweight, use a specialised one */
-    jump stg_block_1;
-}
+    /* Actually this is not necessary because R1 is about to be destroyed. */
+    LDV_ENTER(R1);

 
 

-INFO_TABLE(stg_BLACKHOLE_BQ,1,0,BLACKHOLE_BQ,"BLACKHOLE_BQ","BLACKHOLE_BQ")
-{
-#if defined(GRAN)
-    /* Before overwriting TSO_LINK */
-    STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1 /*Node*/);
+#if defined(THREADED_RTS)
+    foreign "C" ACQUIRE_LOCK(sched_mutex "ptr");
+    // released in stg_block_blackhole_finally

 #endif
 
 #endif
 

-    TICK_ENT_BH();
-    LDV_ENTER(R1);
-
-    /* Put ourselves on the blocking queue for this black hole */
-    StgTSO_link(CurrentTSO) = StgBlockingQueue_blocking_queue(R1);
-    StgBlockingQueue_blocking_queue(R1) = CurrentTSO;
+    /* Put ourselves on the blackhole queue */
+    StgTSO_link(CurrentTSO) = W_[blackhole_queue];
+    W_[blackhole_queue] = CurrentTSO;

 
     /* jot down why and on what closure we are blocked */
     StgTSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16;
     StgTSO_block_info(CurrentTSO) = R1;
 
 
     /* jot down why and on what closure we are blocked */
     StgTSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16;
     StgTSO_block_info(CurrentTSO) = R1;
 

-    /* PAR: dumping of event now done in blockThread -- HWL */
-
-    /* stg_gen_block is too heavyweight, use a specialised one */
-    jump stg_block_1;
+    jump stg_block_blackhole;

 }
 
 }
 

-/*
-   Revertible black holes are needed in the parallel world, to handle
-   negative acknowledgements of messages containing updatable closures.
-   The idea is that when the original message is transmitted, the closure
-   is turned into a revertible black hole...an object which acts like a
-   black hole when local threads try to enter it, but which can be reverted
-   back to the original closure if necessary.
-
-   It's actually a lot like a blocking queue (BQ) entry, because revertible
-   black holes are initially set up with an empty blocking queue.
-*/
-

 #if defined(PAR) || defined(GRAN)
 
 INFO_TABLE(stg_RBH,1,1,RBH,"RBH","RBH")
 #if defined(PAR) || defined(GRAN)
 
 INFO_TABLE(stg_RBH,1,1,RBH,"RBH","RBH")

@@ -455,43 +406,45 @@ INFO_TABLE(stg_CAF_BLACKHOLE,0,1,CAF_BLACKHOLE,"CAF_BLACKHOLE","CAF_BLACKHOLE")
     TICK_ENT_BH();
     LDV_ENTER(R1);
 
     TICK_ENT_BH();
     LDV_ENTER(R1);
 

-    /* Put ourselves on the blocking queue for this black hole */
-    StgTSO_link(CurrentTSO) = stg_END_TSO_QUEUE_closure;
-    StgBlockingQueue_blocking_queue(R1) = CurrentTSO;
+#if defined(THREADED_RTS)
+    // foreign "C" debugBelch("BLACKHOLE entry\n");
+#endif
+
+#if defined(THREADED_RTS)
+    foreign "C" ACQUIRE_LOCK(sched_mutex "ptr");
+    // released in stg_block_blackhole_finally
+#endif
+
+    /* Put ourselves on the blackhole queue */
+    StgTSO_link(CurrentTSO) = W_[blackhole_queue];
+    W_[blackhole_queue] = CurrentTSO;

 
     /* jot down why and on what closure we are blocked */
     StgTSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16;
     StgTSO_block_info(CurrentTSO) = R1;
 
 
     /* jot down why and on what closure we are blocked */
     StgTSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16;
     StgTSO_block_info(CurrentTSO) = R1;
 

-    /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ_STATIC */
-    StgHeader_info(R1) = stg_BLACKHOLE_BQ_info;
-
-    /* closure is mutable since something has just been added to its BQ */
-    foreign "C" recordMutable(R1 "ptr");
-
-    /* PAR: dumping of event now done in blockThread -- HWL */
-
-    /* stg_gen_block is too heavyweight, use a specialised one */
-    jump stg_block_1;
+    jump stg_block_blackhole;

 }
 
 #ifdef EAGER_BLACKHOLING
 }
 
 #ifdef EAGER_BLACKHOLING

-INFO_TABLE(stg_SE_BLACKHOLE_info, stg_SE_BLACKHOLE_entry,0,1,SE_BLACKHOLE,,IF_,"SE_BLACKHOLE","SE_BLACKHOLE");
-IF_(stg_SE_BLACKHOLE_entry)
-{
-    STGCALL3(fprintf,stderr,"SE_BLACKHOLE at %p entered!\n",R1);
-    STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
-}
+INFO_TABLE(stg_SE_BLACKHOLE,0,1,SE_BLACKHOLE,"SE_BLACKHOLE","SE_BLACKHOLE")
+{ foreign "C" barf("SE_BLACKHOLE object entered!"); }

 
 

-INFO_TABLE(stg_SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,1,SE_CAF_BLACKHOLE,,IF_,"CAF_BLACKHOLE","CAF_BLACKHOLE");
-IF_(stg_SE_CAF_BLACKHOLE_entry)
-{
-    STGCALL3(fprintf,stderr,"SE_CAF_BLACKHOLE at %p entered!\n",R1);
-    STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE);
-}
+INFO_TABLE(stg_SE_CAF_BLACKHOLE,0,1,SE_CAF_BLACKHOLE,"SE_CAF_BLACKHOLE","SE_CAF_BLACKHOLE")
+{ foreign "C" barf("SE_CAF_BLACKHOLE object entered!"); }

 #endif
 
 /* ----------------------------------------------------------------------------
 #endif
 
 /* ----------------------------------------------------------------------------

+   Whiteholes are used for the "locked" state of a closure (see lockClosure())
+
+   The closure type is BLAKCHOLE, just because we need a valid closure type
+   for sanity checking.
+   ------------------------------------------------------------------------- */
+
+INFO_TABLE(stg_WHITEHOLE, 0,0, BLACKHOLE, "WHITEHOLE", "WHITEHOLE")
+{ foreign "C" barf("WHITEHOLE object entered!"); }
+
+/* ----------------------------------------------------------------------------

    Some static info tables for things that don't get entered, and
    therefore don't need entry code (i.e. boxed but unpointed objects)
    NON_ENTERABLE_ENTRY_CODE now defined at the beginning of the file
    Some static info tables for things that don't get entered, and
    therefore don't need entry code (i.e. boxed but unpointed objects)
    NON_ENTERABLE_ENTRY_CODE now defined at the beginning of the file

@@ -541,13 +494,6 @@ INFO_TABLE_CONSTR(stg_NO_FINALIZER,0,0,0,CONSTR_NOCAF_STATIC,"NO_FINALIZER","NO_
 CLOSURE(stg_NO_FINALIZER_closure,stg_NO_FINALIZER);
 
 /* ----------------------------------------------------------------------------
 CLOSURE(stg_NO_FINALIZER_closure,stg_NO_FINALIZER);
 
 /* ----------------------------------------------------------------------------

-   Foreign Objects are unlifted and therefore never entered.
-   ------------------------------------------------------------------------- */
-
-INFO_TABLE(stg_FOREIGN,0,1,FOREIGN,"FOREIGN","FOREIGN")
-{ foreign "C" barf("FOREIGN object entered!"); }
-
-/* ----------------------------------------------------------------------------

    Stable Names are unlifted too.
    ------------------------------------------------------------------------- */
 
    Stable Names are unlifted too.
    ------------------------------------------------------------------------- */
 

@@ -640,8 +586,11 @@ INFO_TABLE(stg_EXCEPTION_CONS,1,1,CONSTR,"EXCEPTION_CONS","EXCEPTION_CONS")
 INFO_TABLE(stg_ARR_WORDS, 0, 0, ARR_WORDS, "ARR_WORDS", "ARR_WORDS")
 { foreign "C" barf("ARR_WORDS object entered!"); }
 
 INFO_TABLE(stg_ARR_WORDS, 0, 0, ARR_WORDS, "ARR_WORDS", "ARR_WORDS")
 { foreign "C" barf("ARR_WORDS object entered!"); }
 

-INFO_TABLE(stg_MUT_ARR_PTRS, 0, 0, MUT_ARR_PTRS, "MUT_ARR_PTRS", "MUT_ARR_PTRS")
-{ foreign "C" barf("MUT_ARR_PTRS object entered!"); }
+INFO_TABLE(stg_MUT_ARR_PTRS_CLEAN, 0, 0, MUT_ARR_PTRS_CLEAN, "MUT_ARR_PTRS_CLEAN", "MUT_ARR_PTRS_CLEAN")
+{ foreign "C" barf("MUT_ARR_PTRS_CLEAN object entered!"); }
+
+INFO_TABLE(stg_MUT_ARR_PTRS_DIRTY, 0, 0, MUT_ARR_PTRS_DIRTY, "MUT_ARR_PTRS_DIRTY", "MUT_ARR_PTRS_DIRTY")
+{ foreign "C" barf("MUT_ARR_PTRS_DIRTY object entered!"); }

 
 INFO_TABLE(stg_MUT_ARR_PTRS_FROZEN, 0, 0, MUT_ARR_PTRS_FROZEN, "MUT_ARR_PTRS_FROZEN", "MUT_ARR_PTRS_FROZEN")
 { foreign "C" barf("MUT_ARR_PTRS_FROZEN object entered!"); }
 
 INFO_TABLE(stg_MUT_ARR_PTRS_FROZEN, 0, 0, MUT_ARR_PTRS_FROZEN, "MUT_ARR_PTRS_FROZEN", "MUT_ARR_PTRS_FROZEN")
 { foreign "C" barf("MUT_ARR_PTRS_FROZEN object entered!"); }

@@ -653,8 +602,10 @@ INFO_TABLE(stg_MUT_ARR_PTRS_FROZEN0, 0, 0, MUT_ARR_PTRS_FROZEN0, "MUT_ARR_PTRS_F
    Mutable Variables
    ------------------------------------------------------------------------- */
 
    Mutable Variables
    ------------------------------------------------------------------------- */
 

-INFO_TABLE(stg_MUT_VAR, 1, 0, MUT_VAR, "MUT_VAR", "MUT_VAR")
-{ foreign "C" barf("MUT_VAR object entered!"); }
+INFO_TABLE(stg_MUT_VAR_CLEAN, 1, 0, MUT_VAR_CLEAN, "MUT_VAR_CLEAN", "MUT_VAR_CLEAN")
+{ foreign "C" barf("MUT_VAR_CLEAN object entered!"); }
+INFO_TABLE(stg_MUT_VAR_DIRTY, 1, 0, MUT_VAR_DIRTY, "MUT_VAR_DIRTY", "MUT_VAR_DIRTY")
+{ foreign "C" barf("MUT_VAR_DIRTY object entered!"); }

 
 /* ----------------------------------------------------------------------------
    Dummy return closure
 
 /* ----------------------------------------------------------------------------
    Dummy return closure