#!/usr/bin/perl -w
# $Id: vhier 21533 2006-06-08 14:57:34Z wsnyder $
######################################################################
#
# Copyright 2005-2006 by Wilson Snyder <wsnyder@wsnyder.org>.  This
# program is free software; you can redistribute it and/or modify it under
# the terms of either the GNU Lesser General Public License or the Perl
# Artistic License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
######################################################################

require 5.005;
use lib 'blib/arch';
use lib 'blib/lib';
use lib '.';

use Getopt::Long;
use IO::File;
use Pod::Text;

use Verilog::Netlist;
use Verilog::Getopt;
use strict;
use vars qw ($Debug);

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

$Debug = 0;
my $opt_output_filename = undef;
my @opt_files;

autoflush STDOUT 1;
autoflush STDERR 1;

# Option parsing
my $Opt = new Verilog::Getopt();
my $Opt_Cells;
my $Opt_Modules;
my $Opt_ModFiles;
my $Opt_InFiles;
my $Opt_Missing = 1;
my $Opt_Missing_Modules;
my $Opt_Xml;
@ARGV = $Opt->parameter(@ARGV);
Getopt::Long::config ("no_auto_abbrev","pass_through");
if (! GetOptions (
		  "help"	=> \&usage,
		  "debug"	=> \&debug,
		  "o=s"		=> \$opt_output_filename,
		  "cells!"	=> \$Opt_Cells,
		  "module-files!"	=> \$Opt_ModFiles,
		  "modules!"		=> \$Opt_Modules,
		  "input-files!"	=> \$Opt_InFiles,
		  "language=s"		=> sub { shift; Verilog::Language::language_standard(shift); },
		  "missing!"		=> \$Opt_Missing,
		  "missing-modules!"	=> \$Opt_Missing_Modules,
		  "xml!"	=> \$Opt_Xml,
		  "<>"		=> \&parameter,
		  )) {
    usage();
}

if (!@opt_files) {
    die "%Error: vhier: No input filenames specified.\n";
}

my $fh = IO::File->new;
if ($opt_output_filename) {
    $fh->open(">$opt_output_filename") or die "%Error: $! $opt_output_filename\n";
} else {
    $fh->open(">-") or die;
}

vhier($fh, @opt_files);

exit (0);

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

sub usage {
    print 'Version: $Id: vhier 21533 2006-06-08 14:57:34Z wsnyder $ '."\n";
    $SIG{__WARN__} = sub{};	#pod2text isn't clean.
    pod2text($0);
    exit (1);
}

sub debug {
    $Debug = 1;
}

sub parameter {
    my $param = shift;
    if ($param =~ /^--?/) {
	die "%Error: vhier: Unknown parameter: $param\n";
    } else {
	push @opt_files, $param;
    }
}

######################################################################
#### Creation

sub vhier {
    my $fh = shift;
    my @files = @_;

    my $nl = new Verilog::Netlist (options => $Opt,
				   skip_pin_interconnect => 1,
				   link_read_nonfatal => !$Opt_Missing,
				   );

    foreach my $file (@files) {
	print "   Reading $file\n" if $Debug;
	$nl->read_file (filename=>$file);
    }
    # Read in any sub-modules
    $nl->link();
    $nl->lint();
    $nl->exit_if_error();

    if ($Opt_Cells) {
	foreach my $mod ($nl->modules_sorted) {
	    if ($mod->is_top) {
		show_hier ($fh, $mod, "  ", "");
	    }
	}
    }

    if ($Opt_Modules) {
	show_module_names($nl, $fh);
    }

    if ($Opt_ModFiles) {
	show_mod_files($nl, $fh);
    }

    if ($Opt_InFiles) {
	foreach my $filename ($Opt->depend_files) {
	    printf $fh +("  %s\n",$filename);
	}
    }

    if ($Opt_Missing_Modules) {
	show_missing_module_names($nl,$fh);
    }
}

sub show_module_names {
    my $nl = shift;
    my $fh = shift;
    foreach my $mod ($nl->modules_sorted) {
	print $fh "  ",$mod->name,"\n";
    }
}

sub show_missing_module_names {
    my $nl = shift;
    my $fh = shift;

    my %miss_names;
    foreach my $mod ($nl->modules) {
	foreach my $cell ($mod->cells_sorted) {
	    if (!$cell->submod) {
		$miss_names{$cell->submodname} = 1;
	    }
	}
    }
    foreach my $key (sort (keys %miss_names)) {
	print $fh "  $key\n";
    }
}

