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

# Verilog - Verilog Perl Interface
# See copyright, etc in below POD section.
######################################################################

package Verilog::Netlist;
use Carp;
use IO::File;

use Verilog::Netlist::File;
use Verilog::Netlist::Interface;
use Verilog::Netlist::Module;
use Verilog::Netlist::Subclass;
use base qw(Verilog::Netlist::Subclass);
use strict;
use vars qw($Debug $Verbose $VERSION);

$VERSION = '3.476';

######################################################################
#### Error Handling

# Netlist file & line numbers don't apply
sub logger { return $_[0]->{logger}; }
sub filename { return 'Verilog::Netlist'; }
sub lineno { return ''; }

######################################################################
#### Creation

sub new {
    my $class = shift;
    my $self = {_interfaces => {},
		_modules => {},
		_files => {},
		implicit_wires_ok => 1,
		link_read => 1,
		logger => Verilog::Netlist::Logger->new,
		options => undef,	# Usually pointer to Verilog::Getopt
		symbol_table => [],	# Symbol table for Verilog::Parser
 		preproc => 'Verilog::Preproc',
		parser => 'Verilog::Netlist::File::Parser',
		remove_defines_without_tick => 0,   # Overriden in SystemC::Netlist
		#include_open_nonfatal => 0,
		#keep_comments => 0,
		#synthesis => 0,
		#use_pinselects => 0,
		use_vars => 1,
		_libraries_done => {},
		_need_link => [],	# Objects we need to ->link
		@_};
    bless $self, $class;
    return $self;
}

sub delete {
    my $self = shift;
    # Break circular references to netlist
    foreach my $subref ($self->modules) { $subref->delete; }
    foreach my $subref ($self->interfaces) { $subref->delete; }
    foreach my $subref ($self->files) { $subref->delete; }
    $self->{_modules} = {};
    $self->{_interfaces} = {};
    $self->{_files} = {};
    $self->{_need_link} = {};
}

######################################################################
#### Functions

sub link {
    my $self = shift;
    while (defined(my $subref = pop @{$self->{_need_link}})) {
	$subref->link();
    }
    # The above should have gotten everything, but a child class
    # may rely on old behavior or have added classes outside our
    # universe, so be nice and do it the old way too.
    $self->{_relink} = 1;
    while ($self->{_relink}) {
	$self->{_relink} = 0;
	foreach my $subref ($self->modules) {
	    $subref->link();
	}
	foreach my $subref ($self->interfaces) {
	    $subref->link();
	}
	foreach my $subref ($self->files) {
	    $subref->_link();
	}
    }
}

sub lint {
    my $self = shift;
    foreach my $subref ($self->modules_sorted) {
	next if $subref->is_libcell();
	$subref->lint();
    }
    foreach my $subref ($self->interfaces_sorted) {
	$subref->link();
    }
}

sub verilog_text {
    my $self = shift;
    my @out;
    foreach my $subref ($self->interfaces_sorted) {
	push @out, $subref->verilog_text, "\n";
    }
    foreach my $subref ($self->modules_sorted) {
	push @out, $subref->verilog_text, "\n";
    }
    return (wantarray ? @out : join('',@out));
}

sub dump {
    my $self = shift;
    foreach my $subref ($self->interfaces_sorted) {
	$subref->dump();
    }
    foreach my $subref ($self->modules_sorted) {
	$subref->dump();
    }
}

######################################################################
#### Module access

sub new_module {
    my $self = shift;
    # @_ params
    # Can't have 'new Verilog::Netlist::Module' do this,
    # as not allowed to override Class::Struct's new()
    my $modref = new Verilog::Netlist::Module
	(netlist=>$self,
	 keyword=>'module',
	 is_top=>1,
	 @_);
    $self->{_modules}{$modref->name} = $modref;
    push @{$self->{_need_link}}, $modref;
    return $modref;
}

sub new_root_module {
    my $self = shift;
    $self->{_modules}{'$root'} ||=
	$self->new_module(keyword=>'root_module',
			  name=>'$root',
			  @_);
    return $self->{_modules}{'$root'};
}

sub defvalue_nowarn {
    my $self = shift;
    my $sym = shift;
    # Look up the value of a define, letting the user pick the accessor class
    if (my $opt=$self->{options}) {
	return $opt->defvalue_nowarn($sym);
    }
    return undef;
}

