verilator/bin/verilator_difftree

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

use warnings;
use Getopt::Long;
use IO::File;
use Pod::Usage;
use strict;
use vars qw($Debug);

#======================================================================

# Old version 1 dump nodes with no dtypep's
our %Ver1_Non_Dtyped = map {$_ => 1} qw(
  ACTIVE ALWAYS ALWAYSPOST ALWAYSPUBLIC ATTROF BEGIN BREAK CASE CASEITEM
  CCALL CELL CELLINLINE CFILE CFUNC CHANGEDET CLOCKING COMMENT CONTINUE
  COVERDECL COVERINC COVERTOGGLE CRETURN CSTMT DEFPARAM DISABLE DISPLAY DOT
  DPIEXPORT FCLOSE FFLUSH FINAL FINISH FOPEN GENCASE GENERATE GENFOR GENIF
  IF IMPLICIT INITARRAY INITIAL JUMPGO JUMPLABEL MODULE NETLIST
  NOTFOUNDMODULE PACKAGE PACKAGEIMPORT PARSEREF PIN PORT PRAGMA PRIMITIVE
  PSLASSERT PSLCOVER PSLDEFCLOCK PULL RANGE READMEM REPEAT RETURN SCCTOR
  SCDTOR SCHDR SCIMP SCIMPHDR SCINT SCOPE SELBIT SELEXTRACT SELMINUS
  SELPLUS SENGATE SENITEM SENTREE SFORMAT SFORMATF STOP SYSIGNORE SYSTEMT
  TASK TASKREF TEXT TOPSCOPE TYPEDEFFWD TYPETABLE UCSTMT UDPTABLE
  UDPTABLELINE UNTILSTABLE VASSERT WHILE );

#======================================================================
# main

$Debug = 0;
my $Opt_A;
my $Opt_B;
my $Opt_Lineno = 1;
autoflush STDOUT 1;
autoflush STDERR 1;
Getopt::Long::config("no_auto_abbrev");
if (! GetOptions(
          "help"        => \&usage,
          "debug"       => \&debug,
          "<>"          => \&parameter,
          "lineno!"     => \$Opt_Lineno,
    )) {
    die "%Error: Bad usage, try 'verilator_difftree --help'\n";
}

defined $Opt_A or die "%Error: No old diff filename\n";
defined $Opt_B or die "%Error: No new diff filename\n";

-e $Opt_A or die "%Error: No old diff filename found: $Opt_A\n";
-e $Opt_B or die "%Error: No new diff filename found: $Opt_B\n";

if (-d $Opt_A && -d $Opt_B) {
    diff_dir($Opt_A, $Opt_B);
} elsif (-f $Opt_A && -f $Opt_B) {
    diff_file($Opt_A, $Opt_B);
} else {
    die "%Error: Mix of files and dirs\n";
}

sub diff_dir {
    my $a = shift;
    my $b = shift;
    # Diff all files under two directories
    my %files;

    foreach my $fn (glob("$a/*.tree")) {
        (my $base = $fn) =~ s!.*/!!;
        $files{$base}{a} = $fn;
    }
    foreach my $fn (glob("$b/*.tree")) {
        (my $base = $fn) =~ s!.*/!!;
        $files{$base}{b} = $fn;
    }
    my $any;
    foreach my $base (sort (keys %files)) {
        my $a = $files{$base}{a};
        my $b = $files{$base}{b};
        next if !$a || !$b;
        print "="x70,"\n";
        print "= $a <-> $b\n";
        diff_file($a,$b);
        $any = 1;
    }
    $any or warn("%Warning: No .tree files found that have similar base names:\n    "
                 .join("\n    ", sort keys %files),"\n");
}

sub diff_file {
    my $a = shift;
    my $b = shift;
    # Compare the two tree files
    (my $short_a = $a) =~ s/[^a-zA-Z0-9.]+/_/g;
    (my $short_b = $b) =~ s/[^a-zA-Z0-9.]+/_/g;
    my $tmp_a = "/tmp/${$}_${short_a}.a";
    my $tmp_b = "/tmp/${$}_${short_b}.b";

    my $vera = version_from($a);
    my $verb = version_from($b);
    my $verCvt = (($vera < 0x3900 && $verb >= 0x3900)
                  || ($vera >= 0x3900 && $verb < 0x3900));

    filter($a, $tmp_a, $verCvt);
    filter($b, $tmp_b, $verCvt);
    system("diff -u $tmp_a $tmp_b");
    unlink $tmp_a;
    unlink $tmp_b;
}

