#!/usr/local/bin/perl -w
#$Revision: #36 $$Date: 2003/03/28 $$Author: wsnyder $
######################################################################
#
# This program is Copyright 2000 by Wilson Snyder.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of either the GNU 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.
# 
# If you do not have a copy of the GNU General Public License write to
# the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 
# MA 02139, USA.
#                                                                           
######################################################################

require 5.005;
use Getopt::Long;
use IO::File;
use Pod::Text;
use strict;

use FindBin qw($RealBin);
use lib "$RealBin/lib";
use lib "$RealBin/blib/lib";
use lib "$RealBin/blib/arch";
use lib "$RealBin/..";
use lib "$RealBin/../Verilog/blib/lib";
use lib "$RealBin/../Verilog/blib/arch";
use Verilog::Getopt;
use SystemC::Netlist;

use vars qw ($Debug $opt_makedeps $Opt_Lint $Exit_Status %Error_Unlink);

#======================================================================
$Opt_Lint = 1;

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

autoflush STDOUT 1;
autoflush STDERR 1;

$Debug = 0;
my $opt_preproc = 0;
my $opt_inline;
my $opt_autos = 1;
my @sp_files_lib = ();
my @sp_files_nolib = ();
my $opt_libcell = 0;
my $opt_tree = 0;
my $opt_trace_duplicates = 0;

my $opt = new Verilog::Getopt(gcc_style=>1, vcs_style=>0);
$opt->libext([".sp"]);
@ARGV = $opt->parameter(@ARGV);	# Strip -D and -U flags
if (! GetOptions (
		  "help"	=> \&usage,
		  "verbose"	=> \&verbose,
		  "debug"	=> \&debug,
		  "M:s"		=> \$opt_makedeps,
		  "MMD:s"	=> \$opt_makedeps,
		 # "lint!"	=> \$Opt_Lint,
		  "autos!"	=> \$opt_autos,
		  "libcell!"	=> \$opt_libcell,
		  "preproc!"	=> \$opt_preproc,
		  "inline!"	=> \$opt_inline,
		  "tree=s"	=> \$opt_tree,
		  "trace-duplicates!" => \$opt_trace_duplicates,
		  "<>"		=> \&parameter,
		  )) {
    usage();
}

my $nl = new SystemC::Netlist (options=>$opt,
			       link_read=>1,
			       strip_autos=>1,
			       );

foreach my $file (@sp_files_nolib) {
    $nl->read_file (filename=>$file,
		    strip_autos=>1,
		    is_libcell=>0,);
}
foreach my $file (@sp_files_lib) {
    $nl->read_file (filename=>$file,
		    strip_autos=>1,
		    is_libcell=>1,);
}

$nl->link();
$nl->autos();
tree_report($nl, $opt_tree) if ($opt_tree);
$nl->lint();
our_rulecheck($nl);
$nl->dump() if $Debug;
$nl->exit_if_error();

 #use Data::Dumper; print Dumper (\%SystemC::Module::Modules);

if ($opt_preproc) {
    foreach my $fileref ($nl->files()) {
	next if $fileref->is_libcell();
	my $filename_c = $fileref->basename() . ".cpp";
	my $filename_h = $fileref->basename() . ".h";
	$fileref->write( filename=> $filename_c,
			 as_implementation=>1, expand_autos=>1,
			 keep_timestamp=>1,);
	$fileref->write( filename=> $filename_h,
			 as_interface=>1, expand_autos=>1,
			 keep_timestamp=>1,);
    }
}
if ($opt_inline) {
    foreach my $fileref ($nl->files()) {
	next if $fileref->is_libcell();
	$fileref->write( filename=>$fileref->name(),
			 expand_autos=>$opt_autos,
			 keep_timestamp=>1,);
    }
}
if ($opt_makedeps) {
    $nl->dependency_write($opt_makedeps);
}

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

sub usage {
    print '$Revision: #36 $$Date: 2003/03/28 $$Author: wsnyder $ ', "\n";
    $SIG{__WARN__} = sub{};	#pod2text isn't clean.
    pod2text($0);
    exit (1);
}

sub verbose {
    $SystemC::Netlist::Verbose = 1;
}

sub debug {
    verbose();
    $SystemC::Netlist::Debug = 1;
    $Debug = 1;
}

sub parameter {
    my $param = shift;
    if ($param =~ /\.(cc|cpp|h|hh|sp)$/) {
	if ($opt_libcell) {
	    push @sp_files_lib, $param;
	} else {
	    push @sp_files_nolib, $param;
	}
    } elsif ($param =~ /sp_preproc$/) {
	# Ignore ourself in case user passed all dependencies including this program
    } else {
	die "%Error: Unknown parameter: $param\n";
    }
}
 
#######################################################################

