[project @ 2005-12-29 12:06:13 by simonpj]

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

diff --git a/ghc/rts/StgMiscClosures.cmm b/ghc/rts/StgMiscClosures.cmm
index 4e2c0fb..628e0f1 100644 (file)
--- a/ghc/rts/StgMiscClosures.cmm
+++ b/ghc/rts/StgMiscClosures.cmm
@@ -338,9 +338,18 @@ INFO_TABLE(stg_BLACKHOLE,0,1,BLACKHOLE,"BLACKHOLE","BLACKHOLE")
 
     TICK_ENT_BH();
 
 
     TICK_ENT_BH();
 

+#ifdef SMP
+    // foreign "C" debugBelch("BLACKHOLE entry\n");
+#endif
+

     /* Actually this is not necessary because R1 is about to be destroyed. */
     LDV_ENTER(R1);
 
     /* Actually this is not necessary because R1 is about to be destroyed. */
     LDV_ENTER(R1);
 

+#if defined(SMP)
+    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;
     /* Put ourselves on the blackhole queue */
     StgTSO_link(CurrentTSO) = W_[blackhole_queue];
     W_[blackhole_queue] = CurrentTSO;

@@ -349,8 +358,7 @@ INFO_TABLE(stg_BLACKHOLE,0,1,BLACKHOLE,"BLACKHOLE","BLACKHOLE")
     StgTSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16;
     StgTSO_block_info(CurrentTSO) = R1;
 
     StgTSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16;
     StgTSO_block_info(CurrentTSO) = R1;
 

-    /* stg_gen_block is too heavyweight, use a specialised one */
-    jump stg_block_1;
+    jump stg_block_blackhole;

 }
 
 #if defined(PAR) || defined(GRAN)
 }
 
 #if defined(PAR) || defined(GRAN)

@@ -398,6 +406,15 @@ 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);
 

+#if defined(SMP)
+    // foreign "C" debugBelch("BLACKHOLE entry\n");
+#endif
+
+#if defined(SMP)
+    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;
     /* Put ourselves on the blackhole queue */
     StgTSO_link(CurrentTSO) = W_[blackhole_queue];
     W_[blackhole_queue] = CurrentTSO;

@@ -406,8 +423,7 @@ INFO_TABLE(stg_CAF_BLACKHOLE,0,1,CAF_BLACKHOLE,"CAF_BLACKHOLE","CAF_BLACKHOLE")
     StgTSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16;
     StgTSO_block_info(CurrentTSO) = R1;
 
     StgTSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16;
     StgTSO_block_info(CurrentTSO) = R1;
 

-    /* stg_gen_block is too heavyweight, use a specialised one */
-    jump stg_block_1;
+    jump stg_block_blackhole;

 }
 
 #ifdef EAGER_BLACKHOLING
 }
 
 #ifdef EAGER_BLACKHOLING

@@ -419,6 +435,12 @@ INFO_TABLE(stg_SE_CAF_BLACKHOLE,0,1,SE_CAF_BLACKHOLE,"SE_CAF_BLACKHOLE","SE_CAF_
 #endif
 
 /* ----------------------------------------------------------------------------
 #endif
 
 /* ----------------------------------------------------------------------------

+   ------------------------------------------------------------------------- */
+
+INFO_TABLE(stg_WHITEHOLE, 0,0, INVALID_OBJECT, "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

@@ -468,13 +490,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.
    ------------------------------------------------------------------------- */