Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / Midas_samy / Interface.pm

# -*- perl -*-

package Midas::Interface;

use strict;
require Exporter;

our @ISA = qw(Exporter);
our @EXPORT = qw(midas);

use Getopt::Long;
use File::Spec;
use File::Find;
use File::Basename;
use FindBin '$Bin';
use Cwd;

use Midas::Globals;


use Midas::Command;

use Midas::Error;

# These modules are used, but they are brought in lazily if needed to speed
# up the case where they're not.

#use Midas::Configure;
#use Midas::Assembler;


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

our @Configurable_commands = qw(pal cpp m4 as ld gcc);

sub midas {
 my @argv = @_;

 my $startdir = getcwd;

 eval {

   local (@ARGV) = @argv;

   clear_globals();
   init_error();


   # set defaults
   my %opt =
     (
      h             => 0,
      verbose       => 2,
      stdinc        => 1,
      include_build => 0,
      include_start => 0,
      stddef        => 1,
      E             => 0,
      print_errors  => 1,
      dest_dir      => '.',

#       build_threads  => 3,
      copy_products  => 0,
      gen_all_tsbs   => 0,
     );


   my @options =
     qw(
        h
        stdinc!
        stddef!
        include_build!
        include_start!
        verbose|v:i
        noverbose|nov
        version
        format
        find
        find_root=s
        E
        I=s@
        D=s@
        L=s@
        C=s@
        diag_root=s
        build_dir=s
        dest_dir=s
        mmu=s
        ttefmt=s
        tsbtagfmt=s
        cleanup!
        force_cleanup!
        force_build|f!
       
        build_threads=i
        copy_products!
        gen_all_tsbs!

        file=s@

        start_phase=s
        phase=s@

        print_errors!
        allow_tsb_conflicts!
        allow_empty_sections!
        allow_illegal_page_sizes!
        allow_duplicate_tags!
        allow_misaligned_tsb_base!
        compress_image!
        env_zero!
        default_radix=s
        errcode=i
        pal_diag_args=s@
        config=s
        project=s
       );

   foreach my $cmd (@Configurable_commands) {
     my $use_standard_option = "std_${cmd}_args";
     my $args_option         = "${cmd}_args";
     my $cmd_option          = "${cmd}_cmd";
     $opt{$use_standard_option} = 1;  # make standard the default
     push @options,
       "${use_standard_option}!", "${args_option}=s@", "${cmd_option}=s";
   }

   my @save_argv = @ARGV;

   # Make -D and -I options more palatable to GetOptions
   @ARGV = map { /^(-[DILC])(\S.*)/ ? ($1, $2) : $_ } @ARGV;

   GetOptions(\%opt, @options) or fatal("Command-line parsing failed.\n",
                                        M_ARGERR);
   usage(-exitval => M_NOERROR, -verbose => 2) if $opt{h};

   if(defined $opt{version} and $opt{version}) {
     print "Location: $0\n";
     print "Version:  $Midas::VERSION\n";
     exit M_NOERROR;
   }

   if(defined $opt{errcode}) {
     my $string = errcode_to_string($opt{errcode});
     print "CODE \"$opt{errcode}\"= $string\n";
     exit M_NOERROR;
   }

   if($opt{print_errors} == 0) {
     suppress_error_messages();
   }

   if(defined $opt{format} and $opt{format}) {
     my $fmt = File::Spec->catfile($Bin, 'midasformat');
     die "Cannot find \"$fmt\"\n" unless -e $fmt;
     system($fmt);
     exit M_NOERROR;
   }


   $opt{verbose} = 0 if defined $opt{noverbose} && $opt{noverbose};

   my $diag = shift @ARGV;
   fatal "No diag specified!\n", M_ARGERR unless defined $diag;

   if(not defined $opt{diag_root}) {
     if(exists $ENV{DV_ROOT} and defined $ENV{DV_ROOT}) {
       $opt{diag_root} = $ENV{DV_ROOT};
     } else {
       bad_arg("No -diag_root specified and DV_ROOT not set!\n");
     }
   }

   $opt{find} = 1 if (defined $opt{find_root} and $opt{find_root} ne '');
   if(defined $opt{find}) {
     my $find_root = (defined $opt{find_root} and $opt{find_root} ne '') ?
       $opt{find_root} : File::Spec->catdir($opt{diag_root}, 'verif', 'diag');
     $diag = find_diag($diag, $find_root);
   }



   if(defined $opt{ttefmt} and $opt{ttefmt} ne 'sun4u' and 
      $opt{ttefmt} ne 'sun4v') {
     bad_arg("Illegal -ttefmt setting.  Legal values are sun4u and sun4v.\n");
   }

   if(defined $opt{tsbtagfmt} and $opt{tsbtagfmt} ne 'tagaccess' and
      $opt{tsbtagfmt} ne 'tagtarget') {
     bad_arg("Illegal -tsbtagfmt setting '$opt{tsbtagfmt}'.  ".
             "Legal values are tagaccess and tagtarget.\n");
   }

   if(defined $opt{default_radix} and $opt{default_radix} ne 'decimal' and
      $opt{default_radix} ne 'hex') {
     bad_arg("Illegal -default_radix setting.\n".
             "Legal values are 'decimal' and 'hex'.\n");
   }

   if($opt{project}) {
     $PROJECT = $opt{project};
   }

   if($opt{config}) {
     $CONFIG_FILE = $opt{config};
   }

   my %config_args;
   my @config_list =
     qw(
        mmu build_dir cleanup force_cleanup force_build allow_tsb_conflicts
        allow_empty_sections allow_illegal_page_sizes allow_duplicate_tags
        allow_misaligned_tsb_base env_zero
        compress_image ttefmt tsbtagfmt default_radix build_threads
        copy_products gen_all_tsbs verbose
       );
   foreach my $key (@config_list) {
     $config_args{$key} = $opt{$key} if (exists $opt{$key} and
                                         defined $opt{$key});
   }
   # special-case.  Config name different from option name
   if(exists $config_args{mmu}) {
     $config_args{mmu_type} = $config_args{mmu};
     delete $config_args{mmu};
   }


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

   # Configure module

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

   my %config;
   # Midas::Configure takes a while to load.  Only use it if necessary
   my $code = q{
                 use Midas::Configure;

                 init_config();

                 %config =
                 Midas::Configure::configure
                 ( %config_args );
                };

   eval $code;
   die $@ if $@;

   chat "midas @argv\n", 1;


   ### Configure include paths

   if(not $opt{stdinc}) {
     my @build = ($opt{include_build} ? (builddir => ['.']) : ());
     my @start = ($opt{include_start} ? (startdir => ['.']) : ());
     %config =
       Midas::Configure::configure(
                                   cpp_includes => { @build, @start },
                                   m4_includes  => { @build, @start },
                                   c_includes   => { @build, @start },
                                  );
   }

   if(defined $opt{I} and @{$opt{I}}) {
     my $cwd = getcwd;
     my @incs = map { File::Spec->rel2abs($_, $cwd) } @{$opt{I}};
     Midas::Configure::add_cpp_includes(@incs);
     Midas::Configure::add_m4_includes(@incs);
   }

   if(defined $opt{L} and @{$opt{L}}) {
     my $cwd = getcwd;
     my @incs = map { File::Spec->rel2abs($_, $cwd) } @{$opt{L}};
     Midas::Configure::add_link_includes(@incs);
   }

   if(defined $opt{C} and @{$opt{C}}) {
     my $cwd = getcwd;
     my @incs = map { File::Spec->rel2abs($_, $cwd) } @{$opt{C}};
     Midas::Configure::add_csrc_includes(@incs);
   }

   if(defined $opt{pal_diag_args}) {
     Midas::Configure::add_pal_diag_args(@{$opt{pal_diag_args}});
   }

   ### Configure defines

   if(not $opt{stddef}) {
     %config =
       Midas::Configure::configure( cpp_defines => [] );
   }

   if(defined $opt{D} and @{$opt{D}}) {
     Midas::Configure::add_cpp_defines(@{$opt{D}});
   }

   ### Configure commands

   foreach my $command (@Configurable_commands) {
     configure_command_options($command,
                               $opt{"std_${command}_args"},
                               $opt{"${command}_args"},
                               $opt{"${command}_cmd"},
                               \%config);
   }

   ### Configure file names

   configure_file_names($opt{file}, \%config) if defined $opt{file};

   ###########################################################################
   # Call magic function
   ###########################################################################

   if($opt{E}) {
     push @{$opt{phase}}, qw(setup preprocess);
   }


   $code = q{
              # Midas::Assembly takes a while to load.  Only parse
              # it if necessary.
              use Midas::Assembly;


              assemble_diag($diag,
                            -dest_dir  => $opt{dest_dir},
                            -diag_root => $opt{diag_root},
                            (map { -phase => $_ } @{$opt{phase}}),
                            (defined $opt{start_phase} ?
                             (-start_phase => $opt{start_phase}) : ()
                            ),
                            -argv => "@argv",
                           );
             };

   eval $code;
   die $@ if $@;  # Throw up any exceptions to next level handler

 };

 chdir $startdir;

 return handle_error($@);
}
###############################################################################
###############################################################################

