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

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

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

use Verilog::Netlist;
use Verilog::Netlist::Subclass;
use vars qw($VERSION @ISA);
use strict;
@ISA = qw(Verilog::Netlist::File::Struct
	Verilog::Netlist::Subclass);

$VERSION = '3.478';

structs('new',
	'Verilog::Netlist::File::Struct'
	=>[name		=> '$', #'	# Filename this came from
	   basename	=> '$', #'	# Basename of the file
	   netlist	=> '$', #'	# Netlist is a member of
	   userdata	=> '%',		# User information
	   attributes	=> '%', #'	# Misc attributes for systemperl or other processors
	   comment	=> '$', #'	# Comment provided by user
	   is_libcell	=> '$',	#'	# True if is a library cell
	   preproc	=> '$',	#'	# Preprocessor object
	   # For special procedures
	   _interfaces	=> '%',		# For autosubcell_include
	   _modules	=> '%',		# For autosubcell_include
	   ]);

######################################################################
######################################################################
#### Read class

package Verilog::Netlist::File::Parser;
use Verilog::SigParser;
use Verilog::Preproc;
use base qw(Verilog::SigParser);
use strict;

sub new {
    my $class = shift;
    my %params = (preproc => "Verilog::Preproc",
		  @_);	# filename=>

    my $preproc_class = $params{preproc};
    delete $params{preproc}; # Remove as preproc doesn't need passing down to Preprocessor

    # A new file; make new information
    $params{fileref} or die "%Error: No fileref parameter?";
    $params{netlist} = $params{fileref}->netlist;
    my $parser = $class->SUPER::new (%params,
				     modref=>undef,	# Module being parsed now
				     cellref=>undef,	# Cell being parsed now
				     _cmtref=>undef,	# Object to attach comments to
				     # Must parse all files in same compilation unit with
				     # same symbol_table, or a package won't exist for link()
				     symbol_table => $params{netlist}->{symbol_table},
				     );

    my @opt;
    push @opt, (options=>$params{netlist}{options}) if $params{netlist}{options};
    my $meta = $params{metacomment};
    if ($meta) {
	die "%Error: 'metacomment' arg of Netlist or read_file() must be a hash,"
	    unless (ref($meta) eq 'HASH');
	push @opt, metacomments=>[ grep({ $meta->{$_} } keys %$meta) ];
	push @opt, keep_comments=>($params{netlist}{keep_comments} || 1);
    } elsif ($params{netlist}{keep_comments}) {
	push @opt, keep_comments=>$params{netlist}{keep_comments};
    } else {
	push @opt, keep_comments=>0;
    }
    push @opt, keep_whitespace=>1;  # So we don't loose newlines
    push @opt, include_open_nonfatal=>1 if $params{netlist}{include_open_nonfatal};
    push @opt, synthesis=>1 if $params{netlist}{synthesis};
    my $preproc = $preproc_class->new(@opt,
				      parent => $params{fileref});
    $params{fileref}->preproc($preproc);
    $preproc->open($params{filename});
    $parser->parse_preproc_file($preproc);
    return $parser;
}

sub contassign {
    my $self = shift;
    my $keyword = shift;
    my $lhs = shift;
    my $rhs = shift;

    print " ContAssign $keyword $lhs\n" if $Verilog::Netlist::Debug;
    my $modref = $self->{modref};
    if (!$modref) {
	 return $self->error("CONTASSIGN outside of module definition", $lhs);
    }
    $modref->new_contassign
	 (filename=>$self->filename, lineno=>$self->lineno,
	  keyword=>$keyword, lhs=>$lhs, rhs=>$rhs);
}

sub defparam {
    my $self = shift;
    my $keyword = shift;
    my $lhs = shift;
    my $rhs = shift;

    print " Defparam $keyword $lhs\n" if $Verilog::Netlist::Debug;
    my $modref = $self->{modref};
    if (!$modref) {
	 return $self->error("DEFPARAM outside of module definition", $lhs);
    }
    $modref->new_defparam
	 (filename=>$self->filename, lineno=>$self->lineno,
	  keyword=>$keyword, lhs=>$lhs, rhs=>$rhs);
}

