[project @ 2006-01-10 14:39:38 by simonmar]

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

diff --git a/ghc/rts/StgMiscClosures.cmm b/ghc/rts/StgMiscClosures.cmm
index 78eef91..628e0f1 100644 (file)
--- a/ghc/rts/StgMiscClosures.cmm
+++ b/ghc/rts/StgMiscClosures.cmm
@@ -236,7 +236,7 @@ INFO_TABLE(stg_IND_STATIC,1,0,IND_STATIC,"IND_STATIC","IND_STATIC")
     jump %GET_ENTRY(R1);
 }
 
     jump %GET_ENTRY(R1);
 }
 

-INFO_TABLE(stg_IND_PERM,1,1,IND_PERM,"IND_PERM","IND_PERM")
+INFO_TABLE(stg_IND_PERM,1,0,IND_PERM,"IND_PERM","IND_PERM")

 {
     /* Don't add INDs to granularity cost */
 
 {
     /* Don't add INDs to granularity cost */
 

@@ -278,7 +278,7 @@ INFO_TABLE(stg_IND_PERM,1,1,IND_PERM,"IND_PERM","IND_PERM")
 }  
 
 
 }  
 
 

-INFO_TABLE(stg_IND_OLDGEN,1,1,IND_OLDGEN,"IND_OLDGEN","IND_OLDGEN")
+INFO_TABLE(stg_IND_OLDGEN,1,0,IND_OLDGEN,"IND_OLDGEN","IND_OLDGEN")

 {
     TICK_ENT_STATIC_IND();     /* tick */
     R1 = StgInd_indirectee(R1);
 {
     TICK_ENT_STATIC_IND();     /* tick */
     R1 = StgInd_indirectee(R1);

@@ -286,7 +286,7 @@ INFO_TABLE(stg_IND_OLDGEN,1,1,IND_OLDGEN,"IND_OLDGEN","IND_OLDGEN")
     jump %GET_ENTRY(R1);
 }
 
     jump %GET_ENTRY(R1);
 }
 

