Merge pull request #480 from mshinwell/flambda_unbox-closures

GPR#480: Flambda fix: try to make Unbox_closures behave more reasonably

4 files changed, 15 insertions, 0 deletions

diff --git a/driver/compenv.ml b/driver/compenv.ml
index 63df53dedf..cbdb59c41f 100644
--- a/driver/compenv.ml
+++ b/driver/compenv.ml
@@ -308,6 +308,8 @@ let read_one_param ppf position name v =
     end
   | "unbox-closures" ->
       set "unbox-closures" [ unbox_closures ] v
+  | "unbox-closures-factor" ->
+      int_setter ppf "unbox-closures-factor" unbox_closures_factor v
   | "remove-unused-arguments" ->
       set "remove-unused-arguments" [ remove_unused_arguments ] v
 
diff --git a/driver/main_args.ml b/driver/main_args.ml
index 09b6cf8f1f..6a5c4a42cc 100644
--- a/driver/main_args.ml
+++ b/driver/main_args.ml
@@ -424,6 +424,14 @@ let mk_unbox_closures f =
   " Pass free variables via specialised arguments rather than closures"
 ;;
 
+let mk_unbox_closures_factor f =
+  "-unbox-closures-factor", Arg.Int f,
+  Printf.sprintf "<n > 0>  Scale the size threshold above which \
+      unbox-closures will slow down indirect calls rather than duplicating a \
+      function (default %d)"
+    Clflags.default_unbox_closures_factor
+;;
+
 let mk_unsafe f =
   "-unsafe", Arg.Unit f,
   " Do not compile bounds checking on array and string access"
@@ -772,6 +780,7 @@ module type Optcommon_options = sig
   val _inline_indirect_cost : string -> unit
   val _inline_lifting_benefit : string -> unit
   val _unbox_closures : unit -> unit
+  val _unbox_closures_factor : int -> unit
   val _inline_branch_factor : string -> unit
   val _remove_unused_arguments : unit -> unit
   val _no_unbox_free_vars_of_closures : unit -> unit
@@ -1046,6 +1055,7 @@ struct
     mk_strict_formats F._strict_formats;
     mk_thread F._thread;
     mk_unbox_closures F._unbox_closures;
+    mk_unbox_closures_factor F._unbox_closures_factor;
     mk_inline_max_unroll F._inline_max_unroll;
     mk_unsafe F._unsafe;
     mk_unsafe_string F._unsafe_string;
@@ -1136,6 +1146,7 @@ module Make_opttop_options (F : Opttop_options) = struct
     mk_strict_sequence F._strict_sequence;
     mk_strict_formats F._strict_formats;
     mk_unbox_closures F._unbox_closures;
+    mk_unbox_closures_factor F._unbox_closures_factor;
     mk_unsafe F._unsafe;
     mk_unsafe_string F._unsafe_string;
     mk_version F._version;
diff --git a/driver/main_args.mli b/driver/main_args.mli
index f39482d21f..38654b694d 100644
--- a/driver/main_args.mli
+++ b/driver/main_args.mli
@@ -136,6 +136,7 @@ module type Optcommon_options = sig
   val _inline_indirect_cost : string -> unit
   val _inline_lifting_benefit : string -> unit
   val _unbox_closures : unit -> unit
+  val _unbox_closures_factor : int -> unit
   val _inline_branch_factor : string -> unit
   val _remove_unused_arguments : unit -> unit
   val _no_unbox_free_vars_of_closures : unit -> unit
diff --git a/driver/optmain.ml b/driver/optmain.ml
index f2ae0a243d..4c17c11618 100644
--- a/driver/optmain.ml
+++ b/driver/optmain.ml
@@ -199,6 +199,7 @@ module Options = Main_args.Make_optcomp_options (struct
   let _S = set keep_asm_file
   let _thread = set use_threads
   let _unbox_closures = set unbox_closures
+  let _unbox_closures_factor f = unbox_closures_factor := f
   let _unsafe = set fast
   let _unsafe_string = set unsafe_string
   let _v () = print_version_and_library "native-code compiler"