sub interface {
    my $self = shift;
    my $keyword = shift;
    my $name = shift;

    my $fileref = $self->{fileref};
    my $netlist = $self->{netlist};
    print "Interface $name\n" if $Verilog::Netlist::Debug;

    $self->{modref} = $netlist->new_interface
	 (name=>$name,
	  filename=>$self->filename, lineno=>$self->lineno);
    $fileref->_interfaces($name, $self->{modref});
    $self->{_cmtpre} = undef;
    $self->{_cmtref} = $self->{modref};
}

sub modport {
    my $self = shift;
    my $keyword = shift;
    my $name = shift;

    print " Modport $name\n" if $Verilog::Netlist::Debug;
    my $modref = $self->{modref};
    if (!$modref) {
	return $self->error("MODPORT outside of interface definition", $name);
    }
    $self->{_modportref} = $modref->new_modport
	 (name=>$name,
	  filename=>$self->filename, lineno=>$self->lineno);
    $self->{_cmtpre} = undef;
    $self->{_cmtref} = $self->{modref};
}

sub module {
    my $self = shift;
    my $keyword = shift;
    my $name = shift;
    my $orderref = shift;
    my $in_celldefine = shift;

    my $fileref = $self->{fileref};
    my $netlist = $self->{netlist};
    print "Module $name\n" if $Verilog::Netlist::Debug;

    $self->{modref} = $netlist->new_module
	 (name=>$name, keyword=>$keyword,
	  is_libcell=>($fileref->is_libcell() || $in_celldefine),
	  filename=>$self->filename, lineno=>$self->lineno);
    $fileref->_modules($name, $self->{modref});
    $self->{_cmtpre} = undef;
    $self->{_cmtref} = $self->{modref};
}

sub program {
    my $self = shift;
    $self->module(@_);
}

sub endinterface {
    my $self = shift;
    $self->endmodule(@_);
}

sub endmodport {
    my $self = shift;
    $self->{_cmtpre} = undef;
    $self->{_cmtref} = $self->{modref};
    $self->{_modportref} = undef;
}

sub endmodule {
    my $self = shift;
    $self->{_cmtpre} = undef;
    $self->{_cmtref} = undef;  # Assume all module comments are inside the module, not after
    $self->{modref} = undef;
}

sub endprogram {
    my $self = shift;
    $self->endmodule(@_);
}

sub attribute {
    my $self = shift;
    my $text = shift||'';

    my $modref = $self->{modref};
    my ($category, $name, $eql, $rest);
    if ($text =~ m!^([\$A-Za-z]\w*)\s+ (\w+) (\s*=\s*)? (.*) !x) {
	($category, $name, $eql, $rest) = ($1, $2, ($3 || ""), $4);
	if ($eql ne "") { $eql = "="; }
	my $cleaned = ($category ." ". $name . $eql . $rest);

	if ($Verilog::Netlist::Debug) {
	    printf +("%d: Attribute '%s'\n",
		     $self->lineno, $cleaned);
	}
	# Treat as module-level if attribute appears before any declarations.
	if ($modref) {
	    my $attr = $modref->new_attr($cleaned);
	}
    }
}

sub port {
    my $self = shift;
    my $name = shift;
    my $objof = shift;
    my $direction = shift;
    my $type = shift;
    my $array = shift;
    my $pinnum = shift;

    return if !($objof eq 'module' || $objof eq 'interface' || $objof eq 'modport');

    my $underref = $self->{_modportref} || $self->{modref};

    if ($pinnum) {  # Else a "input" etc outside the "(...)"s
	$underref->_portsordered($pinnum-1, $name);  # -1 because [0] has first pin
    }
    if ($direction) {  # Else just a pin number without declaration
	my $port = $underref->new_port
	    (name=>$name,
	     filename=>$self->filename, lineno=>$self->lineno,
	     direction=>$direction, data_type=>$type,
	     array=>$array, comment=>undef,);
    }
}

