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 = "
"; + #------------------------------------------------------------------------------ # 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*'; + 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_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_warning_messages = (); +my @g_error_msgs = (); +my @g_warning_msgs = (); +my $g_total_error_count = 0; +#------------------------------------------------------------------------------ +# 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 $pretty_dir_list; + my $html_test; + my @experiment_data; + my $exp_info_file; + my $exp_info_ref; + my @exp_info; + + 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 +# The final settings for verbose, debug, warnings and quiet are known and the +# gp_message() subroutine is aware of these. +#------------------------------------------------------------------------------ + $msg = "parsing of the user options completed"; + gp_message ("verbose", $subr_name, $msg); + +#------------------------------------------------------------------------------ +# The user options have been taken in. Check for validity and consistency. +#------------------------------------------------------------------------------ + $msg = "process user options"; + gp_message ("verbose", $subr_name, $msg); + + ($ignored_metrics_ref, $outputdir, + $time_percentage_multiplier, $process_all_functions, $exp_dir_list_ref) = + process_user_options (\@exp_dir_list); + + @exp_dir_list = @{ $exp_dir_list_ref }; + %ignored_metrics = %{$ignored_metrics_ref}; + +#------------------------------------------------------------------------------ +# The next subroutine is executed early to ensure the OS commands we need are +# available. +# +# 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). +#------------------------------------------------------------------------------ + gp_message ("debug", $subr_name, "verify the OS commands"); + $failed_command_mappings = check_and_define_cmds (\@selected_os_cmds, + \@search_paths_os_cmds); + + if ($failed_command_mappings == 0) + { + $msg = "successfully verified the OS commands"; + gp_message ("debug", $subr_name, $msg); + } + +#------------------------------------------------------------------------------ +#------------------------------------------------------------------------------ +# Time to check if any warnings and/or errors have been generated. +#------------------------------------------------------------------------------ +#------------------------------------------------------------------------------ + +#------------------------------------------------------------------------------ +# 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. +#------------------------------------------------------------------------------ + if ($g_debug) + { + $msg = "internal settings after option processing"; + $ignore_value = print_table_user_settings ("diag", $msg); + } + +#------------------------------------------------------------------------------ +# Terminate execution in case fatal errors have occurred. +#------------------------------------------------------------------------------ + 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, $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); + +#------------------------------------------------------------------------------ +# 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); + $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. # -# 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. #------------------------------------------------------------------------------ + $msg = "processing of the rc file has been disabled for now"; + gp_message ("debugXL", $subr_name, $msg); - 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"); - -#------------------------------------------------------------------------------ -# 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. -#------------------------------------------------------------------------------ - gp_message ("verbose", $subr_name, "Parse the user options"); - - $total_user_errors = 0; - - ($option_errors, $found_exp_dir, $exp_dir_list_ref) = parse_and_check_user_options ( - \$#ARGV, - \@ARGV); - $total_user_errors += $option_errors; - -#------------------------------------------------------------------------------ -# 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; -# -# 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.. -#------------------------------------------------------------------------------ - my ($module_errors_ref, $missing_modules_ref) = handle_module_availability (); - - my $module_errors = ${ $module_errors_ref }; - - if ($module_errors > 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); - } - -#------------------------------------------------------------------------------ -# 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; - -#------------------------------------------------------------------------------ -# 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. -#------------------------------------------------------------------------------ - 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]"); - } - } - -#------------------------------------------------------------------------------ -# Bail out in case fatal errors have occurred. -#------------------------------------------------------------------------------ - if ( ($rc_file_errors + $total_user_errors) > 0) - { - my $msg = "the current values for the user controllable settings"; - print_user_settings ("debug", $msg); - - gp_message ("abort", $subr_name, "execution terminated"); - } - else - { - my $msg = "after parsing the user options, the final values are"; - print_user_settings ("debug", $msg); - -#------------------------------------------------------------------------------ -# TBD: Enable once all planned features have been implemented and tested. -#------------------------------------------------------------------------------ -# Temporarily disabled $msg = "the final values for the user controllable settings"; -# Temporarily disabled print_table_user_settings ("verbose", $msg); - } +# 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 = ); @@ -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; + $msg = "generate the experiment information"; + gp_message ("verbose", $subr_name, $msg); - my $experiment_data_ref; - - $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"); + $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_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"); +#------------------------------------------------------------------------------ + $msg = "generate the index.html file"; + gp_message ("verbose", $subr_name, $msg); - $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); + $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); -#------------------------------------------------------------------------------------- -# We're done. In debug mode, print the meta data for the experiment directories. -#------------------------------------------------------------------------------------- +#------------------------------------------------------------------------------ +# We're done. In debug mode, print the meta data for the experiment +# directories. +#------------------------------------------------------------------------------ $ignore_value = print_meta_data_experiments ("debug"); +#------------------------------------------------------------------------------ +# 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 = (); + } + +#------------------------------------------------------------------------------ +# 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); + } + +#------------------------------------------------------------------------------ +# 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"; + my $prologue_text = "Processing completed - view file $results_file" . + " in a browser"; gp_message ("diag", $subr_name, $prologue_text); return (0); } #-- End of subroutine main -#------------------------------------------------------------------------------ -# Print a message after a failure in $GP_DISPLAY_TEXT. -#------------------------------------------------------------------------------ -sub msg_display_text_failure -{ - my $subr_name = get_my_name (); - - my ($gp_display_text_cmd, $error_code, $error_file) = @_; - - my $msg; - - $msg = "error code = $error_code - failure executing the following command:"; - gp_message ("error", $subr_name, $msg); - - gp_message ("error", $subr_name, $gp_display_text_cmd); - - $msg = "check file $error_file for more details"; - gp_message ("error", $subr_name, $msg); - - return (0); - -} #-- End of subroutine msg_display_text_failure - #------------------------------------------------------------------------------ # 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. # -# 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. +# 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. +# +# 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 $failed_cmds; + my @the_fields = (); - gp_message ("debug", $subr_name, "\@cmds = @cmds"); - gp_message ("debug", $subr_name, "\@search_path = @search_path"); + 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 ("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 = $path . "/" . $cmd; - if (-x $target_cmd) - { - $found_match = $TRUE; - $g_mapped_cmds{$cmd} = $target_cmd; - last; - } - } + $target_cmd = "(command -v $cmd; echo \$\?)"; - if (not $found_match) + ($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. +#------------------------------------------------------------------------------ { - $g_mapped_cmds{$cmd} = "road_to_nowhere"; + $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? +#------------------------------------------------------------------------------ + { +#------------------------------------------------------------------------------ +# 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) + { + 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 ($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) { - if ($mapped eq "road_to_nowhere") + $msg = "
" . "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") { - 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 = '^$'; + 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 () { $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 " -# +# #------------------------------------------------------------------------------ if ($line =~ /^\s*) + $extracted_information = $FALSE; + while () { $line = $_; chomp ($line); - gp_message ("debug", $subr_name, "MAP_XML read line = $line"); -## if ($line =~ /^$/) - if ($line =~ /^$/) + gp_message ("debugM", $subr_name, "MAP_XML read line = $line"); +#------------------------------------------------------------------------------ +# Replaces this way too long line: +# if ($line =~ /^$/) +#------------------------------------------------------------------------------ + if ($line =~ /$event_kind_map_regex/) { - gp_message ("debug", $subr_name, "target line = $line"); + gp_message ("debugM", $subr_name, "target line = $line"); $vaddr = $1; $foffset = $2; $modes = $3; $name_path = $4; $name = get_basename ($name_path); - gp_message ("debug", $subr_name, "extracted vaddr = $vaddr foffset = $foffset modes = $modes"); - gp_message ("debug", $subr_name, "extracted name_path = $name_path name = $name"); + $msg = "extracted vaddr = $vaddr foffset = $foffset"; + $msg .= " modes = $modes"; + gp_message ("debugM", $subr_name, $msg); + $msg = "extracted name_path = $name_path name = $name"; + gp_message ("debugM", $subr_name, $msg); # $error_extracting_information = $TRUE; $executable_name = $name; my $result_VA = bigint::hex ($vaddr) - bigint::hex ($foffset); my $hex_VA = sprintf ("0x%016x", $result_VA); $va_executable_in_hex = $hex_VA; - gp_message ("debug", $subr_name, "set executable_name = $executable_name"); - gp_message ("debug", $subr_name, "set va_executable_in_hex = $va_executable_in_hex"); - gp_message ("debug", $subr_name, "result_VA = $result_VA"); - gp_message ("debug", $subr_name, "hex_VA = $hex_VA"); + + $msg = "set executable_name = " . $executable_name; + gp_message ("debugM", $subr_name, $msg); + $msg = "set va_executable_in_hex = " . $va_executable_in_hex; + gp_message ("debugM", $subr_name, $msg); + $msg = "result_VA = " . $result_VA; + gp_message ("debugM", $subr_name, $msg); + $msg = "hex_VA = " . $hex_VA; + gp_message ("debugM", $subr_name, $msg); + if ($modes eq "005") { $extracted_information = $TRUE; @@ -1887,9 +2242,13 @@ sub check_loadobjects_are_elf } } } + + close (MAP_XML); + if (not $extracted_information) { - my $msg = "cannot find the necessary information in the $path_to_map_file file"; + $msg = "cannot find the necessary information in"; + $msg .= " the $path_to_map_file file"; gp_message ("assertion", $subr_name, $msg); } @@ -1917,26 +2276,42 @@ sub check_metric_values my $current_value; my $hp_value = $g_user_settings{"highlight_percentage"}{"current_value"}; my $max_value; + my $msg; my $relative_distance; - @current_metrics = split (" ", $metric_values); + @current_metrics = split (" ", $metric_values); $colour_coded_line = $FALSE; + for my $metric (0 .. $#current_metrics) { $current_value = $current_metrics[$metric]; if (exists ($max_metric_values[$metric])) { $max_value = $max_metric_values[$metric]; - gp_message ("debugXL", $subr_name, "metric = $metric current_value = $current_value max_value = $max_value"); - if ( ($max_value > 0) and ($current_value > 0) and ($current_value != $max_value) ) + + $msg = "metric = $metric current_value = $current_value"; + $msg .= " max_value = $max_value"; + gp_message ("debugXL", $subr_name, $msg); + + if ( ($max_value > 0) and ($current_value > 0) and + ($current_value != $max_value) ) { # TBD: abs needed? - gp_message ("debugXL", $subr_name, "metric = $metric current_value = $current_value max_value = $max_value"); - $relative_distance = 1.00 - abs ( ($max_value - $current_value)/$max_value ); - gp_message ("debugXL", $subr_name, "relative_distance = $relative_distance"); + $msg = "metric = $metric current_value = $current_value"; + $msg .= " max_value = $max_value"; + gp_message ("debugXL", $subr_name, $msg); + + $relative_distance = 1.00 - abs ( + ($max_value - $current_value)/$max_value ); + + $msg = "relative_distance = $relative_distance"; + gp_message ("debugXL", $subr_name, $msg); + if ($relative_distance >= $hp_value/100.0) { - gp_message ("debugXL", $subr_name, "metric $metric is within the relative_distance"); + $msg = "metric $metric is within the relative_distance"; + gp_message ("debugXL", $subr_name, $msg); + $colour_coded_line = $TRUE; last; } @@ -1974,80 +2349,218 @@ sub check_support_for_processor } #-- End of subroutine check_support_for_processor #------------------------------------------------------------------------------ -# Check if the value for the user option given is valid. +# Check the command line options for the occurrence of experiments and make +# sure that this list is contigious. No other names are allowed in this list. # -# In case the value is valid, the g_user_settings table is updated. -# Otherwise an error message is printed. +# Terminate execution in case of an error. Otherwise remove the experiment +# names for ARGV (to make the subsequent parsing easier), and return an array +# with the experiment names. # -# The return value is TRUE/FALSE. +# The following patterns are supposed to be detected: +# +# some other word(s) +# some other word(s) #------------------------------------------------------------------------------ -sub check_user_option +sub check_the_experiment_list { my $subr_name = get_my_name (); - my ($internal_option_name, $value) = @_; +#------------------------------------------------------------------------------ +# The name of an experiment directory can contain any non-whitespace +# character(s), but has to end with .er, or optionally .er/. Multiple +# forward slashes are allowed. +#------------------------------------------------------------------------------ + my $exp_dir_regex = '^(\S+)(\.er)\/*$'; + my $forward_slash_regex = '\/*$'; - my $message; - my $return_value; + my $current_value; + my @exp_dir_list = (); + my $found_experiment = $FALSE; + my $found_non_exp = $FALSE; + my $msg; + my $name_non_exp_dir = ""; + my $no_of_experiments = 0; + my $no_of_invalid_dirs = 0; + my $opt_remainder; + my $valid = $TRUE; - my $option = $g_user_settings{$internal_option_name}{"option"}; - my $data_type = $g_user_settings{$internal_option_name}{"data_type"}; - my $no_of_arguments = $g_user_settings{$internal_option_name}{"no_of_arguments"}; - - if (($no_of_arguments >= 1) and - ((not defined ($value)) or (length ($value) == 0))) + for my $i (keys @ARGV) { + $current_value = $ARGV[$i]; + if ($current_value =~ /$exp_dir_regex/) #------------------------------------------------------------------------------ -# 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. +# The current value is an experiment. Remove any trailing forward slashes, +# Increment the count, push the value into the array and set the +# found_experiment flag to TRUE. #------------------------------------------------------------------------------ - - $message = "the $option option requires a value"; - push (@g_user_input_errors, $message); - $return_value = $FALSE; - } - elsif ($no_of_arguments >= 1) - { -#------------------------------------------------------------------------------ -# 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. -#------------------------------------------------------------------------------ - my $valid = verify_if_input_is_valid ($value, $data_type); - - if ($valid) { - if (($data_type eq "onoff") or ($data_type eq "size")) + $no_of_experiments += 1; + + $current_value =~ s/$forward_slash_regex//; + push (@exp_dir_list, $current_value); + + if (not $found_experiment) +#------------------------------------------------------------------------------ +# Start checking for the next field(s). +#------------------------------------------------------------------------------ { - $g_user_settings{$internal_option_name}{"current_value"} = lc ($value); + $found_experiment = $TRUE; } - else +#------------------------------------------------------------------------------ +# We had found non-experiment names and now see another experiment. Time to +# bail out of the loop. +#------------------------------------------------------------------------------ + if ($found_non_exp) { - $g_user_settings{$internal_option_name}{"current_value"} = $value; + last; } - $g_user_settings{$internal_option_name}{"defined"} = $TRUE; - $return_value = $TRUE; } else { - $message = "incorrect value for $option option: $value"; - push (@g_user_input_errors, $message); + if ($found_experiment) +#------------------------------------------------------------------------------ +# The current value is not an experiment, but the value of found_experiment +# indicates at least one experiment has been seen already. This means that +# the list of experiment names is not contiguous and that is a fatal error. +#------------------------------------------------------------------------------ + { + $name_non_exp_dir .= $current_value . " "; + $found_non_exp = $TRUE; + } + } - $return_value = $FALSE; + } + +#------------------------------------------------------------------------------ +#------------------------------------------------------------------------------ +# Error handling. +#------------------------------------------------------------------------------ +#------------------------------------------------------------------------------ + + if ($found_non_exp) +#------------------------------------------------------------------------------ +# The experiment list is not contiguous. +#------------------------------------------------------------------------------ + { + $valid = $FALSE; + $msg = "the list with the experiments is not contiguous:"; + gp_message ("error", $subr_name, $msg); + + $msg = "\"" . $name_non_exp_dir. "\"". " is not an experiment, but" . + " appears in a list where experiments are expected"; + gp_message ("error", $subr_name, $msg); + + $g_total_error_count++; + } + + if ($no_of_experiments == 0) +#------------------------------------------------------------------------------ +# The experiment list is empty. +#------------------------------------------------------------------------------ + { + $valid = $FALSE; + $msg = "the experiment list is missing from the options"; + gp_message ("error", $subr_name, $msg); + + $g_total_error_count++; + } + + if (not $valid) +#------------------------------------------------------------------------------ +# If an error has occurred, print the error(s) and terminate execution. +#------------------------------------------------------------------------------ + { + gp_message ("abort", $subr_name, $g_abort_msg); + } + +#------------------------------------------------------------------------------ +# We now have a list with experiments, but we still need to verify whether they +# exist, and if so, are these valid experiments? +#------------------------------------------------------------------------------ + for my $exp_dir (@exp_dir_list) + { + $msg = "checking experiment directory $exp_dir"; + gp_message ("debug", $subr_name, $msg); + + if (-d $exp_dir) + { + $msg = "directory $exp_dir found"; + gp_message ("debug", $subr_name, $msg); +#------------------------------------------------------------------------------ +# Files log.xml and map.xml have to be there. +#------------------------------------------------------------------------------ + if ((-e $exp_dir."/log.xml") and (-e $exp_dir."/map.xml")) + { + $msg = "directory $exp_dir appears to be a valid experiment"; + $msg .= " directory"; + gp_message ("debug", $subr_name, $msg); + } + else + { + $no_of_invalid_dirs++; + $msg = "file " . $exp_dir . "/log.xml and/or " . $exp_dir; + $msg .= "/map.xml missing"; + gp_message ("debug", $subr_name, $msg); + + $msg = "directory " . get_basename($exp_dir) . " does not"; + $msg .= " appear to be a valid experiment directory"; + gp_message ("error", $subr_name, $msg); + + $g_total_error_count++; + } + } + else + { + $no_of_invalid_dirs++; + $msg = "directory " . get_basename($exp_dir) . " does not exist"; + gp_message ("error", $subr_name, $msg); + + $g_total_error_count++; } } - return ($return_value); + if ($no_of_invalid_dirs > 0) +#------------------------------------------------------------------------------ +# This is a fatal error, but for now, we can continue to check for more errors. +# Even if none more are found, execution is terminated before the data is +# generated and processed. In this way we can catch as many errors as +# possible. +#------------------------------------------------------------------------------ + { + my $plural_or_single = ($no_of_invalid_dirs == 1) ? + "one experiment is" : $no_of_invalid_dirs . " experiments are"; -} #-- End of subroutine check_user_option + $msg = $plural_or_single . " not valid"; +## gp_message ("abort", $subr_name, $msg); -#------------------------------------------------------------------------------- -# This subroutine performs multiple checks on the experiment directories. One -# or more failures are fatal. -#------------------------------------------------------------------------------- +## $g_total_error_count++; + } + +#------------------------------------------------------------------------------ +# Remove the experiments from ARGV and return the array with the experiment +# names. Note that these may, or may not be valid, but if invalid, execution +# terminates before they are used. +#------------------------------------------------------------------------------ + for my $i (1 .. $no_of_experiments) + { + my $poppy = pop (@ARGV); + + $msg = "popped $poppy from ARGV"; + gp_message ("debug", $subr_name, $msg); + + $msg = "ARGV after update = " . join (" ", @ARGV); + gp_message ("debug", $subr_name, $msg); + } + + return (\@exp_dir_list); + +} #-- End of subroutine check_the_experiment_list + +#------------------------------------------------------------------------------ +# Perform multiple checks on the experiment directories. +# +# TBD: It needs to be investigated whether all of this is really neccesary. +#------------------------------------------------------------------------------ sub check_validity_exp_dirs { my $subr_name = get_my_name (); @@ -2055,117 +2568,85 @@ sub check_validity_exp_dirs my ($exp_dir_list_ref) = @_; my @exp_dir_list = @{ $exp_dir_list_ref }; - + my %elf_rats = (); my $dir_not_found = $FALSE; - my $invalid_dir = $FALSE; - my $dir_check_errors = $FALSE; my $missing_dirs = 0; my $invalid_dirs = 0; - + my $archive_dir_not_empty; - my $elf_magic_number; + my $archives_dir; my $archives_file; - my $archives_dir; - my $first_line; my $count_exp_dir_not_elf; - + my $elf_magic_number; + my $first_line; + my $msg; + my $first_time; my $filename; my $comment; - my $selected_archive_has_elf_format; + my $selected_archive_has_elf_format; my $selected_archive; my $archive_dir_selected; my $no_of_files_in_selected_archive; -#------------------------------------------------------------------------------- -# Check if the experiment directories exist and are valid. -#------------------------------------------------------------------------------- - for my $exp_dir (@exp_dir_list) - { - if (not -d $exp_dir) - { - $dir_not_found = $TRUE; - $missing_dirs++; - gp_message ("error", $subr_name, "directory $exp_dir not found"); - $dir_check_errors = $TRUE; - } - else - { -#------------------------------------------------------------------------------- -# Files log.xml and map.xml have to be there. -#------------------------------------------------------------------------------- - gp_message ("debug", $subr_name, "directory $exp_dir found"); - if ((-e $exp_dir."/log.xml") and (-e $exp_dir."/map.xml")) - { - gp_message ("debug", $subr_name, "directory $exp_dir appears to be a valid experiment directory"); - } - else - { - $invalid_dir = $TRUE; - $invalid_dirs++; - gp_message ("debug", $subr_name, "file ".$exp_dir."/log.xml and/or ".$exp_dir."/map.xml missing"); - gp_message ("error" , $subr_name, "directory $exp_dir does not appear to be a valid experiment directory"); - $dir_check_errors = $TRUE; - } - } - } - if ($dir_not_found) - { - gp_message ("error", $subr_name, "a total of $missing_dirs directories not found"); - } - if ($invalid_dir) - { - gp_message ("abort", $subr_name, "a total of $invalid_dirs directories are not valid"); - } - -#------------------------------------------------------------------------------- +#------------------------------------------------------------------------------ # Initialize ELF status to FALSE. -#------------------------------------------------------------------------------- +#------------------------------------------------------------------------------ ## for my $exp_dir (@exp_dir_list) for my $exp_dir (keys %g_exp_dir_meta_data) { - $g_exp_dir_meta_data{$exp_dir}{"elf_format"} = $FALSE; - $g_exp_dir_meta_data{$exp_dir}{"archive_in_elf_format"} = $FALSE; + $g_exp_dir_meta_data{$exp_dir}{"elf_format"} = $FALSE; + $g_exp_dir_meta_data{$exp_dir}{"archive_in_elf_format"} = $FALSE; } -#------------------------------------------------------------------------------- +#------------------------------------------------------------------------------ # Check if the load objects are in ELF format. -#------------------------------------------------------------------------------- +#------------------------------------------------------------------------------ for my $exp_dir (keys %g_exp_dir_meta_data) { - $archives_dir = $g_exp_dir_meta_data{$exp_dir}{"directory_path"} . $exp_dir . "/archives"; + $archives_dir = $g_exp_dir_meta_data{$exp_dir}{"directory_path"}; + $archives_dir .= $exp_dir . "/archives"; $archive_dir_not_empty = $FALSE; $first_time = $TRUE; $g_exp_dir_meta_data{$exp_dir}{"archive_is_empty"} = $TRUE; $g_exp_dir_meta_data{$exp_dir}{"no_of_files_in_archive"} = 0; - gp_message ("debug", $subr_name, "g_exp_dir_meta_data{$exp_dir}{'archive_is_empty'} = $g_exp_dir_meta_data{$exp_dir}{'archive_is_empty'}"); - gp_message ("debug", $subr_name, "checking $archives_dir"); + $msg = "g_exp_dir_meta_data{$exp_dir}{'archive_is_empty'} = "; + $msg .= $g_exp_dir_meta_data{$exp_dir}{'archive_is_empty'}; + gp_message ("debug", $subr_name, $msg); + + $msg = "checking $archives_dir"; + gp_message ("debug", $subr_name, $msg); while (glob ("$archives_dir/*")) { $filename = get_basename ($_); - gp_message ("debug", $subr_name, "processing file: $filename"); + + $msg = "processing file: $filename"; + gp_message ("debug", $subr_name, $msg); $g_exp_dir_meta_data{$exp_dir}{"archive_files"}{$filename} = $TRUE; $g_exp_dir_meta_data{$exp_dir}{"no_of_files_in_archive"}++; $archive_dir_not_empty = $TRUE; -#------------------------------------------------------------------------------- +#------------------------------------------------------------------------------ # Replaces the ELF_RATS part in elf_phdr. # # Challenge: splittable_mrg.c_I0txnOW_Wn5 # # TBD: Store this for each relevant experiment directory. -#------------------------------------------------------------------------------- +#------------------------------------------------------------------------------ my $last_dot = rindex ($filename,"."); my $underscore_before_dot = $TRUE; my $first_underscore = -1; - gp_message ("debugXL", $subr_name, "last_dot = $last_dot"); + + $msg = "last_dot = $last_dot"; + gp_message ("debugXL", $subr_name, $msg); + while ($underscore_before_dot) { $first_underscore = index ($filename, "_", $first_underscore+1); @@ -2175,27 +2656,33 @@ sub check_validity_exp_dirs } } my $original_name = substr ($filename, 0, $first_underscore); - gp_message ("debug", $subr_name, "stripped archive name: $original_name"); + $msg = "stripped archive name: " . $original_name; + gp_message ("debug", $subr_name, $msg); if (not exists ($elf_rats{$original_name})) { $elf_rats{$original_name} = [$filename, $exp_dir]; } -#------------------------------------------------------------------------------- +#------------------------------------------------------------------------------ # We only need to detect the presence of an object once. -#------------------------------------------------------------------------------- +#------------------------------------------------------------------------------ if ($first_time) { $first_time = $FALSE; $g_exp_dir_meta_data{$exp_dir}{"archive_is_empty"} = $FALSE; - gp_message ("debugXL", $subr_name, "g_exp_dir_meta_data{$exp_dir}{'archive_is_empty'} = $g_exp_dir_meta_data{$exp_dir}{'archive_is_empty'}"); + $msg = "g_exp_dir_meta_data{$exp_dir}{'archive_is_empty'} = "; + $msg .= $g_exp_dir_meta_data{$exp_dir}{"archive_is_empty"}; + + gp_message ("debugXL", $subr_name, $msg); } } } #-- End of loop over experiment directories for my $exp_dir (sort keys %g_exp_dir_meta_data) { - my $empty = $g_exp_dir_meta_data{$exp_dir}{"archive_is_empty"}; - gp_message ("debug", $subr_name, "archive directory $exp_dir/archives is ".($empty ? "empty" : "not empty")); + my $empty = $g_exp_dir_meta_data{$exp_dir}{"archive_is_empty"}; + $msg = "archive directory " . $exp_dir . "/archives is"; + $msg .= " " . ($empty ? "empty" : "not empty"); + gp_message ("debug", $subr_name, $msg); } #------------------------------------------------------------------------------ @@ -2203,21 +2690,26 @@ sub check_validity_exp_dirs #------------------------------------------------------------------------------ for my $exp_dir (sort keys %g_exp_dir_meta_data) { - $g_exp_dir_meta_data{$exp_dir}{"archive_in_elf_format"} = $FALSE; + $g_exp_dir_meta_data{$exp_dir}{"archive_in_elf_format"} = $FALSE; if (not $g_exp_dir_meta_data{$exp_dir}{"archive_is_empty"}) { - $archives_dir = $g_exp_dir_meta_data{$exp_dir}{"directory_path"} . $exp_dir . "/archives"; - gp_message ("debug", $subr_name, "exp_dir = $exp_dir archives_dir = $archives_dir"); + $archives_dir = $g_exp_dir_meta_data{$exp_dir}{"directory_path"}; + $archives_dir .= $exp_dir . "/archives"; + $msg = "exp_dir = " . $exp_dir . " archives_dir = " . $archives_dir; + gp_message ("debug", $subr_name, $msg); #------------------------------------------------------------------------------ # Check if any of the loadobjects is of type ELF. Bail out on the first one # found. The assumption is that all other loadobjects must be of type ELF too # then. #------------------------------------------------------------------------------ - for my $aname (sort keys %{$g_exp_dir_meta_data{$exp_dir}{"archive_files"}}) + for my $aname (sort keys + %{$g_exp_dir_meta_data{$exp_dir}{"archive_files"}}) { - $filename = $g_exp_dir_meta_data{$exp_dir}{"directory_path"} . $exp_dir . "/archives/" . $aname; + $filename = $g_exp_dir_meta_data{$exp_dir}{"directory_path"}; + $filename .= $exp_dir . "/archives/" . $aname; + $msg = " - unable to open file $filename for reading:"; open (ARCF,"<", $filename) - or die ("unable to open file $filename for reading - '$!'"); + or die ($subr_name . $msg . " " . $!); $first_line = ; close (ARCF); @@ -2230,10 +2722,10 @@ sub check_validity_exp_dirs # if ($first_line =~ /^\177ELF.*/) $elf_magic_number = unpack ('H8', $first_line); -# gp_message ("debug", $subr_name, "elf_magic_number = $elf_magic_number"); if ($elf_magic_number eq "7f454c46") { - $g_exp_dir_meta_data{$exp_dir}{"archive_in_elf_format"} = $TRUE; + $g_exp_dir_meta_data{$exp_dir}{"archive_in_elf_format"} = + $TRUE; $g_exp_dir_meta_data{$exp_dir}{"elf_format"} = $TRUE; last; } @@ -2243,22 +2735,24 @@ sub check_validity_exp_dirs for my $exp_dir (sort keys %g_exp_dir_meta_data) { - $comment = "the loadobjects in the archive in $exp_dir are "; - $comment .= ($g_exp_dir_meta_data{$exp_dir}{"archive_in_elf_format"}) ? "in " : "not in "; - $comment .= "ELF format"; - gp_message ("debug", $subr_name, $comment); + $msg = "the loadobjects in the archive in $exp_dir are"; + $msg .= ($g_exp_dir_meta_data{$exp_dir}{"archive_in_elf_format"}) ? + " in" : " not in"; + $msg .= " ELF format"; + gp_message ("debug", $subr_name, $msg); } for my $exp_dir (sort keys %g_exp_dir_meta_data) { if ($g_exp_dir_meta_data{$exp_dir}{"archive_is_empty"}) { - gp_message ("debug", $subr_name, "there are no archived files in $exp_dir"); + $msg = "there are no archived files in " . $exp_dir; + gp_message ("debug", $subr_name, $msg); } } #------------------------------------------------------------------------------ -# If there are archived files and they are not in ELF format, a debug is -# issued. +# If there are archived files and they are not in ELF format, a debug message +# is issued. # # TBD: Bail out? #------------------------------------------------------------------------------ @@ -2267,12 +2761,14 @@ sub check_validity_exp_dirs { if (not $g_exp_dir_meta_data{$exp_dir}{"archive_in_elf_format"}) { - $count_exp_dir_not_elf++; + $count_exp_dir_not_elf++; } } if ($count_exp_dir_not_elf != 0) { - gp_message ("debug", $subr_name, "there are $count_exp_dir_not_elf experiments with non-ELF load objects"); + $msg = "there are $count_exp_dir_not_elf experiments with non-ELF"; + $msg .= " load objects"; + gp_message ("debug", $subr_name, $msg); } #------------------------------------------------------------------------------ @@ -2290,19 +2786,24 @@ sub check_validity_exp_dirs ## for my $exp_dir (sort @exp_dir_list) for my $exp_dir (sort keys %g_exp_dir_meta_data) { - gp_message ("debugXL", $subr_name, "exp_dir = $exp_dir"); - gp_message ("debugXL", $subr_name, "g_exp_dir_meta_data{$exp_dir}{'archive_is_empty'}"); + $msg = "exp_dir = " . $exp_dir; + gp_message ("debugXL", $subr_name, $msg); + $msg = "g_exp_dir_meta_data{$exp_dir}{'archive_is_empty'}"; + $msg .= " = " . $g_exp_dir_meta_data{$exp_dir}{"archive_is_empty"}; + gp_message ("debugXL", $subr_name, $msg); if (not $g_exp_dir_meta_data{$exp_dir}{"archive_is_empty"}) { $selected_archive = $exp_dir; $archive_dir_not_empty = $TRUE; $archive_dir_selected = $TRUE; - $selected_archive_has_elf_format = ($g_exp_dir_meta_data{$exp_dir}{"archive_in_elf_format"}) ? $TRUE : $FALSE; + $selected_archive_has_elf_format = + ($g_exp_dir_meta_data{$exp_dir}{"archive_in_elf_format"}) ? + $TRUE : $FALSE; last; } } - if (not $archive_dir_selected) + if (not $archive_dir_selected) #------------------------------------------------------------------------------ # None are found and pick the first one without archived files. #------------------------------------------------------------------------------ @@ -2319,35 +2820,52 @@ sub check_validity_exp_dirs } } } - gp_message ("debug", $subr_name, "experiment $selected_archive has been selected for archive analysis"); - gp_message ("debug", $subr_name, "this archive is ". (($archive_dir_not_empty) ? "not empty" : "empty")); - gp_message ("debug", $subr_name, "this archive is ". (($selected_archive_has_elf_format) ? "in" : "not in")." ELF format"); + + $msg = "experiment $selected_archive has been selected for"; + $msg .= " archive analysis"; + gp_message ("debug", $subr_name, $msg); + $msg = "this archive is"; + $msg .= $archive_dir_not_empty ? " not empty" : " empty"; + gp_message ("debug", $subr_name, $msg); + $msg = "this archive is"; + $msg .= $selected_archive_has_elf_format ? " in" : " not in"; + $msg .= " ELF format"; + gp_message ("debug", $subr_name, $msg); #------------------------------------------------------------------------------ # Get the size of the hash that contains the archived files. #------------------------------------------------------------------------------ ## $NO_OF_FILES_IN_ARCHIVE = scalar (keys %ARCHIVES_FILES); - $no_of_files_in_selected_archive = $g_exp_dir_meta_data{$selected_archive}{"no_of_files_in_archive"}; - gp_message ("debug", $subr_name, "number of files in archive $selected_archive is $no_of_files_in_selected_archive"); + $no_of_files_in_selected_archive = + $g_exp_dir_meta_data{$selected_archive}{"no_of_files_in_archive"}; + $msg = "number of files in archive $selected_archive is"; + $msg .= " " . $no_of_files_in_selected_archive; + gp_message ("debug", $subr_name, $msg); for my $exp_dir (sort keys %g_exp_dir_meta_data) { my $is_empty = $g_exp_dir_meta_data{$exp_dir}{"archive_is_empty"}; - gp_message ("debug", $subr_name, "archive directory $exp_dir/archives is ".($is_empty ? "empty" : "not empty")); + $msg = "archive directory $exp_dir/archives is"; + $msg .= $is_empty ? " empty" : " not empty"; + gp_message ("debug", $subr_name, $msg); } for my $exp_dir (sort keys %g_exp_dir_meta_data) { if (not $g_exp_dir_meta_data{$exp_dir}{"archive_is_empty"}) { - for my $object (sort keys %{$g_exp_dir_meta_data{$exp_dir}{"archive_files"}}) + for my $object (sort keys + %{$g_exp_dir_meta_data{$exp_dir}{"archive_files"}}) { - gp_message ("debug", $subr_name, "$exp_dir $object $g_exp_dir_meta_data{$exp_dir}{'archive_files'}{$object}"); + $msg = $exp_dir . " " . $object . " "; + $msg .= + $g_exp_dir_meta_data{$exp_dir}{'archive_files'}{$object}; + gp_message ("debug", $subr_name, $msg); } } } - return ($dir_check_errors, $archive_dir_not_empty, $selected_archive, \%elf_rats); + return ($archive_dir_not_empty, $selected_archive, \%elf_rats); } #-- End of subroutine check_validity_exp_dirs @@ -2378,7 +2896,7 @@ sub color_string { $colored_string .= ""; } - $colored_string .= ""; + $colored_string .= ""; return ($colored_string); @@ -2397,25 +2915,29 @@ sub create_exp_info my @experiment_data = @{ $experiment_data_ref }; my @experiment_stats_html = (); - my $experiment_stats_line; + my $experiment_stats_line; + my $msg; my $plural; $plural = ($#experiment_dir_list > 0) ? "s:" : ":"; $experiment_stats_line = "