-INFO_TABLE(stg_IND_OLDGEN_PERM,1,1,IND_OLDGEN_PERM,"IND_OLDGEN_PERM","IND_OLDGEN_PERM")
+INFO_TABLE(stg_IND_OLDGEN_PERM,1,0,IND_OLDGEN_PERM,"IND_OLDGEN_PERM","IND_OLDGEN_PERM")

 {
     /* Don't: TICK_ENT_STATIC_IND(Node); for ticky-ticky; 
        this ind is here only to help profiling */
 {
     /* Don't: TICK_ENT_STATIC_IND(Node); for ticky-ticky; 
        this ind is here only to help profiling */

@@ -325,13 +325,11 @@ INFO_TABLE(stg_IND_OLDGEN_PERM,1,1,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,2,BLACKHOLE,"BLACKHOLE","BLACKHOLE")
+INFO_TABLE(stg_BLACKHOLE,0,1,BLACKHOLE,"BLACKHOLE","BLACKHOLE")

 {
 #if defined(GRAN)
     /* Before overwriting TSO_LINK */
 {
 #if defined(GRAN)
     /* Before overwriting TSO_LINK */

@@ -340,76 +338,29 @@ INFO_TABLE(stg_BLACKHOLE,0,2,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);
 

-    /* 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));
-#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);
+#if defined(SMP)
+    foreign "C" ACQUIRE_LOCK(sched_mutex "ptr");
+    // released in stg_block_blackhole_finally

 #endif
 
 #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;
-}
-
-INFO_TABLE(stg_BLACKHOLE_BQ,1,1,BLACKHOLE_BQ,"BLACKHOLE_BQ","BLACKHOLE_BQ")
-{
-#if defined(GRAN)
-    /* Before overwriting TSO_LINK */
-    STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1 /*Node*/);
-#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")

@@ -445,7 +396,7 @@ INFO_TABLE(stg_RBH_Save_2,2,0,CONSTR,"RBH_Save_2","RBH_Save_2");
 #endif /* defined(PAR) || defined(GRAN) */
 
 /* identical to BLACKHOLEs except for the infotag */
 #endif /* defined(PAR) || defined(GRAN) */
 
 /* identical to BLACKHOLEs except for the infotag */

-INFO_TABLE(stg_CAF_BLACKHOLE,0,2,CAF_BLACKHOLE,"CAF_BLACKHOLE","CAF_BLACKHOLE")
+INFO_TABLE(stg_CAF_BLACKHOLE,0,1,CAF_BLACKHOLE,"CAF_BLACKHOLE","CAF_BLACKHOLE")

 {
 #if defined(GRAN)
     /* mainly statistics gathering for GranSim simulation */
 {
 #if defined(GRAN)
     /* mainly statistics gathering for GranSim simulation */

@@ -455,43 +406,41 @@ INFO_TABLE(stg_CAF_BLACKHOLE,0,2,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(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;

 
     /* 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,2,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,2,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
 
 /* ----------------------------------------------------------------------------

+   ------------------------------------------------------------------------- */
+
+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

@@ -541,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.
    ------------------------------------------------------------------------- */
 

@@ -561,12 +503,43 @@ INFO_TABLE(stg_STABLE_NAME,0,1,STABLE_NAME,"STABLE_NAME","STABLE_NAME")
    and entry code for each type.
    ------------------------------------------------------------------------- */
 
    and entry code for each type.
    ------------------------------------------------------------------------- */
 

-INFO_TABLE(stg_FULL_MVAR,4,0,MVAR,"MVAR","MVAR")
+INFO_TABLE(stg_FULL_MVAR,3,0,MVAR,"MVAR","MVAR")

 { foreign "C" barf("FULL_MVAR object entered!"); }
 
 { foreign "C" barf("FULL_MVAR object entered!"); }
 

-INFO_TABLE(stg_EMPTY_MVAR,4,0,MVAR,"MVAR","MVAR")
+INFO_TABLE(stg_EMPTY_MVAR,3,0,MVAR,"MVAR","MVAR")

 { foreign "C" barf("EMPTY_MVAR object entered!"); }
 
 { foreign "C" barf("EMPTY_MVAR object entered!"); }
 

+/* -----------------------------------------------------------------------------
+   STM
+   -------------------------------------------------------------------------- */
+
+INFO_TABLE(stg_TVAR, 0, 0, TVAR, "TVAR", "TVAR")
+{ foreign "C" barf("TVAR object entered!"); }
+
+INFO_TABLE(stg_TVAR_WAIT_QUEUE, 0, 0, TVAR_WAIT_QUEUE, "TVAR_WAIT_QUEUE", "TVAR_WAIT_QUEUE")
+{ foreign "C" barf("TVAR_WAIT_QUEUE object entered!"); }
+
+INFO_TABLE(stg_TREC_CHUNK, 0, 0, TREC_CHUNK, "TREC_CHUNK", "TREC_CHUNK")
+{ foreign "C" barf("TREC_CHUNK object entered!"); }
+
+INFO_TABLE(stg_TREC_HEADER, 0, 0, TREC_HEADER, "TREC_HEADER", "TREC_HEADER")
+{ foreign "C" barf("TREC_HEADER object entered!"); }
+
+INFO_TABLE_CONSTR(stg_END_STM_WAIT_QUEUE,0,0,0,CONSTR_NOCAF_STATIC,"END_STM_WAIT_QUEUE","END_STM_WAIT_QUEUE")
+{ foreign "C" barf("END_STM_WAIT_QUEUE object entered!"); }
+
+INFO_TABLE_CONSTR(stg_END_STM_CHUNK_LIST,0,0,0,CONSTR_NOCAF_STATIC,"END_STM_CHUNK_LIST","END_STM_CHUNK_LIST")
+{ foreign "C" barf("END_STM_CHUNK_LIST object entered!"); }
+
+INFO_TABLE_CONSTR(stg_NO_TREC,0,0,0,CONSTR_NOCAF_STATIC,"NO_TREC","NO_TREC")
+{ foreign "C" barf("NO_TREC object entered!"); }
+
+CLOSURE(stg_END_STM_WAIT_QUEUE_closure,stg_END_STM_WAIT_QUEUE);
+
+CLOSURE(stg_END_STM_CHUNK_LIST_closure,stg_END_STM_CHUNK_LIST);
+
+CLOSURE(stg_NO_TREC_closure,stg_NO_TREC);
+

 /* ----------------------------------------------------------------------------
    END_TSO_QUEUE
 
 /* ----------------------------------------------------------------------------
    END_TSO_QUEUE
 

@@ -580,22 +553,6 @@ INFO_TABLE_CONSTR(stg_END_TSO_QUEUE,0,0,0,CONSTR_NOCAF_STATIC,"END_TSO_QUEUE","E
 CLOSURE(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE);
 
 /* ----------------------------------------------------------------------------
 CLOSURE(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE);
 
 /* ----------------------------------------------------------------------------

-   Mutable lists
-
-   Mutable lists (used by the garbage collector) consist of a chain of
-   StgMutClosures connected through their mut_link fields, ending in
-   an END_MUT_LIST closure.
-   ------------------------------------------------------------------------- */
-
-INFO_TABLE_CONSTR(stg_END_MUT_LIST,0,0,0,CONSTR_NOCAF_STATIC,"END_MUT_LIST","END_MUT_LIST")
-{ foreign "C" barf("END_MUT_LIST object entered!"); }
-
-CLOSURE(stg_END_MUT_LIST_closure,stg_END_MUT_LIST);
-
-INFO_TABLE(stg_MUT_CONS, 1, 1, MUT_CONS, "MUT_CONS", "MUT_CONS")
-{ foreign "C" barf("MUT_CONS object entered!"); }
-
-/* ----------------------------------------------------------------------------

    Exception lists
    ------------------------------------------------------------------------- */
 
    Exception lists
    ------------------------------------------------------------------------- */
 

@@ -631,11 +588,14 @@ INFO_TABLE(stg_MUT_ARR_PTRS, 0, 0, MUT_ARR_PTRS, "MUT_ARR_PTRS", "MUT_ARR_PTRS")
 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!"); }
 

+INFO_TABLE(stg_MUT_ARR_PTRS_FROZEN0, 0, 0, MUT_ARR_PTRS_FROZEN0, "MUT_ARR_PTRS_FROZEN0", "MUT_ARR_PTRS_FROZEN0")
+{ foreign "C" barf("MUT_ARR_PTRS_FROZEN0 object entered!"); }
+

 /* ----------------------------------------------------------------------------
    Mutable Variables
    ------------------------------------------------------------------------- */
 
 /* ----------------------------------------------------------------------------
    Mutable Variables
    ------------------------------------------------------------------------- */
 

-INFO_TABLE(stg_MUT_VAR, 1, 1, MUT_VAR, "MUT_VAR", "MUT_VAR")
+INFO_TABLE(stg_MUT_VAR, 1, 0, MUT_VAR, "MUT_VAR", "MUT_VAR")

 { foreign "C" barf("MUT_VAR object entered!"); }
 
 /* ----------------------------------------------------------------------------
 { foreign "C" barf("MUT_VAR object entered!"); }
 
 /* ----------------------------------------------------------------------------