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, 16 insertions, 8 deletions

diff --git a/byterun/finalise.c b/byterun/finalise.c
index e411311489..5a9c0c07f6 100644
--- a/byterun/finalise.c
+++ b/byterun/finalise.c
@@ -24,6 +24,7 @@
 struct final {
   value fun;
   value val;
+  int offset;
 };
 
 static struct final *final_table = NULL;
@@ -67,7 +68,7 @@ void caml_final_update (void)
 {
   uintnat i, j, k;
   uintnat todo_count = 0;
-  
+
   Assert (young == old);
   for (i = 0; i < old; i++){
     Assert (Is_block (final_table[i].val));
@@ -84,7 +85,9 @@ void caml_final_update (void)
       Assert (Is_in_heap (final_table[i].val));
       if (Is_white_val (final_table[i].val)){
         if (Tag_val (final_table[i].val) == Forward_tag){
-          value fv = Forward_val (final_table[i].val);
+          value fv;
+          Assert (final_table[i].offset == 0);
+          fv = Forward_val (final_table[i].val);
           if (Is_block (fv) && (Is_young (fv) || Is_in_heap (fv))
               && (Tag_val (fv) == Forward_tag || Tag_val (fv) == Lazy_tag
                   || Tag_val (fv) == Double_tag)){
@@ -136,7 +139,7 @@ void caml_final_do_calls (void)
       -- to_do_hd->size;
       f = to_do_hd->item[to_do_hd->size];
       running_finalisation_function = 1;
-      caml_callback (f.fun, f.val);
+      caml_callback (f.fun, f.val + f.offset);
       running_finalisation_function = 0;
     }
     caml_gc_message (0x80, "Done calling finalisation functions.\n", 0);
@@ -159,7 +162,7 @@ void caml_final_do_strong_roots (scanning_action f)
 
   Assert (old == young);
   for (i = 0; i < old; i++) Call_action (f, final_table[i].fun);
-  
+
   for (todo = to_do_hd; todo != NULL; todo = todo->next){
     for (i = 0; i < todo->size; i++){
       Call_action (f, todo->item[i].fun);
@@ -186,7 +189,7 @@ void caml_final_do_weak_roots (scanning_action f)
 void caml_final_do_young_roots (scanning_action f)
 {
   uintnat i;
-  
+
   Assert (old <= young);
   for (i = old; i < young; i++){
     Call_action (f, final_table[i].fun);
@@ -210,7 +213,7 @@ CAMLprim value caml_final_register (value f, value v)
     caml_invalid_argument ("Gc.finalise");
   }
   Assert (old <= young);
-  
+
   if (young >= size){
     if (final_table == NULL){
       uintnat new_size = 30;
@@ -227,8 +230,13 @@ CAMLprim value caml_final_register (value f, value v)
   }
   Assert (young < size);
   final_table[young].fun = f;
-  if (Tag_val (v) == Infix_tag) v -= Infix_offset_val (v);
-  final_table[young].val = v;
+  if (Tag_val (v) == Infix_tag){
+    final_table[young].offset = Infix_offset_val (v);
+    final_table[young].val = v - Infix_offset_val (v);
+  }else{
+    final_table[young].offset = 0;
+    final_table[young].val = v;
+  }
   ++ young;
 
   return Val_unit;