Project

General

Profile

Revision 61df3cb9

View differences:

src/log.ml
9 9
(*                                                                  *)
10 10
(********************************************************************)
11 11

  
12
let report ~level:level p =
13
if !Options.verbose_level >= level then
12
let report ?(plugins="") ?(verbose_level=Options.verbose_level) ~level:level p =
13
  let plugins = if plugins = "" then plugins else plugins ^ " " in 
14
  if !verbose_level >= level then
14 15
  begin
15
    Format.eprintf "%t" p;
16
    Format.eprintf "%s%t" plugins p;
16 17
  (* Removed the flush since it was breaking most open/close boxes *)
17 18
  (* Format.pp_print_flush Format.err_formatter () *)
18 19
  end
src/main_lustre_compiler.ml
120 120
  end
121 121

  
122 122
let compile dirname basename extension =
123
  Plugins.init ();
123 124
  match extension with
124 125
  | ".lusi"  -> compile_header dirname basename extension
125 126
  | ".lus"   -> compile_source dirname basename extension
src/options_management.ml
137 137
    "-no-mutation-suffix", Arg.Set no_mutation_suffix, "does not rename node with the _mutant suffix"
138 138
  ]
139 139

  
140
let plugin_opt (name, activate, options) =
140
let plugin_opt (name, activate, usage, options) =
141
  let usage () =
142
    Format.printf "@[<v 2>Plugin %s:@ %t@]@." name usage;
143
    exit 0
144
  in
141 145
  ( "-" ^ name , Arg.Unit activate, "activate plugin " ^ name ) ::
146
  ( "-" ^ name ^ "-help" , Arg.Unit usage, "plugin " ^ name ^ " help") ::
142 147
    (List.map (fun (opt, act, desc) -> "-" ^ name ^ opt, act, desc) options)
143 148
 
144 149

  
src/pluginType.ml
2 2
sig
3 3
  val name: string
4 4
  val activate: unit -> unit
5
  val usage: Format.formatter -> unit
5 6
  val options: (string * Arg.spec * string) list
7
  val init: unit -> unit
6 8
  val check_force_stateful : unit -> bool
7 9
  val refine_machine_code: Lustre_types.top_decl list ->
8 10
    Machine_code_types.machine_t list -> Machine_code_types.machine_t list
......
11 13
end
12 14

  
13 15
module Default =
14
struct
15
  let check_force_stateful () = false
16
  let refine_machine_code prog machines = machines
17
  let c_backend_main_loop_body_prefix basename mname fmt () = ()
18
  let c_backend_main_loop_body_suffix fmt () = ()
19
end
16
  struct
17
    let usage fmt = Format.fprintf fmt "No specific help." 
18
    let init () = ()
19
    let check_force_stateful () = false
20
    let refine_machine_code prog machines = machines
21
    let c_backend_main_loop_body_prefix basename mname fmt () = ()
22
    let c_backend_main_loop_body_suffix fmt () = ()
23
  end
src/plugins.ml
8 8
    List.map Options_management.plugin_opt (
9 9
      List.map (fun m ->
10 10
	let module M = (val m : PluginType.PluginType) in
11
	(M.name, M.activate, M.options)
11
	(M.name, M.activate, M.usage, M.options)
12 12
      ) plugins
13 13
    ))
14

  
15
let init () =
16
  List.iter (fun m ->
17
      let module M = (val m : PluginType.PluginType) in
18
      M.init ()
19
    ) plugins
14 20
  
