Project

General

Profile

« Previous | Next » 

Revision 5360dcf8

Added by Arnaud Dieumegard over 3 years ago

Beggining of implicit latching check

View differences:

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;

Also available in: Unified diff