* [binutils-gdb] gprofng: support GNU option syntax in gp-display-html, plus various fixes
@ 2023-11-29 18:45 Vladimir Mezentsev
0 siblings, 0 replies; only message in thread
From: Vladimir Mezentsev @ 2023-11-29 18:45 UTC (permalink / raw)
To: bfd-cvs, gdb-cvs
https://sourceware.org/git/gitweb.cgi?p=binutils-gdb.git;h=a0dc1f9a12a4394463b9dbf5927166f2ab8518a6
commit a0dc1f9a12a4394463b9dbf5927166f2ab8518a6
Author: Vladimir Mezentsev <vladimir.mezentsev@oracle.com>
Date: Tue Nov 28 12:05:15 2023 -0800
gprofng: support GNU option syntax in gp-display-html, plus various fixes
This is a major update of gp-display-html. The option handling has been
modified to support the GNU style long option syntax. Compatibility with
the previous syntax has been preserved. If still used, a warning is issued.
Through the --nowarnings option, this can be suppressed.
In addition to this, various lay-out changes have been implemented. In
particular to reduce the number of lines that extend beyond column 79.
Several bugs have been fixed, for example in the handling of directory names.
gprofng/ChangeLog
2023-11-28 Ruud van der Pas <ruud.vanderpas@oracle.com>
* gp-display-html/gp-display-html.in: Change option syntax plus fixes.
Diff:
---
gprofng/gp-display-html/gp-display-html.in | 7125 +++++++++++++++++-----------
1 file changed, 4226 insertions(+), 2899 deletions(-)
diff --git a/gprofng/gp-display-html/gp-display-html.in b/gprofng/gp-display-html/gp-display-html.in
index dc310f836af..4973297db2a 100644
--- a/gprofng/gp-display-html/gp-display-html.in
+++ b/gprofng/gp-display-html/gp-display-html.in
@@ -18,11 +18,21 @@
# along with this program; if not, write to the Free Software
# Foundation, 51 Franklin Street - Fifth Floor, Boston,
# MA 02110-1301, USA.
-
+
use strict;
use warnings;
-use feature qw (state);
+
+# Disable before release
+# use Perl::Critic;
+
+use bignum;
+use List::Util qw (max);
+use Cwd qw (abs_path cwd);
+use File::Basename;
use File::stat;
+use feature qw (state);
+use POSIX;
+use Getopt::Long qw (Configure);
#------------------------------------------------------------------------------
# Check as early as possible if the version of Perl used is supported.
@@ -64,14 +74,14 @@ my $g_max_length_first_metric;
#------------------------------------------------------------------------------
my $g_path_to_tools;
-#-------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
# Code debugging flag
-#-------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
my $g_test_code = $FALSE;
-#-------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
# GPROFNG commands and files used.
-#-------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
my $GP_DISPLAY_TEXT = "gp-display-text";
my $g_gp_output_file = $GP_DISPLAY_TEXT.".stdout.log";
@@ -91,6 +101,11 @@ my $g_addressing_mode = "64 bit";
my $g_html_less_than_regex = '<';
my $g_endbr_inst_regex = 'endbr[32|64]';
+#------------------------------------------------------------------------------
+# For consistency, use a global variable.
+#------------------------------------------------------------------------------
+ my $g_html_new_line = "<br>";
+
#------------------------------------------------------------------------------
# These are the regex's used.
#------------------------------------------------------------------------------
@@ -99,18 +114,10 @@ my $g_addressing_mode = "64 bit";
#------------------------------------------------------------------------------
my $g_branch_regex = '\.*([0-9a-fA-F]*):\s+(j).*\s*0x([0-9a-fA-F]+)';
my $g_endbr_regex = '\.*([0-9a-fA-F]*):\s+(endbr[32|64])';
- my $g_function_call_v2_regex = '(.*)\s+([0-9a-fA-F]*):\s+(call)\s*0x([0-9a-fA-F]+)\s*';
-
-#------------------------------------------------------------------------------
-# Convenience. These map the on/off value to $TRUE/$FALSE to make the code
-# easier to read. For example: "if ($g_verbose)" as opposed to the following:
-# "if ($verbose_setting eq "on").
-#------------------------------------------------------------------------------
-my $g_verbose;
-my $g_warnings;
-my $g_quiet;
+ my $g_function_call_v2_regex =
+ '(.*)\s+([0-9a-fA-F]*):\s+(call)\s*0x([0-9a-fA-F]+)\s*';
-my $g_first_metric;
+my $g_first_metric;
my $binutils_version;
my $driver_cmd;
@@ -120,10 +127,23 @@ my $version_info;
my %g_mapped_cmds = ();
#------------------------------------------------------------------------------
-# TBD All warning messages are collected and are accessible through the main
-# page.
+# Variables dealing with warnings and errors. Since a message may span
+# multiple lines (for readability reasons), the number of entries in the
+# array may not reflect the total number of messages. This is why we use
+# separate variables for the counts.
+#------------------------------------------------------------------------------
+my @g_error_msgs = ();
+my @g_warning_msgs = ();
+my $g_total_error_count = 0;
#------------------------------------------------------------------------------
-my @g_warning_messages = ();
+# This count is used in the html_create_warnings_page HTML page to show how
+# many warning messages there are. Warnings are printed through gp_message(),
+# but since one warning may span multiple lines, we update a separate counter
+# that contains the total number of warning messages issued so far.
+#------------------------------------------------------------------------------
+my $g_total_warning_count = 0;
+my $g_options_printed = $FALSE;
+my $g_abort_msg = "cannot recover from the error(s)";
#------------------------------------------------------------------------------
# Contains the names that have already been tagged. This is a global
@@ -140,12 +160,10 @@ my $g_context = 5; # Defines the range of scan
my $g_default_setting_lang = "en-US.UTF-8";
my %g_exp_dir_meta_data;
-my @g_user_input_errors = ();
-
my $g_html_credits_line;
-my $g_warn_keyword = "Input warning: ";
-my $g_error_keyword = "Input error: ";
+my $g_warn_keyword = "[Warning]";
+my $g_error_keyword = "[Error]";
my %g_function_occurrences = ();
my %g_map_function_to_index = ();
@@ -155,49 +173,128 @@ my @g_full_function_view_table = ();
my @g_html_experiment_stats = ();
-#-------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
# These structures contain the information printed in the function views.
-#-------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
my $g_header_lines;
my @g_html_function_name = ();
-#-------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
# TBD: This variable may not be needed and replaced by tp_value
my $thresh = 0;
-#-------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
-#-------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
# Define the driver command, tool name and version number.
-#-------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
$driver_cmd = "gprofng display html";
$tool_name = "gp-display-html";
#$binutils_version = "2.38.50";
$binutils_version = "BINUTILS_VERSION";
$version_info = $tool_name . " GNU binutils version " . $binutils_version;
-#-------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
-#-------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
# Define several key data structures.
-#-------------------------------------------------------------------------------
-my %g_user_settings =
+#------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
+
+#------------------------------------------------------------------------------
+# This table has the settings of the variables the user may set.
+#------------------------------------------------------------------------------
+my %g_user_settings =
(
- output => { option => "-o" , no_of_arguments => 1, data_type => "path" , current_value => undef, defined => $FALSE},
- overwrite => { option => "-O" , no_of_arguments => 1, data_type => "path" , current_value => undef, defined => $FALSE},
- calltree => { option => "-ct", no_of_arguments => 1, data_type => "onoff" , current_value => "off" , defined => $FALSE},
- func_limit => { option => "-fl", no_of_arguments => 1, data_type => "pinteger", current_value => 500 , defined => $FALSE},
- highlight_percentage => { option => "-hp", no_of_arguments => 1, data_type => "pfloat" , current_value => 90.0 , defined => $FALSE},
- threshold_percentage => { option => "-tp", no_of_arguments => 1, data_type => "pfloat" , current_value => 100.0 , defined => $FALSE},
- default_metrics => { option => "-dm", no_of_arguments => 1, data_type => "onoff" , current_value => "off" , defined => $FALSE},
- ignore_metrics => { option => "-im", no_of_arguments => 1, data_type => "metric_names", current_value => undef, defined => $FALSE},
- verbose => { option => "--verbose" , no_of_arguments => 1, data_type => "onoff" , current_value => "off" , defined => $FALSE},
- warnings => { option => "--warnings" , no_of_arguments => 1, data_type => "onoff" , current_value => "on" , defined => $FALSE},
- debug => { option => "--debug" , no_of_arguments => 1, data_type => "size" , current_value => "off" , defined => $FALSE},
- quiet => { option => "--quiet" , no_of_arguments => 1, data_type => "onoff" , current_value => "off" , defined => $FALSE},
+ verbose => { option => "--verbose",
+ no_of_arguments => 1,
+ data_type => "onoff",
+ current_value => "off", defined => $FALSE},
+
+ debug => { option => "--debug",
+ no_of_arguments => 1,
+ data_type => "size",
+ current_value => "off", defined => $FALSE},
+
+ warnings => { option => "--warnings",
+ no_of_arguments => 1,
+ data_type => "onoff" ,
+ current_value => "off", defined => $FALSE},
+
+ nowarnings => { option => "--nowarnings",
+ no_of_arguments => 1,
+ data_type => "onoff",
+ current_value => "off", defined => $FALSE},
+
+ quiet => { option => "--quiet",
+ no_of_arguments => 1,
+ data_type => "onoff",
+ current_value => "off", defined => $FALSE},
+
+ output => { option => "-o",
+ no_of_arguments => 1,
+ data_type => "path",
+ current_value => undef, defined => $FALSE},
+
+ overwrite => { option => "-O",
+ no_of_arguments => 1,
+ data_type => "path",
+ current_value => undef, defined => $FALSE},
+
+ calltree => { option => "-ct",
+ no_of_arguments => 1,
+ data_type => "onoff",
+ current_value => "off", defined => $FALSE},
+
+ func_limit => { option => "-fl",
+ no_of_arguments => 1,
+ data_type => "pinteger",
+ current_value => 500, defined => $FALSE},
+
+ highlight_percentage => { option => "--highlight-percentage",
+ no_of_arguments => 1,
+ data_type => "pfloat",
+ current_value => 90.0, defined => $FALSE},
+
+ hp => { option => "-hp",
+ no_of_arguments => 1,
+ data_type => "pfloat",
+ current_value => 90.0, defined => $FALSE},
+
+ threshold_percentage => { option => "-tp",
+ no_of_arguments => 1,
+ data_type => "pfloat",
+ current_value => 100.0, defined => $FALSE},
+
+ default_metrics => { option => "-dm",
+ no_of_arguments => 1,
+ data_type => "onoff",
+ current_value => "off", defined => $FALSE},
+
+ ignore_metrics => { option => "-im",
+ no_of_arguments => 1,
+ data_type => "metric_names",
+ current_value => undef, defined => $FALSE},
);
-my %g_debug_size =
+#------------------------------------------------------------------------------
+# Convenience. These map the on/off value to $TRUE/$FALSE to make the code
+# easier to read. For example: "if ($g_verbose)" as opposed to the following:
+# "if ($verbose_setting eq "on").
+#------------------------------------------------------------------------------
+my $g_verbose = $FALSE;
+my $g_debug = $FALSE;
+my $g_warnings = $TRUE;
+my $g_quiet = $FALSE;
+
+#------------------------------------------------------------------------------
+# Since ARGV is modified when parsing the options, a clean copy is used to
+# print the original ARGV values in case of a warning, or error.
+#------------------------------------------------------------------------------
+my @CopyOfARGV = ();
+
+my %g_debug_size =
(
"on" => $FALSE,
"s" => $FALSE,
@@ -219,7 +316,10 @@ my %local_system_config =
hostname_current => "undefined",
);
-# Note that we use single quotes here, because regular expressions wreak havoc otherwise.
+#------------------------------------------------------------------------------
+# Note that we use single quotes here, because regular expressions wreak
+# havoc otherwise.
+#------------------------------------------------------------------------------
my %g_arch_specific_settings =
(
@@ -269,7 +369,7 @@ my %g_html_base_file_name = (
);
#------------------------------------------------------------------------------
-# This is cosmetic, but helps with the scoping of variables.
+# Introducing main() is cosmetic, but helps with the scoping of variables.
#------------------------------------------------------------------------------
main ();
@@ -282,6 +382,8 @@ sub main
{
my $subr_name = get_my_name ();
+ @CopyOfARGV = @ARGV;
+
#------------------------------------------------------------------------------
# The name of the configuration file.
#------------------------------------------------------------------------------
@@ -289,9 +391,12 @@ sub main
#------------------------------------------------------------------------------
# OS commands executed and search paths.
+#
+# TBD: check if elfdump should be here too (most likely not though)
#------------------------------------------------------------------------------
- my @selected_os_cmds = qw (rm mv cat hostname locale which printenv ls
- uname readelf mkdir);
+ my @selected_os_cmds = qw (rm cat hostname locale which printenv uname
+ readelf mkdir);
+
my @search_paths_os_cmds = qw (
/usr/bin
/bin
@@ -310,11 +415,11 @@ sub main
#------------------------------------------------------------------------------
# Local structures (hashes and arrays).
#------------------------------------------------------------------------------
- my @exp_dir_list; # List with experiment directories
+ my @exp_dir_list = ();
my @metrics_data;
my %function_address_info = ();
- my $function_address_info_ref;
+ my $function_address_info_ref;
my @function_info = ();
my $function_info_ref;
@@ -340,22 +445,19 @@ sub main
#------------------------------------------------------------------------------
# Local variables.
#------------------------------------------------------------------------------
- my $abs_path_outputdir;
+ my $abs_path_outputdir;
my $archive_dir_not_empty;
- my $base_va_executable;
+ my $base_va_executable;
my $executable_name;
- my $exp_dir_list_ref;
my $found_exp_dir;
my $ignore_value;
- my $message;
+ my $msg;
my $number_of_metrics;
my $va_executable_in_hex;
- my $failed_command_mappings;
- my $option_errors;
- my $total_user_errors;
+ my $failed_command_mappings;
- my $script_pc_metrics;
+ my $script_pc_metrics;
my $dir_check_errors;
my $consistency_errors;
my $outputdir;
@@ -367,7 +469,7 @@ sub main
my $elf_arch;
my $elf_support;
my $home_dir;
- my $elf_loadobjects_found;
+ my $elf_loadobjects_found;
my $rc_file_paths_ref;
my @rc_file_paths = ();
@@ -380,9 +482,15 @@ sub main
my $system_metrics;
my $wall_metrics;
my $detail_metrics;
- my $detail_metrics_system;
+ my $detail_metrics_system;
+
+ my $html_test;
+ my @experiment_data;
+ my $exp_info_file;
+ my $exp_info_ref;
+ my @exp_info;
- my $pretty_dir_list;
+ my $pretty_dir_list;
my %metric_value = ();
my %metric_description = ();
@@ -416,12 +524,12 @@ sub main
#------------------------------------------------------------------------------
if ($#ARGV == -1)
{
- $ignore_value = print_help_info ();
+ $ignore_value = print_help_info ();
return (0);
}
#------------------------------------------------------------------------------
-# This part is like a preamble. Before we continue we need to figure out some
+# This part is like a preamble. Before we continue we need to figure out some
# things that are needed later on.
#------------------------------------------------------------------------------
@@ -431,214 +539,157 @@ sub main
my $location_gp_command = $0;
#------------------------------------------------------------------------------
-# The very first thing to do is to quickly determine if the user has enabled
-# one of the following options and take action accordingly:
-# --version, --verbose, --debug, --quiet
+# Get the ball rolling. Parse and interpret the options. Some first checks
+# are performed.
#
-# This avoids that there is a gap between the start of the execution and the
-# moment the options are parsed, checked, and interpreted.
+# Instead of bailing out on the first user error, we capture all warnings and
+# errors. The warnings, if any, will be printed once the command line has
+# been parsed and verified. Execution continues.
#
-# When parsing the full command line, these options will be more extensively
-# checked and also updated in %g_user_settings
-
-# Note that a confirmation message, if any, is printed here and not when the
-# options are parsed and processed.
-#------------------------------------------------------------------------------
-
- $g_verbose = $g_user_settings{"verbose"}{"current_value"} eq "on" ? $TRUE : $FALSE;
- $g_warnings = $g_user_settings{"warnings"}{"current_value"} eq "on" ? $TRUE : $FALSE;
- $g_quiet = $g_user_settings{"quiet"}{"current_value"} eq "on" ? $TRUE : $FALSE;
-
- $ignore_value = early_scan_specific_options ();
-
-#------------------------------------------------------------------------------
-# The next subroutine is executed early to ensure the OS commands we need are
-# available.
+# Any error(s) accumulated in this phase will be printed after the command
+# line has been parsed and verified. Execution is then terminated.
#
-# This subroutine stores the commands and the full path names as an associative
-# array called "g_mapped_cmds". The command is the key and the value is the full
-# path. For example: ("uname", /usr/bin/uname).
+# In the remainder, any error encountered will immediately terminate the
+# execution because we can't guarantee the remaining code will work up to
+# some point.
#------------------------------------------------------------------------------
- $failed_command_mappings = check_and_define_cmds (\@selected_os_cmds, \@search_paths_os_cmds);
+ my ($found_exp_dir_ref, $exp_dir_list_ref) = parse_and_check_user_options ();
- if ($failed_command_mappings == 0)
+ $found_exp_dir = ${ $found_exp_dir_ref };
+
+ if ($found_exp_dir)
{
- gp_message ("debug", $subr_name, "verified the OS commands");
+ @exp_dir_list = @{ $exp_dir_list_ref };
}
else
{
- my $msg = "failure in the verification of the OS commands";
- gp_message ("assertion", $subr_name, $msg);
+ $msg = "the list with experiments is either missing, or incorrect";
+ gp_message ("debug", $subr_name, $msg);
}
#------------------------------------------------------------------------------
-# Get the home directory and the locations for the configuration file on the
-# current system.
-#------------------------------------------------------------------------------
- ($home_dir, $rc_file_paths_ref) = get_home_dir_and_rc_path ($rc_file_name);
-
- @rc_file_paths = @{ $rc_file_paths_ref };
- gp_message ("debug", $subr_name, "the home directory is $home_dir");
- gp_message ("debugXL", $subr_name, "the search path for the rc file is @rc_file_paths");
-
- $pretty_dir_list = build_pretty_dir_list (\@rc_file_paths);
-
-#------------------------------------------------------------------------------
-# Get the ball rolling. Parse and interpret the configuration file (if any)
-# and the command line options.
-#
-# If either $rc_file_errors or $total_user_errors, or both, are non-zero it
-# means a fatal error has occured. In this case, all error messages are
-# printed and execution is terminated.
-#
-# Note that the verbose, debug, and quiet options can be set in this file.
-# It is a deliberate choice to ignore these for now. The assumption is that
-# the user will not be happy if we ignore the command line settings for a
-# while.
+# The final settings for verbose, debug, warnings and quiet are known and the
+# gp_message() subroutine is aware of these.
#------------------------------------------------------------------------------
-
- gp_message ("debugXL", $subr_name, "processing of the rc file disabled for now");
-
-# Temporarily disabled print_table_user_settings ("debugXL", "before function process_rc_file");
-# Temporarily disabled
-# Temporarily disabled $rc_file_errors = process_rc_file ($rc_file_name, $rc_file_paths_ref);
-# Temporarily disabled
-# Temporarily disabled if ($rc_file_errors != 0)
-# Temporarily disabled {
-# Temporarily disabled $message = "fatal errors in file $rc_file_name encountered";
-# Temporarily disabled gp_message ("debugXL", $subr_name, $message);
-# Temporarily disabled }
-# Temporarily disabled
-# Temporarily disabled print_table_user_settings ("debugXL", "after function process_rc_file");
+ $msg = "parsing of the user options completed";
+ gp_message ("verbose", $subr_name, $msg);
#------------------------------------------------------------------------------
-# Get the ball rolling. Parse and interpret the options. Some first checks
-# are performed.
-#
-# Instead of bailing out on the first user error, we capture all errors, print
-# messages and then bail out. This is more user friendly.
+# The user options have been taken in. Check for validity and consistency.
#------------------------------------------------------------------------------
- gp_message ("verbose", $subr_name, "Parse the user options");
+ $msg = "process user options";
+ gp_message ("verbose", $subr_name, $msg);
- $total_user_errors = 0;
+ ($ignored_metrics_ref, $outputdir,
+ $time_percentage_multiplier, $process_all_functions, $exp_dir_list_ref) =
+ process_user_options (\@exp_dir_list);
- ($option_errors, $found_exp_dir, $exp_dir_list_ref) = parse_and_check_user_options (
- \$#ARGV,
- \@ARGV);
- $total_user_errors += $option_errors;
+ @exp_dir_list = @{ $exp_dir_list_ref };
+ %ignored_metrics = %{$ignored_metrics_ref};
#------------------------------------------------------------------------------
-# Dynamically load the modules needed. If a module is not available, print
-# an error message and bail out.
-#
-# This call replaces the following:
-#
-# use feature qw (state);
-# use List::Util qw (min max);
-# use Cwd;
-# use File::Basename;
-# use File::stat;
-# use POSIX;
-# use bignum;
+# The next subroutine is executed early to ensure the OS commands we need are
+# available.
#
-# Note that this check cannot be done earlier, because in case of a missing
-# module, the man page would not be generated if the code ends prematurely
-# in case the --help and --version options are used..
+# This subroutine stores the commands and the full path names as an
+# associative array called "g_mapped_cmds". The command is the key and the
+# value is the full path. For example: ("uname", /usr/bin/uname).
#------------------------------------------------------------------------------
- my ($module_errors_ref, $missing_modules_ref) = handle_module_availability ();
-
- my $module_errors = ${ $module_errors_ref };
+ gp_message ("debug", $subr_name, "verify the OS commands");
+ $failed_command_mappings = check_and_define_cmds (\@selected_os_cmds,
+ \@search_paths_os_cmds);
- if ($module_errors > 0)
+ if ($failed_command_mappings == 0)
{
- my $msg;
-
- my $plural_or_single = ($module_errors > 1) ? "modules are" : "module is";
- my @missing_modules = @{ $missing_modules_ref };
-
- for my $i (0 .. $#missing_modules)
- {
- $msg = "module $missing_modules[$i] is missing";
- gp_message ("error", $subr_name, $msg);
- }
-
- $msg = $module_errors . " " . $plural_or_single .
- "missing - execution is terminated";
- gp_message ("abort", $subr_name, $msg);
+ $msg = "successfully verified the OS commands";
+ gp_message ("debug", $subr_name, $msg);
}
#------------------------------------------------------------------------------
-# The user options have been taken in. Check for validity and consistency.
#------------------------------------------------------------------------------
- gp_message ("verbose", $subr_name, "Process user options");
-
- ($option_errors, $ignored_metrics_ref, $outputdir,
- $time_percentage_multiplier, $process_all_functions,
- $exp_dir_list_ref) = process_user_options ($exp_dir_list_ref);
-
- @exp_dir_list = @{ $exp_dir_list_ref };
- %ignored_metrics = %{$ignored_metrics_ref};
-
- $total_user_errors += $option_errors;
-
+# Time to check if any warnings and/or errors have been generated.
#------------------------------------------------------------------------------
-# If no option is given for the output directory, pick a default. Otherwise,
-# if the output directory exists, wipe it clean in case the -O option is used.
-# If not, flag an error because the -o option does not overwrite an existing
-# directory.
#------------------------------------------------------------------------------
- if ($total_user_errors == 0)
- {
- ($option_errors, $outputdir) = set_up_output_directory ();
- $abs_path_outputdir = cwd () . "/" . $outputdir;
- $total_user_errors += $option_errors;
- }
- if ($total_user_errors == 0)
- {
- gp_message ("debug", $subr_name, "the output directory is $outputdir");
- }
- else
- {
#------------------------------------------------------------------------------
-# All command line errors and warnings are printed here.
+# We have completed all the upfront checks. Print any warnings and errors.
+# If there are already any errors, execution is terminated. As execution
+# continues, errors may occur and they are typically fatal.
#------------------------------------------------------------------------------
- my $plural_or_single = ($total_user_errors > 1) ? "errors have" : "error has";
- $message = $g_error_keyword;
- $message .= $total_user_errors;
- if ($rc_file_errors > 0)
- {
- $message .= " additional";
- }
- $message .= " fatal input $plural_or_single been detected:";
- gp_message ("error", $subr_name, $message);
- for my $key (keys @g_user_input_errors)
- {
- gp_message ("error", $subr_name, "$g_error_keyword $g_user_input_errors[$key]");
- }
+ if ($g_debug)
+ {
+ $msg = "internal settings after option processing";
+ $ignore_value = print_table_user_settings ("diag", $msg);
}
#------------------------------------------------------------------------------
-# Bail out in case fatal errors have occurred.
+# Terminate execution in case fatal errors have occurred.
#------------------------------------------------------------------------------
- if ( ($rc_file_errors + $total_user_errors) > 0)
+ if ( $g_total_error_count > 0)
{
my $msg = "the current values for the user controllable settings";
print_user_settings ("debug", $msg);
- gp_message ("abort", $subr_name, "execution terminated");
+ gp_message ("abort", $subr_name, $g_abort_msg);
}
else
{
my $msg = "after parsing the user options, the final values are";
print_user_settings ("debug", $msg);
+ }
+
+#------------------------------------------------------------------------------
+# If no option is given for the output directory, pick a default. Otherwise,
+# if the output directory exists, wipe it clean in case the -O option is used.
+# If not, raise an error because the -o option does not overwrite an existing
+# directory.
+# Also in case of other errors, the execution is terminated.
+#------------------------------------------------------------------------------
+ $outputdir = set_up_output_directory ();
+ $abs_path_outputdir = Cwd::cwd () . "/" . $outputdir;
+
+ $msg = "the output directory is $outputdir";
+ gp_message ("debug", $subr_name, $msg);
#------------------------------------------------------------------------------
-# TBD: Enable once all planned features have been implemented and tested.
+# Get the home directory and the locations for the configuration file on the
+# current system.
#------------------------------------------------------------------------------
-# Temporarily disabled $msg = "the final values for the user controllable settings";
-# Temporarily disabled print_table_user_settings ("verbose", $msg);
- }
+ ($home_dir, $rc_file_paths_ref) = get_home_dir_and_rc_path ($rc_file_name);
+
+ @rc_file_paths = @{ $rc_file_paths_ref };
+
+ $msg = "the home directory is $home_dir";
+ gp_message ("debug", $subr_name, $msg);
+
+#------------------------------------------------------------------------------
+# TBD: de-activated until this feature has been fully implemented.
+#------------------------------------------------------------------------------
+## $msg = "the search path for the rc file is @rc_file_paths";
+## gp_message ("debug", $subr_name, $msg);
+## $pretty_dir_list = build_pretty_dir_list (\@rc_file_paths);
+
+#------------------------------------------------------------------------------
+# Get the ball rolling. Parse and interpret the configuration file (if any)
+# and the command line options.
+#
+# Note that the verbose, debug, and quiet options can be set in this file.
+# It is a deliberate choice to ignore these for now. The assumption is that
+# the user will not be happy if we ignore the command line settings for a
+# while.
+#------------------------------------------------------------------------------
+ $msg = "processing of the rc file has been disabled for now";
+ gp_message ("debugXL", $subr_name, $msg);
+
+# Temporarily disabled
+# print_table_user_settings ("debugXL", "before function process_rc_file");
+# $rc_file_errors = process_rc_file ($rc_file_name, $rc_file_paths_ref);
+# if ($rc_file_errors != 0)
+# {
+# $message = "fatal errors in file $rc_file_name encountered";
+# gp_message ("debugXL", $subr_name, $message);
+# }
+# print_table_user_settings ("debugXL", "after function process_rc_file");
#------------------------------------------------------------------------------
# Print a list with the experiment directory names
@@ -647,7 +698,8 @@ sub main
my $plural = ($#exp_dir_list > 0) ? "directories are" : "directory is";
- gp_message ("verbose", $subr_name, "The experiment " . $plural . ":");
+ $msg = "the experiment " . $plural . ":";
+ gp_message ("verbose", $subr_name, $msg);
gp_message ("verbose", $subr_name, $pretty_dir_list);
#------------------------------------------------------------------------------
@@ -657,73 +709,77 @@ sub main
for my $exp_dir (@exp_dir_list)
{
my ($filename, $directory_path, $ignore_suffix) = fileparse ($exp_dir);
- gp_message ("debug", $subr_name, "exp_dir = $exp_dir");
- gp_message ("debug", $subr_name, "filename = $filename");
- gp_message ("debug", $subr_name, "directory_path = $directory_path");
- $g_exp_dir_meta_data{$filename}{"directory_path"} = $directory_path;
+ gp_message ("debug", $subr_name, "exp_dir = $exp_dir");
+ gp_message ("debug", $subr_name, "filename = $filename");
+ gp_message ("debug", $subr_name, "directory_path = $directory_path");
+ $g_exp_dir_meta_data{$filename}{"directory_path"} = $directory_path;
}
#------------------------------------------------------------------------------
-# Check whether the experiment directories are valid. If not, it is a fatal
-# error.
-# Upon successful return, one directory has been selected to be used in the
-# remainder. This is not always the correct thing to do, but is the same as
-# the original code. In due time this should be addressed though.
+# TBD:
+# This subroutine may be overkill. See what is really needed here and remove
+# everything else.
+#
+# Upon return, one directory has been selected to be used in the remainder.
+# This is not always the correct thing to do, but is the same as the original
+# code. In due time this should be addressed though.
#------------------------------------------------------------------------------
- ($dir_check_errors, $archive_dir_not_empty, $selected_archive,
- $elf_rats_ref) = check_validity_exp_dirs ($exp_dir_list_ref);
-
- if ($dir_check_errors)
- {
- gp_message ("abort", $subr_name, "execution terminated");
- }
- else
- {
- gp_message ("verbose", $subr_name, "The experiment directories have been verified and are valid");
- }
+ ($archive_dir_not_empty, $selected_archive, $elf_rats_ref) =
+ check_validity_exp_dirs (\@exp_dir_list);
%elf_rats = %{$elf_rats_ref};
-#-------------------------------------------------------------------------------
+ $msg = "the experiment directories have been verified and are valid";
+ gp_message ("verbose", $subr_name, $msg);
+
+#------------------------------------------------------------------------------
# Now that we know the map.xml file(s) are present, we can scan these and get
# the required information. This includes setting the base virtual address.
-#-------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
$ignore_value = determine_base_virtual_address ($exp_dir_list_ref);
#------------------------------------------------------------------------------
# Check whether the experiment directories are consistent.
#------------------------------------------------------------------------------
- ($consistency_errors, $executable_name) = verify_consistency_experiments ($exp_dir_list_ref);
+ ($consistency_errors, $executable_name) =
+ verify_consistency_experiments ($exp_dir_list_ref);
if ($consistency_errors == 0)
{
- gp_message ("verbose", $subr_name, "The experiment directories are consistent");
+ $msg = "the experiment directories are consistent";
+ gp_message ("verbose", $subr_name, $msg);
}
else
{
- gp_message ("abort", $subr_name, "number of consistency errors detected: $consistency_errors");
+ $msg = "the number of consistency errors detected: $consistency_errors";
+ gp_message ("abort", $subr_name, $msg);
}
#------------------------------------------------------------------------------
# The directories are consistent. We can now set the base virtual address of
# the executable.
#------------------------------------------------------------------------------
- $base_va_executable = $g_exp_dir_meta_data{$selected_archive}{"va_base_in_hex"};
+ $base_va_executable =
+ $g_exp_dir_meta_data{$selected_archive}{"va_base_in_hex"};
- gp_message ("debug", $subr_name, "executable_name = $executable_name");
- gp_message ("debug", $subr_name, "selected_archive = $selected_archive");
- gp_message ("debug", $subr_name, "base_va_executable = $base_va_executable");
+ $msg = "executable_name = " . $executable_name;
+ gp_message ("debug", $subr_name, $msg);
+ $msg = "selected_archive = " . $selected_archive;
+ gp_message ("debug", $subr_name, $msg);
+ $msg = "base_va_executable = " . $base_va_executable;
+ gp_message ("debug", $subr_name, $msg);
#------------------------------------------------------------------------------
-# The $GP_DISPLAY_TEXT tool is critical and has to be available in order
-# to proceed.
-# This subroutine only returns a value if the tool can be found."
+# The $GP_DISPLAY_TEXT tool is critical and has to be available in order to
+# proceed.
+# This subroutine only returns a value if the tool can be found.
#------------------------------------------------------------------------------
$g_path_to_tools = ${ check_availability_tool (\$location_gp_command)};
$GP_DISPLAY_TEXT = $g_path_to_tools . $GP_DISPLAY_TEXT;
- gp_message ("debug", $subr_name, "updated GP_DISPLAY_TEXT = $GP_DISPLAY_TEXT");
+ $msg = "updated GP_DISPLAY_TEXT = $GP_DISPLAY_TEXT";
+ gp_message ("debug", $subr_name, $msg);
#------------------------------------------------------------------------------
# Check if $GP_DISPLAY_TEXT is executable for user, group, and other.
@@ -732,35 +788,38 @@ sub main
#------------------------------------------------------------------------------
if (not is_file_executable ($GP_DISPLAY_TEXT))
{
- my $msg = "file $GP_DISPLAY_TEXT is not executable for user, group, and other";
+ $msg = "file $GP_DISPLAY_TEXT is not executable for user, group, and";
+ $msg .= " other";
gp_message ("warning", $subr_name, $msg);
}
#------------------------------------------------------------------------------
# Find out what the decimal separator is, as set by the user.
#------------------------------------------------------------------------------
- ($return_code, $decimal_separator, $convert_to_dot) =
+ ($return_code, $decimal_separator, $convert_to_dot) =
determine_decimal_separator ();
if ($return_code == 0)
{
- my $txt = "decimal separator is $decimal_separator " .
- "(conversion to dot is " .
- ($convert_to_dot == $TRUE ? "enabled" : "disabled").")";
- gp_message ("debugXL", $subr_name, $txt);
+ $msg = "decimal separator is $decimal_separator";
+ $msg .= " (conversion to dot is ";
+ $msg .= ($convert_to_dot == $TRUE ? "enabled" : "disabled") . ")";
+ gp_message ("debugXL", $subr_name, $msg);
}
else
{
- my $msg = "the decimal separator cannot be determined - set to $decimal_separator";
+ $msg = "the decimal separator cannot be determined -";
+ $msg .= " set to $decimal_separator";
gp_message ("warning", $subr_name, $msg);
}
#------------------------------------------------------------------------------
# Collect and store the system information.
#------------------------------------------------------------------------------
- gp_message ("verbose", $subr_name, "Collect system information and adapt settings");
+ $msg = "collect system information and adapt settings";
+ gp_message ("verbose", $subr_name, $msg);
- $return_code = get_system_config_info ();
+ $return_code = get_system_config_info ();
#------------------------------------------------------------------------------
# The 3 variables below are used in the remainder.
@@ -775,20 +834,25 @@ sub main
gp_message ("debug", $subr_name, "set arch_uname_s = $arch_uname_s");
gp_message ("debug", $subr_name, "set arch_uname = $arch_uname");
-#-------------------------------------------------------------------------------
-# This function also sets the values in "g_arch_specific_settings". This
+#------------------------------------------------------------------------------
+# This function also sets the values in "g_arch_specific_settings". This
# includes several definitions of regular expressions.
-#-------------------------------------------------------------------------------
- ($architecture_supported, $elf_arch, $elf_support) =
- set_system_specific_variables ($arch_uname, $arch_uname_s);
+#------------------------------------------------------------------------------
+ ($architecture_supported, $elf_arch, $elf_support) =
+ set_system_specific_variables ($arch_uname, $arch_uname_s);
- gp_message ("debug", $subr_name, "architecture_supported = $architecture_supported");
- gp_message ("debug", $subr_name, "elf_arch = $elf_arch");
- gp_message ("debug", $subr_name, "elf_support = ".($elf_arch ? "TRUE" : "FALSE"));
+ $msg = "architecture_supported = $architecture_supported";
+ gp_message ("debug", $subr_name, $msg);
+ $msg = "elf_arch = $elf_arch";
+ gp_message ("debug", $subr_name, $msg);
+ $msg = "elf_support = ".($elf_arch ? "TRUE" : "FALSE");
+ gp_message ("debug", $subr_name, $msg);
for my $feature (sort keys %g_arch_specific_settings)
{
- gp_message ("debug", $subr_name, "g_arch_specific_settings{$feature} = $g_arch_specific_settings{$feature}");
+ $msg = "g_arch_specific_settings{$feature} = ";
+ $msg .= $g_arch_specific_settings{$feature};
+ gp_message ("debug", $subr_name, $msg);
}
$arch = $g_arch_specific_settings{"arch"};
@@ -797,7 +861,8 @@ sub main
$g_locale_settings{"LANG"} = get_LANG_setting ();
- gp_message ("debugXL", $subr_name, "after get_LANG_setting: LANG = $g_locale_settings{'LANG'}");
+ $msg = "after get_LANG_setting: LANG = $g_locale_settings{'LANG'}";
+ gp_message ("debugXL", $subr_name, $msg);
#------------------------------------------------------------------------------
# Temporarily reset selected settings since these are not yet implemented.
@@ -808,19 +873,28 @@ sub main
# TBD: Revisit. Is this really necessary?
#------------------------------------------------------------------------------
- ($executable_name, $va_executable_in_hex) = check_loadobjects_are_elf ($selected_archive);
+ ($executable_name, $va_executable_in_hex) =
+ check_loadobjects_are_elf ($selected_archive);
$elf_loadobjects_found = $TRUE;
# TBD: Hack and those ARCHIVES_ names can be eliminated
$ARCHIVES_MAP_NAME = $executable_name;
$ARCHIVES_MAP_VADDR = $va_executable_in_hex;
- gp_message ("debugXL", $subr_name, "hack ARCHIVES_MAP_NAME = $ARCHIVES_MAP_NAME");
- gp_message ("debugXL", $subr_name, "hack ARCHIVES_MAP_VADDR = $ARCHIVES_MAP_VADDR");
- gp_message ("debugXL", $subr_name, "after call to check_loadobjects_are_elf forced elf_loadobjects_found = $elf_loadobjects_found");
-
+ $msg = "hack ARCHIVES_MAP_NAME = $ARCHIVES_MAP_NAME";
+ gp_message ("debugXL", $subr_name, $msg);
+ $msg = "hack ARCHIVES_MAP_VADDR = $ARCHIVES_MAP_VADDR";
+ gp_message ("debugXL", $subr_name, $msg);
+
+ $msg = "after call to check_loadobjects_are_elf forced";
+ $msg .= " elf_loadobjects_found = $elf_loadobjects_found";
+ gp_message ("debugXL", $subr_name, $msg);
+
$g_html_credits_line = ${ create_html_credits () };
- gp_message ("debugXL", $subr_name, "g_html_credits_line = $g_html_credits_line");
+
+ $msg = "g_html_credits_line = $g_html_credits_line";
+ gp_message ("debugXL", $subr_name, $msg);
+
#------------------------------------------------------------------------------
# Add a "/" to simplify the construction of path names in the remainder.
#
@@ -841,7 +915,7 @@ sub main
$detail_metrics_system = 'e.totalcpu:e.system';
$call_metrics = 'a.totalcpu';
- my $cmd_options;
+ my $cmd_options;
my $metrics_cmd;
my $outfile1 = $outputdir ."metrics";
@@ -853,9 +927,11 @@ sub main
# to get all the output in files $outfile1 and $outfile2. These are then
# parsed.
#------------------------------------------------------------------------------
- gp_message ("verbose", $subr_name, "Gather the metrics data from the experiments");
+ $msg = "gather the metrics data from the experiments";
+ gp_message ("verbose", $subr_name, $msg);
- $return_code = get_metrics_data (\@exp_dir_list, $outputdir, $outfile1, $outfile2, $gp_error_file);
+ $return_code = get_metrics_data (\@exp_dir_list, $outputdir, $outfile1,
+ $outfile2, $gp_error_file);
if ($return_code != 0)
{
@@ -865,8 +941,11 @@ sub main
#------------------------------------------------------------------------------
# TBD: Test this code
#------------------------------------------------------------------------------
- open (METRICS, "<", $outfile1)
- or die ("$subr_name - unable to open metric value data file $outfile1 for reading: '$!'");
+ $msg = "unable to open metric value data file $outfile1 for reading:";
+ open (METRICS, "<", $outfile1)
+ or die ($subr_name . " - " . $msg . " " . $!);
+
+ $msg = "opened file $outfile1 for reading";
gp_message ("debug", $subr_name, "opened file $outfile1 for reading");
chomp (@metrics_data = <METRICS>);
@@ -874,7 +953,8 @@ sub main
for my $i (keys @metrics_data)
{
- gp_message ("debugXL", $subr_name, "metrics_data[$i] = $metrics_data[$i]");
+ $msg = "metrics_data[$i] = " . $metrics_data[$i];
+ gp_message ("debugXL", $subr_name, $msg);
}
#------------------------------------------------------------------------------
@@ -888,7 +968,7 @@ sub main
{
gp_message ("verbose", $subr_name, "Process the metrics data");
- ($metric_value_ref, $metric_description_ref, $metric_found_ref,
+ ($metric_value_ref, $metric_description_ref, $metric_found_ref,
$user_metrics, $system_metrics, $wall_metrics,
$summary_metrics, $detail_metrics, $detail_metrics_system, $call_metrics
) = process_metrics_data ($outfile1, $outfile2, \%ignored_metrics);
@@ -898,14 +978,19 @@ sub main
%metric_found = %{ $metric_found_ref };
%metric_description_reversed = reverse %metric_description;
- gp_message ("debugXL", $subr_name, "after the call to process_metrics_data");
+ $msg = "after the call to process_metrics_data";
+ gp_message ("debugXL", $subr_name, $msg);
+
for my $metric (sort keys %metric_value)
{
- gp_message ("debugXL", $subr_name, "metric_value{$metric} = $metric_value{$metric}");
+ $msg = "metric_value{$metric} = " . $metric_value{$metric};
+ gp_message ("debugXL", $subr_name, $msg);
}
for my $metric (sort keys %metric_description)
{
- gp_message ("debugXL", $subr_name, "metric_description{$metric} = $metric_description{$metric}");
+ $msg = "metric_description{$metric} =";
+ $msg .= " " . $metric_description{$metric};
+ gp_message ("debugXL", $subr_name, $msg);
}
gp_message ("debugXL", $subr_name, "user_metrics = $user_metrics");
gp_message ("debugXL", $subr_name, "system_metrics = $system_metrics");
@@ -918,9 +1003,10 @@ sub main
#
# TBD: These should be OS dependent.
#------------------------------------------------------------------------------
- gp_message ("verbose", $subr_name, "Select the set of default metrics");
+ $msg = "select the set of default metrics";
+ gp_message ("verbose", $subr_name, $msg);
- ($metric_description_ref, $metric_found_ref, $summary_metrics,
+ ($metric_description_ref, $metric_found_ref, $summary_metrics,
$detail_metrics, $detail_metrics_system, $call_metrics
) = set_default_metrics ($outfile1, \%ignored_metrics);
@@ -929,51 +1015,54 @@ sub main
%metric_found = %{ $metric_found_ref };
%metric_description_reversed = reverse %metric_description;
- gp_message ("debug", $subr_name, "after the call to set_default_metrics");
+ $msg = "after the call to set_default_metrics";
+ gp_message ("debug", $subr_name, $msg);
}
$number_of_metrics = split (":", $summary_metrics);
- gp_message ("debugXL", $subr_name, "summary_metrics = $summary_metrics");
- gp_message ("debugXL", $subr_name, "detail_metrics = $detail_metrics");
- gp_message ("debugXL", $subr_name, "detail_metrics_system = $detail_metrics_system");
- gp_message ("debugXL", $subr_name, "call_metrics = $call_metrics");
- gp_message ("debugXL", $subr_name, "number_of_metrics = $number_of_metrics");
+ $msg = "summary_metrics = " . $summary_metrics;
+ gp_message ("debugXL", $subr_name, $msg);
+ $msg = "detail_metrics = " . $detail_metrics;
+ gp_message ("debugXL", $subr_name, $msg);
+ $msg = "detail_metrics_system = " . $detail_metrics_system;
+ gp_message ("debugXL", $subr_name, $msg);
+ $msg = "call_metrics = " . $call_metrics;
+ gp_message ("debugXL", $subr_name, $msg);
+ $msg = "number_of_metrics = " . $number_of_metrics;
+ gp_message ("debugXL", $subr_name, $msg);
#------------------------------------------------------------------------------
# TBD Find a way to better handle this situation:
#------------------------------------------------------------------------------
for my $im (keys %metric_found)
{
- gp_message ("debugXL", $subr_name, "metric_found{$im} = $metric_found{$im}");
+ $msg = "metric_found{$im} = " . $metric_found{$im};
+ gp_message ("debugXL", $subr_name, $msg);
}
for my $im (keys %ignored_metrics)
{
if (not exists ($metric_found{$im}))
{
- gp_message ("debugXL", $subr_name, "user requested ignored metric (-im) $im does not exist in collected metrics");
+ $msg = "user requested ignored metric (-im) $im does not exist in";
+ $msg .= " collected metrics";
+ gp_message ("debugXL", $subr_name, $msg);
}
}
#------------------------------------------------------------------------------
# Get the information on the experiments.
#------------------------------------------------------------------------------
- gp_message ("verbose", $subr_name, "Generate the experiment information");
-
- my $exp_info_file_ref;
- my $exp_info_file;
- my $exp_info_ref;
- my @exp_info;
-
- my $experiment_data_ref;
+ $msg = "generate the experiment information";
+ gp_message ("verbose", $subr_name, $msg);
- $experiment_data_ref = get_experiment_info (\$outputdir, \@exp_dir_list);
- my @experiment_data = @{ $experiment_data_ref };
+ my $experiment_data_ref = get_experiment_info (\$outputdir, \@exp_dir_list);
+ @experiment_data = @{ $experiment_data_ref };
for my $i (sort keys @experiment_data)
{
- my $msg = "i = $i " . $experiment_data[$i]{"exp_id"} . " => " .
+ my $msg = "i = $i " . $experiment_data[$i]{"exp_id"} . " => " .
$experiment_data[$i]{"exp_name_full"};
gp_message ("debugM", $subr_name, $msg);
}
@@ -991,21 +1080,21 @@ sub main
}
}
- @g_html_experiment_stats = @{ create_exp_info (
- \@exp_dir_list,
- \@experiment_data) };
+ @g_html_experiment_stats = @{ create_exp_info (\@exp_dir_list,
+ \@experiment_data) };
- $table_execution_stats_ref = html_generate_exp_summary (
- \$outputdir,
- \@experiment_data);
+ $table_execution_stats_ref = html_generate_exp_summary (\$outputdir,
+ \@experiment_data);
@table_execution_stats = @{ $table_execution_stats_ref };
#------------------------------------------------------------------------------
# Get the function overview.
#------------------------------------------------------------------------------
- gp_message ("verbose", $subr_name, "Generate the list with functions executed");
+ $msg = "generate the list with functions executed";
+ gp_message ("verbose", $subr_name, $msg);
- my ($outfile, $sort_fields_ref) = get_hot_functions (\@exp_dir_list, $summary_metrics, $outputdir);
+ my ($outfile, $sort_fields_ref) =
+ get_hot_functions (\@exp_dir_list, $summary_metrics, $outputdir);
@sort_fields = @{$sort_fields_ref};
@@ -1013,11 +1102,12 @@ sub main
# Parse the output from the fsummary command and store the relevant data for
# all the functions listed there.
#------------------------------------------------------------------------------
+ $msg = "analyze and store the relevant function information";
+ gp_message ("verbose", $subr_name, $msg);
- gp_message ("verbose", $subr_name, "Analyze and store the relevant function information");
-
- ($function_info_ref, $function_address_and_index_ref, $addressobjtextm_ref,
- $LINUX_vDSO_ref, $function_view_structure_ref) = get_function_info ($outfile);
+ ($function_info_ref, $function_address_and_index_ref, $addressobjtextm_ref,
+ $LINUX_vDSO_ref, $function_view_structure_ref) =
+ get_function_info ($outfile);
@function_info = @{ $function_info_ref };
%function_address_and_index = %{ $function_address_and_index_ref };
@@ -1029,194 +1119,215 @@ sub main
{
for my $fields (keys %{$function_info[$keys]})
{
- gp_message ("debugXL", $subr_name,"$keys $fields $function_info[$keys]{$fields}");
+ $msg = "$keys $fields $function_info[$keys]{$fields}";
+ gp_message ("debugXL", $subr_name, $msg);
}
}
for my $i (keys %addressobjtextm)
{
- gp_message ("debugXL", $subr_name,"addressobjtextm{$i} = $addressobjtextm{$i}");
+ $msg = "addressobjtextm{$i} = " . $addressobjtextm{$i};
+ gp_message ("debugXL", $subr_name, $msg);
}
- gp_message ("verbose", $subr_name, "Generate the files with function overviews and the callers-callees information");
+ $msg = "generate the files with function overviews and the";
+ $msg .= " callers-callees information";
+ gp_message ("verbose", $subr_name, $msg);
- $script_pc_metrics = generate_function_level_info (\@exp_dir_list,
- $call_metrics,
- $summary_metrics,
- $outputdir,
+ $script_pc_metrics = generate_function_level_info (\@exp_dir_list,
+ $call_metrics,
+ $summary_metrics,
+ $outputdir,
$sort_fields_ref);
- gp_message ("verbose", $subr_name, "Preprocess the files with the function level information");
+ $msg = "preprocess the files with the function level information";
+ gp_message ("verbose", $subr_name, $msg);
$ignore_value = preprocess_function_files (
- $metric_description_ref,
- $script_pc_metrics,
- $outputdir,
+ $metric_description_ref,
+ $script_pc_metrics,
+ $outputdir,
\@sort_fields);
- gp_message ("verbose", $subr_name, "For each function, generate a set of files");
-
- ($function_info_ref, $function_address_info_ref, $addressobj_index_ref) = process_function_files (
- \@exp_dir_list,
- $executable_name,
- $time_percentage_multiplier,
- $summary_metrics,
- $process_all_functions,
- $elf_loadobjects_found,
- $outputdir,
- \@sort_fields,
- \@function_info,
- \%function_address_and_index,
- \%LINUX_vDSO,
- \%metric_description,
- $elf_arch,
- $base_va_executable,
- $ARCHIVES_MAP_NAME, $ARCHIVES_MAP_VADDR, \%elf_rats);
+ $msg = "for each function, generate a set of files";
+ gp_message ("verbose", $subr_name, $msg);
+
+ ($function_info_ref, $function_address_info_ref, $addressobj_index_ref) =
+ process_function_files (\@exp_dir_list,
+ $executable_name,
+ $time_percentage_multiplier,
+ $summary_metrics,
+ $process_all_functions,
+ $elf_loadobjects_found,
+ $outputdir,
+ \@sort_fields,
+ \@function_info,
+ \%function_address_and_index,
+ \%LINUX_vDSO,
+ \%metric_description,
+ $elf_arch,
+ $base_va_executable,
+ $ARCHIVES_MAP_NAME,
+ $ARCHIVES_MAP_VADDR,
+ \%elf_rats);
@function_info = @{ $function_info_ref };
%function_address_info = %{ $function_address_info_ref };
%addressobj_index = %{ $addressobj_index_ref };
-#-------------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
# Parse the disassembly information and generate the html files.
-#-------------------------------------------------------------------------------------
- gp_message ("verbose", $subr_name, "Parse the disassembly files and generate the html files");
+#------------------------------------------------------------------------------
+ $msg = "parse the disassembly files and generate the html files";
+ gp_message ("verbose", $subr_name, $msg);
- $ignore_value = parse_dis_files (\$number_of_metrics, \@function_info,
- \%function_address_and_index,
- \$outputdir, \%addressobj_index);
+ $ignore_value = parse_dis_files (\$number_of_metrics,
+ \@function_info,
+ \%function_address_and_index,
+ \$outputdir,
+ \%addressobj_index);
-#-------------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
# Parse the source information and generate the html files.
-#-------------------------------------------------------------------------------------
- gp_message ("verbose", $subr_name, "Parse the source files and generate the html files");
+#------------------------------------------------------------------------------
+ $msg = "parse the source files and generate the html files";
+ gp_message ("verbose", $subr_name, $msg);
parse_source_files (\$number_of_metrics, \@function_info, \$outputdir);
-#-------------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
# Parse the caller-callee information and generate the html files.
-#-------------------------------------------------------------------------------------
- gp_message ("verbose", $subr_name, "Process the caller-callee information and generate the html file");
+#------------------------------------------------------------------------------
+ $msg = "process the caller-callee information and generate the html file";
+ gp_message ("verbose", $subr_name, $msg);
-#-------------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
# Generate the caller-callee information.
-#-------------------------------------------------------------------------------------
- $ignore_value = generate_caller_callee (
- \$number_of_metrics,
- \@function_info,
- \%function_view_structure,
- \%function_address_info,
- \%addressobjtextm,
- \$outputdir);
-
-#-------------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
+ $ignore_value = generate_caller_callee (\$number_of_metrics,
+ \@function_info,
+ \%function_view_structure,
+ \%function_address_info,
+ \%addressobjtextm,
+ \$outputdir);
+
+#------------------------------------------------------------------------------
# Parse the calltree information and generate the html files.
-#-------------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
if ($g_user_settings{"calltree"}{"current_value"} eq "on")
{
- my $msg = "Process the call tree information and generate the html file";
+ $msg = "process the call tree information and generate the html file";
gp_message ("verbose", $subr_name, $msg);
- $ignore_value = process_calltree (
- \@function_info,
- \%function_address_info,
- \%addressobjtextm,
- $outputdir);
+ $ignore_value = process_calltree (\@function_info,
+ \%function_address_info,
+ \%addressobjtextm,
+ $outputdir);
}
-#-------------------------------------------------------------------------------------
-# TBD
-#-------------------------------------------------------------------------------------
- gp_message ("verbose", $subr_name, "Generate the html file with the metrics information");
+#------------------------------------------------------------------------------
+# Process the metric values.
+#------------------------------------------------------------------------------
+ $msg = "generate the html file with the metrics information";
+ gp_message ("verbose", $subr_name, $msg);
- $ignore_value = process_metrics (
- $outputdir,
- \@sort_fields,
- \%metric_description,
- \%ignored_metrics);
+ $ignore_value = process_metrics ($outputdir,
+ \@sort_fields,
+ \%metric_description,
+ \%ignored_metrics);
-#-------------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
# Generate the function view html files.
-#-------------------------------------------------------------------------------------
- gp_message ("verbose", $subr_name, "Generate the function view html files");
+#------------------------------------------------------------------------------
+ $msg = "generate the function view html files";
+ gp_message ("verbose", $subr_name, $msg);
$html_first_metric_file_ref = generate_function_view (
- \$outputdir,
- \$summary_metrics,
- \$number_of_metrics,
- \@function_info,
- \%function_view_structure,
- \%function_address_info,
- \@sort_fields,
- \@exp_dir_list,
- \%addressobjtextm);
+ \$outputdir,
+ \$summary_metrics,
+ \$number_of_metrics,
+ \@function_info,
+ \%function_view_structure,
+ \%function_address_info,
+ \@sort_fields,
+ \@exp_dir_list,
+ \%addressobjtextm);
$html_first_metric_file = ${ $html_first_metric_file_ref };
- gp_message ("debugXL", $subr_name, "html_first_metric_file = $html_first_metric_file");
+ $msg = "html_first_metric_file = " . $html_first_metric_file;
+ gp_message ("debugXL", $subr_name, $msg);
- my $html_test = ${ generate_home_link ("left") };
- gp_message ("debugXL", $subr_name, "html_test = $html_test");
+ $html_test = ${ generate_home_link ("left") };
+ $msg = "html_test = " . $html_test;
+ gp_message ("debugXL", $subr_name, $msg);
- my $number_of_warnings_ref = create_html_warnings_page (\$outputdir);
+#------------------------------------------------------------------------------
+# Unconditionnaly generate the page with the warnings.
+#------------------------------------------------------------------------------
+ $ignore_value = html_create_warnings_page (\$outputdir);
-#-------------------------------------------------------------------------------------
+#------------------------------------------------------------------------------
# Generate the index.html file.
-#-------------------------------------------------------------------------------------
- gp_message ("verbose", $subr_name, "Generate the index.html file");
-
- $ignore_value = generate_index (\$outputdir,
- \$html_first_metric_file,
- \$summary_metrics,
- \$number_of_metrics,
- \@function_info,
- \%function_address_info,
- \@sort_fields,
- \@exp_dir_list,
- \%addressobjtextm,
- \%metric_description_reversed,
- $number_of_warnings_ref,
- \@table_execution_stats);
-
-#-------------------------------------------------------------------------------------
-# We're done. In debug mode, print the meta data for the experiment directories.
-#-------------------------------------------------------------------------------------
- $ignore_value = print_meta_data_experiments ("debug");
-
- my $results_file = $abs_path_outputdir . "/index.html";
- my $prologue_text = "Processing completed - view file $results_file in a browser";
- gp_message ("diag", $subr_name, $prologue_text);
-
- return (0);
+#------------------------------------------------------------------------------
+ $msg = "generate the index.html file";
+ gp_message ("verbose", $subr_name, $msg);
-} #-- End of subroutine main
+ $ignore_value = html_generate_index (\$outputdir,
+ \$html_first_metric_file,
+ \$summary_metrics,
+ \$number_of_metrics,
+ \@function_info,
+ \%function_address_info,
+ \@sort_fields,
+ \@exp_dir_list,
+ \%addressobjtextm,
+ \%metric_description_reversed,
+ \@table_execution_stats);
#------------------------------------------------------------------------------
-# Print a message after a failure in $GP_DISPLAY_TEXT.
+# We're done. In debug mode, print the meta data for the experiment
+# directories.
#------------------------------------------------------------------------------
-sub msg_display_text_failure
-{
- my $subr_name = get_my_name ();
-
- my ($gp_display_text_cmd, $error_code, $error_file) = @_;
-
- my $msg;
+ $ignore_value = print_meta_data_experiments ("debug");
- $msg = "error code = $error_code - failure executing the following command:";
- gp_message ("error", $subr_name, $msg);
+#------------------------------------------------------------------------------
+# Before the execution completes, print the warning(s) on the screen.
+#
+# Note that this assumes that no additional warnings have been created since
+# the call to html_create_warnings_page. Otherwise there will be a discrepancy
+# between what is printed on the screen and shown in the warnings.html page.
+#------------------------------------------------------------------------------
+ if (($g_total_warning_count > 0) and ($g_warnings))
+ {
+ $ignore_value = print_warnings_buffer ();
+ @g_warning_msgs = ();
+ }
- gp_message ("error", $subr_name, $gp_display_text_cmd);
+#------------------------------------------------------------------------------
+# This is not supposed to happen, but in case there are any fatal errors that
+# have not caused the execution to terminate, print them here.
+#------------------------------------------------------------------------------
+ if (@g_error_msgs)
+ {
+ $ignore_value = print_errors_buffer (\$g_error_keyword);
+ }
- $msg = "check file $error_file for more details";
- gp_message ("error", $subr_name, $msg);
+#------------------------------------------------------------------------------
+# One line message to show where the results can be found.
+#------------------------------------------------------------------------------
+ my $results_file = $abs_path_outputdir . "/index.html";
+ my $prologue_text = "Processing completed - view file $results_file" .
+ " in a browser";
+ gp_message ("diag", $subr_name, $prologue_text);
return (0);
-} #-- End of subroutine msg_display_text_failure
+} #-- End of subroutine main
#------------------------------------------------------------------------------
# If it is not present, add a "/" to the name of the argument. This is
-# intended to be used for the name of the output directory and makes it
+# intended to be used for the name of the output directory and makes it
# easier to construct pathnames.
#------------------------------------------------------------------------------
sub append_forward_slash
@@ -1228,7 +1339,7 @@ sub append_forward_slash
my $length_of_string = length ($input_string);
my $return_string = $input_string;
- if (rindex ($input_string, "/") != $length_of_string-1)
+ if (rindex ($input_string, "/") != $length_of_string-1)
{
$return_string .= "/";
}
@@ -1255,7 +1366,7 @@ sub build_pretty_dir_list
} #-- End of subroutine build_pretty_dir_list
#------------------------------------------------------------------------------
-# Calculate the target address in hex by adding the instruction to the
+# Calculate the target address in hex by adding the instruction to the
# instruction address.
#------------------------------------------------------------------------------
sub calculate_target_hex_address
@@ -1264,14 +1375,15 @@ sub calculate_target_hex_address
my ($instruction_address, $instruction_offset) = @_;
- my $dec_branch_target;
+ my $dec_branch_target;
my $d1;
my $d2;
my $first_char;
my $length_of_string;
my $mask;
+ my $msg;
my $number_of_fields;
- my $raw_hex_branch_target;
+ my $raw_hex_branch_target;
my $result;
if ($g_addressing_mode eq "64 bit")
@@ -1281,10 +1393,11 @@ sub calculate_target_hex_address
}
else
{
- gp_message ("abort", $subr_name, "g_addressing_mode = $g_addressing_mode not supported\n");
+ $msg = "g_addressing_mode = $g_addressing_mode not supported";
+ gp_message ("abort", $subr_name, $msg);
}
-
- $length_of_string = length ($instruction_offset);
+
+ $length_of_string = length ($instruction_offset);
$first_char = lcfirst (substr ($instruction_offset,0,1));
$d1 = bigint::hex ($instruction_offset);
$d2 = bigint::hex ($mask);
@@ -1315,11 +1428,15 @@ sub calculate_target_hex_address
} #-- End of subroutine calculate_target_hex_address
#------------------------------------------------------------------------------
-# Sets the absolute path to all commands in array @cmds. The commands and
-# their respective paths are stored in hash "g_mapped_cmds".
+# Sets the absolute path to all commands in array @cmds.
+#
+# First, it is checked if the command is in the search path, built-in, or an
+# alias. If this is not the case, search for it in a couple of locations.
+#
+# If this all fails, warning messages are printed, but this is not a hard
+# error. Yet. Most likely, things will go bad later on.
#
-# If no such mapping is found, a warning is issued, but execution continues.
-# The warning(s) may help with troubleshooting, should a failure occur later.
+# The commands and their respective paths are stored in hash "g_mapped_cmds".
#------------------------------------------------------------------------------
sub check_and_define_cmds
{
@@ -1333,37 +1450,129 @@ sub check_and_define_cmds
my @cmds = @{$cmds_ref};
my @search_path = @{$search_path_ref};
- my $found_match;
- my $target_cmd;
- my $failed_cmd;
- my $no_of_failed_mappings;
+ my @the_fields = ();
+
+ my $cmd;
+ my $cmd_found;
+ my $error_code;
+ my $failed_cmd;
my $failed_cmds;
+ my $found_match;
+ my $mapped;
+ my $msg;
+ my $no_of_failed_mappings;
+ my $no_of_fields;
+ my $output_cmd;
+ my $target_cmd;
+ my $failed_mapping = $FALSE;
+ my $full_path_cmd;
- gp_message ("debug", $subr_name, "\@cmds = @cmds");
- gp_message ("debug", $subr_name, "\@search_path = @search_path");
+ gp_message ("debugXL", $subr_name, "\@cmds = @cmds");
+ gp_message ("debugXL", $subr_name, "\@search_path = @search_path");
#------------------------------------------------------------------------------
-# Search for the command to be in the search path given. In case no such path
+# Search for the command and record the absolute path. In case no such path
# can be found, the entry in $g_mapped_cmds is assigned a special value that
# will be checked for in the next block.
#------------------------------------------------------------------------------
- for my $cmd (@cmds)
+ for $cmd (@cmds)
{
- $found_match = $FALSE;
- for my $path (@search_path)
+ $target_cmd = "(command -v $cmd; echo \$\?)";
+
+ ($error_code, $output_cmd) = execute_system_cmd ($target_cmd);
+
+ if ($error_code != 0)
+#------------------------------------------------------------------------------
+# This is unlikely to happen, since it means the command executed failed.
+#------------------------------------------------------------------------------
+ {
+ $msg = "error executing this command: " . $target_cmd;
+ gp_message ("warning", $subr_name, $msg);
+ $msg = "execution continues, but may fail later on";
+ gp_message ("warning", $subr_name, $msg);
+
+ $g_total_warning_count++;
+ }
+ else
+#------------------------------------------------------------------------------
+# So far, all is well, but is the target command available?
+#------------------------------------------------------------------------------
{
- $target_cmd = $path . "/" . $cmd;
- if (-x $target_cmd)
+#------------------------------------------------------------------------------
+# The output from the $target_cmd command should contain 2 lines in case the
+# command has been found. The first line shows the command with the full
+# path, while the second line has the exit code.
+#
+# If the exit code is not zero, the command has not been found.
+#------------------------------------------------------------------------------
+
+#------------------------------------------------------------------------------
+# Split the output at the \n character and check the number of lines as
+# well as the return code.
+#------------------------------------------------------------------------------
+ @the_fields = split ("\n", $output_cmd);
+ $no_of_fields = scalar (@the_fields);
+ $cmd_found = ($the_fields[$no_of_fields-1] == 0 ? $TRUE : $FALSE);
+
+#------------------------------------------------------------------------------
+# This is unexpected. Throw an assertion error and bail out.
+#------------------------------------------------------------------------------
+ if ($no_of_fields > 2)
{
- $found_match = $TRUE;
- $g_mapped_cmds{$cmd} = $target_cmd;
- last;
+ gp_message ("error", $subr_name, "output from $target_cmd:");
+ gp_message ("error", $subr_name, $output_cmd);
+
+ $msg = "the output from $target_cmd has more than 2 lines";
+ gp_message ("assertion", $subr_name, $msg);
}
- }
- if (not $found_match)
- {
- $g_mapped_cmds{$cmd} = "road_to_nowhere";
+ if ($cmd_found)
+ {
+ $full_path_cmd = $the_fields[0];
+#------------------------------------------------------------------------------
+# The command is in the search path. Store the full path to the command.
+#------------------------------------------------------------------------------
+ $msg = "the $cmd command is in the search path";
+ gp_message ("debug", $subr_name, $msg);
+
+ $g_mapped_cmds{$cmd} = $full_path_cmd;
+ }
+ else
+#------------------------------------------------------------------------------
+# A best effort to locate the command elsewhere. If found, store the command
+# with the absolute path included. Otherwise print a warning, but continue.
+#------------------------------------------------------------------------------
+ {
+ $msg = "the $cmd command is not in the search path";
+ $msg .= " - start a best effort search to find it";
+ gp_message ("debug", $subr_name, $msg);
+
+ $found_match = $FALSE;
+ for my $path (@search_path)
+ {
+ $target_cmd = $path . "/" . $cmd;
+ if (-x $target_cmd)
+ {
+ $msg = "found the command in $path";
+ gp_message ("debug", $subr_name, $msg);
+
+ $found_match = $TRUE;
+ $g_mapped_cmds{$cmd} = $target_cmd;
+ last;
+ }
+ else
+ {
+ $msg = "failure to find the $cmd command in $path";
+ gp_message ("debug", $subr_name, $msg);
+ }
+ }
+
+ if (not $found_match)
+ {
+ $g_mapped_cmds{$cmd} = "road to nowhere";
+ $failed_mapping = $TRUE;
+ }
+ }
}
}
@@ -1372,26 +1581,50 @@ sub check_and_define_cmds
#------------------------------------------------------------------------------
$no_of_failed_mappings = 0;
$failed_cmds = "";
- while ( my ($cmd, $mapped) = each %g_mapped_cmds)
+
+#------------------------------------------------------------------------------
+# Print a warning message before showing the results, that at least one search
+# has failed.
+#------------------------------------------------------------------------------
+ if ($failed_mapping)
+ {
+ $msg = "<br>" . "failure in the verification of the OS commands:";
+ gp_message ("warning", $subr_name, $msg);
+ }
+
+ while ( ($cmd, $mapped) = each %g_mapped_cmds)
{
- if ($mapped eq "road_to_nowhere")
+ if ($mapped eq "road to nowhere")
{
- my $msg = "cannot find a path for command $cmd - " .
- "assume this will still work without a path";
+ $msg = "cannot find a path for command $cmd";
gp_message ("warning", $subr_name, $msg);
- $no_of_failed_mappings++;
- $failed_cmds .= $cmd;
+ gp_message ("debug", $subr_name, $msg);
+
+ $no_of_failed_mappings++;
+ $failed_cmds .= $cmd;
$g_mapped_cmds{$cmd} = $cmd;
}
else
{
- gp_message ("debug", $subr_name, "path for the $cmd command is $mapped");
+ $msg = "path for the $cmd command is $mapped";
+ gp_message ("debug", $subr_name, $msg);
}
}
if ($no_of_failed_mappings != 0)
{
- gp_message ("debug", $subr_name, "failed to find a mapping for $failed_cmds");
- gp_message ("debug", $subr_name, "a total of $no_of_failed_mappings mapping failures");
+ my $plural_1 = ($no_of_failed_mappings > 1) ? "failures" : "failure";
+ my $plural_2 = ($no_of_failed_mappings > 1) ? "commands" : "command";
+
+ $msg = "encountered $no_of_failed_mappings $plural_1 to locate";
+ $msg .= " selected " . $plural_2;
+ gp_message ("warning", $subr_name, $msg);
+ gp_message ("debug", $subr_name, $msg);
+
+ $msg = "execution continues, but may fail later on";
+ gp_message ("warning", $subr_name, $msg);
+ gp_message ("debug", $subr_name, $msg);
+
+ $g_total_warning_count++;
}
return ($no_of_failed_mappings);
@@ -1423,7 +1656,7 @@ sub check_and_proc_dis_branches
my $msg;
my $raw_hex_branch_target;
- if ( ($input_line =~ /$g_branch_regex/)
+ if ( ($input_line =~ /$g_branch_regex/)
or ($input_line =~ /$g_endbr_regex/))
{
if (defined ($3))
@@ -1451,12 +1684,13 @@ sub check_and_proc_dis_branches
#------------------------------------------------------------------------------
$instruction_offset = $3;
$raw_hex_branch_target = calculate_target_hex_address (
- $instruction_address,
- $instruction_offset);
+ $instruction_address,
+ $instruction_offset);
$hex_branch_target = "0x" . $raw_hex_branch_target;
$branch_target{$hex_branch_target} = 1;
- $extended_branch_target{$instruction_address} = $raw_hex_branch_target;
+ $extended_branch_target{$instruction_address} =
+ $raw_hex_branch_target;
}
if (defined ($2) and (not defined ($3)))
{
@@ -1482,7 +1716,8 @@ sub check_and_proc_dis_branches
# TBD: Perhaps this should be an assertion or alike.
#------------------------------------------------------------------------------
$branch_target{"0x0000"} = $FALSE;
- gp_message ("debug", $subr_name, "cannot determine branch target");
+ $msg = "cannot determine branch target";
+ gp_message ("debug", $subr_name, $msg);
}
}
else
@@ -1512,11 +1747,11 @@ sub check_and_proc_dis_func_call
my %extended_branch_target = %{ $extended_branch_target_ref };
my $found_it = $TRUE;
- my $hex_branch_target;
+ my $hex_branch_target;
my $instruction_address;
my $instruction_offset;
my $msg;
- my $raw_hex_branch_target;
+ my $raw_hex_branch_target;
if ( $input_line =~ /$g_function_call_v2_regex/ )
{
@@ -1558,8 +1793,8 @@ sub check_and_proc_dis_func_call
# address.
#------------------------------------------------------------------------------
$raw_hex_branch_target = calculate_target_hex_address (
- $instruction_address,
- $instruction_offset);
+ $instruction_address,
+ $instruction_offset);
$hex_branch_target = "0x" . $raw_hex_branch_target;
$msg = "calculated hex_branch_target = " .
@@ -1567,12 +1802,13 @@ sub check_and_proc_dis_func_call
gp_message ("debugXL", $subr_name, $msg);
$branch_target{$hex_branch_target} = 1;
- $extended_branch_target{$instruction_address} = $raw_hex_branch_target;
+ $extended_branch_target{$instruction_address} =
+ $raw_hex_branch_target;
$msg = "set branch_target{$hex_branch_target} to 1";
gp_message ("debugXL", $subr_name, $msg);
- $msg = "added extended_branch_target{$instruction_address}" .
- " = $extended_branch_target{$instruction_address}";
+ $msg = "added extended_branch_target{$instruction_address}";
+ $msg .= " = $extended_branch_target{$instruction_address}";
gp_message ("debugXL", $subr_name, $msg);
}
else
@@ -1593,11 +1829,77 @@ sub check_and_proc_dis_func_call
} #-- End of subroutine check_and_proc_dis_func_call
#------------------------------------------------------------------------------
-# Check for the $GP_DISPLAY_TEXT tool to be available. This is a critical tool
-# needed to provide the information. If it can not be found, execution is
+# Check if the value for the user option given is valid.
+#
+# In case the value is valid, the g_user_settings table is updated with the
+# (new) value.
+#
+# Otherwise an error message is pushed into the g_error_msgs buffer.
+#
+# The return value is TRUE/FALSE.
+#------------------------------------------------------------------------------
+sub check_and_set_user_option
+{
+ my $subr_name = get_my_name ();
+
+ my ($internal_opt_name, $value) = @_;
+
+ my $msg;
+ my $valid;
+ my $option_value_missing;
+
+ my $option = $g_user_settings{$internal_opt_name}{"option"};
+ my $data_type = $g_user_settings{$internal_opt_name}{"data_type"};
+ my $no_of_args = $g_user_settings{$internal_opt_name}{"no_of_arguments"};
+
+ if (($no_of_args >= 1) and
+ ((not defined ($value)) or (length ($value) == 0)))
+#------------------------------------------------------------------------------
+# If there was no value given, but it is required, flag an error.
+# There could also be a value, but it might be the empty string.
+#
+# Note that that there are currently no options with multiple values. Should
+# these be introduced, the current check may need to be refined.
+#------------------------------------------------------------------------------
+ {
+ $valid = $FALSE;
+ $option_value_missing = $TRUE;
+ }
+ elsif ($no_of_args >= 1)
+ {
+ $option_value_missing = $FALSE;
+#------------------------------------------------------------------------------
+# There is an input value. Check if it is valid and if so, store it.
+#
+# Note that we allow the options to be case insensitive.
+#------------------------------------------------------------------------------
+ $valid = verify_if_input_is_valid ($value, $data_type);
+
+ if ($valid)
+ {
+ if (($data_type eq "onoff") or ($data_type eq "size"))
+ {
+ $g_user_settings{$internal_opt_name}{"current_value"} =
+ lc ($value);
+ }
+ else
+ {
+ $g_user_settings{$internal_opt_name}{"current_value"} = $value;
+ }
+ $g_user_settings{$internal_opt_name}{"defined"} = $TRUE;
+ }
+ }
+
+ return (\$valid, \$option_value_missing);
+
+} #-- End of subroutine check_and_set_user_option
+
+#------------------------------------------------------------------------------
+# Check for the $GP_DISPLAY_TEXT tool to be available. This is a critical tool
+# needed to provide the information. If it can not be found, execution is
# terminated.
#
-# We first search foe this tool in the current execution directory. If it
+# We first search for this tool in the current execution directory. If it
# cannot be found there, use $PATH to try to locate it.
#------------------------------------------------------------------------------
sub check_availability_tool
@@ -1608,6 +1910,7 @@ sub check_availability_tool
my $error_code;
my $error_occurred;
+ my $gp_path;
my $msg;
my $output_which_gp_display_text;
my $return_value;
@@ -1616,23 +1919,24 @@ sub check_availability_tool
#------------------------------------------------------------------------------
# Get the path to gp-display-text.
#------------------------------------------------------------------------------
- my ($error_occurred_ref, $return_value_ref) = find_path_to_gp_display_text (
- $location_gp_command_ref
- );
- $error_occurred = ${ $error_occurred_ref};
+ my ($error_occurred_ref, $gp_path_ref, $return_value_ref) =
+ find_path_to_gp_display_text ($location_gp_command_ref);
+
+ $error_occurred = ${ $error_occurred_ref};
+ $gp_path = ${ $gp_path_ref };
$return_value = ${ $return_value_ref};
$msg = "error_occurred = $error_occurred return_value = $return_value";
gp_message ("debugXL", $subr_name, $msg);
- if (not $error_occurred)
+ if (not $error_occurred)
#------------------------------------------------------------------------------
# All is well and gp-display-text has been located.
#------------------------------------------------------------------------------
{
$g_path_to_tools = $return_value;
- $msg = "located $GP_DISPLAY_TEXT in execution directory";
+ $msg = "located $GP_DISPLAY_TEXT in the execution directory";
gp_message ("debug", $subr_name, $msg);
$msg = "g_path_to_tools = $g_path_to_tools";
gp_message ("debug", $subr_name, $msg);
@@ -1643,42 +1947,49 @@ sub check_availability_tool
# $GP_DISPLAY_TEXT through the search path.
#------------------------------------------------------------------------------
{
- $msg = "error accessing $GP_DISPLAY_TEXT: $return_value - " .
- "run time behaviour may be undefined";
+ $msg = $g_html_new_line;
+ $msg .= "could not find $GP_DISPLAY_TEXT in directory $gp_path :";
+ $msg .= " $return_value";
gp_message ("warning", $subr_name, $msg);
-
+
#------------------------------------------------------------------------------
# Check if we can find $GP_DISPLAY_TEXT in the search path.
#------------------------------------------------------------------------------
- $msg = "check for $GP_DISPLAY_TEXT in search path";
+ $msg = "check for $GP_DISPLAY_TEXT to be in the search path";
gp_message ("debug", $subr_name, $msg);
+ gp_message ("warning", $subr_name, $msg);
+ $g_total_warning_count++;
+
$target_cmd = $g_mapped_cmds{"which"} . " $GP_DISPLAY_TEXT 2>&1";
- ($error_code, $output_which_gp_display_text) =
- execute_system_cmd ($target_cmd);
-
+ ($error_code, $output_which_gp_display_text) =
+ execute_system_cmd ($target_cmd);
+
if ($error_code == 0)
{
- my ($gp_file_name, $gp_path, $suffix_not_used) =
+ my ($gp_file_name, $gp_path, $suffix_not_used) =
fileparse ($output_which_gp_display_text);
$g_path_to_tools = $gp_path;
- $msg = "using $GP_DISPLAY_TEXT in $g_path_to_tools instead";
+ $msg = "located $GP_DISPLAY_TEXT in $g_path_to_tools";
+ gp_message ("warning", $subr_name, $msg);
+ $msg = "this is the version that will be used";
gp_message ("warning", $subr_name, $msg);
$msg = "the $GP_DISPLAY_TEXT tool is in the search path";
gp_message ("debug", $subr_name, $msg);
$msg = "g_path_to_tools = $g_path_to_tools";
gp_message ("debug", $subr_name, $msg);
- }
+ }
else
{
$msg = "failure to find $GP_DISPLAY_TEXT in the search path";
- gp_message ("debug", $subr_name, $msg);
+ gp_message ("error", $subr_name, $msg);
- $msg = "fatal error executing command $target_cmd";
- gp_message ("abort", $subr_name, $msg);
+ $g_total_error_count++;
+
+ gp_message ("abort", $subr_name, $g_abort_msg);
}
}
@@ -1690,7 +2001,7 @@ sub check_availability_tool
# This function determines whether load objects are in ELF format.
#
# Compared to the original code, any input value other than 2 or 3 is rejected
-# upfront. This not only reduces the nesting level, but also eliminates a
+# upfront. This not only reduces the nesting level, but also eliminates a
# possible bug.
#
# Also, by isolating the tests for the input files, another nesting level could
@@ -1702,17 +2013,23 @@ sub check_loadobjects_are_elf
my ($selected_archive) = @_;
+ my $event_kind_map_regex;
+ $event_kind_map_regex = '^<event kind="map"\s.*vaddr=';
+ $event_kind_map_regex .= '"0x([0-9a-fA-F]+)"\s+.*foffset=';
+ $event_kind_map_regex .= '"\+*0x([0-9a-fA-F]+)"\s.*modes=';
+ $event_kind_map_regex .= '"0x([0-9]+)"\s.*name="(.*)".*>$';
+
my $hostname_current = $local_system_config{"hostname_current"};
my $arch = $local_system_config{"processor"};
my $arch_uname_s = $local_system_config{"kernel_name"};
- my $extracted_information;
+ my $extracted_information;
my $elf_magic_number;
my $executable_name;
my $va_executable_in_hex;
-
+
my $arch_exp;
my $hostname_exp;
my $os_exp;
@@ -1722,19 +2039,21 @@ sub check_loadobjects_are_elf
my $rc_b;
my $file;
my $line;
+ my $msg;
my $name;
my $name_path;
my $foffset;
my $vaddr;
my $modes;
- my $path_to_map_file;
+ my $path_to_map_file;
my $path_to_log_file;
#------------------------------------------------------------------------------
# TBD: Parameterize and should be the first experiment directory from the list.
#------------------------------------------------------------------------------
- $path_to_log_file = $g_exp_dir_meta_data{$selected_archive}{"directory_path"};
+ $path_to_log_file =
+ $g_exp_dir_meta_data{$selected_archive}{"directory_path"};
$path_to_log_file .= $selected_archive;
$path_to_log_file .= "/log.xml";
@@ -1748,34 +2067,40 @@ sub check_loadobjects_are_elf
# This check can probably be removed since the presence of the log.xml file is
# checked for in an earlier phase.
#------------------------------------------------------------------------------
+ $msg = " - unable to open file $path_to_log_file for reading:";
open (LOG_XML, "<", $path_to_log_file)
- or die ("$subr_name - unable to open file $path_to_log_file for reading: '$!'");
- gp_message ("debug", $subr_name, "opened file $path_to_log_file for reading");
-
+ or die ($subr_name . $msg . " " . $!);
+
+ $msg = "opened file $path_to_log_file for reading";
+ gp_message ("debug", $subr_name, $msg);
+
while (<LOG_XML>)
{
$line = $_;
chomp ($line);
- gp_message ("debug", $subr_name, "read line: $line");
+ gp_message ("debugM", $subr_name, "read line: $line");
#------------------------------------------------------------------------------
# Search for the first line starting with "<system". Bail out if found and
# parsed. These are two examples:
-# <system hostname="ruud-vm" arch="x86_64" os="Linux 4.14.35-2025.400.8.el7uek.x86_64" pagesz="4096" npages="30871514">
-# <system hostname="sca-m88-092-pd0" arch="sun4v" os="SunOS 5.11" pagesz="8192" npages="602963968">
+# <system hostname="ruud-vm" arch="x86_64" \
+# os="Linux 4.14.35-2025.400.8.el7uek.x86_64" pagesz="4096" npages="30871514">
#------------------------------------------------------------------------------
if ($line =~ /^\s*<system\s+/)
{
- gp_message ("debug", $subr_name, "selected the following line from the log.xml file:");
- gp_message ("debug", $subr_name, "$line");
+ $msg = "selected the following line from the log.xml file:";
+ gp_message ("debugM", $subr_name, $msg);
+ gp_message ("debugM", $subr_name, "$line");
if ($line =~ /.*\s+hostname="([^"]+)/)
{
$hostname_exp = $1;
- gp_message ("debug", $subr_name, "extracted hostname_exp = $hostname_exp");
+ $msg = "extracted hostname_exp = " . $hostname_exp;
+ gp_message ("debugM", $subr_name, $msg);
}
if ($line =~ /.*\s+arch="([^"]+)/)
{
$arch_exp = $1;
- gp_message ("debug", $subr_name, "extracted arch_exp = $arch_exp");
+ $msg = "extracted arch_exp = " . $arch_exp;
+ gp_message ("debugM", $subr_name, $msg);
}
if ($line =~ /.*\s+os="([^"]+)/)
{
@@ -1787,7 +2112,8 @@ sub check_loadobjects_are_elf
{
$os_exp = $1;
}
- gp_message ("debug", $subr_name, "extracted os_exp = $os_exp");
+ $msg = "extracted os_exp = " . $os_exp;
+ gp_message ("debugM", $subr_name, $msg);
}
last;
}
@@ -1810,76 +2136,105 @@ sub check_loadobjects_are_elf
#TBD: THIS DOES NOT CHECK IF ELF IS FOUND!
if (($hostname_current eq $hostname_exp) and
- ($arch eq $arch_exp) and
+ ($arch eq $arch_exp) and
($arch_uname_s eq $os_exp))
{
- gp_message ("debug", $subr_name, "early return: the hostname, architecture and OS match the current system");
- gp_message ("debug", $subr_name, "FAKE THIS IS NOT THE CASE AND CONTINUE");
+ $msg = "early return: the hostname, architecture and OS match";
+ $msg .= " the current system";
+ gp_message ("debug", $subr_name, $msg);
+ $msg = "FAKE THIS IS NOT THE CASE AND CONTINUE";
+ gp_message ("debug", $subr_name, $msg);
# FAKE return ($TRUE);
}
if (not $g_exp_dir_meta_data{$selected_archive}{"archive_is_empty"})
{
- gp_message ("debug", $subr_name, "selected_archive = $selected_archive");
- for my $i (sort keys %{$g_exp_dir_meta_data{$selected_archive}{"archive_files"}})
+ $msg = "selected_archive = " . $selected_archive;
+ gp_message ("debug", $subr_name, $msg);
+ for my $i (sort keys
+ %{$g_exp_dir_meta_data{$selected_archive}{"archive_files"}})
{
- gp_message ("debug", $subr_name, "stored loadobject $i $g_exp_dir_meta_data{$selected_archive}{'archive_files'}{$i}");
+ $msg = "stored loadobject " . $i . " ";
+ $msg .= $g_exp_dir_meta_data{$selected_archive}{"archive_files"}{$i};
+ gp_message ("debug", $subr_name, $msg);
}
}
#------------------------------------------------------------------------------
# Check if the selected experiment directory has archived files in ELF format.
-# If not, use the information in map.xml to get the name of the executable
+# If not, use the information in map.xml to get the name of the executable
# and the virtual address.
#------------------------------------------------------------------------------
if ($g_exp_dir_meta_data{$selected_archive}{"archive_in_elf_format"})
{
- gp_message ("debug", $subr_name, "the files in directory $selected_archive/archives are in ELF format");
- gp_message ("debug", $subr_name, "IGNORE THIS AND USE MAP.XML");
+ $msg = "the files in directory $selected_archive/archives are in";
+ $msg .= " ELF format";
+ gp_message ("debugM", $subr_name, $msg);
+ $msg =[...]
[diff truncated at 100000 bytes]
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-11-29 18:45 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-11-29 18:45 [binutils-gdb] gprofng: support GNU option syntax in gp-display-html, plus various fixes Vladimir Mezentsev
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).