sub our_rulecheck {
    my $netlist = shift;
    foreach my $modref ($netlist->modules) {
	foreach my $sigref ($modref->nets_sorted) {
	    if (!$sigref->comment || $sigref->comment eq "") {
		#$sigref->warn ($sigref, "Missing documentation on ",$sigref->name,"\n");
	    }
	}
	foreach my $sigref ($modref->ports_sorted) {
	    if (!$sigref->comment || $sigref->comment eq "") {
		#$sigref->warn ($sigref, "Missing documentation on ",$sigref->name,"\n");
	    }
	}
    }
}

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

#######################################################################
#######################################################################
# Level selection

sub tree_report {
    my $netlist = shift;
    my $filename = shift;
    mod_levels($netlist);
    my $fh = IO::File->new($filename,'w') or die "%Error: $! writing $filename\n";
    foreach my $modref ($netlist->modules_sorted) {
	if ($modref->userdata('level')==0
	    && !$modref->is_libcell) {	# Not read by AUTOINOUT_MODULE
	    tree_recurse($modref,$fh,"","",$modref->name);
	    printf $fh "#\n";
	}
    }

    printf $fh "#"x70,"\n";
    printf $fh "#\n";
    printf $fh "#Files:\n";
    foreach my $fileref ($netlist->files_sorted) {
	printf $fh "# %-40s\n", $fileref->name;
    }

    $fh->close();
}

sub tree_recurse {
    my $modref = shift;	# May be null if unnamed cell
    my $fh = shift;
    my $this_indent = shift;
    my $next_indent = shift;
    my $cellname = shift;

    if (!$modref) {
	printf $fh "# %-40s %-30s %s\n",$cellname,$this_indent."?","?";
    } else {
	printf $fh "# %-40s %-30s %s\n",$cellname,$this_indent.$modref->name,$modref->filename;
	my @cells = ($modref->cells_sorted);
	my $ncell = 0;
	foreach my $subcell (@cells) {
	    my $cell_this_indent = $next_indent."|-";
	    my $cell_next_indent = $next_indent."| ";
	    if ($ncell++ == $#cells) {
		$cell_this_indent = $next_indent."\\-";
		$cell_next_indent = $next_indent."  ";
	    }
	    tree_recurse($subcell->submod,$fh,
			 $cell_this_indent, $cell_next_indent,
			 $cellname.".".$subcell->name);
	}
    }
}

sub mod_levels {
    my $netlist = shift;
    foreach my $modref ($netlist->modules_sorted) {
	mod_levels_recurse($modref,0);
    }
}

sub mod_levels_recurse {
    my $modref = shift;
    my $level = shift;
    if ($level>=($modref->userdata('level')||0)) { 
	$modref->userdata('level',$level);
    }
    if ($level>100) {
	print "   In ".$modref->name."  $level\n";
	if ($level>120) {
	    $modref->error("Seems to have a cell that refers back to itself\n");
	}
    }
    foreach my $subcell ($modref->cells_sorted) {
	mod_levels_recurse($subcell->submod,$level+1) if $subcell->submod;
    }
}


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

=pod

=head1 NAME

sp_preproc - SystemPerl Preprocessor

=head1 SYNOPSIS

C<sp_preproc> I<file.sp>

=head1 DESCRIPTION

sp_preproc takes a .sp (systemperl) file and creates the SystemC header
and C files.

It is generally only executed from the standard build scripts.

=head1 ARGUMENTS

=over 4

=item --help

Displays this message and program version and exits.

=item --inline

Edit the existing source code "inline".  Similar to the Verilog-mode AUTOs.
Use --inline --noautos to remove the expanded automatics.

=item --libcell

Files listed before --libcell will be preprocessed or inlined as
appropriate.  Files after noexpand will only be used for resolving
references, they will not be linked, linted, or otherwise checked.
--nolibcell can be used to reenable checking of subsequent files.

=item --preproc

Preprocess the code, writing to separate header and cpp files.

=item --trace-duplicates

Include code to trace submodule signals connected directly to a parent
signal, generally for debugging interconnect.  Without this switch such
signals will be presumed to have the value of their parent module's signal,
speeding and compressing traces.

=item --tree I<filename>

Write a report showing the design hiearchy tree to the specified filename.
This format may change, it should not be parsed by tools.

=item --noautos

With --inline, remove any expanded automatics.

=item --verbose

Shows which files are being written, or are the same.

=item -M

Makes the dependency listing (similar to I<cpp -M>).

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

Sets a define to the given value (similar to I<cpp -D>).

=item -f I<file>

Parse parameters from the given file.

=back

=head1 LANGUAGE

See C<SystemPerl> for the language specification.

=head1 SEE ALSO

C<SystemPerl>

=head1 AUTHORS

Wilson Snyder <wsnyder@wsnyder.org>

=cut

######################################################################
### Local Variables:
### compile-command: "./sp_preproc "
### End:
