flambda-backend: Oclassic/O2/O3 etc (ocaml-flambda#104)

Author: mshinwell

driver/compenv.ml

@@ -337,23 +337,9 @@ let read_one_param ppf position name v =
     Int_arg_helper.parse v
       "Bad syntax in OCAMLPARAM for 'inline-max-depth'"
       inline_max_depth
-
-  | "Oclassic" ->
-      set "Oclassic" [ classic_inlining ] v
-  | "O2" ->
-    if check_bool ppf "O2" v then begin
-      default_simplify_rounds := 2;
-      use_inlining_arguments_set o2_arguments;
-      use_inlining_arguments_set ~round:0 o1_arguments
-    end
-
-  | "O3" ->
-    if check_bool ppf "O3" v then begin
-      default_simplify_rounds := 3;
-      use_inlining_arguments_set o3_arguments;
-      use_inlining_arguments_set ~round:1 o2_arguments;
-      use_inlining_arguments_set ~round:0 o1_arguments
-    end
+  | "Oclassic" -> if check_bool ppf "Oclassic" v then Clflags.set_oclassic ()
+  | "O2" -> if check_bool ppf "O2" v then Clflags.set_o2 ()
+  | "O3" -> if check_bool ppf "O3" v then Clflags.set_o3 ()
   | "unbox-closures" ->
       set "unbox-closures" [ unbox_closures ] v
   | "unbox-closures-factor" ->

driver/main_args.ml

@@ -2214,7 +2214,7 @@ module Default = struct
   module Native = struct
     let _S = set keep_asm_file
     let _clambda_checks () = clambda_checks := true
-    let _classic_inlining () = classic_inlining := true
+    let _classic_inlining () = set_oclassic ()
     let _compact = clear optimize_for_speed
     let _dalloc = set dump_regalloc
     let _davail () = dump_avail := true
@@ -2300,15 +2300,8 @@ module Default = struct
        collected, then checked all at once for illegal combinations, and then
        transformed into the settings of the individual parameters.
     *)
-    let _o2 () =
-      default_simplify_rounds := 2;
-      use_inlining_arguments_set o2_arguments;
-      use_inlining_arguments_set ~round:0 o1_arguments
-    let _o3 () =
-      default_simplify_rounds := 3;
-      use_inlining_arguments_set o3_arguments;
-      use_inlining_arguments_set ~round:1 o2_arguments;
-      use_inlining_arguments_set ~round:0 o1_arguments
+    let _o2 () = Clflags.set_o2 ()
+    let _o3 () = Clflags.set_o3 ()
     let _remove_unused_arguments = set remove_unused_arguments
     let _rounds n = simplify_rounds := (Some n)
     let _unbox_closures = set unbox_closures

driver/optcompile.ml

@@ -32,12 +32,6 @@ let (|>>) (x, y) f = (x, f y)
 (** Native compilation backend for .ml files. *)
 
 let flambda i backend typed =
-  if !Clflags.classic_inlining then begin
-    Clflags.default_simplify_rounds := 1;
-    Clflags.use_inlining_arguments_set Clflags.classic_arguments;
-    Clflags.unbox_free_vars_of_closures := false;
-    Clflags.unbox_specialised_args := false
-  end;
   typed
   |> Profile.(record transl)
       (Translmod.transl_implementation_flambda i.module_name)
@@ -67,7 +61,7 @@ let flambda i backend typed =
     Compilenv.save_unit_info (cmx i))
 
 let clambda i backend typed =
-  Clflags.use_inlining_arguments_set Clflags.classic_arguments;
+  Clflags.set_oclassic ();
   typed
   |> Profile.(record transl)
     (Translmod.transl_store_implementation i.module_name)

parsing/builtin_attributes.ml

@@ -337,18 +337,15 @@ let clflags_attribute_with_int_payload attr ~name clflags_ref =
     | Some i -> clflags_ref := i
     | None -> ()
   end
-  
+
 let nolabels_attribute attr =
   clflags_attribute_without_payload attr
     ~name:"nolabels" Clflags.classic
 
 let flambda_o3_attribute attr =
   clflags_attribute_without_payload' attr
     ~name:"flambda_o3"