15 21
let check_force_stateful () =
16 22
  List.exists (fun m ->
src/plugins/salsa/machine_salsa_opt.ml
6 6

  
7 7
(* Datatype for Salsa: FormalEnv, Ranges, Var set ... *)
8 8
open SalsaDatatypes
9
   
10
let report = Log.report ~plugins:"[salsa]" ~verbose_level:Salsa.Log.verbose_level 
9 11
(******************************************************************)
10 12
(* TODO Xavier: should those functions be declared more globally? *)
11 13

  
......
98 100
    let fresh_id = "toto"  in (* TODO more meaningful name *)
99 101

  
100 102
    let abstractEnv = RangesInt.to_abstract_env ranges in
101
    Format.eprintf "Launching analysis@.@?";
103
    report ~level:2 (fun fmt -> Format.fprintf fmt
104
                                  "Launching analysis: %s@ "
105
                                  (Salsa.Print.printExpression e_salsa));
102 106
    let new_e_salsa, e_val = 
103 107
      Salsa.MainEPEG.transformExpression fresh_id e_salsa abstractEnv
104 108
    in
105
    Format.eprintf " Analysis done@.@?";
109
    report ~level:2 (fun fmt -> Format.fprintf fmt " Analysis done: %s@ "
110
      (Salsa.Print.printExpression new_e_salsa));
106 111

  
107 112

  
108 113
    (* (\* Debug *\) *)
......
111 116
    (*   (Salsa.Print.printExpression new_e_salsa); *)
112 117
    (* (\* Debug *\) *)
113 118
    
114
    Format.eprintf " Computing range progress@.@?";
119
    report ~level:2 (fun fmt -> Format.fprintf fmt " Computing range progress@ ");
115 120

  
116 121
    let old_val = Salsa.Analyzer.evalExpr e_salsa abstractEnv [] in
117 122
    let expr, expr_range  =
118 123
      match RangesInt.Value.leq old_val e_val, RangesInt.Value.leq e_val old_val with
119 124
      | true, true -> (
120
	if !debug then Log.report ~level:2 (fun fmt ->
125
	if !debug then report ~level:2 (fun fmt ->
121 126
	  Format.fprintf fmt "No improvement on abstract value %a@ " RangesInt.pp_val e_val;
122 127
	);
123 128
	e_salsa, Some old_val
124 129
      )
125 130
      | false, true -> (
126
	if !debug then Log.report ~level:2 (fun fmt ->
131
	if !debug then report ~level:2 (fun fmt ->
127 132
	  Format.fprintf fmt "Improved!@ ";
128 133
	);
129 134
	new_e_salsa, Some e_val
130 135
      )
131
      | true, false -> Format.eprintf "CAREFUL --- new range is worse!. Restoring provided expression@ "; 	e_salsa, Some old_val
136
      | true, false ->
137
         report ~level:2 (fun fmt ->
138
             Format.fprintf fmt
139
               "CAREFUL --- new range is worse!. Restoring provided expression@ ");
140
 	     e_salsa, Some old_val
132 141

  
133 142
      | false, false -> (
134
	Format.eprintf
135
	  "Error; new range is not comparabe with old end. It may need some investigation!@.@?";
136
	Format.eprintf "old: %a@.new: %a@.@?"
137
	  RangesInt.pp_val old_val
138
	  RangesInt.pp_val e_val;
143
        report ~level:2 (fun fmt ->
144
            Format.fprintf fmt
145
	      "Error; new range is not comparable with old end. It may need some investigation!@. ";
146
	    Format.fprintf fmt "old: %a@.new: %a@ "
147
	      RangesInt.pp_val old_val
148
	      RangesInt.pp_val e_val);
139 149
	
140 150
	new_e_salsa, Some e_val
141 151
       	(* assert false *)
142 152
      )
143 153
    in
144
    Format.eprintf " Computing range done@.@?";
154
    report ~level:2 (fun fmt -> Format.fprintf fmt " Computing range done@ ");
145 155

  
146
    if !debug then Log.report ~level:2 (fun fmt ->
156
    if !debug then report ~level:2 (fun fmt ->
147 157
      Format.fprintf fmt
148 158
	"  @[<v>old_expr: @[<v 0>%s@ range: %a@]@ new_expr: @[<v 0>%s@ range: %a@]@ @]@ "
149 159
	(Salsa.Print.printExpression e_salsa)
......
156 166
    expr, expr_range
157 167
  with (* Not_found ->  *)
158 168
  | Salsa.Epeg_types.EPEGError _ -> (
159
    Log.report ~level:2 (fun fmt ->
169
    report ~level:2 (fun fmt ->
160 170
      Format.fprintf fmt
161 171
	"BECAUSE OF AN ERROR, Expression %s was not optimized@ " 	(Salsa.Print.printExpression e_salsa)
162 172
(* MC.pp_val e *));
......
180 190
       else e, None, [], Vars.empty
181 191
    | Var v -> 
182 192
       if not (Vars.mem v printed_vars) && 
183
	 (* TODO xavier: comment recuperer le type de l'expression? Parfois e.value_type vaut 'd *)
184
	 (Types.is_real_type e.value_type ||  Types.is_real_type v.LT.var_type) 
193
	    (* TODO xavier: comment recuperer le type de l'expression? Parfois e.value_type vaut 'd *)
194
	    (Types.is_real_type e.value_type ||  Types.is_real_type v.LT.var_type) 
185 195
       then
186 196
	 opt_num_expr m vars_env ranges formalEnv e 
187 197
       else 
......
198 208
	(* We do not care for computed local ranges. *)
199 209
  	let args', il, new_locals =
200 210
	  List.fold_right (
201
	    fun arg (al, il, nl) ->
211
	      fun arg (al, il, nl) ->
202 212
	      let arg', _, arg_il, arg_nl =
203 213
		opt_expr m vars_env ranges formalEnv arg in
204 214
	      arg'::al, arg_il@il, Vars.union arg_nl nl)
......
209 219
      )
210 220
    )
211 221
    | Array _
212
    | Access _
213
    | Power _ -> assert false  
222
      | Access _
223
      | Power _ -> assert false  
214 224
  and opt_num_expr m vars_env ranges formalEnv e = 
215 225
    if !debug then (
216
      Log.report ~level:2 (fun fmt -> Format.fprintf fmt "Optimizing expression @[<hov>%a@]@ "
217
	(MC.pp_val m) e);
226
      report ~level:2 (fun fmt -> Format.fprintf fmt "Optimizing expression @[<hov>%a@]@ "
227
	                            (MC.pp_val m) e);
218 228
    );
219 229
    (* if !debug then Format.eprintf "Optimizing expression %a with Salsa@ " MC.pp_val e;  *)
220 230
    (* Convert expression *)
......
259 269

  
260 270
    let free_vars = get_salsa_free_vars vars_env constEnv abstractEnv e_salsa in
261 271
    if Vars.cardinal free_vars > 0 then (
262
      Log.report ~level:2 (fun fmt -> Format.fprintf fmt
263
	"Warning: unbounded free vars (%a) in expression %a. We do not optimize it.@ " 
264
	Vars.pp (Vars.fold (fun v accu ->
265
	  let v' = {v with LT.var_id = nodename.LT.node_id ^ "." ^ v.LT.var_id } in
266
	  Vars.add v' accu)
267
		   free_vars Vars.empty)
268
	(MC.pp_val m) (salsa_expr2value_t vars_env constEnv e_salsa));
269
      if !debug then Log.report ~level:2 (fun fmt -> Format.fprintf fmt  "Some free vars, not optimizing@ ");
270
      if !debug then Log.report ~level:3 (fun fmt -> Format.fprintf fmt "  ranges: %a@ "
271
	RangesInt.pp ranges);
272
      report ~level:2 (fun fmt -> Format.fprintf fmt
273
	                                "Warning: unbounded free vars (%a) in expression %a. We do not optimize it.@ " 
274
	                                Vars.pp (Vars.fold (fun v accu ->
275
	                                             let v' = {v with LT.var_id = nodename.LT.node_id ^ "." ^ v.LT.var_id } in
276
	                                             Vars.add v' accu)
277
		                                   free_vars Vars.empty)
278
	                                (MC.pp_val m) (salsa_expr2value_t vars_env constEnv e_salsa));
279
      if !debug then report ~level:2 (fun fmt -> Format.fprintf fmt  "Some free vars, not optimizing@ ");
280
      if !debug then report ~level:3 (fun fmt -> Format.fprintf fmt "  ranges: %a@ "
281
	                                               RangesInt.pp ranges);
272 282

  
273 283
      (* if !debug then Log.report ~level:2 (fun fmt -> Format.fprintf fmt "Formal env was @[<v 0>%a@]@ " FormalEnv.pp formalEnv); *)
274 284
      
......
279 289
    else (
280 290
      
281 291
      if !debug then
282
	  Log.report ~level:3 (fun fmt -> Format.fprintf fmt "@[<v 2>Analyzing expression %a@  with ranges: @[<v>%a@ @]@ @]@ "
283
	    (C_backend_common.pp_c_val m "" (C_backend_common.pp_c_var_read m)) (salsa_expr2value_t vars_env constEnv e_salsa)
284
	    (Utils.fprintf_list ~sep:",@ "(fun fmt (l,r) -> Format.fprintf fmt "%s -> %a" l FloatIntSalsa.pp r)) abstractEnv)
285
	
292
	report ~level:3 (fun fmt -> Format.fprintf fmt "@[<v 2>Analyzing expression %a@  with ranges: @[<v>%a@ @]@ @]@ "
293
	                                  (C_backend_common.pp_c_val m "" (C_backend_common.pp_c_var_read m)) (salsa_expr2value_t vars_env constEnv e_salsa)
294
	                                  (Utils.fprintf_list ~sep:",@ "(fun fmt (l,r) -> Format.fprintf fmt "%s -> %a" l FloatIntSalsa.pp r)) abstractEnv)
295
      
286 296
      ;
287 297

  
288
      (* Slicing expression *)
289
      let e_salsa, seq =
290
	try
291
	  Salsa.Rewrite.sliceExpr e_salsa 0 (Salsa.Types.Nop(Salsa.Types.Lab 0))
292
	    with _ -> Format.eprintf "Issues rewriting express %s@.@?" (Salsa.Print.printExpression e_salsa); assert false
293
      in
294
      let def_tmps = Salsa.Utils.flatten_seq seq [] in
295
      (* Registering tmp ids in vars_env *)
296
      let vars_env', new_local_vars = List.fold_left
297
	(fun (vs,vars) (id, _) ->
298
	  let vdecl = Corelang.mk_fresh_var
299
	    nodename
300
	    Location.dummy_loc
301
	    e.MT.value_type
302
	    (Clocks.new_var true)
303
	    
304
	  in
305
	  let vs' =
306
	    VarEnv.add
307
	      id
308
	      {
309
		vdecl = vdecl ;
310
		is_local = true;
311
	      }
312
	      vs
313
	  in
314
	  let vars' = Vars.add vdecl vars in
315
	  vs', vars'
316
	)
317
	(vars_env,Vars.empty)
318
	def_tmps
319
      in 
320
      (* Debug *)
321
      if !debug then (
322
	Log.report ~level:3 (fun fmt ->
323
	  Format.fprintf  fmt "List of slices: @[<v 0>%a@]@ "
324
	    (Utils.fprintf_list
325
	       ~sep:"@ "
326
	       (fun fmt (id, e_id) ->
327
		 Format.fprintf fmt "(%s,%a) -> %a"
328
		   id
329
		   Printers.pp_var (get_var vars_env' id).vdecl
330
		   (C_backend_common.pp_c_val m "" (C_backend_common.pp_c_var_read m)) (salsa_expr2value_t vars_env' constEnv e_id)
331
	       )
332
	    )
333
	    def_tmps;
334
	  Format.eprintf "Sliced expression: %a@ "
335
	    (C_backend_common.pp_c_val m "" (C_backend_common.pp_c_var_read m)) (salsa_expr2value_t vars_env' constEnv e_salsa)
336
	  ;
298
        (* Slicing expression *)
299
        let e_salsa, seq =
300
	  try
301
	    Salsa.Rewrite.sliceExpr e_salsa 0 (Salsa.Types.Nop(Salsa.Types.Lab 0))
302
	  with _ -> Format.eprintf "Issues rewriting express %s@.@?" (Salsa.Print.printExpression e_salsa); assert false
303
        in
304
        let def_tmps = Salsa.Utils.flatten_seq seq [] in
305
        (* Registering tmp ids in vars_env *)
306
        let vars_env', new_local_vars = List.fold_left
307
	                                  (fun (vs,vars) (id, _) ->
308
	                                    let vdecl = Corelang.mk_fresh_var
309
	                                                  nodename
310
	                                                  Location.dummy_loc
311
	                                                  e.MT.value_type
312
	                                                  (Clocks.new_var true)
313
	                                              
314
	                                    in
315
	                                    let vs' =
316
	                                      VarEnv.add
317
	                                        id
318
	                                        {
319
		                                  vdecl = vdecl ;
320
		                                  is_local = true;
321
	                                        }
322
	                                        vs
323
	                                    in
324
	                                    let vars' = Vars.add vdecl vars in
325
	                                    vs', vars'
326
	                                  )
327
	                                  (vars_env,Vars.empty)
328
	                                  def_tmps
329
        in 
330
        (* Debug *)
331
        if !debug then (
332
	  report ~level:3 (fun fmt ->
333
	      Format.fprintf  fmt "List of slices: @[<v 0>%a@]@ "
334
	        (Utils.fprintf_list
335
	           ~sep:"@ "
336
	           (fun fmt (id, e_id) ->
337
		     Format.fprintf fmt "(%s,%a) -> %a"
338
		       id
339
		       Printers.pp_var (get_var vars_env' id).vdecl
340
		       (C_backend_common.pp_c_val m "" (C_backend_common.pp_c_var_read m)) (salsa_expr2value_t vars_env' constEnv e_id)
341
	           )
342
	        )
343
	        def_tmps;
344
	      Format.fprintf fmt "Sliced expression: %a@ "
345
	        (C_backend_common.pp_c_val m "" (C_backend_common.pp_c_var_read m)) (salsa_expr2value_t vars_env' constEnv e_salsa)
346
	      ;
337 347
	));
338
      (* Debug *)
339
      
340
      (* Optimize def tmp, and build the associated instructions.  Update the
348
        (* Debug *)
349
        
350
        (* Optimize def tmp, and build the associated instructions.  Update the
341 351
	 abstract Env with computed ranges *)
342
      if !debug && List.length def_tmps >= 1 then (
343
	Log.report ~level:3 (fun fmt -> Format.fprintf fmt "@[<v 3>Optimizing sliced sub-expressions@ ")
344
      );
345
      let rev_def_tmp_instrs, ranges =
346
	List.fold_left (fun (accu_instrs, ranges) (id, e_id) ->
347
	  (* Format.eprintf "Cleaning/Optimizing %s@." id; *)
348
	  let e_id', e_range = (*Salsa.MainEPEG.transformExpression id e_id abstractEnv*)
349
	    opt_num_expr_sliced ranges e_id
350
	  in
351
	  let new_e_id' = try salsa_expr2value_t vars_env' constEnv e_id'  with Not_found -> assert false in
352

  
353
	  let vdecl = (get_var vars_env' id).vdecl in
354
	  
355
	  let new_local_assign =
356
	    (* let expr = salsa_expr2value_t vars_env' constEnv e_id' in *)
357
	    MT.MLocalAssign(vdecl, new_e_id')
358
	  in
359
	  let new_local_assign = {
360
	    MT.instr_desc = new_local_assign;
361
	    MT.lustre_eq = None (* could be Corelang.mkeq Location.dummy_loc
352
        if !debug && List.length def_tmps >= 1 then (
353
	  report ~level:3 (fun fmt -> Format.fprintf fmt "@[<v 3>Optimizing sliced sub-expressions@ ")
354
        );
355
        let rev_def_tmp_instrs, ranges =
356
	  List.fold_left (fun (accu_instrs, ranges) (id, e_id) ->
357
	      (* Format.eprintf "Cleaning/Optimizing %s@." id; *)
358
	      let e_id', e_range = (*Salsa.MainEPEG.transformExpression id e_id abstractEnv*)
359
	        opt_num_expr_sliced ranges e_id
360
	      in
361
	      let new_e_id' = try salsa_expr2value_t vars_env' constEnv e_id'  with Not_found -> assert false in
362

  
363
	      let vdecl = (get_var vars_env' id).vdecl in
364
	      
365
	      let new_local_assign =
366
	        (* let expr = salsa_expr2value_t vars_env' constEnv e_id' in *)
367
	        MT.MLocalAssign(vdecl, new_e_id')
368
	      in
369
	      let new_local_assign = {
370
	          MT.instr_desc = new_local_assign;
371
	          MT.lustre_eq = None (* could be Corelang.mkeq Location.dummy_loc
362 372
				   ([vdecl.LT.var_id], e_id) provided it is
363 373
				   converted as Lustre expression rather than
364 374
				   a Machine code value *);
365
	  }
366
	  in
367
	  let new_ranges =
368
	    match e_range with
369
	      None -> ranges
370
	    | Some e_range -> RangesInt.add_def ranges id e_range in
371
	  new_local_assign::accu_instrs, new_ranges
372
	) ([], ranges) def_tmps
373
      in
374
      if !debug && List.length def_tmps >= 1 then (
375
	Log.report ~level:3 (fun fmt -> Format.fprintf fmt "@]@ ")
376
      );
377

  
378
      (* Format.eprintf "Optimizing main expression %s@.AbstractEnv is %a" (Salsa.Print.printExpression e_salsa) RangesInt.pp ranges; *)
379
      
375
	        }
376
	      in
377
	      let new_ranges =
378
	        match e_range with
379
	          None -> ranges
380
	        | Some e_range -> RangesInt.add_def ranges id e_range in
381
	      new_local_assign::accu_instrs, new_ranges
382
	    ) ([], ranges) def_tmps
383
        in
384
        if !debug && List.length def_tmps >= 1 then (
385
	  report ~level:3 (fun fmt -> Format.fprintf fmt "@]@ ")
386
        );
387

  
388
        (* Format.eprintf "Optimizing main expression %s@.AbstractEnv is %a" (Salsa.Print.printExpression e_salsa) RangesInt.pp ranges; *)
389
        
380 390

  
381
      let expr_salsa, expr_range = opt_num_expr_sliced ranges e_salsa in
382
      let expr = try salsa_expr2value_t vars_env' constEnv expr_salsa   with Not_found -> assert false in
391
        let expr_salsa, expr_range = opt_num_expr_sliced ranges e_salsa in
392
        let expr = try salsa_expr2value_t vars_env' constEnv expr_salsa   with Not_found -> assert false in
383 393

  
384
      expr, expr_range, List.rev rev_def_tmp_instrs, new_local_vars
394
        expr, expr_range, List.rev rev_def_tmp_instrs, new_local_vars
385 395

  
386 396

  
387 397

  
388
     (* ???? Bout de code dans unstable lors du merge avec salsa ? 
398
    (* ???? Bout de code dans unstable lors du merge avec salsa ? 
389 399
      ====
390 400

  
391 401
      let new_e = try salsa_expr2value_t vars_env' constEnv new_e_salsa   with Not_found -> assert false in
......
412 422
	e, None, []
413 423
      )
414 424
>>>>>>> unstable
415
      *)
425
     *)
416 426
    )
417 427

  
418 428

  
419
      
429
    
420 430
  in
421 431
  opt_expr m vars_env ranges formalEnv e  
422 432
    
......
431 441
      (FormalEnv.get_sort_fun formalEnv) 
432 442
      (Vars.elements vars_to_print) 
433 443
  in
434
  if !debug then Log.report ~level:4 (fun fmt -> Format.fprintf fmt
444
  if !debug then report ~level:4 (fun fmt -> Format.fprintf fmt
435 445
    "Printing vars in the following order: [%a]@ "
436 446
    (Utils.fprintf_list ~sep:", " Printers.pp_var) ordered_vars);
437 447
  
438 448
  List.fold_right (
439 449
    fun v (accu_instr, accu_ranges, accu_new_locals) -> 
440
      if !debug then  Log.report ~level:4 (fun fmt -> Format.fprintf fmt "Printing assign for variable %s@ " v.LT.var_id);
450
      if !debug then report ~level:4 (fun fmt -> Format.fprintf fmt "Printing assign for variable %s@ " v.LT.var_id);
441 451
      try
442 452
	(* Obtaining unfold expression of v in formalEnv *)
443 453
	let v_def = FormalEnv.get_def formalEnv v  in
......
824 834
  let unused = (Vars.diff all_local_vars printed_vars) in
825 835
  let locals =
826 836
    if not (Vars.is_empty unused) then (
827
      if !debug then Log.report ~level:2 (fun fmt -> Format.fprintf fmt  "Unused local vars: [%a]. Removing them.@ "
837
      if !debug then report ~level:2 (fun fmt -> Format.fprintf fmt  "Unused local vars: [%a]. Removing them.@ "
828 838
	Vars.pp unused);
829 839
      List.filter (fun v -> not (Vars.mem v unused)) s.MT.step_locals
830 840
    )
......
837 847

  
838 848
let machine_t2machine_t_optimized_by_salsa constEnv  mt =
839 849
  try
840
    if !debug then Log.report ~level:2 (fun fmt -> Format.fprintf fmt "@[<v 3>[salsa] Optimizing machine %s@ " mt.MT.mname.LT.node_id);
850
    if !debug then report ~level:2 (fun fmt -> Format.fprintf fmt "@[<v 3>Optimizing machine %s@ " mt.MT.mname.LT.node_id);
841 851
    let new_step = salsaStep constEnv  mt mt.MT.mstep in
842
    if !debug then Log.report ~level:2 (fun fmt -> Format.fprintf fmt "@]@ ");
852
    if !debug then report ~level:2 (fun fmt -> Format.fprintf fmt "@]@ ");
843 853
    { mt with MT.mstep = new_step } 
844 854
    
845 855
      
src/plugins/salsa/salsa_plugin.ml
5 5
    (* "-salsa", Arg.Set salsa_enabled, "activate Salsa optimization <default>"; *)
6 6
    (* "-no-salsa", Arg.Clear salsa_enabled, "deactivate Salsa optimization"; *)
7 7

  
8

  
8
  
9
  
9 10
module Plugin =
10 11
(struct
11 12
  include PluginType.Default
......
13 14
  
14 15
  let options = [
15 16
        "-debug", Arg.Set SalsaDatatypes.debug, "debug salsa plugin";
17
        "-verbose", Arg.Set_int Salsa.Log.verbose_level, "salsa plugin verbose level (default is 0)";
16 18
        "-slice-depth", Arg.Set_int Salsa.Prelude.sliceSize, "salsa slice depth (default is 5)";
17 19
        "-disable", Arg.Clear salsa_enabled, "disable salsa";
18 20
    ]
19 21

  
20
  let activate () = salsa_enabled := true
21

  
22
  let activate () =
23
    salsa_enabled := true
24
    
25
  let init () =
26
    if !salsa_enabled then
27
      if  !SalsaDatatypes.debug then
28
        Salsa.Log.debug := true
29
  
22 30
  let refine_machine_code prog machine_code = 
23 31
    if !salsa_enabled then
24 32
      begin
src/plugins/scopes/scopes.ml
361 361
    include PluginType.PluginType
362 362
    val show_scopes: unit -> bool
363 363
    end) =
364
struct
365
  let name = "scopes"
366
  let is_active () = 
367
    !option_scopes || !option_show_scopes || !option_all_scopes
368
  (* || !option_mem_scopes || !option_input_scopes *)
364
  struct
365
    include PluginType.Default
366
    let name = "scopes"
367
    let is_active () = 
368
      !option_scopes || !option_show_scopes || !option_all_scopes
369
    (* || !option_mem_scopes || !option_input_scopes *)
369 370
      
370
  let show_scopes () = 
371
    !option_show_scopes && (
372
      Compiler_common.check_main ();
373
      true)
374

  
375
  let options = [
376
    "-select", Arg.String register_scopes, "specifies which variables to log";
377
    "-input", Arg.String register_inputs, "specifies the simulation input";
378
    "-show-possible-scopes", Arg.Set option_show_scopes, "list possible variables to log";
379
    "-select-all", Arg.Unit register_all_scopes, "select all possible variables to log";
380
    (* "-select-mems", Arg.Set option_mems_scopes, "select all memory variables to log";
381
     * "-select-inputs", Arg.Set option_input_scopes, "select all input variables to log"; *)
382
  ]
371
    let show_scopes () = 
372
      !option_show_scopes && (
373
        Compiler_common.check_main ();
374
        true)
375

  
376
    let usage fmt =
377
      let open Format in
378
      fprintf fmt "@[<hov 0>Scopes@ enrich@ the@ internal@ memories@ to@ record@ all@ or@ a@ selection@ of@ internals.@ In@ conjunction@ with@ the@ trace@ option@ of@ the@ produced@ binary@ it@ can@ also@ record@ these@ flow@ values@ within@ separated@ log@ files.@]@ @ ";
379
      fprintf fmt "Options are:@ "
380
    
381
    let options = [
382
        "-select", Arg.String register_scopes, "specifies which variables to log";
383
        "-input", Arg.String register_inputs, "specifies the simulation input";
384
        "-show-possible-scopes", Arg.Set option_show_scopes, "list possible variables to log";
385
        "-select-all", Arg.Unit register_all_scopes, "select all possible variables to log";
386
(* "-select-mems", Arg.Set option_mems_scopes, "select all memory variables to log";
387
 * "-select-inputs", Arg.Set option_input_scopes, "select all input variables to log"; *)
388
      ]
383 389

  
384 390
  let activate = activate
385 391

  
......
389 395
    if show_scopes () then
390 396
      begin
391 397
	let all_scopes = compute_scopes prog !Options.main_node in
392
      (* Printing scopes *)
393
      if !Options.verbose_level >= 1 then
394
	Format.printf "Possible scopes are:@   ";
395
	Format.printf "@[<v>%a@ @]@.@?" print_scopes all_scopes;
398
        (* Printing scopes *)
399
        if !Options.verbose_level >= 1 then 
400
	  Format.printf "Possible scopes are:@ ";
401
	Format.printf "@[<v 0>%a@ @]@.@?" print_scopes all_scopes;
396 402
	exit 0
397 403
      end;
398 404
    if is_active () then

Also available in: Unified diff