File Coverage

blib/lib/Verilog/Netlist/Net.pm
Criterion Covered Total %
statement 61 98 62.2
branch 33 64 51.5
condition 32 54 59.2
subroutine 16 23 69.5
pod 6 11 54.5
total 148 250 59.2


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::Net;
6              
7 8     8   45 use Verilog::Netlist;
  8         11  
  8         186  
8 8     8   31 use Verilog::Netlist::Subclass;
  8         10  
  8         310  
9 8     8   36 use vars qw($VERSION @ISA);
  8         13  
  8         343  
10 8     8   38 use strict;
  8         11  
  8         12404  
11             @ISA = qw(Verilog::Netlist::Net::Struct
12             Verilog::Netlist::Subclass);
13              
14             $VERSION = '3.480';
15              
16             my %_Type_Widths = (
17             'bit' => 1,
18             'byte' => 8,
19             'genvar' => 32,
20             'integer' => 32,
21             'localparam'=> 32,
22             'logic' => 1,
23             'longint' => 64,
24             'parameter' => 32,
25             'reg' => 1,
26             'shortint' => 16,
27             'supply0' => 1,
28             'supply1' => 1,
29             'tri' => 1,
30             'tri0' => 1,
31             'tri1' => 1,
32             'triand' => 1,
33             'trior' => 1,
34             'trireg' => 1,
35             'wand' => 1,
36             'wire' => 1,
37             'wor' => 1,
38             );
39              
40             my %_Type_Accessors = (
41             'genvar' => 'decl_type',
42             'localparam'=> 'decl_type',
43             'parameter' => 'decl_type',
44             'var' => 'decl_type', # Not in old version, but for completeness
45             #'port' => 'decl_type', # Internals - Look at Port (input/output/inout/ref)
46             #'net' => 'decl_type', # Internals - Look at net_type (wire/tri/...)
47             #
48             'supply0' => 'net_type',
49             'supply1' => 'net_type',
50             'tri' => 'net_type',
51             'tri0' => 'net_type',
52             'tri1' => 'net_type',
53             'triand' => 'net_type',
54             'trior' => 'net_type',
55             'trireg' => 'net_type',
56             'wand' => 'net_type',
57             'wire' => 'net_type',
58             'wor' => 'net_type',
59             #
60             'bit' => 'data_type',
61             'byte' => 'data_type',
62             'chandle' => 'data_type',
63             'event' => 'data_type',
64             'int' => 'data_type',
65             'integer' => 'data_type',
66             'logic' => 'data_type',
67             'longint' => 'data_type',
68             'real' => 'data_type',
69             'realtime' => 'data_type',
70             'reg' => 'data_type',
71             'shortint' => 'data_type',
72             'shortreal' => 'data_type',
73             'string' => 'data_type',
74             'time' => 'data_type',
75             );
76              
77             ######################################################################
78              
79             structs('_new_base',
80             'Verilog::Netlist::Net::Struct'
81             =>[name => '$', #' # Name of the net
82             filename => '$', #' # Filename this came from
83             lineno => '$', #' # Linenumber this came from
84             userdata => '%', # User information
85             attributes => '%', #' # Misc attributes for systemperl or other processors
86             #
87             data_type => '$', #' # SystemVerilog Type (logic/integer/reg [3:0] etc)
88             decl_type => '$', #' # Declaration type (parameter/genvar/port/net etc)
89             net_type => '$', #' # Net type (wire/tri/supply0 etc)
90             comment => '$', #' # Comment provided by user
91             array => '$', #' # Vector
92             module => '$', #' # Module, Program or Interface entity belongs to
93             signed => '$', #' # True if signed
94             value => '$', #' # For parameters, the value of the parameter
95             # below only after links()
96             port => '$', #' # Reference to port connected to
97             msb => '$', #' # MSB of signal (if known)
98             lsb => '$', #' # LSB of signal (if known)
99             stored_lsb => '$', #' # Bit number of signal stored in bit 0 (generally lsb)
100             _used_in => '$', #' # Driver count onto signal
101             _used_out => '$', #' # Receiver count on signal
102             _used_inout => '$', #' # Bidirect count on signal
103             # SystemPerl only: below only after autos()
104             simple_type => '$', #' # True if is uint (as opposed to sc_signal)
105             sp_traced => '$', #' # Created by SP_TRACED
106             sp_autocreated => '$', #' # Created by /*AUTOSIGNAL*/
107             ]);
108              
109             sub new {
110 12582     12582 0 13550 my $class = shift;
111 12582         48245 my %params = @_;
112 12582         171239 my $self = $class->_new_base(%params);
113 12582 50       27414 $self->type($params{type}) if $params{type}; # Backward compatibility
114 12582         32401 return $self;
115             }
116              
117             sub delete {
118 12407     12407 0 11380 my $self = shift;
119 12407         122780 my $h = $self->module->_nets;
120 12407         121496 delete $h->{$self->name};
121 12407         17802 return undef;
122             }
123              
124             ######################################################################
125              
126             sub logger {
127 0     0 1 0 return $_[0]->netlist->logger;
128             }
129             sub netlist {
130 0     0 0 0 return $_[0]->module->netlist;
131             }
132              
133 46   100 46   570 sub _used_in_inc { $_[0]->_used_in(1+($_[0]->_used_in()||0)); }
134 51   100 51   582 sub _used_out_inc { $_[0]->_used_out(1+($_[0]->_used_out()||0)); }
135 7   50 7   94 sub _used_inout_inc { $_[0]->_used_inout(1+($_[0]->_used_inout()||0)); }
136             sub _used_in_dec {
137 5 50   5   57 return if !$_[0]->_used_in();
138 5         53 $_[0]->_used_in(-1+$_[0]->_used_in());
139             }
140             sub _used_out_dec {
141 0 0   0   0 return if !$_[0]->_used_out();
142 0         0 $_[0]->_used_out(-1+$_[0]->_used_out());
143             }
144             sub _used_inout_dec {
145 0 0   0   0 return if !$_[0]->_used_inout();
146 0         0 $_[0]->_used_inout(-1+$_[0]->_used_inout());
147             }
148              
149 0 0   0 0 0 sub stored_lsb { defined $_[0]->SUPER::stored_lsb ? $_[0]->SUPER::stored_lsb : $_[0]->lsb; }
150              
151             sub width {
152 9     9 1 39 my $self = shift;
153             # Return bit width (if known)
154 9 50       120 my $dt = $self->data_type; $dt="" if $dt eq "signed";
  9         20  
155 9 100 66     97 if (defined $self->msb && defined $self->lsb) {
    50 100        
      66        
156 6         61 return (abs($self->msb - $self->lsb) + 1);
157             } elsif (my $width = $_Type_Widths{$dt || $self->net_type || $self->decl_type}) {
158 3         14 return $width;
159             }
160 0         0 return undef;
161             }
162              
163             sub type {
164 0     0 1 0 my $self = shift;
165 0         0 my $flag = shift;
166 0 0       0 if (defined $flag) {
167 0 0       0 if (my $acc = $_Type_Accessors{$flag}) {
168 0 0       0 if ($acc eq 'decl_type') { $self->decl_type($flag); }
  0 0       0  
169 0         0 elsif ($acc eq 'net_type') { $self->net_type($flag); }
170 0         0 else { $self->data_type($flag); }
171             } else {
172 0         0 $self->data_type($flag);
173             }
174             }
175 0 0 0     0 my $dt = $self->data_type; $dt="" if $dt && $dt eq "signed";
  0         0  
176 0   0     0 return $dt || $self->net_type || $self->decl_type;
177             }
178              
179             ######################################################################
180              
181       350     sub _link {}
182              
183             sub lint {
184 137     137 1 136 my $self = shift;
185             # Sequential logic may gen/use a signal, so we have to be a little sloppy
186 137 100       1426 if (0&&$self->_used_inout() && $self->_used_out()
187             && !$self->array()) { # if an array, different outputs might hit different bits
188             $self->warn("Signal is used as both a inout and output: ",$self->name(), "\n");
189             $self->dump_drivers(8);
190             }
191 0         0 elsif ($self->_used_out()) {
192 40 50 66     405 if ($self->_used_out()>1
      66        
193             # if an array, different outputs might hit different bits
194             && !$self->array()
195             # if vector, warn only if # of usages is higher than # of bits in vector
196             && (abs($self->msb() - $self->lsb()) + 1) < $self->_used_out()) {
197 0         0 $self->warn("Signal has multiple drivers (",
198             $self->_used_out(),"): ",$self->name(), "\n");
199 0         0 $self->dump_drivers(8);
200             }
201             }
202 137         129 if (0&&$self->_used_in() && !$self->_used_out()) {
203             $self->warn("Signal has no drivers: ",$self->name(), "\n");
204             }
205 137         175 if (0&&$self->_used_out() && !$self->_used_in()
206             && $self->name() !~ /unused/) {
207             $self->dump(5);
208             $self->port->dump(10) if $self->port;
209             $self->warn("Signal is not used (or needs signal declaration): ",$self->name(), "\n");
210             flush STDOUT;
211             flush STDERR;
212             }
213             }
214              
215             ######################################################################
216             ## Outputters
217              
218             sub _decls {
219 120     120   100 my $self = shift;
220 120   66     1300 my $out = $self->net_type || $self->decl_type;
221 120 100       1342 if ($self->port) {
222 69 100       700 $out = "input" if $self->port->direction eq "in";
223 69 100       709 $out = "output" if $self->port->direction eq "out";
224 69 100       704 $out = "inout" if $self->port->direction eq "inout";
225             }
226 120         199 return $out;
227             }
228              
229             sub verilog_text {
230 120     120 0 122 my $self = shift;
231 120         132 my @out;
232 120         152 foreach my $decl ($self->_decls) {
233 120         161 push @out, $decl;
234 120 100       1221 push @out, " ".$self->data_type if $self->data_type;
235 120         1232 push @out, " ".$self->name;
236 120 50       1241 push @out, " ".$self->array if $self->array;
237 120 100 100     1215 push @out, " = ".$self->value if defined $self->value && $self->value ne '';
238 120         169 push @out, ";";
239 120 100 66     1219 push @out, " ".$self->comment if defined $self->comment && $self->comment ne '';
240             }
241 120 50       435 return (wantarray ? @out : join('',@out));
242             }
243              
244             sub dump {
245 156     156 1 165 my $self = shift;
246 156   50     224 my $indent = shift||0;
247 156 100 50     2090 print " "x$indent,"Net:",$self->name()
    100 100        
      100        
      50        
248             ," ",($self->_used_in() ? "I":""),($self->_used_out() ? "O":""),
249             ," DeclT:",$self->decl_type||''
250             ," NetT:",$self->net_type||''
251             ," DataT:",$self->data_type||''
252             ," Array:",$self->array()||'';
253 156 100       2690 print " ",($self->msb).":".($self->lsb) if defined $self->msb;
254 156 100 66     2027 print " Value:",$self->value if defined $self->value && $self->value ne '';
255 156         2095 print "\n";
256             }
257              
258             sub dump_drivers {
259 0     0 1   my $self = shift;
260 0   0       my $indent = shift||0;
261 0           print " "x$indent,"Net:",$self->name,"\n";
262 0 0         if (my $port = $self->port) {
263 0           print " "x$indent," Port: ",$port->name," ",$port->direction,"\n";
264             }
265 0           foreach my $cell ($self->module->cells_sorted) {
266 0           foreach my $pin ($cell->pins_sorted) {
267 0           foreach my $net ($pin->nets) {
268 0 0         next unless defined $net->{net};
269 0 0 0       if ($pin->port && $net->{net} == $self) {
    0          
270 0           print " "x$indent," Pin: ",$cell->name,".",$pin->name
271             ," ",$pin->port->direction,"\n";
272             }
273             elsif ($self->name eq $net->{net}->name) {
274             warn "%Warning: Internal net name duplicate: ".$cell->name." ".$self->name."\n"
275             .$self->comment." ".$net->{net}->comment."\n"
276 0           ."$self ".$net->{net}->name."\n";
277             }
278             }
279             }
280             }
281 0           flush STDERR;
282 0           flush STDOUT;
283             }
284              
285             ######################################################################
286             #### Package return
287             1;
288             __END__