vpassert

Verilog Parser in Perl

    foreach my $i (@values) {
	my $nexpr = $expr;
	$nexpr =~ s/\$ui\b/($i)/g
	    or die "%Error: ".$Last_Parser->fileline.": No \$ui in \$ucover_foreach_clk expression: $expr\n";
	_ucover_clk_guts($clk, $label."__".$i, "(${nexpr})");
    }
}

sub ucover_clk {
    my $clk = shift;
    my $label = shift;
    $#_==-1
	or die "%Error: ".$Last_Parser->fileline.": Extra arguments to \$ucover_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";

    _ucover_clk_guts($clk,$label, "1'b1");
}

sub _ucover_clk_guts {
    my $clk = shift;
    my $label = shift;
    my $expr = shift;

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

    sendout("/*vpassert*/$sig=${expr};/*vpassert*/");

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

    # Alas, `line is required to see correct cover point
    my $bot = "";
    if ($Opt_Line) {
	$bot .= "\n`line ".$Last_Parser->lineno." \"".$Last_Parser->filename."\" 0\n";
    }
    $bot .= " $label: cover property (@(posedge $clk) ($sig));\n";
    if ($Opt_Line) {
	$bot .= "`line /*vpassert_endmod_line*/ \"".$Last_Parser->filename."\" 0\n";
    }
    push @Endmodule_Inserts, $bot;
}

sub _insert_always_begin {
    my $for_assert = shift;
    my $text = shift;
    my $beginl;
    for (my $l = $#Sendout; $l>=0; $l--) {
	my $tok = $Sendout[$l][1];
	#print "HUNT $l: ".($beginl||"").": $tok\n";
	# Fortunately all comments must be a single array entry
	$tok =~ s!//.*?\n!!go;
	$tok =~ s!/\*.*?\*/$!!go;
	if ($tok =~ /\bbegin\b/) {
	    $beginl = $l;
	}
	if ($tok =~ /\b(if|initial|final)\b/) {
	    $beginl = undef;
	}
	if ($tok =~ /\bposedge\b/) {
	    if ($for_assert ne 'cover') {
		die "%Error: ".$Last_Parser->fileline.": \$uerror_clk is under a posedge clk, use \$uerror instead\n";
	    }
	}
	if ($tok =~ /\balways\b/) {
	    last if !defined $beginl;  # And die below
	    my $insert = "";
	    $insert .= "\n" if $Opt_Line;
	    $insert .= $text;
	    $insert .= "\n`line ".$Sendout[$l][0]." \"".$Last_Parser->filename."\" 0\n" if $Opt_Line;
	    $Sendout[$beginl][1] =~ s/(\bbegin\b)/$1$insert/;
	    return;
	}
    }
    die "%Error: ".$Last_Parser->fileline.": \$uerror_clk is not somewhere under an 'always begin' block\n";
}

sub get_lineinfo {
    # Align the lineinfo so that right hand sides are aligned
    my $message_filename = $Last_Parser->filename;
    $message_filename =~ s/^.*\///g;
    my $lineinfo = substr ($message_filename, 0, 17); # Don't make too long
    $lineinfo = $lineinfo . sprintf(":%04d:", $Last_Parser->lineno );
    $lineinfo = sprintf ("%-21s", $lineinfo);
}

use vars qw($Msg_Header_Level);
sub message_header {
    my $out = "";
    if (!$Msg_Header_Level) {
	$out .= "\n/*summit modcovoff -bpen*/\n" if $Vericov_Enabled;
	$out .= "\n/*ri userpass BE on*/\n" if $Opt_RealIntent;
	$out .= "/*vpassert*/";
    }
    $out .= "begin ";
    $out .= "`coverage_block_off " if ($Opt_Verilator && !$Msg_Header_Level);
    $Msg_Header_Level++;
    return $out;
}

sub message_trailer {
    my $out = 'end ';
    $out .= '/*vpassert*/' if ((--$Msg_Header_Level)==0);
    $out .= "\n/*summit modcovon -bpen*/\n" if $Vericov_Enabled;
    $out .= "\n/*ri userpass BE off*/\n" if $Opt_RealIntent;
    return $out;
}

