[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.

ghc/includes/PrimOps.h

 /* -----------------------------------------------------------------------------
- * $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

ghc/includes/StgMiscClosures.h

 /* -----------------------------------------------------------------------------
- * $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[];

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))

ghc/lib/std/PrelGHC.hi-boot

@@ -291,7 +291,8 @@ __export PrelGHC
   Weakzh
   mkWeakzh
   deRefWeakzh
-  
+  finaliseWeakzh
+
   ForeignObjzh
   makeForeignObjzh
   writeForeignObjzh

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

ghc/rts/PrimOps.hc

 /* -----------------------------------------------------------------------------
- * $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_
 }
 

ghc/rts/StgMiscClosures.hc

 /* -----------------------------------------------------------------------------
- * $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.
  *
@@ -239,6 +239,19 @@ NON_ENTERABLE_ENTRY_CODE(WEAK);
 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.
    -------------------------------------------------------------------------- */

ghc/rts/Weak.c

 /* -----------------------------------------------------------------------------
- * $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;
   }
 }