[project @ 1999-01-26 11:12:41 by simonm]

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

diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc
index 1edc735..9bc0930 100644 (file)
--- a/ghc/rts/StgMiscClosures.hc
+++ b/ghc/rts/StgMiscClosures.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.5 1999/01/15 17:57:11 simonm Exp $
+ * $Id: StgMiscClosures.hc,v 1.8 1999/01/26 11:12:52 simonm Exp $
  *
  * Entry code for various built-in closure types.
  *
@@ -9,6 +9,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 +111,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));
@@ -136,11 +136,15 @@ 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 */
-    ((StgBlackHole *)R1.p)->header.info = &BLACKHOLE_BQ_info;
+    ((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;
-    ((StgBlackHole *)R1.p)->blocking_queue = CurrentTSO;
+    ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
+    ((StgBlockingQueue *)R1.p)->mut_link = NULL;
+    recordMutable((StgMutClosure *)R1.cl);
 
     /* stg_gen_block is too heavyweight, use a specialised one */
     BLOCK_NP(1);
@@ -151,9 +155,11 @@ 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);
@@ -165,11 +171,15 @@ INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,const,EF_,0
 STGFUN(CAF_BLACKHOLE_entry)
 {
   FB_
+    TICK_ENT_BH();
+
     /* Change the BLACKHOLE into a BLACKHOLE_BQ */
-    ((StgBlackHole *)R1.p)->header.info = &BLACKHOLE_BQ_info;
+    ((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;
-    ((StgBlackHole *)R1.p)->blocking_queue = CurrentTSO;
+    ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
+    ((StgBlockingQueue *)R1.p)->mut_link = NULL;
+    recordMutable((StgMutClosure *)R1.cl);
 
     /* stg_gen_block is too heavyweight, use a specialised one */
     BLOCK_NP(1);
@@ -237,6 +247,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
@@ -345,6 +362,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_)
 };