vpassert

Verilog Parser in Perl

		}
	    }
	    $hit or die "vpassert %Error: $filename: Couldn't find symbol insertion point in $mod\n";
	}
    }

    $#Endmodule_Inserts < 0
	or die "vpassert %Error: $filename: Couldn't find endmodule\n";

    # Put out the processed file
    print "Got_Change? $Got_Change  $outname\n"	if ($Debug);
    if ($Got_Change) {
	my $date = localtime;
	$fh->open(">$outname") or die "%Error: Can't write $outname.";
	if ($Opt_Line) {
	    print $fh "`line 1 \"$filename\" 0\n";
	}
	# No newline so line counts not affected
	print $fh "/* Generated by vpassert; File:\"$filename\" */";
	my $out = join('',map {$_->[1]} @Sendout);
	# Simplify redundant `lines to save space
	$out =~ s%(`line[^\n]*)\n[ \t\n]*(`line[^\n]*\n)%$2%mg;
	print $fh $out;
	$fh->close;
	if (defined $File_Mtime{$filename}) {
	    utime $File_Mtime{$filename}, $File_Mtime{$filename}, $outname;
	}
    }

    return $Got_Change;
}

#----------------------------------------------------------------------

sub bitwidth {
    # Take a string like "{foo[5:0],bar} and return bit width (7 in this case)
    my $statement = shift;
    my $bits = 0;
    foreach my $sig (split /,\{\]/, $statement) {
	if ($sig =~ /[a-z].* \[ (-?[0-9]+) : (-?[0-9]+) \]/x) {
	    $bits += ($1 - $2) + 1;
	} elsif ($sig =~ /[a-z]/) {
	    $bits ++;
	}
    }
    return $bits;
}

#----------------------------------------------------------------------
#----------------------------------------------------------------------
#----------------------------------------------------------------------

sub vpassert_db_read_file {
    # Read when the unprocessed files were last known to not need processing
    my $filename = shift;
    my $fh = IO::File->new("<$filename") or return;  # no error if fails
    while (my $line = $fh->getline) {
	chomp $line;
	if ($line =~ /^switch\s*(.*$)/) {
	    my $old = $1;
	    my $now = _switch_line();
	    $old =~ s/\s+//g;
	    $now =~ s/\s+//g;
	    $Last_ArgsDiffer = ($old ne $now);
	} else {
	    my ($tt_cmd, $tt_file, $tt_mtime) = split(/\t/,$line);
	    $tt_cmd .= "";	# Warning removal
	    $File_Mtime_Read{$tt_file} = $tt_mtime;
	    $File_Mtime_Read_Used{$tt_file} = 0;
	}
    }
    $fh->close;
}

sub vpassert_db_write_file {
    # Save which unprocessed files did not need processing
    my $filename = shift;
    my $fh = IO::File->new(">$filename") or die "%Error: $! $filename.\n";
    $fh->print ("switch\t"._switch_line()."\n");
    foreach my $file (sort (keys %File_Mtime)) {
	$fh->print ("unproc\t$file\t$File_Mtime{$file}\n");
    }
    $fh->close;
}

#----------------------------------------------------------------------

sub vpassert_recursive_prelude {
    # What to do before processing any files
    my $destdir = shift;

    $destdir .= "/"		if ($destdir !~ /[\\\/]$/);

    %File_Mtime = ();
    %File_Mtime_Read = ();
    vpassert_db_read_file ("${destdir}/.vpassert_skipped_times");
    form_conversions_regexp();

    if (! -d $destdir) {
	mkdir ($destdir,0777) or die "%Error: Can't mkdir $destdir\n";
    }

    # Don't include directory in time saving, as path may change dep how run
    my $dest_mtime = $File_Mtime_Read{"vpassert"} || 0;
    if (!$Opt_Date
	|| ($Prog_Mtime > $dest_mtime)
	|| $Last_ArgsDiffer) {
	# Flush the whole read cache
	%File_Mtime_Read = ();
	print "\t    VPASSERT (or overall flags) changed... Two minutes...\n";
	print "\t    Mtime = $Prog_Mtime\n" if $Debug;
    }
    #print "FF $Opt_Date, $Prog_Mtime, $dest_mtime, $Opt_Vericov, $Last_Vericov\n";
    $File_Mtime{"vpassert"} = $Prog_Mtime;
    $File_Mtime_Read_Used{"vpassert"} = 1;
}

