[project @ 1999-03-20 17:33:07 by sof]

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

diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc
index 9bc0930..67dadf0 100644 (file)
--- a/ghc/rts/StgMiscClosures.hc
+++ b/ghc/rts/StgMiscClosures.hc
@@ -1,5 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.8 1999/01/26 11:12:52 simonm Exp $
+ * $Id: StgMiscClosures.hc,v 1.19 1999/03/18 17:57:23 simonm Exp $
+ *
+ * (c) The GHC Team, 1998-1999
  *
  * Entry code for various built-in closure types.
  *
@@ -46,7 +48,7 @@ STGFUN(IND_STATIC_entry)
     FE_
 }
 
-INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,0,IND_PERM,const,EF_,0,0);
+INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,const,EF_,0,0);
 STGFUN(IND_PERM_entry)
 {
     FB_
@@ -96,7 +98,7 @@ STGFUN(IND_OLDGEN_PERM_entry)
    This code assumes R1 is in a register for now.
    -------------------------------------------------------------------------- */
 
-INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,2,CAF_UNENTERED,const,EF_,0,0);
+INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,3,CAF_UNENTERED,const,EF_,0,0);
 STGFUN(CAF_UNENTERED_entry)
 {
     FB_
@@ -107,7 +109,8 @@ STGFUN(CAF_UNENTERED_entry)
     FE_
 }
 
-INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,2,1,CAF_ENTERED,const,EF_,0,0);
+/* 0,4 is entirely bogus; _do not_ rely on this info */
+INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,0,4,CAF_ENTERED,const,EF_,0,0);
 STGFUN(CAF_ENTERED_entry)
 {
     FB_
@@ -143,7 +146,7 @@ STGFUN(BLACKHOLE_entry)
     /* Put ourselves on the blocking queue for this black hole */
     CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
-    ((StgBlockingQueue *)R1.p)->mut_link = NULL;
+    CurrentTSO->blocked_on = R1.cl;
     recordMutable((StgMutClosure *)R1.cl);
 
     /* stg_gen_block is too heavyweight, use a specialised one */
@@ -158,6 +161,7 @@ STGFUN(BLACKHOLE_BQ_entry)
     TICK_ENT_BH();
 
     /* Put ourselves on the blocking queue for this black hole */
+    CurrentTSO->blocked_on = R1.cl;
     CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
 
@@ -178,7 +182,7 @@ STGFUN(CAF_BLACKHOLE_entry)
     /* Put ourselves on the blocking queue for this black hole */
     CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
     ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
-    ((StgBlockingQueue *)R1.p)->mut_link = NULL;
+    CurrentTSO->blocked_on = R1.cl;
     recordMutable((StgMutClosure *)R1.cl);
 
     /* stg_gen_block is too heavyweight, use a specialised one */
@@ -240,6 +244,19 @@ INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,const,EF_,0,0);
 NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
 
 /* -----------------------------------------------------------------------------
+   NO_FINALIZER
+
+   This is a static nullary constructor (like []) that we use to mark an empty
+   finalizer in a weak pointer object.
+   -------------------------------------------------------------------------- */
+
+INFO_TABLE_CONSTR(NO_FINALIZER_info,NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
+
+SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_)
+};
+
+/* -----------------------------------------------------------------------------
    Foreign Objects are unlifted and therefore never entered.
    -------------------------------------------------------------------------- */
 
@@ -311,14 +328,15 @@ NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
 
    -------------------------------------------------------------------------- */
 
-#define ArrayInfo(type)                                                        \
-INFO_TABLE(type##_info, type##_entry, 0, 0, type, const, EF_,0,0);     \
-NON_ENTERABLE_ENTRY_CODE(type);
+#define ArrayInfo(type)                                        \
+INFO_TABLE(type##_info, type##_entry, 0, 0, type, const, EF_,0,0);
 
 ArrayInfo(ARR_WORDS);
-ArrayInfo(MUT_ARR_WORDS);
+NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
 ArrayInfo(MUT_ARR_PTRS);
+NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS);
 ArrayInfo(MUT_ARR_PTRS_FROZEN);
+NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
 
 #undef ArrayInfo
 
@@ -407,25 +425,25 @@ VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO)
 
 #ifndef COMPILER
 
-INFO_TABLE_CONSTR(CZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,const,EF_,0,0);
-INFO_TABLE_CONSTR(IZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,const,EF_,0,0);
-INFO_TABLE_CONSTR(I64Zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,const,EF_,0,0);
-INFO_TABLE_CONSTR(FZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,const,EF_,0,0);
-INFO_TABLE_CONSTR(DZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,const,EF_,0,0);
-INFO_TABLE_CONSTR(AZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,const,EF_,0,0);
-INFO_TABLE_CONSTR(WZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,const,EF_,0,0);
+INFO_TABLE_CONSTR(Czh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,const,EF_,0,0);
+INFO_TABLE_CONSTR(Izh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,const,EF_,0,0);
+INFO_TABLE_CONSTR(I64zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,const,EF_,0,0);
+INFO_TABLE_CONSTR(Fzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,const,EF_,0,0);
+INFO_TABLE_CONSTR(Dzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,const,EF_,0,0);
+INFO_TABLE_CONSTR(Azh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,const,EF_,0,0);
+INFO_TABLE_CONSTR(Wzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,const,EF_,0,0);
 INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,const,EF_,0,0);
 
-/* These might seem redundant but {I,C}Zh_static_info are used in
+/* 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,const,EF_,0,0);
-INFO_TABLE_CONSTR(IZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
-INFO_TABLE_CONSTR(I64Zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
-INFO_TABLE_CONSTR(FZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
-INFO_TABLE_CONSTR(DZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
-INFO_TABLE_CONSTR(AZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
-INFO_TABLE_CONSTR(WZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+INFO_TABLE_CONSTR(Czh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+INFO_TABLE_CONSTR(Izh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+INFO_TABLE_CONSTR(I64zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+INFO_TABLE_CONSTR(Fzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+INFO_TABLE_CONSTR(Dzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+INFO_TABLE_CONSTR(Azh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+INFO_TABLE_CONSTR(Wzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
 INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
 
 #endif /* !defined(COMPILER) */
@@ -438,16 +456,32 @@ INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr
    replace them with references to the static objects.
    -------------------------------------------------------------------------- */
 
+#ifdef HAVE_WIN32_DLL_SUPPORT
+/*
+ * When sticking the RTS in a DLL, we delay populating the
+ * Charlike and Intlike tables until load-time, which is only
+ * when we've got the real addresses to the C# and I# closures.
+ *
+ */
+static const StgInfoTable czh_static_info;
+static 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
+#endif
+
 #define CHARLIKE_HDR(n)                                                \
        {                                                       \
-         STATIC_HDR(CZh_static_info, /* C# */                  \
+         STATIC_HDR(Char_hash_static_info, /* C# */            \
                         CCS_DONTZuCARE),                       \
           data : n                                             \
        }
                                             
 #define INTLIKE_HDR(n)                                         \
        {                                                       \
-         STATIC_HDR(IZh_static_info,  /* I# */                 \
+         STATIC_HDR(Int_hash_static_info,  /* I# */            \
                         CCS_DONTZuCARE),                       \
           data : n                                             \
        }