Merge pull request #488 from mshinwell/pr7157-4.03-take2

GPR#488: [Attempt to] Fix PR7157 (too many minor collections)

byterun/caml/minor_gc.h

@@ -87,6 +87,7 @@ static inline void add_to_ephe_ref_table (struct caml_ephe_ref_table *tbl,
   ephe_ref = tbl->ptr++;
   ephe_ref->ephe = ar;
   ephe_ref->offset = offset;
+  Assert(ephe_ref->offset < Wosize_val(ephe_ref->ephe));
 }
 
 #endif /* CAML_MINOR_GC_H */

byterun/caml/weak.h

@@ -29,6 +29,7 @@ extern value caml_ephe_none;
        others       2..:  keys;
 
     A weak pointer is an ephemeron with the data at caml_ephe_none
+    If fields are added, don't forget to update weak.ml [additional_values].
  */
 
 #define CAML_EPHE_LINK_OFFSET 0

byterun/minor_gc.c

@@ -85,9 +85,9 @@ static void alloc_generic_table (struct generic_table *tbl, asize_t sz,
   if (tbl->base != NULL) caml_stat_free (tbl->base);
   tbl->base = new_table;
   tbl->ptr = tbl->base;
-  tbl->threshold = tbl->base + tbl->size;
+  tbl->threshold = tbl->base + tbl->size * element_size;
   tbl->limit = tbl->threshold;
-  tbl->end = tbl->base + tbl->size + tbl->reserve;
+  tbl->end = tbl->base + (tbl->size + tbl->reserve) * element_size;
 }
 
 void caml_alloc_table (struct caml_ref_table *tbl, asize_t sz, asize_t rsv)
@@ -280,7 +280,7 @@ void caml_oldify_one (value v, value *p)
 static inline int ephe_check_alive_data(struct caml_ephe_ref_elt *re){
   mlsize_t i;
   value child;
-  for (i = 2; i < Wosize_val(re->ephe); i++){
+  for (i = CAML_EPHE_FIRST_KEY; i < Wosize_val(re->ephe); i++){
     child = Field (re->ephe, i);
     if(child != caml_ephe_none
        && Is_block (child) && Is_young (child)
@@ -371,6 +371,8 @@ void caml_empty_minor_heap (void)
     /* Update the ephemerons */
     for (re = caml_ephe_ref_table.base;
          re < caml_ephe_ref_table.ptr; re++){
+      if(re->offset < Wosize_val(re->ephe)){
+        /* If it is not the case, the ephemeron has been truncated */
         value *key = &Field(re->ephe,re->offset);
         if (*key != caml_ephe_none && Is_block (*key) && Is_young (*key)){
           if (Hd_val (*key) == 0){ /* Value copied to major heap */
@@ -382,7 +384,8 @@ void caml_empty_minor_heap (void)
           }
         }
       }
-    /* Run custom block finalisation of dead minor value */
+    }
+    /* Run custom block finalisation of dead minor values */
     for (r = caml_finalize_table.base; r < caml_finalize_table.ptr; r++){
       int hd = Hd_val ((value)*r);
       if (hd != 0){         /* If not oldified the finalizer must be called */
@@ -520,8 +523,8 @@ static void realloc_generic_table
     if (tbl->base == NULL){
       caml_fatal_error (msg_error);
     }
-    tbl->end = tbl->base + tbl->size + tbl->reserve;
+    tbl->end = tbl->base + (tbl->size + tbl->reserve) * element_size;
-    tbl->threshold = tbl->base + tbl->size;
+    tbl->threshold = tbl->base + tbl->size * element_size;
     tbl->ptr = tbl->base + cur_ptr;
     tbl->limit = tbl->end;
   }

stdlib/weak.ml

@@ -19,7 +19,10 @@ type 'a t;;
 
 external create : int -> 'a t = "caml_weak_create";;
 
-let length x = Obj.size(Obj.repr x) - 2;;
+(** number of additional values in a weak pointer *)
+let additional_values = 2
+
+let length x = Obj.size(Obj.repr x) - additional_values;;
 
 external set : 'a t -> int -> 'a option -> unit = "caml_weak_set";;
 external get : 'a t -> int -> 'a option = "caml_weak_get";;
@@ -162,7 +165,7 @@ module Make (H : Hashtbl.HashedType) : (S with type data = H.t) = struct
         t.table.(t.rover) <- emptybucket;
         t.hashes.(t.rover) <- [| |];
       end else begin
-        Obj.truncate (Obj.repr bucket) (prev_len + 1);
+        Obj.truncate (Obj.repr bucket) (prev_len + additional_values);
         Obj.truncate (Obj.repr hbucket) prev_len;
       end;
       if len > t.limit && prev_len <= t.limit then t.oversize <- t.oversize - 1;