Merge from diff ocaml3100/ocaml3102: cvs update -j ocaml3100 -j ocaml3102 -kkcducetrunk

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/cducetrunk@8864 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 58 insertions, 8 deletions

diff --git a/byterun/weak.c b/byterun/weak.c
index 0cea2a6dc3..5673faef56 100644
--- a/byterun/weak.c
+++ b/byterun/weak.c
@@ -45,6 +45,24 @@ CAMLprim value caml_weak_create (value len)
 #define None_val (Val_int(0))
 #define Some_tag 0
 
+static void do_set (value ar, mlsize_t offset, value v)
+{
+  if (Is_block (v) && Is_young (v)){
+    /* modified version of Modify */
+    value old = Field (ar, offset);
+    Field (ar, offset) = v;
+    if (!(Is_block (old) && Is_young (old))){
+      if (caml_weak_ref_table.ptr >= caml_weak_ref_table.limit){
+        CAMLassert (caml_weak_ref_table.ptr == caml_weak_ref_table.limit);
+        caml_realloc_ref_table (&caml_weak_ref_table);
+      }
+      *caml_weak_ref_table.ptr++ = &Field (ar, offset);
+    }
+  }else{
+    Field (ar, offset) = v;
+  }
+}
+
 CAMLprim value caml_weak_set (value ar, value n, value el)
 {
   mlsize_t offset = Long_val (n) + 1;
@@ -52,15 +70,11 @@ CAMLprim value caml_weak_set (value ar, value n, value el)
   if (offset < 1 || offset >= Wosize_val (ar)){
     caml_invalid_argument ("Weak.set");
   }
-  Field (ar, offset) = caml_weak_none;
   if (el != None_val){
-    value v;                                  Assert (Wosize_val (el) == 1);
-    v = Field (el, 0);
-    if (Is_block (v) && (Is_young (v) || Is_in_heap (v))){
-      Modify (&Field (ar, offset), v);
-    }else{
-      Field (ar, offset) = v;
-    }
+                                              Assert (Wosize_val (el) == 1);
+    do_set (ar, offset, Field (el, 0));
+  }else{
+    Field (ar, offset) = caml_weak_none;
   }
   return Val_unit;
 }
@@ -141,3 +155,39 @@ CAMLprim value caml_weak_check (value ar, value n)
   }
   return Val_bool (Field (ar, offset) != caml_weak_none);
 }
+
+CAMLprim value caml_weak_blit (value ars, value ofs,
+                               value ard, value ofd, value len)
+{
+  mlsize_t offset_s = Long_val (ofs) + 1;
+  mlsize_t offset_d = Long_val (ofd) + 1;
+  mlsize_t length = Long_val (len);
+  long i;
+                                                   Assert (Is_in_heap (ars));
+                                                   Assert (Is_in_heap (ard));
+  if (offset_s < 1 || offset_s + length > Wosize_val (ars)){
+    caml_invalid_argument ("Weak.blit");
+  }
+  if (offset_d < 1 || offset_d + length > Wosize_val (ard)){
+    caml_invalid_argument ("Weak.blit");
+  }
+  if (caml_gc_phase == Phase_mark && caml_gc_subphase == Subphase_weak1){
+    for (i = 0; i < length; i++){
+      value v = Field (ars, offset_s + i);
+      if (v != caml_weak_none && Is_block (v) && Is_in_heap (v)
+          && Is_white_val (v)){
+        Field (ars, offset_s + i) = caml_weak_none;
+      }
+    }
+  }
+  if (offset_d < offset_s){
+    for (i = 0; i < length; i++){
+      do_set (ard, offset_d + i, Field (ars, offset_s + i));
+    }
+  }else{
+    for (i = length - 1; i >= 0; i--){
+      do_set (ard, offset_d + i,  Field (ars, offset_s + i));
+    }
+  }
+  return Val_unit;
+}