sub version_from {
    my $fn = shift;
    # Return dump format
    my $f1 = IO::File->new ($fn) or die "%Error: $! $fn,";
    while (defined (my $line=$f1->getline())) {
        last if $. > 10;
        return hex $1 if $line =~ /\(format (0x[0-9.]+)\)/;
    }
    return 1.0;
}

sub filter {
    my $fn1 = shift;
    my $fn2 = shift;
    my $verCvt = shift;
    # Remove hex numbers before diffing
    my $f1 = IO::File->new ($fn1) or die "%Error: $! $fn1,";
    my $f2 = IO::File->new ($fn2,"w") or die "%Error: $! $fn2,";
    while (defined (my $line=$f1->getline())) {
      same_line:
        next if $line =~ / This=/;
        $line =~ s/0x[a-f0-9]+/0x/g;
        $line =~ s/<e[0-9]+\#?>/<e>/g;
        $line =~ s/{[a-z]*\d+}/{}/g if !$Opt_Lineno;
        if ($verCvt) {
            next if $line =~ /^     NETLIST/;
            $line =~ s!\@dt=0x\(G?/?([^)]+)\)!$1!g;  # NEW: @dt -> OLD: non @dt format
            #                                        # Below Ver1_Non_Dtyped may replace above further
            if ($line =~ /: ([A-Z]+) /) {
                my $type = $1;
                next if $type =~ 'DTYPE';
                if ($type eq 'TYPETABLE' || $type eq 'RANGE') {
                    $line =~ /^(\s+\S+:) /; my $prefix = $1;
                    while (defined ($line=$f1->getline())) {
                        next if $line =~ /^\s+[a-z]/;  # Table body
                        next if $line =~ /^${prefix}[0-9]:/;
                        goto same_line;
                    }
                    next;
                }
                if ($Ver1_Non_Dtyped{$type}) {
                    $line =~ s! w[0-9]+!!g;
                }
            }
            $line =~ s!\@dt=0$!NoW!g;   # NEW: dt=null -> common format
            $line =~ s!\@dt=0 !NoW !g;  # NEW: dt=null -> common format
            $line =~ s! s?w0$! NoW!g;   # OLD: no width -> common format
            $line =~ s! s?w0 ! NoW !g;  # OLD: no width -> common format
        }
        print $f2 $line;
    }
    $f1->close;
    $f2->close;
}

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

sub usage {
    pod2usage(-verbose=>2, -exitval=>0, -output=>\*STDOUT);
    exit(1);  # Unreachable
}

sub debug {
    $Debug = 1;
}

sub parameter {
    my $param = shift;
    if (!defined $Opt_A) {
        $Opt_A = $param;
    } elsif (!defined $Opt_B) {
        $Opt_B = $param;
    } else {
        die "%Error: Unknown parameter: $param\n";
    }
}

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

sub run {
    # Run a system command, check errors
    my $command = shift;
    print "\t$command\n";
    system "$command";
    my $status = $?;
    ($status == 0) or die "%Error: Command Failed $command, $status, stopped";
}

#######################################################################
__END__

=pod

=head1 NAME

verilator_difftree - Compare two Verilator debugging trees

=head1 SYNOPSIS

  verilator_difftree .../a/a.tree  .../b/a.tree
  verilator_difftree .../a         .../b

=head1 DESCRIPTION

Verilator_difftree is used for debugging Verilator tree output files.  It
performs a diff between two files, or all files common between two
directories, ignoring irrelevant pointer differences.

=head1 ARGUMENTS

=over 4

=item --help

Displays this message and program version and exits.

=item --nolineno

Do not show differences in line numbering.

=back

=head1 DISTRIBUTION

The latest version is available from L<https://verilator.org>.

Copyright 2005-2020 by Wilson Snyder.  This package is free software; you can
redistribute it and/or modify it under the terms of either the GNU Lesser
General Public License Version 3 or the Perl Artistic License Version 2.0.

=head1 AUTHORS

Wilson Snyder <wsnyder@wsnyder.org>

=head1 SEE ALSO

C<verilator>

=cut

######################################################################
### Local Variables:
### compile-command: "$V4/bin/verilator_difftree  {$V4D,$V4}/test_regress/obj_dir/t_EXAMPLE/V*_03_*.tree"
### End: