[project @ 2004-08-13 10:45:16 by simonmar]

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

diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc
index 71f7ef7..8bf5dbb 100644 (file)
--- a/ghc/rts/StgMiscClosures.hc
+++ b/ghc/rts/StgMiscClosures.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.82 2002/12/13 19:14:58 wolfgang Exp $
+ * $Id: StgMiscClosures.hc,v 1.85 2003/05/14 09:14:00 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2002
  *
@@ -127,13 +127,13 @@ STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_6_ret);
 STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_7_ret);
 
 VEC_POLY_INFO_TABLE( stg_ctoi_ret_R1p, 0/* special layout */,
-                    0/*srt*/, 0/*srt_off*/, 0/*srt_len*/, 
+                    0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, 
                     RET_BCO,, EF_);
 
 // When the returned value is a pointer, but unlifted, in R1 ...
 INFO_TABLE_RET( stg_ctoi_ret_R1unpt_info, stg_ctoi_ret_R1unpt_entry,
                0/* special layout */,
-               0/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, IF_, 0, 0);
+               0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
 IF_(stg_ctoi_ret_R1unpt_entry)
 {
    FB_
@@ -147,7 +147,7 @@ IF_(stg_ctoi_ret_R1unpt_entry)
 // When the returned value is a non-pointer in R1 ...
 INFO_TABLE_RET( stg_ctoi_ret_R1n_info, stg_ctoi_ret_R1n_entry,
                0/* special layout */,
-               0/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, IF_, 0, 0);
+               0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
 IF_(stg_ctoi_ret_R1n_entry)
 {
    FB_
@@ -162,7 +162,7 @@ IF_(stg_ctoi_ret_R1n_entry)
 // When the returned value is in F1 ...
 INFO_TABLE_RET( stg_ctoi_ret_F1_info, stg_ctoi_ret_F1_entry, 
                0/* special layout */,
-               0/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, IF_, 0, 0);
+               0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
 IF_(stg_ctoi_ret_F1_entry)
 {
    FB_
@@ -176,7 +176,7 @@ IF_(stg_ctoi_ret_F1_entry)
 // When the returned value is in D1 ...
 INFO_TABLE_RET( stg_ctoi_ret_D1_info, stg_ctoi_ret_D1_entry,
                0/* special layout */,
-               0/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, IF_, 0, 0);
+               0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
 IF_(stg_ctoi_ret_D1_entry)
 {
    FB_
@@ -190,7 +190,7 @@ IF_(stg_ctoi_ret_D1_entry)
 // When the returned value is in L1 ...
 INFO_TABLE_RET( stg_ctoi_ret_L1_info, stg_ctoi_ret_L1_entry,
                0/* special layout */,
-               0/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, IF_, 0, 0);
+               0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
 IF_(stg_ctoi_ret_L1_entry)
 {
    FB_
@@ -204,7 +204,7 @@ IF_(stg_ctoi_ret_L1_entry)
 // When the returned value a VoidRep ...
 INFO_TABLE_RET( stg_ctoi_ret_V_info, stg_ctoi_ret_V_entry,
                0/* special layout */,
-               0/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, IF_, 0, 0);
+               0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
 IF_(stg_ctoi_ret_V_entry)
 {
    FB_
@@ -218,7 +218,7 @@ IF_(stg_ctoi_ret_V_entry)
 // should apply the BCO on the stack to its arguments, also on the stack.
 INFO_TABLE_RET( stg_apply_interp_info, stg_apply_interp_entry,
                0/* special layout */,
-               0/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, IF_, 0, 0);
+               0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
 IF_(stg_apply_interp_entry)
 {
     FB_
@@ -234,8 +234,8 @@ IF_(stg_apply_interp_entry)
 INFO_TABLE_FUN_GEN(stg_BCO_info,stg_BCO_entry,4,0,
              0,0,0,  /* no SRT */
              ARG_BCO, 0/*dummy arity*/, 0/*dummy bitmap*/, NULL/*slow_apply*/,
-             BCO,,IF_,"BCO","BCO");
-IF_(stg_BCO_entry) {
+             BCO,,EF_,"BCO","BCO");
+FN_(stg_BCO_entry) {
   FB_
   // entering a BCO means "apply it", same as a function
   Sp -= 2;
@@ -246,7 +246,13 @@ IF_(stg_BCO_entry) {
 }
 
 /* -----------------------------------------------------------------------------
-   Entry code for an indirection.
+   Info tables for indirections.
+
+   SPECIALISED INDIRECTIONS: we have a specialised indirection for each
+   kind of return (direct, vectored 0-7), so that we can avoid entering
+   the object when we know what kind of return it will do.  The update
+   code (Updates.hc) updates objects with the appropriate kind of
+   indirection.  We only do this for young-gen indirections.
    -------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_IND_info,stg_IND_entry,1,0,IND,,IF_,"IND","IND");
@@ -260,6 +266,28 @@ IF_(stg_IND_entry)
     FE_
 }
 
+#define IND_SPEC(n,ret) \
+INFO_TABLE(stg_IND_##n##_info,stg_IND_##n##_entry,1,0,IND,,IF_,"IND","IND"); \
+IF_(stg_IND_##n##_entry)                       \
+{                                              \
+    FB_                                                \
+    TICK_ENT_DYN_IND(Node);    /* tick */      \
+    R1.p = (P_) ((StgInd*)R1.p)->indirectee;   \
+    TICK_ENT_VIA_NODE();                       \
+    JMP_(ret);                                 \
+    FE_                                                \
+}
+
+IND_SPEC(direct, ENTRY_CODE(Sp[0]))
+IND_SPEC(0, RET_VEC(Sp[0],0))
+IND_SPEC(1, RET_VEC(Sp[0],1))
+IND_SPEC(2, RET_VEC(Sp[0],2))
+IND_SPEC(3, RET_VEC(Sp[0],3))
+IND_SPEC(4, RET_VEC(Sp[0],4))
+IND_SPEC(5, RET_VEC(Sp[0],5))
+IND_SPEC(6, RET_VEC(Sp[0],6))
+IND_SPEC(7, RET_VEC(Sp[0],7))
+
 INFO_TABLE(stg_IND_STATIC_info,stg_IND_STATIC_entry,1,0,IND_STATIC,,IF_,"IND_STATIC","IND_STATIC");
 IF_(stg_IND_STATIC_entry)
 {
@@ -580,7 +608,7 @@ IF_(stg_CAF_BLACKHOLE_entry)
   FE_
 }
 
-#ifdef TICKY_TICKY
+#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)
 {