[project @ 2001-11-08 12:46:31 by simonmar]

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

diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc
index 93f4bc2..de36bea 100644 (file)
--- a/ghc/rts/StgMiscClosures.hc
+++ b/ghc/rts/StgMiscClosures.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.64 2001/02/11 17:51:08 simonmar Exp $
+ * $Id: StgMiscClosures.hc,v 1.69 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -7,11 +7,11 @@
  *
  * ---------------------------------------------------------------------------*/
 
+#include "Stg.h"
 #include "Rts.h"
 #include "RtsUtils.h"
 #include "RtsFlags.h"
 #include "StgMiscClosures.h"
-#include "HeapStackCheck.h"   /* for stg_gen_yield */
 #include "Storage.h"
 #include "StoragePriv.h"
 #include "Profiling.h"
@@ -226,6 +226,35 @@ STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_7_entry);
 
 VEC_POLY_INFO_TABLE(stg_ctoi_ret_D1,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
 
+
+/* When the returned value a VoidRep ... */
+#define STG_CtoI_RET_V_Template(label)         \
+   IFN_(label)                         \
+   {                                    \
+      StgPtr bco;                       \
+      FB_                              \
+      bco = ((StgPtr*)Sp)[1];           \
+      Sp -= 1;                          \
+      ((StgPtr*)Sp)[0] = 0; /* VoidRep tag */ \
+      Sp -= 1;                         \
+      ((StgPtr*)Sp)[0] = bco;          \
+      JMP_(stg_yield_to_interpreter);   \
+      FE_                               \
+   }
+
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_0_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_1_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_2_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_3_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_4_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_5_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_6_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_7_entry);
+
+VEC_POLY_INFO_TABLE(stg_ctoi_ret_V,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
+
+
 /* The other way round: when the interpreter returns a value to
    compiled code.  The stack looks like this:
 
@@ -404,28 +433,29 @@ STGFUN(stg_BLACKHOLE_entry)
 #endif
     TICK_ENT_BH();
 
-    /* Put ourselves on the blocking queue for this black hole */
+    // Put ourselves on the blocking queue for this black hole
 #if defined(GRAN) || defined(PAR)
-    /* in fact, only difference is the type of the end-of-queue marker! */
+    // in fact, only difference is the type of the end-of-queue marker!
     CurrentTSO->link = END_BQ_QUEUE;
     ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
 #else
     CurrentTSO->link = END_TSO_QUEUE;
     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
 #endif
-    /* jot down why and on what closure we are blocked */
+    // jot down why and on what closure we are blocked
     CurrentTSO->why_blocked = BlockedOnBlackHole;
     CurrentTSO->block_info.closure = R1.cl;
-    /* closure is mutable since something has just been added to its BQ */
-    recordMutable((StgMutClosure *)R1.cl);
-    /* Change the BLACKHOLE into a BLACKHOLE_BQ */
+
+    // Change the CAF_BLACKHOLE into a BLACKHOLE_BQ_STATIC
     ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info;
 
-    /* PAR: dumping of event now done in blockThread -- HWL */
+    // closure is mutable since something has just been added to its BQ
+    recordMutable((StgMutClosure *)R1.cl);
 
-    /* stg_gen_block is too heavyweight, use a specialised one */
-    BLOCK_NP(1);
+    // PAR: dumping of event now done in blockThread -- HWL
 
+    // stg_gen_block is too heavyweight, use a specialised one
+    BLOCK_NP(1);
   FE_
 }
 
@@ -533,7 +563,7 @@ STGFUN(stg_CAF_BLACKHOLE_entry)
     {
       bdescr *bd = Bdescr(R1.p);
       if (bd->back != (bdescr *)BaseReg) {
-       if (bd->gen->no >= 1 || bd->step->no >= 1) {
+       if (bd->gen_no >= 1 || bd->step->no >= 1) {
          CMPXCHG(R1.cl->header.info, &stg_CAF_BLACKHOLE_info, &stg_WHITEHOLE_info);
        } else {
          EXTFUN_RTS(stg_gc_enter_1_hponly);
@@ -545,26 +575,28 @@ STGFUN(stg_CAF_BLACKHOLE_entry)
 
     TICK_ENT_BH();
 
-    /* Put ourselves on the blocking queue for this black hole */
+    // Put ourselves on the blocking queue for this black hole
 #if defined(GRAN) || defined(PAR)
-    /* in fact, only difference is the type of the end-of-queue marker! */
+    // in fact, only difference is the type of the end-of-queue marker!
     CurrentTSO->link = END_BQ_QUEUE;
     ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
 #else
     CurrentTSO->link = END_TSO_QUEUE;
     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
 #endif
-    /* jot down why and on what closure we are blocked */
+    // jot down why and on what closure we are blocked
     CurrentTSO->why_blocked = BlockedOnBlackHole;
     CurrentTSO->block_info.closure = R1.cl;
-    /* closure is mutable since something has just been added to its BQ */
-    recordMutable((StgMutClosure *)R1.cl);
-    /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ_STATIC */
+
+    // Change the CAF_BLACKHOLE into a BLACKHOLE_BQ_STATIC
     ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info;
 
-    /* PAR: dumping of event now done in blockThread -- HWL */
+    // closure is mutable since something has just been added to its BQ
+    recordMutable((StgMutClosure *)R1.cl);
 
-    /* stg_gen_block is too heavyweight, use a specialised one */
+    // PAR: dumping of event now done in blockThread -- HWL
+
+    // stg_gen_block is too heavyweight, use a specialised one
     BLOCK_NP(1);
   FE_
 }
@@ -697,7 +729,7 @@ NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
 SET_STATIC_HDR(stg_END_MUT_LIST_closure,stg_END_MUT_LIST_info,0/*CC*/,,EI_)
 , /*payload*/{} };
 
-INFO_TABLE(stg_MUT_CONS_info, stg_MUT_CONS_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
+INFO_TABLE(stg_MUT_CONS_info, stg_MUT_CONS_entry, 1, 1, MUT_CONS, , EF_, 0, 0);
 NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
 
 /* -----------------------------------------------------------------------------