[project @ 2000-05-08 15:57:01 by simonmar]
[ghc-hetmet.git] / ghc / rts / StgMiscClosures.hc
index c904f9d..132caaa 100644 (file)
@@ -1,7 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.36 2000/03/01 16:57:57 sewardj Exp $
+ * $Id: StgMiscClosures.hc,v 1.44 2000/04/27 16:29:55 sewardj Exp $
  *
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2000
  *
  * Entry code for various built-in closure types.
  *
@@ -14,7 +14,8 @@
 #include "HeapStackCheck.h"   /* for stg_gen_yield */
 #include "Storage.h"
 #include "StoragePriv.h"
-#include "ProfRts.h"
+#include "Profiling.h"
+#include "Prelude.h"
 #include "SMP.h"
 #if defined(GRAN) || defined(PAR)
 # include "GranSimRts.h"      /* for DumpRawGranEvent */
@@ -45,8 +46,6 @@ STGFUN(type##_entry)                                                  \
 
 /* -----------------------------------------------------------------------------
    Entry code for an indirection.
-
-   This code assumes R1 is in a register for now.
    -------------------------------------------------------------------------- */
 
 INFO_TABLE(IND_info,IND_entry,1,0,IND,,EF_,0,0);
@@ -66,14 +65,13 @@ STGFUN(IND_STATIC_entry)
 {
     FB_
     TICK_ENT_IND(Node);        /* tick */
-  
     R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
     TICK_ENT_VIA_NODE();
     JMP_(ENTRY_CODE(*R1.p));
     FE_
 }
 
-INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,,EF_,0,0);
+INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,,EF_,"IND_PERM","IND_PERM");
 STGFUN(IND_PERM_entry)
 {
     FB_
@@ -199,7 +197,7 @@ STGFUN(CAF_ENTERED_entry)
  * old-generation indirection. 
  */
 
-INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,0,0);
+INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,"BLACKHOLE","BLACKHOLE");
 STGFUN(BLACKHOLE_entry)
 {
   FB_
@@ -240,31 +238,15 @@ STGFUN(BLACKHOLE_entry)
     /* Change the BLACKHOLE into a BLACKHOLE_BQ */
     ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
 
-#if defined(PAR)
-    /* Save the Thread State here, before calling RTS routines below! */
-    SAVE_THREAD_STATE(1);
-
-    /* if collecting stats update the execution time etc */
-    if (RtsFlags.ParFlags.ParStats.Full) {
-      /* Note that CURRENT_TIME may perform an unsafe call */
-      //rtsTime now = CURRENT_TIME; /* Now */
-      CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat;
-      CurrentTSO->par.blockcount++;
-      CurrentTSO->par.blockedat = CURRENT_TIME;
-      DumpRawGranEvent(CURRENT_PROC, thisPE,
-                      GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0);
-    }
+    /* PAR: dumping of event now done in blockThread -- HWL */
 
-    THREAD_RETURN(1);  /* back to the scheduler */  
-#else
     /* stg_gen_block is too heavyweight, use a specialised one */
     BLOCK_NP(1);
-#endif
 
   FE_
 }
 
-INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,0,0);
+INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,"BLACKHOLE","BLACKHOLE");
 STGFUN(BLACKHOLE_BQ_entry)
 {
   FB_
@@ -299,26 +281,10 @@ STGFUN(BLACKHOLE_BQ_entry)
     ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
 #endif
 
-#if defined(PAR)
-    /* Save the Thread State here, before calling RTS routines below! */
-    SAVE_THREAD_STATE(1);
-
-    /* if collecting stats update the execution time etc */
-    if (RtsFlags.ParFlags.ParStats.Full) {
-      /* Note that CURRENT_TIME may perform an unsafe call */
-      //rtsTime now = CURRENT_TIME; /* Now */
-      CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat;
-      CurrentTSO->par.blockcount++;
-      CurrentTSO->par.blockedat = CURRENT_TIME;
-      DumpRawGranEvent(CURRENT_PROC, thisPE,
-                      GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0);
-    }
+    /* PAR: dumping of event now done in blockThread -- HWL */
 
-    THREAD_RETURN(1);  /* back to the scheduler */  
-#else
     /* stg_gen_block is too heavyweight, use a specialised one */
     BLOCK_NP(1);
-#endif
   FE_
 }
 
