source: Deliverables/D2.2/8051/src/options.ml @ 1546

Last change on this file since 1546 was 1546, checked in by tranquil, 10 years ago

added an option to prevent reindexing transformations from taking place, regardless of optimization options

File size: 7.4 KB
Line 
1open Misc.ArgExt
2
3let default_choice       = "default"
4let option_settings_step = "during option settings"
5
6let language_from_string kind default s =
7  try 
8    Languages.from_string s
9  with Not_found -> 
10    if s = default_choice then 
11      default
12    else 
13      Error.global_error option_settings_step
14        (Printf.sprintf "`%s' is not a valid %s language." s kind)
15 
16let source_language_of_string   = language_from_string "source" Languages.Clight
17let source_language             = ref (source_language_of_string default_choice)
18let set_source_language s       = source_language := source_language_of_string s
19let get_source_language ()      = !source_language
20
21let target_language_of_string   = language_from_string "target" Languages.ASM
22let target_language             = ref (target_language_of_string default_choice)
23let set_target_language s       = target_language := target_language_of_string s
24let get_target_language ()      = !target_language
25
26let input_files                 = ref []
27let add_input_file f            = input_files := f :: !input_files
28let input_files ()              = !input_files
29
30let output_files                = ref None
31let set_output_files s          = output_files := Some s
32let get_output_files ()         = !output_files
33
34let annotation_flag             = ref false
35let request_annotation          = (:=) annotation_flag
36let annotation_requested ()     = !annotation_flag
37
38let interpretation_flag         = ref false
39let request_interpretation      = (:=) interpretation_flag
40let interpretation_requested () = !interpretation_flag
41
42let interpretations_flag         = ref false
43let request_interpretations      = (:=) interpretations_flag
44let interpretations_requested () = !interpretations_flag
45
46let debug_flag                  = ref false
47let set_debug                   = (:=) debug_flag
48let is_debug_enabled ()         = !debug_flag
49
50let reindex_flag                = ref true
51
52let transformations = ref []
53let reindexing_transformations = ref []
54let add_transformation, add_reindexing_transformation =
55  let add_to l t () = l := !l @ [t] in
56  add_to transformations, add_to reindexing_transformations
57let add_transformations (safe, reindexing) () =
58  transformations := !transformations @ safe ;
59  reindexing_transformations := !reindexing_transformations @ reindexing
60let get_transformations () =
61  if !reindex_flag then !transformations else
62  !transformations @ !reindexing_transformations
63
64let cost_ternary_flag           = ref true
65let set_cost_ternary            = (:=) cost_ternary_flag
66let is_cost_ternary_enabled ()  = !cost_ternary_flag
67
68let asm_pretty_flag             = ref false
69let set_asm_pretty              = (:=) asm_pretty_flag
70let is_asm_pretty ()            = !asm_pretty_flag
71
72let lustre_flag                 = ref false
73let set_lustre_file             = (:=) lustre_flag
74let is_lustre_file ()           = !lustre_flag
75
76let remove_lustre_externals       = ref false
77let set_remove_lustre_externals   = (:=) remove_lustre_externals
78let is_remove_lustre_externals () = !remove_lustre_externals
79
80let lustre_test                 = ref None
81let set_lustre_test s           = lustre_test := Some s
82let get_lustre_test ()          = !lustre_test
83
84let lustre_test_cases           = ref 100
85let set_lustre_test_cases       = (:=) lustre_test_cases
86let get_lustre_test_cases ()    = !lustre_test_cases
87
88let lustre_test_cycles          = ref 100
89let set_lustre_test_cycles      = (:=) lustre_test_cycles
90let get_lustre_test_cycles ()   = !lustre_test_cycles
91
92let lustre_test_min_int         = ref (-1000)
93let set_lustre_test_min_int     = (:=) lustre_test_min_int
94let get_lustre_test_min_int ()  = !lustre_test_min_int
95
96let lustre_test_max_int         = ref 1000
97let set_lustre_test_max_int     = (:=) lustre_test_max_int
98let get_lustre_test_max_int ()  = !lustre_test_max_int
99
100
101(*
102let print_result_flag           = ref false
103let set_print_result            = (:=) print_result_flag
104let is_print_result_enabled ()  = !print_result_flag
105*)
106
107let dev_test                    = ref false
108let set_dev_test                = (:=) dev_test
109let is_dev_test_enabled ()      = !dev_test
110
111let help_specify_opt_stage ?(reind = false) (trans : Languages.transformation) =
112  extra_doc (Printf.sprintf " [%sdone in %s]"
113               (if reind then "reindexing transformation, " else "")
114               (Languages.to_string (fst trans)))
115
116let basic_optimizations =
117  ([
118    ConstPropagation.trans;
119    CopyPropagation.trans;
120    RedundancyElimination.trans;
121    CopyPropagation.trans;
122    RedundancyElimination.trans
123  ],[
124    LoopPeeling.trans
125  ])
126
127let options = OptionsParsing.register [
128(*
129  "-s", Arg.String set_source_language,
130  " Choose the source language between:";
131  extra_doc " Clight, Cminor";
132  extra_doc " [default is C]";
133*)
134
135  "-l", Arg.String set_target_language,
136  " Choose the target language between:";
137  extra_doc " Clight, Cminor, RTLabs, RTL, ERTL, LTL, LIN, ASM";
138  extra_doc " [default is ASM]";
139
140  "-a", Arg.Set annotation_flag,
141  " Add cost annotations on the source code.";
142
143  "-i", Arg.Set interpretation_flag,
144  " Interpret the compiled code.";
145
146  "-is", Arg.Set interpretations_flag,
147  " Interpret all the compilation passes.";
148
149  "-d", Arg.Set debug_flag,
150  " Debugging mode.";
151
152  "-o", Arg.String set_output_files,
153  " Prefix of the output files.";
154
155  "-asm-pretty", Arg.Set asm_pretty_flag,
156  " Output a pretty-printed assembly file.";
157
158  "-lustre", Arg.Set lustre_flag,
159  " Input file is a Lustre file.";
160
161  "-remove-lustre-externals", Arg.Set remove_lustre_externals,
162  " Remove Lustre externals.";
163
164  "-lustre-test", Arg.String set_lustre_test,
165  " Input file is a Lustre file, testing requested.";
166
167  "-lustre-test-cases", Arg.Int set_lustre_test_cases,
168  " Set the number of test cases when testing a Lustre";
169  extra_doc " file.";
170  extra_doc " [default is 100]";
171
172  "-lustre-test-cycles", Arg.Int set_lustre_test_cycles,
173  " Set the number of cycles for each case when testing";
174  extra_doc " a Lustre file.";
175  extra_doc " [default is 100]";
176
177  "-lustre-test-min-int", Arg.Int set_lustre_test_min_int,
178  " Random int minimum value when testing a Lustre file.";
179  extra_doc " [default is -1000]";
180
181  "-lustre-test-max-int", Arg.Int set_lustre_test_max_int,
182  " Random int maximum value when testing a Lustre file.";
183  extra_doc " [default is 1000]";
184
185  "-peel", Arg.Unit (add_reindexing_transformation LoopPeeling.trans),
186  " Apply loop peeling.";
187    help_specify_opt_stage ~reind:true LoopPeeling.trans;
188
189  "-cst-prop", Arg.Unit (add_transformation ConstPropagation.trans),
190  " Apply constant propagation.";
191  help_specify_opt_stage ConstPropagation.trans;
192
193  "-cpy-prop", Arg.Unit (add_transformation CopyPropagation.trans),
194  " Apply copy propagation.";
195    help_specify_opt_stage CopyPropagation.trans;
196
197  "-pre", Arg.Unit (add_transformation RedundancyElimination.trans),
198  " Apply partial redundancy elimination.";
199    help_specify_opt_stage RedundancyElimination.trans;
200
201  "-unroll-for",
202  Arg.Int (fun i -> add_reindexing_transformation (
203    LoopUnrolling.trans ~factor:i ()) ()),
204  " Apply loop unrolling, specifying factor.";
205  help_specify_opt_stage ~reind:true (LoopUnrolling.trans ());
206
207  "-unroll", Arg.Unit (add_reindexing_transformation (LoopUnrolling.trans ())),
208  " Apply loop unrolling.";
209  help_specify_opt_stage ~reind:true (LoopUnrolling.trans ());
210
211  "-O", Arg.Unit (add_transformations basic_optimizations),
212  " Apply some optimizations.";
213
214  "-no-cost-tern",  Arg.Clear cost_ternary_flag,
215  " Replace cost ternary expressions with equivalent";
216  extra_doc " branch statements.";
217
218  "-no-reindex", Arg.Clear reindex_flag,
219  " Prevent optimizations that reindex labels.";
220(*
221  "-res", Arg.Set print_result_flag,
222  " Print the result of interpretations.";
223*)
224
225  "-dev", Arg.Set dev_test,
226  " Playground for developers.";
227]
Note: See TracBrowser for help on using the repository browser.