\n"; - $experiment_stats_line .= "Full pathnames to the input experiment" . $plural . "\n"; + $experiment_stats_line .= "Full pathnames to the input experiment"; + $experiment_stats_line .= $plural . "\n"; $experiment_stats_line .= "

\n"; $experiment_stats_line .= "
\n";
 
   for my $i (0 .. $#experiment_dir_list)
     {
-      $experiment_stats_line .= $experiment_dir_list[$i] . " (" . $experiment_data[$i]{"start_date"} . ")\n";
+      $experiment_stats_line .= $experiment_dir_list[$i] . " (" ;
+      $experiment_stats_line .= $experiment_data[$i]{"start_date"} . ")\n";
     }
   $experiment_stats_line .= "
\n"; push (@experiment_stats_html, $experiment_stats_line); - gp_message ("debugXL", $subr_name, "experiment_stats_line = $experiment_stats_line --"); + $msg = "experiment_stats_line = " . $experiment_stats_line; + gp_message ("debugXL", $subr_name, $msg); return (\@experiment_stats_html); @@ -2448,9 +2970,11 @@ sub create_html_credits my $msg; my $the_date; - my @months = qw (January February March April May June July August September October November December); + my @months = qw (January February March April May June July + August September October November December); - my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime (); + my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = + localtime (); $year += 1900; @@ -2484,17 +3008,18 @@ sub create_html_header my $title = ${ $title_ref }; my $LANG = $g_locale_settings{"LANG"}; - my $background_color = $g_html_color_scheme{"background_color_page"}; + my $background_color = $g_html_color_scheme{"background_color_page"}; - my $html_header; + my $html_header; $html_header = "\n"; $html_header .= "\n"; $html_header .= "\n"; - $html_header .= "\n"; + $html_header .= "\n"; $html_header .= "" . $title . "\n"; $html_header .= "\n"; - $html_header .= "\n"; + $html_header .= "\n"; $html_header .= "