[project @ 2001-03-13 17:46:56 by rrt]

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

diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc
index 16d9012..eadb097 100644 (file)
--- a/ghc/rts/StgMiscClosures.hc
+++ b/ghc/rts/StgMiscClosures.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.58 2001/01/15 16:55:25 sewardj Exp $
+ * $Id: StgMiscClosures.hc,v 1.65 2001/02/15 14:30:07 sewardj Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -51,14 +51,12 @@ 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) 
 { 
   /* R1 points at the constructor */
   FB_ 
-    STGCALL2(fprintf,stderr,"stg_interp_constr_entry (direct return)!\n");
+    /* STGCALL2(fprintf,stderr,"stg_interp_constr_entry (direct return)!\n"); */
     /* Pointless, since SET_TAG doesn't do anything */
     SET_TAG( GET_TAG(GET_INFO(R1.cl))); 
     JMP_(ENTRY_CODE((P_)(*Sp))); 
@@ -229,6 +227,34 @@ 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:
 
@@ -257,8 +283,6 @@ STGFUN(stg_BCO_entry) {
   FE_
 }
 
-#endif /* GHCI */
-
 
 /* -----------------------------------------------------------------------------
    Entry code for an indirection.
@@ -314,7 +338,7 @@ STGFUN(stg_IND_PERM_entry)
 #  ifdef PROFILING
 #    error Profiling and ticky-ticky do not mix at present!
 #  endif  /* PROFILING */
-    SET_INFO((StgInd*)R1.p,&IND_info);
+    SET_INFO((StgInd*)R1.p,&stg_IND_info);
 #endif /* TICKY_TICKY */
 
     R1.p = (P_) ((StgInd*)R1.p)->indirectee;
@@ -360,7 +384,7 @@ STGFUN(stg_IND_OLDGEN_PERM_entry)
 #  ifdef PROFILING
 #    error Profiling and ticky-ticky do not mix at present!
 #  endif  /* PROFILING */
-    SET_INFO((StgInd*)R1.p,&IND_OLDGEN_info);
+    SET_INFO((StgInd*)R1.p,&stg_IND_OLDGEN_info);
 #endif /* TICKY_TICKY */
 
     R1.p = (P_) ((StgInd*)R1.p)->indirectee;
@@ -370,34 +394,6 @@ STGFUN(stg_IND_OLDGEN_PERM_entry)
 }
 
 /* -----------------------------------------------------------------------------
-   Entry code for CAFs
-
-   This code assumes R1 is in a register for now.
-   -------------------------------------------------------------------------- */
-
-INFO_TABLE(stg_CAF_UNENTERED_info,stg_CAF_UNENTERED_entry,1,3,CAF_UNENTERED,,EF_,0,0);
-STGFUN(stg_CAF_UNENTERED_entry)
-{
-    FB_
-    /* ToDo: implement directly in GHC */
-    Sp -= 1;
-    Sp[0] = R1.w;
-    JMP_(stg_yield_to_interpreter);
-    FE_
-}
-
-/* 0,4 is entirely bogus; _do not_ rely on this info */
-INFO_TABLE(stg_CAF_ENTERED_info,stg_CAF_ENTERED_entry,0,4,CAF_ENTERED,,EF_,0,0);
-STGFUN(stg_CAF_ENTERED_entry)
-{
-    FB_
-    R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */
-    TICK_ENT_VIA_NODE();
-    JMP_(GET_ENTRY(R1.cl));
-    FE_
-}
-
-/* -----------------------------------------------------------------------------
    Entry code for a black hole.
 
    Entering a black hole normally causes a cyclic data dependency, but
@@ -427,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);
@@ -476,7 +472,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);
@@ -567,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) {
-         CMPXCHG(R1.cl->header.info, &CAF_BLACKHOLE_info, &WHITEHOLE_info);
+         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);
@@ -592,7 +588,7 @@ STGFUN(stg_CAF_BLACKHOLE_entry)
     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 */
+    /* 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 */
@@ -843,7 +839,7 @@ STGFUN(stg_forceIO_ret_entry)
 }
 #else
 INFO_TABLE_SRT_BITMAP(stg_forceIO_ret_info,stg_forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
-STGFUN(forceIO_ret_entry)
+STGFUN(stg_forceIO_ret_entry)
 {
   StgClosure *rval;
   FB_