[project @ 1999-02-01 18:05:30 by simonm]

- Add finalise#
- Add mkWeakNoFinaliser
- Move deRefWeak# from an out-of-line primop to an inline one.

diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h
index b637bf9..2a7ce94 100644 (file)
--- a/ghc/includes/PrimOps.h
+++ b/ghc/includes/PrimOps.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.12 1999/01/29 09:32:37 simonm Exp $
+ * $Id: PrimOps.h,v 1.13 1999/02/01 18:05:30 simonm Exp $
  *
  * Macros for primitive operations in STG-ish C code.
  *
@@ -685,7 +685,17 @@ EF_(seqzh_fast);
 #ifndef PAR
 
 EF_(mkWeakzh_fast);
-EF_(deRefWeakzh_fast);
+EF_(finaliseWeakzh_fast);
+
+#define deRefWeakzh(code,val,w)                        \
+  if (((StgWeak *)w)->header.info == &WEAK_info) {     \
+       code = 1;                                       \
+       val = ((StgWeak *)w)->value;                    \
+  } else {                                             \
+       code = 0;                                       \
+       val = (StgClosure *)w;                          \
+  }
+
 #define sameWeakzh(w1,w2)  ((w1)==(w2))
 
 #endif

diff --git a/ghc/includes/StgMiscClosures.h b/ghc/includes/StgMiscClosures.h
index 990385c..ee948dc 100644 (file)
--- a/ghc/includes/StgMiscClosures.h
+++ b/ghc/includes/StgMiscClosures.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.h,v 1.6 1999/01/26 11:12:58 simonm Exp $
+ * $Id: StgMiscClosures.h,v 1.7 1999/02/01 18:05:31 simonm Exp $
  *
  * Entry code for various built-in closure types.
  *
@@ -26,6 +26,7 @@ STGFUN(BCO_entry);
 STGFUN(EVACUATED_entry);
 STGFUN(FOREIGN_entry);
 STGFUN(WEAK_entry);
+STGFUN(NO_FINALISER_entry);
 STGFUN(DEAD_WEAK_entry);
 STGFUN(STABLE_NAME_entry);
 STGFUN(TSO_entry);
@@ -58,6 +59,7 @@ extern const StgInfoTable EVACUATED_info;
 extern const StgInfoTable FOREIGN_info;
 extern const StgInfoTable WEAK_info;
 extern const StgInfoTable DEAD_WEAK_info;
+extern const StgInfoTable NO_FINALISER_info;
 extern const StgInfoTable STABLE_NAME_info;
 extern const StgInfoTable FULL_MVAR_info;
 extern const StgInfoTable EMPTY_MVAR_info;
@@ -85,6 +87,7 @@ extern const StgInfoTable ret_bco_info;
 
 extern StgClosure END_TSO_QUEUE_closure;
 extern StgClosure END_MUT_LIST_closure;
+extern StgClosure NO_FINALISER_closure;
 extern StgClosure dummy_ret_closure;
 
 extern StgIntCharlikeClosure CHARLIKE_closure[];

