More microbenchmarks

benchmarks/simple-tests/alloc.ml

@@ -1,13 +1,13 @@
-let words_to_allocate = 10000000.
+let iterations = 1000000
 
 type a_mutable_record = { an_int : int; mutable a_string : string ; a_float: float } 
 
 let rec create f n =
   match n with 
   | 0 -> ()
   | _ -> let _ = f() in
-    create f (n-1)
+  create f (n-1)
 
-let () = while (Gc.minor_words() < words_to_allocate) do
-    create (fun () -> { an_int = 5; a_string = "foo"; a_float = 0.1 }) 1000
-  done
+let () = for _ = 0 to iterations do
+  Sys.opaque_identity create (fun () -> { an_int = 5; a_string = "foo"; a_float = 0.1 }) 1000
+done

benchmarks/simple-tests/capi.ml

@@ -0,0 +1,15 @@
+let test_name = Sys.argv.(1)
+
+let run_many_times f =
+    for _ = 1 to 1_000_000_000 do
+      ignore(Sys.opaque_identity f ())
+    done
+
+let () = match test_name with
+    | "test_no_args_alloc" -> run_many_times (fun _ -> Ocamlcapi.test_no_args_alloc())
+    | "test_no_args_noalloc" -> run_many_times (fun _ -> Ocamlcapi.test_no_args_noalloc())
+    | "test_few_args_alloc" -> run_many_times (fun _ -> Ocamlcapi.test_few_args_alloc 1)
+    | "test_few_args_noalloc" -> run_many_times (fun _ -> Ocamlcapi.test_few_args_noalloc 2)
+    | "test_many_args_alloc" -> run_many_times (fun _ -> Ocamlcapi.test_many_args_alloc 1 2 3 4 5 6 7)
+    | "test_many_args_noalloc" -> run_many_times (fun _ -> Ocamlcapi.test_many_args_noalloc 1 2 3 4 5 6 7)
+    | _ -> failwith "unexpected test name"

benchmarks/simple-tests/dune

@@ -1,12 +1,24 @@
 (include lists-dune.inc)
 (include stress-dune.inc)
+(include stacks-dune.inc)
+(include ocamlcapi-dune.inc)
+(include lazy-dune.inc)
+(include weak-dune.inc)
+(include finalise-dune.inc)
 
 (executables
  (names alloc) (modules alloc))
 
+ (executables (names morestacks) (modules morestacks))
+
+ (rule
+ (targets morestacks.bench)
+ (deps (:prog morestacks.exe))
+ (action (run orun -o %{targets} -- %{prog})))
+
 (rule
  (targets alloc.bench)
  (deps (:prog alloc.exe))
  (action (run orun -o %{targets} -- %{prog})))
 
-(alias (name bench) (deps alloc.bench))
+(alias (name bench) (deps alloc.bench morestacks.bench))

benchmarks/simple-tests/finalise-dune.inc

@@ -0,0 +1,44 @@
+(executable (name finalise) (modules finalise))
+
+(rule
+         (targets finalise.10.bench)
+          (deps (:prog finalise.exe))
+           (action (run orun -o %{targets} -- %{prog} 10)))
+(rule
+         (targets finalise.20.bench)
+          (deps (:prog finalise.exe))
+           (action (run orun -o %{targets} -- %{prog} 20)))
+(rule
+         (targets finalise.30.bench)
+          (deps (:prog finalise.exe))
+           (action (run orun -o %{targets} -- %{prog} 30)))
+(rule
+         (targets finalise.40.bench)
+          (deps (:prog finalise.exe))
+           (action (run orun -o %{targets} -- %{prog} 40)))
+(rule
+         (targets finalise.50.bench)
+          (deps (:prog finalise.exe))
+           (action (run orun -o %{targets} -- %{prog} 50)))
+(rule
+         (targets finalise.60.bench)
+          (deps (:prog finalise.exe))
+           (action (run orun -o %{targets} -- %{prog} 60)))
+(rule
+         (targets finalise.70.bench)
+          (deps (:prog finalise.exe))
+           (action (run orun -o %{targets} -- %{prog} 70)))
+(rule
+         (targets finalise.80.bench)
+          (deps (:prog finalise.exe))
+           (action (run orun -o %{targets} -- %{prog} 80)))
+(rule
+         (targets finalise.90.bench)
+          (deps (:prog finalise.exe))
+           (action (run orun -o %{targets} -- %{prog} 90)))
+(rule
+         (targets finalise.100.bench)
+          (deps (:prog finalise.exe))
+           (action (run orun -o %{targets} -- %{prog} 100)))
+
+(alias (name bench) (deps finalise.10.bench finalise.20.bench finalise.30.bench finalise.40.bench finalise.50.bench finalise.60.bench finalise.70.bench finalise.80.bench finalise.90.bench finalise.100.bench))

