FIX #1364: added support for C finalizers that run as soon as the value is not longer...

Patch originally by Ivan Tomac <tomac@pacific.net.au>, amended by
Simon Marlow:

  - mkWeakFinalizer# commoned up with mkWeakFinalizerEnv#
  - GC parameters to ALLOC_PRIM fixed

diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 77ef9de..1e41453 100644 (file)
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -1557,6 +1557,12 @@ primop  MkWeakOp "mkWeak#" GenPrimOp
    has_side_effects = True
    out_of_line      = True
 
+primop  MkWeakForeignEnvOp "mkWeakForeignEnv#" GenPrimOp
+   o -> b -> Addr# -> Addr# -> Int# -> Addr# -> State# RealWorld -> (# State# RealWorld, Weak# b #)
+   with
+   has_side_effects = True
+   out_of_line      = True
+
 primop  DeRefWeakOp "deRefWeak#" GenPrimOp
    Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, a #)
    with

diff --git a/includes/Closures.h b/includes/Closures.h
index 05cf7ba..15955fd 100644 (file)
--- a/includes/Closures.h
+++ b/includes/Closures.h
@@ -190,6 +190,7 @@ typedef struct _StgStableName {
 
 typedef struct _StgWeak {      /* Weak v */
   StgHeader header;
+  StgClosure *cfinalizer;
   StgClosure *key;
   StgClosure *value;           /* v */
   StgClosure *finalizer;

diff --git a/includes/StgMiscClosures.h b/includes/StgMiscClosures.h
index 8911cf3..460adeb 100644 (file)
--- a/includes/StgMiscClosures.h
+++ b/includes/StgMiscClosures.h
@@ -582,6 +582,8 @@ RTS_FUN(isCurrentThreadBoundzh_fast);
 RTS_FUN(threadStatuszh_fast);
 
 RTS_FUN(mkWeakzh_fast);
+RTS_FUN(mkWeakForeignzh_fast);
+RTS_FUN(mkWeakForeignEnvzh_fast);
 RTS_FUN(finalizzeWeakzh_fast);
 RTS_FUN(deRefWeakzh_fast);
 

diff --git a/includes/mkDerivedConstants.c b/includes/mkDerivedConstants.c
index 116b2e9..d993643 100644 (file)
--- a/includes/mkDerivedConstants.c
+++ b/includes/mkDerivedConstants.c
@@ -376,6 +376,7 @@ main(int argc, char *argv[])
     closure_field(StgWeak,key);
     closure_field(StgWeak,value);
     closure_field(StgWeak,finalizer);
+    closure_field(StgWeak,cfinalizer);
 
     closure_size(StgDeadWeak);
     closure_field(StgDeadWeak,link);

diff --git a/rts/Linker.c b/rts/Linker.c
index ac06cda..ef12e3e 100644 (file)
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -224,6 +224,7 @@ typedef struct _RtsSymbolVal {
 
 #if !defined(PAR)
 #define Maybe_Stable_Names      SymI_HasProto(mkWeakzh_fast)                   \
+                               SymI_HasProto(mkWeakForeignEnvzh_fast)          \
                                SymI_HasProto(makeStableNamezh_fast)            \
                                SymI_HasProto(finalizzeWeakzh_fast)
 #else

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index f75b8aa..40948a3 100644 (file)
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -297,9 +297,14 @@ mkWeakzh_fast
   w = Hp - SIZEOF_StgWeak + WDS(1);
   SET_HDR(w, stg_WEAK_info, W_[CCCS]);
 
-  StgWeak_key(w)       = R1;
-  StgWeak_value(w)     = R2;
-  StgWeak_finalizer(w) = R3;
+  // We don't care about cfinalizer here.
+  // Should StgWeak_cfinalizer(w) be stg_NO_FINALIZER_closure or
+  // something else?
+
+  StgWeak_key(w)        = R1;
+  StgWeak_value(w)      = R2;
+  StgWeak_finalizer(w)  = R3;
+  StgWeak_cfinalizer(w) = stg_NO_FINALIZER_closure;
 
   StgWeak_link(w)      = W_[weak_ptr_list];
   W_[weak_ptr_list]    = w;
@@ -309,12 +314,65 @@ mkWeakzh_fast
   RET_P(w);
 }
 
+mkWeakForeignEnvzh_fast
+{
+  /* R1 = key
+     R2 = value
+     R3 = finalizer
+     R4 = pointer
+     R5 = has environment (0 or 1)
+     R6 = environment
+  */
+  W_ w, payload_words, words, p;
+
+  W_ key, val, fptr, ptr, flag, eptr;
+
+  key  = R1;
+  val  = R2;
+  fptr = R3;
+  ptr  = R4;
+  flag = R5;
+  eptr = R6;
+
+  ALLOC_PRIM( SIZEOF_StgWeak, R1_PTR & R2_PTR & R3_PTR, mkWeakForeignEnvzh_fast );
+
+  w = Hp - SIZEOF_StgWeak + WDS(1);
+  SET_HDR(w, stg_WEAK_info, W_[CCCS]);
+
+  payload_words = 4;
+  words         = BYTES_TO_WDS(SIZEOF_StgArrWords) + payload_words;
+  ("ptr" p)     = foreign "C" allocateLocal(MyCapability() "ptr", words) [];
+
+  TICK_ALLOC_PRIM(SIZEOF_StgArrWords,WDS(payload_words),0);
+  SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
+
+  StgArrWords_words(p)     = payload_words;
+  StgArrWords_payload(p,0) = fptr;
+  StgArrWords_payload(p,1) = ptr;
+  StgArrWords_payload(p,2) = eptr;
+  StgArrWords_payload(p,3) = flag;
+
+  // We don't care about the value here.
+  // Should StgWeak_value(w) be stg_NO_FINALIZER_closure or something else?
+
+  StgWeak_key(w)        = key;
+  StgWeak_value(w)      = val;
+  StgWeak_finalizer(w)  = stg_NO_FINALIZER_closure;
+  StgWeak_cfinalizer(w) = p;
+
+  StgWeak_link(w)   = W_[weak_ptr_list];
+  W_[weak_ptr_list] = w;
+
+  IF_DEBUG(weak, foreign "C" debugBelch(stg_weak_msg,w) []);
+
+  RET_P(w);
+}
 
 finalizzeWeakzh_fast
 {
   /* R1 = weak ptr
    */
-  W_ w, f;
+  W_ w, f, arr;
 
   w = R1;
 
@@ -342,9 +400,18 @@ finalizzeWeakzh_fast
   SET_INFO(w,stg_DEAD_WEAK_info);
   LDV_RECORD_CREATE(w);
 
-  f = StgWeak_finalizer(w);
+  f   = StgWeak_finalizer(w);
+  arr = StgWeak_cfinalizer(w);
+
   StgDeadWeak_link(w) = StgWeak_link(w);
 
+  if (arr != stg_NO_FINALIZER_closure) {
+    foreign "C" runCFinalizer(StgArrWords_payload(arr,0),
+                              StgArrWords_payload(arr,1),
+                              StgArrWords_payload(arr,2),
+                              StgArrWords_payload(arr,3)) [];
+  }
+
   /* return the finalizer */
   if (f == stg_NO_FINALIZER_closure) {
       RET_NP(0,stg_NO_FINALIZER_closure);

diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index fbebdb9..6abeb40 100644 (file)
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -414,6 +414,9 @@ hs_exit_(rtsBool wait_foreign)
 
     /* stop all running tasks */
     exitScheduler(wait_foreign);
+
+    /* run C finalizers for all active weak pointers */
+    runAllCFinalizers(weak_ptr_list);
     
 #if defined(GRAN)
     /* end_gr_simulation prints global stats if requested -- HWL */

diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm
index 7f7cf78..639ac7e 100644 (file)
--- a/rts/StgMiscClosures.cmm
+++ b/rts/StgMiscClosures.cmm
@@ -435,16 +435,16 @@ INFO_TABLE(stg_TSO, 0,0,TSO, "TSO", "TSO")
    live weak pointers with dead ones).
    ------------------------------------------------------------------------- */
 
-INFO_TABLE(stg_WEAK,0,4,WEAK,"WEAK","WEAK")
+INFO_TABLE(stg_WEAK,1,4,WEAK,"WEAK","WEAK")
 { foreign "C" barf("WEAK object entered!") never returns; }
 
 /*
  * It's important when turning an existing WEAK into a DEAD_WEAK
  * (which is what finalizeWeak# does) that we don't lose the link
  * field and break the linked list of weak pointers.  Hence, we give
- * DEAD_WEAK 4 non-pointer fields, the same as WEAK.
+ * DEAD_WEAK 5 non-pointer fields.
  */
-INFO_TABLE_CONSTR(stg_DEAD_WEAK,0,4,0,CONSTR,"DEAD_WEAK","DEAD_WEAK")
+INFO_TABLE_CONSTR(stg_DEAD_WEAK,0,5,0,CONSTR,"DEAD_WEAK","DEAD_WEAK")
 { foreign "C" barf("DEAD_WEAK object entered!") never returns; }
 
 /* ----------------------------------------------------------------------------

diff --git a/rts/Weak.c b/rts/Weak.c
index e97ff57..a50a72e 100644 (file)
--- a/rts/Weak.c
+++ b/rts/Weak.c
@@ -17,8 +17,38 @@
 #include "RtsAPI.h"
 #include "Trace.h"
 
+// ForeignPtrs with C finalizers rely on weak pointers inside weak_ptr_list
+// to always be in the same order.
+
 StgWeak *weak_ptr_list;
 
+void
+runCFinalizer(StgVoid *fn, StgVoid *ptr, StgVoid *env, StgWord flag)
+{
+    if (flag)
+       ((void (*)(void *, void *))fn)(env, ptr);
+    else
+       ((void (*)(void *))fn)(ptr);
+}
+
+void
+runAllCFinalizers(StgWeak *list)
+{
+    StgWeak *w;
+
+    for (w = list; w; w = w->link) {
+       StgArrWords *farr;
+
+       farr = (StgArrWords *)UNTAG_CLOSURE(w->cfinalizer);
+
+       if ((StgClosure *)farr != &stg_NO_FINALIZER_closure)
+           runCFinalizer((StgVoid *)farr->payload[0],
+                         (StgVoid *)farr->payload[1],
+                         (StgVoid *)farr->payload[2],
+                         farr->payload[3]);
+    }
+}
+
 /*
  * scheduleFinalizers() is called on the list of weak pointers found
  * to be dead after a garbage collection.  It overwrites each object
@@ -45,6 +75,7 @@ scheduleFinalizers(Capability *cap, StgWeak *list)
     // count number of finalizers, and kill all the weak pointers first...
     n = 0;
     for (w = list; w; w = w->link) { 
+       StgArrWords *farr;
 
        // Better not be a DEAD_WEAK at this stage; the garbage
        // collector removes DEAD_WEAKs from the weak pointer list.
@@ -54,6 +85,14 @@ scheduleFinalizers(Capability *cap, StgWeak *list)
            n++;
        }
 
+       farr = (StgArrWords *)UNTAG_CLOSURE(w->cfinalizer);
+
+       if ((StgClosure *)farr != &stg_NO_FINALIZER_closure)
+           runCFinalizer((StgVoid *)farr->payload[0],
+                         (StgVoid *)farr->payload[1],
+                         (StgVoid *)farr->payload[2],
+                         farr->payload[3]);
+
 #ifdef PROFILING
         // A weak pointer is inherently used, so we do not need to call
         // LDV_recordDead().

diff --git a/rts/Weak.h b/rts/Weak.h
index ba8c1ca..cf93b4d 100644 (file)
--- a/rts/Weak.h
+++ b/rts/Weak.h
@@ -11,6 +11,8 @@
 
 #include "Capability.h"
 
+void runCFinalizer(StgVoid *fn, StgVoid *ptr, StgVoid *env, StgWord flag);
+void runAllCFinalizers(StgWeak *w);
 void scheduleFinalizers(Capability *cap, StgWeak *w);
 void markWeakList(void);