vpassert

Verilog Parser in Perl

#!/usr/bin/perl -w
# See copyright, etc in below POD section.
######################################################################

require 5.005;
use Getopt::Long;
use IO::File;
use IO::Dir;
use Pod::Usage;
use FindBin qw($RealBin);
use File::Copy;
use strict "vars";

use lib 'blib/arch';
use lib 'blib/lib';
use lib '.';
use Verilog::Parser;
use Verilog::Getopt;

use vars qw ($VERSION $Debug $Opt %Vpassert_Conversions
	     $Vpassert_Conversions_Regexp
	     %Vpassert_Chiponly_Rename
	     $Opt_Vericov $Opt_Chiponly
	     @Endmodule_Inserts
	     $Last_Parser
	     $Last_Module
	     $Last_Task
	     $ReqAck_Num
	     $Vericov_Enabled
	     $Got_Change
	     @Sendout
	     %Insure_Symbols
	     %File_Mtime %File_Mtime_Read %File_Mtime_Read_Used
	     %File_Dest
	     );
$VERSION = '3.120';

######################################################################
# configuration

# Hash with key of macro to convert and value of the function to call when it occurs
# Avoid having a token that is a substring of a standard function, for example
#     $wr would be bad (beginning of $write).  That would slow down the parsing.
%Vpassert_Conversions
    = (## U versions, to avoid conflicts with SystemVerilog
       '$uassert' =>		\&ins_uassert,
       '$uassert_amone' =>	sub {shift; uassert_hot(0,@_); },   # atmost one hot
       '$uassert_onehot' =>	sub {shift; uassert_hot(1,@_); },
       '$uassert_req_ack' =>	\&ins_uassert_req_ack,
       '$uassert_info' =>	\&ins_uassert_info,
       '$ucheck_ilevel' =>	\&ins_ucheck_ilevel,
       '$uerror' =>		\&ins_uerror,
       #'$ui' =>		# Used inside ucover_foreach_clk
       '$uinfo' =>		\&ins_uinfo,
       '$uwarn' =>		\&ins_uwarn,
       #'$uassert_clk' =>	sub {shift; my $clk=shift; my $cond=shift; umessage_clk("%%E", $cond,$clk,@_); }, # May be confusing, try without
       '$uerror_clk' =>		sub {shift; umessage_clk("%%E", 0, @_); },
       '$uwarn_clk' =>		sub {shift; umessage_clk("%%W", 0, @_); },
       '$ucover_clk' =>		sub {shift; ucover_clk(@_); },
       '$ucover_foreach_clk' =>	sub {shift; ucover_foreach_clk(@_); },
       );

# Any tokens appearing here will be removed with the --chiponly option
# This allows v files to be given to people that don't have our PLI library, and
# cah have these "true-PLI" functions to do something simpler.
%Vpassert_Chiponly_Rename = ();
%Vpassert_Chiponly_Rename
    = (#Token	  Convert to (0=remove)
       '$cmd_stop' => '$stop',
       );

######################################################################
# main

$Debug = 0;
my $output_dirname = ".vpassert/";
my $Opt_Quiet = 0;	# Don't blab about what files are being worked on
my $Opt_AllFiles = 0;	# Preprocess all files
my $Opt_Date = 0;	# Check dates
my $Opt_NoPli = 0;	# Delete all pli calls
$Opt_Vericov = 0;	# Add vericov on/off comments (messes up line # counts)
$Opt_Chiponly = 0;	# Only chip model; apply Vpassert_Chiponly_Rename's
my $Opt_RealIntent;	# RealIntent
my $Opt_Stop = 1;	# Put $stop in error messages
my $Opt_Verilator;	# Verilator
my $Last_ArgsDiffer;	# Last run's Opt_* mismatch
my $Opt_Minimum;	# Include `__message_minimum
my @Opt_Exclude;
my $Opt_Timeformat_Units = undef;
my $Opt_Timeformat_Precision = 0;
my $Opt_Line;

