projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 1999-02-08 10:41:17 by simonm]
[ghc-hetmet.git] / ghc / rts / StgMiscClosures.hc
diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc
index f426d59..fcf26d9 100644 (file)
--- a/ghc/rts/StgMiscClosures.hc
+++ b/ghc/rts/StgMiscClosures.hc
@@ -1,5 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.4 1999/01/15 12:47:20 sewardj Exp $
+ * $Id: StgMiscClosures.hc,v 1.13 1999/02/05 16:02:58 simonm Exp $
+ *
+ * (c) The GHC Team, 1998-1999
  *
  * Entry code for various built-in closure types.
  *
@@ -9,6 +11,8 @@
 #include "RtsUtils.h"
 #include "StgMiscClosures.h"
 #include "HeapStackCheck.h"   /* for stg_gen_yield */
+#include "Storage.h"
+#include "StoragePriv.h"
 
 #ifdef HAVE_STDIO_H
 #include <stdio.h>
@@ -109,8 +113,6 @@ INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,2,1,CAF_ENTERED,const,EF_,0,0);
 STGFUN(CAF_ENTERED_entry)
 {
     FB_
-    TICK_ENT_CAF_ENTERED(Node);        /* tick */
-
     R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */
     TICK_ENT_VIA_NODE();
     JMP_(GET_ENTRY(R1.cl));
@@ -132,13 +134,33 @@ STGFUN(CAF_ENTERED_entry)
  * should be big enough for an old-generation indirection.  
  */
 
-INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,1,1,BLACKHOLE,const,EF_,0,0);
+INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,const,EF_,0,0);
 STGFUN(BLACKHOLE_entry)
 {
   FB_
+    TICK_ENT_BH();
+
+    /* Change the BLACKHOLE into a BLACKHOLE_BQ */
+    ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
+    /* Put ourselves on the blocking queue for this black hole */
+    CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
+    ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
+    recordMutable((StgMutClosure *)R1.cl);
+
+    /* stg_gen_block is too heavyweight, use a specialised one */
+    BLOCK_NP(1);
+  FE_
+}
+
+INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,const,EF_,0,0);
+STGFUN(BLACKHOLE_BQ_entry)
+{
+  FB_
+    TICK_ENT_BH();
+
     /* Put ourselves on the blocking queue for this black hole */
-    CurrentTSO->link = ((StgBlackHole *)R1.p)->blocking_queue;
-    ((StgBlackHole *)R1.p)->blocking_queue = CurrentTSO;
+    CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
+    ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
 
     /* stg_gen_block is too heavyweight, use a specialised one */
     BLOCK_NP(1);
@@ -146,13 +168,18 @@ STGFUN(BLACKHOLE_entry)
 }
 
 /* identical to BLACKHOLEs except for the infotag */
-INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,1,1,CAF_BLACKHOLE,const,EF_,0,0);
+INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,const,EF_,0,0);
 STGFUN(CAF_BLACKHOLE_entry)
 {
   FB_
+    TICK_ENT_BH();
+
+    /* Change the BLACKHOLE into a BLACKHOLE_BQ */
+    ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
     /* Put ourselves on the blocking queue for this black hole */
-    CurrentTSO->link = ((StgBlackHole *)R1.p)->blocking_queue;
-    ((StgBlackHole *)R1.p)->blocking_queue = CurrentTSO;
+    CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
+    ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
+    recordMutable((StgMutClosure *)R1.cl);
 
     /* stg_gen_block is too heavyweight, use a specialised one */
     BLOCK_NP(1);
@@ -213,6 +240,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_FINALISER
+
+   This is a static nullary constructor (like []) that we use to mark an empty
+   finaliser in a weak pointer object.
+   -------------------------------------------------------------------------- */
+
+INFO_TABLE_CONSTR(NO_FINALISER_info,NO_FINALISER_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+NON_ENTERABLE_ENTRY_CODE(NO_FINALISER);
+
+SET_STATIC_HDR(NO_FINALISER_closure,NO_FINALISER_info,0/*CC*/,,EI_)
+};
+
+/* -----------------------------------------------------------------------------
    Foreign Objects are unlifted and therefore never entered.
    -------------------------------------------------------------------------- */
 
@@ -220,6 +260,13 @@ INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,const,EF_,0,0);
 NON_ENTERABLE_ENTRY_CODE(FOREIGN);
 
 /* -----------------------------------------------------------------------------
+   Stable Names are unlifted too.
+   -------------------------------------------------------------------------- */
+
+INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,const,EF_,0,0);
+NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
+
+/* -----------------------------------------------------------------------------
    MVars
 
    There are two kinds of these: full and empty.  We need an info table
@@ -282,7 +329,6 @@ INFO_TABLE(type##_info, type##_entry, 0, 0, type, const, EF_,0,0);  \
 NON_ENTERABLE_ENTRY_CODE(type);
 
 ArrayInfo(ARR_WORDS);
-ArrayInfo(MUT_ARR_WORDS);
 ArrayInfo(MUT_ARR_PTRS);
 ArrayInfo(MUT_ARR_PTRS_FROZEN);
 
@@ -328,6 +374,7 @@ FN_(dummy_ret_entry)
   ret_addr = Sp[0];
   Sp++;
   JMP_(ENTRY_CODE(ret_addr));
+  FE_
 }
 SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_)
 };
@@ -372,25 +419,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) */
@@ -405,14 +452,14 @@ INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr
 
 #define CHARLIKE_HDR(n)                                                \
        {                                                       \
-         STATIC_HDR(CZh_static_info, /* C# */                  \
+         STATIC_HDR(Czh_static_info, /* C# */                  \
                         CCS_DONTZuCARE),                       \
           data : n                                             \
        }
                                             
 #define INTLIKE_HDR(n)                                         \
        {                                                       \
-         STATIC_HDR(IZh_static_info,  /* I# */                 \
+         STATIC_HDR(Izh_static_info,  /* I# */                 \
                         CCS_DONTZuCARE),                       \
           data : n                                             \
        }
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)