benchmarks/simple-tests/finalise.ml

@@ -0,0 +1,19 @@
+let percent_finalize = int_of_string Sys.argv.(1)
+let iterations = 10000
+
+let () = Random.init 42
+
+type a_record = { an_int: int; mutable a_string : string; a_float : float }
+
+let allocate () =
+  for _ = 0 to 1000 do
+    let v = { an_int = 5; a_string = "foo"; a_float = 0.0 } in
+    if Random.int 100 < percent_finalize then
+      Gc.finalise (fun n -> ignore(Sys.opaque_identity (n.an_int+1))) v
+    else
+      ignore(Sys.opaque_identity ref v)
+  done
+
+let () = for _ = 0 to iterations do
+  allocate()
+  done

benchmarks/simple-tests/lazy-dune.inc

@@ -0,0 +1,20 @@
+(executable (name lazylist) (modules lazylist))
+
+(rule
+        (targets lazylist.500000.100.bench)
+        (deps (:prog lazylist.exe))
+        (action (run orun -o %{targets} -- %{prog} 500000 100)))
+(rule
+        (targets lazylist.50000.1000.bench)
+        (deps (:prog lazylist.exe))
+        (action (run orun -o %{targets} -- %{prog} 50000 1000)))
+(rule
+        (targets lazylist.5000.10000.bench)
+        (deps (:prog lazylist.exe))
+        (action (run orun -o %{targets} -- %{prog} 5000 10000)))
+(rule
+        (targets lazylist.500.100000.bench)
+        (deps (:prog lazylist.exe))
+        (action (run orun -o %{targets} -- %{prog} 500 100000)))
+
+(alias (name bench) (deps lazylist.500000.100.bench lazylist.50000.1000.bench lazylist.5000.10000.bench lazylist.500.100000.bench))

benchmarks/simple-tests/lazylist.ml

@@ -0,0 +1,19 @@
+let list_length = int_of_string Sys.argv.(1)
+let iterations = int_of_string Sys.argv.(2)
+
+let rec add_lazy l n =
+  if n == 0 then
+    l
+  else
+    let new_head = lazy (1 + (Lazy.force (List.hd l))) in
+    new_head :: add_lazy l (n-1)
+
+let create_list () =
+  add_lazy [Lazy.from_val 0] list_length
+
+let () = 
+  for _ = 0 to iterations do
+    let l = create_list() in
+    let list_head = List.hd l in
+    ignore(Sys.opaque_identity Lazy.force list_head)
+  done

benchmarks/simple-tests/lists-dune.inc

@@ -84,5 +84,29 @@
          (targets lists.float-array.120000.bench)
           (deps (:prog lists.exe))
            (action (run orun -o %{targets} -- %{prog} float-array 120000)))