my $Total_Files = 0;
my @files = ();
my @instance_tests_list = ();

my $Prog_Mtime = 0;	# Time program last changed, so we bag cache on change
(-r "$RealBin/vpassert") or die "%Error: Where'd the vpassert source code go?";
$Prog_Mtime = (stat("$RealBin/vpassert"))[9];

autoflush STDOUT 1;

$Opt = new Verilog::Getopt();
@ARGV = $Opt->parameter(@ARGV);	# Strip -y, +incdir+, etc

if (! GetOptions (
		  "-o=s"	=> \$output_dirname,
		  "allfiles!"	=> \$Opt_AllFiles,
		  "chiponly!"	=> \$Opt_Chiponly,	# For makeesim only
		  "date!"	=> \$Opt_Date,
		  "debug"	=> \&debug,
		  "exclude=s"	=> sub {shift; push @Opt_Exclude, shift;},
		  "help"	=> \&usage,
		  "language=s"	=> sub { shift; Verilog::Language::language_standard(shift); },
	  	  "line!"	=> \$Opt_Line,
		  "minimum!"	=> \$Opt_Minimum,
		  "nopli!"	=> \$Opt_NoPli,
		  "realintent!"	=> \$Opt_RealIntent,
		  "quiet!"	=> \$Opt_Quiet,
		  "stop!"	=> \$Opt_Stop,
		  "timeformat-precision=s" => \$Opt_Timeformat_Precision,
		  "timeformat-units=s"	=> \$Opt_Timeformat_Units,
		  "vericov!"	=> \$Opt_Vericov,
		  "verilator!"	=> \$Opt_Verilator,
		  "version"	=> sub { print "Version $VERSION\n"; exit(0); },
		  "<>"		=> \&parameter,
		  )) {
    die "%Error: Bad usage, try 'vpassert --help'\n";
}
sub _switch_line {
    # If any of these flags change, we must regenerate output
    my $sw = "";
    $sw .= " --chiponly" if $Opt_Chiponly;
    $sw .= " --line" if $Opt_Line;
    $sw .= " --minimum=$Opt_Minimum" if defined $Opt_Minimum;
    $sw .= " --nopli" if $Opt_NoPli;
    $sw .= " --realintent" if $Opt_RealIntent;
    $sw .= " --stop" if $Opt_Stop;
    $sw .= " --vericov" if $Opt_Vericov;
    $sw .= " --verilator" if $Opt_Verilator;
    return $sw;
}

if (!defined $Opt_Line) {
    $Opt_Line = $Opt_Verilator || Verilog::Language::is_compdirect("`line"); # uses language_standard()
}

push @files, ($Opt->incdir(), $Opt->library(), $Opt->module_dir());

@files = $Opt->remove_duplicates(@files);
(@files) or die "%Error: No directories or files specified for processing, try --help\n";

if ($#files >= 0) {
    (!-f $output_dirname) or die "%Error: $output_dirname already exists as a file, should be a directory.\n";
    vpassert_recursive_prelude($output_dirname);
  file:
    foreach my $file (@files) {
	next if $file eq $output_dirname;
	foreach my $exclude (@Opt_Exclude) {
	    next file if $file =~ /^$exclude/;
	}
	vpassert_recursive ($file, $output_dirname);
    }
    vpassert_recursive_postlude($output_dirname);
}

print "\tVPASSERT generated $Total_Files new file(s)\n";
exit (0);

######################################################################

sub usage {
    print "Version $VERSION\n";
    print "\nThe following tokens are converted:\n";
    foreach my $tok (keys %Vpassert_Conversions ) {
	print "\tToken $tok\n";
    }
    print "\n";
    pod2usage(-verbose=>2, -exitval => 2);
    exit (1);
}

sub debug {
    $Debug = 1;
    $Verilog::Parser::Debug = 1;
    $Opt_Quiet = 0;
}

