mfp / ocaml-finite-maps

Imperative and functional finite map implementations, head to head

This URL has Read+Write access

ocaml-finite-maps / size.ml
100644 106 lines (81 sloc) 3.232 kb
raw blame history 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106

(**************************************************************************)
(*                                                                        *)
(*  Copyright (C) Jean-Christophe Filliatre                               *)
(*                                                                        *)
(*  This software is free software; you can redistribute it and/or        *)
(*  modify it under the terms of the GNU Library General Public           *)
(*  License version 2.1, with the special exception on linking            *)
(*  described in file LICENSE.                                            *)
(*                                                                        *)
(*  This software is distributed in the hope that it will be useful,      *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
(*                                                                        *)
(**************************************************************************)
 
(*i $Id: size.ml,v 1.7 2008-07-21 14:53:06 filliatr Exp $ i*)
 
(*i*)
open Obj
(*i*)
 
(*s Pointers already visited are stored in a hash-table, where
    comparisons are done using physical equality. *)
 
module H = Hashtbl.Make(
  struct 
    type t = Obj.t 
    let equal = (==) 
    let hash o = Hashtbl.hash (magic o : int)
  end)
 
let node_table = (H.create 257 : unit H.t)
 
let in_table o = try H.find node_table o; true with Not_found -> false
 
let add_in_table o = H.add node_table o ()
 
let reset_table () = H.clear node_table
 
 
(*
module H = Hashtbl
 
let node_table = H.create 257
 
let in_table o =
  try
    List.exists ((==) o) (H.find_all node_table o)
  with Not_found -> false
 
let add_in_table o = H.add node_table o o
 
let reset_table () = H.clear node_table
 *)
 
(*s Objects are traversed recursively, as soon as their tags are less than
    [no_scan_tag]. [count] records the numbers of words already visited. *)
 
let size_of_double = size (repr 1.0)
 
let count = ref 0
 
let rec traverse t =
  if not (in_table t) then begin
    add_in_table t;
    if is_block t then begin
      let n = size t in
      let tag = tag t in
      if tag < no_scan_tag then begin
	count := !count + 1 + n;
	for i = 0 to n - 1 do
      	  let f = field t i in 
	  if is_block f then traverse f
	done
      end else if tag = string_tag then
	count := !count + 1 + n 
      else if tag = double_tag then
	count := !count + size_of_double
      else if tag = double_array_tag then
	count := !count + 1 + size_of_double * n 
      else
	incr count
    end
  end
 
(*s Sizes of objects in words and in bytes. The size in bytes is computed
    system-independently according to [Sys.word_size]. *)
 
let size_w o =
  reset_table ();
  let gc_params = Gc.get () in
    (* prevent compaction, so value in major heap won't move *)
    Gc.set { gc_params with Gc.max_overhead = 10_000_000 };
    (* move values to major heap, so no value is changed by the GC anymore *)
    Gc.minor ();
    count := 0;
    traverse (repr o);
    Gc.set gc_params;
    !count
 
let size_b o = (size_w o) * (Sys.word_size / 8)
 
let size_kb o = (size_w o) / (8192 / Sys.word_size)