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);

#======================================================================
# 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/;
            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;
                }
            }
        }
        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-2021 by Wilson Snyder. This program 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.

SPDX-License-Identifier: LGPL-3.0-only OR Artistic-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: