+++ /dev/null
-let time f a msg =
- let t0 = Unix.gettimeofday () in
- let r = f a in
- let t1 = Unix.gettimeofday () in
- Printf.printf "Timing %s: %f ms\n" msg ((t1 -. t0) *. 1000.);
- r
-
-
-
-type pointers
-type allocation_order = PREORDER | INORDER | POSTORDER
-external build_pointers : Tree.t -> allocation_order -> pointers = "caml_build_pointers"
-external iter_pointers : pointers -> int = "caml_iter_pointers"
-external free_pointers : pointers -> unit = "caml_free_pointers"
-
-let string_of_alloc =
- function
- PREORDER -> "preorder"
- | INORDER -> "inorder"
- | POSTORDER -> "postorder"
-
-
-let test_pointers alloc v =
- let size = Tree.subtree_size v Tree.root in
- if ((size * (Sys.word_size/8)*2) / (1024*1024)) >= 2800
- then Printf.printf "Not enough memory to allocate pointer with %i nodes\n%!" size
- else begin
- let msg1 = Printf.sprintf "pointer structure %s allocation" (string_of_alloc alloc) in
- let pointers = time (build_pointers v) alloc msg1 in
- let i = time (iter_pointers) pointers "pointer structure full traversal" in
- Printf.printf "Traversed %i nodes\n" i;
- time (free_pointers) pointers "pointer structure deallocation"
- end
-;;
-
-let test_iterative v =
- let i = time (Tree.benchmark_iter) v "iterative traversal (on sxsi)" in
- Printf.printf "Traversed %i nodes\n%!" i
-
-let test_full_traversal v =
- let i = time (Tree.benchmark_fcns) v "recursive traversal (on sxsi)" in
- Printf.printf "Traversed %i nodes\n%!" i
-
-let test_full_elements v =
- let i = time (Tree.benchmark_fene) v "recursive traversal of element nodes (on sxsi)" in
- Printf.printf "Traversed %i nodes\n%!" i
-
-let test_tag_jump v t =
- let msg = Printf.sprintf "jumping to tag <%s> (on sxsi)" (Tag.to_string t) in
- let i = time (Tree.benchmark_jump v) t msg in
- Printf.printf "Traversed %i nodes\n%!" i
-
-
-module Options =
- struct
- open Arg
- let input_file = ref ""
- let save_file = ref ""
- let run_iterative = ref false
- let run_full_sxsi = ref false
- let run_elements = ref false
- let run_pointers = ref []
- let run_jump_tag = ref ""
-
- let add_pointer t =
- let tag = match t with
- | "preorder" -> PREORDER
- | "inorder" -> INORDER
- | "postorder" -> POSTORDER
- | _ -> raise (Bad (t))
- in
- if not (List.mem tag !run_pointers) then run_pointers := tag :: !run_pointers
-
-
- let spec = align
- [ "-s", Set_string save_file, "<output.srx> saves the index in file output.srx";
- "-i", Set run_iterative, " runs the iterative full traversal (on sxsi)";
- "-f", Set run_full_sxsi, " runs the recursive full traversal (on sxsi)";
- "-e", Set run_elements, " simulates //* on sxsi";
- "-p", Symbol ([ "preorder"; "inorder"; "postorder" ],
- add_pointer), "runs a full traveral over pointers with given allocation scheme";
- "-t", Set_string run_jump_tag, "<tag> simulates //tag on sxsi" ]
-
- let usage_msg = Printf.sprintf "%s [options] <input.{xml|srx}>" Sys.argv.(0)
- let parse () = parse spec (fun s -> input_file := s) usage_msg
- let usage () = usage spec usage_msg
- end
-
-let fail msg = Printf.eprintf "error: %s%!" msg; Options.usage (); exit 1
-
-let line () = Printf.printf "\n%!"
-
-let main () =
- Options.parse ();
- if !Options.input_file = "" then fail "missing input file";
- let ifile = !Options.input_file in
- let doc =
- if Filename.check_suffix ifile ".srx" then
- Tree.load ifile
- else Tree.parse_xml_uri ifile in
- if !Options.save_file <> "" then begin
- Printf.printf "Saving index to %s ... %!" !Options.save_file;
- Tree.save doc !Options.save_file;
- Printf.printf "done\n%!"
- end;
- Tag.init (Tree.tag_pool doc);
- line ();
- if !Options.run_iterative then (test_iterative doc; line ());
-
- if !Options.run_full_sxsi then (test_full_traversal doc; line ());
-
- if !Options.run_elements then (test_full_elements doc; line ());
-
- if !Options.run_jump_tag <> "" then (test_tag_jump doc (Tag.tag !Options.run_jump_tag);
- line ());
-
- if !Options.run_pointers <> [] then
- List.iter (fun s -> test_pointers s doc; line ())
- !Options.run_pointers;
-
- exit 0
-;;
-
-let _ =
- let () = Printexc.record_backtrace true in
- try
- main ()
- with
- _ ->
- let msg = Printexc.get_backtrace () in
- Printf.eprintf "%s\n%!" msg;
- exit 3
-
-