Project

General

Profile

« Previous | Next » 

Revision 5360dcf8

Added by Arnaud Dieumegard over 3 years ago

Beggining of implicit latching check

View differences:

src/backends/VHDL/mini_vhdl_ast.ml
50 50
and mini_vhdl_if_case_t =
51 51
  {
52 52
    if_cond: vhdl_expr_t;
53
    if_block: mini_vhdl_sequential_stmt_t list;
53
    if_block_mini: mini_vhdl_sequential_stmt_t list;
54 54
  }
55 55
and mini_vhdl_case_item_t = 
56 56
  {
57 57
    when_cond: vhdl_expr_t list;
58
    when_stmt: mini_vhdl_sequential_stmt_t list;
58
    when_stmt_mini: mini_vhdl_sequential_stmt_t list;
59 59
  }
60 60

  
61 61
and mini_vhdl_declaration_t =
src/backends/VHDL/mini_vhdl_ast_pp.ml
310 310
                       ((__1 ()) fmt) x;
311 311
                       Format.fprintf fmt ";";
312 312
                       true) false x);
313
          )) x.if_block;)
313
          )) x.if_block_mini;)
314 314
    [@ocaml.warning "-A"])
315 315

  
316 316
and show_mini_vhdl_if_case_t :
......
344 344
                         if sep then Format.fprintf fmt "@;";
345 345
                         ((__1 ()) fmt) x;
346 346
                         Format.fprintf fmt ";";
347
                         true) ((List.length x) > 1) x);) x.when_stmt;
347
                         true) ((List.length x) > 1) x);) x.when_stmt_mini;
348 348
           Format.fprintf fmt "@]")
349 349
    [@ocaml.warning "-A"])
350 350

  
src/backends/VHDL/vhdl_2_mini_vhdl_map.ml
305 305
        | SigCondAssign { label; lhs; rhs; delay} -> [lhs]
306 306
        | SigSelectAssign { label; lhs; sel; branches; delay } -> [lhs]
307 307
        | If { label; if_cases; default } -> 
308
            let if_cases_stmts = List.flatten (List.map (fun x -> x.if_block) if_cases) in
308
            let if_cases_stmts = List.flatten (List.map (fun x -> x.if_block_mini) if_cases) in