@@ -353,28 +319,10 @@ STGFUN(RBH_entry)
     CurrentTSO->why_blocked = BlockedOnBlackHole;
     CurrentTSO->block_info.closure = R1.cl;
 
-#if defined(PAR)
-    /* Save the Thread State here, before calling RTS routines below! */
-    SAVE_THREAD_STATE(1);
-
-    /* if collecting stats update the execution time etc */
-    if (RtsFlags.ParFlags.ParStats.Full) {
-      /* Note that CURRENT_TIME may perform an unsafe call */
-      //rtsTime now = CURRENT_TIME; /* Now */
-      CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat;
-      CurrentTSO->par.blockcount++;
-      CurrentTSO->par.blockedat = CURRENT_TIME;
-      DumpRawGranEvent(CURRENT_PROC, thisPE,
-                      GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0);
-    }
+    /* PAR: dumping of event now done in blockThread -- HWL */
 
-    THREAD_RETURN(1);  /* back to the scheduler */  
-#else
-    /* saves thread state and leaves thread in ThreadEnterGHC state; */
     /* stg_gen_block is too heavyweight, use a specialised one */
     BLOCK_NP(1); 
-#endif
-
   FE_
 }
 
@@ -389,7 +337,7 @@ NON_ENTERABLE_ENTRY_CODE(RBH_Save_2);
 #endif /* defined(PAR) || defined(GRAN) */
 
 /* identical to BLACKHOLEs except for the infotag */
-INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,0,0);
+INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,"CAF_BLACKHOLE","CAF_BLACKHOLE");
 STGFUN(CAF_BLACKHOLE_entry)
 {
   FB_
@@ -431,27 +379,10 @@ STGFUN(CAF_BLACKHOLE_entry)
     /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ */
     ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
 
-#if defined(PAR)
-    /* Save the Thread State here, before calling RTS routines below! */
-    SAVE_THREAD_STATE(1);
-
-    /* if collecting stats update the execution time etc */
-    if (RtsFlags.ParFlags.ParStats.Full) {
-      /* Note that CURRENT_TIME may perform an unsafe call */
-      //rtsTime now = CURRENT_TIME; /* Now */
-      CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat;
-      CurrentTSO->par.blockcount++;
-      CurrentTSO->par.blockedat = CURRENT_TIME;
-      DumpRawGranEvent(CURRENT_PROC, thisPE,
-                      GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0);
-    }
+    /* PAR: dumping of event now done in blockThread -- HWL */
 
-    THREAD_RETURN(1);  /* back to the scheduler */  
-#else
     /* stg_gen_block is too heavyweight, use a specialised one */
     BLOCK_NP(1);
-#endif
-
   FE_
 }
 
@@ -488,7 +419,7 @@ STGFUN(WHITEHOLE_entry)
 /* -----------------------------------------------------------------------------
    The code for a BCO returns to the scheduler
    -------------------------------------------------------------------------- */
-INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,,EF_,0,0);
+INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,,EF_,"BCO","BCO");
 EF_(BCO_entry) {                               
   FB_  
     Sp -= 1;
@@ -503,7 +434,7 @@ EF_(BCO_entry) {
    NON_ENTERABLE_ENTRY_CODE now defined at the beginning of the file
    -------------------------------------------------------------------------- */
 
-INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,,EF_,0,0);
+INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,,EF_,"TSO","TSO");
 NON_ENTERABLE_ENTRY_CODE(TSO);
 
 /* -----------------------------------------------------------------------------
@@ -522,10 +453,10 @@ NON_ENTERABLE_ENTRY_CODE(EVACUATED);
    live weak pointers with dead ones).
    -------------------------------------------------------------------------- */
 
-INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,,EF_,0,0);
+INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,,EF_,"WEAK","WEAK");
 NON_ENTERABLE_ENTRY_CODE(WEAK);
 
-INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,0,0);
+INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,"DEAD_WEAK","DEAD_WEAK");
 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
 
 /* -----------------------------------------------------------------------------
@@ -545,14 +476,14 @@ SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_)
    Foreign Objects are unlifted and therefore never entered.
    -------------------------------------------------------------------------- */
 
-INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,,EF_,0,0);
+INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,,EF_,"FOREIGN","FOREIGN");
 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
 
 /* -----------------------------------------------------------------------------
    Stable Names are unlifted too.
    -------------------------------------------------------------------------- */
 
-INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,0,0);
+INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,"STABLE_NAME","STABLE_NAME");
 NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
 
 /* -----------------------------------------------------------------------------
@@ -562,10 +493,10 @@ NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
    and entry code for each type.
    -------------------------------------------------------------------------- */
 
-INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,,EF_,0,0);
+INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
 NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
 
-INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,,EF_,0,0);
+INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
 NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
 
 /* -----------------------------------------------------------------------------
@@ -627,7 +558,7 @@ NON_ENTERABLE_ENTRY_CODE(EXCEPTION_CONS);
    -------------------------------------------------------------------------- */
 
 #define ArrayInfo(type)                                        \
-INFO_TABLE(type##_info, type##_entry, 0, 0, type, , EF_,0,0);
+INFO_TABLE(type##_info, type##_entry, 0, 0, type, , EF_,"" # type "","" # type "");
 
 ArrayInfo(ARR_WORDS);
 NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
@@ -642,7 +573,7 @@ NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
    Mutable Variables
    -------------------------------------------------------------------------- */
 
-INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
+INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, "MUT_VAR", "MUT_VAR");
 NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
 
 /* -----------------------------------------------------------------------------
@@ -678,7 +609,7 @@ FN_(dummy_ret_entry)
   JMP_(ENTRY_CODE(ret_addr));
   FE_
 }
-SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_)
+SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONT_CARE,,EI_)
 , /*payload*/{} };
 
 /* -----------------------------------------------------------------------------
@@ -733,7 +664,7 @@ FN_(forceIO_entry)
   JMP_(GET_ENTRY(R1.cl));
   FE_
 }
-SET_STATIC_HDR(forceIO_closure,forceIO_info,CCS_DONTZuCARE,,EI_)
+SET_STATIC_HDR(forceIO_closure,forceIO_info,CCS_DONT_CARE,,EI_)
 , /*payload*/{} };
 
 
@@ -773,31 +704,6 @@ VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,
 
 #endif /* INTERPRETER */
 
-#ifndef COMPILER
-
-INFO_TABLE_CONSTR(Czh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(Izh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(I64zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(Fzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(Dzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(Azh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(Wzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,,EF_,0,0);
-
-/* These might seem redundant but {I,C}zh_static_info are used in
- * {INT,CHAR}LIKE and the rest are used in RtsAPI.c
- */
-INFO_TABLE_CONSTR(Czh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(Izh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(I64zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(Fzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(Dzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(Azh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(Wzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-
-#endif /* !defined(COMPILER) */
-
 /* -----------------------------------------------------------------------------
    CHARLIKE and INTLIKE closures.  
 
@@ -806,7 +712,7 @@ INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr
    replace them with references to the static objects.
    -------------------------------------------------------------------------- */
 
-#ifdef ENABLE_WIN32_DLL_SUPPORT
+#if defined(INTERPRETER) || defined(ENABLE_WIN32_DLL_SUPPORT)
 /*
  * When sticking the RTS in a DLL, we delay populating the
  * Charlike and Intlike tables until load-time, which is only
@@ -818,21 +724,21 @@ static INFO_TBL_CONST StgInfoTable izh_static_info;
 #define Char_hash_static_info czh_static_info
 #define Int_hash_static_info izh_static_info
 #else
-#define Char_hash_static_info Czh_static_info
-#define Int_hash_static_info Izh_static_info
+#define Char_hash_static_info PrelBase_Czh_static_info
+#define Int_hash_static_info PrelBase_Izh_static_info
 #endif
 
 #define CHARLIKE_HDR(n)                                                \
        {                                                       \
          STATIC_HDR(Char_hash_static_info, /* C# */            \
-                        CCS_DONTZuCARE),                       \
+                        CCS_DONT_CARE),                        \
           data : n                                             \
        }
                                             
 #define INTLIKE_HDR(n)                                         \
        {                                                       \
          STATIC_HDR(Int_hash_static_info,  /* I# */            \
-                        CCS_DONTZuCARE),                       \
+                        CCS_DONT_CARE),                        \
           data : n                                             \
        }