sub vpassert_recursive_postlude {
    my $destdir = shift;
    $destdir .= "/"		if ($destdir !~ /[\\\/]$/);
    # What to do after processing all files

    # Check for deletions
    foreach my $srcfile (keys %File_Mtime_Read) {
	if (defined $File_Mtime_Read_Used{$srcfile}
	    && !$File_Mtime_Read_Used{$srcfile}) {
	    (my $basefile = $srcfile) =~ s/.*\///;
	    my $destfile = "$destdir$basefile";
	    # A file with the same basename may now be in a different dir,
	    # and already processed, so don't delete it.
	    if (!$File_Dest{$destfile}) {
		print "\t    vpassert: Deleted? $srcfile\n" if !$Opt_Quiet;
		unlink $destfile;
	    }
	}
    }

    vpassert_db_write_file ("${destdir}/.vpassert_skipped_times");
}

sub vpassert_recursive {
    # Recursively process this directory or file argument
    my $srcdir = shift;
    my $destdir = shift;

    print "Recursing $srcdir $destdir\n" if ($Debug);

    if (-d $srcdir) {
	$srcdir .= "/"		if ($srcdir !~ /[\\\/]$/);
	$destdir .= "/"		if ($destdir !~ /[\\\/]$/);
	my $dh = new IO::Dir $srcdir or die "%Error: Could not directory $srcdir.\n";
	while (defined (my $basefile = $dh->read)) {
	    my $srcfile = $srcdir . $basefile;
	    if ($Opt->libext_matches($srcfile)) {
		next if -d $srcfile;
		vpassert_process_one($srcfile, $destdir);
	    }
	}
	$dh->close();
    } else {
	# Plain file
	vpassert_process_one ($srcdir, $destdir, 1);
    }
}

use vars (qw(%file_directory));

sub vpassert_process_one {
    # Process one file, keeping cache consistent
    my $srcfile = shift;
    my $destdir = shift;

    (my $basefile = $srcfile) =~ s!.*[/\\]!!;
    my $destfile = "$destdir$basefile";
    $File_Dest{$destfile} = 1;

    my $src_mtime = (stat($srcfile))[9];
    $src_mtime ||= 0;
    my $dest_mtime = $File_Mtime_Read{$srcfile} || 0;
    $File_Mtime_Read_Used{$srcfile} = 1;

    # Mark times
    #print "BCK $basefile $src_mtime, $dest_mtime\n";
    $File_Mtime{$srcfile} = $src_mtime;

    if ($src_mtime != $dest_mtime) {
	my $no_output = 0;
	unlink $destfile;
	$Total_Files++;
	if (! vpassert_process ($srcfile, $destfile, $Opt_AllFiles)) {
	    # Didn't need to do processing
	    $no_output = 1;
	    print "nooutput: vpassert_process ($srcfile, $destfile,0 )\n" if ($Debug);
	    copy($srcfile,$destfile);
	} else {
	    # Make sure didn't clobber another directory's file
	    print "madenew:  vpassert_process ($srcfile, $destfile,0 )\n" if ($Debug);
	    if ($file_directory{$destfile}) {
		my $old = $file_directory{$destfile};
		die "%Error: Two files with same basename: $srcfile, $old\n";
		# This warning is to prevent search order dependence in the
		# verilog search path.  It also makes sure we don't clobber
		# one file with another by the same name in the .vpassert directory
	    }
	}
	if (!$Opt_Quiet) {
	    print "  VPASSERT'ing file ($Total_Files) $srcfile ",
	    ($dest_mtime ? "(Changed)":"(New)"), ($no_output ? " (no-output)" : ""),"\n";
	}
    }
    $file_directory{$destfile} = $srcfile;
}

######################################################################
######################################################################
######################################################################
######################################################################
# Parser functions called by Verilog::Parser

package Verilog::Vpassert::Parser; ## no critic
require Exporter;
use Verilog::Parser;
use base qw(Verilog::Parser);

BEGIN {
    # Symbols to alias to global scope
    use vars qw(@GLOBALS);
    @GLOBALS = qw
	(
	 $Debug
	 @Sendout
	 $Last_Task
	 $Last_Module
	 $Opt_Chiponly
	 $Opt_Vericov
	 $ReqAck_Num
	 $Vericov_Enabled
	 %Vpassert_Conversions
	 %Vpassert_Chiponly_Rename
	 %Insure_Symbols
	 @Endmodule_Inserts
	 );
    foreach (@GLOBALS) {
	my ($type,$sym) = /^(.)(.*)$/;
	*{"$sym"} = \${"::$sym"} if ($type eq "\$");
	*{"$sym"} = \%{"::$sym"} if ($type eq "%");
	*{"$sym"} = \@{"::$sym"} if ($type eq "@");
    }
}

