#!/usr/bin/perl

#
# $Id: necprimfix,v 1.2 2002/10/17 00:53:29 jeff Exp $
#

# 
# Jeff Mock
#
# This program is specific to the bcp for building a module
# hierarchy, reporting primitive instances, identifying
# unreferenced modules, and changing primitive instances
# to new library.
#
# The program is not a verilog parser, it uses regular expressions
# to locate modules declarations and instances.  This might be useful 
# for other purposes, but look at bcp special
# cases before proceeding...

use Getopt::Long;

$opt_ldir = "/home/jeff/bb/rf/hw/chip/lib/verilog/nec";
$opt_vdir = "/home/jeff/bb/rf/hw/chip/bcp";
if ($ENV{ROOT}) {
    $opt_ldir = $ENV{ROOT} . "/PR/hw2/chip/lib/verilog/nec";
    $opt_vdir = $ENV{ROOT} . "/PR/hw2/chip/bcp";
} else {
    print "\nWarning: ROOT Environment variable is not set.\n";
    print "Default path to source tree and old NEC library as follows,\n";
    print "this may not be what you want. You can always set the paths\n";
    print "with the --ldir and --vdir options (see --help):\n";
    print "    $opt_ldir\n";
    print "    $opt_vdir\n\n";
}

$opt_toplevel = "bcp";

$cmdline = $0 . " " . (join " ", @ARGV);


if (!GetOptions(
        'ldir=s'        => \$opt_ldir,
        'vdir=s'        => \$opt_vdir,
        'top=s'         => \$opt_toplevel,

    )) 
{
    print STDERR <<USAGE;

    Process bcp design and replace NEC primitives
        
    $0 [options] 
        [--ldir=filename]   Library directory to extract names
        [--vdir=filename]   Verilog source tree
        [--top=module]      Top level module for tree
    

USAGE
    exit 1;
}


my $file_count = 0;
my $pfile_count = 0;
my $prim_count = 0;

my %lnames = ();            # Key is NEC primitive names, value is 1
my %modinfo = ();           # Key is module, value is reference to hash of
                            # instanced modules. value of this hash is
                            # number of instances in module.
my %modfn = ();             # Key is module name, value is filename
my %mod_list = ();          # Modules used in design
my %new_mods = ();          # Key is old NEC module, value is new name

# bcp special case
# Hack to not mistake reserved words as modules.  I'm not really parsing
# the verilog, I'm using regular expressions to match modules instances
#
my %reserved = (
        begin                                   => 1,
        end                                     => 1,
        endcase                                 => 1,
        else                                    => 1,
        define                                  => 1
    );

# bcp special case
# bcp specific hack to skip files that redeclare certain modules
#
my %skipfile = (
        "/rsp/src/rspWrap_regression.v"         => 1,
        "/st/src/adder27b.v"                    => 1,
        "/vu/src/fake_div_rom.v"                => 1,
    );

# bcp special case
# bcp specific special modules that aren't in the tree but I 
# don't want to flag as undefined
#
my %specmod = (
#        cbus_driver                             => 1,
#        dbus_driver                             => 1,
#        ebus_driver                             => 1,
#        cp0_driver                              => 1,
#        tmem_driver                             => 1,
#        aes_d                                   => 1,
#        cdbuf                                   => 1,
#        spanbuf                                 => 1,
#        dmem                                    => 1,
#        imem                                    => 1,
#        tmem                                    => 1,
    );