-    ~f:(fun () ->
-      if Config.flambda then begin
-        Clflags.use_inlining_arguments_set Clflags.o3_arguments
-      end)
+    ~f:(fun () -> if Config.flambda then Clflags.set_o3 ())
 
 let inline_attribute attr =
   if String.equal attr.attr_name.txt "inline"
@@ -367,7 +364,7 @@ let inline_attribute attr =
         Clflags.Float_arg_helper.parse s err_msg Clflags.inline_threshold
       | None -> warn_payload attr.attr_loc attr.attr_name.txt err_msg
   end
-  
+
 let afl_inst_ratio_attribute attr =
   clflags_attribute_with_int_payload attr
     ~name:"afl_inst_ratio" Clflags.afl_inst_ratio

utils/clflags.ml

@@ -551,6 +551,80 @@ module Flambda2 = struct
     let threshold = ref (F.default Default.threshold)
 
     let report_bin = ref false
+
+    type inlining_arguments = {
+      max_depth : int option;
+      call_cost : float option;
+      alloc_cost : float option;
+      prim_cost : float option;
+      branch_cost : float option;
+      indirect_call_cost : float option;
+      poly_compare_cost : float option;
+      small_function_size : int option;
+      large_function_size : int option;
+      threshold : float option;
+    }
+
+    let use_inlining_arguments_set ?round (arg : inlining_arguments) =
+      let set_int = set_int_arg round in
+      let set_float = set_float_arg round in
+      set_int max_depth Default.max_depth arg.max_depth;
+      set_float call_cost Default.call_cost arg.call_cost;
+      set_float alloc_cost Default.alloc_cost arg.alloc_cost;
+      set_float prim_cost Default.prim_cost arg.prim_cost;
+      set_float branch_cost Default.branch_cost arg.branch_cost;
+      set_float indirect_call_cost
+        Default.indirect_call_cost arg.indirect_call_cost;
+      set_float poly_compare_cost
+        Default.poly_compare_cost arg.poly_compare_cost;
+      set_int small_function_size
+        Default.small_function_size arg.small_function_size;
+      set_int large_function_size
+        Default.large_function_size arg.large_function_size;
+      set_float threshold Default.threshold arg.threshold
+
+    let oclassic_arguments = {
+      max_depth = None;
+      call_cost = None;
+      alloc_cost = None;
+      prim_cost = None;
+      branch_cost = None;
+      indirect_call_cost = None;
+      poly_compare_cost = None;
+      (* We set the small and large function sizes to the same value here to
+         recover "classic mode" semantics (no speculative inlining). *)
+      small_function_size = Some Default.small_function_size;
+      large_function_size = Some Default.small_function_size;
+      (* [threshold] matches the current compiler's default.  (The factor of
+         8 in that default is accounted for by [cost_divisor], above.) *)
+      threshold = Some 10.;
+    }
+
+    let o2_arguments = {
+      max_depth = Some 2;
+      call_cost = Some (2.0 *. Default.call_cost);
+      alloc_cost = Some (2.0 *. Default.alloc_cost);
+      prim_cost = Some (2.0 *. Default.prim_cost);
+      branch_cost = Some (2.0 *. Default.branch_cost);
+      indirect_call_cost = Some (2.0 *. Default.indirect_call_cost);
+      poly_compare_cost = Some (2.0 *. Default.poly_compare_cost);
+      small_function_size = Some (2 * Default.small_function_size);
+      large_function_size = Some (4 * Default.large_function_size);
+      threshold = Some 25.;
+    }
+
+    let o3_arguments = {
+      max_depth = Some 3;
+      call_cost = Some (3.0 *. Default.call_cost);
+      alloc_cost = Some (3.0 *. Default.alloc_cost);
+      prim_cost = Some (3.0 *. Default.prim_cost);
+      branch_cost = Some (3.0 *. Default.branch_cost);
+      indirect_call_cost = Some (3.0 *. Default.indirect_call_cost);
+      poly_compare_cost = Some (3.0 *. Default.poly_compare_cost);
+      small_function_size = Some (3 * Default.small_function_size);
+      large_function_size = Some (8 * Default.large_function_size);
+      threshold = Some 50.;
+    }
   end
 
   let oclassic_flags () =
