File Coverage

blib/lib/Verilog/Netlist.pm
Criterion Covered Total %
statement 154 200 77.0
branch 12 34 35.2
condition 9 15 60.0
subroutine 35 43 81.4
pod 31 34 91.1
total 241 326 73.9


line stmt bran cond sub pod time code
1             # Verilog - Verilog Perl Interface
2             # See copyright, etc in below POD section.
3             ######################################################################
4              
5             package Verilog::Netlist;
6 8     8   465030 use Carp;
  8         66  
  8         510  
7 8     8   48 use IO::File;
  8         15  
  8         970  
8              
9 8     8   3830 use Verilog::Netlist::File;
  8         31  
  8         451  
10 8     8   4385 use Verilog::Netlist::Interface;
  8         29  
  8         480  
11 8     8   59 use Verilog::Netlist::Module;
  8         17  
  8         268  
12 8     8   44 use Verilog::Netlist::Subclass;
  8         14  
  8         362  
13 8     8   72 use base qw(Verilog::Netlist::Subclass);
  8         29  
  8         898  
14 8     8   51 use strict;
  8         14  
  8         248  
15 8     8   44 use vars qw($Debug $Verbose $VERSION);
  8         14  
  8         18839  
16              
17             $VERSION = '3.478';
18              
19             ######################################################################
20             #### Error Handling
21              
22             # Netlist file & line numbers don't apply
23 8     8 1 39 sub logger { return $_[0]->{logger}; }
24 0     0 1 0 sub filename { return 'Verilog::Netlist'; }
25 0     0 1 0 sub lineno { return ''; }
26              
27             ######################################################################
28             #### Creation
29              
30             sub new {
31 213     213 1 6549 my $class = shift;
32 213         1486 my $self = {_interfaces => {},
33             _modules => {},
34             _files => {},
35             implicit_wires_ok => 1,
36             link_read => 1,
37             logger => Verilog::Netlist::Logger->new,
38             options => undef, # Usually pointer to Verilog::Getopt
39             symbol_table => [], # Symbol table for Verilog::Parser
40             preproc => 'Verilog::Preproc',
41             parser => 'Verilog::Netlist::File::Parser',
42             remove_defines_without_tick => 0, # Overriden in SystemC::Netlist
43             #include_open_nonfatal => 0,
44             #keep_comments => 0,
45             #synthesis => 0,
46             #use_pinselects => 0,
47             use_vars => 1,
48             _libraries_done => {},
49             _need_link => [], # Objects we need to ->link
50             @_};
51 213         542 bless $self, $class;
52 213         519 return $self;
53             }
54              
55             sub delete {
56 203     203 1 1146 my $self = shift;
57             # Break circular references to netlist
58 203         600 foreach my $subref ($self->modules) { $subref->delete; }
  203         874  
59 203         689 foreach my $subref ($self->interfaces) { $subref->delete; }
  0         0  
60 203         705 foreach my $subref ($self->files) { $subref->delete; }
  203         784  
61 203         783 $self->{_modules} = {};
62 203         420 $self->{_interfaces} = {};
63 203         408 $self->{_files} = {};
64 203         5589 $self->{_need_link} = {};
65             }
66              
67             ######################################################################
68             #### Functions
69              
70             sub link {
71 9     9 1 59 my $self = shift;
72 9         17 while (defined(my $subref = pop @{$self->{_need_link}})) {
  97         303  
73 88         232 $subref->link();
74             }
75             # The above should have gotten everything, but a child class
76             # may rely on old behavior or have added classes outside our
77             # universe, so be nice and do it the old way too.
78 9         25 $self->{_relink} = 1;
79 9         34 while ($self->{_relink}) {
80 9         16 $self->{_relink} = 0;
81 9         36 foreach my $subref ($self->modules) {
82 47         104 $subref->link();
83             }
84 9         54 foreach my $subref ($self->interfaces) {
85 6         20 $subref->link();
86             }
87 9         42 foreach my $subref ($self->files) {
88 35         62 $subref->_link();
89             }
90             }
91             }
92              
93             sub lint {
94 7     7 1 37 my $self = shift;
95 7         18 foreach my $subref ($self->modules_sorted) {
96 39 50       536 next if $subref->is_libcell();
97 39         97 $subref->lint();
98             }
99 7         30 foreach my $subref ($self->interfaces_sorted) {
100 6         17 $subref->link();
101             }
102             }
103              
104             sub verilog_text {
105 7     7 1 1525 my $self = shift;
106 7         15 my @out;
107 7         21 foreach my $subref ($self->interfaces_sorted) {
108 3         10 push @out, $subref->verilog_text, "\n";
109             }
110 7         23 foreach my $subref ($self->modules_sorted) {
111 32         111 push @out, $subref->verilog_text, "\n";
112             }
113 7 50       431 return (wantarray ? @out : join('',@out));
114             }
115              
116             sub dump {
117 7     7 1 1261 my $self = shift;
118 7         21 foreach my $subref ($self->interfaces_sorted) {
119 3         10 $subref->dump();
120             }
121 7         30 foreach my $subref ($self->modules_sorted) {
122 37         111 $subref->dump();
123             }
124             }
125              
126             ######################################################################
127             #### Module access
128              
129             sub new_module {
130 251     251 1 577 my $self = shift;
131             # @_ params
132             # Can't have 'new Verilog::Netlist::Module' do this,
133             # as not allowed to override Class::Struct's new()
134 251         4975 my $modref = new Verilog::Netlist::Module
135             (netlist=>$self,
136             keyword=>'module',
137             is_top=>1,
138             @_);
139 251         3693 $self->{_modules}{$modref->name} = $modref;
140 251         470 push @{$self->{_need_link}}, $modref;
  251         630  
141 251         659 return $modref;
142             }
143              
144             sub new_root_module {
145 4     4 1 9 my $self = shift;
146 4   33     36 $self->{_modules}{'$root'} ||=
147             $self->new_module(keyword=>'root_module',
148             name=>'$root',
149             @_);
150 4         12 return $self->{_modules}{'$root'};
151             }
152              
153             sub defvalue_nowarn {
154 0     0 1 0 my $self = shift;
155 0         0 my $sym = shift;
156             # Look up the value of a define, letting the user pick the accessor class
157 0 0       0 if (my $opt=$self->{options}) {
158 0         0 return $opt->defvalue_nowarn($sym);
159             }
160 0         0 return undef;
161             }
162              
163             sub remove_defines {
164 87     87 1 127 my $self = shift;
165 87         122 my $sym = shift;
166             # This function is HOT
167 87         122 my $xsym = $sym;
168             # We only remove defines one level deep, for historical reasons.
169             # We optionally don't require a ` as SystemC also uses this function and doesn't use `.
170 87 50 33     364 if ($self->{remove_defines_without_tick} || $xsym =~ /^\`/) {
171 0         0 $xsym =~ s/^\`//;
172 0         0 my $val = $self->defvalue_nowarn($xsym); #Undef if not found
173 0 0       0 return $val if defined $val;
174             }
175 87         183 return $sym;
176             }
177              
178             sub find_module_or_interface_for_cell {
179             # ($self,$name) Are arguments, hardcoded below
180             # Hot function, used only by Verilog::Netlist::Cell linking
181             # Doesn't need to remove defines, as that's already done by caller
182 87   100 87 0 378 return $_[0]->{_modules}{$_[1]} || $_[0]->{_interfaces}{$_[1]};
183             }
184              
185             sub find_module {
186 10     10 1 3128 my $self = shift;
187 10         14 my $search = shift;
188             # Return module maching name
189 10         23 my $mod = $self->{_modules}{$search};
190 10 50       48 return $mod if $mod;
191             # Allow FOO_CELL to be a #define to choose what instantiation is really used
192 0         0 my $rsearch = $self->remove_defines($search);
193 0 0       0 if ($rsearch ne $search) {
194 0         0 return $self->find_module($rsearch);
195             }
196 0         0 return undef;
197             }
198              
199             sub modules {
200 212     212 1 375 my $self = shift;
201             # Return all modules
202 212         288 return (values %{$self->{_modules}});
  212         1212  
203             }
204              
205             sub modules_sorted {
206 27     27 1 133 my $self = shift;
207             # Return all modules
208 27         46 return (sort {$a->name cmp $b->name} (values %{$self->{_modules}}));
  265         3517  
  27         120  
209             }
210              
211             sub modules_sorted_level {
212 1     1 1 3 my $self = shift;
213             # Return all modules
214 16 50       33 return (sort {$a->level <=> $b->level || $a->name cmp $b->name}
215 1         2 (values %{$self->{_modules}}));
  1         6  
216             }
217              
218             sub top_modules_sorted {
219 1     1 1 7 my $self = shift;
220 1   66     5 return grep ($_->is_top && !$_->is_libcell, $self->modules_sorted);
221             }
222              
223             ######################################################################
224             #### Interface access
225              
226             sub new_interface {
227 6     6 1 13 my $self = shift;
228             # @_ params
229             # Can't have 'new Verilog::Netlist::Interface' do this,
230             # as not allowed to override Class::Struct's new()
231 6         167 my $modref = new Verilog::Netlist::Interface
232             (netlist=>$self,
233             @_);
234 6         104 $self->{_interfaces}{$modref->name} = $modref;
235 6         65 push @{$self->{_need_link}}, $modref;
  6         15  
236 6         27 return $modref;
237             }
238              
239             sub find_interface {
240 0     0 1 0 my $self = shift;
241 0         0 my $search = shift;
242             # Return interface maching name
243 0         0 my $mod = $self->{_interfaces}{$search};
244 0 0       0 return $mod if $mod;
245             # Allow FOO_CELL to be a #define to choose what instantiation is really used
246 0         0 my $rsearch = $self->remove_defines($search);
247 0 0       0 if ($rsearch ne $search) {
248 0         0 return $self->find_interface($rsearch);
249             }
250 0         0 return undef;
251             }
252              
253             sub interfaces {
254 212     212 1 308 my $self = shift;
255             # Return all interfaces
256 212         262 return (values %{$self->{_interfaces}});
  212         627  
257             }
258              
259             sub interfaces_sorted {
260 21     21 1 34 my $self = shift;
261             # Return all interfaces
262 21         56 return (sort {$a->name cmp $b->name} (values %{$self->{_interfaces}}));
  11         166  
  21         103  
263             }
264              
265             ######################################################################
266             #### Files access
267              
268             sub resolve_filename {
269 249     249 1 429 my $self = shift;
270 249         368 my $filename = shift;
271 249         402 my $lookup_type = shift;
272 249 100       685 if ($self->{options}) {
273 45         128 $filename = $self->remove_defines($filename);
274 45         190 $filename = $self->{options}->file_path($filename, $lookup_type);
275             }
276 249 100 66     11819 if (!-r $filename || -d $filename) {
277 10         46 return undef;
278             }
279 239         1288 $self->dependency_in($filename);
280 239         711 return $filename;
281             }
282              
283             sub new_file {
284 239     239 0 538 my $self = shift;
285             # @_ params
286             # Can't have 'new Verilog::Netlist::File' do this,
287             # as not allowed to override Class::Struct's new()
288 239         8786 my $fileref = new Verilog::Netlist::File
289             (netlist=>$self,
290             @_);
291 239 50       3329 defined $fileref->name or carp "%Error: No name=> specified, stopped";
292 239         3335 $self->{_files}{$fileref->name} = $fileref;
293 239         3219 $fileref->basename(Verilog::Netlist::Module::modulename_from_filename($fileref->name));
294 239         381 push @{$self->{_need_link}}, $fileref;
  239         669  
295 239         677 return $fileref;
296             }
297              
298             sub find_file {
299 0     0 1 0 my $self = shift;
300 0         0 my $search = shift;
301             # Return file maching name
302 0         0 return $self->{_files}{$search};
303             }
304              
305             sub files {
306 212 50   212 1 285 my $self = shift; ref $self or die;
  212         637  
307             # Return all files
308 212         281 return (sort {$a->name() cmp $b->name()} (values %{$self->{_files}}));
  57         750  
  212         864  
309             }
310 0     0 1 0 sub files_sorted { return files(@_); }
311              
312             sub read_file {
313 249     249 1 1257 my $self = shift;
314 249         683 my $fileref = $self->read_verilog_file(@_);
315 249         710 return $fileref;
316             }
317              
318             sub read_verilog_file {
319 249     249 0 361 my $self = shift;
320 249         1197 my $fileref = Verilog::Netlist::File::read
321             (netlist=>$self,
322             @_);
323 249         726 return $fileref;
324             }
325              
326             sub read_libraries {
327 6     6 1 17 my $self = shift;
328 6 50       35 if ($self->{options}) {
329 6         34 my @files = $self->{options}->library();
330 6         23 foreach my $file (@files) {
331 0 0       0 if (!$self->{_libraries_done}{$file}) {
332 0         0 $self->{_libraries_done}{$file} = 1;
333 0         0 $self->read_file(filename=>$file, is_libcell=>1, );
334             ## $self->dump();
335             }
336             }
337             }
338             }
339              
340             ######################################################################
341             #### Dependencies
342              
343             sub dependency_in {
344 239     239 1 476 my $self = shift;
345 239         388 my $filename = shift;
346 239         1023 $self->{_depend_in}{$filename} = 1;
347             }
348             sub dependency_out {
349 0     0 1   my $self = shift;
350 0           my $filename = shift;
351 0           $self->{_depend_out}{$filename} = 1;
352             }
353              
354             sub dependency_write {
355 0     0 1   my $self = shift;
356 0           my $filename = shift;
357              
358 0 0         my $fh = IO::File->new(">$filename") or die "%Error: $! writing $filename\n";
359 0           print $fh "$filename";
360 0           foreach my $dout (sort (keys %{$self->{_depend_out}})) {
  0            
361 0           print $fh " $dout";
362             }
363 0           print $fh " :";
364 0           foreach my $din (sort (keys %{$self->{_depend_in}})) {
  0            
365 0           print $fh " $din";
366             }
367 0           print $fh "\n";
368 0           $fh->close();
369             }
370              
371             ######################################################################
372             #### Package return
373             1;
374             __END__