sub parameter {
    my $param = shift;
    (-r $param) or die "%Error: Can't open $param";
    push @files, $param;
}

######################################################################
######################################################################
######################################################################
######################################################################
######################################################################
######################################################################
# Functions that transform the tokens

# Note -I is specially detected below
sub ins_uinfo   { shift; sendout( message (get_lineinfo(), 1, "-I",  1, "", @_)); }
sub ins_uwarn   { shift; sendout( message (get_lineinfo(), 1, "%%W", 1, "", @_)); }
sub ins_uerror  { shift; sendout( message (get_lineinfo(), 1, "%%E", 1, "", @_)); }

sub ins_uassert {
    shift;
    my $cond = shift;
    my @params = @_;
    sendout( message (get_lineinfo(), 1, "%%E", $cond, "", 0, @params));
}

sub ins_uassert_info {
    shift;
    my $cond = shift;
    my @params = @_;
    # Lower case -i indicates it's a assert vs. a info
    sendout( message (get_lineinfo(), 1, "-i", $cond, "", 0, @params));
}

sub check_signame {
    my $sig = shift;
    return undef if !$sig;
    return $1 if ($sig =~ /^\s*([a-zA-Z_\$][a-z0-9A-Z_\$]*)\s*$/);
    return undef;
}

sub ins_uassert_req_ack {
    shift;
    my @params = @_;

    # Check parameters
    my $req = check_signame(shift @params);
    my $ack = check_signame(shift @params);
    ($req && $ack) or die "%Error: ".$Last_Parser->fileline.": Format of \$uassert_req_ack boggled.\n";
    @params = map {
	my $ipar = $_;
	$ipar = check_signame($ipar);
	($ipar) or die "%Error: ".$Last_Parser->fileline.": Parameter $ipar isn't a signal\n";
	$ipar;
    } @params;

    # Form new variables
    $ReqAck_Num or die "%Error: ".$Last_Parser->fileline.": \$uassert_req_ack can't find module statement\n";
    my $busy = "_assertreqack${ReqAck_Num}_busy_r";
    $Insure_Symbols{$Last_Module}{$busy} = ['reg', 0];	# Make this symbol exist if doesn't

    # We make a parity across all data signals, as we don't have the width
    # of the original signal, and I'm too lazy to add code to find it out.
    my @dholds = ();
    for (my $n=0; $n<=$#params; $n++) {
	my $dhold = "_assertreqack${ReqAck_Num}_data${n}_r";
	push @dholds, $dhold;
	$Insure_Symbols{$Last_Module}{$dhold} = ['reg', 0];
    }

    # Output it
    sendout(message_header());
    sendout("if (`__message_on) begin ");  # Need to wait till after reset, so FSM doesn't start
    sendout("casez({($busy),($req),($ack)}) ");
    sendout(" 3'b000: ;");
    sendout(" 3'b010: $busy<=1'b1;");
    sendout(" 3'b011: "); ins_uerror(0,"\"Unexpected $req coincident with $ack\\n\"");
    sendout(" 3'b001: "); ins_uerror(0,"\"Unexpected $ack with no request pending\\n\"");
    sendout(" 3'b100: ;");
    sendout(" 3'b11?: "); ins_uerror(0,"\"Unexpected $req with request already pending\\n\"");
    sendout(" 3'b101: $busy<=1'b0;");
    sendout("endcase ");

    if ($#params>=0) {
	sendout(" if (($req)||($busy)) begin");
	sendout(" if (($busy)) begin");
	for (my $n=0; $n<=$#params; $n++) {
	    sendout(" if ($dholds[$n] != ^($params[$n])) ");
	    ins_uerror(0,"\"Unexpected transition of $params[$n] during transaction\\n\"");
	}
	sendout(" end");
	# Save state of signals
	for (my $n=0; $n<=$#params; $n++) {
	    sendout(" $dholds[$n] <= ^($params[$n]);");
	}
	sendout(" end ");
    }
    sendout(" end ");

    sendout(message_trailer());
    $ReqAck_Num++;
}

