# ========== Copyright Header Begin ==========================================
# OpenSPARC T2 Processor File: Script.pm
# Copyright (C) 1995-2007 Sun Microsystems, Inc. All Rights Reserved
# 4150 Network Circle, Santa Clara, California 95054, U.S.A.
# * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the 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.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
# For the avoidance of doubt, and except that if any non-GPL license
# choice is available it will apply instead, Sun elects to use only
# the General Public License version 2 (GPLv2) at this time for any
# software where a choice of GPL license versions is made
# available with the language indicating that GPLv2 or any later version
# may be used, or where a choice of which version of the GPL is applied is
# Please contact Sun Microsystems, Inc., 4150 Network Circle, Santa Clara,
# CA 95054 USA or visit www.sun.com if you need additional information or
# ========== Copyright Header End ============================================
package DiagList
::Script
;
our @EXPORT = qw(dlist construct_dlist get_diag_display build_tags);
our @EXPORT_OK = qw( $Default_cpp_cmd $Default_cpp_args );
our $Default_cpp_cmd = 'bw_cpp';
our $Default_cpp_args = '-undef -B';
cpp_cmd => $Default_cpp_cmd,
cpp_args => $Default_cpp_args,
my ($GMAXLEN, $BMAXLEN, $NMAXLEN);
###############################################################################
# Make -D and -I options more palatable to GetOptions
@ARGV = map { /^(-[DI])(\S.*)/ ?
($1, $2) : $_ } @ARGV;
if(not GetOptions
(\
%opt, @options)) {
pod2usage
(-exitval
=> 'NOEXIT',
pod2usage
(-exitval
=> 'NOEXIT', -verbose
=> 2);
if(not defined $opt{diaglist
}) {
if(not defined $opt{diag_root
}) {
die "dlist: Must set \$DV_ROOT or use -diag_root or -diaglist.\n"
unless exists $ENV{DV_ROOT
};
$opt{diag_root
} = File
::Spec
->catdir($ENV{DV_ROOT
}, 'verif', 'diag');
$opt{diaglist
} = File
::Spec
->catfile($opt{diag_root
}, 'master_diaglist');
if(defined $opt{find
} and $opt{find
} and not defined $opt{diag_root
}) {
die "dlist: Must set \$DV_ROOT or use -diag_root with -find\n" unless exists $ENV{DV_ROOT
};
$opt{diag_root
} = File
::Spec
->catdir($ENV{DV_ROOT
}, 'verif', 'diag');
$opt{q
} = 1 if $opt{find
};
die "dlist: Diag list \"$opt{diaglist}\" not found.\n"
unless -e
$opt{diaglist
};
my $dlist = construct_dlist
(\
%opt);
build_tags
($dlist, $opt{buildtag
}, \
%opt) if defined $opt{buildtag
};
my $diagname = shift @ARGV;
#pod2usage(-exitval => -1, -verbose => 1,
# -message => "You must specify a diag name!\n")
# unless defined $diagname;
my ($alias, $group, $nametag);
if($diagname =~ /^(\S+):(\S+)$/) {
foreach my $gr ($dlist->group_list()) {
push @display_list, get_diag_display
($dlist, $alias, $nametag, $gr,
foreach my $gr ($dlist->group_list()) {
$OUT->print_status("Group: $gr\n");
push @display_list, get_diag_display
($dlist, $alias, $nametag, $group,
my $g_obj = $dlist->find_group($group);
die "dlist: Group \"$group\" not found!\n" unless defined $g_obj;
foreach my $bt ($g_obj->build_tags()) {
my @diags = $g_obj->list_diags($bt);
foreach my $diagname (@diags) {
my $d_obj = $g_obj->find_diag($bt, $diagname);
$alias = $d_obj->get_alias();
$nametag = $d_obj->get_nametag();
push @display_list, get_diag_display
($dlist, $alias, $nametag, $group,
@display_list = sort { $a->{name
} cmp $b->{name
} } @display_list;
$GMAXLEN = maxlen
( map { $_->{group
} } @display_list);
$BMAXLEN = maxlen
( map { $_->{buildtag
} } @display_list);
$NMAXLEN = maxlen
( map { $_->{name
} } @display_list);
foreach my $elem (@display_list) {
my $file = $elem->{diag
}->get_file();
if(exists $findhash{$file}) {
$elem->{full
} = $findhash{$file};
$elem->{full
} = find_file
($file, $opt{diag_root
});
$findhash{$file} = $elem->{full
};
foreach my $elem (@display_list) {
# All I'm printing is the filename, so only grab one entry for each name
# Otherwise, I'll get lots of messy duplicates
@display_list = values %{{ map { $_->{name
} . $_->{full
}, $_ } @display_list}};
foreach my $elem (@display_list) {
###############################################################################
##############################################################################
use fields
qw( name buildtag group diag full );
############################################################################
my $this = fields
::new
($class);
foreach my $key (keys %args) {
$this->{$key} = $args{$key};
############################################################################
my $npad = ' ' x
($NMAXLEN - length $this->{name
});
$OUT->print_status("$this->{name}$npad");
my $file = $this->{diag
}->get_file();
$file = $this->{full
} if $opt->{find
};
$OUT->print_status(" $file");
my $gpad = ' ' x
($GMAXLEN - length $this->{group
});
my $bpad = ' ' x
($BMAXLEN - length $this->{buildtag
});
$OUT->print_status("gr=$this->{group}$gpad ");
$OUT->print_status("build=$this->{buildtag}$bpad ");
$OUT->print_status(" " . $this->{diag
}->get_cmdline());
$OUT->print_status("\n");
############################################################################
##############################################################################
die "dlist: No group specified!\n" unless defined $group;
my $g = $dlist->find_group($group);
die "dlist: No group \"$group\" specified!\n" unless defined $g;
foreach my $bt ($g->build_tags()) {
my $dhash = $g->diag_hash($bt);
foreach my $key (@keys) {
if($key =~ /^$alias:(\S+)/) {
next if defined $nametag && $nametag ne $1;
push @list, DisplayEntry
->new( buildtag
=> $bt, name
=> $key,
group
=> $group, diag
=> $dhash->{$key});
##############################################################################
die("dlist: Can't find with root \"$root\": No such directory.\n")
$$found_ref = $File::Find
::name
;
$found = "<could_not_find>" unless defined $found;
##############################################################################
my %thash = map { $_, 1 } $dlist->build_list();
die "dlist: Build tag $buildtag not defined\n"
unless exists $thash{$buildtag};
$OUT->print_status("$buildtag\n");
$OUT->print_status("$buildtag " . $dlist->build_args($buildtag) . "\n");
my @tags = $dlist->build_list();
my $maxlen = maxlen
(@tags);
my $pad = ' ' x
($maxlen - length $bt);
$OUT->print_status("$bt\n");
$OUT->print_status("$bt$pad " . $dlist->build_args($bt) . "\n");
##############################################################################
foreach my $elem (@list) {
$maxlen = ((length $elem) > $maxlen) ?
length $elem : $maxlen;
##############################################################################
$dlist = DiagList
->new($opt->{diaglist
});
my $cmd = "$opt->{cpp_cmd} $opt->{cpp_args} ";
my $abs = File
::Spec
->rel2abs($opt->{diaglist
});
push @incs, @
{$opt->{I
}} if defined $opt->{I
};
$cmd .= join ' ', (map { "-I$_" } @incs);
push @defs, @
{$opt->{D
}} if defined $opt->{D
};
$cmd .= join ' ', (map { "-D$_" } @defs);
$cmd .= $opt->{diaglist
};
open(PIPE
, "$cmd |") or die "dlist: Can't start command \"$cmd\": $!\n";
$dlist = DiagList
->new($opt->{diaglist
}, \
*PIPE
);
##############################################################################