diff --git a/ghc/lib/exts/Weak.lhs b/ghc/lib/exts/Weak.lhs
index 18a8577..be0c025 100644 (file)
--- a/ghc/lib/exts/Weak.lhs
+++ b/ghc/lib/exts/Weak.lhs
@@ -15,6 +15,7 @@ module Weak (
        deRefWeak,              -- :: Weak v -> IO (Maybe v)
        -- finalise             -- :: Weak v -> IO ()
        -- replaceFinaliser     -- :: Weak v -> IO () -> IO ()
+       mkWeakNoFinaliser,      -- :: k -> v -> IO (Weak v)
 
        mkWeakPtr,              -- :: k -> IO () -> IO (Weak k)
        mkWeakPair,             -- :: k -> v -> IO () -> IO (Weak (k,v))

diff --git a/ghc/lib/std/PrelGHC.hi-boot b/ghc/lib/std/PrelGHC.hi-boot
index c43a288..35bd436 100644 (file)
--- a/ghc/lib/std/PrelGHC.hi-boot
+++ b/ghc/lib/std/PrelGHC.hi-boot
@@ -291,7 +291,8 @@ __export PrelGHC
   Weakzh
   mkWeakzh
   deRefWeakzh
-  
+  finaliseWeakzh
+
   ForeignObjzh
   makeForeignObjzh
   writeForeignObjzh

diff --git a/ghc/lib/std/PrelWeak.lhs b/ghc/lib/std/PrelWeak.lhs
index cbe510a..d684460 100644 (file)
--- a/ghc/lib/std/PrelWeak.lhs
+++ b/ghc/lib/std/PrelWeak.lhs
@@ -26,6 +26,11 @@ mkWeak key val finaliser = IO $ \s ->
    case mkWeak# key val finaliser s of { (# s1, w #) ->
    (# s1, Weak w #) }
 
+mkWeakNoFinaliser key val = IO $ \s ->
+   -- zero is a valid finaliser argument to mkWeak#, and means "no finaliser"
+   case mkWeak# key val (unsafeCoerce# 0#) s of { (# s1, w #) ->
+   (# s1, Weak w #) }
+
 deRefWeak :: Weak v -> IO (Maybe v)
 deRefWeak (Weak w) = IO $ \s ->
    case deRefWeak# w s of

diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc
index cfcca50..e865fb1 100644 (file)
--- a/ghc/rts/PrimOps.hc
+++ b/ghc/rts/PrimOps.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.9 1999/01/27 14:51:20 simonpj Exp $
+ * $Id: PrimOps.hc,v 1.10 1999/02/01 18:05:34 simonm Exp $
  *
  * Primitive functions / data
  *
@@ -313,7 +313,11 @@ FN_(mkWeakzh_fast)
 
   w->key        = R1.cl;
   w->value      = R2.cl;
-  w->finaliser  = R3.cl;
+  if (R3.cl) {
+     w->finaliser  = R3.cl;
+  } else
+     w->finaliser  = &NO_FINALISER_closure;
+  }
 
   w->link       = weak_ptr_list;
   weak_ptr_list = w;
@@ -324,20 +328,27 @@ FN_(mkWeakzh_fast)
   FE_
 }
 
-FN_(deRefWeakzh_fast)
+FN_(finaliseWeakzh_fast)
 {
   /* R1.p = weak ptr
    */
   StgWeak *w;
   FB_
-  
-  TICK_RET_UNBOXED_TUP(2);
+  TICK_RET_UNBOXED_TUP(0);
   w = (StgWeak *)R1.p;
-  if (w->header.info == &WEAK_info) {
-       RET_NP(1, w->value);
-  } else {
-       RET_NP(0, w);
+
+  if (w->finaliser != &NO_FINALISER_info) {
+#ifdef INTERPRETER
+      STGCALL2(StgTSO *, createGenThread,
+               RtsFlags.GcFlags.initialStkSize, w->finaliser);
+#else
+      STGCALL2(StgTSO *, createIOThread,
+               RtsFlags.GcFlags.initialStkSize, w->finaliser);
+#endif
   }
+  w->header.info = &DEAD_WEAK_info;
+
+  JMP_(ENTRY_CODE(Sp[0]));
   FE_
 }
 

diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc
index a511113..e724233 100644 (file)
--- a/ghc/rts/StgMiscClosures.hc
+++ b/ghc/rts/StgMiscClosures.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.9 1999/01/27 14:51:22 simonpj Exp $
+ * $Id: StgMiscClosures.hc,v 1.10 1999/02/01 18:05:34 simonm Exp $
  *
  * Entry code for various built-in closure types.
  *
@@ -240,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.
    -------------------------------------------------------------------------- */
 

diff --git a/ghc/rts/Weak.c b/ghc/rts/Weak.c
index 48e7310..5f038db 100644 (file)
--- a/ghc/rts/Weak.c
+++ b/ghc/rts/Weak.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Weak.c,v 1.4 1999/01/26 11:12:53 simonm Exp $
+ * $Id: Weak.c,v 1.5 1999/02/01 18:05:35 simonm Exp $
  *
  * Weak pointers / finalisers
  *
@@ -27,7 +27,9 @@ finaliseWeakPointersNow(void)
   for (w = weak_ptr_list; w; w = w->link) {
     IF_DEBUG(weak,fprintf(stderr,"Finalising weak pointer at %p -> %p\n", w, w->key));
     w->header.info = &DEAD_WEAK_info;
-    rts_evalIO(w->finaliser,NULL);
+    if (w->finaliser != &NO_FINALISER_info) {
+      rts_evalIO(w->finaliser,NULL);
+    }
   }
 } 
 
@@ -44,11 +46,13 @@ scheduleFinalisers(StgWeak *list)
   
   for (w = list; w; w = w->link) {
     IF_DEBUG(weak,fprintf(stderr,"Finalising weak pointer at %p -> %p\n", w, w->key));
+    if (w->finaliser != &NO_FINALISER_info) {
 #ifdef INTERPRETER
-    createGenThread(RtsFlags.GcFlags.initialStkSize, w->finaliser);
+      createGenThread(RtsFlags.GcFlags.initialStkSize, w->finaliser);
 #else
-    createIOThread(RtsFlags.GcFlags.initialStkSize, w->finaliser);
+      createIOThread(RtsFlags.GcFlags.initialStkSize, w->finaliser);
 #endif
+    }
     w->header.info = &DEAD_WEAK_info;
   }
 }