sub var {
    my $self = shift;
    #use Data::Dumper; print " DEBUG: var callback: ",Dumper(\@_);
    my $decl_type = shift;
    my $name = shift;
    my $objof = shift;
    my $net_type = shift;
    my $data_type = shift;
    my $array = shift;
    my $value = shift;
    print " Sig $name dt=$decl_type nt=$net_type d=$data_type\n" if $Verilog::Netlist::Debug;

    return if !($objof eq 'module' || $objof eq 'interface' || $objof eq 'modport' || $objof eq 'netlist');

    my $msb;
    my $lsb;
    if ($data_type && $data_type =~ /\[(.*):(.*)\]/) {
	$msb = $1; $lsb = $2;
    } elsif ($data_type && $data_type =~ /\[(.*)\]/) {
	$msb = $lsb = $1;
    }

    my $underref = $self->{_modportref} || $self->{modref};
    if ($objof eq 'netlist') {
	$underref = $self->{netlist}->new_root_module
	    (filename=>$self->filename, lineno=>$self->lineno);
    }
    if (!$underref) {
	return $self->error("Signal declaration outside of module definition", $name);
    }

    my $signed = ($data_type =~ /signed/);

    my $net = $underref->find_net($name);
    $net or $net = $underref->new_net
	(name=>$name,
	 filename=>$self->filename, lineno=>$self->lineno,
	 simple_type=>1, data_type=>$data_type, array=>$array,
	 comment=>$self->{_cmtpre}, msb=>$msb, lsb=>$lsb,
	 net_type=>$net_type, decl_type=>$decl_type,
	 signed=>$signed, value=>$value,
	);
    $net->data_type($data_type);  # If it was declared earlier as in/out etc
    $net->net_type($net_type) if $net_type;
    # (from a single non-typed input/output stmt), remark the type now
    $self->{_cmtpre} = undef;
    $self->{_cmtref} = $net;
}

sub instant {
    my $self = shift;
    my $submodname = shift;
    my $instname = shift;
    my $range = shift;

    print " Cell $instname\n" if $Verilog::Netlist::Debug;
    my $modref = $self->{modref};
    if (!$modref) {
	 return $self->error("CELL outside of module definition", $instname);
    }
    $self->{cellref} = $modref->new_cell
	 (name=>$instname,
	  filename=>$self->filename, lineno=>$self->lineno,
	  submodname=>$submodname, range=>$range,);
    $self->{_cmtpre} = undef;
    $self->{_cmtref} = $self->{cellref};
}

sub endcell {
    my $self = shift;
    $self->{_cmtpre} = undef;
    $self->{_cmtref} = $self->{cellref};  # Comments after cell decl go to the cell
}

sub parampin {
    my $self = shift;
    my $pin = shift;
    my $conn = shift;
    my $number = shift;

    my $prev = $self->{cellref}->params();
    $prev .= ", " if $prev;
    $prev .= ($pin ? ".$pin($conn)" : $conn);
    $self->{cellref}->params($prev);
}

sub pin {
    my $self = shift;
    if (!$self->{use_pinselects}) {
	$self->pinselects(@_);
    }
}

sub pinselects {
    my $self = shift;
    my $pin = shift;
    my $nets = shift;
    my $number = shift;
    my $hasnamedports = (($pin||'') ne '');
    $pin = "pin".$number if !$hasnamedports;

    my $net_cnt = scalar($nets);
    print "   Pin $pin  $number (connected to $net_cnt nets) \n" if $Verilog::Netlist::Debug;
    my $cellref = $self->{cellref};
    if (!$cellref) {
	return $self->error("PIN outside of cell definition", $pin);
    }

    my %params = (
	name => $pin,
	portname => $pin,
	portnumber => $number,
	pinnamed => $hasnamedports,
	filename => $self->filename,
	lineno => $self->lineno,
    );

    if ($self->{use_pinselects}) {
	$params{pinselects} = $nets;
    } else {
	$params{netname} = $nets;
    }

    my $pinref = $cellref->new_pin(%params);
    # If any pin uses call-by-name, then all are assumed to use call-by-name
    $cellref->byorder(1) if !$hasnamedports;
    $self->{_cmtpre} = undef;
    $self->{_cmtref} = $pinref;
}