+(rule
+         (targets lists.int-array.1.bench)
+          (deps (:prog lists.exe))
+           (action (run orun -o %{targets} -- %{prog} int-array 1)))
+(rule
+         (targets lists.int-array.10000.bench)
+          (deps (:prog lists.exe))
+           (action (run orun -o %{targets} -- %{prog} int-array 10000)))
+(rule
+         (targets lists.int-array.120000.bench)
+          (deps (:prog lists.exe))
+           (action (run orun -o %{targets} -- %{prog} int-array 120000)))
+(rule
+         (targets lists.int-option-array.1.bench)
+          (deps (:prog lists.exe))
+           (action (run orun -o %{targets} -- %{prog} int-option-array 1)))
+(rule
+         (targets lists.int-option-array.10000.bench)
+          (deps (:prog lists.exe))
+           (action (run orun -o %{targets} -- %{prog} int-option-array 10000)))
+(rule
+         (targets lists.int-option-array.120000.bench)
+          (deps (:prog lists.exe))
+           (action (run orun -o %{targets} -- %{prog} int-option-array 120000)))
 
-(alias (name bench) (deps lists.int.1.bench lists.int.10000.bench lists.int.120000.bench lists.float.1.bench lists.float.10000.bench lists.float.120000.bench lists.int-tuple.1.bench lists.int-tuple.10000.bench lists.int-tuple.120000.bench lists.float-tuple.1.bench lists.float-tuple.10000.bench lists.float-tuple.120000.bench lists.string.1.bench lists.string.10000.bench lists.string.120000.bench lists.record.1.bench lists.record.10000.bench lists.record.120000.bench lists.float-array.1.bench lists.float-array.10000.bench lists.float-array.120000.bench))
+(alias (name bench) (deps lists.int.1.bench lists.int.10000.bench lists.int.120000.bench lists.float.1.bench lists.float.10000.bench lists.float.120000.bench lists.int-tuple.1.bench lists.int-tuple.10000.bench lists.int-tuple.120000.bench lists.float-tuple.1.bench lists.float-tuple.10000.bench lists.float-tuple.120000.bench lists.string.1.bench lists.string.10000.bench lists.string.120000.bench lists.record.1.bench lists.record.10000.bench lists.record.120000.bench lists.float-array.1.bench lists.float-array.10000.bench lists.float-array.120000.bench lists.int-array.1.bench lists.int-array.10000.bench lists.int-array.120000.bench lists.int-option-array.1.bench lists.int-option-array.10000.bench lists.int-option-array.120000.bench))

benchmarks/simple-tests/lists.ml

@@ -1,27 +1,27 @@
 let data_type = Sys.argv.(1)
 let list_length = int_of_string Sys.argv.(2)
-let words_to_allocate = 1000000000.
+let iterations = 10000000 / list_length
 
-type a_mutable_record = { mutable an_int : int; a_string : string ; a_float: float } 
+type a_mutable_record = { mutable an_int : int; a_string : string ; a_float: float }
 
 let rec create_list f n = match n with
   | 0 -> []
   | _ -> (f n) :: (create_list f (n-1))
 
 let allocate_list () =
   match data_type with