# Get names of NEC primitives from verilog library
#
sub getlibnames 
{
    my $ldir = shift;
    my %lnames = ();

    opendir DIR, $ldir or die "Cannot open NEC library directory $ldir: $!";

    while (defined(my $fn = readdir(DIR))) {
        my $ffn = "$ldir/$fn";

        # Skip directories
        next if -d "$ffn";

        open FD, $ffn or die "Cannot open NEC library file $ffn; $!";
        {
            local $/;
            undef $/;
            
            my $f = <FD>;

            # Okay, try to filter out stuff in verilog // comments
            $f =~ s/\/\/.*\n/\n/g;

            # Okay, try to filter out stuff in verilog /* */ comments
            $f =~ s/\/\*.*?\*\// /sg;

            # Not to be confused with really parsing verilog, just 
            # looking for "module foo (", there are a lot of ways
            # this could fail, just a hack...
            #
            while ($f =~ m/module\s+(\w+)\s*\(/g) {
                $lnames{$1} = 1;
                # print "$1\n";
            }

        }
        close FD;
    }
    closedir DIR;
    return %lnames;
}

# Process a verilog file in source tree. Collect names of modules
# defined in file and build a list modules instanced by the defined
# modules.
#
sub processfile
{
    my $base = shift;
    my $ft = shift;

    my $fn = $base . $ft;

    # print "Processing $fn.\n";
    open FD, $fn or die "Cannot open verilog source $fn for scanning: $!";
    P: {
        local $/;
        undef $/;

        $file_count++;
        my $f = <FD>;
        close FD;
        
        # Some verilog files are marked as not used, skip them
        last P if $f =~ /JCM not used/;

        # Okay, try to filter out stuff in verilog // comments
        $f =~ s/\/\/.*\n/\n/g;

        # Okay, try to filter out stuff in verilog /* */ comments
        $f =~ s/\/\*.*?\*\// /sg;
        
        # This is a hack too, looking for "module name ("
        # This can fail in verilog comments and probably many other
        # ways, it's a hack to get names of instantiated modules.
        #
        while ($f =~ m/module\s+(\w+)(.*?)endmodule/sg) {
            my %moduse = ();
            my $mname = $1;
            my $mod = $2;

            # print "    $mname\n";
            # print $mod;

            # Try to remove an parameter passing to module references
            $mod =~ s/#\s*\(.*?\)//sg;

            # Match module instances, sometimes fails on reserved
            # words in a pattern that looks like an instance.
            # Not very rigorous
            #
            while ($mod =~ m/(\w+)\s+\w+\s*\(.*?\)/sg) {
               next if defined($reserved{$1});  # skip verilog reserved words

               # bcp special case
               # hack for `define in top level
               my $mn = $1;
               $mn = "ri"  if $1 eq "RI";
               $mn = "ai"  if $1 eq "AI";
               $mn = "rdp" if $1 eq "RDP";
               $mn = "rsp" if $1 eq "RSP";
               $mn = "vi"  if $1 eq "VI";

               # print "        $mn\n";
               $moduse{$mn}++;
            }
            die "Module $mname in $fn already scanned in file $modfn{$mname}" if defined($modinfo{$mname});
            $modinfo{$mname} = \%moduse;
            $modfn{$mname} = $ft; 
        }
    }
}

# Descend directory tree.  Skips directories called "src-*" (src is okay),
# directory skipped to ignore convention I use when hacking.
#
sub recursetree
{
    my $base = shift;
    my $dir = shift;

    # print "$base $dir\n";

    opendir DIR, "$base/$dir" or die "Cannot open dir $base/$dir while scanning source files: $!";
    my @names = readdir(DIR);
    closedir DIR;

    for my $f (@names) {
        my $ffn = "$dir/$f";

        next if $f eq ".";
        next if $f eq "..";
        next if $f =~ /^src-/;
        next if $skipfile{$ffn};

        if (-d "$base/$ffn") {
            recursetree($base, $ffn);
        } else {
            processfile($base, $ffn) if $ffn =~ /\.v$/;
        }
    }
}

# Traverse design hierarchy and build a list of all modules used
# in the design.  List is put in the hash %mod_list.
#
sub make_mod_list
{
    my $mod = shift;
    my $depth = shift;

    $mod_list{$mod} = 1;
    if (defined($modinfo{$mod})) {
        my %mx = %{$modinfo{$mod}};
        for my $sm (sort keys %mx) {
            make_mod_list($sm,$depth+1);
        }
    }
}

# Process a verilog file.  Use the hash %new_mods to place
# every instance of the keys by the value of the hash.  Leaves
# a little summary of changes at beginning of file.  It is 
# a fatal error if the routine makes no modifications to the
# file.  Previous logic should insure that only files needing
# to be modified are processed.
#
sub fixfile
{
    my $fn = shift;
    my $fn_tmp = $fn . ".tmp";
    my $changes;
    my $okay = 0;
    
    print "    Processing $fn...\n";
    rename($fn, $fn_tmp);
    open FI, "<$fn_tmp" or die "Cannot open source file $fn_tmp for input: $!";
    open FO, ">$fn" or die "Cannot open source file $fn for output: $!";

    print FO "// Module instances modified by $cmdline\n//\n";
    P: {
        local $/;
        undef $/;

        my $f = <FI>;
        for my $mod (sort keys %new_mods) {
            my $nmod = $new_mods{$mod};
            if ($changes = ($f =~ s/(\s+)$mod(\s+)/$1 . $nmod . $2/sge)) {
                $okay = 1;
                printf FO "//    %d instance%s of %s changed to %s.\n",
                    $changes, $changes>1 ? "s" : "", $mod, $nmod;
                printf    "        %d instance%s of %s changed to %s.\n",
                    $changes, $changes>1 ? "s" : "", $mod, $nmod;
            }
        }
        print FO "//\n\n";
        print FO $f;
    }
    
    close FO;
    close FI;
    unlink($fn_tmp);
    die "Botch: No changes made to $fn?  Files probably altered, bad deal..."
        if !$okay;
}


# Get Library names
%lnames = getlibnames($opt_ldir);

# Build tree of modules and module instances in design
recursetree($opt_vdir, "");

# Build flat list of modules used in the design in %mod_list
make_mod_list($opt_toplevel, 0);

# Go through each module in design in a flat fashion
# (no hierarchy) and get a list of NEC primitives used.
#
# %lnames_used     Key is name of NEC primitive used in design,
#                  value is number of instances in design.
#
for my $mod (keys %mod_list) {
    if (defined $modinfo{$mod}) {
        # Go through each module instanced by the current module
        # and keep a count of number of instances for the primitive
        #
        for my $smod (keys %{$modinfo{$mod}}) {
            $lnames_used{$smod} += ${$modinfo{$mod}}{$smod} 
                if $lnames{$smod};
        }
    }
}

# Make a list of the module names used to replace the NEC modules
# Filters out drive suffix in module name: *d1, *d1h, etc.
# Add a prefix to the beginning of module name
#
# %new_mods   The key is the name of an NEC module, the 
#             value is the name of the new module
#
for my $mod (keys %lnames_used) {
    my $mod_x = $mod;
    $mod_x =~ s/d[0-9]h*$//;
    $new_mods{$mod} = "j_" . $mod_x;
}

# Make a reverse list showing the one to many mapping of new
# module name to NEC primitives that it replaces
#
# %new_ref   The key is the name of a new module, the
#            value is an array reference to the names of 
#            NEC prims the module replaces.
#
my %new_ref = ();
for my $mod (sort keys %new_mods) {
    $new_name = $new_mods{$mod};
    if (defined($new_ref{$new_name})) {
        push @{$new_ref{$new_name}}, $mod;
    } else {
        my @l = ( $mod );
        $new_ref{$new_name} = \@l;
    }
}

# Make a list of filenames containing primitives that need
# fixing.
#
# The key
my %fix_files = ();
for my $mod (keys %mod_list) {
    if (defined $modinfo{$mod}) {
        # Go through each module instanced by the current module
        # and keep a count of number of instances for the primitive
        #
        for my $smod (keys %{$modinfo{$mod}}) {
            $fix_files{$modfn{$mod}} = 1 if $lnames{$smod};
        }
    }
}

# Print accounting of primitives used in design
#
my $prims = 0;
my $instances = 0;
print "NEC primitives used:\n";
for my $prim (sort keys %lnames_used) {
    $prims++;
    $instances += $lnames_used{$prim};
    printf "    %-15s %s\n", $prim, $lnames_used{$prim} 
        if $lnames_used{$prim};
}
printf "%d prims, %d instances.\n\n", $prims, $instances;
if ($instances == 0) {
    print "No changes to be made, maybe design already processed?\n";
    exit 1;
}


# Print account of module names changes about to be made.
#
printf "New module name replacements\n\n";
for my $mod (sort keys %new_ref) {
    my $l = join " ", @{$new_ref{$mod}};
    printf "    %-15s %s\n", $mod, $l;
}
print "\n";

# Fix the files
#
printf "Fixing files...\n\n";
for my $fn (sort keys %fix_files) {
    fixfile($opt_vdir . $fn);
}
print "Success\n";
exit 0;