sub message {
    my $lineinfo = shift;
    my $show_id = shift;
    my $char = shift;
    my $cond = shift;
    my $otherargs = shift;
    my @params = @_;	# Level, printf string, args

    if ($params[0] =~ /^\s*\"/) {
	# No digit in first parameter
	# Push new parameter [0] as a 0.
	unshift @params, '0';
    }

    $params[1] = convert_concat_string($params[1]);
    unless ($char =~ /^-I/i) {
	if ($params[1] =~ s/\s*\"\s*$//) {
	    # For a well-formed message, $params[1] now ends in "\\n".
	    $params[1] .= "\\n" if $params[1] !~ /\\n$/;
	    $params[1] = $params[1]."${char}: In %m\\n\"";
	}
    }

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

    my $out = message_header();

    # These long lines without breaks are intentional; I want to preserve line numbers
    my $is_warn = (($char eq "%%E") || ($char eq "%%W") || ($char eq "-i"));

    if ($cond ne "1") {
	# Conditional code, for $uassert
	# Note this will only work in RTL code!  Chiponly build issues otherwise.
	$out .= "if (!($cond) && (`__message_on)) ";
    } elsif ($params[0] =~ /^\s*0\s*$/) {
	# Always enabled
	if ($is_warn) {
	    $out .= "if (`__message_on) ";
	}
    } else {
	# Complex test
	$Insure_Symbols{$Last_Module}{__message} = ['integer',5];	# Make this symbol exist if doesn't
	my $chk = 'if ((__message >= (' . $params[0] . '))';
	$chk .= ' && (`__message_minimum >= (' . $params[0] . '))' if $Opt_Minimum;
	$chk .= " && (`__message_on) " if $is_warn;
	$chk .= ') ';
	$out .= $chk;
    }

    my $task;
    if (($char eq "-I") || ($char eq "-i")) {}
    elsif ($char eq "%%E") {
	$task = ($Opt_Stop ? '$stop;' : "`pli.errors = `pli.errors+1;");
    } elsif ($char eq "%%W") {
	$task = ($Opt_Stop ? '$stop;' : "`pli.warnings = `pli.warnings+1;");
    } else { die "%Error: Unknown message character class '$char'\n"; }

    {	# if's body
	$out .= "begin";
	$out .= " \$timeformat($Opt_Timeformat_Units, $Opt_Timeformat_Precision,\"\",20);"
	    if defined $Opt_Timeformat_Units;
	$out .= " \$write (\"[%0t] ${char}:${lineinfo} ";

	my $par = $params[1];
	$par =~ s/^\s*\"//;

	$out .= "$par,\$time$otherargs";
	for my $parn (2 .. $#params) {
	    my $p = $params[$parn];
	    $out .= ", $p";
	    print "MESSAGE $char, Parameter $p\n" if ($Debug);
	}
	$out .= ');';
	$out .= $task    if ($task && !$Opt_Chiponly);
	$out .= '$stop;' if ($task && $Opt_Chiponly);
	$out .= ' end ';
    }

    $out .= message_trailer();

    return $out;
}

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

sub _convert_foreach_comma {
    my $in = shift;
    # Similar to Verilog::Language::split_bus
    my @out;
    $in =~ s/\s+//g;
    while ($in =~ s!,?(((\d+):(\d+))|(\d+))!!) {
	if (defined $3 && defined $4) {
	    if ($3<$4) {
		foreach (my $i=$3; $i<=$4; $i++) {
		    push @out, $i;
		}
	    } else {
		foreach (my $i=$3; $i>=$4; $i--) {
		    push @out, $i;
		}
	    }
	} elsif (defined $5) {
	    push @out, $5;
	}
    }
    $in eq ""
	or die "%Error: ".$Last_Parser->fileline.": Strange range expression: $in\n";
    return @out;
}