309 309
            List.flatten (List.map self#mini_vhdl_sequential_stmt_t_assigned_signals_names (if_cases_stmts@default))
310 310
        | Case { label; guard; branches } ->
311
            let case_branches_stmts = List.flatten (List.map (fun x -> x.when_stmt) branches) in
311
            let case_branches_stmts = List.flatten (List.map (fun x -> x.when_stmt_mini) branches) in
312 312
            List.flatten (List.map self#mini_vhdl_sequential_stmt_t_assigned_signals_names case_branches_stmts)
313 313
        | ProcedureCall { label; name; assocs } -> [] (* TODO: resolve this *)
314 314
        | _ -> []
......
331 331
      fun assigned_signals -> fun mems -> fun x ->
332 332
        match x with
333 333
        | If { label; if_cases; default } ->
334
            let if_cases_stmts = List.map (fun x -> x.if_block) if_cases in
334
            let if_cases_stmts = List.map (fun x -> x.if_block_mini) if_cases in
335 335
            let if_cases_assigned_signals = 
336 336
              List.map self#mini_vhdl_sequential_stmt_t_assigned_signals_names (List.flatten (if_cases_stmts@[default])) in
337 337
            let if_cases_memories = List.flatten (List.map (fun x -> List.flatten (List.map (self#memories assigned_signals []) x)) (if_cases_stmts@[default])) in
338 338
            let mems = if_cases_memories@mems in
339

  
340 339
            (match default with
341 340
              | [] -> (List.flatten if_cases_assigned_signals)@mems
342 341
              | _ -> mems)
343 342
        | Case { label; guard; branches } ->
344
            let case_branches_stmts = List.map (fun x -> x.when_stmt) branches in
343
            let case_branches_stmts = List.map (fun x -> x.when_stmt_mini) branches in
345 344
         (*   let case_assigned_signals = List.map self#mini_vhdl_sequential_stmt_t_assigned_signals_names (List.flatten (case_branches_stmts)) in *)
346 345
            let cases_memories = List.flatten (List.map (fun x -> List.flatten (List.map (self#memories assigned_signals []) x)) (case_branches_stmts)) in
347 346
            cases_memories@mems
......
662 661
    method vhdl_if_case_t : vhdl_if_case_t -> mini_vhdl_if_case_t=
663 662
      fun { if_cond; if_block }  ->
664 663
        let if_cond = self#vhdl_expr_t if_cond  in
665
        let if_block = List.map self#vhdl_sequential_stmt_t if_block  in
666
        { if_cond; if_block }
664
        let if_block_mini = List.map self#vhdl_sequential_stmt_t if_block  in
665
        { if_cond; if_block_mini }
667 666

  
668 667
    method vhdl_case_item_t : vhdl_case_item_t -> mini_vhdl_case_item_t=
669 668
      fun { when_cond; when_stmt }  ->
670 669
        let when_cond = self#list self#vhdl_expr_t when_cond  in
671
        let when_stmt = List.map self#vhdl_sequential_stmt_t when_stmt  in
672
        { when_cond; when_stmt }
670
        let when_stmt_mini = List.map self#vhdl_sequential_stmt_t when_stmt  in
671
        { when_cond; when_stmt_mini }
673 672

  
674 673
    method vhdl_declaration_t : vhdl_declaration_t -> mini_vhdl_declaration_t=
675 674
      fun x  ->
src/tools/importer/main_lustre_importer.ml
16 16
open Mini_vhdl_ast
17 17
open Mini_vhdl_ast_pp
18 18
open Vhdl_ast_pp
19
(*open Vhdl_ast_yojson*)
20 19
open Mini_vhdl_check
21 20
open Printf
22 21
open Printers
src/tools/importer/mini_vhdl_check.ml
1 1
open Vhdl_ast
2
open Mini_vhdl_ast
2
open Vhdl_ast_pp
3 3
open Vhdl_2_mini_vhdl_map
4 4
open Mini_vhdl_utils
5 5

  
......
10 10
  | "" -> ()
11 11
  | _ -> match level with
12 12
    | INFO -> Printf.printf    "<INFO> %s" s
13
    | WARNING -> Printf.printf "<WARNING =%s=> %s" code s
14
    | ERROR -> Printf.printf   "<ERROR =%s=> %s" code s
13
    | WARNING -> Printf.printf "<WARN_%s> %s" code s
14
    | ERROR -> Printf.printf   "<ERR_%s> %s" code s
15

  
16
let separator s = 
17
  Printf.printf "----------%s----------\n" (String.make (String.length s) '-');
18
  Printf.printf "--------- %s ---------\n" s;
19
  Printf.printf "----------%s----------\n" (String.make (String.length s) '-')
15 20

  
16 21
let filter_display s l to_string_name = match l with
17 22
  | [] -> ""
......
65 70
          then print ~level:level ~code:code (Printf.sprintf " Missing assignment of %s" (filter_display "signal" missing to_string_name))
66 71
          else ()
67 72

  
68
let count_architecture : (vhdl_name_t -> string) -> string -> level -> db_tuple_t -> unit=
73
(* let count_architecture : (vhdl_name_t -> string) -> string -> level -> db_tuple_t -> unit=
69 74
  fun to_string_name -> fun code -> fun level ->
70 75
      fun {entity; architecture; architecture_signals; architecture_ports; architecture_generics; assigned_signals_names; contexts} ->
71 76
        let count (e : vhdl_architecture_t) : (int * int) =
......
87 92
          (visitor#count_sig, visitor#count_var) in
88 93
        let (nb_sig, nb_var) = (count architecture) in
89 94
        print ~level:level ~code:code (Printf.sprintf "  Nb signals declarations in archi %s : %d\n" (to_string_name architecture.a_name) nb_sig);
90
        print ~level:level ~code:code (Printf.sprintf "  Nb variables declarations in archi %s : %d\n" (to_string_name architecture.a_name) nb_var)
95
        print ~level:level ~code:code (Printf.sprintf "  Nb variables declarations in archi %s : %d\n" (to_string_name architecture.a_name) nb_var) *)
96

  
97
let latches_detection : (vhdl_name_t -> string) -> string -> level -> db_tuple_t -> unit=
98
  fun to_string_name -> fun code -> fun level ->
99
      fun {entity; architecture; architecture_signals; architecture_ports; architecture_generics; assigned_signals_names; contexts} ->
100

  
101
(*        
102
        let in_ports_names = List.flatten (List.map get_names (get_ports architecture_ports InPort)) in
103
        let out_ports_names = List.flatten (List.map get_names (get_ports architecture_ports OutPort)) in
104
        let inout_ports_names = List.flatten (List.map get_names (get_ports architecture_ports InoutPort)) in
105
        let sigs_names = List.flatten (List.map mini_vhdl_declaration_t_names architecture_signals) in
106
        let arch_writable_signals = inout_ports_names@sigs_names@out_ports_names in
107
        let arch_readable_signals = inout_ports_names@sigs_names@in_ports_names in
108
*)
109
        
110
        let get_latched_processes (arch : vhdl_architecture_t) : (vhdl_process_t * vhdl_sequential_stmt_t) list =
111
          let visitor = object (self)
112
            val mutable current_process = []
113
            val mutable latched_processes = []
114
            method current_process = current_process
115
            method latched_processes = latched_processes
116
            
117
            inherit [_] vhdl_iter as super_vhdl
118
          
119
            method! visit_vhdl_process_t env p =
120
              current_process <- [p];
121
              List.iter (super_vhdl#visit_vhdl_sequential_stmt_t env) p.p_body
122

  
123
            method! visit_vhdl_sequential_stmt_t env s =
124
              match s with
125
              | If ({label; if_cases; default}) -> 
126
                  (match default with 
127
                  | [] -> latched_processes <- ((List.hd current_process), s)::latched_processes;
128
                  | _ -> ();
129
                  (match if_cases with
130
                  | [] -> () 
131
                  | _ -> 
132
                      let sub_seq_stmts = List.flatten (List.map (function x -> x.if_block) if_cases) in
133
                      List.iter (self#visit_vhdl_sequential_stmt_t env) sub_seq_stmts))
134
              | Case ({label; guard; branches}) ->
135
                  let cond_exprs = guard::(List.flatten (List.map (function x -> x.when_cond) branches)) in
136
                  let sub_seq_stmts = List.flatten (List.map (function x -> x.when_stmt) branches) in
137
                  let has_others = List.exists (function c -> match c with | Others -> true | _ -> false) cond_exprs in
138
                  (* TODO: Needs something like: is_exhaustive_mapping cond_exprs *) (*let is_exhaustive_mapping = false in*)
139
                  if (not (has_others)) then (* Add test for is_exhaustive_mapping *)
140
                    latched_processes <- ((List.hd current_process), s)::latched_processes;
141
                  List.iter (self#visit_vhdl_sequential_stmt_t env) sub_seq_stmts
142
              | _ -> super_vhdl#visit_vhdl_sequential_stmt_t env s
143
            end
144
          in
145
          visitor#visit_vhdl_architecture_t () arch;
146
          visitor#latched_processes in
147
        List.iter (function (p,s) -> 
148
          print ~level:level ~code:code (
149
            Printf.sprintf "  Potentially latched process [%s] in architecture [%s]. See statement: \n%s\n"
150
              (to_string_name p.id)
151
              (to_string_name architecture.a_name)
152
              (show_vhdl_sequential_stmt_t s)
153
            )
154
          ) (get_latched_processes architecture)
91 155

  
92 156
let checks = [
93 157
  ("#E001",ERROR,check_error_duplicate_signal_assignment);
94 158
  ("#W001",WARNING,check_missing_signal_assignment);
95
  ("#I001",INFO,count_architecture)
159
  ("#W002",WARNING,latches_detection)
160
(*  ("#I001",INFO,count_architecture)*)
96 161
]
97 162

  
98 163
(**
......
103 168
    | [] -> ()
104 169
    | (code,level,check)::tl -> check to_string_name code level x; iter_checks tl x in
105 170
  let disp_and_check x =
171
    separator "Structure";
106 172
    display_struct_content to_string_name x;
173
    separator "Checks";
107 174
    iter_checks checks x in
108 175
  List.iter disp_and_check db;
src/tools/importer/mini_vhdl_to_lustre.ml
316 316
            Return { label; expr }*)
317 317

  
318 318
    method mini_vhdl_if_case_t : mini_vhdl_if_case_t -> mini_vhdl_if_case_t=
319
      fun { if_cond; if_block }  ->
319
      fun { if_cond; if_block_mini }  ->
320 320
        let if_cond = self#vhdl_expr_t if_cond  in
321
        let if_block = self#list self#mini_vhdl_sequential_stmt_t if_block
321
        let if_block_mini = self#list self#mini_vhdl_sequential_stmt_t if_block_mini
322 322
           in
323
        { if_cond; if_block }
323
        { if_cond; if_block_mini }
324 324

  
325 325
    method mini_vhdl_case_item_t :
326 326
      mini_vhdl_case_item_t -> mini_vhdl_case_item_t=
327
      fun { when_cond; when_stmt }  ->
327
      fun { when_cond; when_stmt_mini }  ->
328 328
        let when_cond = self#list self#vhdl_expr_t when_cond  in
329
        let when_stmt = self#list self#mini_vhdl_sequential_stmt_t when_stmt
329
        let when_stmt_mini = self#list self#mini_vhdl_sequential_stmt_t when_stmt_mini
330 330
           in
331
        { when_cond; when_stmt }
331
        { when_cond; when_stmt_mini }
332 332

  
333 333
    method mini_vhdl_declaration_t :
334 334
      mini_vhdl_declaration_t -> var_decl list=

Also available in: Unified diff