sub remove_defines {
    my $self = shift;
    my $sym = shift;
    # This function is HOT
    my $xsym = $sym;
    # We only remove defines one level deep, for historical reasons.
    # We optionally don't require a ` as SystemC also uses this function and doesn't use `.
    if ($self->{remove_defines_without_tick} || $xsym =~ /^\`/) {
	$xsym =~ s/^\`//;
	my $val = $self->defvalue_nowarn($xsym);  #Undef if not found
	return $val if defined $val;
    }
    return $sym;
}

sub find_module_or_interface_for_cell {
    # ($self,$name)   Are arguments, hardcoded below
    # Hot function, used only by Verilog::Netlist::Cell linking
    # Doesn't need to remove defines, as that's already done by caller
    return $_[0]->{_modules}{$_[1]} || $_[0]->{_interfaces}{$_[1]};
}

sub find_module {
    my $self = shift;
    my $search = shift;
    # Return module maching name
    my $mod = $self->{_modules}{$search};
    return $mod if $mod;
    # Allow FOO_CELL to be a #define to choose what instantiation is really used
    my $rsearch = $self->remove_defines($search);
    if ($rsearch ne $search) {
	return $self->find_module($rsearch);
    }
    return undef;
}

sub modules {
    my $self = shift;
    # Return all modules
    return (values %{$self->{_modules}});
}

sub modules_sorted {
    my $self = shift;
    # Return all modules
    return (sort {$a->name cmp $b->name} (values %{$self->{_modules}}));
}

sub modules_sorted_level {
    my $self = shift;
    # Return all modules
    return (sort {$a->level <=> $b->level || $a->name cmp $b->name}
	    (values %{$self->{_modules}}));
}

sub top_modules_sorted {
    my $self = shift;
    return grep ($_->is_top && !$_->is_libcell, $self->modules_sorted);
}

######################################################################
#### Interface access

sub new_interface {
    my $self = shift;
    # @_ params
    # Can't have 'new Verilog::Netlist::Interface' do this,
    # as not allowed to override Class::Struct's new()
    my $modref = new Verilog::Netlist::Interface
	(netlist=>$self,
	 @_);
    $self->{_interfaces}{$modref->name} = $modref;
    push @{$self->{_need_link}}, $modref;
    return $modref;
}

sub find_interface {
    my $self = shift;
    my $search = shift;
    # Return interface maching name
    my $mod = $self->{_interfaces}{$search};
    return $mod if $mod;
    # Allow FOO_CELL to be a #define to choose what instantiation is really used
    my $rsearch = $self->remove_defines($search);
    if ($rsearch ne $search) {
	return $self->find_interface($rsearch);
    }
    return undef;
}

sub interfaces {
    my $self = shift;
    # Return all interfaces
    return (values %{$self->{_interfaces}});
}

sub interfaces_sorted {
    my $self = shift;
    # Return all interfaces
    return (sort {$a->name cmp $b->name} (values %{$self->{_interfaces}}));
}

######################################################################
#### Files access

sub resolve_filename {
    my $self = shift;
    my $filename = shift;
    my $lookup_type = shift;
    if ($self->{options}) {
	$filename = $self->remove_defines($filename);
	$filename = $self->{options}->file_path($filename, $lookup_type);
    }
    if (!-r $filename || -d $filename) {
	return undef;
    }
    $self->dependency_in($filename);
    return $filename;
}

sub new_file {
    my $self = shift;
    # @_ params
    # Can't have 'new Verilog::Netlist::File' do this,
    # as not allowed to override Class::Struct's new()
    my $fileref = new Verilog::Netlist::File
	(netlist=>$self,
	 @_);
    defined $fileref->name or carp "%Error: No name=> specified, stopped";
    $self->{_files}{$fileref->name} = $fileref;
    $fileref->basename(Verilog::Netlist::Module::modulename_from_filename($fileref->name));
    push @{$self->{_need_link}}, $fileref;
    return $fileref;
}

sub find_file {
    my $self = shift;
    my $search = shift;
    # Return file maching name
    return $self->{_files}{$search};
}

sub files {
    my $self = shift; ref $self or die;
    # Return all files
    return (sort {$a->name() cmp $b->name()} (values %{$self->{_files}}));
}
sub files_sorted { return files(@_); }

sub read_file {
    my $self = shift;
    my $fileref = $self->read_verilog_file(@_);
    return $fileref;
}

sub read_verilog_file {
    my $self = shift;
    my $fileref = Verilog::Netlist::File::read
	(netlist=>$self,
	 @_);
    return $fileref;
}

sub read_libraries {
    my $self = shift;
    if ($self->{options}) {
	my @files = $self->{options}->library();
	foreach my $file (@files) {
	    if (!$self->{_libraries_done}{$file}) {
		$self->{_libraries_done}{$file} = 1;
		$self->read_file(filename=>$file, is_libcell=>1, );
		## $self->dump();
	    }
	}
    }
}

######################################################################
#### Dependencies

sub dependency_in {
    my $self = shift;
    my $filename = shift;
    $self->{_depend_in}{$filename} = 1;
}
sub dependency_out {
    my $self = shift;
    my $filename = shift;
    $self->{_depend_out}{$filename} = 1;
}

sub dependency_write {
    my $self = shift;
    my $filename = shift;

    my $fh = IO::File->new(">$filename") or die "%Error: $! writing $filename\n";
    print $fh "$filename";
    foreach my $dout (sort (keys %{$self->{_depend_out}})) {
	print $fh " $dout";
    }
    print $fh " :";
    foreach my $din (sort (keys %{$self->{_depend_in}})) {
	print $fh " $din";
    }
    print $fh "\n";
    $fh->close();
}

######################################################################
#### Package return
1;
__END__