-  | "int" -> ignore (create_list (fun n -> (n+1)) list_length)
-  | "float" -> ignore (create_list (fun n -> float_of_int n) list_length)
-  | "int-tuple" -> ignore (create_list (fun n -> (n-1,n+1)) list_length)
-  | "float-tuple" -> ignore (create_list (fun n -> ((float_of_int (n+1)), (float_of_int (n-1)))) list_length)
-  | "string" -> ignore (create_list (fun n -> (string_of_int n)) list_length)
-  | "record" -> ignore (create_list (fun n -> { an_int = n; a_string = (string_of_int n); a_float = (float_of_int n)}) list_length)
-  | "float-array" -> ignore (create_list (fun n -> [| (float_of_int n), (float_of_int n), (float_of_int n) |]) list_length)
+  | "int" -> ignore (Sys.opaque_identity create_list (fun n -> (n+1)) list_length)
+  | "float" -> ignore (Sys.opaque_identity create_list (fun n -> float_of_int n) list_length)
+  | "int-tuple" -> ignore (Sys.opaque_identity create_list (fun n -> (n-1,n+1)) list_length)
+  | "float-tuple" -> ignore (Sys.opaque_identity create_list (fun n -> ((float_of_int (n+1)), (float_of_int (n-1)))) list_length)
+  | "string" -> ignore (Sys.opaque_identity create_list (fun n -> (string_of_int n)) list_length)
+  | "record" -> ignore (Sys.opaque_identity create_list (fun n -> { an_int = n; a_string = (string_of_int n); a_float = (float_of_int n)}) list_length)
+  | "float-array" -> ignore (Sys.opaque_identity create_list (fun n -> [| (float_of_int n), (float_of_int n), (float_of_int n) |]) list_length)
+  | "int-array" -> ignore (Sys.opaque_identity create_list (fun n -> [| n, n, n |]) list_length)
+  | "int-option-array" -> ignore (Sys.opaque_identity create_list (fun n -> [| Some n, Some n, Some n, None |]) list_length)
   | _ -> failwith "unexpected data type"
 
-let () = while (Gc.minor_words() < words_to_allocate) do
-    for i = 0 to 100 do
-      allocate_list()
-    done
+let () = for _ = 0 to iterations do
+    allocate_list()
   done
 

benchmarks/simple-tests/morestacks.ml

@@ -0,0 +1,10 @@
+let bar n =
+  n + 5
+
+let foo () = for a = 0 to 1_000_000 do
+  ignore(Sys.opaque_identity bar a)
+done
+
+let () = for _ = 0 to 10_000 do
+  foo()
+done

benchmarks/simple-tests/ocamlcapi-dune.inc

@@ -0,0 +1,41 @@
+(executable
+    (name capi)
+    (modules capi)
+    (libraries ocamlcapi))
+
+(library
+    (name ocamlcapi)
+    (modules ocamlcapi)
+    (c_names ocamlcapi))
+
+(rule
+         (targets test_no_args_alloc.bench)
+          (deps (:prog capi.exe))
+           (action (run orun -o %{targets} -- %{prog} test_no_args_alloc)))
+
+(rule
+         (targets test_no_args_noalloc.bench)
+          (deps (:prog capi.exe))
+           (action (run orun -o %{targets} -- %{prog} test_no_args_noalloc)))
+
+(rule
+         (targets test_few_args_alloc.bench)
+          (deps (:prog capi.exe))
+           (action (run orun -o %{targets} -- %{prog} test_few_args_alloc)))
+
+(rule
+         (targets test_few_args_noalloc.bench)
+          (deps (:prog capi.exe))
+           (action (run orun -o %{targets} -- %{prog} test_few_args_noalloc)))
+
+(rule
+         (targets test_many_args_alloc.bench)
+          (deps (:prog capi.exe))
+           (action (run orun -o %{targets} -- %{prog} test_many_args_alloc)))
+
+(rule
+         (targets test_many_args_noalloc.bench)
+          (deps (:prog capi.exe))
+           (action (run orun -o %{targets} -- %{prog} test_many_args_noalloc)))
+
+(alias (name bench) (deps test_no_args_alloc.bench test_no_args_noalloc.bench test_few_args_alloc.bench test_few_args_noalloc.bench test_many_args_alloc.bench test_many_args_noalloc.bench))

benchmarks/simple-tests/ocamlcapi.c

@@ -0,0 +1,30 @@
+#include <stdio.h>
+#include <caml/mlvalues.h>
+
+  CAMLprim value
+test_no_args_alloc(value unit)
+{
+  return Int_val(42);
+}
+
+CAMLprim value test_no_args_no_alloc(value unit)
+{
+  return Int_val(42);
+}
+
+CAMLprim value test_few_args_alloc(value input) {
+  return Int_val(42);
+}
+
+CAMLprim value test_few_args_no_alloc(value input) {
+  return Int_val(42);
+}
+
+CAMLprim value test_many_args_alloc_nc(value one, value two, value three, value four, value five, value six, value seven) {
+  return Int_val(42);
+}
+
+CAMLprim value test_many_args_noalloc_nc(value one, value two, value three, value four, value five, value six, value seven) {
+  return Int_val(42);
+}
+