sub keyword {
    # OVERRIDE Verilog::Parse calls when keyword occurs
    # Note we use_cb_keyword only if comments are parsed!
    my $self = shift;	# Parser invoked
    $self->{_cmtpre} = undef;
    $self->{_cmtref} = undef;
}

sub comment {
    my $self = shift;
    # OVERRIDE Verilog::Parse calls when comment occurs
    my $text = shift;	# Includes comment delimiters
    if ($self->{_cmtref}) {
	my $old = $self->{_cmtref}->comment();
	$old = (defined $old) ? $old."\n".$text : $text;
	$self->{_cmtref}->comment($old);
    }
    elsif ($self->{modref}) {
	my $old = $self->{_cmtpre};
	$old = (defined $old) ? $old."\n".$text : $text;
	$self->{_cmtpre} = $old;
    }
}

# sub operator {   ... Disabled by new(use_cmt_operator => 0)
# sub number {   ... Disabled by new(use_cmt_number => 0)
# sub string {   ... Disabled by new(use_cmt_string => 0)
# sub symbol {   ... Disabled by new(use_cmt_symbol => 0)

sub error {
    my $self = shift;
    my $text = shift;

    my $fileref = $self->{fileref};
    # Call Verilog::Netlist::Subclass's error reporting, it will track # errors
    $fileref->error($self, "$text\n");
}

sub warn {
    my $self = shift;
    my $text = shift;

    my $fileref = $self->{fileref};
    $fileref->warn($self, "$text\n");
}

package Verilog::Netlist::File;

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

sub delete {
    my $self = shift;
    $self->netlist(undef);  # Break circular
    $self->preproc(undef);  # Break circular
}

sub logger {
    my $self = shift;
    return $self->netlist->logger;
}

sub read {
    my %params = (lookup_type=>'module',
		  @_);	# netlist=>, filename=>, per-file options

    my $filename = $params{filename} or croak "%Error: ".__PACKAGE__."::read_file (filename=>) parameter required, stopped";
    my $netlist = $params{netlist} or croak("Call Verilog::Netlist::read_file instead,");

    my $filepath = $netlist->resolve_filename($filename, $params{lookup_type});
    if (!$filepath) {
	if ($params{error_self}) { $params{error_self}->error("Cannot find $filename\n"); }
	elsif (!defined $params{error_self}) { die "%Error: Cannot find $filename\n"; }  # 0=suppress error
	return undef;
    }
    print __PACKAGE__."::read_file $filepath\n" if $Verilog::Netlist::Debug;

    my $fileref = $netlist->new_file(name=>$filepath,
				     is_libcell=>$params{is_libcell}||0,
				     );

    my $keep_cmt = ($params{keep_comments} || $netlist->{keep_comments});
    my $parser_class = ($params{parser} || $netlist->{parser});

    my $parser = $parser_class->new
	( fileref => $fileref,
	  filename => $filepath,	# for ->read
	  metacomment => ($params{metacomment} || $netlist->{metacomment}),
	  keep_comments => $keep_cmt,
	  use_vars => ($params{use_vars} || $netlist->{use_vars}),
	  use_pinselects => ($params{use_pinselects} || $netlist->{use_pinselects}),
	  use_protected => 0,
	  preproc => ($params{preproc} || $netlist->{preproc}),
	  # Callbacks we need; disable unused for speed
	  use_cb_attribute => 1,
	  use_cb_comment => $keep_cmt,
	  use_cb_keyword => $keep_cmt,
	  use_cb_number => 0,
	  use_cb_operator => 0,
	  use_cb_string => 0,
	  use_cb_symbol => 0,
	  );
    return $fileref;
}

sub link {
    # For backward compatibility for SystemC child class, call _link
    $_[0]->_link(@_);
}
sub _link {
}

sub dump {
    my $self = shift;
    my $indent = shift||0;
    print " "x$indent,"File:",$self->name(),"\n";
}

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