summaryrefslogtreecommitdiff
path: root/lib/cObj.ml
diff options
context:
space:
mode:
authorGravatar Benjamin Barenblat <bbaren@debian.org>2018-12-29 14:31:27 -0500
committerGravatar Benjamin Barenblat <bbaren@debian.org>2018-12-29 14:31:27 -0500
commit9043add656177eeac1491a73d2f3ab92bec0013c (patch)
tree2b0092c84bfbf718eca10c81f60b2640dc8cab05 /lib/cObj.ml
parenta4c7f8bd98be2a200489325ff7c5061cf80ab4f3 (diff)
Imported Upstream version 8.8.2upstream/8.8.2
Diffstat (limited to 'lib/cObj.ml')
-rw-r--r--lib/cObj.ml203
1 files changed, 0 insertions, 203 deletions
diff --git a/lib/cObj.ml b/lib/cObj.ml
deleted file mode 100644
index 7f3ee185..00000000
--- a/lib/cObj.ml
+++ /dev/null
@@ -1,203 +0,0 @@
-(***********************************************************************)
-(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *)
-(* \VV/ *************************************************************)
-(* // * This file is distributed under the terms of the *)
-(* * GNU Lesser General Public License Version 2.1 *)
-(***********************************************************************)
-
-(*s Logical and physical size of ocaml values. *)
-
-(** {6 Logical sizes} *)
-
-let c = ref 0
-let s = ref 0
-let b = ref 0
-let m = ref 0
-
-let rec obj_stats d t =
- if Obj.is_int t then m := max d !m
- else if Obj.tag t >= Obj.no_scan_tag then
- if Obj.tag t = Obj.string_tag then
- (c := !c + Obj.size t; b := !b + 1; m := max d !m)
- else if Obj.tag t = Obj.double_tag then
- (s := !s + 2; b := !b + 1; m := max d !m)
- else if Obj.tag t = Obj.double_array_tag then
- (s := !s + 2 * Obj.size t; b := !b + 1; m := max d !m)
- else (b := !b + 1; m := max d !m)
- else
- let n = Obj.size t in
- s := !s + n; b := !b + 1;
- block_stats (d + 1) (n - 1) t
-
-and block_stats d i t =
- if i >= 0 then (obj_stats d (Obj.field t i); block_stats d (i-1) t)
-
-let obj_stats a =
- c := 0; s:= 0; b:= 0; m:= 0;
- obj_stats 0 (Obj.repr a);
- (!c, !s + !b, !m)
-
-(** {6 Physical sizes} *)
-
-(*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 = Hashtbl.hash
- 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
-
-(*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 = Obj.size (Obj.repr 1.0)
-
-let count = ref 0
-
-let rec traverse t =
- if not (in_table t) && Obj.is_block t then begin
- add_in_table t;
- let n = Obj.size t in
- let tag = Obj.tag t in
- if tag < Obj.no_scan_tag then
- begin
- count := !count + 1 + n;
- for i = 0 to n - 1 do traverse (Obj.field t i) done
- end
- else if tag = Obj.string_tag then
- count := !count + 1 + n
- else if tag = Obj.double_tag then
- count := !count + size_of_double
- else if tag = Obj.double_array_tag then
- count := !count + 1 + size_of_double * n
- else
- incr count
- 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 o =
- reset_table ();
- count := 0;
- traverse (Obj.repr o);
- !count
-
-let size_b o = (size o) * (Sys.word_size / 8)
-
-let size_kb o = (size o) / (8192 / Sys.word_size)
-
-(** {6 Physical sizes with sharing} *)
-
-(** This time, all the size of objects are computed with respect
- to a larger object containing them all, and we only count
- the new blocks not already seen earlier in the left-to-right
- visit of the englobing object.
-
- The very same object could have a zero size or not, depending
- of the occurrence we're considering in the englobing object.
- For speaking of occurrences, we use an [int list] for a path
- of field indexes from the outmost block to the one we're looking.
- In the list, the leftmost integer is the field index in the deepest
- block.
-*)
-
-(** We now store in the hashtable the size (with sharing), and
- also the position of the first occurrence of the object *)
-
-let node_sizes = (H.create 257 : (int*int list) H.t)
-let get_size o = H.find node_sizes o
-let add_size o n pos = H.replace node_sizes o (n,pos)
-let reset_sizes () = H.clear node_sizes
-let global_object = ref (Obj.repr 0)
-
-(** [sum n f] is [f 0 + f 1 + ... + f (n-1)], evaluated from left to right *)
-
-let sum n f =
- let rec loop k acc = if k >= n then acc else loop (k+1) (acc + f k)
- in loop 0 0
-
-(** Recursive visit of the main object, filling the hashtable *)
-
-let rec compute_size o pos =
- if not (Obj.is_block o) then 0
- else
- try
- let _ = get_size o in 0 (* already seen *)
- with Not_found ->
- let n = Obj.size o in
- add_size o (-1) pos (* temp size, for cyclic values *);
- let tag = Obj.tag o in
- let size =
- if tag < Obj.no_scan_tag then
- 1 + n + sum n (fun i -> compute_size (Obj.field o i) (i::pos))
- else if tag = Obj.string_tag then
- 1 + n
- else if tag = Obj.double_tag then
- size_of_double
- else if tag = Obj.double_array_tag then
- size_of_double * n
- else
- 1
- in
- add_size o size pos;
- size
-
-(** Provides the global object in which we'll search shared sizes *)
-
-let register_shared_size t =
- let o = Obj.repr t in
- reset_sizes ();
- global_object := o;
- ignore (compute_size o [])
-
-(** Shared size of an object with respect to the global object given
- by the last [register_shared_size] *)
-
-let shared_size pos o =
- if not (Obj.is_block o) then 0
- else
- let size,pos' =
- try get_size o
- with Not_found -> failwith "shared_size: unregistered structure ?"
- in
- match pos with
- | Some p when p <> pos' -> 0
- | _ -> size
-
-let shared_size_of_obj t = shared_size None (Obj.repr t)
-
-(** Shared size of the object at some positiion in the global object given
- by the last [register_shared_size] *)
-
-let shared_size_of_pos pos =
- let rec obj_of_pos o = function
- | [] -> o
- | n::pos' ->
- let o' = obj_of_pos o pos' in
- assert (Obj.is_block o' && n < Obj.size o');
- Obj.field o' n
- in
- shared_size (Some pos) (obj_of_pos !global_object pos)
-
-
-(*s Total size of the allocated ocaml heap. *)
-
-let heap_size () =
- let stat = Gc.stat ()
- and control = Gc.get () in
- let max_words_total = stat.Gc.heap_words + control.Gc.minor_heap_size in
- (max_words_total * (Sys.word_size / 8))
-
-let heap_size_kb () = (heap_size () + 1023) / 1024