benchmarks/simple-tests/ocamlcapi.ml

@@ -0,0 +1,6 @@
+external test_no_args_alloc : unit -> int = "test_no_args_alloc"
+external test_no_args_noalloc : unit -> int = "test_no_args_no_alloc" [@@noalloc]
+external test_few_args_alloc : int -> int = "test_few_args_alloc"
+external test_few_args_noalloc : int -> int = "test_few_args_no_alloc" [@@noalloc]
+external test_many_args_alloc : int -> int -> int -> int -> int -> int -> int -> int = "test_many_args_noalloc_bc" "test_many_args_alloc_nc"
+external test_many_args_noalloc : int -> int -> int -> int -> int -> int -> int -> int = "test_many_args_noalloc_bc" "test_many_args_noalloc_nc" [@@noalloc]

benchmarks/simple-tests/stacks-dune.inc

@@ -0,0 +1,20 @@
+(executable (name stacks) (modules stacks))
+
+(rule
+         (targets stacks.100000.ints-small.bench)
+          (deps (:prog stacks.exe))
+           (action (run orun -o %{targets} -- %{prog} 100000 ints-small)))
+(rule
+         (targets stacks.20000.ints-large.bench)
+          (deps (:prog stacks.exe))
+           (action (run orun -o %{targets} -- %{prog} 20000 ints-large)))
+(rule
+         (targets stacks.100000.floats-small.bench)
+          (deps (:prog stacks.exe))
+           (action (run orun -o %{targets} -- %{prog} 100000 floats-small)))
+(rule
+         (targets stacks.20000.floats-large.bench)
+          (deps (:prog stacks.exe))
+           (action (run orun -o %{targets} -- %{prog} 20000 floats-large)))
+
+(alias (name bench) (deps stacks.100000.ints-small.bench stacks.20000.ints-large.bench stacks.100000.floats-small.bench stacks.20000.floats-large.bench))

benchmarks/simple-tests/stacks.ml

@@ -0,0 +1,35 @@
+let depth = int_of_string Sys.argv.(1)
+let arguments = Sys.argv.(2)
+
+let rec ints_small a0 n = if n == 0 then
+  1
+else
+  a0 + (ints_small a0 (n - 1)) * a0
+
+let rec ints_large a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 n = if n == 0 then
+  1
+else
+  a0 + a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10 + a11 + a12 + a13 + a14 + a15 + (ints_large a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 (n-1)) * a0
+
+let rec floats_small a0 n = if n == 0 then
+  1.0
+else
+  a0 +. (floats_small a0 (n - 1)) *. a0
+
+let rec floats_large a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 n = if n == 0 then
+  1.0 
+else 
+  a0 +. a1 +. a2 +. a3 +. a4 +. a5 +. a6 +. a7 +. a8 +. a9 +. a10 +. a11 +. a12 +. a13 +. a14 +. a15 +. (floats_large a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 (n-1)) *. a0
+
+let run_many_times f =
+  for _ = 1 to 20000 do
+    ignore(Sys.opaque_identity f ())
+  done
+
+let () = let result = match arguments with
+    | "ints-small" -> run_many_times (fun _ -> ints_small 100 depth)
+    | "ints-large" -> run_many_times (fun _ -> ints_large 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 depth)
+    | "floats-small" -> run_many_times (fun _ -> floats_small 100.0 depth)
+    | "floats-large" -> run_many_times (fun _ -> floats_large 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0 11.0 12.0 13.0 14.0 15.0 16.0 depth)
+    | _ -> failwith "unexpected arguments"
+  in ignore(result)