@@ -560,13 +634,6 @@ module Flambda2 = struct
     Expert.fallback_inlining_heuristic := true;
     backend_cse_at_toplevel := false
 
-  let o1_flags () =
-    cse_depth := 2;
-    join_points := true;
-    unbox_along_intra_function_control_flow := true;
-    Expert.fallback_inlining_heuristic := false;
-    backend_cse_at_toplevel := false
-
   let o2_flags () =
     cse_depth := 2;
     join_points := true;
@@ -582,6 +649,43 @@ module Flambda2 = struct
     backend_cse_at_toplevel := false
 end
 
+let is_flambda2 () =
+  Config.flambda2 && !native_code
+
+let set_oclassic () =
+  if is_flambda2 () then begin
+    Flambda2.Inlining.use_inlining_arguments_set
+      Flambda2.Inlining.oclassic_arguments;
+    Flambda2.oclassic_flags ()
+  end else begin
+    classic_inlining := true;
+    default_simplify_rounds := 1;
+    use_inlining_arguments_set classic_arguments;
+    unbox_free_vars_of_closures := false;
+    unbox_specialised_args := false
+  end
+
+let set_o2 () =
+  if is_flambda2 () then begin
+    Flambda2.Inlining.use_inlining_arguments_set Flambda2.Inlining.o2_arguments;
+    Flambda2.o2_flags ()
+  end else begin
+    default_simplify_rounds := 2;
+    use_inlining_arguments_set o2_arguments;
+    use_inlining_arguments_set ~round:0 o1_arguments
+  end
+
+let set_o3 () =
+  if is_flambda2 () then begin
+    Flambda2.Inlining.use_inlining_arguments_set Flambda2.Inlining.o3_arguments;
+    Flambda2.o3_flags ()
+  end else begin
+    default_simplify_rounds := 3;
+    use_inlining_arguments_set o3_arguments;
+    use_inlining_arguments_set ~round:1 o2_arguments;
+    use_inlining_arguments_set ~round:0 o1_arguments
+  end
+
 (* This is used by the -stop-after option. *)
 module Compiler_pass = struct
   (* If you add a new pass, the following must be updated:
@@ -671,10 +775,6 @@ let set_save_ir_after pass enabled =
   in
   save_ir_after := new_passes
 
-
-let is_flambda2 () =
-  Config.flambda2 && !native_code
-
 module String = Misc.Stdlib.String
 
 let arg_spec = ref []

utils/clflags.mli

@@ -43,29 +43,6 @@ module Float_arg_helper : sig
   val get : key:int -> parsed -> float
 end
 
-type inlining_arguments = {
-  inline_call_cost : int option;
-  inline_alloc_cost : int option;
-  inline_prim_cost : int option;
-  inline_branch_cost : int option;
-  inline_indirect_cost : int option;
-  inline_lifting_benefit : int option;
-  inline_branch_factor : float option;
-  inline_max_depth : int option;
-  inline_max_unroll : int option;
-  inline_threshold : float option;
-  inline_toplevel_threshold : int option;
-}
-
-val classic_arguments : inlining_arguments
-val o1_arguments : inlining_arguments
-val o2_arguments : inlining_arguments
-val o3_arguments : inlining_arguments
-
-(** Set all the inlining arguments for a round.
-    The default is set if no round is provided. *)
-val use_inlining_arguments_set : ?round:int -> inlining_arguments -> unit
-
 val objfiles : string list ref
 val ccobjs : string list ref
 val dllibs : string list ref
@@ -324,13 +301,12 @@ module Flambda2 : sig
 
     val report_bin : bool ref
   end
-
-  val oclassic_flags : unit -> unit
-  val o1_flags : unit -> unit
-  val o2_flags : unit -> unit
-  val o3_flags : unit -> unit
 end
 
+val set_oclassic : unit -> unit
+val set_o2 : unit -> unit
+val set_o3 : unit -> unit
+
 module Compiler_pass : sig
   type t = Parsing | Typing | Scheduling | Emit
   val of_string : string -> t option