use strict;
use vars (@GLOBALS,
	  qw ( $Last_Keyword
	       @Last_Symbols
	       @Last_Number_Ops
	       $Need_Vpassert_Symbols
	       @Params
	       $Param_Num
	       $Parens
	       $In_Message
	       ));
use Verilog::Parser;

sub new {
    my $class = shift;
    my $self = $class->SUPER::new();
    bless $self, $class;

    # State of the parser
    # These could be put under the class, but this is faster and we only parse
    # one file at a time
    @Endmodule_Inserts = ();
    $Last_Keyword = "";
    @Last_Symbols = ();
    @Last_Number_Ops = ();
    $Last_Task = "";
    $Last_Module = "";
    $Vericov_Enabled = $Opt_Vericov;
    $Need_Vpassert_Symbols = 0;
    $Param_Num = 0;
    $Parens = 0;
    $In_Message = 0;
    #%module_symbols = ();
    %Insure_Symbols = ();
    @Params = ();

    return $self;
}

sub keyword {
    # Callback from parser when a keyword occurs
    my ($parser, $token) = @_;
    my $since = $parser->unreadback(); $parser->unreadback('');

    $Last_Keyword = $token;
    @Last_Symbols = ();
    @Last_Number_Ops = ();

    if ($Opt_Vericov && (($token eq "case") || ($token eq "casex") || ($token eq "casez"))) {
	push @Sendout, [$parser->lineno, $since];
	::sendout ("\n/*summit implicit off*/\n") if $Vericov_Enabled;
	push @Sendout, [$parser->lineno, $token];
    }
    elsif ($Opt_Vericov && ($token eq "endcase")) {
	push @Sendout, [$parser->lineno, $since . $token];
	::sendout ("\n/*summit implicit on*/\n") if $Vericov_Enabled;
    }
    elsif ($token eq "endmodule") {
	if ($#Endmodule_Inserts >= 0) {
	    my $ins = join('',@Endmodule_Inserts);
	    my $lineno = $parser->lineno;
	    $ins =~ s!/\*vpassert_endmod_line\*/!$lineno!g;
	    ::sendout ("/*vpassert*/ ".$ins." /*vpassert*/");
	    @Endmodule_Inserts = ();
	}
	push @Sendout, [$parser->lineno, $since . $token];
    }
    else {
	push @Sendout, [$parser->lineno, $since . $token];
    }
}

sub symbol {
    # Callback from parser when a symbol occurs
    my ($parser, $token) = @_;
    my $since = $parser->unreadback(); $parser->unreadback('');

    if ($token eq "__LINE__") { $token = $parser->lineno(); }
    if ($token eq "__FILE__") { $token = $parser->filename(); }

    if ($In_Message) {
	$Params[$Param_Num] .= $since . $token;
    } else {
	if ($Vpassert_Conversions {$token}
		 || ($Opt_Chiponly && defined $Vpassert_Chiponly_Rename{$token} && !$Vpassert_Chiponly_Rename{$token})
		 || ($Opt_NoPli && $token =~ /^\$/ && $Parens==0)) {
	    push @Sendout, [$parser->lineno, $since];
	    print "Callback SYMBOL $token\n"    if ($Debug);
	    $In_Message = 1;
	    $Param_Num = 1;
	    @Params = ();
	    $Params[0] = $token;
	} elsif ($Opt_Chiponly && defined $Vpassert_Chiponly_Rename{$token}
		 && $Vpassert_Chiponly_Rename{$token}) {
	    push @Sendout, [$parser->lineno, $since . $Vpassert_Chiponly_Rename{$token}];
	} else {
	    # Actually a keyword; we check for that too
	    push @Sendout, [$parser->lineno, $since . $token];
	}
    }

    if ($Last_Keyword eq "task") {
	$Last_Task = $token;
	$Last_Keyword = "";
	$Parens = 0;
    }
    if ($Last_Keyword eq "module") {
	$Last_Module = $token;
	$Last_Keyword = "";
	$Need_Vpassert_Symbols = 1;
	$ReqAck_Num = 1;
	$Parens = 0;
    }
    push @Last_Symbols, $token;
}

sub number {
    # Callback from parser when a number occurs
    my ($parser, $token) = @_;
    my $since = $parser->unreadback(); $parser->unreadback('');

    if ($In_Message) {
	print "Callback NUMBER $token\n"    if ($Debug);
	$Params[$Param_Num] .= $since . $token;
    } else {
	push @Sendout, [0, $since . $token];
    }
    push @Last_Number_Ops, $token;
}