sub show_mod_files {
    my $nl = shift;
    my $fh = shift;
    # We'll attach a level attribute to each module indicating it's maximum depth
    foreach my $mod ($nl->modules) {
	$mod->attributes("_vhier_level", 0);
    }
    # Recurse the tree and determine level
    foreach my $mod ($nl->modules) {
	if ($mod->is_top) {
	    _mod_files_recurse($mod, 1);
	}
    }
    # Make sort key based on numeric level
    my %keys;
    foreach my $mod ($nl->modules) {
	my $key = sprintf("%03d_%s", $mod->attributes("_vhier_level"), $mod->name);
	$keys{$key} = $mod;
    }
    my @files;
    my %files;  # Uniquify the array
    foreach my $key (sort {$b cmp $a} (keys %keys)) {
	my $mod = $keys{$key};
	my $filename = $mod->filename;
	if (!$files{$filename}) {
	    $files{$filename} = 1;
	    push @files, " "x($mod->attributes("_vhier_level")) . $filename;
	}
    }
    foreach my $filename (reverse @files) {
	print $fh "  $filename\n";
    }
}

sub _mod_files_recurse {
    my $mod = shift;
    my $level = shift;
    if ($mod->attributes("_vhier_level") < $level) {
	$mod->attributes("_vhier_level", $level);
    }
    foreach my $cell ($mod->cells_sorted) {
	if ($cell->submod) {
	    _mod_files_recurse ($cell->submod, $level+1);
	}
    }
}

sub show_hier {
    my $fh = shift;
    my $mod = shift;
    my $indent = shift;
    my $hier = shift;
    printf $fh ("%-38s %s\n", $indent."Module ".$mod->name,$hier) if $Debug;
    printf $fh "%s%s\n", $indent, $mod->name;
    foreach my $cell ($mod->cells_sorted) {
	if ($cell->submod) {
	    show_hier ($fh, $cell->submod, $indent."  ", $hier.".".$cell->name);
	}
    }
}

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

__END__

=pod

=head1 NAME

vhier - Return all files in a verilog hierarchy using Verilog::Netlist

=head1 SYNOPSIS

  vhier --help
  vhier [verilog_options] [-o filename] [verilog_files.v...]

=head1 DESCRIPTION

Vhier reads the Verilog files passed on the command line and outputs
a tree of all of the filenames referenced by that file.

=head1 VERILOG ARGUMENTS

The following arguments are compatible with GCC, VCS and most Verilog
programs.

=over 4

=item +define+I<var>+I<value>
=item -DI<var>=I<value>

Defines the given preprocessor symbol.

=item -f I<file>

Read the specified file, and act as if all text inside it was
specified as command line parameters.

=item +incdir+I<dir>
=item -II<dir>

Add the directory to the list of directories that should be searched
for include directories or libraries.

=item +libext+I<ext>+I<ext>...

Specify the extensions that should be used for finding modules.  If for
example module I<x> is referenced, look in I<x>.I<ext>.

=item -y I<dir>

Add the directory to the list of directories that should be searched
for include directories or libraries.

=back

=head1 VHIER ARGUMENTS

=over 4

=item --help

Displays this message and program version and exits.

=item --o I<file>

Use the given filename for output instead of stdout.

=item --cells

Show the module name of all cells in top-down order.

=item --input-files

Show all input filenames.  Copying all of these files should result in only
those files needed to represent the entire design.

=item --language-standard <1995|2001|sv31>

Set the language standard for the files.  This determines which tokens are
signals versus keywords, such as the ever-common "do" (data-out signal,
versus a do-while loop keyword).

=item --module-files

Show all module filenames in top-down order.  Child modules will always
appear as low as possible, so that reversing the list will allow bottom-up
processing of modules.  Unlike input-files, header files are not included.

=item --modules

Show all module names.

=item --nomissing

Do not complain about references to missing modules.

=item --missing-modules

With --nomissing, show all modules that are not found.

=back

=head1 DISTRIBUTION

Verilog-Perl is part of the L<http://www.veripool.com/> free Verilog EDA
software tool suite.  The latest version is available from CPAN and from
L<http://www.veripool.com/verilog-perl.html>.

Copyright 2005-2006 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 or the Perl Artistic License.

=head1 AUTHORS

Wilson Snyder <wsnyder@wsnyder.org>

=head1 SEE ALSO

L<Verilog::Getopt>,
L<Verilog::Preproc>,
L<Verilog::Netlist>

=cut
######################################################################
