Version franÁaise
Home ††† About ††† Download ††† Resources ††† Contact us †††

This site is updated infrequently. For up-to-date information, please visit the new OCaml website at

Browse thread
Questions on replacing finalizers and memory footprints
[ Home ] [ Index: by date | by threads ]
[ Search: ]

[ Message by date: previous | next ] [ Message in thread: previous | next ] [ Thread: previous | next ]
Date: 2007-12-08 (14:20)
From: Benjamin Canou <benjamin.canou@g...>
Subject: Re: [Caml-list] Questions on replacing finalizers and memory footprints

Another solution (not safe if the value is used at the same time in
another thread or signal handler however) is to modify the value while
exploring it.

Here is the principle :
When you explore a block node b, you replace its first field with a
special block saying "I've not restored this node, the original first
field is v" (a tuple (false, v) with a special tag) and you call the
recursive size function on v and remaining fields of b; when you explore
this block again, you don't call the recursive function since the first
field is a special block.
When the calculation is done, you explore the value again, and when you
find a block b with a special block (false, v) as first field, you set
its status to "I'm restoring this block", you call the recursive
reconstruction on v and replace the first field of b with v in the end;
otherwise, you do nothing.

Here is the code, but it does only handle simple blocks (not strings,
etc.) Also since one cannot mark blocks easily, I use a high block tag
which should not occur in most programs, but the code in totally unsafe
and can destroy the value if it is the case. A safer way could be to use
ad hoc custom blocks. As said in caps lock at the beginning of many
source files : "use at your own risk, no warranty"...

open Obj

(* the special tag is 240 , not safe if used in v *)
let calc_size v =
  let rec calc_size v =
    if is_int v then 1 else (
      if size v >= 1 then (
	let v0 = field v 0 in
	  if is_int v0 || tag v0 <> 240 then (
	    let s = ref (size v + 1 (* header *)) in
	    let d = new_block 240 2 in
	      set_field v 0 d ;
	      set_field d 0 (repr false) ;
	      set_field d 1 v0 ;
	      if is_block v0 then
		s := !s + calc_size v0;
	      for i = 1 to size v - 1 do
		if is_block (field v i) then
		  s := !s + calc_size (field v i)
	      done ;
	  ) else 0
      ) else 0 (* atoms are preallocated *)
    ) in
  let rec restore v =
    if is_block v then (
      if size v >= 1 then (
	let v0 = field v 0 in
	  if is_block v0 && tag v0 == 240 then (
	    if field v0 0 = repr false then (
	      set_field v0 0 (repr true) ;
	      restore (field v0 1) ;
	      for i = 1 to size v - 1 do
		restore (field v i) ;
	      done ;
	      set_field v 0 (field v0 1)
    ) in
  let size = calc_size v in restore v ; size


PS: My code is not much tested, if you find bugs and/or enhance it with
strings, doubles, etc., I'm interested.

Le samedi 08 décembre 2007 à 10:57 +0100, Alexandre Pilkiewicz a écrit :
> Le Friday 07 December 2007 22:01:23, vous avez écrit :
> > Le 7 d√©c. 07 √† 20:54, Jean-Christophe Filli√Ętre a √©crit :
> > My mistake, I did not take into account the fact that if a block is
> > moved by the
> > garbage collector, its reference is updated in the hashtable *too*.
> > Hence the termination guarantee.
> I think the problem is with the hash function :
> 	let hash o = Hashtbl.hash (magic o : int)
> If you put an object in the hash table, it is stored under a key that depends 
> on it's address a1. Once it's moved by the GC to the address a2, its 
> reference is changed to a2, but not its key which is still the hash of a1. So 
> when you check after that if your object is allready in the hash table, you 
> look under the key hash(a2) if it's allready there, but it's not ! And if you 
> are very unlucky (and have very few memory), it might append several time.
> One solution could be to store the objects in a normal list and to look at the 
> entire list every time. It would be *much* slower on huge structures, but 
> probably more "correct" (so if used only for debug purpose, why not..)
> let node_list = ref []
> let in_list o = List.memq o !node_list
> let add_in_list o = node_list := o::!node_list
> let reset_list () = node_list := []