sub ins_ucheck_ilevel {
    shift; # $ucheck_ilevel
    my $level = shift;
    my $chk = "/*vpassert*/if ((`__message_on) && ";
    $chk .= ' && (`__message_minimum >= (' . $level . '))' if $Opt_Minimum;
    $chk = $chk . '(__message >= (' . $level . ')))';
    sendout ($chk);
}

sub uassert_hot {
    my $check_nohot = shift;
    my @params = @_;

    my $text = "";
    my ($elem,$i,$ptemp,$plist,$pnone);

    my $len = 0;
    my @cl = ();
    while ($elem = shift @params){
	$elem =~ s/^\s*//;
	if ($elem =~ /^\"/){   # beginning quote
	    $elem =~ s/\"//g;
	    $text .= $elem;
	    last;
	}else{
	    foreach my $subel (split ',', $elem) {
		$len = $len + bitwidth($subel);
	    }
	    push @cl, $elem;
	};
    }

    # We use === so that x's will properly cause error messages
    my $vec = "({".join(",",@cl)."})";
    sendout("if (($vec & ($vec - ${len}'b1)) !== ${len}'b0 && `__message_on) ");
    ins_uerror(0,"\"MULTIPLE ACTIVE %b --> $text\\n\"",$vec);

    if ($check_nohot==1){
	sendout("if ($vec === ${len}'b0 && `__message_on) ");
	ins_uerror(0,"\"NONE ACTIVE %b --> $text\\n\"",$vec);
    }
}

sub umessage_clk {
    my $char = shift;
    my $cond = shift;
    my $clk = shift;
    my @params = @_;

    $params[0] = convert_concat_string($params[0]);
    ($params[0] =~ /^\s*\"/)
	or die "%Error: ".$Last_Parser->fileline.": Non-string \$message second argument: $params[0]\n";

    $ReqAck_Num or die "%Error: ".$Last_Parser->fileline.": \$uassert_req_ack can't find module statement\n";
    my $sig = "_umessageclk${ReqAck_Num}";
    $Insure_Symbols{$Last_Module}{$sig} = ['reg', 0];	# Make this symbol exist if doesn't
    $ReqAck_Num++;

    if ($cond eq '0') {
	sendout("/*vpassert*/$sig=1'b1;/*vpassert*/");
    } else {
	sendout("/*vpassert*/$sig=!($cond);/*vpassert*/");
    }

    _insert_always_begin('assert', "/*vpassert*/ $sig=1'b0; /*vpassert*/");

    my $bot = (" always @ (posedge $clk) if ($sig) "
	       .message (get_lineinfo(), 1, $char, 1, "", @_)
	       ." ");
    push @Endmodule_Inserts, $bot;
}

sub ucover_foreach_clk {
    my $clk = shift;
    my $label = shift;
    my $range = shift;
    my $expr = shift;
    $#_==-1
	or die "%Error: ".$Last_Parser->fileline.": Extra arguments to \$ucover_foreach_clk: $_[0]\n";

    # We require quotes around the label so synthesis tools won't gripe if not wrapping in vpassert
    # (Otherwise it would look like a system call with a variable of the name of the label.)
    ($label =~ s/^\s*\"([a-zA-Z][a-zA-Z0-9_]+)\"\s*$/$1/)
	or die "%Error: ".$Last_Parser->fileline.": Non-string label \$ucover_clk second argument: $label\n";

    ($range =~ s/^\s*\"\s*(\d[0-9,:]+)\s*\"\s*$/$1/)
	or die "%Error: ".$Last_Parser->fileline.": Can't parse msb:lsb in \$ucover_foreach_clk: $range\n";

    my @values = _convert_foreach_comma($range);