sub convert_concat_string {
    my $string = shift;
    # Convert {"string"} or {"str","in","g"} to just "string"
    # Beware embedded quotes "\""
    return $string if ($string !~ /^\s*\{\s*(\".*)\s*\}\s*$/);
    my $in = $1;
    my $out = "";
    my $quote; my $slash;
    for (my $i=0; $i<length($in); $i++) {
	my $c = substr($in,$i,1);
	if ($quote && $c eq '"' && !$slash) {
	    $quote = 0;
	    $out .= $c;
	} elsif ($quote) {
	    $out .= $c;
	} elsif ($c eq '"') {
	    $quote = 1;
	    $out .= $c;
	    $out =~ s/\"\"$//;	# Join "" strings
	} elsif ($c =~ /\s/) {
	} elsif ($c eq ',') {
	} else {
	    # Something strange, just don't convert it
	    return $string;
	}
	$slash = ($c eq "\\");
    }
    return $out;
}

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

sub sendout {
    # Send out the string to the output file, consider this a change.
    my $string = shift;
    push @Sendout, [0, $string];
    $Got_Change = 1;
}

sub sendout_orig {
    # Send out the string to the output file, not a change.
    # The first argument is the line number.  Right now only certain things
    # need to set it.  In the future we may adopt a more general scheme
    # whereby all original text sets it, the autos indicate "-1" and the
    # outputter does the appropriate `lines for us.
    my $string = shift;
    push @Sendout, [0, $string];
}

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

sub form_conversions_regexp {
    # Create $Vpassert_Conversions_Regexp, a regexp that matches any of the conversions
    # This regexp will allow us to quickly look at the file and ignore it if no matches
    $Vpassert_Conversions_Regexp = '\$(';
    my $last_tok = "\$ignore";
    foreach my $tok (sort (keys %Vpassert_Conversions)) {
	($tok =~ s/^\$//) or die "%Error: Vpassert_Conversion $tok doesn't have leading \$\n";
	if (substr ($tok, 0, length($last_tok)) eq $last_tok) {
	    #print "Suppress $tok   $last_tok\n" if $Debug;
	} else {
	    $Vpassert_Conversions_Regexp .= "${tok}|";
	    $last_tok = $tok;
	}
    }
    $Vpassert_Conversions_Regexp =~ s/\|$ /\)/x;

    $Vpassert_Conversions_Regexp = "\$NEVER_MATCH_ANYTHING" if $Vpassert_Conversions_Regexp eq '\$()';
    #print "CV REGEXP $Vpassert_Conversions_Regexp\n" if $Debug;
}

sub vpassert_process {
    # Read all signals in this filename
    # Return TRUE if the file changed
    my $filename = shift;
    my $outname = shift;
    $Got_Change = shift;	# True if should always write output, not only if have change

    if ($outname =~ /[\/\\]$/) {
	# Directory, not file, so append filename
	my $basename = $filename;
	$basename =~ s/.*[\/\\]//g;
	$outname .= $basename;
    }

    print "vpassert_process ($filename, $outname, $Got_Change)\n"	if ($Debug);

    ($filename ne $outname) or die "%Error: $filename: Would overwrite self.";

    @Sendout = ();

    @instance_tests_list = ();

    # Set up parsing
    my $parser = new Verilog::Vpassert::Parser;
    $parser->filename($filename);
    $parser->lineno(1);
    $Last_Parser = $parser;

    # Open file for reading and parse it
    my $fh = IO::File->new("<$filename") or die "%Error: $! $filename.";
    if (!$Got_Change) {
	while (<$fh>) {
	    goto diff if (/$Vpassert_Conversions_Regexp/o);
	    goto diff if ($Opt_NoPli && /\$/);
	}
	print "$filename: No dollars, not processing\n" if ($Debug);
	return;
      diff:
	$fh->seek(0,0);
	$. = 1;
    }

    while (my $line = $fh->getline() ) {
	$parser->parse ($line);
    }
    $parser->eof;
    sendout_orig($parser->unreadback());    $parser->unreadback('');
    $fh->close;

    # Hack the output text to add in the messages variable
    foreach my $mod (keys %Insure_Symbols) {
	my $insert="";
	my $n=0;  # Some compilers choke if lines get too long;
	foreach my $sym (keys %{$Insure_Symbols{$mod}}) {
	    #if ! $module_symbols{$sym} 	# For now always put it in
	    my $type = $Insure_Symbols{$mod}{$sym}[0];
	    my $value = $Insure_Symbols{$mod}{$sym}[1];
	    $insert .= "$type $sym; initial $sym = $value;";
	    if (++$n > 10) {
		$insert .= "\n";
		$n=0;
	    }
	}
	if ($insert) {
	    my $hit;
	    for (my $l = $#Sendout; $l>=0; $l--) {
		my $tok = $Sendout[$l][1];
		if ($tok =~ m%/\*vpassert beginmodule $mod\*/%) {
		    my $lineno = $Sendout[$l][0];
		    if ($Opt_Line) {
			$insert .= "\n`line ".$lineno." \"".$Last_Parser->filename."\" 0\n";
		    }
		    $tok =~ s%/\*vpassert beginmodule $mod\*/%/*vpassert*/$insert%g or die;  # Must exist, found above!
		    $Sendout[$l][1] = $tok;
		    $hit = 1;
		    # Don't exit the loop, keep looking for more.
		    # It's possible there's a `ifdef with multiple "module x" headers