Hog v10.13.0
hdl_parser.tcl
Go to the documentation of this file.
1 
2 proc token_value {token} { return [dict get $token value ] }
3 proc token_type {token} { return [dict get $token type ] }
4 proc token_line {token} { return [dict get $token line ] }
5 proc token_col {token} { return [dict get $token col ] }
6 
7 proc tokenize {code token_patterns keywords {case_sensitive 1}} {
8  set tokens {}
9  set line 1
10  set line_start 0
11  set cursor 0
12 
13  set keyword_dict [dict create]
14  foreach kw $keywords {
15  dict set keyword_dict $kw 1
16  }
17 
18  set code_len [string length $code]
19  while {$cursor < $code_len} {
20  set found_match 0
21 
22 
23  # this is an attempt at "optimizing" the regex matching by only checking a window of the code
24  # we double the window size if no match is found and try again
25  set window_size 200
26  while {!$found_match && $cursor < $code_len} {
27  set window_end [expr {min($cursor + $window_size - 1, $code_len - 1)}]
28  set window [string range $code $cursor $window_end]
29 
30  foreach item $token_patterns {
31  set type [lindex $item 0]
32  set pattern [lindex $item 1]
33  # set re [string cat {^(} $pattern {)}]
34  set re "^($pattern)"
35 
36  if {[regexp -- $re $window allmatch submatch]} {
37  set value $submatch
38  set match_len [string length $allmatch]
39 
40  set column [expr {$cursor - $line_start + 1}]
41 
42  if {$type == "NEWLINE"} {
43  incr line
44  set line_start [expr {$cursor + $match_len}]
45  } elseif {$type != "WHITESPACE" && $type != "COMMENT"} {
46 
47  if {!$case_sensitive} {
48  set value [string tolower $value]
49  }
50 
51  if {$type == "IDENTIFIER" && [dict exists $keyword_dict $value]} {
52  set type "KEYWORD"
53  }
54  lappend tokens [dict create type $type value $value line $line column $column]
55  }
56 
57  set cursor [expr {$cursor + $match_len}]
58  set found_match 1
59  break
60  }
61  }
62 
63  if {!$found_match && $window_end >= $code_len - 1} {
64  break
65  }
66 
67  if {!$found_match} {
68  set window_size [expr {$window_size * 2}]
69  Msg Warning "No match found at index $cursor, increasing window size to $window_size"
70  }
71  }
72 
73  if {!$found_match} {
74  puts stderr "Error: Tokenizer stuck at index $cursor on char '[string index $code $cursor]'"
75  incr cursor
76  }
77  }
78 
79  return $tokens
80 }
81 
82 
83 # hdl_node
84 # type: "vhdl_entity", "vhdl_architecture", "verilog_module", etc.
85 # name: module name
86 # file_path: path to the source file
87 # line: line number of declaration
88 # entity: name of the parent entity, for arch/body
89 # libraries: [
90 # library_node dict {
91 # name: library name, e.g., "ieee"
92 # uses: list of usesg, e.g., "IEEE.STD_LOGIC_1164.all"
93 # }
94 # ]
95 # components_declared: [
96 # component_node dict {
97 # name: component name
98 # line: line number
99 # }
100 # ]
101 # instantiations: [
102 # instantiation_node dict {
103 # mod_name: name of the instantiated module
104 # type: "entity_inst", "component_inst"
105 # inst_name: instance label
106 # line: line number
107 # }
108 # ]
109 
110 proc create_hdl_node {type name file_path line {libraries ""} {components_declared ""} {instantiations ""} {entity ""}} {
111  return [dict create type $type name $name file_path $file_path line $line \
112  libraries $libraries components_declared $components_declared instantiations $instantiations entity $entity]
113 }
114 
115 proc create_instantiation_node {mod_name type inst_name line} {
116  return [dict create mod_name $mod_name type $type inst_name $inst_name line $line]
117 }
118 
119 proc hdl_node_string {hdl_node} {
120 
121  set node_info "Node Type: [dict get $hdl_node type]"
122  append node_info "\n Name: [dict get $hdl_node name]"
123  append node_info "\n File Path: [dict get $hdl_node file_path]"
124  append node_info "\n Declared on line: [dict get $hdl_node line]"
125  if {[dict exists $hdl_node entity] && [dict get $hdl_node entity] ne ""} {
126  append node_info "\n Entity: [dict get $hdl_node entity]"
127  }
128 
129  if {[dict get $hdl_node type] eq "vhdl_entity" || [dict get $hdl_node type] eq "vhdl_package" \
130  || [dict get $hdl_node type] eq "vhdl_architecture" || [dict get $hdl_node type] eq "vhdl_package_body"} {
131  append node_info "\n Libraries:"
132  set libraries [dict get $hdl_node libraries]
133  if {[llength $libraries] == 0} {
134  append node_info " (None)"
135  } else {
136  foreach lib $libraries {
137  append node_info "\n - Library: [dict get $lib name]"
138  set uses [dict get $lib uses]
139  if {[llength $uses] > 0} {
140  append node_info "\n Uses:"
141  foreach use $uses {
142  append node_info "\n - $use"
143  }
144  }
145  }
146  }
147 
148  if {[dict get $hdl_node type] eq "vhdl_architecture"} {
149  append node_info "\n Components Declared:"
150  set components_declared [dict get $hdl_node components_declared]
151  if {[llength $components_declared] == 0} {
152  append node_info " (None)"
153  } else {
154  foreach comp $components_declared {
155  append node_info "\n - [dict get $comp name] (line [dict get $comp line])"
156  }
157  }
158  append node_info "\n Instantiations:"
159  set instantiations [dict get $hdl_node instantiations]
160  if {[llength $instantiations] == 0} {
161  append node_info " (None)"
162  } else {
163  foreach inst $instantiations {
164  # tclint-disable-next-line line-length
165  append node_info "\n - Name: [dict get $inst mod_name], Instance: [dict get $inst inst_name] type: [dict get $inst type] (line [dict get $inst line])"
166  }
167  }
168  }
169  } elseif {[dict get $hdl_node type] eq "verilog_module"} {
170  append node_info "\n Instantiations:"
171  set instantiations [dict get $hdl_node instantiations]
172  if {[llength $instantiations] == 0} {
173  append node_info " (None)"
174  } else {
175  foreach inst $instantiations {
176  # tclint-disable-next-line line-length
177  append node_info "\n - Name: [dict get $inst mod_name], Instance: [dict get $inst inst_name] type: [dict get $inst type] (line [dict get $inst line])"
178  }
179  }
180  }
181 
182  return $node_info
183 }
184 
185 
186 
187 
188 
189 
190 ########## VERILOG #########
191 
192 set verilog_keywords {
193  always and assign automatic
194  begin buf bufif0 bufif1 case casex
195  casez cell cmos config
196  deassign default defparam design disable
197  edge else end endcase endconfig endfunction endgenerate
198  endmodule endpackage endprimitive endspecify endtable endtask event
199  for force forever fork function generate genvar highz0
200  highz1 if ifnone incdir include initial inout input instance integer
201  join large liblist library localparam macromodule medium module nand negedge
202  nmos nor noshowcancelled not notif0 notif1 or output package parameter pmos
203  posedge primitive pull0 pull1 pulldown pullup pulsestyle_onevent pulsestyle_ondetect rcmos real
204  realtime reg release repeat rnmos rpmos rtran rtranif0 rtranif1 scalared
205  showcancelled signed small specify specparam strong0 strong1 supply0 supply1 table
206  task time tran tranif0 tranif1 tri tri0 tri1 triand trior
207  trireg unsigned1 use uwire vectored wait wand weak0 weak1 while
208  wire wor xnor xor
209 }
210 
211 set verilog_token_patterns {
212  {COMMENT {//[^\n]*|/\*.*?\*/}}
213  {NEWLINE {\n}}
214  {WHITESPACE {[ \t\r]+}}
215  {STRING {"[^\"]*"}}
216  {NUMBER {\d['\d_hHbsodxza-fA-F]*}}
217  {IDENTIFIER {[a-zA-Z_][a-zA-Z0-9_$]*}}
218  {OPERATOR {[+\-*/%<>=!&|~^?@:]+}}
219  {LPAREN {\(}}
220  {RPAREN {\)}}
221  {LBRACE {\{}}
222  {RBRACE {\}}}
223  {LBRACK {\[}}
224  {RBRACK {\]}}
225  {COMMA {,}}
226  {SEMICOLON {;}}
227  {DOT {\.}}
228  {POUND {#}}
229  {DIRECTIVE {\`[a-zA-Z_][a-zA-Z0-9_]*}}
230  {MISMATCH {.}}
231 }
232 
233 proc tokenize_verilog {code} {
234  global verilog_token_patterns verilog_keywords
235  return [tokenize $code $verilog_token_patterns $verilog_keywords 1]
236 }
237 
238 proc find_verilog_constructs {tokens filename} {
239  set results [list]
240  set state "TOP_LEVEL"
241  set current_module ""
242  set current_module_insts [list]
243  set current_package ""
244  set current_package_insts [list]
245  set package_start_line 0
246  set sv_pending_imports [list]
247 
248  for {set i 0} {$i < [llength $tokens]} {incr i} {
249  set token [lindex $tokens $i]
250  set type [token_type $token]
251  set value [token_value $token]
252 
253  # Detect SV package imports: import pkg_name :: ...
254  # "import" is not a Verilog keyword so it is tokenized as IDENTIFIER.
255  if {$type == "IDENTIFIER" && $value == "import"} {
256  if {$i + 2 < [llength $tokens]} {
257  set t1 [lindex $tokens [expr {$i + 1}]]
258  set t2 [lindex $tokens [expr {$i + 2}]]
259  if {[token_type $t1] == "IDENTIFIER" &&
260  [token_type $t2] == "OPERATOR" && [string match "::*" [token_value $t2]]} {
261  set pkg_name [token_value $t1]
262  set import_node [create_instantiation_node $pkg_name "sv_import" "" [token_line $token]]
263  if {$state == "TOP_LEVEL"} {
264  lappend sv_pending_imports $import_node
265  } elseif {$state == "IN_MODULE_HEADER" || $state == "IN_MODULE_BODY"} {
266  lappend current_module_insts $import_node
267  } elseif {$state == "IN_PACKAGE_BODY"} {
268  lappend current_package_insts $import_node
269  }
270  incr i
271  continue
272  }
273  }
274  }
275 
276  # Detect `include directives: `include "file.svh" or `include <file.svh>
277  if {$type == "DIRECTIVE" && $value == "`include"} {
278  set include_file ""
279  if {$i + 1 < [llength $tokens]} {
280  set t1 [lindex $tokens [expr {$i + 1}]]
281  if {[token_type $t1] == "STRING"} {
282  set include_file [string trim [token_value $t1] "\""]
283  incr i
284  } elseif {[token_type $t1] == "OPERATOR" && [token_value $t1] == "<"} {
285  incr i
286  while {$i + 1 < [llength $tokens]} {
287  incr i
288  set t [lindex $tokens $i]
289  if {[token_type $t] == "OPERATOR" && [string match ">*" [token_value $t]]} {
290  break
291  }
292  append include_file [token_value $t]
293  }
294  }
295  }
296  if {$include_file ne ""} {
297  set inc_node [create_instantiation_node $include_file "sv_include" "" \
298  [token_line $token]]
299  if {$state == "TOP_LEVEL"} {
300  lappend sv_pending_imports $inc_node
301  } elseif {$state == "IN_MODULE_HEADER" || $state == "IN_MODULE_BODY"} {
302  lappend current_module_insts $inc_node
303  } elseif {$state == "IN_PACKAGE_BODY"} {
304  lappend current_package_insts $inc_node
305  }
306  }
307  continue
308  }
309 
310  if {$state == "TOP_LEVEL"} {
311  if {$type == "KEYWORD" && $value == "module"} {
312  if {$i + 1 < [llength $tokens]} {
313  set next_token [lindex $tokens [expr {$i + 1}]]
314  if {[token_type $next_token] == "IDENTIFIER"} {
315  set current_module [token_value $next_token]
316  set state "IN_MODULE_HEADER"
317  set current_module_insts $sv_pending_imports
318  set sv_pending_imports [list]
319  }
320  }
321  } elseif {$type == "KEYWORD" && $value == "package"} {
322  # Skip "package import" statements — they are import declarations,
323  # not package definitions.
324  if {$i + 1 < [llength $tokens]} {
325  set next_token [lindex $tokens [expr {$i + 1}]]
326  if {[token_type $next_token] == "IDENTIFIER"} {
327  set current_package [token_value $next_token]
328  set package_start_line [token_line $token]
329  set state "IN_PACKAGE_BODY"
330  set current_package_insts $sv_pending_imports
331  set sv_pending_imports [list]
332  }
333  }
334  }
335  } elseif {$state == "IN_MODULE_HEADER"} {
336  if {$type == "SEMICOLON"} {
337  set state "IN_MODULE_BODY"
338  }
339  } elseif {$state == "IN_MODULE_BODY"} {
340  if {$type == "KEYWORD" && $value == "endmodule"} {
341 
342  set decl_node [create_hdl_node "verilog_module" $current_module $filename [dict get $token line] "" "" $current_module_insts]
343  lappend results $decl_node
344 
345  set state "TOP_LEVEL"
346  set current_module ""
347  continue
348  }
349 
350  if {$type == "IDENTIFIER"} {
351  if {$i + 2 < [llength $tokens]} {
352  set token2 [lindex $tokens [expr {$i + 1}]]
353  set token3 [lindex $tokens [expr {$i + 2}]]
354 
355  if {[token_type $token2 ] == "IDENTIFIER" && [token_type $token3] == "LPAREN"} {
356  set inst_dict [create_instantiation_node $value "inst" [token_value $token2] [token_line $token]]
357  lappend current_module_insts $inst_dict
358  } elseif {[token_type $token2] == "POUND" && [token_type $token3] == "LPAREN"} {
359  # find last )
360  set old_token $token
361  incr i 3
362  set depth 1
363  while {$i < [llength $tokens]} {
364  set token [lindex $tokens $i]
365  if {[token_type $token] == "LPAREN" } {
366  incr depth
367  }
368 
369  if {[token_type $token] == "RPAREN" } {
370  incr depth -1
371  if {$depth == 0} {
372  incr i
373  break
374  }
375  }
376  incr i
377  }
378 
379  set token [lindex $tokens $i]
380  if {[token_type $token] == "IDENTIFIER"} {
381  set inst_dict [create_instantiation_node [token_value $old_token] "inst" [token_value $token] [token_line $token]]
382  lappend current_module_insts $inst_dict
383  }
384  }
385  }
386  }
387  } elseif {$state == "IN_PACKAGE_BODY"} {
388  if {$type == "KEYWORD" && $value == "endpackage"} {
389  set decl_node [create_hdl_node "sv_package" $current_package $filename \
390  $package_start_line "" "" $current_package_insts]
391  lappend results $decl_node
392  set state "TOP_LEVEL"
393  set current_package ""
394  set current_package_insts [list]
395  }
396  }
397  }
398  return $results
399 }
400 
401 
402 ########## VHDL ##########
403 
404 set vhdl_keywords {
405  abs access after alias all and architecture array assert attribute
406  begin block body buffer bus case component configuration constant
407  disconnect downto else elsif end entity exit file for function
408  generate generic group guarded if impure in inertial inout is
409  label library linkage literal loop map mod nand new next nor not
410  null of on open or others out package port postponed procedure
411  process pure range record register reject rem report return rol
412  ror select severity signal shared sla sll sra srl subtype then
413  to transport type unaffected units until use variable wait when
414  while with xnor xor
415 }
416 
417 set vhdl_token_patterns {
418  {COMMENT {--[^\n]*}}
419  {NEWLINE {\n}}
420  {WHITESPACE {[ \t\r]+}}
421  {STRING {"[^"]*"}}
422  {CHAR_LITERAL {'[^']'}}
423  {NUMBER {\d['\d_.]*}}
424  {IDENTIFIER {[a-zA-Z][a-zA-Z0-9_]*}}
425  {OPERATOR {[:=<>|/*&.+-]}}
426  {LPAREN {\(}}
427  {RPAREN {\)}}
428  {COMMA {,}}
429  {SEMICOLON {;}}
430  {MISMATCH {.}}
431 }
432 
433 proc tokenize_vhdl {code} {
434  global vhdl_token_patterns vhdl_keywords
435  return [tokenize $code $vhdl_token_patterns $vhdl_keywords 0]
436 }
437 
438 
439 proc parse_vhdl_architecture_header {tokens index} {
440  set architecture_components [list]
441  set architecture_pkg_insts [list]
442  set i $index
443  for {set i $index} {$i < [llength $tokens]} {incr i} {
444  set token [lindex $tokens $i]
445  set type [token_type $token]
446  set value [token_value $token]
447 
448  if {$type == "KEYWORD" && $value == "begin"} {
449  break
450  }
451 
452  # Look for component declarations
453  if {$type == "KEYWORD" && $value == "component"} {
454  if {[expr {$i + 2}] < [llength $tokens]} {
455  set comp_name_tok [lindex $tokens [expr {$i + 1}]]
456  set is_tok [lindex $tokens [expr {$i + 2}]]
457 
458  if {[token_type $comp_name_tok] == "IDENTIFIER" &&
459  [token_type $is_tok] == "KEYWORD" && [token_value $is_tok] == "is"} {
460  lappend architecture_components [dict create name [token_value $comp_name_tok] line [token_line $comp_name_tok]]
461  }
462  }
463  }
464 
465  # Generic package instantiation: package NAME is new LIB.PKG ...;
466  if {$type == "KEYWORD" && $value == "package"} {
467  if {$i + 6 < [llength $tokens]} {
468  set name_tok [lindex $tokens [expr {$i + 1}]]
469  set is_tok [lindex $tokens [expr {$i + 2}]]
470  set new_tok [lindex $tokens [expr {$i + 3}]]
471  set lib_tok [lindex $tokens [expr {$i + 4}]]
472  set dot_tok [lindex $tokens [expr {$i + 5}]]
473  set pkg_tok [lindex $tokens [expr {$i + 6}]]
474  if {[token_type $name_tok] == "IDENTIFIER" &&
475  [token_value $is_tok] == "is" &&
476  [token_value $new_tok] == "new" &&
477  [token_type $lib_tok] == "IDENTIFIER" &&
478  [token_type $dot_tok] == "OPERATOR" && [token_value $dot_tok] eq "." &&
479  [token_type $pkg_tok] == "IDENTIFIER"} {
480  set ref "[token_value $lib_tok].[token_value $pkg_tok]"
481  lappend architecture_pkg_insts [create_instantiation_node $ref "vhdl_pkg_inst" \
482  [token_value $name_tok] [token_line $name_tok]]
483  # Skip past the semicolon that ends this instantiation
484  while {$i < [llength $tokens] && \
485  [token_type [lindex $tokens $i]] != "SEMICOLON"} { incr i }
486  }
487  }
488  }
489  }
490  return [dict create index $i components $architecture_components \
491  pkg_insts $architecture_pkg_insts]
492 }
493 
494 proc parse_vhdl_architecture_body {tokens index arch_name} {
495  set architecture_insts [list]
496  set i $index
497  for {set i $index} {$i < [llength $tokens]} {incr i} {
498  set token [lindex $tokens $i]
499  set type [token_type $token]
500  set value [token_value $token]
501 
502  if {$type == "KEYWORD" && $value == "end"} {
503  if {$i + 2 < [llength $tokens]} {
504  set token2 [lindex $tokens [expr {$i + 1}]]
505  set token3 [lindex $tokens [expr {$i + 2}]]
506  if { [token_value $token2] == "$arch_name" && [token_type $token3] == "SEMICOLON"} {
507  break
508  }
509  }
510  }
511 
512  # Look for instantiations in the concurrent part
513  if {$type == "IDENTIFIER"} {
514  if {$i + 2 < [llength $tokens]} {
515  set inst_tok $token
516  set token2 [lindex $tokens [expr {$i + 1}]]
517  set token3 [lindex $tokens [expr {$i + 2}]]
518  # Entity instantiation: INST_NAME : entity ENTITY_NAME ...
519  if {[token_value $token2] == ":" && [token_value $token3] == "entity"} {
520  incr i 3
521  set entity_inst_name ""
522  while {$i < [llength $tokens]} {
523  set token [lindex $tokens $i]
524  set type [token_type $token]
525  set value [token_value $token]
526 
527  if {$value == "generic" || $value == "port" || $type == "SEMICOLON"} {
528  break
529  }
530  set entity_inst_name "${entity_inst_name}${value}"
531  incr i
532  }
533  if {$entity_inst_name != ""} {
534  lappend architecture_insts [create_instantiation_node $entity_inst_name "entity_inst" [token_value $inst_tok] [token_line $inst_tok]]
535  }
536  # Component instantiation: INST_NAME : COMPONENT COMPONENT_NAME ...
537  } elseif {[token_value $token2] == ":" && [token_value $token3] == "component"} {
538  set token4 [lindex $tokens [expr {$i + 3}]]
539  set comp_inst_name [token_value $token4]
540  lappend architecture_insts [create_instantiation_node $comp_inst_name "component_inst" [token_value $token] [token_line $token]]
541 
542  # Component instantiation: INST_NAME : COMPONENT_NAME ...
543  } elseif {[token_value $token2] == ":" && [token_type $token3] == "IDENTIFIER"} {
544  set is_instantiation 0
545  # look for port or generic followed by map after token3
546  for {set k [expr {$i + 3}]} {$k < [llength $tokens]} {incr k} {
547  set check_token [lindex $tokens $k]
548  set check_value [token_value $check_token]
549  set check_type [token_type $check_token]
550 
551  if {$check_type == "SEMICOLON"} {
552  break
553  }
554  if {$check_type == "KEYWORD" && ($check_value eq "port" || $check_value eq "generic")} {
555  if {[expr {$k + 1}] < [llength $tokens]} {
556  set next_token [lindex $tokens [expr {$k + 1}]]
557  if {[token_value $next_token] eq "map"} {
558  set is_instantiation 1
559  break
560  }
561  }
562  }
563  }
564 
565  if {$is_instantiation} {
566  set comp_inst_name [token_value $token3]
567  lappend architecture_insts [create_instantiation_node $comp_inst_name "component_inst" [token_value $inst_tok] [token_line $inst_tok]]
568  }
569  }
570  }
571  }
572  }
573  return [dict create index $i insts $architecture_insts]
574 }
575 
576 proc parse_vhdl_architecture_content {arch tokens index} {
577  set i $index
578 
579  set header_info [parse_vhdl_architecture_header $tokens $i]
580  set i [dict get $header_info index]
581  set architecture_components [dict get $header_info components]
582  set architecture_pkg_insts [dict get $header_info pkg_insts]
583 
584  if {$i < [llength $tokens] && [token_value [lindex $tokens $i]] eq "begin"} {
585  incr i
586  }
587  set body_info [parse_vhdl_architecture_body $tokens $i $arch]
588  set i [dict get $body_info index]
589  set architecture_insts [concat $architecture_pkg_insts [dict get $body_info insts]]
590 
591  return [dict create index $i components $architecture_components insts $architecture_insts]
592 }
593 
594 proc skip_vhdl_package_spec {tokens index} {
595  set i $index
596  while {$i < [llength $tokens]} {
597  set current_tok [lindex $tokens $i]
598  set current_val [token_value $current_tok]
599  if {$current_val eq "end"} {
600  if {[expr {$i + 1} < [llength $tokens]]} {
601  set next_token [lindex $tokens [expr {$i + 1}]]
602  if {[token_value $next_token] eq "package"} {
603  set i [expr {$i + 1}]
604  break
605  }
606  }
607  }
608  incr i
609  }
610  return $i
611 }
612 
613 proc skip_vhdl_package_body {tokens index} {
614  set i $index
615  while {$i < [llength $tokens]} {
616  set current_tok [lindex $tokens $i]
617  set current_val [token_value $current_tok]
618  if {$current_val eq "end"} {
619  if {[expr {$i + 2} < [llength $tokens]]} {
620  set next_token [lindex $tokens [expr {$i + 1}]]
621  set next_next_token [lindex $tokens [expr {$i + 2}]]
622  if {[token_value $next_token] eq "package" && [token_value $next_next_token] eq "body"} {
623  set i [expr {$i + 2}]
624  break
625  }
626  }
627  }
628  incr i
629  }
630  return $i
631 }
632 
633 proc find_vhdl_constructs {tokens filename} {
634  set results [list]
635  set libraries_map [dict create]
636 
637  for {set i 0} {$i < [llength $tokens]} {incr i} {
638  set token [lindex $tokens $i]
639  set type [token_type $token]
640  set value [token_value $token]
641 
642  if {$type == "KEYWORD" && $value == "library"} {
643  set i [expr {$i + 1}]
644  while {$i < [llength $tokens]} {
645  set token [lindex $tokens $i]
646  set type [token_type $token]
647  set value [token_value $token]
648 
649  if {$type == "IDENTIFIER"} {
650  set lib_name [string tolower $value]
651  if {![dict exists $libraries_map $lib_name]} {
652  dict set libraries_map $lib_name [list]
653  }
654  } elseif {$type == "SEMICOLON"} {
655  break
656  }
657  incr i
658  }
659  } elseif {$type == "KEYWORD" && $value == "use"} {
660  if {$i + 1 < [llength $tokens]} {
661  set use_path_start_idx [expr {$i + 1}]
662  set use_path ""
663  for {set j $use_path_start_idx} {$j < [llength $tokens]} {incr j} {
664  set use_token [lindex $tokens $j]
665  if {[token_type $use_token] == "SEMICOLON"} {
666  set i $j
667  break
668  }
669  append use_path [token_value $use_token]
670  }
671  if {$use_path != ""} {
672  set use_path_parts [split $use_path .]
673  set lib_name [string tolower [lindex $use_path_parts 0]]
674  if {![dict exists $libraries_map $lib_name]} {
675  dict set libraries_map $lib_name [list]
676  }
677  dict lappend libraries_map $lib_name $use_path
678  }
679  }
680  } elseif {$type == "KEYWORD" && $value == "entity"} {
681  if {$i + 2 < [llength $tokens]} {
682  set name_tok [lindex $tokens [expr {$i + 1}]]
683  set is_tok [lindex $tokens [expr {$i + 2}]]
684  if {[token_type $name_tok] == "IDENTIFIER" && [token_value $is_tok] == "is"} {
685  set entity_name [token_value $name_tok]
686  set final_libraries [list]
687  dict for {lib_name use_paths} $libraries_map {
688  lappend final_libraries [dict create name $lib_name uses $use_paths]
689  }
690  set entity_node [create_hdl_node "vhdl_entity" $entity_name $filename [token_line $name_tok] $final_libraries]
691  lappend results $entity_node
692  }
693  }
694  } elseif {$type == "KEYWORD" && $value == "package"} {
695  if {[expr {$i + 1} < [llength $tokens]]} {
696  set next_token [lindex $tokens [expr {$i + 1}]]
697 
698  if {[token_type $next_token] == "IDENTIFIER"} {
699  set package_name [token_value $next_token]
700  set package_line [token_line $next_token]
701  set i [expr {$i + 2}]
702 
703  if {$i < [llength $tokens]} {
704  set current_tok [lindex $tokens $i]
705  set current_val [token_value $current_tok]
706  if {[token_type $current_tok] == "KEYWORD" && $current_val eq "is"} {
707  # Distinguish: package NAME is new LIB.PKG vs. package NAME is ... end package
708  set is_pkg_inst 0
709  if {$i + 1 < [llength $tokens] &&
710  [token_value [lindex $tokens [expr {$i + 1}]]] eq "new"} {
711  set is_pkg_inst 1
712  }
713  if {$is_pkg_inst} {
714  # Generic package instantiation — record dependency on source package
715  if {$i + 4 < [llength $tokens]} {
716  set lib_tok [lindex $tokens [expr {$i + 2}]]
717  set dot_tok [lindex $tokens [expr {$i + 3}]]
718  set pkg_tok [lindex $tokens [expr {$i + 4}]]
719  if {[token_type $lib_tok] == "IDENTIFIER" &&
720  [token_type $dot_tok] == "OPERATOR" && [token_value $dot_tok] eq "." &&
721  [token_type $pkg_tok] == "IDENTIFIER"} {
722  set ref_lib [string tolower [token_value $lib_tok]]
723  set ref_pkg [token_value $pkg_tok]
724  if {![dict exists $libraries_map $ref_lib]} {
725  dict set libraries_map $ref_lib [list]
726  }
727  dict lappend libraries_map $ref_lib "${ref_lib}.${ref_pkg}.all"
728  }
729  }
730  # Skip to the semicolon ending the instantiation
731  while {$i < [llength $tokens] && \
732  [token_type [lindex $tokens $i]] != "SEMICOLON"} { incr i }
733  continue
734  }
735  # Regular package declaration
736  set i [skip_vhdl_package_spec $tokens $i]
737  set final_libraries [list]
738  dict for {lib_name use_paths} $libraries_map {
739  lappend final_libraries [dict create name $lib_name uses $use_paths]
740  }
741  set package_node [create_hdl_node "vhdl_package" $package_name $filename $package_line $final_libraries]
742  lappend results $package_node
743  continue
744  }
745  }
746  } elseif {[token_value $next_token] == "body" } {
747  # package body
748  set i [skip_vhdl_package_body $tokens $i]
749  set final_libraries [list]
750  dict for {lib_name use_paths} $libraries_map {
751  lappend final_libraries [dict create name $lib_name uses $use_paths]
752  }
753  set package_body_node [create_hdl_node "vhdl_package_body" $package_name $filename $package_line $final_libraries]
754  lappend results $package_body_node
755  continue
756  }
757  }
758  } elseif {$type == "KEYWORD" && $value == "architecture"} {
759  if {$i + 4 < [llength $tokens]} {
760  set arch_name_tok [lindex $tokens [expr {$i + 1}]]
761  set of_tok [lindex $tokens [expr {$i + 2}]]
762  set entity_name_tok [lindex $tokens [expr {$i + 3}]]
763  set is_tok [lindex $tokens [expr {$i + 4}]]
764 
765  if {[token_type $arch_name_tok] == "IDENTIFIER" && [token_value $of_tok] == "of" \
766  && [token_type $entity_name_tok] == "IDENTIFIER" && [token_value $is_tok] == "is"} {
767  set arch_name [token_value $arch_name_tok]
768  set entity_name [token_value $entity_name_tok]
769 
770  set arch_info [parse_vhdl_architecture_content $arch_name $tokens [expr $i + 1]]
771  set i [dict get $arch_info index]
772  set components [dict get $arch_info components]
773  set insts [dict get $arch_info insts]
774  set final_libraries [list]
775  dict for {lib_name use_paths} $libraries_map {
776  lappend final_libraries [dict create name $lib_name uses $use_paths]
777  }
778 
779  set arch_node [create_hdl_node "vhdl_architecture" $arch_name $filename [token_line $arch_name_tok] $final_libraries $components $insts $entity_name]
780  lappend results $arch_node
781  }
782  }
783  }
784  }
785  return $results
786 }
787 
788 
789 proc parse_hdl_file {filename} {
790 
791  if {![file exists $filename]} {
792  puts "Error: file not found: $filename"
793  return ""
794  }
795 
796  set fp [open $filename r]
797  set code [read $fp]
798  close $fp
799 
800 
801  # skip protected files
802  set first_line [lindex [split $code "\n"] 0]
803  set first_line_trimmed [string trim $first_line]
804  if {$first_line_trimmed eq "`pragma protect begin_protected" ||
805  $first_line_trimmed eq "`protect begin_protected"} {
806  return {}
807  }
808 
809  set extension [string tolower [file extension $filename]]
810 
811  set tokens {}
812  set constructs {}
813 
814  switch -- $extension {
815  ".v" -
816  ".vh" -
817  ".sv" -
818  ".svh" {
819  set t_tokenize [time {set tokens [tokenize_verilog $code]} 1]
820  set t_constructs [time {set constructs [find_verilog_constructs $tokens $filename]} 1]
821  }
822  ".vhd" -
823  ".vhdl" {
824  set t_tokenize [time {set tokens [tokenize_vhdl $code]} 1]
825  set t_constructs [time {set constructs [find_vhdl_constructs $tokens $filename]} 1]
826  }
827  default {
828  return {}
829  }
830  }
831 
832  # Extract microseconds and convert to milliseconds
833  set tokenize_us [lindex $t_tokenize 0]
834  set constructs_us [lindex $t_constructs 0]
835  set tokenize_ms [expr {$tokenize_us / 1000.0}]
836  set constructs_ms [expr {$constructs_us / 1000.0}]
837 
838  #puts "\[PERFORMACE\] Tokenization: $tokenize_ms ms, Construct discovery: $constructs_ms ms for file $filename"
839 
840  return $constructs
841 }