Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fix PR7157 (too many minor collections)

master
Mark Shinwell 2016-02-29 12:17:45 +00:00
parent e14e85b992
commit fb84058720
4 changed files with 24 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
byterun/caml/minor_gc.h
View File

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

1
byterun/caml/weak.h
View File

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

31
byterun/minor_gc.c
View File

@ -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,18 +371,21 @@ void caml_empty_minor_heap (void)
/* Update the ephemerons */
for (re = caml_ephe_ref_table.base;
re < caml_ephe_ref_table.ptr; re++){
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 */
*key = Field (*key, 0);
}else{ /* Value not copied so it's dead */
Assert(!ephe_check_alive_data(re));
*key = caml_ephe_none;
Field(re->ephe,1) = caml_ephe_none;
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 */
*key = Field (*key, 0);
}else{ /* Value not copied so it's dead */
Assert(!ephe_check_alive_data(re));
*key = caml_ephe_none;
Field(re->ephe,1) = caml_ephe_none;
}
}
}
}
/* 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->threshold = tbl->base + tbl->size;
tbl->end = tbl->base + (tbl->size + tbl->reserve) * element_size;
tbl->threshold = tbl->base + tbl->size * element_size;
tbl->ptr = tbl->base + cur_ptr;
tbl->limit = tbl->end;
}

7
stdlib/weak.ml
View File

@ -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;