projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[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 8ed6fa8..de36bea 100644 (file)
--- a/ghc/rts/StgMiscClosures.hc
+++ b/ghc/rts/StgMiscClosures.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.62 2001/01/31 10:12: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"
@@ -51,8 +51,6 @@ STGFUN(stg_##type##_entry)                                                    \
    Support for the bytecode interpreter.
    -------------------------------------------------------------------------- */
 
-#ifdef GHCI
-
 /* 9 bits of return code for constructors created by the interpreter. */
 FN_(stg_interp_constr_entry) 
 { 
@@ -228,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:
 
@@ -256,8 +283,6 @@ STGFUN(stg_BCO_entry) {
   FE_
 }
 
-#endif /* GHCI */
-
 
 /* -----------------------------------------------------------------------------
    Entry code for an indirection.
@@ -398,7 +423,7 @@ STGFUN(stg_BLACKHOLE_entry)
       bdescr *bd = Bdescr(R1.p);
       if (bd->back != (bdescr *)BaseReg) {
        if (bd->gen->no >= 1 || bd->step->no >= 1) {
-         CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
+         CMPXCHG(R1.cl->header.info, &stg_BLACKHOLE_info, &stg_WHITEHOLE_info);
        } else {
          EXTFUN_RTS(stg_gc_enter_1_hponly);
          JMP_(stg_gc_enter_1_hponly);
@@ -408,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_
 }
 
@@ -447,7 +473,7 @@ STGFUN(stg_BLACKHOLE_BQ_entry)
       bdescr *bd = Bdescr(R1.p);
       if (bd->back != (bdescr *)BaseReg) {
        if (bd->gen->no >= 1 || bd->step->no >= 1) {
-         CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
+         CMPXCHG(R1.cl->header.info, &stg_BLACKHOLE_info, &stg_WHITEHOLE_info);
        } else {
          EXTFUN_RTS(stg_gc_enter_1_hponly);
          JMP_(stg_gc_enter_1_hponly);
@@ -537,8 +563,8 @@ STGFUN(stg_CAF_BLACKHOLE_entry)
     {
       bdescr *bd = Bdescr(R1.p);
       if (bd->back != (bdescr *)BaseReg) {
-       if (bd->gen->no >= 1 || bd->step->no >= 1) {
-         CMPXCHG(R1.cl->header.info, &CAF_BLACKHOLE_info, &WHITEHOLE_info);
+       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);
          JMP_(stg_gc_enter_1_hponly);
@@ -549,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_
 }
@@ -701,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);
 
 /* -----------------------------------------------------------------------------
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)