Skip to content

Commit b3375d3

Browse files
gretay-jsgretay-js
authored
Move flambda-backend specific flags out of ocaml/ subdirectory (#382)
1 parent de75a98 commit b3375d3

File tree

18 files changed

+1345
-1190
lines changed

18 files changed

+1345
-1190
lines changed

‎backend/asmgen.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -222,14 +222,14 @@ let compile_fundecl ~ppf_dump fd_cmm =
222222
++ Profile.record ~accumulate:true "linearize" (fun (f : Mach.fundecl) ->
223223
let res = Linearize.fundecl f in
224224
(* CR xclerc for xclerc: temporary, for testing. *)
225-
if !Clflags.use_ocamlcfg then begin
225+
if !Flambda_backend_flags.use_ocamlcfg then begin
226226
test_cfgize f res;
227227
end;
228228
res)
229229
++ pass_dump_linear_if ppf_dump dump_linear "Linearized code"
230230
++ Compiler_hooks.execute_and_pipe Compiler_hooks.Linear
231231
++ (fun (fd : Linear.fundecl) ->
232-
if !use_ocamlcfg then begin
232+
if !Flambda_backend_flags.use_ocamlcfg then begin
233233
fd
234234
++ Profile.record ~accumulate:true "linear_to_cfg"
235235
(Linear_to_cfg.run ~preserve_orig_labels:true)

‎driver/flambda_backend_args.ml

Lines changed: 757 additions & 0 deletions
Large diffs are not rendered by default.

‎driver/flambda_backend_args.mli

Lines changed: 93 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,93 @@
1+
(**************************************************************************)
2+
(* *)
3+
(* OCaml *)
4+
(* *)
5+
(* Pierre Chambart, OCamlPro *)
6+
(* Mark Shinwell and Leo White, Jane Street Europe *)
7+
(* *)
8+
(* Copyright 2013--2021 OCamlPro SAS *)
9+
(* Copyright 2014--2021 Jane Street Group LLC *)
10+
(* *)
11+
(* All rights reserved. This file is distributed under the terms of *)
12+
(* the GNU Lesser General Public License version 2.1, with the *)
13+
(* special exception on linking described in the file LICENSE. *)
14+
(* *)
15+
(**************************************************************************)
16+
module type Flambda_backend_options = sig
17+
val _ocamlcfg : unit -> unit
18+
val _no_ocamlcfg : unit -> unit
19+
val _flambda2_join_points : unit -> unit
20+
val _no_flambda2_join_points : unit -> unit
21+
val _flambda2_unbox_along_intra_function_control_flow : unit -> unit
22+
val _no_flambda2_unbox_along_intra_function_control_flow : unit -> unit
23+
val _flambda2_backend_cse_at_toplevel : unit -> unit
24+
val _no_flambda2_backend_cse_at_toplevel : unit -> unit
25+
val _flambda2_cse_depth : int -> unit
26+
val _flambda2_expert_code_id_and_symbol_scoping_checks : unit -> unit
27+
val _no_flambda2_expert_code_id_and_symbol_scoping_checks : unit -> unit
28+
val _flambda2_expert_fallback_inlining_heuristic : unit -> unit
29+
val _no_flambda2_expert_fallback_inlining_heuristic : unit -> unit
30+
val _flambda2_expert_inline_effects_in_cmm : unit -> unit
31+
val _no_flambda2_expert_inline_effects_in_cmm : unit -> unit
32+
val _flambda2_expert_phantom_lets : unit -> unit
33+
val _no_flambda2_expert_phantom_lets : unit -> unit
34+
val _flambda2_expert_max_block_size_for_projections : int -> unit
35+
val _flambda2_expert_max_unboxing_depth : int -> unit
36+
val _flambda2_expert_can_inline_recursive_functions : unit -> unit
37+
val _no_flambda2_expert_can_inline_recursive_functions : unit -> unit
38+
val _flambda2_debug_permute_every_name : unit -> unit
39+
val _no_flambda2_debug_permute_every_name : unit -> unit
40+
val _flambda2_debug_concrete_types_only_on_canonicals : unit -> unit
41+
val _no_flambda2_debug_concrete_types_only_on_canonicals : unit -> unit
42+
43+
val _flambda2_inline_max_depth : string -> unit
44+
val _flambda2_inline_max_rec_depth : string -> unit
45+
val _flambda2_inline_call_cost : string -> unit
46+
val _flambda2_inline_alloc_cost : string -> unit
47+
val _flambda2_inline_prim_cost : string -> unit
48+
val _flambda2_inline_branch_cost : string -> unit
49+
val _flambda2_inline_indirect_call_cost : string -> unit
50+
val _flambda2_inline_poly_compare_cost : string -> unit
51+
val _flambda2_inline_small_function_size : string -> unit
52+
val _flambda2_inline_large_function_size : string -> unit
53+
val _flambda2_inline_threshold : string -> unit
54+
val _flambda2_speculative_inlining_only_if_arguments_useful : unit -> unit
55+
val _no_flambda2_speculative_inlining_only_if_arguments_useful : unit -> unit
56+
57+
val _flambda2_inlining_report_bin : unit -> unit
58+
59+
val _flambda2_unicode : unit -> unit
60+
61+
val _flambda2_treat_invalid_code_as_unreachable : unit -> unit
62+
val _no_flambda2_treat_invalid_code_as_unreachable : unit -> unit
63+
64+
val _drawfexpr : unit -> unit
65+
val _dfexpr : unit -> unit
66+
val _dflexpect : unit -> unit
67+
val _dclosure_offsets : unit -> unit
68+
val _dfreshen : unit -> unit
69+
end
70+
71+
module type Optcomp_options = sig
72+
include Main_args.Optcomp_options
73+
include Flambda_backend_options
74+
end
75+
76+
module type Opttop_options = sig
77+
include Main_args.Opttop_options
78+
include Flambda_backend_options
79+
end
80+
81+
module Make_optcomp_options : Optcomp_options -> Main_args.Arg_list;;
82+
module Make_opttop_options : Opttop_options -> Main_args.Arg_list;;
83+
84+
module Default: sig
85+
module Optmain: Optcomp_options
86+
module Opttopmain: Opttop_options
87+
end
88+
89+
module Extra_params : sig
90+
(** [read_param ppf pos name value] returns whether the param was handled. *)
91+
val read_param :
92+
Format.formatter -> Compenv.readenv_position -> string -> string -> bool
93+
end

‎driver/flambda_backend_flags.ml

Lines changed: 252 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,252 @@
1+
(**************************************************************************)
2+
(* *)
3+
(* OCaml *)
4+
(* *)
5+
(* Pierre Chambart, OCamlPro *)
6+
(* Mark Shinwell and Leo White, Jane Street Europe *)
7+
(* *)
8+
(* Copyright 2013--2021 OCamlPro SAS *)
9+
(* Copyright 2014--2021 Jane Street Group LLC *)
10+
(* *)
11+
(* All rights reserved. This file is distributed under the terms of *)
12+
(* the GNU Lesser General Public License version 2.1, with the *)
13+
(* special exception on linking described in the file LICENSE. *)
14+
(* *)
15+
(**************************************************************************)
16+
let use_ocamlcfg = ref false (* -ocamlcfg *)
17+
18+
module Flambda2 = struct
19+
module Default = struct
20+
let classic_mode = false
21+
let join_points = false
22+
let unbox_along_intra_function_control_flow = true
23+
let backend_cse_at_toplevel = false
24+
let cse_depth = 2
25+
let treat_invalid_code_as_unreachable = false
26+
let unicode = true
27+
end
28+
29+
let classic_mode = ref Default.classic_mode
30+
let join_points = ref Default.join_points
31+
let unbox_along_intra_function_control_flow =
32+
ref Default.unbox_along_intra_function_control_flow
33+
let backend_cse_at_toplevel = ref Default.backend_cse_at_toplevel
34+
let cse_depth = ref Default.cse_depth
35+
let treat_invalid_code_as_unreachable =
36+
ref Default.treat_invalid_code_as_unreachable
37+
let unicode = ref Default.unicode
38+
39+
module Dump = struct
40+
let rawfexpr = ref false
41+
let fexpr = ref false
42+
let flexpect = ref false
43+
let closure_offsets = ref false
44+
let freshen = ref false
45+
end
46+
47+
module Expert = struct
48+
module Default = struct
49+
let code_id_and_symbol_scoping_checks = false
50+
let fallback_inlining_heuristic = false
51+
let inline_effects_in_cmm = false
52+
let phantom_lets = true
53+
let max_block_size_for_projections = None
54+
let max_unboxing_depth = 3
55+
let can_inline_recursive_functions = false
56+
end
57+
58+
let code_id_and_symbol_scoping_checks =
59+
ref Default.code_id_and_symbol_scoping_checks
60+
let fallback_inlining_heuristic = ref Default.fallback_inlining_heuristic
61+
let inline_effects_in_cmm = ref Default.inline_effects_in_cmm
62+
let phantom_lets = ref Default.phantom_lets
63+
let max_block_size_for_projections =
64+
ref Default.max_block_size_for_projections
65+
let max_unboxing_depth = ref Default.max_unboxing_depth
66+
let can_inline_recursive_functions =
67+
ref Default.can_inline_recursive_functions
68+
end
69+
70+
module Debug = struct
71+
module Default = struct
72+
let permute_every_name = false
73+
let concrete_types_only_on_canonicals = false
74+
end
75+
76+
let permute_every_name = ref Default.permute_every_name
77+
let concrete_types_only_on_canonicals =
78+
ref Default.concrete_types_only_on_canonicals
79+
end
80+
81+
module I = Clflags.Int_arg_helper
82+
module F = Clflags.Float_arg_helper
83+
84+
module Inlining = struct
85+
module Default = struct
86+
let cost_divisor = 8.
87+
88+
let max_depth = 1
89+
let max_rec_depth = 0
90+
91+
let call_cost = 5. /. cost_divisor
92+
let alloc_cost = 7. /. cost_divisor
93+
let prim_cost = 3. /. cost_divisor
94+
let branch_cost = 5. /. cost_divisor
95+
let indirect_call_cost = 4. /. cost_divisor
96+
let poly_compare_cost = 10. /. cost_divisor
97+
98+
let small_function_size = 10
99+
let large_function_size = 10
100+
101+
let threshold = 10.
102+
103+
let speculative_inlining_only_if_arguments_useful = true
104+
end
105+
106+
let max_depth = ref (I.default Default.max_depth)
107+
let max_rec_depth = ref (I.default Default.max_rec_depth)
108+
109+
let call_cost = ref (F.default Default.call_cost)
110+
let alloc_cost = ref (F.default Default.alloc_cost)
111+
let prim_cost = ref (F.default Default.prim_cost)
112+
let branch_cost = ref (F.default Default.branch_cost)
113+
let indirect_call_cost = ref (F.default Default.indirect_call_cost)
114+
let poly_compare_cost = ref (F.default Default.poly_compare_cost)
115+
116+
let small_function_size = ref (I.default Default.small_function_size)
117+
let large_function_size = ref (I.default Default.large_function_size)
118+
119+
let threshold = ref (F.default Default.threshold)
120+
121+
let speculative_inlining_only_if_arguments_useful =
122+
ref Default.speculative_inlining_only_if_arguments_useful
123+
124+
let report_bin = ref false
125+
126+
type inlining_arguments = {
127+
max_depth : int option;
128+
max_rec_depth : int option;
129+
call_cost : float option;
130+
alloc_cost : float option;
131+
prim_cost : float option;
132+
branch_cost : float option;
133+
indirect_call_cost : float option;
134+
poly_compare_cost : float option;
135+
small_function_size : int option;
136+
large_function_size : int option;
137+
threshold : float option;
138+
}
139+
140+
let use_inlining_arguments_set ?round (arg : inlining_arguments) =
141+
let set_int = Clflags.set_int_arg round in
142+
let set_float = Clflags.set_float_arg round in
143+
set_int max_depth Default.max_depth arg.max_depth;
144+
set_int max_rec_depth Default.max_rec_depth arg.max_rec_depth;
145+
set_float call_cost Default.call_cost arg.call_cost;
146+
set_float alloc_cost Default.alloc_cost arg.alloc_cost;
147+
set_float prim_cost Default.prim_cost arg.prim_cost;
148+
set_float branch_cost Default.branch_cost arg.branch_cost;
149+
set_float indirect_call_cost
150+
Default.indirect_call_cost arg.indirect_call_cost;
151+
set_float poly_compare_cost
152+
Default.poly_compare_cost arg.poly_compare_cost;
153+
set_int small_function_size
154+
Default.small_function_size arg.small_function_size;
155+
set_int large_function_size
156+
Default.large_function_size arg.large_function_size;
157+
set_float threshold Default.threshold arg.threshold
158+
159+
let oclassic_arguments = {
160+
max_depth = None;
161+
max_rec_depth = None;
162+
call_cost = None;
163+
alloc_cost = None;
164+
prim_cost = None;
165+
branch_cost = None;
166+
indirect_call_cost = None;
167+
poly_compare_cost = None;
168+
(* We set the small and large function sizes to the same value here to
169+
recover "classic mode" semantics (no speculative inlining). *)
170+
small_function_size = Some Default.small_function_size;
171+
large_function_size = Some Default.small_function_size;
172+
(* [threshold] matches the current compiler's default. (The factor of
173+
8 in that default is accounted for by [cost_divisor], above.) *)
174+
threshold = Some 10.;
175+
}
176+
177+
let o2_arguments = {
178+
max_depth = Some 2;
179+
max_rec_depth = Some 0;
180+
call_cost = Some (2.0 *. Default.call_cost);
181+
alloc_cost = Some (2.0 *. Default.alloc_cost);
182+
prim_cost = Some (2.0 *. Default.prim_cost);
183+
branch_cost = Some (2.0 *. Default.branch_cost);
184+
indirect_call_cost = Some (2.0 *. Default.indirect_call_cost);
185+
poly_compare_cost = Some (2.0 *. Default.poly_compare_cost);
186+
small_function_size = Some (2 * Default.small_function_size);
187+
large_function_size = Some (4 * Default.large_function_size);
188+
threshold = Some 25.;
189+
}
190+
191+
let o3_arguments = {
192+
max_depth = Some 3;
193+
max_rec_depth = Some 0;
194+
call_cost = Some (3.0 *. Default.call_cost);
195+
alloc_cost = Some (3.0 *. Default.alloc_cost);
196+
prim_cost = Some (3.0 *. Default.prim_cost);
197+
branch_cost = Some (3.0 *. Default.branch_cost);
198+
indirect_call_cost = Some (3.0 *. Default.indirect_call_cost);
199+
poly_compare_cost = Some (3.0 *. Default.poly_compare_cost);
200+
small_function_size = Some (10 * Default.small_function_size);
201+
large_function_size = Some (50 * Default.large_function_size);
202+
threshold = Some 100.;
203+
}
204+
end
205+
206+
let oclassic_flags () =
207+
classic_mode := true;
208+
cse_depth := 2;
209+
join_points := false;
210+
unbox_along_intra_function_control_flow := true;
211+
Expert.fallback_inlining_heuristic := true;
212+
backend_cse_at_toplevel := false
213+
214+
let o2_flags () =
215+
cse_depth := 2;
216+
join_points := false;
217+
unbox_along_intra_function_control_flow := true;
218+
Expert.fallback_inlining_heuristic := false;
219+
backend_cse_at_toplevel := false
220+
221+
let o3_flags () =
222+
cse_depth := 2;
223+
join_points := true;
224+
unbox_along_intra_function_control_flow := true;
225+
Expert.fallback_inlining_heuristic := false;
226+
backend_cse_at_toplevel := false
227+
end
228+
229+
let set_oclassic () =
230+
if Clflags.is_flambda2 () then begin
231+
Flambda2.Inlining.use_inlining_arguments_set
232+
Flambda2.Inlining.oclassic_arguments;
233+
Flambda2.oclassic_flags ()
234+
end else begin
235+
Clflags.set_oclassic ();
236+
end
237+
238+
let set_o2 () =
239+
if Clflags.is_flambda2 () then begin
240+
Flambda2.Inlining.use_inlining_arguments_set Flambda2.Inlining.o2_arguments;
241+
Flambda2.o2_flags ()
242+
end else begin
243+
Clflags.set_o2 ();
244+
end
245+
246+
let set_o3 () =
247+
if Clflags.is_flambda2 () then begin
248+
Flambda2.Inlining.use_inlining_arguments_set Flambda2.Inlining.o3_arguments;
249+
Flambda2.o3_flags ()
250+
end else begin
251+
Clflags.set_o3 ();
252+
end

0 commit comments

Comments
 (0)