File Coverage

blib/lib/Verilog/Netlist/File.pm
Criterion Covered Total %
statement 223 257 86.7
branch 65 100 65.0
condition 38 60 63.3
subroutine 34 38 89.4
pod 3 5 60.0
total 363 460 78.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::File;
6 8     8   55 use Carp;
  8         14  
  8         440  
7              
8 8     8   44 use Verilog::Netlist;
  8         14  
  8         188  
9 8     8   3757 use Verilog::Netlist::Subclass;
  8         21  
  8         487  
10 8     8   44 use vars qw($VERSION @ISA);
  8         14  
  8         435  
11 8     8   45 use strict;
  8         13  
  8         640  
12             @ISA = qw(Verilog::Netlist::File::Struct
13             Verilog::Netlist::Subclass);
14              
15             $VERSION = '3.478';
16              
17             structs('new',
18             'Verilog::Netlist::File::Struct'
19             =>[name => '$', #' # Filename this came from
20             basename => '$', #' # Basename of the file
21             netlist => '$', #' # Netlist is a member of
22             userdata => '%', # User information
23             attributes => '%', #' # Misc attributes for systemperl or other processors
24             comment => '$', #' # Comment provided by user
25             is_libcell => '$', #' # True if is a library cell
26             preproc => '$', #' # Preprocessor object
27             # For special procedures
28             _interfaces => '%', # For autosubcell_include
29             _modules => '%', # For autosubcell_include
30             ]);
31              
32             ######################################################################
33             ######################################################################
34             #### Read class
35              
36             package Verilog::Netlist::File::Parser;
37 8     8   3027 use Verilog::SigParser;
  8         39  
  8         42  
38 8     8   3126 use Verilog::Preproc;
  8         23  
  8         300  
39 8     8   52 use base qw(Verilog::SigParser);
  8         19  
  8         677  
40 8     8   52 use strict;
  8         13  
  8         24391  