sub usage {
 my @args = @_;

 my $code = q{

               use Pod::Usage;

               pod2usage(@args);

              };

 eval $code;
 die "Can't load Pod::Usage!: $@\n" if $@;
}

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

sub bad_arg {
 my $message = shift;
 fatal $message, M_ARGERR;
}

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

sub configure_command_options {
 my $command      = shift;
 my $use_standard = shift;
 my $add_args     = shift;
 my $cmd_option   = shift;
 my $configref    = shift;

 if(not defined $configref) {
   my %c = Midas::Configure::configure() unless defined $configref;
   $configref = \%c;
 }

 my $opt_config_key = "${command}_opt";
 my $cmd_config_key = "${command}_cmd";

 bad_arg("No such command \"$command\".\n")
   unless exists $configref->{$opt_config_key};

 if(not $use_standard) {
   Midas::Configure::configure($opt_config_key => []);
 }
 if(defined $add_args and @$add_args) {
   Midas::Configure::append_configuration($opt_config_key => $add_args);
 }
 if(defined $cmd_option) {
   Midas::Configure::configure($cmd_config_key => $cmd_option);
 }
}

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

sub configure_file_names {
 my $file_list = shift;
 my $configref = shift;

 if(not defined $configref) {
   my %c = Midas::Configure::configure() unless defined $configref;
   $configref = \%c;
 }

 my @config;
 foreach my $spec (@$file_list) {
   bad_arg("-file argument is tag=name.\n")
     unless $spec =~ /^(\S+)=(\S.*)$/;
   my ($file, $name) = ($1, $2);
   my $config_tag = "local_$file";
   bad_arg("File tag \"$file\" is not a configurable file.\n")
     unless exists $configref->{$config_tag};
   push @config, $config_tag, $name;
 }
 Midas::Configure::configure(@config) if @config;

}

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

sub find_diag {
 my $diag = shift;
 my $root = shift;

 my $diag_base = basename $diag;
 bad_arg("When -find is used, diag \"$diag\" should be a name, ".
         "not a path.\n") if ($diag ne $diag_base);

 bad_arg("Can't find with root \"$root\": No such directory.\n")
   unless -d $root;

 my $found;
 my $found_ref = \$found;
 my $wanted = sub {
   if($diag_base eq $_) {
     $$found_ref = $File::Find::name;
   }
 };

 find($wanted, $root);

 bad_arg("Could not find file \"$diag\" in root \"$root\".\n")
   unless defined $found;

 return $found;
}

###############################################################################
###############################################################################
1;