41              
42             sub new {
43 239     239   492 my $class = shift;
44 239         2430 my %params = (preproc => "Verilog::Preproc",
45             @_); # filename=>
46              
47 239         549 my $preproc_class = $params{preproc};
48 239         515 delete $params{preproc}; # Remove as preproc doesn't need passing down to Preprocessor
49              
50             # A new file; make new information
51 239 50       548 $params{fileref} or die "%Error: No fileref parameter?";
52 239         3988 $params{netlist} = $params{fileref}->netlist;
53             my $parser = $class->SUPER::new (%params,
54             modref=>undef, # Module being parsed now
55             cellref=>undef, # Cell being parsed now
56             _cmtref=>undef, # Object to attach comments to
57             # Must parse all files in same compilation unit with
58             # same symbol_table, or a package won't exist for link()
59             symbol_table => $params{netlist}->{symbol_table},
60 239         2269 );
61              
62 239         609 my @opt;
63 239 100       678 push @opt, (options=>$params{netlist}{options}) if $params{netlist}{options};
64 239         406 my $meta = $params{metacomment};
65 239 50       818 if ($meta) {
    100          
66 0 0       0 die "%Error: 'metacomment' arg of Netlist or read_file() must be a hash,"
67             unless (ref($meta) eq 'HASH');
68 0         0 push @opt, metacomments=>[ grep({ $meta->{$_} } keys %$meta) ];
  0         0  
69 0   0     0 push @opt, keep_comments=>($params{netlist}{keep_comments} || 1);
70             } elsif ($params{netlist}{keep_comments}) {
71 28         73 push @opt, keep_comments=>$params{netlist}{keep_comments};
72             } else {
73 211         481 push @opt, keep_comments=>0;
74             }
75 239         436 push @opt, keep_whitespace=>1; # So we don't loose newlines
76 239 50       725 push @opt, include_open_nonfatal=>1 if $params{netlist}{include_open_nonfatal};
77 239 50       647 push @opt, synthesis=>1 if $params{netlist}{synthesis};
78             my $preproc = $preproc_class->new(@opt,
79 239         1247 parent => $params{fileref});
80 239         6117 $params{fileref}->preproc($preproc);
81 239         976 $preproc->open($params{filename});
82 239         1144 $parser->parse_preproc_file($preproc);
83 239         1755 return $parser;
84             }
85              
86             sub contassign {
87 6     6   17 my $self = shift;
88 6         13 my $keyword = shift;
89 6         11 my $lhs = shift;
90 6         21 my $rhs = shift;
91              
92 6 50       22 print " ContAssign $keyword $lhs\n" if $Verilog::Netlist::Debug;
93 6         25 my $modref = $self->{modref};
94 6 50       22 if (!$modref) {
95 0         0 return $self->error("CONTASSIGN outside of module definition", $lhs);
96             }
97             $modref->new_contassign
98 6         76 (filename=>$self->filename, lineno=>$self->lineno,
99             keyword=>$keyword, lhs=>$lhs, rhs=>$rhs);
100             }
101              
102             sub defparam {
103 4     4   14 my $self = shift;
104 4         7 my $keyword = shift;
105 4         7 my $lhs = shift;
106 4         5 my $rhs = shift;
107              
108 4 50       16 print " Defparam $keyword $lhs\n" if $Verilog::Netlist::Debug;
109 4         9 my $modref = $self->{modref};
110 4 50       15 if (!$modref) {
111 0         0 return $self->error("DEFPARAM outside of module definition", $lhs);
112             }
113             $modref->new_defparam
114 4         44 (filename=>$self->filename, lineno=>$self->lineno,
115             keyword=>$keyword, lhs=>$lhs, rhs=>$rhs);
116             }
117              
118             sub interface {
119 6     6   16 my $self = shift;
120 6         9 my $keyword = shift;
121 6         9 my $name = shift;
122              
123 6         11 my $fileref = $self->{fileref};
124 6         9 my $netlist = $self->{netlist};
125 6 50       16 print "Interface $name\n" if $Verilog::Netlist::Debug;
126              
127 6         48 $self->{modref} = $netlist->new_interface
128             (name=>$name,
129             filename=>$self->filename, lineno=>$self->lineno);
130 6         131 $fileref->_interfaces($name, $self->{modref});
131 6         9 $self->{_cmtpre} = undef;
132 6         169 $self->{_cmtref} = $self->{modref};
133             }
134              
135             sub modport {
136 2     2   6 my $self = shift;
137 2         6 my $keyword = shift;
138 2         4 my $name = shift;
139              
140 2 50       7 print " Modport $name\n" if $Verilog::Netlist::Debug;
141 2         6 my $modref = $self->{modref};
142 2 50       7 if (!$modref) {
143 0         0 return $self->error("MODPORT outside of interface definition", $name);
144             }
145 2         20 $self->{_modportref} = $modref->new_modport
146             (name=>$name,
147             filename=>$self->filename, lineno=>$self->lineno);
148 2         6 $self->{_cmtpre} = undef;
149 2         27 $self->{_cmtref} = $self->{modref};
150             }
151              
152             sub module {
153 246     246   664 my $self = shift;
154 246         427 my $keyword = shift;
155 246         350 my $name = shift;
156 246         492 my $orderref = shift;
157 246         324 my $in_celldefine = shift;
158              
159 246         492 my $fileref = $self->{fileref};
160 246         462 my $netlist = $self->{netlist};
161 246 50       687 print "Module $name\n" if $Verilog::Netlist::Debug;
162              
163 246   33     7258 $self->{modref} = $netlist->new_module
164             (name=>$name, keyword=>$keyword,
165             is_libcell=>($fileref->is_libcell() || $in_celldefine),
166             filename=>$self->filename, lineno=>$self->lineno);
167 246         3854 $fileref->_modules($name, $self->{modref});
168 246         477 $self->{_cmtpre} = undef;
169 246         6507 $self->{_cmtref} = $self->{modref};
170             }
171              
172             sub program {
173 2     2   7 my $self = shift;
174 2         8 $self->module(@_);
175             }
176              
177             sub endinterface {
178 6     6   10 my $self = shift;
179 6         18 $self->endmodule(@_);
180             }
181              
182             sub endmodport {
183 2     2   6 my $self = shift;
184 2         6 $self->{_cmtpre} = undef;
185 2         6 $self->{_cmtref} = $self->{modref};
186 2         41 $self->{_modportref} = undef;
187             }
188              
189             sub endmodule {
190 252     252   582 my $self = shift;
191 252         459 $self->{_cmtpre} = undef;
192 252         482 $self->{_cmtref} = undef; # Assume all module comments are inside the module, not after
193 252         16854 $self->{modref} = undef;
194             }
195              
196             sub endprogram {
197 2     2   7 my $self = shift;
198 2         7 $self->endmodule(@_);
199             }
200              
201             sub attribute {
202 204     204   422 my $self = shift;
203 204   50     503 my $text = shift||'';
204              
205 204         384 my $modref = $self->{modref};
206 204         354 my ($category, $name, $eql, $rest);
207 204 50       4354 if ($text =~ m!^([\$A-Za-z]\w*)\s+ (\w+) (\s*=\s*)? (.*) !x) {
208 0   0     0 ($category, $name, $eql, $rest) = ($1, $2, ($3 || ""), $4);
209 0 0       0 if ($eql ne "") { $eql = "="; }
  0         0  
210 0         0 my $cleaned = ($category ." ". $name . $eql . $rest);
211              
212 0 0       0 if ($Verilog::Netlist::Debug) {
213 0         0 printf +("%d: Attribute '%s'\n",
214             $self->lineno, $cleaned);
215             }
216             # Treat as module-level if attribute appears before any declarations.
217 0 0       0 if ($modref) {
218 0         0 my $attr = $modref->new_attr($cleaned);
219             }
220             }
221             }
222              
223             sub port {
224 932     932   1631 my $self = shift;
225 932         1326 my $name = shift;
226 932         1274 my $objof = shift;
227 932         1251 my $direction = shift;
228 932         1109 my $type = shift;
229 932         1066 my $array = shift;
230 932         1180 my $pinnum = shift;
231              
232 932 100 100     8279 return if !($objof eq 'module' || $objof eq 'interface' || $objof eq 'modport');
      100        
233              
234 728   66     2615 my $underref = $self->{_modportref} || $self->{modref};
235              
236 728 100       1360 if ($pinnum) { # Else a "input" etc outside the "(...)"s
237 684         11912 $underref->_portsordered($pinnum-1, $name); # -1 because [0] has first pin
238             }
239 728 100       2143 if ($direction) { # Else just a pin number without declaration
240 688         4416 my $port = $underref->new_port
241             (name=>$name,
242             filename=>$self->filename, lineno=>$self->lineno,
243             direction=>$direction, data_type=>$type,
244             array=>$array, comment=>undef,);
245             }
246             }
247              
248             sub var {
249 12796     12796   29785 my $self = shift;
250             #use Data::Dumper; print " DEBUG: var callback: ",Dumper(\@_);
251 12796         17454 my $decl_type = shift;
252 12796         15705 my $name = shift;
253 12796         14743 my $objof = shift;
254 12796         16672 my $net_type = shift;
255 12796         15186 my $data_type = shift;
256 12796         14858 my $array = shift;
257 12796         14330 my $value = shift;
258 12796 50       24307 print " Sig $name dt=$decl_type nt=$net_type d=$data_type\n" if $Verilog::Netlist::Debug;
259              
260 12796 100 100     30541 return if !($objof eq 'module' || $objof eq 'interface' || $objof eq 'modport' || $objof eq 'netlist');
      100        
      100        
261              
262 12588         19113 my $msb;
263             my $lsb;
264 12588 100 100     41155 if ($data_type && $data_type =~ /\[(.*):(.*)\]/) {
    50 66        
265 459         1271 $msb = $1; $lsb = $2;
  459         821  
266             } elsif ($data_type && $data_type =~ /\[(.*)\]/) {
267 0         0 $msb = $lsb = $1;
268             }
269              
270 12588   100     42551 my $underref = $self->{_modportref} || $self->{modref};
271 12588 100       21354 if ($objof eq 'netlist') {
272             $underref = $self->{netlist}->new_root_module
273 4         48 (filename=>$self->filename, lineno=>$self->lineno);
274             }
275 12588 50       21284 if (!$underref) {
276 0         0 return $self->error("Signal declaration outside of module definition", $name);
277             }
278              
279 12588         18546 my $signed = ($data_type =~ /signed/);
280              
281 12588         29471 my $net = $underref->find_net($name);
282             $net or $net = $underref->new_net
283             (name=>$name,
284             filename=>$self->filename, lineno=>$self->lineno,
285             simple_type=>1, data_type=>$data_type, array=>$array,
286 12588 100       96782 comment=>$self->{_cmtpre}, msb=>$msb, lsb=>$lsb,
287             net_type=>$net_type, decl_type=>$decl_type,
288             signed=>$signed, value=>$value,
289             );
290 12588         178507 $net->data_type($data_type); # If it was declared earlier as in/out etc
291 12588 100       157852 $net->net_type($net_type) if $net_type;
292             # (from a single non-typed input/output stmt), remark the type now
293 12588         18852 $self->{_cmtpre} = undef;
294 12588         310278 $self->{_cmtref} = $net;
295             }
296              
297             sub instant {
298 450     450   1279 my $self = shift;
299 450         707 my $submodname = shift;
300 450         635 my $instname = shift;
301 450         574 my $range = shift;
302              
303 450 50       996 print " Cell $instname\n" if $Verilog::Netlist::Debug;
304 450         793 my $modref = $self->{modref};
305 450 50       908 if (!$modref) {
306 0         0 return $self->error("CELL outside of module definition", $instname);
307             }
308 450         3033 $self->{cellref} = $modref->new_cell
309             (name=>$instname,
310             filename=>$self->filename, lineno=>$self->lineno,
311             submodname=>$submodname, range=>$range,);
312 450         961 $self->{_cmtpre} = undef;
313 450         6840 $self->{_cmtref} = $self->{cellref};
314             }
315              
316             sub endcell {
317 450     450   937 my $self = shift;
318 450         705 $self->{_cmtpre} = undef;
319 450         12373 $self->{_cmtref} = $self->{cellref}; # Comments after cell decl go to the cell
320             }
321              
322             sub parampin {
323 220     220   469 my $self = shift;
324 220         384 my $pin = shift;
325 220         340 my $conn = shift;
326 220         304 my $number = shift;
327              
328 220         3732 my $prev = $self->{cellref}->params();
329 220 50       499 $prev .= ", " if $prev;
330 220 50       822 $prev .= ($pin ? ".$pin($conn)" : $conn);
331 220         3006 $self->{cellref}->params($prev);
332             }
333              
334             sub pin {
335 849     849   1871 my $self = shift;
336 849 100       2172 if (!$self->{use_pinselects}) {
337 842         1922 $self->pinselects(@_);
338             }
339             }
340              
341             sub pinselects {
342 849     849   1167 my $self = shift;
343 849         1105 my $pin = shift;
344 849         1170 my $nets = shift;
345 849         1005 my $number = shift;
346 849   100     2395 my $hasnamedports = (($pin||'') ne '');
347 849 100       1685 $pin = "pin".$number if !$hasnamedports;
348              
349 849         1035 my $net_cnt = scalar($nets);
350 849 50       1537 print " Pin $pin $number (connected to $net_cnt nets) \n" if $Verilog::Netlist::Debug;
351 849         1189 my $cellref = $self->{cellref};
352 849 50       1558 if (!$cellref) {
353 0         0 return $self->error("PIN outside of cell definition", $pin);
354             }
355              
356 849         6874 my %params = (
357             name => $pin,
358             portname => $pin,
359             portnumber => $number,
360             pinnamed => $hasnamedports,
361             filename => $self->filename,
362             lineno => $self->lineno,
363             );
364              
365 849 100       1938 if ($self->{use_pinselects}) {
366 7         15 $params{pinselects} = $nets;
367             } else {
368 842         1625 $params{netname} = $nets;
369             }
370              
371 849         3521 my $pinref = $cellref->new_pin(%params);
372             # If any pin uses call-by-name, then all are assumed to use call-by-name
373 849 100       7383 $cellref->byorder(1) if !$hasnamedports;
374 849         1405 $self->{_cmtpre} = undef;
375 849         13707 $self->{_cmtref} = $pinref;
376             }
377              
378             sub keyword {
379             # OVERRIDE Verilog::Parse calls when keyword occurs
380             # Note we use_cb_keyword only if comments are parsed!
381 313     313   646 my $self = shift; # Parser invoked
382 313         468 $self->{_cmtpre} = undef;
383 313         5638 $self->{_cmtref} = undef;
384             }
385              
386             sub comment {
387 234     234   480 my $self = shift;
388             # OVERRIDE Verilog::Parse calls when comment occurs
389 234         292 my $text = shift; # Includes comment delimiters
390 234 100       1182 if ($self->{_cmtref}) {
    100          
391 103         1751 my $old = $self->{_cmtref}->comment();
392 103 100       283 $old = (defined $old) ? $old."\n".$text : $text;
393 103         1375 $self->{_cmtref}->comment($old);
394             }
395             elsif ($self->{modref}) {
396 27         41 my $old = $self->{_cmtpre};
397 27 100       63 $old = (defined $old) ? $old."\n".$text : $text;
398 27         299 $self->{_cmtpre} = $old;
399             }
400             }
401              
402             # sub operator { ... Disabled by new(use_cmt_operator => 0)
403             # sub number { ... Disabled by new(use_cmt_number => 0)
404             # sub string { ... Disabled by new(use_cmt_string => 0)
405             # sub symbol { ... Disabled by new(use_cmt_symbol => 0)
406              
407             sub error {
408 0     0   0 my $self = shift;
409 0         0 my $text = shift;
410              
411 0         0 my $fileref = $self->{fileref};
412             # Call Verilog::Netlist::Subclass's error reporting, it will track # errors
413 0         0 $fileref->error($self, "$text\n");
414             }
415              
416             sub warn {
417 0     0   0 my $self = shift;
418 0         0 my $text = shift;
419              
420 0         0 my $fileref = $self->{fileref};
421 0         0 $fileref->warn($self, "$text\n");
422             }
423              
424             package Verilog::Netlist::File;
425              
426             ######################################################################
427             ######################################################################
428             #### Functions
429              
430             sub delete {
431 203     203 0 319 my $self = shift;
432 203         3338 $self->netlist(undef); # Break circular
433 203         2887 $self->preproc(undef); # Break circular
434             }
435              
436             sub logger {
437 0     0 1 0 my $self = shift;
438 0         0 return $self->netlist->logger;
439             }
440              
441             sub read {
442 249     249 1 1377 my %params = (lookup_type=>'module',
443             @_); # netlist=>, filename=>, per-file options
444              
445 249 50       987 my $filename = $params{filename} or croak "%Error: ".__PACKAGE__."::read_file (filename=>) parameter required, stopped";
446 249 50       861 my $netlist = $params{netlist} or croak("Call Verilog::Netlist::read_file instead,");
447              
448 249         979 my $filepath = $netlist->resolve_filename($filename, $params{lookup_type});
449 249 100       705 if (!$filepath) {
450 10 50       43 if ($params{error_self}) { $params{error_self}->error("Cannot find $filename\n"); }
  0 50       0  
451 0         0 elsif (!defined $params{error_self}) { die "%Error: Cannot find $filename\n"; } # 0=suppress error
452 10         32 return undef;
453             }
454 239 50       615 print __PACKAGE__."::read_file $filepath\n" if $Verilog::Netlist::Debug;
455              
456             my $fileref = $netlist->new_file(name=>$filepath,
457 239   50     1424 is_libcell=>$params{is_libcell}||0,
458             );
459              
460 239   66     1085 my $keep_cmt = ($params{keep_comments} || $netlist->{keep_comments});
461 239   33     1061 my $parser_class = ($params{parser} || $netlist->{parser});
462              
463             my $parser = $parser_class->new
464             ( fileref => $fileref,
465             filename => $filepath, # for ->read
466             metacomment => ($params{metacomment} || $netlist->{metacomment}),
467             keep_comments => $keep_cmt,
468             use_vars => ($params{use_vars} || $netlist->{use_vars}),
469             use_pinselects => ($params{use_pinselects} || $netlist->{use_pinselects}),
470             use_protected => 0,
471 239   33     3522 preproc => ($params{preproc} || $netlist->{preproc}),
      33        
      66        
      33        
472             # Callbacks we need; disable unused for speed
473             use_cb_attribute => 1,
474             use_cb_comment => $keep_cmt,
475             use_cb_keyword => $keep_cmt,
476             use_cb_number => 0,
477             use_cb_operator => 0,
478             use_cb_string => 0,
479             use_cb_symbol => 0,
480             );
481 239         1122 return $fileref;
482             }
483              
484             sub link {
485             # For backward compatibility for SystemC child class, call _link
486 35     35 0 78 $_[0]->_link(@_);
487             }
488       70     sub _link {
489             }
490              
491             sub dump {
492 0     0 1   my $self = shift;
493 0   0       my $indent = shift||0;
494 0           print " "x$indent,"File:",$self->name(),"\n";
495             }
496              
497             ######################################################################
498             #### Package return
499             1;
500             __END__