^^&&^^

Edit File: gp-display-html

#!/usr/bin/perl
#   Copyright (C) 2021-2023 Free Software Foundation, Inc.
#   Contributed by Oracle.
#
#   This file is part of GNU Binutils.
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 3, or (at your option)
#   any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, 51 Franklin Street - Fifth Floor, Boston,
#   MA 02110-1301, USA.

use strict;
use warnings;

# 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.
#------------------------------------------------------------------------------
INIT
{
  my $perl_minimal_version_supported = version->parse ("5.10.0")->normal;
  my $perl_current_version           = version->parse ("$]")->normal;

if ($perl_current_version lt $perl_minimal_version_supported)
    {
      my $msg;

$msg  = "Error: minimum Perl release required: ";
      $msg .= $perl_minimal_version_supported;
      $msg .= " current: ";
      $msg .= $perl_current_version;
      $msg .= "\n";

print $msg;

exit (1);
     }
} #-- End of INIT

#------------------------------------------------------------------------------
# Poor man's version of a boolean.
#------------------------------------------------------------------------------
my $TRUE    = 1;
my $FALSE   = 0;

#------------------------------------------------------------------------------
# The total number of functions to be processed.
#------------------------------------------------------------------------------
my $g_total_function_count = 0;

#------------------------------------------------------------------------------
# Used to ensure correct alignment of columns.
#------------------------------------------------------------------------------
my $g_max_length_first_metric;

#------------------------------------------------------------------------------
# This variable contains the path used to execute $GP_DISPAY_TEXT.
#------------------------------------------------------------------------------
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";
my $g_gp_error_logfile = $GP_DISPLAY_TEXT.".stderr.log";

#------------------------------------------------------------------------------
# Global variables.
#------------------------------------------------------------------------------
my $g_addressing_mode = "64 bit";

#------------------------------------------------------------------------------
# The global regex section.
#
# First step towards consolidating all regexes.
#------------------------------------------------------------------------------
  my $g_less_than_regex      = '<';
  my $g_html_less_than_regex = '&lt;';
  my $g_endbr_inst_regex     = 'endbr[32|64]';
  my $g_rm_surrounding_spaces_regex = '^\s+|\s+$';

#------------------------------------------------------------------------------
# For consistency, use a global variable.
#------------------------------------------------------------------------------
  my $g_html_new_line = "<br>";

#------------------------------------------------------------------------------
# These are the regex's used.
#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
# Disassembly analysis
#------------------------------------------------------------------------------
  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_first_metric;

my $binutils_version;
my $driver_cmd;
my $tool_name;
my $version_info;

my %g_mapped_cmds = ();

#------------------------------------------------------------------------------
# Variables dealing with warnings and errors.  Since a message may span
# multiple lines (for readability reasons), the number of entries in the
# array may not reflect the total number of messages.  This is why we use
# separate variables for the counts.
#------------------------------------------------------------------------------
my @g_error_msgs   = ();
my @g_warning_msgs = ();
my $g_total_error_count = 0;
#------------------------------------------------------------------------------
# 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
# structure because otherwise the code would get much more complicated.
#------------------------------------------------------------------------------
my %g_tagged_names = ();

#------------------------------------------------------------------------------
# TBD Remove the use of these structures. No longer used.
#------------------------------------------------------------------------------
my %g_function_tag_id = ();
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_html_credits_line;

my $g_warn_keyword  = "[Warning]";
my $g_error_keyword = "[Error]";

my %g_function_occurrences = ();
my %g_map_function_to_index = ();
my %g_multi_count_function = ();
my %g_function_view_all = ();
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 = "2.42";
$version_info     = $tool_name . " GNU binutils version " . $binutils_version;

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

#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
# Define several key data structures.
#------------------------------------------------------------------------------
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# This table has the settings of the variables the user may set.
#------------------------------------------------------------------------------
my %g_user_settings =
  (
    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},
  );

#------------------------------------------------------------------------------
# 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,
    "m"   => $FALSE,
    "l"   => $FALSE,
    "xl"  => $FALSE,
  );

my %local_system_config =
  (
    kernel_name       => "undefined",
    nodename          => "undefined",
    kernel_release    => "undefined",
    kernel_version    => "undefined",
    machine           => "undefined",
    processor         => "undefined",
    hardware_platform => "undefined",
    operating_system  => "undefined",
    hostname_current  => "undefined",
  );

#------------------------------------------------------------------------------
# Note that we use single quotes here, because regular expressions wreak
# havoc otherwise.
#------------------------------------------------------------------------------

my %g_arch_specific_settings =
  (
    arch_supported  => $FALSE,
    arch            => 'undefined',
    regex           => 'undefined',
    subexp          => 'undefined',
    linksubexp      => 'undefined',
  );

my %g_locale_settings = (
  LANG              => "en_US.UTF-8",
  decimal_separator => "\\.",
  covert_to_dot     => $FALSE
);

#------------------------------------------------------------------------------
# See this page for a nice overview with the colors:
# https://www.w3schools.com/colors/colors_groups.asp
#------------------------------------------------------------------------------

my %g_html_color_scheme = (
  "control_flow"  => "Brown",
  "target_function_name" => "Red",
  "non_target_function_name" => "BlueViolet",
  "background_color_hot" => "PeachPuff",
  "background_color_lukewarm" => "LemonChiffon",
  "link_outside_range" => "Crimson",
  "error_message" => "LightPink",
  "background_color_page" => "White",
#  "background_color_page" => "LightGray",
  "background_selected_sort" => "LightSlateGray",
  "index" => "Lavender",
);

#------------------------------------------------------------------------------
# These are the base names for the HTML files that are generated.
#------------------------------------------------------------------------------
my %g_html_base_file_name = (
  "caller_callee"  => "caller-callee",
  "disassembly" => "dis",
  "experiment_info"  => "experiment-info",
  "function_view"  => "function-view-sorted",
  "index" => "index",
  "source" => "src",
  "warnings" => "warnings",
);

#------------------------------------------------------------------------------
# Introducing main() is cosmetic, but helps with the scoping of variables.
#------------------------------------------------------------------------------
  main ();

exit (0);

#------------------------------------------------------------------------------
# This is the driver part of the program.
#------------------------------------------------------------------------------
sub main
{
  my $subr_name = get_my_name ();

@CopyOfARGV = @ARGV;

#------------------------------------------------------------------------------
# The name of the configuration file.
#------------------------------------------------------------------------------
  my $rc_file_name = ".gp-display-html.rc";

#------------------------------------------------------------------------------
# OS commands executed and search paths.
#
# TBD: check if elfdump should be here too (most likely not though)
#------------------------------------------------------------------------------
  my @selected_os_cmds = qw (rm cat hostname locale which printenv uname
			     readelf mkdir);

my @search_paths_os_cmds = qw (
    /usr/bin
    /bin
    /usr/local/bin
    /usr/local/sbin
    /usr/sbin
    /sbin
  );

#------------------------------------------------------------------------------
# TBD: Eliminate these.
#------------------------------------------------------------------------------
  my $ARCHIVES_MAP_NAME;
  my $ARCHIVES_MAP_VADDR;

#------------------------------------------------------------------------------
# Local structures (hashes and arrays).
#------------------------------------------------------------------------------
  my @exp_dir_list = ();
  my @metrics_data;

my %function_address_info = ();
  my $function_address_info_ref;

my @function_info = ();
  my $function_info_ref;

my %function_address_and_index = ();
  my $function_address_and_index_ref;

my %addressobjtextm = ();
  my $addressobjtextm_ref;

my %addressobj_index = ();
  my $addressobj_index_ref;

my %LINUX_vDSO = ();
  my $LINUX_vDSO_ref;

my %function_view_structure = ();
  my $function_view_structure_ref;

my %elf_rats = ();
  my $elf_rats_ref;

#------------------------------------------------------------------------------
# Local variables.
#------------------------------------------------------------------------------
  my $abs_path_outputdir;
  my $archive_dir_not_empty;
  my $base_va_executable;
  my $executable_name;
  my $found_exp_dir;
  my $ignore_value;
  my $msg;
  my $number_of_metrics;
  my $va_executable_in_hex;

my $failed_command_mappings;

my $script_pc_metrics;
  my $dir_check_errors;
  my $consistency_errors;
  my $outputdir;
  my $return_code;

my $decimal_separator;
  my $convert_to_dot;
  my $architecture_supported;
  my $elf_arch;
  my $elf_support;
  my $home_dir;
  my $elf_loadobjects_found;

my $rc_file_paths_ref;
  my @rc_file_paths = ();
  my $rc_file_errors = 0;

my @sort_fields = ();
  my $summary_metrics;
  my $call_metrics;
  my $user_metrics;
  my $system_metrics;
  my $wall_metrics;
  my $detail_metrics;
  my $detail_metrics_system;

my $html_test;
  my @experiment_data;
  my $exp_info_file;
  my $exp_info_ref;
  my @exp_info;

my $pretty_dir_list;

my %metric_value       = ();
  my %metric_description = ();
  my %metric_description_reversed = ();
  my %metric_found = ();
  my %ignored_metrics = ();

my $metric_value_ref;
  my $metric_description_ref;
  my $metric_found_ref;
  my $ignored_metrics_ref;

my @table_execution_stats = ();
  my $table_execution_stats_ref;

my $html_first_metric_file_ref;
  my $html_first_metric_file;

my $arch;
  my $subexp;
  my $linksubexp;

my $setting_for_LANG;
  my $time_percentage_multiplier;
  my $process_all_functions;

my $selected_archive;

#------------------------------------------------------------------------------
# If no options are given, print the help info and exit.
#------------------------------------------------------------------------------
  if ($#ARGV == -1)
    {
      $ignore_value = print_help_info ();
      return (0);
    }

#------------------------------------------------------------------------------
# This part is like a preamble.  Before we continue we need to figure out some
# things that are needed later on.
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# Store the absolute path of the command executed.
#------------------------------------------------------------------------------
  my $location_gp_command = $0;

#------------------------------------------------------------------------------
# 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 warnings and
# errors.  The warnings, if any, will be printed once the command line has
# been parsed and verified.  Execution continues.
#
# Any error(s) accumulated in this phase will be printed after the command
# line has been parsed and verified.  Execution is then terminated.
#
# 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.
#------------------------------------------------------------------------------
  my ($found_exp_dir_ref, $exp_dir_list_ref) = parse_and_check_user_options ();

$found_exp_dir = ${ $found_exp_dir_ref };

if ($found_exp_dir)
    {
      @exp_dir_list = @{ $exp_dir_list_ref };
    }
  else
    {
      $msg = "the list with experiments is either missing, or incorrect";
      gp_message ("debug", $subr_name, $msg);
    }

#------------------------------------------------------------------------------
# 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 };

$msg = "the home directory is $home_dir";
  gp_message ("debug", $subr_name, $msg);

#------------------------------------------------------------------------------
# TBD: de-activated until this feature has been fully implemented.
#------------------------------------------------------------------------------
##  $msg =  "the search path for the rc file is @rc_file_paths";
##  gp_message ("debug", $subr_name, $msg);
##  $pretty_dir_list = build_pretty_dir_list (\@rc_file_paths);

#------------------------------------------------------------------------------
# Get the ball rolling.  Parse and interpret the configuration file (if any)
# and the command line options.
#
# Note that the verbose, debug, and quiet options can be set in this file.
# It is a deliberate choice to ignore these for now.  The assumption is that
# the user will not be happy if we ignore the command line settings for a
# while.
#------------------------------------------------------------------------------
  $msg = "processing of the rc file has been disabled for now";
  gp_message ("debugXL", $subr_name, $msg);

# Temporarily disabled
# print_table_user_settings ("debugXL", "before function process_rc_file");
# $rc_file_errors = process_rc_file ($rc_file_name, $rc_file_paths_ref);
# if ($rc_file_errors != 0)
# {
#   $message = "fatal errors in file $rc_file_name encountered";
#   gp_message ("debugXL", $subr_name, $message);
# }
# print_table_user_settings ("debugXL", "after function process_rc_file");

#------------------------------------------------------------------------------
# Print a list with the experiment directory names
#------------------------------------------------------------------------------
  $pretty_dir_list = build_pretty_dir_list (\@exp_dir_list);

my $plural = ($#exp_dir_list > 0) ? "directories are" : "directory is";

$msg = "the experiment " . $plural . ":";
  gp_message ("verbose", $subr_name, $msg);
  gp_message ("verbose", $subr_name, $pretty_dir_list);

#------------------------------------------------------------------------------
# Set up the first entry with the meta data for the experiments.  This field
# contains the absolute paths to the experiment directories.
#------------------------------------------------------------------------------
  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;
    }

#------------------------------------------------------------------------------
# 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.
#------------------------------------------------------------------------------
  ($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);

if ($consistency_errors == 0)
    {
      $msg = "the experiment directories are consistent";
      gp_message ("verbose", $subr_name, $msg);
    }
  else
    {
      $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"};

$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.
#------------------------------------------------------------------------------
  $g_path_to_tools = ${ check_availability_tool (\$location_gp_command)};

$GP_DISPLAY_TEXT = $g_path_to_tools . $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.
# If not, print a warning only, since this may not be fatal but could
# potentially lead to issues later on.
#------------------------------------------------------------------------------
  if (not is_file_executable ($GP_DISPLAY_TEXT))
    {
      $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) =
                                                determine_decimal_separator ();

if ($return_code == 0)
    {
      $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
    {
      $msg  = "the decimal separator cannot be determined -";
      $msg .= " set to $decimal_separator";
      gp_message ("warning", $subr_name, $msg);
    }

#------------------------------------------------------------------------------
# Collect and store the system information.
#------------------------------------------------------------------------------
  $msg = "collect system information and adapt settings";
  gp_message ("verbose", $subr_name, $msg);

$return_code = get_system_config_info ();

#------------------------------------------------------------------------------
# The 3 variables below are used in the remainder.
#
# The output from "uname -p" is recommended to be used for the ISA.
#------------------------------------------------------------------------------
  my $hostname_current = $local_system_config{hostname_current};
  my $arch_uname_s     = $local_system_config{kernel_name};
  my $arch_uname       = $local_system_config{processor};

gp_message ("debug", $subr_name, "set hostname_current = $hostname_current");
  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
# includes several definitions of regular expressions.
#------------------------------------------------------------------------------
  ($architecture_supported, $elf_arch, $elf_support) =
		set_system_specific_variables ($arch_uname, $arch_uname_s);

$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)
    {
      $msg  = "g_arch_specific_settings{$feature} = ";
      $msg .= $g_arch_specific_settings{$feature};
      gp_message ("debug", $subr_name, $msg);
    }

$arch       = $g_arch_specific_settings{"arch"};
  $subexp     = $g_arch_specific_settings{"subexp"};
  $linksubexp = $g_arch_specific_settings{"linksubexp"};

$g_locale_settings{"LANG"} =  get_LANG_setting ();

$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.
#------------------------------------------------------------------------------
  $ignore_value = reset_selected_settings ();

#------------------------------------------------------------------------------
# TBD: Revisit. Is this really necessary?
#------------------------------------------------------------------------------

($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;

$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 () };

$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.
#
# TBD: Push this into a subroutine(s).
#------------------------------------------------------------------------------
  $outputdir = append_forward_slash ($outputdir);

gp_message ("debug", $subr_name, "prepared outputdir = $outputdir");

#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
# ******* TBD: e.system not available on Linux!!
#------------------------------------------------------------------------------
#------------------------------------------------------------------------------

##  my $summary_metrics       = 'e.totalcpu';
  $detail_metrics        = 'e.totalcpu';
  $detail_metrics_system = 'e.totalcpu:e.system';
  $call_metrics          = 'a.totalcpu';

my $cmd_options;
  my $metrics_cmd;

my $outfile1      = $outputdir   ."metrics";
  my $outfile2      = $outputdir . "metrictotals";
  my $gp_error_file = $outputdir . $g_gp_error_logfile;

#------------------------------------------------------------------------------
# Execute the $GP_DISPLAY_TEXT tool with the appropriate options.  The goal is
# to get all the output in files $outfile1 and $outfile2.  These are then
# parsed.
#------------------------------------------------------------------------------
  $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);

if ($return_code != 0)
    {
      gp_message ("abort", $subr_name, "execution terminated");
    }

#------------------------------------------------------------------------------
# TBD: Test this code
#------------------------------------------------------------------------------
  $msg = "unable to open metric value data file $outfile1 for reading:";
  open (METRICS, "<", $outfile1)
    or die ($subr_name . " - " . $msg . " " . $!);

$msg = "opened file $outfile1 for reading";
  gp_message ("debug", $subr_name, "opened file $outfile1 for reading");

chomp (@metrics_data = <METRICS>);
  close (METRICS);

for my $i (keys @metrics_data)
    {
      $msg = "metrics_data[$i] = " . $metrics_data[$i];
      gp_message ("debugXL", $subr_name, $msg);
    }

#------------------------------------------------------------------------------
# Process the generated metrics data.
#------------------------------------------------------------------------------
  if ($g_user_settings{"default_metrics"}{"current_value"} eq "off")

#------------------------------------------------------------------------------
# The metrics will be derived from the experiments.
#------------------------------------------------------------------------------
    {
      gp_message ("verbose", $subr_name, "Process the metrics data");

($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);

%metric_value                = %{ $metric_value_ref };
      %metric_description          = %{ $metric_description_ref };
      %metric_found                = %{ $metric_found_ref };
      %metric_description_reversed = reverse %metric_description;

$msg = "after the call to process_metrics_data";
      gp_message ("debugXL", $subr_name, $msg);

for my $metric (sort keys %metric_value)
        {
          $msg = "metric_value{$metric} = " . $metric_value{$metric};
          gp_message ("debugXL", $subr_name, $msg);
        }
      for my $metric (sort keys %metric_description)
        {
          $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");
      gp_message ("debugXL", $subr_name, "wall_metrics   = $wall_metrics");
    }
  else
    {
#------------------------------------------------------------------------------
# A default set of metrics will be used.
#
# TBD: These should be OS dependent.
#------------------------------------------------------------------------------
      $msg = "select the set of default metrics";
      gp_message ("verbose", $subr_name, $msg);

($metric_description_ref, $metric_found_ref, $summary_metrics,
       $detail_metrics, $detail_metrics_system, $call_metrics
       ) = set_default_metrics ($outfile1, \%ignored_metrics);

%metric_description          = %{ $metric_description_ref };
      %metric_found                = %{ $metric_found_ref };
      %metric_description_reversed = reverse %metric_description;

$msg = "after the call to set_default_metrics";
      gp_message ("debug", $subr_name, $msg);

}

$number_of_metrics = split (":", $summary_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)
    {
      $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}))
        {
          $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.
#------------------------------------------------------------------------------
  $msg = "generate the experiment information";
  gp_message ("verbose", $subr_name, $msg);

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"} . " => " .
                $experiment_data[$i]{"exp_name_full"};
      gp_message ("debugM", $subr_name, $msg);
    }

$experiment_data_ref = process_experiment_info ($experiment_data_ref);
  @experiment_data = @{ $experiment_data_ref };

for my $i (sort keys @experiment_data)
    {
      for my $fields (sort keys %{ $experiment_data[$i] })
        {
          my $msg = "i = $i experiment_data[$i]{$fields} = " .
                    $experiment_data[$i]{$fields};
          gp_message ("debugXL", $subr_name, $msg);
        }
    }

@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 = @{ $table_execution_stats_ref };

#------------------------------------------------------------------------------
# Get the function overview.
#------------------------------------------------------------------------------
  $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);

@sort_fields = @{$sort_fields_ref};

#------------------------------------------------------------------------------
# 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);

($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 };
  %addressobjtextm            = %{ $addressobjtextm_ref };
  %LINUX_vDSO                 = %{ $LINUX_vDSO_ref };
  %function_view_structure    = %{ $function_view_structure_ref };

$msg = "found " . $g_total_function_count . " functions to process";
  gp_message ("verbose", $subr_name, $msg);

for my $keys (0 .. $#function_info)
    {
      for my $fields (keys %{$function_info[$keys]})
        {
          $msg = "$keys $fields $function_info[$keys]{$fields}";
          gp_message ("debugXL", $subr_name, $msg);
        }
    }

for my $i (keys %addressobjtextm)
    {
      $msg = "addressobjtextm{$i} = " . $addressobjtextm{$i};
      gp_message ("debugXL", $subr_name, $msg);
    }

$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,
                                                     $sort_fields_ref);

$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,
                    \@sort_fields);

$msg = "for each function, generate a set of files";
  gp_message ("verbose", $subr_name, $msg);

($function_info_ref, $function_address_info_ref, $addressobj_index_ref) =
			process_function_files (\@exp_dir_list,
						$executable_name,
						$time_percentage_multiplier,
						$summary_metrics,
						$process_all_functions,
						$elf_loadobjects_found,
						$outputdir,
						\@sort_fields,
						\@function_info,
						\%function_address_and_index,
						\%LINUX_vDSO,
						\%metric_description,
						$elf_arch,
						$base_va_executable,
						$ARCHIVES_MAP_NAME,
						$ARCHIVES_MAP_VADDR,
						\%elf_rats);

@function_info         = @{ $function_info_ref };
  %function_address_info = %{ $function_address_info_ref };
  %addressobj_index      = %{ $addressobj_index_ref };

#------------------------------------------------------------------------------
# Parse the disassembly information and generate the html files.
#------------------------------------------------------------------------------
  $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);

#------------------------------------------------------------------------------
# Parse the source information 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.
#------------------------------------------------------------------------------
  $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);

#------------------------------------------------------------------------------
# Parse the calltree information and generate the html files.
#------------------------------------------------------------------------------
  if ($g_user_settings{"calltree"}{"current_value"} eq "on")
    {
      $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);
    }

#------------------------------------------------------------------------------
# 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);

#------------------------------------------------------------------------------
# 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);

$html_first_metric_file = ${ $html_first_metric_file_ref };

$msg = "html_first_metric_file = " . $html_first_metric_file;
  gp_message ("debugXL", $subr_name, $msg);

$html_test = ${ generate_home_link ("left") };
  $msg = "html_test = " . $html_test;
  gp_message ("debugXL", $subr_name, $msg);

#------------------------------------------------------------------------------
# Unconditionnaly generate the page with the warnings.
#------------------------------------------------------------------------------
  $ignore_value = html_create_warnings_page (\$outputdir);

#------------------------------------------------------------------------------
# Generate the index.html file.
#------------------------------------------------------------------------------
  $msg = "generate the index.html file";
  gp_message ("verbose", $subr_name, $msg);

$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.
#------------------------------------------------------------------------------
  $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";
  gp_message ("diag", $subr_name, $prologue_text);

return (0);

} #-- End of subroutine main

#------------------------------------------------------------------------------
# If it is not present, add a "/" to the name of the argument.  This is
# intended to be used for the name of the output directory and makes it
# easier to construct pathnames.
#------------------------------------------------------------------------------
sub append_forward_slash
{
  my $subr_name = get_my_name ();

my ($input_string) = @_;

my $length_of_string = length ($input_string);
  my $return_string    = $input_string;

if (rindex ($input_string, "/") != $length_of_string-1)
    {
      $return_string .= "/";
    }

return ($return_string);

} #-- End of subroutine append_forward_slash

#------------------------------------------------------------------------------
# Return a string with a comma separated list of directory names.
#------------------------------------------------------------------------------
sub build_pretty_dir_list
{
  my $subr_name = get_my_name ();

my ($dir_list_ref) = @_;

my @dir_list = @{ $dir_list_ref};

my $pretty_dir_list = join ("\n", @dir_list);

return ($pretty_dir_list);

} #-- End of subroutine build_pretty_dir_list

#------------------------------------------------------------------------------
# Calculate the target address in hex by adding the instruction to the
# instruction address.
#------------------------------------------------------------------------------
sub calculate_target_hex_address
{
  my $subr_name = get_my_name ();

my ($instruction_address, $instruction_offset) = @_;

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 $result;

if ($g_addressing_mode eq "64 bit")
    {
      $mask = "0xffffffffffffffff";
      $number_of_fields = 16;
    }
  else
    {
      $msg = "g_addressing_mode = $g_addressing_mode not supported";
      gp_message ("abort", $subr_name, $msg);
    }

$length_of_string = length ($instruction_offset);
  $first_char       = lcfirst (substr ($instruction_offset,0,1));
  $d1               = bigint::hex ($instruction_offset);
  $d2               = bigint::hex ($mask);
#          if ($first_char eq "f")
  if (($first_char =~ /[89a-f]/) and ($length_of_string == $number_of_fields))
    {
#------------------------------------------------------------------------------
# The offset is negative.  Convert to decimal and perform the subtrraction.
#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
# XOR the decimal representation and add 1 to the result.
#------------------------------------------------------------------------------
      $result = ($d1 ^ $d2) + 1;
      $dec_branch_target = bigint::hex ($instruction_address) - $result;
    }
  else
    {
      $result = $d1;
      $dec_branch_target = bigint::hex ($instruction_address) + $result;
    }
#------------------------------------------------------------------------------
# Convert to hexadecimal.
#------------------------------------------------------------------------------
  $raw_hex_branch_target = sprintf ("%x", $dec_branch_target);

return ($raw_hex_branch_target);

} #-- End of subroutine calculate_target_hex_address

#------------------------------------------------------------------------------
# Sets the absolute path to all commands in array @cmds.
#
# First, it is checked if the command is in the search path, built-in, or an
# alias.  If this is not the case, search for it in a couple of locations.
#
# If this all fails, warning messages are printed, but this is not a hard
# error. Yet. Most likely, things will go bad later on.
#
# The commands and their respective paths are stored in hash "g_mapped_cmds".
#------------------------------------------------------------------------------
sub check_and_define_cmds
{
  my $subr_name = get_my_name ();

my ($cmds_ref, $search_path_ref) = @_;

#------------------------------------------------------------------------------
# Dereference the array addressess first and then store the contents.
#------------------------------------------------------------------------------
  my @cmds        = @{$cmds_ref};
  my @search_path = @{$search_path_ref};

my @the_fields = ();

my $cmd;
  my $cmd_found;
  my $error_code;
  my $failed_cmd;
  my $failed_cmds;
  my $found_match;
  my $mapped;
  my $msg;
  my $no_of_failed_mappings;
  my $no_of_fields;
  my $output_cmd;
  my $target_cmd;
  my $failed_mapping = $FALSE;
  my $full_path_cmd;

gp_message ("debugXL", $subr_name, "\@cmds = @cmds");
  gp_message ("debugXL", $subr_name, "\@search_path = @search_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 $cmd (@cmds)
    {
      $target_cmd = "(command -v $cmd; echo \$\?)";

($error_code, $output_cmd) = execute_system_cmd ($target_cmd);

if ($error_code != 0)
#------------------------------------------------------------------------------
# This is unlikely to happen, since it means the command executed failed.
#------------------------------------------------------------------------------
        {
          $msg = "error executing this command: " . $target_cmd;
          gp_message ("warning", $subr_name, $msg);
          $msg = "execution continues, but may fail later on";
          gp_message ("warning", $subr_name, $msg);

$g_total_warning_count++;
        }
      else
#------------------------------------------------------------------------------
# So far, all is well, but is the target command available?
#------------------------------------------------------------------------------
        {
#------------------------------------------------------------------------------
# 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;
                }
            }
        }
    }

#------------------------------------------------------------------------------
# Scan the results stored in $g_mapped_cmds and flag errors.
#------------------------------------------------------------------------------
  $no_of_failed_mappings = 0;
  $failed_cmds           = "";

#------------------------------------------------------------------------------
# Print a warning message before showing the results, that at least one search
# has failed.
#------------------------------------------------------------------------------
  if ($failed_mapping)
    {
      $msg  = "<br>" . "failure in the verification of the OS commands:";
      gp_message ("warning", $subr_name, $msg);
    }

while ( ($cmd, $mapped) = each %g_mapped_cmds)
    {
      if ($mapped eq "road to nowhere")
        {
          $msg  = "cannot find a path for command $cmd";
          gp_message ("warning", $subr_name, $msg);
          gp_message ("debug", $subr_name, $msg);

$no_of_failed_mappings++;
          $failed_cmds .= $cmd;
          $g_mapped_cmds{$cmd} = $cmd;
        }
      else
       {
          $msg = "path for the $cmd command is $mapped";
          gp_message ("debug", $subr_name, $msg);
       }
    }
  if ($no_of_failed_mappings != 0)
    {
      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);

} #-- End of subroutine check_and_define_cmds

my ($input_line_ref, $line_no_ref,  $branch_target_ref,
      $extended_branch_target_ref, $branch_target_no_ref_ref) = @_;

my $input_line = ${ $input_line_ref };
  my $line_no    = ${ $line_no_ref };
  my %branch_target = %{ $branch_target_ref };
  my %extended_branch_target = %{ $extended_branch_target_ref };
  my %branch_target_no_ref = %{ $branch_target_no_ref_ref };

my $found_it = $TRUE;
  my $hex_branch_target;
  my $instruction_address;
  my $instruction_offset;
  my $msg;
  my $raw_hex_branch_target;

if (   ($input_line =~ /$g_branch_regex/)
      or ($input_line =~ /$g_endbr_regex/))
    {
      if (defined ($3))
        {
          $msg = "found a branch or endbr instruction: " .
                 "\$1 = $1 \$2 = $2 \$3 = $3";
        }
      else
        {
          $msg = "found a branch or endbr instruction: " .
                 "\$1 = $1 \$2 = $2";
        }
      gp_message ("debugXL", $subr_name, $msg);

if (defined ($1))
        {
#------------------------------------------------------------------------------
# Found a qualifying instruction
#------------------------------------------------------------------------------
          $instruction_address = $1;
          if (defined ($3))
            {
#------------------------------------------------------------------------------
# This must be the branch target and needs to be converted and processed.
#------------------------------------------------------------------------------
              $instruction_offset  = $3;
              $raw_hex_branch_target = calculate_target_hex_address (
                                        $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;
            }
          if (defined ($2) and (not defined ($3)))
            {
#------------------------------------------------------------------------------
# Unlike a branch, the endbr32/endbr64 instructions do not have a second field.
#------------------------------------------------------------------------------
              my $instruction_name = $2;
              if ($instruction_name =~ /$g_endbr_inst_regex/)
                {
                  my $msg = "found endbr: $instruction_name " .
                            $instruction_address;
                  gp_message ("debugXL", $subr_name, $msg);
                  $raw_hex_branch_target = $instruction_address;

$hex_branch_target = "0x" . $raw_hex_branch_target;
                  $branch_target_no_ref{$instruction_address} = 1;
                }
            }
        }
      else
        {
#------------------------------------------------------------------------------
# TBD: Perhaps this should be an assertion or alike.
#------------------------------------------------------------------------------
          $branch_target{"0x0000"} = $FALSE;
          $msg = "cannot determine branch target";
          gp_message ("debug", $subr_name, $msg);
        }
    }
  else
    {
      $found_it = $FALSE;
    }

return (\$found_it, \%branch_target, \%extended_branch_target,
         \%branch_target_no_ref);

} #-- End of subroutine check_and_proc_dis_branches

#------------------------------------------------------------------------------
# Check an input line from the disassembly file to include a function call.
# If it does, process the line and return the branch target results.
#------------------------------------------------------------------------------
sub check_and_proc_dis_func_call
{
  my $subr_name = get_my_name ();

my ($input_line_ref, $line_no_ref,  $branch_target_ref,
      $extended_branch_target_ref) = @_;

my $input_line = ${ $input_line_ref };
  my $line_no    = ${ $line_no_ref };
  my %branch_target = %{ $branch_target_ref };
  my %extended_branch_target = %{ $extended_branch_target_ref };

my $found_it = $TRUE;
  my $hex_branch_target;
  my $instruction_address;
  my $instruction_offset;
  my $msg;
  my $raw_hex_branch_target;

if ( $input_line =~ /$g_function_call_v2_regex/ )
    {
      $msg = "found a function call - line[$line_no] = $input_line";
      gp_message ("debugXL", $subr_name, $msg);
      if (not defined ($2))
        {
          $msg = "line[$line_no] " .
                 "an instruction address is expected, but not found";
          gp_message ("assertion", $subr_name, $msg);
        }
      else
        {
          $instruction_address = $2;

$msg = "instruction_address = $instruction_address";
          gp_message ("debugXL", $subr_name, $msg);

if (not defined ($4))
            {
              $msg = "line[$line_no] " .
                     "an address offset is expected, but not found";
              gp_message ("assertion", $subr_name, $msg);
            }
          else
            {
              $instruction_offset = $4;
              if ($instruction_offset =~ /[0-9a-fA-F]+/)
                {
                  $msg = "calculate branch target: " .
                         "instruction_address = $instruction_address";
                  gp_message ("debugXL", $subr_name, $msg);
                  $msg = "calculate branch target: " .
                         "instruction_offset  = $instruction_offset";
                  gp_message ("debugXL", $subr_name, $msg);

#------------------------------------------------------------------------------
# The instruction offset needs to be converted and added to the instruction
# address.
#------------------------------------------------------------------------------
                  $raw_hex_branch_target = calculate_target_hex_address (
                                            $instruction_address,
                                            $instruction_offset);
                  $hex_branch_target     = "0x" . $raw_hex_branch_target;

$msg = "calculated hex_branch_target = " .
                         $hex_branch_target;
                  gp_message ("debugXL", $subr_name, $msg);

$branch_target{$hex_branch_target} = 1;
                  $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}";
                  $msg .= " = $extended_branch_target{$instruction_address}";
                  gp_message ("debugXL", $subr_name, $msg);
                }
              else
                {
                  $msg = "line[$line_no] unknown address format";
                  gp_message ("assertion", $subr_name, $msg);
                }
            }
        }
    }
  else
    {
      $found_it = $FALSE;
    }

return (\$found_it, \%branch_target, \%extended_branch_target);

} #-- End of subroutine check_and_proc_dis_func_call

#------------------------------------------------------------------------------
# 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 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
{
  my $subr_name = get_my_name ();

my ($location_gp_command_ref) = @_;

my $error_code;
  my $error_occurred;
  my $gp_path;
  my $msg;
  my $output_which_gp_display_text;
  my $return_value;
  my $target_cmd;

#------------------------------------------------------------------------------
# Get the path to gp-display-text.
#------------------------------------------------------------------------------
  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)
#------------------------------------------------------------------------------
# All is well and gp-display-text has been located.
#------------------------------------------------------------------------------
    {
      $g_path_to_tools = $return_value;

$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);
    }
  else
#------------------------------------------------------------------------------
# Something went wrong, but perhaps we can still continue.  Try to find
# $GP_DISPLAY_TEXT through the search path.
#------------------------------------------------------------------------------
    {
      $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 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);

if ($error_code == 0)
        {
          my ($gp_file_name, $gp_path, $suffix_not_used) =
                                     fileparse ($output_which_gp_display_text);
          $g_path_to_tools = $gp_path;

$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 ("error", $subr_name, $msg);

$g_total_error_count++;

gp_message ("abort", $subr_name, $g_abort_msg);
        }
     }

return (\$g_path_to_tools);

} #-- End of subroutine 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
# possible bug.
#
# Also, by isolating the tests for the input files, another nesting level could
# be eliminated, further simplifying this still too complex code.
#------------------------------------------------------------------------------
sub check_loadobjects_are_elf
{
  my $subr_name = get_my_name ();

my ($selected_archive) = @_;

my $event_kind_map_regex;
  $event_kind_map_regex  = '^<event kind="map"\s.*vaddr=';
  $event_kind_map_regex .= '"0x([0-9a-fA-F]+)"\s+.*foffset=';
  $event_kind_map_regex .= '"\+*0x([0-9a-fA-F]+)"\s.*modes=';
  $event_kind_map_regex .= '"0x([0-9]+)"\s.*name="(.*)".*>$';

my $hostname_current = $local_system_config{"hostname_current"};
  my $arch             = $local_system_config{"processor"};
  my $arch_uname_s     = $local_system_config{"kernel_name"};

my $extracted_information;

my $elf_magic_number;

my $executable_name;
  my $va_executable_in_hex;

my $arch_exp;
  my $hostname_exp;
  my $os_exp;
  my $os_exp_full;

my $archives_file;
  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_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 .= $selected_archive;
  $path_to_log_file .= "/log.xml";

gp_message ("debug", $subr_name, "hostname_current = $hostname_current");
  gp_message ("debug", $subr_name, "arch             = $arch");
  gp_message ("debug", $subr_name, "arch_uname_s     = $arch_uname_s");

#------------------------------------------------------------------------------
# TBD
#
# 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 . $msg . " " . $!);

$msg = "opened file $path_to_log_file for reading";
  gp_message ("debug", $subr_name, $msg);

while (<LOG_XML>)
    {
      $line = $_;
      chomp ($line);
      gp_message ("debugM", $subr_name, "read line: $line");
#------------------------------------------------------------------------------
# Search for the first line starting with "<system".  Bail out if found and
# parsed. These are two examples:
# <system hostname="ruud-vm" arch="x86_64" \
# os="Linux 4.14.35-2025.400.8.el7uek.x86_64" pagesz="4096" npages="30871514">
#------------------------------------------------------------------------------
      if ($line =~ /^\s*<system\s+/)
        {
          $msg = "selected the following line from the log.xml file:";
          gp_message ("debugM", $subr_name, $msg);
          gp_message ("debugM", $subr_name, "$line");
          if ($line =~ /.*\s+hostname="([^"]+)/)
            {
              $hostname_exp = $1;
              $msg = "extracted hostname_exp = " . $hostname_exp;
              gp_message ("debugM", $subr_name, $msg);
            }
          if ($line =~ /.*\s+arch="([^"]+)/)
            {
              $arch_exp = $1;
              $msg = "extracted arch_exp = " . $arch_exp;
              gp_message ("debugM", $subr_name, $msg);
            }
          if ($line =~ /.*\s+os="([^"]+)/)
            {
              $os_exp_full = $1;
#------------------------------------------------------------------------------
# Capture the first word only.
#------------------------------------------------------------------------------
              if ($os_exp_full =~ /([^\s]+)/)
                {
                  $os_exp = $1;
                }
              $msg = "extracted os_exp = " . $os_exp;
              gp_message ("debugM", $subr_name, $msg);
            }
          last;
        }
    } #-- End of while loop

close (LOG_XML);

#------------------------------------------------------------------------------
# If the current system is identical to the system used in the experiment,
# we can return early.  Otherwise we need to dig deeper.
#
# TBD: How about the other experiment directories?! This needs to be fixed.
#------------------------------------------------------------------------------

gp_message ("debug", $subr_name, "completed while loop");
  gp_message ("debug", $subr_name, "hostname_exp     = $hostname_exp");
  gp_message ("debug", $subr_name, "arch_exp         = $arch_exp");
  gp_message ("debug", $subr_name, "os_exp           = $os_exp");

#TBD: THIS DOES NOT CHECK IF ELF IS FOUND!

if (($hostname_current eq $hostname_exp) and
      ($arch             eq $arch_exp)     and
      ($arch_uname_s     eq $os_exp))
        {
          $msg  = "early return: the hostname, architecture and OS match";
          $msg .= " the current system";
          gp_message ("debug", $subr_name, $msg);
          $msg = "FAKE THIS IS NOT THE CASE AND CONTINUE";
          gp_message ("debug", $subr_name, $msg);
# FAKE          return ($TRUE);
        }

if (not $g_exp_dir_meta_data{$selected_archive}{"archive_is_empty"})
    {
      $msg = "selected_archive = " . $selected_archive;
      gp_message ("debug", $subr_name, $msg);
      for my $i (sort keys
		   %{$g_exp_dir_meta_data{$selected_archive}{"archive_files"}})
        {
          $msg  = "stored loadobject " . $i . " ";
          $msg .= $g_exp_dir_meta_data{$selected_archive}{"archive_files"}{$i};
          gp_message ("debug", $subr_name, $msg);
        }
    }

#------------------------------------------------------------------------------
# Check if the selected experiment directory has archived files in ELF format.
# If not, use the information in map.xml to get the name of the executable
# and the virtual address.
#------------------------------------------------------------------------------

if ($g_exp_dir_meta_data{$selected_archive}{"archive_in_elf_format"})
    {
      $msg  = "the files in directory $selected_archive/archives are in";
      $msg .= " ELF format";
      gp_message ("debugM", $subr_name, $msg);
      $msg = "IGNORE THIS AND USE MAP.XML";
      gp_message ("debugM", $subr_name, $msg);
##      return ($TRUE);
    }

$msg  = "the files in directory $selected_archive/archives are not in";
  $msg .= " ELF format";
  gp_message ("debug", $subr_name, $msg);

$path_to_map_file  =
		$g_exp_dir_meta_data{$selected_archive}{"directory_path"};
  $path_to_map_file .= $selected_archive;
  $path_to_map_file .= "/map.xml";

$msg  = " - unable to open file $path_to_map_file for reading:";
  open (MAP_XML, "<", $path_to_map_file)
    or die ($subr_name . $msg . " " . $!);
  $msg = "opened file $path_to_map_file for reading";
  gp_message ("debug", $subr_name, $msg);

#------------------------------------------------------------------------------
# Scan the map.xml file.  We need to find the name of the executable with the
# mode set to 0x005.  For this entry we have to capture the virtual address.
#------------------------------------------------------------------------------
  $extracted_information = $FALSE;
  while (<MAP_XML>)
    {
      $line = $_;
      chomp ($line);
      gp_message ("debugM", $subr_name, "MAP_XML read line = $line");
#------------------------------------------------------------------------------
# Replaces this way too long line:
#     if ($line =~   /^<event kind="map"\s.*vaddr="0x([0-9a-fA-F]+)"\s+.
#     *foffset="\+*0x([0-9a-fA-F]+)"\s.*modes="0x([0-9]+)"\s.*
#     name="(.*)".*>$/)
#------------------------------------------------------------------------------
      if ($line =~ /$event_kind_map_regex/)
        {
          gp_message ("debugM", $subr_name, "target line = $line");
          $vaddr     = $1;
          $foffset   = $2;
          $modes     = $3;
          $name_path = $4;
          $name      = get_basename ($name_path);
          $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;

$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;
              last;
            }
        }
    }

close (MAP_XML);

if (not $extracted_information)
    {
      $msg  = "cannot find the necessary information in";
      $msg .= " the $path_to_map_file file";
      gp_message ("assertion", $subr_name, $msg);
    }

##  $executable_name = $ARCHIVES_MAP_NAME;
##  $va_executable_in_hex = $ARCHIVES_MAP_VADDR;

return ($executable_name, $va_executable_in_hex);

} #-- End of subroutine check_loadobjects_are_elf

#------------------------------------------------------------------------------
# Compare the current metric values against the maximum values.  Mark the line
# if a value is within the percentage defined by $hp_value.
#------------------------------------------------------------------------------
sub check_metric_values
{
  my $subr_name = get_my_name ();

my ($metric_values, $max_metric_values_ref) = @_;

my @max_metric_values = @{ $max_metric_values_ref };

my @current_metrics = ();
  my $colour_coded_line;
  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);
  $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];

$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?
              $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)
                {
                  $msg = "metric $metric is within the relative_distance";
                  gp_message ("debugXL", $subr_name, $msg);

$colour_coded_line = $TRUE;
                  last;
                }
            }
        }
    } #-- End of loop over metrics

return (\$colour_coded_line);

} #-- End of subroutine check_metric_values

#------------------------------------------------------------------------------
# Check if the system is supported.
#------------------------------------------------------------------------------
sub check_support_for_processor
{
  my $subr_name = get_my_name ();

my ($machine_ref) = @_;

my $machine = ${ $machine_ref };
  my $is_supported;

if ($machine eq "x86_64")
    {
      $is_supported = $TRUE;
    }
  else
    {
      $is_supported = $FALSE;
    }

return (\$is_supported);

} #-- End of subroutine check_support_for_processor

#------------------------------------------------------------------------------
# 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.
#
# 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 following patterns are supposed to be detected:
#
# <expdir_1> some other word(s) <expdir_2>
# <expdir> some other word(s)
#------------------------------------------------------------------------------
sub check_the_experiment_list
{
  my $subr_name = get_my_name ();

#------------------------------------------------------------------------------
# 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 $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;

for my $i (keys @ARGV)
    {
      $current_value = $ARGV[$i];
      if ($current_value =~ /$exp_dir_regex/)
#------------------------------------------------------------------------------
# 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.
#------------------------------------------------------------------------------
        {
          $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).
#------------------------------------------------------------------------------
            {
              $found_experiment = $TRUE;
            }
#------------------------------------------------------------------------------
# We had found non-experiment names and now see another experiment.  Time to
# bail out of the loop.
#------------------------------------------------------------------------------
          if ($found_non_exp)
            {
              last;
            }
        }
      else
        {
          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;
            }
        }

}

#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
# 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++;
        }
    }

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";

$msg = $plural_or_single . " not valid";
##      gp_message ("abort", $subr_name, $msg);

##      $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 ();

my ($exp_dir_list_ref) = @_;

my @exp_dir_list = @{ $exp_dir_list_ref };

my %elf_rats = ();

my $dir_not_found    = $FALSE;
  my $missing_dirs     = 0;
  my $invalid_dirs     = 0;

my $archive_dir_not_empty;
  my $archives_dir;
  my $archives_file;
  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;
  my $archive_dir_selected;
  my $no_of_files_in_selected_archive;

#------------------------------------------------------------------------------
# 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;
    }
#------------------------------------------------------------------------------
# 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"};
      $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;

$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 ($_);

$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;

$msg = "last_dot = $last_dot";
          gp_message ("debugXL", $subr_name, $msg);

while ($underscore_before_dot)
            {
              $first_underscore = index ($filename, "_", $first_underscore+1);
              if ($last_dot < $first_underscore)
                {
                  $underscore_before_dot = $FALSE;
                }
            }
          my $original_name  = substr ($filename, 0, $first_underscore);
          $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;
              $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"};
      $msg  = "archive directory " . $exp_dir . "/archives is";
      $msg .= " " . ($empty ? "empty" : "not empty");
      gp_message ("debug", $subr_name, $msg);
    }

#------------------------------------------------------------------------------
# Verify that all relevant files in the archive directories are in ELF format.
#------------------------------------------------------------------------------
  for my $exp_dir (sort keys %g_exp_dir_meta_data)
    {
      $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"};
          $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"}})
            {
              $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 ($subr_name . $msg . " " . $!);

$first_line = <ARCF>;
              close (ARCF);

#------------------------------------------------------------------------------
# The first 4 hex fields in the header of an ELF file are: 7F 45 4c 46 (7FELF).
#
# See also https://en.wikipedia.org/wiki/Executable_and_Linkable_Format
#------------------------------------------------------------------------------
#              if ($first_line =~ /^\177ELF.*/)

$elf_magic_number = unpack ('H8', $first_line);
              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}{"elf_format"} = $TRUE;
                  last;
                }
            }
        }
    }

for my $exp_dir (sort keys %g_exp_dir_meta_data)
    {
      $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"})
        {
          $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 message
# is issued.
#
# TBD: Bail out?
#------------------------------------------------------------------------------
  $count_exp_dir_not_elf = 0;
  for my $exp_dir (sort keys %g_exp_dir_meta_data)
    {
      if (not $g_exp_dir_meta_data{$exp_dir}{"archive_in_elf_format"})
        {
          $count_exp_dir_not_elf++;
        }
    }
  if ($count_exp_dir_not_elf != 0)
    {
      $msg  = "there are $count_exp_dir_not_elf experiments with non-ELF";
      $msg .= " load objects";
      gp_message ("debug", $subr_name, $msg);
    }

#------------------------------------------------------------------------------
# Select the experiment directory that is used for the files in the archive.
# By default, a directory with archived files is used, but in case this does
# not exist, a directory without archived files is selected.  Obviously this
# needs to be dealt with later on.
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# Try the experiments with archived files first.
#------------------------------------------------------------------------------
  $archive_dir_not_empty = $FALSE;
  $archive_dir_selected  = $FALSE;
##  for my $exp_dir (sort @exp_dir_list)
  for my $exp_dir (sort keys %g_exp_dir_meta_data)
    {
      $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;
          last;
        }
    }
  if (not $archive_dir_selected)
#------------------------------------------------------------------------------
# None are found and pick the first one without archived files.
#------------------------------------------------------------------------------
    {
      for my $exp_dir (sort keys %g_exp_dir_meta_data)
        {
          if ($g_exp_dir_meta_data{$exp_dir}{"archive_is_empty"})
            {
              $selected_archive      = $exp_dir;
              $archive_dir_not_empty = $FALSE;
              $archive_dir_selected  = $TRUE;
              $selected_archive_has_elf_format = $FALSE;
              last;
            }
        }
    }

$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"};

$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"};
      $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"}})
            {
              $msg  = $exp_dir . " " . $object . " ";
              $msg .=
		$g_exp_dir_meta_data{$exp_dir}{'archive_files'}{$object};
              gp_message ("debug", $subr_name, $msg);
            }
        }
    }

return ($archive_dir_not_empty, $selected_archive, \%elf_rats);

} #-- End of subroutine check_validity_exp_dirs

#------------------------------------------------------------------------------
# Color the string and optionally mark it boldface.
#
# For supported colors, see:
# https://www.w3schools.com/colors/colors_names.asp
#------------------------------------------------------------------------------
sub color_string
{
  my $subr_name = get_my_name ();

my ($input_string, $boldface, $color) = @_;

my $colored_string;

$colored_string = "<font color='" . $color . "'>";

if ($boldface)
    {
      $colored_string .= "<b>";
    }

$colored_string .= $input_string;

if ($boldface)
    {
      $colored_string .= "</b>";
    }
  $colored_string .= "</font>";

return ($colored_string);

} #-- End of subroutine color_string

#------------------------------------------------------------------------------
# Generate the array with the info on the experiment(s).
#------------------------------------------------------------------------------
sub create_exp_info
{
  my $subr_name = get_my_name ();

my ($experiment_dir_list_ref, $experiment_data_ref) = @_;

my @experiment_dir_list = @{ $experiment_dir_list_ref };
  my @experiment_data     = @{ $experiment_data_ref };

my @experiment_stats_html = ();
  my $experiment_stats_line;
  my $msg;
  my $plural;

$plural = ($#experiment_dir_list > 0) ? "s:" : ":";

$experiment_stats_line  = "<h3>\n";
  $experiment_stats_line .= "Full pathnames to the input experiment";
  $experiment_stats_line .= $plural . "\n";
  $experiment_stats_line .= "</h3>\n";
  $experiment_stats_line .= "<pre>\n";

for my $i (0 .. $#experiment_dir_list)
    {
      $experiment_stats_line .= $experiment_dir_list[$i] . " (" ;
      $experiment_stats_line .= $experiment_data[$i]{"start_date"} . ")\n";
    }
  $experiment_stats_line .= "</pre>\n";

push (@experiment_stats_html, $experiment_stats_line);

$msg = "experiment_stats_line = " . $experiment_stats_line;
  gp_message ("debugXL", $subr_name, $msg);

return (\@experiment_stats_html);

} #-- End of subroutine create_exp_info

#------------------------------------------------------------------------------
# Trivial function to generate a tag.  This has been made a function to ensure
# consistency creating tags and also make it easier to change them.
#------------------------------------------------------------------------------
sub create_function_tag
{
  my $subr_name = get_my_name ();

my ($tag_id) = @_;

my $function_tag = "function_tag_" . $tag_id;

return ($function_tag);

} #-- End of subroutine create_function_tag

#------------------------------------------------------------------------------
# Generate and return a string with the credits.  Note that this also ends
# the HTML formatting controls.
#------------------------------------------------------------------------------
sub create_html_credits
{
  my $subr_name = get_my_name ();

my $msg;
  my $the_date;

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 ();

$year += 1900;

$the_date = $months[$mon] . " " . $mday . ", " . $year;

$msg  = "<i>\n";
  $msg .= "Output generated by the $driver_cmd command ";
  $msg .= "on $the_date ";
  $msg .= "(GNU binutils version " . $binutils_version . ")";
  $msg .= "\n";
  $msg .= "</i>";

gp_message ("debug", $subr_name, "the date = $the_date");

return (\$msg);

} #-- End of subroutine create_html_credits

#------------------------------------------------------------------------------
# Generate a string that contains all the necessary HTML header information,
# plus a title.
#
# See also https://www.w3schools.com for the details on the features used.
#------------------------------------------------------------------------------
sub create_html_header
{
  my $subr_name = get_my_name ();

my ($title_ref) = @_;

my $title = ${ $title_ref };

my $LANG = $g_locale_settings{"LANG"};
  my $background_color = $g_html_color_scheme{"background_color_page"};

my $html_header;

$html_header  = "<!DOCTYPE html public \"-//w3c//dtd html 3.2//en\">\n";
  $html_header .= "<html lang=\"$LANG\">\n";
  $html_header .= "<head>\n";
  $html_header .= "<meta http-equiv=\"content-type\"";
  $html_header .= " content=\"text/html; charset=iso-8859-1\">\n";
  $html_header .= "<title>" . $title . "</title>\n";
  $html_header .= "</head>\n";
  $html_header .= "<body lang=\"$LANG\" bgcolor=". $background_color . ">\n";
  $html_header .= "<style>\n";
  $html_header .= "div.left {\n";
  $html_header .= "text-align: left;\n";
  $html_header .= "}\n";
  $html_header .= "div.right {\n";
  $html_header .= "text-align: right;\n";
  $html_header .= "}\n";
  $html_header .= "div.center {\n";
  $html_header .= "text-align: center;\n";
  $html_header .= "}\n";
  $html_header .= "div.justify {\n";
  $html_header .= "text-align: justify;\n";
  $html_header .= "}\n";
  $html_header .= "</style>";

return (\$html_header);

} #-- End of subroutine create_html_header

#------------------------------------------------------------------------------
# Create a complete table.
#------------------------------------------------------------------------------
sub create_table
{
  my $subr_name = get_my_name ();

my ($experiment_data_ref, $table_definition_ref) = @_;

my @experiment_data  = @{ $experiment_data_ref };
  my @table_definition = @{ $table_definition_ref };

my @html_exp_table_data = ();
  my $html_header_line;
  my $html_table_line;
  my $html_end_table;

$html_header_line = ${ create_table_header_exp (\@experiment_data) };

push (@html_exp_table_data, $html_header_line);

for my $i (sort keys @table_definition)
    {
      $html_table_line = ${
		create_table_entry_exp (\$table_definition[$i]{"name"},
					\$table_definition[$i]{"key"},
					\@experiment_data) };
      push (@html_exp_table_data, $html_table_line);

my $msg = "i = $i html_table_line = $html_table_line";
      gp_message ("debugXL", $subr_name, $msg);
    }

$html_end_table  = "</table>\n";
  push (@html_exp_table_data, $html_end_table);

return (\@html_exp_table_data);

} #-- End of subroutine create_table

#------------------------------------------------------------------------------
# Create one row for the table with experiment info.
#------------------------------------------------------------------------------
sub create_table_entry_exp
{
  my $subr_name = get_my_name ();

my ($entry_name_ref, $key_ref, $experiment_data_ref) = @_;

my $entry_name       = ${ $entry_name_ref };
  my $key              = ${ $key_ref };
  my @experiment_data  = @{ $experiment_data_ref };

my $html_line;
  my $msg;

$msg = "entry_name = $entry_name key = $key";
  gp_message ("debugXL", $subr_name, $msg);

##  $html_line  = "<tr><div class=\"left\"><td><b>&nbsp; ";
  $html_line  = "<tr><div class=\"right\"><td><b>&nbsp; ";
  $html_line .= $entry_name;
  $html_line .= " &nbsp;</b></td>";
  for my $i (sort keys @experiment_data)
    {
      if (exists ($experiment_data[$i]{$key}))
        {
          $html_line .= "<td>&nbsp; " . $experiment_data[$i]{$key};
          $html_line .= " &nbsp;</td>";
        }
      else
        {
          $msg = "experiment_data[$i]{$key} does not exist";
##          gp_message ("assertion", $subr_name, $msg);
# TBD: warning or error?
          gp_message ("warning", $subr_name, $msg);
        }
    }
  $html_line .= "</div></tr>\n";

gp_message ("debugXL", $subr_name, "return html_line = $html_line");

return (\$html_line);

} #-- End of subroutine create_table_entry_exp

#------------------------------------------------------------------------------
# Create the table header for the experiment info.
#------------------------------------------------------------------------------
sub create_table_header_exp
{
  my $subr_name = get_my_name ();

my ($experiment_data_ref) = @_;

my @experiment_data = @{ $experiment_data_ref };
  my $html_header_line;
  my $msg;

$html_header_line  = "<style>\n";
  $html_header_line .= "table, th, td {\n";
  $html_header_line .= "border: 1px solid black;\n";
  $html_header_line .= "border-collapse: collapse;\n";
  $html_header_line .= "}\n";
  $html_header_line .= "</style>\n";
  $html_header_line .= "</pre>\n";
  $html_header_line .= "<table>\n";
  $html_header_line .= "<tr><div class=\"center\"><th></th>";

for my $i (sort keys @experiment_data)
    {
      $html_header_line .= "<th>&nbsp; Experiment ID ";
      $html_header_line .= $experiment_data[$i]{"exp_id"} . "&nbsp;</th>";
    }
  $html_header_line .= "</div></tr>\n";

$msg = "html_header_line = " . $html_header_line;
  gp_message ("debugXL", $subr_name, $msg);

return (\$html_header_line);

} #-- End of subroutine create_table_header_exp

#------------------------------------------------------------------------------
# Handle where the output should go. If needed, a directory is created where
# the results will go.
#------------------------------------------------------------------------------
sub define_the_output_directory
{
  my $subr_name = get_my_name ();

my ($define_new_output_dir, $overwrite_output_dir) = @_;

my $msg;
  my $outputdir;

#------------------------------------------------------------------------------
# If neither -o or -O are set, find the next number to be used in the name for
# the default output directory.
#------------------------------------------------------------------------------
  if ((not $define_new_output_dir) and (not $overwrite_output_dir))
    {
      my $dir_id = 1;
      while (-d "er.".$dir_id.".html")
        { $dir_id++; }
      $outputdir = "er.".$dir_id.".html";
    }

if (-d $outputdir)
    {
#------------------------------------------------------------------------------
# The -o option is used, but the directory already exists.
#------------------------------------------------------------------------------
      if ($define_new_output_dir)
        {
          $msg = "directory $outputdir already exists";
          gp_message ("error", $subr_name, $msg);
          $g_total_error_count++;

$msg  =  "use the -O/--overwrite option to overwrite an existing";
          $msg .= " directory";
          gp_message ("abort", $subr_name, $msg);
        }
#------------------------------------------------------------------------------
# This is a bit risky, so we proceed with caution. The output directory exists,
# but it is okay to overwrite it. It is removed here and created again below.
#------------------------------------------------------------------------------
      elsif ($overwrite_output_dir)
        {
          my $target_cmd = $g_mapped_cmds{"rm"};
          my $rm_output  = qx ($target_cmd -rf $outputdir);
          my $error_code = ${^CHILD_ERROR_NATIVE};
          if ($error_code != 0)
            {
              gp_message ("error", $subr_name, $rm_output);
              $msg = "fatal error when trying to remove " . $outputdir;
              gp_message ("abort", $subr_name, $msg);
            }
          else
            {
              $msg = "directory $outputdir has been removed";
              gp_message ("debug", $subr_name, $msg);
            }
        }
    }
#------------------------------------------------------------------------------
# When we get here, the fatal scenarios have been cleared and the name for
# $outputdir is known. Time to create it.
#------------------------------------------------------------------------------
  if (mkdir ($outputdir, 0777))
    {
      $msg = "created output directory " . $outputdir;
      gp_message ("debug", $subr_name, $msg);
    }
  else
    {
      $msg = "a fatal problem occurred when creating directory " . $outputdir;
      gp_message ("abort", $subr_name, $msg);
    }

return ($outputdir);

} #-- End of subroutine define_the_output_directory

#------------------------------------------------------------------------------
# Return the virtual address for the load object.
#
# Note that at this point, $elf_arch is known to be supported.
#
# TBD: Duplications?
#------------------------------------------------------------------------------
sub determine_base_va_address
{
  my $subr_name = get_my_name ();

my ($executable_name, $base_va_executable, $loadobj, $routine) = @_;

my $msg;
  my $name_loadobject;
  my $base_va_address;

$msg = "base_va_executable = " . $base_va_executable;
  gp_message ("debugXL", $subr_name, $msg);
  $msg = "loadobj            = " . $loadobj;
  gp_message ("debugXL", $subr_name, $msg);
  $msg = "routine            = " . $routine;
  gp_message ("debugXL", $subr_name, $msg);

#------------------------------------------------------------------------------
# Strip the pathname from the load object name.
#------------------------------------------------------------------------------
  $name_loadobject = get_basename ($loadobj);

#------------------------------------------------------------------------------
# If the load object is the executable, return the base address determined
# earlier.  Otherwise return 0x0.  Note that I am not sure if this is always
# the right thing to do, but for .so files it seems to work out fine.
#------------------------------------------------------------------------------
  if ($name_loadobject eq $executable_name)
    {
      $base_va_address = $base_va_executable;
    }
  else
    {
      $base_va_address = "0x0";
    }

my $decimal_address = bigint::hex ($base_va_address);

$msg  = "return base_va_address = $base_va_address";
  $msg .= " (decimal: $decimal_address)";
  gp_message ("debugXL", $subr_name, $msg);

return ($base_va_address);

} #-- End of subroutine determine_base_va_address

#------------------------------------------------------------------------------
# Now that we know the map.xml file(s) are present, we can scan these and get
# the required information.
#------------------------------------------------------------------------------
sub determine_base_virtual_address
{
  my $subr_name = get_my_name ();

my ($exp_dir_list_ref) = @_;

my @exp_dir_list   = @{ $exp_dir_list_ref };

my $executable_name;
  my $full_path_exec;
  my $msg;
  my $path_to_map_file;
  my $va_executable_in_hex;

for my $exp_dir (keys %g_exp_dir_meta_data)
    {
      $path_to_map_file  = $g_exp_dir_meta_data{$exp_dir}{"directory_path"};
      $path_to_map_file .= $exp_dir;
      $path_to_map_file .= "/map.xml";

($full_path_exec, $executable_name, $va_executable_in_hex) =
				extract_info_from_map_xml ($path_to_map_file);

$g_exp_dir_meta_data{$exp_dir}{"full_path_exec"} = $full_path_exec;
      $g_exp_dir_meta_data{$exp_dir}{"exec_name"}      = $executable_name;
      $g_exp_dir_meta_data{$exp_dir}{"va_base_in_hex"} = $va_executable_in_hex;

$msg = "exp_dir              = " . $exp_dir;
      gp_message ("debug", $subr_name, $msg);
      $msg = "full_path_exece      = " . $full_path_exec;
      gp_message ("debug", $subr_name, $msg);
      $msg = "executable_name      = " . $executable_name;
      gp_message ("debug", $subr_name, $msg);
      $msg = "va_executable_in_hex = " . $va_executable_in_hex;
      gp_message ("debug", $subr_name, $msg);
    }

return (0);

} #-- End of subroutine determine_base_virtual_address

#------------------------------------------------------------------------------
# Determine whether the decimal separator is a point or a comma.
#------------------------------------------------------------------------------
sub determine_decimal_separator
{
  my $subr_name = get_my_name ();

my $cmd_output;
  my $convert_to_dot;
  my $decimal_separator;
  my $error_code;
  my $field;
  my $ignore_count;
  my @locale_info = ();
  my $msg;
  my $target_cmd;
  my $target_found;

my $default_decimal_separator = "\\.";

$target_cmd  = $g_mapped_cmds{locale} . " -k LC_NUMERIC";
  ($error_code, $cmd_output) = execute_system_cmd ($target_cmd);

if ($error_code != 0)
#------------------------------------------------------------------------------
# This is unlikely to happen, but you never know.  To reduce the nesting level,
# return right here in case of an error.
#------------------------------------------------------------------------------
    {
      $msg = "failure to execute the command " . $target_cmd;
      gp_message ("error", $subr_name, $msg);

$g_total_error_count++;

$convert_to_dot = $TRUE;

return ($error_code, $default_decimal_separator, $convert_to_dot);
    }

#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
# Scan the locale info and search for the target line of the form
# decimal_point="<target>" where <target> is either a dot, or a comma.
#------------------------------------------------------------------------------
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# Split the output into the different lines and scan for the line we need.
#------------------------------------------------------------------------------
  @locale_info  = split ("\n", $cmd_output);
  $target_found = $FALSE;
  for my $line (@locale_info)
    {
      chomp ($line);
      $msg = "line from locale_info = " . $line;
      gp_message ("debug", $subr_name, $msg);

if ($line =~ /decimal_point=/)
        {

#------------------------------------------------------------------------------
# Found the target line. Split this line to get the value field.
#------------------------------------------------------------------------------
          my @split_line = split ("=", $line);

#------------------------------------------------------------------------------
# There should be 2 fields. If not, something went wrong.
#------------------------------------------------------------------------------
          if (scalar @split_line != 2)
            {
#     if (scalar @split_line == 2) {
#        $target_found    = $FALSE;
#------------------------------------------------------------------------------
# Remove the newline before printing the variables.
#------------------------------------------------------------------------------
              $ignore_count = chomp ($line);
              $ignore_count = chomp (@split_line);

$msg  = "line $line matches the search, but the decimal";
              $msg .= " separator has the wrong format";
              gp_message ("warning", $subr_name, $msg);
              $msg  = "the splitted line is [@split_line] and does not";
              $msg .= " contain 2 fields";
              gp_message ("warning", $subr_name, $msg);
              $msg  = "the default decimal separator will be used";
              gp_message ("warning", $subr_name, $msg);

$g_total_warning_count++;
            }
          else
            {
#------------------------------------------------------------------------------
# We know there are 2 fields and the second one has the decimal point.
#------------------------------------------------------------------------------
              $msg = "split_line[1] = " . $split_line[1];
              gp_message ("debug", $subr_name, $msg);

chomp ($split_line[1]);
              $field = $split_line[1];

if (length ($field) != 3)
#------------------------------------------------------------------------------
# The field still includes the quotes.  Check if the string has length 3, which
# should be the case, but if not, we flag an error.  The error code is set such
# that the callee will know a problem has occurred.
#------------------------------------------------------------------------------
                {
                  $msg  = "unexpected output from the $target_cmd command:";
                  $msg .= " " . $field;
                  gp_message ("error", $subr_name, $msg);

$g_total_error_count++;

$error_code = 1;
                  last;
                }

$msg = "field = ->$field<-";
              gp_message ("debug", $subr_name, $msg);

if (($field eq "\".\"") or ($field eq "\",\""))
#------------------------------------------------------------------------------
# Found the separator.  Capture the character between the quotes.
#------------------------------------------------------------------------------
                {
                  $target_found      = $TRUE;
                  $decimal_separator = substr ($field,1,1);
                  $msg  = "decimal_separator = $decimal_separator--end";
                  $msg .= " skip remainder of loop";
                  gp_message ("debug", $subr_name, $msg);
                  last;
                }
            }
        }
    }
  if (not $target_found)
    {
      $decimal_separator = $default_decimal_separator;
      $msg  = "cannot determine the decimal separator";
      $msg .= " - use the default " . $decimal_separator;
      gp_message ("warning", $subr_name, $msg);

$g_total_warning_count++;
    }

if ($decimal_separator ne ".")
    {
      $convert_to_dot = $TRUE;
    }
  else
    {
      $convert_to_dot = $FALSE;
    }

$decimal_separator = "\\".$decimal_separator;
  $g_locale_settings{"decimal_separator"} = $decimal_separator;
  $g_locale_settings{"convert_to_dot"}    = $convert_to_dot;

return ($error_code, $decimal_separator, $convert_to_dot);

} #-- End of subroutine determine_decimal_separator

#------------------------------------------------------------------------------
# TBD
#------------------------------------------------------------------------------
sub dump_function_info
{
  my $subr_name = get_my_name ();

my ($function_info_ref, $name) = @_;

my %function_info = %{$function_info_ref};
  my $kip;
  my $msg;

$msg = "function_info for " . $name;
  gp_message ("debug", $subr_name, $msg);

$kip = 0;
  for my $farray ($function_info{$name})
    {
      for my $elm (@{$farray})
        {
          $msg = $kip . ": routine = " . ${$elm}{"routine"};
          gp_message ("debug", $subr_name, $msg);
          for my $key (sort keys %{$elm})
            {
              if ($key eq "routine")
                {
                  next;
                }
              $msg = $kip . ": $key = " . ${$elm}{$key};
              gp_message ("debug", $subr_name, $msg);
            }
          $kip++;
        }
    }

return (0);

} #-- End of subroutine dump_function_info

my ($elf_loadobjects_found, $elf_arch, $loadobj, $routine,
      $ARCHIVES_MAP_NAME, $ARCHIVES_MAP_VADDR, $elf_rats_ref) = @_;

my %elf_rats = %{$elf_rats_ref};

my $msg;
  my $return_value;

#------------------------------------------------------------------------------
# TBD. Quick check. Can be moved up the call tree.
#------------------------------------------------------------------------------
    if ( $elf_arch ne "Linux" )
      {
        $msg = $elf_arch . " is not a supported OS";
        gp_message ("error", $subr_name, $msg);
        $g_total_error_count++;
        gp_message ("abort", $subr_name, $g_abort_msg);
      }

#------------------------------------------------------------------------------
# TBD: This should not be in a loop over $loadobj and only use the executable.
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# TBD: $routine is not really used in these subroutines. Is this a bug?
#------------------------------------------------------------------------------
  if ($elf_loadobjects_found)
    {
      gp_message ("debugXL", $subr_name, "calling elf_phdr_usual");
      $return_value = elf_phdr_usual ($elf_arch,
				      $loadobj,
				      $routine,
				      \%elf_rats);
    }
  else
    {
      gp_message ("debugXL", $subr_name, "calling elf_phdr_sometimes");
      $return_value = elf_phdr_sometimes ($elf_arch,
					  $loadobj,
					  $routine,
					  $ARCHIVES_MAP_NAME,
					  $ARCHIVES_MAP_VADDR);
    }

gp_message ("debug", $subr_name, "the return value = $return_value");

if (not $return_value)
    {
      $msg = "need to handle a return value of FALSE";
      gp_message ("error", $subr_name, $msg);
      $g_total_error_count++;
      gp_message ("abort", $subr_name, $g_abort_msg);
    }

return ($return_value);

} #-- End of subroutine elf_phdr

#------------------------------------------------------------------------------
# Return the virtual address for the load object.
#------------------------------------------------------------------------------
sub elf_phdr_sometimes
{
  my $subr_name = get_my_name ();

my ($elf_arch, $loadobj, $routine, $ARCHIVES_MAP_NAME,
      $ARCHIVES_MAP_VADDR) = @_;

my $arch_uname_s = $local_system_config{"kernel_name"};
  my $arch_uname   = $local_system_config{"processor"};
  my $arch         = $g_arch_specific_settings{"arch"};

gp_message ("debug", $subr_name, "arch_uname_s = $arch_uname_s");
  gp_message ("debug", $subr_name, "arch_uname   = $arch_uname");
  gp_message ("debug", $subr_name, "arch         = $arch");

my $cmd_output;
  my $command_string;
  my $error_code;
  my $msg;
  my $target_cmd;

my $line;
  my $blo;

my $elf_offset;
  my $i;
  my @foo;
  my $foo;
  my $foo1;
  my $p_vaddr;
  my $rc;
  my $archives_file;
  my $loadobj_SAVE;
  my $Offset;
  my $VirtAddr;
  my $PhysAddr;
  my $FileSiz;
  my $MemSiz;
  my $Flg;
  my $Align;

if ($ARCHIVES_MAP_NAME eq $blo)
    {
      return ($ARCHIVES_MAP_VADDR);
    }
  else
    {
      return ($FALSE);
    }

if ($arch_uname_s ne $elf_arch)
    {
#------------------------------------------------------------------------------
# We are masquerading between systems, must leave
#------------------------------------------------------------------------------
      $msg = "masquerading arch_uname_s->$arch_uname_s elf_arch->$elf_arch";
      gp_message ("debug", $subr_name, $msg);
      return ($FALSE);
    }

if ($loadobj eq "DYNAMIC_FUNCTIONS")
#------------------------------------------------------------------------------
# Linux vDSO, leave for now
#------------------------------------------------------------------------------
    {
      return ($FALSE);
    }

# TBD: STILL NEEDED??!!

$loadobj_SAVE = $loadobj;

$blo = get_basename ($loadobj);
  gp_message ("debug", $subr_name, "loadobj = $loadobj");
  gp_message ("debug", $subr_name, "blo     = $blo");
  gp_message ("debug", $subr_name, "ARCHIVES_MAP_NAME  = $ARCHIVES_MAP_NAME");
  gp_message ("debug", $subr_name, "ARCHIVES_MAP_VADDR = $ARCHIVES_MAP_VADDR");
  if ($ARCHIVES_MAP_NAME eq $blo)
    {
      return ($ARCHIVES_MAP_VADDR);
    }
  else
    {
      return ($FALSE);
    }

} #-- End of subroutine elf_phdr_sometimes

#------------------------------------------------------------------------------
# Return the virtual address for the load object.
#
# Note that at this point, $elf_arch is known to be supported.
#------------------------------------------------------------------------------
sub elf_phdr_usual
{
  my $subr_name = get_my_name ();

my ($elf_arch, $loadobj, $routine, $elf_rats_ref) = @_;

my %elf_rats = %{$elf_rats_ref};

my $load_long_regex;
  $load_long_regex     = '^\s+LOAD\s+(\S+)\s+(\S+)\s+(\S+)';
  $load_long_regex    .= '\s+(\S+)\s+(\S+)\s+(R\sE)\s+(\S+)$';
  my $load_short_regex = '^\s+LOAD\s+(\S+)\s+(\S+)\s+(\S+)$';
  my $re_regex         = '^\s+(\S+)\s+(\S+)\s+(R\sE)\s+(\S+)$';

my $return_code;
  my $cmd_output;
  my $target_cmd;
  my $command_string;
  my $error_code;
  my $error_code1;
  my $error_code2;
  my $msg;

my ($elf_offset, $loadobjARC);
  my ($i, @foo, $foo, $foo1, $p_vaddr, $rc);
  my ($Offset, $VirtAddr, $PhysAddr, $FileSiz, $MemSiz, $Flg, $Align);

my $arch_uname_s = $local_system_config{"kernel_name"};

$msg = "elf_arch = $elf_arch loadobj = $loadobj routine = $routine";
  gp_message ("debug", $subr_name, $msg);

my ($base, $ignore_value, $ignore_too) = fileparse ($loadobj);

$msg = "base = $base " . basename ($loadobj);
  gp_message ("debug", $subr_name, $msg);

if ($elf_arch eq "Linux")
    {
      if ($arch_uname_s ne $elf_arch)
        {
#------------------------------------------------------------------------------
# We are masquerading between systems, must leave.
# Maybe we could use ELF_RATS
#------------------------------------------------------------------------------
          $msg  = "masquerading arch_uname_s->" . $arch_uname_s;
          $msg .= " elf_arch->" . $elf_arch;
          gp_message ("debug", $subr_name, $msg);

return ($FALSE);
        }
      if ($loadobj eq "DYNAMIC_FUNCTIONS")
        {
#------------------------------------------------------------------------------
# Linux vDSO, leave for now
#------------------------------------------------------------------------------
          gp_message ("debug", $subr_name, "early return: loadobj = $loadobj");
          return ($FALSE);
        }

$target_cmd     = $g_mapped_cmds{"readelf"};
      $command_string = $target_cmd . " -l " . $loadobj . " 2>/dev/null";

($error_code1, $cmd_output) = execute_system_cmd ($command_string);

$msg = "executed command_string = " . $command_string;
      gp_message ("debug", $subr_name, $msg);
      $msg = "cmd_output = " . $cmd_output;
      gp_message ("debug", $subr_name, $msg);

if ($error_code1 != 0)
        {
          gp_message ("debug", $subr_name, "call failure for $command_string");
#------------------------------------------------------------------------------
# e.g. $loadobj->/usr/lib64/libc-2.17.so
#------------------------------------------------------------------------------
          $loadobjARC = get_basename ($loadobj);
          gp_message ("debug", $subr_name, "seek elf_rats for $loadobjARC");

if (exists ($elf_rats{$loadobjARC}))
            {
              my $elfoid;
              $elfoid  = $elf_rats{$loadobjARC}[1] . "/archives/";
              $elfoid .= $elf_rats{$loadobjARC}[0];
              $target_cmd     = $g_mapped_cmds{"readelf"};
              $command_string = $target_cmd . "-l " . $elfoid . " 2>/dev/null";
              ($error_code2, $cmd_output) =
					execute_system_cmd ($command_string);

if ($error_code2 != 0)
                {
                  $msg = "call failure for " . $command_string;
                  gp_message ("error", $subr_name, $msg);
                  $g_total_error_count++;
                  gp_message ("abort", $subr_name, $g_abort_msg);
                }
              else
                {
                  $msg = "executed command_string = " . $command_string;
                  gp_message ("debug", $subr_name, $msg);
                  $msg = "cmd_output = " . $cmd_output;
                  gp_message ("debug", $subr_name, $msg);
                }
            }
          else
            {
              $msg =  "elf_rats{$loadobjARC} does not exist";
              gp_message ("assertion", $subr_name, $msg);
            }
        }
#------------------------------------------------------------------------------
# Example output of "readelf -l" on Linux:
#
# Elf file type is EXEC (Executable file)
# Entry point 0x4023a0
# There are 11 program headers, starting at offset 64
#
# Program Headers:
#   Type           Offset             VirtAddr           PhysAddr
#                  FileSiz            MemSiz              Flags  Align
#   PHDR           0x0000000000000040 0x0000000000400040 0x0000000000400040
#                  0x0000000000000268 0x0000000000000268  R      8
#   INTERP         0x00000000000002a8 0x00000000004002a8 0x00000000004002a8
#                  0x000000000000001c 0x000000000000001c  R      1
#       [Requesting program interpreter: /lib64/ld-linux-x86-64.so.2]
#   LOAD           0x0000000000000000 0x0000000000400000 0x0000000000400000
#                  0x0000000000001310 0x0000000000001310  R      1000
#   LOAD           0x0000000000002000 0x0000000000402000 0x0000000000402000
#                  0x0000000000006515 0x0000000000006515  R E    1000
#   LOAD           0x0000000000009000 0x0000000000409000 0x0000000000409000
#                  0x000000000006f5a8 0x000000000006f5a8  R      1000
#   LOAD           0x0000000000078dc8 0x0000000000479dc8 0x0000000000479dc8
#                  0x000000000000047c 0x0000000000000f80  RW     1000
#   DYNAMIC        0x0000000000078dd8 0x0000000000479dd8 0x0000000000479dd8
#                  0x0000000000000220 0x0000000000000220  RW     8
#   NOTE           0x00000000000002c4 0x00000000004002c4 0x00000000004002c4
#                  0x0000000000000044 0x0000000000000044  R      4
#   GNU_EH_FRAME   0x00000000000777f4 0x00000000004777f4 0x00000000004777f4
#                  0x000000000000020c 0x000000000000020c  R      4
#   GNU_STACK      0x0000000000000000 0x0000000000000000 0x0000000000000000
#                  0x0000000000000000 0x0000000000000000  RW     10
#   GNU_RELRO      0x0000000000078dc8 0x0000000000479dc8 0x0000000000479dc8
#                  0x0000000000000238 0x0000000000000238  R      1
#
#  Section to Segment mapping:
#   Segment Sections...
#    00
#    01     .interp
#    02     .interp .note.gnu.build-id .note.ABI-tag .gnu.hash .dynsym
#           .dynstr .gnu.version .gnu.version_r .rela.dyn .rela.plt
#    03     .init .plt .text .fini
#    04     .rodata .eh_frame_hdr .eh_frame
#    05     .init_array .fini_array .dynamic .got .got.plt .data .bss
#    06     .dynamic
#    07     .note.gnu.build-id .note.ABI-tag
#    08     .eh_frame_hdr
#    09
#    10     .init_array .fini_array .dynamic .got
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# Analyze the ELF information and try to find the virtual address.
#
# Note that the information printed as part of LOAD needs to have "R E" in it.
# In the example output above, the return value would be "0x0000000000402000".
#
# We also need to distinguish two cases.  It could be that the output is on
# a single line, or spread over two lines:
#
#                 Offset   VirtAddr   PhysAddr   FileSiz  MemSiz   Flg Align
#  LOAD           0x000000 0x08048000 0x08048000 0x61b4ae 0x61b4ae R E 0x1000
# or 2 lines
#  LOAD           0x0000000000000000 0x0000000000400000 0x0000000000400000
#                 0x0000000000001010 0x0000000000001010  R E    200000
#------------------------------------------------------------------------------
      @foo = split ("\n",$cmd_output);
      for $i (0 .. $#foo)
        {
          $foo = $foo[$i];
          chomp ($foo);
          if ($foo =~ /$load_long_regex/)
            {
              $Offset   = $1;
              $VirtAddr = $2;
              $PhysAddr = $3;
              $FileSiz  = $4;
              $MemSiz   = $5;
              $Flg      = $6;
              $Align    = $7;

$elf_offset = $VirtAddr;
              $msg = "single line version elf_offset = " . $elf_offset;
              gp_message ("debug", $subr_name, $msg);
              return ($elf_offset);
            }
          elsif ($foo =~ /$load_short_regex/)
            {
#------------------------------------------------------------------------------
# is it a two line version?
#------------------------------------------------------------------------------
              $Offset   = $1;
              $VirtAddr = $2; # maybe
              $PhysAddr = $3;
              if ($i != $#foo)
                {
                  $foo1 = $foo[$i + 1];
                  chomp ($foo1);
                  if ($foo1 =~ /$re_regex/)
                    {
                      $FileSiz  = $1;
                      $MemSiz   = $2;
                      $Flg      = $3;
                      $Align    = $4;
                      $elf_offset = $VirtAddr;
                      $msg = "two line version elf_offset = " . $elf_offset;
                      gp_message ("debug", $subr_name, $msg);
                      return ($elf_offset);
                    }
                }
            }
        }
    }

} #-- End of subroutine elf_phdr_usual

#------------------------------------------------------------------------------
# Execute a system command.  In case of an error, a non-zero error code is
# returned.  It is upon the caller to decide what to do next.
#------------------------------------------------------------------------------
sub execute_system_cmd
{
  my $subr_name = get_my_name ();

my ($target_cmd) = @_;

my $cmd_output;
  my $error_code;
  my $msg;

chomp ($target_cmd);

$cmd_output = qx ($target_cmd);
  $error_code = ${^CHILD_ERROR_NATIVE};

if ($error_code != 0)
    {
      chomp ($cmd_output);
      $msg = "failure executing command " . $target_cmd;
      gp_message ("error", $subr_name, $msg);
      $msg = "error code = " . $error_code;
      gp_message ("error", $subr_name, $msg);
      $msg = "cmd_output = " . $cmd_output;

gp_message ("error", $subr_name, $msg);
      $g_total_error_count++;
    }
  else
    {
      $msg = "executed command " . $target_cmd;
      gp_message ("debugXL", $subr_name, $msg);
    }

return ($error_code, $cmd_output);

} #-- End of subroutine execute_system_cmd

#------------------------------------------------------------------------------
# Scan the input file, which should be a gprofng generated map.xml file, and
# extract the relevant information.
#------------------------------------------------------------------------------
sub extract_info_from_map_xml
{
  my $subr_name = get_my_name ();

my ($input_map_xml_file) = @_;

my $map_xml_regex;
  $map_xml_regex  = '<event kind="map"\s.*';
  $map_xml_regex .= 'vaddr="0x([0-9a-fA-F]+)"\s+.*';
  $map_xml_regex .= 'foffset="\+*0x([0-9a-fA-F]+)"\s.*';
  $map_xml_regex .= 'modes="0x([0-9]+)"\s.*';
  $map_xml_regex .= 'name="(.*)".*>$';

my $extracted_information;
  my $input_line;
  my $vaddr;
  my $foffset;
  my $msg;
  my $modes;
  my $name_path;
  my $name;

my $full_path_exec;
  my $executable_name;
  my $result_VA;
  my $va_executable_in_hex;

$msg = " - unable to open file $input_map_xml_file for reading:";
  open (MAP_XML, "<", $input_map_xml_file)
    or die ($subr_name . $msg . " " . $!);

$msg = "opened file $input_map_xml_file for reading";
  gp_message ("debug", $subr_name, $msg);

#------------------------------------------------------------------------------
# Scan the file.  We need to find the name of the executable with the mode set
# to 0x005.  For this entry we have to capture the name, the mode, the virtual
# address and the offset.
#------------------------------------------------------------------------------
  $extracted_information = $FALSE;
  while (<MAP_XML>)
    {
      $input_line = $_;
      chomp ($input_line);

$msg = "read input_line = $input_line";
      gp_message ("debug", $subr_name, $msg);

if ($input_line =~  /^$map_xml_regex/)
        {
          $msg = "target line = $input_line";
          gp_message ("debug", $subr_name, $msg);

$vaddr     = $1;
          $foffset   = $2;
          $modes     = $3;
          $name_path = $4;
          $name      = get_basename ($name_path);

$msg  = "extracted vaddr = $vaddr foffset = $foffset";
          $msg .= " modes = $modes";
          gp_message ("debug", $subr_name, $msg);

$msg = "extracted name_path = $name_path name = $name";
          gp_message ("debug", $subr_name, $msg);

#------------------------------------------------------------------------------
# The base virtual address is calculated as vaddr-foffset.  Although Perl
# handles arithmetic in hex, we take the safe way here.  Maybe overkill, but
# I prefer to be safe than sorry in cases like this.
#------------------------------------------------------------------------------
          $full_path_exec   = $name_path;
          $executable_name  = $name;
          $result_VA        = bigint::hex ($vaddr) - bigint::hex ($foffset);
          $va_executable_in_hex = sprintf ("0x%016x", $result_VA);

##          $ARCHIVES_MAP_NAME  = $name;
##          $ARCHIVES_MAP_VADDR = $va_executable_in_hex;

$msg = "result_VA            = $result_VA";
          gp_message ("debug", $subr_name, $msg);

$msg = "va_executable_in_hex = $va_executable_in_hex";
          gp_message ("debug", $subr_name, $msg);

#------------------------------------------------------------------------------
# Stop reading when we found the correct entry.
#------------------------------------------------------------------------------
          if ($modes eq "005")
            {
              $extracted_information = $TRUE;
              last;
            }
        }
    } #-- End of while-loop

if (not $extracted_information)
    {
      $msg  = "cannot find the necessary information in file";
      $msg .= " " . $input_map_xml_file;
      gp_message ("assertion", $subr_name, $msg);
    }

$msg = "full_path_exec       = $full_path_exec";
  gp_message ("debug", $subr_name, $msg);
  $msg = "executable_name      = $executable_name";
  gp_message ("debug", $subr_name, $msg);
  $msg = "va_executable_in_hex = $va_executable_in_hex";
  gp_message ("debug", $subr_name, $msg);

return ($full_path_exec, $executable_name, $va_executable_in_hex);

} #-- End of subroutine extract_info_from_map_xml

#------------------------------------------------------------------------------
# This routine analyzes the metric line and extracts the metric specifics
# from it.
# Example input: Exclusive Total CPU Time: e.%totalcpu
#------------------------------------------------------------------------------
sub extract_metric_specifics
{
  my $subr_name = get_my_name ();

my ($metric_line) = @_;

my $metric_description;
  my $metric_flavor;
  my $metric_visibility;
  my $metric_name;
  my $metric_spec;

# Ruud   if (($metric =~ /\s*(.*):\s+(\S)((\.\S+)|(\+\S+))/) && !($metric =~/^Current/)){
  if (($metric_line =~ /\s*(.+):\s+([ei])([\.\+%]+)(\S*)/) and !($metric_line =~/^Current/))
    {
      gp_message ("debug", $subr_name, "line of interest: $metric_line");

$metric_description = $1;
      $metric_flavor      = $2;
      $metric_visibility  = $3;
      $metric_name        = $4;

#------------------------------------------------------------------------------
# Although we have captured the metric visibility, the original code removes
# this from the name.  Since the structure is more complicated, the code is
# more tedious as well.  With our new approach we just leave the visibility
# out.
#------------------------------------------------------------------------------
#      $metric_spec        = $metric_flavor.$metric_visibility.$metric_name;

$metric_spec        = $metric_flavor . "." . $metric_name;

#------------------------------------------------------------------------------
# From the original code:
#
# On x64 systems there are metrics which contain ~ (for example
# DC_access~umask=0 .  When er_print lists them, they come out
# as DC_access%7e%umask=0 (see 6530691).  Untill 6530691 is
# fixed, we need this.  Later we may need something else, or
# things may just work.
#------------------------------------------------------------------------------
#          $metric_spec=~s/\%7e\%/,/;
#          # remove % metric
#          print "DB: before \$metric_spec = $metric_spec\n";

#------------------------------------------------------------------------------
# TBD: I don't know why the "%" symbol is removed.
#------------------------------------------------------------------------------
#          $metric_spec =~ s/\%//;
#          print "DB: after  \$metric_spec = $metric_spec\n";

return ($metric_spec, $metric_flavor, $metric_visibility,
              $metric_name, $metric_description);
    }
  else
    {
      return ("skipped", "void");
    }

} #-- End of subroutine extract_metric_specifics

#------------------------------------------------------------------------------
# Extract the option value(s) from the input array.  In case the number of
# values execeeds the specified limit, warning messages are printed.
#
# In case the option value is valid, g_user_settings is updated with this
# value and a value of TRUE is returned.  Otherwise the return value is FALSE.
#
# Note that not in all invocations of this subroutine, gp_message() is
# operational.  Only after the debug settings have been finalized, the
# messages are printed.
#
# This subroutine also generates warnings about multiple occurrences
# and the validity of the values.
#------------------------------------------------------------------------------
sub extract_option_value
{
  my $subr_name = get_my_name ();

my ($option_dir_ref, $max_occurrences_ref, $internal_option_name_ref,
      $option_name_ref) = @_;

my @option_dir           = @{ $option_dir_ref };
  my $max_occurrences      = ${ $max_occurrences_ref };
  my $internal_option_name = ${ $internal_option_name_ref };
  my $option_name          = ${ $option_name_ref };

my $deprecated_option_used;
  my $excess_occurrences;
  my $msg;
  my $no_of_occurrences;
  my $no_of_warnings = 0;
  my $option_value   = "not set yet";
  my $option_value_missing;
  my $option_value_missing_ref;
  my $reset_blank_value;
  my $special_treatment = $FALSE;
  my $valid = $FALSE;
  my $valid_ref;

if (@option_dir)
    {
      $no_of_occurrences = scalar (@option_dir);

$msg = "option_name          = $option_name";
      gp_message ("debug", $subr_name, $msg);
      $msg = "internal_option_name = $internal_option_name";
      gp_message ("debug", $subr_name, $msg);
      $msg = "no_of_occurrences    = $no_of_occurrences";
      gp_message ("debug", $subr_name, $msg);

$excess_occurrences = ($no_of_occurrences > $max_occurrences) ?
							$TRUE : $FALSE;

#------------------------------------------------------------------------------
# This is not supposed to happen, but just to be sure, there is a check.
#------------------------------------------------------------------------------
      if ($no_of_occurrences < 1)
        {
          $msg  = "the number of fields is $no_of_occurrences";
          $msg .= " - should at least be 1";
          gp_message ("assertion", $subr_name, $msg);
        }

#------------------------------------------------------------------------------
# For backward compatibility, we support the legacy "on" and "off" values for
# certain options.
#
# We also support the debug option without value.  In case no value is given,
# it is set to "on".
#
# Note that regardless of the value(s) in ARGV, internally we use the on/off
# setting.
#------------------------------------------------------------------------------
      if (($g_user_settings{$internal_option_name}{"data_type"} eq "onoff") or
          ($internal_option_name eq "debug"))
        {
          $msg = "enable special treatment of the option";
          gp_message ("debug", $subr_name, $msg);

$special_treatment = $TRUE;
        }

#------------------------------------------------------------------------------
# Issue a warning if the same option occcurs more often than what is supported.
#------------------------------------------------------------------------------
      if ($excess_occurrences)
        {
          $msg = "multiple occurrences of the " . $option_name .
                 " option found:";

gp_message ("debugM", $subr_name, $msg);

gp_message ("warning", $subr_name, $g_html_new_line . $msg);
        }

#------------------------------------------------------------------------------
# Main loop over all the occurrences of the options.  This is a rather simple
# approach since only the last value seen will be accepted.
#
# To assist the user with troubleshooting, the values that are ignored will be
# checked for validity and a marker to this extent will be printed.
#
# NOTE:
# If an option may have multiple meaningful occurrences, this part needs to be
# revisited.
#------------------------------------------------------------------------------
      $deprecated_option_used = $FALSE;
      for my $key (keys @option_dir)
        {
          $option_value      = $option_dir[$key];
          $reset_blank_value = $FALSE;

#------------------------------------------------------------------------------
# For the "onoff" options, convert a blank value to "on".
#------------------------------------------------------------------------------
          if (($option_value eq "on") or ($option_value eq "off"))
            {
              if (($option_name eq "--verbose") or ($option_name eq "--quiet"))
                {
  		  $deprecated_option_used = $TRUE;
                }
            }

#------------------------------------------------------------------------------
# For the "onoff" options, convert a blank value to "on".
#------------------------------------------------------------------------------
          if ($special_treatment and ($option_value eq ""))
            {
              $option_value = "on";
              $reset_blank_value = $TRUE;

$msg  = "reset option value for $option_name from blank";
              $msg .= " to \"on\"";
              gp_message ("debug", $subr_name, $msg);
            }

#------------------------------------------------------------------------------
# Check for the option value to be valid.  It may also happen that an option
# does not have a value, while it should have one.
#------------------------------------------------------------------------------
          ($valid_ref, $option_value_missing_ref) = check_and_set_user_option (
							$internal_option_name,
							$option_value);

$valid                = ${ $valid_ref };
          $option_value_missing = ${ $option_value_missing_ref };

$msg  = "option_value = $option_value";
          gp_message ("debug", $subr_name, $msg);
          $msg  = "after check_and_set_user_option: valid = $valid";
          $msg .= " option_value_missing = $option_value_missing";
          gp_message ("debug", $subr_name, $msg);

#------------------------------------------------------------------------------
# Generate warning messages, but if an option value is missing, it will also
# be considered to be a fatal error.
#------------------------------------------------------------------------------
          if ($excess_occurrences)
            {
              if ($option_value_missing)
                {
                  $msg  = "$option_name option - missing a value";
                }
              else
                {
#------------------------------------------------------------------------------
# A little trick to avoid user confusion.  Although we have set the internal
# value to "on", the user did not set this and so we print "" instead.
#------------------------------------------------------------------------------
                  if ($reset_blank_value)
                    {
                      $msg  = "$option_name option - value = \"\"";
                    }
                  else
                    {
                      $msg  = "$option_name option - value = $option_value";
                    }
                  $msg .= ($valid) ? " (valid value)" : " (invalid value)";
                }

gp_message ("debug", $subr_name, $msg);
              gp_message ("warning", $subr_name, $msg);
            }

#------------------------------------------------------------------------------
# Check for the last occurrence of the option to be valid.  If it is not, it
# is a fatal error.
#------------------------------------------------------------------------------
          if ((not $valid) && ($key == $no_of_occurrences-1))
            {
              if ($option_value_missing)
                {
                  $msg = "the $option_name option requires a value";
                }
              else
                {
                  $msg  = "the value of $option_value for the $option_name";
                  $msg .= " option is invalid";
                }
              gp_message ("debug", $subr_name, $g_error_keyword . $msg);

gp_message ("error", $subr_name, $msg);

$g_total_error_count++;
            }
        }

#------------------------------------------------------------------------------
# Issue a warning if the same option occcurs more often than what is supported
# and warn the user that all but the last value will be ignored.
#------------------------------------------------------------------------------
      if ($excess_occurrences)
        {
          $msg = "all values but the last one shown above are ignored";

gp_message ("debugM", $subr_name, $msg);
          gp_message ("warning", $subr_name, $msg);

$g_total_warning_count++;
        }
    }

#------------------------------------------------------------------------------
# Issue a warning if the old on/off syntax is used still.
#------------------------------------------------------------------------------
  if ($deprecated_option_used)
    {
      $msg  = "<br>";
      $msg .= "the on/off syntax for option $option_name has been";
      $msg .= " deprecated";
      gp_message ("warning", $subr_name, $msg);

$msg  = "this option acts like a switch now";
      gp_message ("warning", $subr_name, $msg);

$msg  = "support for the old syntax may be terminated";
      $msg .= " in a future update";
      gp_message ("warning", $subr_name, $msg);

$msg  = "please check the man page of gp-display-html";
      $msg .= " for more details";
      gp_message ("warning", $subr_name, $msg);
      $g_total_warning_count++;
    }

return (\$valid);

} #-- End of subroutine extract_option_value

#------------------------------------------------------------------------------
# TBD
#------------------------------------------------------------------------------
sub extract_source_line_number
{
  my $subr_name = get_my_name ();

my ($src_times_regex, $function_regex, $number_of_metrics, $input_line) = @_;

my @fields_in_line = ();
  my $hot_line;
  my $line_id;

#------------------------------------------------------------------------------
# To extract the source line number, we need to distinguish whether this is
# a line with, or without metrics.
#------------------------------------------------------------------------------
      @fields_in_line = split (" ", $input_line);
      if ( $input_line =~ /$src_times_regex/ )
        {
          $hot_line = $1;
          if ($hot_line eq "##")
#------------------------------------------------------------------------------
# The line id comes after the "##" symbol and the metrics.
#------------------------------------------------------------------------------
            {
              $line_id = $fields_in_line[$number_of_metrics+1];
            }
          else
#------------------------------------------------------------------------------
# The line id comes after the metrics.
#------------------------------------------------------------------------------
            {
              $line_id = $fields_in_line[$number_of_metrics];
            }
        }
      elsif ($input_line =~ /$function_regex/)
        {
          $line_id = "func";
        }
      else
#------------------------------------------------------------------------------
# The line id is the first non-blank element.
#------------------------------------------------------------------------------
        {
          $line_id = $fields_in_line[0];
        }
#------------------------------------------------------------------------------
# Remove the trailing dot.
#------------------------------------------------------------------------------
      $line_id =~ s/$find_dot_regex//;

return ($line_id);

} #-- End of subroutine extract_source_line_number

#------------------------------------------------------------------------------
# Finalize the settings for the special options verbose, debug, warnings and
# quiet.
#------------------------------------------------------------------------------
sub finalize_special_options
{
  my $subr_name = get_my_name ();

my $msg;

#------------------------------------------------------------------------------
# If quiet mode has been enabled, disable verbose, warnings and debug.
#------------------------------------------------------------------------------
  if ($g_quiet)
    {
      $g_user_settings{"verbose"}{"current_value"}    = "off";
      $g_user_settings{"nowarnings"}{"current_value"} = "on";
      $g_user_settings{"warnings"}{"current_value"}   = "off";
      $g_user_settings{"debug"}{"current_value"}      = "off";
      $g_debug    = $FALSE;
      $g_verbose  = $FALSE;
      $g_warnings = $FALSE;
      my $debug_off = "off";
      my $ignore_value = set_debug_size (\$debug_off);
    }
  else
    {
#------------------------------------------------------------------------------
# Disable output buffering if verbose, debug, and/or warnings are enabled.
#------------------------------------------------------------------------------
      if ($g_verbose or $g_debug or $g_warnings)
        {
          STDOUT->autoflush (1);

$msg = "enabled autoflush for STDOUT";
          gp_message ("debug", $subr_name, $msg);
        }
#------------------------------------------------------------------------------
# If verbose and/or debug have been enabled, print a message.
#------------------------------------------------------------------------------
##      gp_message ("verbose", $subr_name, "verbose mode has been enabled");
##      gp_message ("debug",   $subr_name, "debug " . $g_debug_size_value . " mode has been enabled");
    }

return (0);

} #-- End of subroutine finalize_special_options

#------------------------------------------------------------------------------
# For a give routine name and address, find the index into the
# function_info array
#------------------------------------------------------------------------------
sub find_index_in_function_info
{
  my $subr_name = get_my_name ();

my ($routine_ref, $current_address_ref, $function_info_ref) = @_;

my $routine = ${ $routine_ref };
  my $current_address = ${ $current_address_ref };
  my @function_info = @{ $function_info_ref };

my $addr_offset;
  my $ref_index;

gp_message ("debugXL", $subr_name, "find index for routine = $routine and current_address = $current_address");
  if (exists ($g_multi_count_function{$routine}))
    {

# TBD: Scan all of the function_info list. Or beter: add index to g_multi_count_function!!

gp_message ("debugXL", $subr_name, "$routine: occurrences = $g_function_occurrences{$routine}");
      for my $ref (keys @{ $g_map_function_to_index{$routine} })
        {
          $ref_index = $g_map_function_to_index{$routine}[$ref];

gp_message ("debugXL", $subr_name, "$routine: retrieving duplicate entry at ref_index = $ref_index");
          gp_message ("debugXL", $subr_name, "$routine: function_info[$ref_index]{'alt_name'} = $function_info[$ref_index]{'alt_name'}");

$addr_offset = $function_info[$ref_index]{"addressobjtext"};
          gp_message ("debugXL", $subr_name, "$routine: addr_offset = $addr_offset");

$addr_offset =~ s/^@\d+://;
          gp_message ("debugXL", $subr_name, "$routine: addr_offset = $addr_offset");
          if ($addr_offset eq $current_address)
            {
              last;
            }
        }
    }
  else
    {
#------------------------------------------------------------------------------
# There is only a single occurrence and it is straightforward to get the index.
#------------------------------------------------------------------------------
      if (exists ($g_map_function_to_index{$routine}))
        {
          $ref_index = $g_map_function_to_index{$routine}[0];
        }
      else
        {
          my $msg = "index for $routine cannot be determined";
          gp_message ("assertion", $subr_name, $msg);
        }
    }

gp_message ("debugXL", $subr_name, "routine = $routine current_address = $current_address ref_index = $ref_index");

return (\$ref_index);

} #-- End of subroutine find_index_in_function_info

#------------------------------------------------------------------------------
# TBD
#------------------------------------------------------------------------------
sub find_keyword_in_string
{
  my $subr_name = get_my_name ();

my ($target_string_ref, $target_keyword_ref) = @_;

my $target_string  = ${ $target_string_ref };
  my $target_keyword = ${ $target_keyword_ref };
  my $foundit = $FALSE;

my @index_values = ();

my $ret_val = 0;
    my $offset = 0;
    gp_message ("debugXL", $subr_name, "target_string = $target_string");
    $ret_val = index ($target_string, $target_keyword, $offset);
    gp_message ("debugXL", $subr_name, "ret_val = $ret_val");

if ($ret_val != -1)
      {
        $foundit = $TRUE;
        while ($ret_val != -1)
          {
             push (@index_values, $ret_val);
             $offset = $ret_val + 1;
             gp_message ("debugXL", $subr_name, "ret_val = $ret_val offset = $offset");
             $ret_val = index ($target_string, $target_keyword, $offset);
          }
        for my $i (keys @index_values)
          {
            gp_message ("debugXL", $subr_name, "index_values[$i] = $index_values[$i]");
          }
      }
    else
      {
        gp_message ("debugXL", $subr_name, "target keyword $target_keyword not found");
      }

return (\$foundit, \@index_values);

} #-- End of subroutine find_keyword_in_string

#------------------------------------------------------------------------------
# Retrieve the absolute path that was used to execute the command.  This path
# is used to execute gp-display-text later on.
#------------------------------------------------------------------------------
sub find_path_to_gp_display_text
{
  my $subr_name = get_my_name ();

my ($full_command_ref) = @_;

my $full_command = ${ $full_command_ref };

my $error_occurred = $TRUE;
  my $return_value;

#------------------------------------------------------------------------------
# Get the path name.
#------------------------------------------------------------------------------
  my ($gp_file_name, $gp_path, $suffix_not_used) = fileparse ($full_command);

gp_message ("debug", $subr_name, "full_command = $full_command");
  gp_message ("debug", $subr_name, "gp_path  = $gp_path");

my $gp_display_text_instance = $gp_path . $GP_DISPLAY_TEXT;

#------------------------------------------------------------------------------
# Check if $GP_DISPLAY_TEXT exists, is not empty, and executable.
#------------------------------------------------------------------------------
  if (not -e $gp_display_text_instance)
    {
      $return_value = "file not found";
    }
  else
    {
      if (is_file_empty ($gp_display_text_instance))
        {
          $return_value = "file is empty";
        }
      else
        {
#------------------------------------------------------------------------------
# All is well.  Capture the path.
#------------------------------------------------------------------------------
          $error_occurred = $FALSE;
          $return_value = $gp_path;
        }
    }

return (\$error_occurred, \$gp_path, \$return_value);

} #-- End of subroutine find_path_to_gp_display_text

#------------------------------------------------------------------------------
# Scan the command line to see if the specified option is present.
#
# Two types of options are supported: options without a value (e.g. --help) or
# those that are set to "on" or "off".
#
# In this phase, we only need to check if a value is valid. If it is, we have
# to enable the corresponding global setting.  If the value is not valid, we
# ignore it, since it will be caught later and a warning message is issued.
#------------------------------------------------------------------------------
sub find_target_option
{
  my $subr_name = get_my_name ();

my ($command_line_ref, $option_requires_value, $target_option) = @_;

my @command_line     = @{ $command_line_ref };
  my $option_value     = undef;
  my $found_option     = $FALSE;

my ($command_line_string) = join (" ", @command_line);

##  if ($command_line_string =~ /\s*($target_option)\s*(on|off)*\s*/)
#------------------------------------------------------------------------------
# This does not make any assumptions on the values we are looking for.
#------------------------------------------------------------------------------
  if ($command_line_string =~ /\s*\-\-($target_option)\s*(\w*)\s*/)
    {
      if (defined ($1))
#------------------------------------------------------------------------------
# We have found the option we are looking for.
#------------------------------------------------------------------------------
        {
          $found_option = $TRUE;
          if ($option_requires_value and defined ($2))
#------------------------------------------------------------------------------
# There is a value and it is passed on to the caller.
#------------------------------------------------------------------------------
            {
              $option_value = $2;
            }
        }
    }

return ($found_option, $option_value);

} #-- End of subroutine find_target_option

#------------------------------------------------------------------------------
# Find the occurrences of non-space characters in a string and return their
# start and end index values(s).
#------------------------------------------------------------------------------
sub find_words_in_line
{
  my $subr_name = get_my_name ();

my ($input_line_ref) = @_;

my $input_line = ${ $input_line_ref };

my $finished = $TRUE;

my $space = 0;
  my $space_position = 0;
  my $start_word;
  my $end_word;

my @word_delimiters = ();

gp_message ("debugXL", $subr_name, "input_line = $input_line");

$finished = $FALSE;
    while (not $finished)
      {
        $space = index ($input_line, " ", $space_position);

my $txt = "string search space_position = $space_position ";
        $txt   .= "space = $space";
        gp_message ("debugXL", $subr_name, $txt);

if ($space != -1)
          {
            if ($space > $space_position)
              {
                $start_word = $space_position;
                $end_word   = $space - 1;
                $space_position = $space;
                my $keyword = substr ($input_line, $start_word, $end_word - $start_word + 1);
                gp_message ("debugXL", $subr_name, "string search start_word = $start_word end_word = $end_word space_position = $space_position $keyword");
                push (@word_delimiters, [$start_word, $end_word]);
              }
            elsif ( ($space == $space_position) and ($space < length ($input_line) - 1))
              {
                $space          = $space + 1;
                $space_position = $space;
              }
            else
              {
                print "DONE\n";
                $finished = $TRUE;
                gp_message ("debugXL", $subr_name, "completed - finished = $finished");
              }
          }
        else
          {
            $finished = $TRUE;
            $start_word = $space_position;
            $end_word = length ($input_line) - 1;
            my $keyword = substr ($input_line, $start_word, $end_word - $start_word + 1);
            push (@word_delimiters, [$start_word, $end_word]);
            if ($keyword =~ /\s+/)
              {
                my $txt = "end search spaces only";
                gp_message ("debugXL", $subr_name, $txt);
              }
            else
              {
                my $txt  = "end search start_word = $start_word ";
                $txt    .= "end_word = $end_word ";
                $txt    .= "space_position = $space_position -->$keyword<--";
                gp_message ("debugXL", $subr_name, $txt);
              }
          }

}

for my $i (keys @word_delimiters)
    {
      gp_message ("debugXL", $subr_name, "i = $i $word_delimiters[$i][0] $word_delimiters[$i][1]");
    }

return (\@word_delimiters);

} #-- End of subroutine find_words_in_line

my ($outputdir, $FUNC_FILE, $metric, $LINUX_vDSO_ref) = @_;

my %LINUX_vDSO = %{ $LINUX_vDSO_ref };

my $index_val;
  my $address_decimal;
  my $full_address_field;

my $FUNC_FILE_NO_PC;
  my $off_with_the_PC;

my $blanks;
  my $lblanks;
  my $lvdso_key;
  my $line_regex;

my %functions_per_metric_indexes = ();
  my %functions_per_metric_first_index = ();
  my @order;

my ($line,$line_n,$value);
  my ($df_flag,$n,$u);
  my ($metric_value,$PC_Address,$routine);
  my ($is_calls,$metric_ok,$name_regex,$pc_len);
  my ($segment,$offset,$offy,$spaces,$rest,$not_printed,$vdso_key);

#------------------------------------------------------------------------------
# If the directory name does not end with a "/", add it.
#------------------------------------------------------------------------------
  my $length_of_string = length ($outputdir);

if (rindex ($outputdir, "/") != $length_of_string-1)
    {
      $outputdir .= "/";
    }

gp_message ("debug", $subr_name, "on input FUNC_FILE = $FUNC_FILE metric = $metric");

$is_calls        = $FALSE;
  $metric_ok       = $TRUE;
  $off_with_the_PC = rindex ($FUNC_FILE, "-PC");
  $FUNC_FILE_NO_PC = substr ($FUNC_FILE, 0, $off_with_the_PC);

if ($FUNC_FILE_NO_PC eq $outputdir."calls.sort.func")
    {
      $FUNC_FILE_NO_PC = $outputdir."calls";
      $is_calls        = $TRUE;
      $metric_ok       = $FALSE;
    }
  elsif ($FUNC_FILE_NO_PC eq $outputdir."calltree.sort.func")
    {
      $FUNC_FILE_NO_PC = $outputdir."calltree";
      $metric_ok       = $FALSE;
    }
  elsif ($FUNC_FILE_NO_PC eq $outputdir."functions.sort.func")
    {
      $FUNC_FILE_NO_PC = $outputdir."functions.func";
      $metric_ok       = $FALSE;
    }
  gp_message ("debugM", $subr_name, "set FUNC_FILE_NO_PC = $FUNC_FILE_NO_PC");

open (FUNC_FILE, "<", $FUNC_FILE)
    or die ("Not able to open file $FUNC_FILE for reading - '$!'");
  gp_message ("debug", $subr_name, "opened file FUNC_FILE = $FUNC_FILE for reading");

open (FUNC_FILE_NO_PC, ">", $FUNC_FILE_NO_PC)
    or die ("Not able to open file $FUNC_FILE_NO_PC for writing - '$!'");
  gp_message ("debug", $subr_name, "opened file FUNC_FILE_NO_PC = $FUNC_FILE_NO_PC for writing");

open (FUNC_FILE_REGEXP, "<", "$FUNC_FILE.name-regex")
    or die ("Not able to open file $FUNC_FILE.name-regex for reading - '$!'");
  gp_message ("debug", $subr_name, "opened file FUNC_FILE_REGEXP = $FUNC_FILE.name-regex for reading");

$name_regex = <FUNC_FILE_REGEXP>;
  chomp ($name_regex);
  close (FUNC_FILE_REGEXP);

gp_message ("debugXL", $subr_name, "name_regex = $name_regex");

$n = 0;
  $u = 0;
  $pc_len = 0;

#------------------------------------------------------------------------------
# Note that the double \\ is needed here.  The regex used will not have these.
#------------------------------------------------------------------------------
  if ($is_calls)
    {
#------------------------------------------------------------------------------
# TBD
# I do not see the "*" in my test output, but no harm to leave the code in.
#
# er_print * before PC for calls ! 101315
#------------------------------------------------------------------------------
      $line_regex = "^(\\s*)(\\**)(\\S+)(:)(\\S+)(\\s+)(.*)";
    }
  else
    {
      $line_regex = "^(\\s*)(\\S+)(:)(\\S+)(\\s+)(.*)";
    }
  gp_message ("debugXL", $subr_name, "is_calls = ".(($is_calls) ? "TRUE" : "FALSE")." line_regex->$line_regex<-");
  gp_message ("debugXL", $subr_name, "read FUNC_FILE = $FUNC_FILE");

$line_n = 0;
  $index_val = 0;
  while (<FUNC_FILE>)
    {
      $line = $_;
      chomp ($line);
      $line =~ s/ --  no functions found//;

gp_message ("debug", $subr_name, "FUNC_FILE: input line = $line");

$line_n++;
      if ($line =~ /$line_regex/) # field 2|3 needs to be \S in case of -ve sign
        {
#------------------------------------------------------------------------------
# A typical target line looks like this:
# 11:0x001492e0  6976.900   <additional_timings> _lwp_start
#------------------------------------------------------------------------------
          gp_message ("debugXL", $subr_name, "select = $line");
          if ($is_calls)
            {
              $segment = $3;
              $offset  = $5;
              $spaces  = $6;
              $rest    = $7;
              $PC_Address = $segment.$4.$offset; # PC Addr.
              gp_message ("debugXL", $subr_name, "is_calls = ".(($is_calls) ? "TRUE" : "FALSE")." \$3 = $3");
              gp_message ("debugXL", $subr_name, "is_calls = ".(($is_calls) ? "TRUE" : "FALSE")." \$5 = $5");
              gp_message ("debugXL", $subr_name, "is_calls = ".(($is_calls) ? "TRUE" : "FALSE")." \$6 = $6");
              gp_message ("debugXL", $subr_name, "is_calls = ".(($is_calls) ? "TRUE" : "FALSE")." \$7 = $7");
            }
          else
            {
              $segment = $2;
              $offset  = $4;
              $spaces  = $5;
              $rest    = $6;
              $PC_Address = $segment.$3.$offset; # PC Addr.
              gp_message ("debugXL", $subr_name, "is_calls = ".(($is_calls) ? "TRUE" : "FALSE")." \$2 = $2");
              gp_message ("debugXL", $subr_name, "is_calls = ".(($is_calls) ? "TRUE" : "FALSE")." \$4 = $4");
              gp_message ("debugXL", $subr_name, "is_calls = ".(($is_calls) ? "TRUE" : "FALSE")." \$5 = $5");
              gp_message ("debugXL", $subr_name, "is_calls = ".(($is_calls) ? "TRUE" : "FALSE")." \$6 = $6");
            }
          if ($segment == -1)
            {
#------------------------------------------------------------------------------
# presume vDSO field overflow - er_print used an inadequate format
# or the fsummary (MASTER) had the wrong format for -1?
# rats - get ahead of ourselves - should not be a field abuttal so
#------------------------------------------------------------------------------
              if ($line =~ /$name_regex/)
                {
                  if ($metric_ok)
                    {
                      $metric_value = $1; # whatever
                      $routine = $2;
                    }
                  else
                    {
                      $routine = $1;
                    }
                  if ($is_calls)
                    {
                      if (substr ($routine,0,1) eq "*")
                        {
                          $routine = substr ($routine,1);
                        }
                    }
                  for $vdso_key (keys %LINUX_vDSO)
                    {
                      if ($routine eq $LINUX_vDSO{$vdso_key})
                        {
#------------------------------------------------------------------------------
# presume no duplicates - at least can check offset
#------------------------------------------------------------------------------
                          if ($vdso_key =~ /(\d+):(\S+)/)
#------------------------------------------------------------------------------
# no -ve segments allowed and not expected
#------------------------------------------------------------------------------
                            {
                              if ($2 eq $offset)
                                {
#------------------------------------------------------------------------------
# the real segment
#------------------------------------------------------------------------------
                                  $segment = $1;
                                  gp_message ("debugXL", $subr_name, "rescued segment for $PC_Address($routine)->$segment:$offset $FUNC_FILE");
                                  $PC_Address = $segment.":".$offset; # PC Addr.
                                  gp_message ("debugXL", $subr_name, "vdso line ->$line");
                                  $line = $PC_Address.(' ' x (length ($spaces)-2)).$rest;
                                  gp_message ("debugXL", $subr_name, "becomes   ->$line");
                                  last;
                                }
                            }
                        }
                    }
                }
              else
                {
                  gp_message ("debug", $subr_name, "name_regex failure for file $FUNC_FILE");
                }
            }

#------------------------------------------------------------------------------
# a rotten exception for Linux vDSO
# With a BIG "PC Address" like 32767:0x841fecd0, the functions.sort.func_PC file
# can have lines like
#->32767:0x841fecd0161.553   527182898954  131.936    100003     __vdso_gettimeofday<-
#->32767:0x153ff810 42.460   0                   0   __vdso_gettimeofday<-
#->-1:0xff600000   99.040   0                   0   [vsyscall]<-
#  (Real PC Address: 4294967295:0xff600000)
#-> 4294967295:0xff600000   99.040   0                   0   [vsyscall]<-
#-> 9:0x00000020   49.310   0                   0   <static>@0x7fff153ff600 ([vdso])<-
# Rats!
# $LINUX_vDSO{substr($order[$i]{"addressobjtext"},1)} = $order[$i]{"routine"};
#------------------------------------------------------------------------------

$not_printed = $TRUE;
          for $vdso_key (keys %LINUX_vDSO)
            {
              if ($line =~ /^(\s*)($vdso_key)(.*)$/)
                {
                  $blanks = 1;
                  $rest   = 3;
                  $lblanks = length ($blanks);
                  $lvdso_key = length ($vdso_key);
                  $PC_Address = $vdso_key; # PC Addr.
                  $offy = ($lblanks+$lvdso_key < $pc_len) ? $pc_len : $lblanks+$lvdso_key;
                  gp_message ("debugXL", $subr_name, "offy = $offy for ->$line<-");
                  if ($pc_len)
                    {
                      print FUNC_FILE_NO_PC substr ($line,$offy)."\n";
                      $not_printed = $FALSE;
                    }
                  else
                    {
                      die ("sod1a");
                    }
                  gp_message ("debugXL", $subr_name, "vdso line ->$line");
                  if (substr ($line,$lblanks+$lvdso_key,1) eq " ")
                    {
#------------------------------------------------------------------------------
# O.K. no field abuttal
#------------------------------------------------------------------------------
                      gp_message ("debugXL", $subr_name, "vdso no field abuttal line ->$line");
                    }
                  else
                    {
                      gp_message ("debugXL", $subr_name, "vdso field abuttal line ->$line");
                      $line = $blanks.$vdso_key." ".$rest;
                    }
                  gp_message ("debugXL", $subr_name, "becomes   ->$line");
                  last;
                }
            }
          if ($not_printed)
            {
              if ($pc_len)
                {
                  print FUNC_FILE_NO_PC substr ($line,$pc_len)."\n";
                }
              else
                {
                  die ("sod1b");
                }
              $not_printed = $FALSE;
            }
        }
      else
        {
          if (!$pc_len)
            {
              if ($line =~ /(^\s*PC Addr.\s+)(\S+)/)
                {
                  $pc_len = length ($1); # say 15
                  print FUNC_FILE_NO_PC substr ($line,$pc_len)."\n";
                }
              else
                {
                  print FUNC_FILE_NO_PC "$line\n";
                }
            }
          else
            {
              if ($pc_len)
                {
                  my $strlen = length ($line);
                  if ($strlen > 0 )
                    {
                      print FUNC_FILE_NO_PC substr ($line,$pc_len)."\n";
                    }
                  else
                    {
                      print FUNC_FILE_NO_PC "\n";
                    }
                }
              else
                {
                  die ("sod2");
                }
            }
          next;
        }
      $routine = "";
      if ($line =~ /$name_regex/)
        {
          if ($metric_ok)
            {
              $metric_value = $1; # whatever
              $routine = $2;
            }
          else
            {
              $routine = $1;
            }
        }

if ($is_calls)
        {
          if (substr ($routine,0,1) eq "*")
            {
              $routine = substr ($routine,1);
            }
        }
      if (length ($routine))
        {
          $order[$index_val]{"routine"} = $routine;
          if ($metric_ok)
            {
              $order[$index_val]{"metric_value"} = $metric_value;
            }
          $order[$index_val]{"PC Address"} = $PC_Address;
          $df_flag = 0;
          if (not exists ($functions_per_metric_indexes{$routine}))
            {
              $functions_per_metric_indexes{$routine} = [$index_val];
            }
          else
            {
              push (@{$functions_per_metric_indexes{$routine}},$index_val); # add $RI to list
            }
          gp_message ("debugXL", $subr_name, "updated functions_per_metric_indexes $routine [$index_val] line = $line");
          if ($PC_Address =~ /\s*(\S+):(\S+)/)
            {
              my ($segment,$offset);
              $segment = $1;
              $offset = $2;
              $address_decimal = bigint::hex ($offset); # decimal
##              $full_address_field = '@'.$segment.":".$offset; # e.g. @2:0x0003f280
              $full_address_field = $segment.":".$offset; # e.g. @2:0x0003f280
              $order[$index_val]{"addressobj"} = $address_decimal;
              $order[$index_val]{"addressobjtext"} = $full_address_field;
            }
#------------------------------------------------------------------------------
# Check uniqueness
#------------------------------------------------------------------------------
          if (not exists ($functions_per_metric_first_index{$routine}{$PC_Address}))
            {
              $functions_per_metric_first_index{$routine}{$PC_Address} = $index_val;
              $u++; #$RI
            }
          else
            {
              if (!($metric eq "calls" || $metric eq "calltree"))
                {
                  gp_message ("debug", $subr_name, "file $FUNC_FILE: function $routine already has a PC Address");
                }
            }

$index_val++;
          gp_message ("debugXL", $subr_name, "updated index_val = $index_val");
          $n++;
          next;
        }
      else
        {
          if ($n && length ($line))
            {
              my $msg = "unexpected line format in functions file $FUNC_FILE line->$line<-";
              gp_message ("assertion", $subr_name, $msg);
            }
        }
    }
  close (FUNC_FILE);
  close (FUNC_FILE_NO_PC);

for my $i (sort keys %functions_per_metric_indexes)
    {
      my $values = "";
      for my $fields (sort keys @{ $functions_per_metric_indexes{$i} })
        {
           $values .= "$functions_per_metric_indexes{$i}[$fields] ";
        }
      gp_message ("debugXL", $subr_name, "on return: functions_per_metric_indexes{$i} = $values");
    }

return (\@order, \%functions_per_metric_first_index, \%functions_per_metric_indexes);

} #-- End of subroutine function_info

#------------------------------------------------------------------------------
# Generate a html header.
#------------------------------------------------------------------------------
sub generate_a_header
{
  my $subr_name = get_my_name ();

my ($page_text_ref, $size_text_ref, $position_text_ref) = @_;

my $page_text     = ${ $page_text_ref };
  my $size_text     = ${ $size_text_ref };
  my $position_text = ${ $position_text_ref };
  my $html_header;

$html_header  = "<div class=\"" . $position_text . "\">\n";
  $html_header .= "<". $size_text . ">\n";
  $html_header .= $page_text . "\n";
  $html_header .= "</". $size_text . ">\n";
  $html_header .= "</div>";

gp_message ("debugXL", $subr_name, "on exit page_title = $html_header");

return (\$html_header);

} #-- End of subroutine generate_a_header

my ($number_of_metrics_ref, $function_info_ref, $function_view_structure_ref,
      $function_address_info_ref, $addressobjtextm_ref,
      $input_string_ref) = @_;

my $number_of_metrics       = ${ $number_of_metrics_ref };
  my @function_info           = @{ $function_info_ref };
  my %function_view_structure = %{ $function_view_structure_ref };
  my %function_address_info   = %{ $function_address_info_ref };
  my %addressobjtextm         = %{ $addressobjtextm_ref };
  my $input_string            = ${ $input_string_ref };

my @caller_callee_data = ();
  my $caller_callee_data_ref;
  my $outfile;
  my $input_line;

my $fullname;
  my $separator = "cuthere";

my @address_field = ();
  my @fields = ();
  my @function_names = ();
  my @marker = ();
  my @metric_values = ();
  my @word_index_values = ();
  my @header_lines = ();

my $all_metrics;
  my $elements_in_name;
  my $full_hex_address;
  my $hex_address;
  my $msg;

my $remainder2;

my $file_title;
  my $page_title;
  my $size_text;
  my $position_text;
  my @html_metric_sort_header = ();
  my $html_header;
  my $html_title_header;
  my $html_home;
  my $html_acknowledgement;
  my $html_end;
  my $html_line;

my $marker_target_function;
  my $max_metrics_length = 0;
  my $metrics_length;
  my $modified_line;
  my $name_regex;
  my $no_of_fields;
  my $routine;
  my $routine_length;
  my $string_length;
  my $top_header;
  my $total_header_lines;
  my $word_index_values_ref;
  my $infile;

my $outputdir               = append_forward_slash ($input_string);
  my $LANG                    = $g_locale_settings{"LANG"};
  my $decimal_separator       = $g_locale_settings{"decimal_separator"};

gp_message ("debug", $subr_name, "decimal_separator = $decimal_separator");
  gp_message ("debug", $subr_name, "outputdir = $outputdir");

$infile  = $outputdir . "caller-callee-PC2";
  $outfile = $outputdir . $g_html_base_file_name{"caller_callee"} . ".html";

gp_message ("debug", $subr_name, "infile = $infile outfile = $outfile");

open (CALLER_CALLEE_IN, "<", $infile)
    or die ("unable to open caller file $infile for reading - '$!'");
  gp_message ("debug", $subr_name, "opened file $infile for reading");

open (CALLER_CALLEE_OUT, ">", $outfile)
    or die ("unable to open $outfile for writing - '$!'");
  gp_message ("debug", $subr_name, "opened file $outfile for writing");

$msg = "building caller-callee file " . $outfile;
  gp_message ("debug", $subr_name, $msg);
  gp_message ("verbose", $subr_name, $msg);

#------------------------------------------------------------------------------
# Generate some of the structures used in the HTML output.
#------------------------------------------------------------------------------
  $file_title  = "Caller-callee overview";
  $html_header = ${ create_html_header (\$file_title) };
  $html_home   = ${ generate_home_link ("right") };

$page_title    = "Caller Callee View";
  $size_text     = "h2";
  $position_text = "center";
  $html_title_header = ${ generate_a_header (\$page_title,
					     \$size_text,
					     \$position_text) };

#------------------------------------------------------------------------------
# Read all of the file into an array with the name caller_callee_data.
#------------------------------------------------------------------------------
  chomp (@caller_callee_data = <CALLER_CALLEE_IN>);

#------------------------------------------------------------------------------
# Remove a legacy redundant string, if any.
#------------------------------------------------------------------------------
  @caller_callee_data = @{ remove_redundant_string (\@caller_callee_data)};

#------------------------------------------------------------------------------
# Typical structure of the input file:
#
# Current metrics: address:name:e.totalcpu:e.cycles:e+insts:e+llm
# Current Sort Metric: Exclusive Total CPU Time ( e.totalcpu )
# Functions sorted by metric: Exclusive Total CPU Time
# Callers and callees sorted by metric: Attributed Total CPU Time
#
# PC Addr.       Name              Attr.     Attr. CPU  Attr.         Attr.
#                                  Total     Cycles     Instructions  Last-Level
#                                  CPU sec.   sec.      Executed      Cache Misses
# 1:0x00000000  *<Total>           3.502     4.005      15396819700   24024250
# 7:0x00008070   start_thread      3.342     3.865      14500538981   23824045
# 6:0x000233a0   __libc_start_main 0.160     0.140        896280719     200205
#
# PC Addr.       Name              Attr.     Attr. CPU  Attr.         Attr.
#                                  Total     Cycles     Instructions  Last-Level
#                                  CPU sec.   sec.      Executed      Cache Misses
# 2:0x000021f9   driver_mxv        3.342     3.865      14500538981   23824045
# 2:0x000021ae  *mxv_core          3.342     3.865      14500538981   23824045
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# Scan the input file.  The first lines are assumed to be part of the header,
# so we store those. The diagnostic lines that echo some settings are also
# stored, but currently not used.
#------------------------------------------------------------------------------
  my $scan_header = $FALSE;
  my $scan_caller_callee_data = $FALSE;
  my $data_function_block = "";
  my @function_blocks = ();
  my $first = $TRUE;
  my @html_caller_callee = ();
  my @top_level_header = ();

#------------------------------------------------------------------------------
# The regexes.
#------------------------------------------------------------------------------
  my $empty_line_regex       = '^\s*$';
  my $line_of_interest_regex = '\s*(\d+:0x[a-fA-F0-9]+)\s+(\**)(.*)';
  my $get_hex_address_regex  = '(\d+):0x(\S+)';
  my $get_metric_field_regex = ')\s+([\s\d' . $decimal_separator . ']*)';
  my $header_name_regex      = '(.*\.)(\s+)(Name)\s+(.*)';
  my $sorted_by_regex        = 'sorted by metric:';
  my $current_regex          = '^Current';
  my $get_addr_offset_regex  = '^@\d+:';

#------------------------------------------------------------------------------
# Get the length of the first metric field across all lines.  This value is
# used to pad the first metric with spaces and get the alignment right.
#
# Scan the input data and find the line(s) with metric values.  A complication
# is that a function name may consists of more than one field.
#
# Note.  This part could be used to parse the other elements of the input file,
# but that makes the loop very complicated.   Instead, we re-scan the data
# below and process each block separately.
#
# Since this data is all in memory and relatively small, the performance should
# not suffer much, but it does improve the readability of the code.
#------------------------------------------------------------------------------
  $g_max_length_first_metric = 0;

my @hex_addresses = ();
  my @metrics_array = ();
  my @length_first_metric = ();
  my @special_marker = ();
  my @the_function_name = ();
  my @the_metrics = ();

my $find_hex_address_regex = '\s*(\d+:0x[a-fA-F0-9]+)\s+(.*)';
  my $find_metric_values_regex  = '\)\s+\[.*\]\s+(\d+';
     $find_metric_values_regex .= '[\.\d\ ]*)|\)\s+(\d+[\.\d\ ]*)';
  my $find_marker_regex = '(^\*).*';

my @html_block_prologue;
  my @html_code_function_block;
  my $marker;
  my $list_with_metrics;
  my $reduced_line;

$msg  = "loop over the caller-callee data - number of lines = ";
  $msg .= ($#caller_callee_data + 1);
  gp_message ("debugXL", $subr_name, $msg);

for (my $line = 0; $line <= $#caller_callee_data; $line++)
    {
      $input_line = $caller_callee_data[$line];
      $reduced_line = $input_line;

$msg = "line = " . $line . " input_line = " . $input_line;
      gp_message ("debugXL", $subr_name, $msg);

if ($input_line =~ /$find_hex_address_regex/)
#------------------------------------------------------------------------------
# This is an input line of interest.
#------------------------------------------------------------------------------
        {
          my ($hex_address_ref, $marker_ref, $reduced_line_ref, 
              $list_with_metrics_ref) =
                                       split_function_data_line (\$input_line);

$hex_address       = ${ $hex_address_ref };
          $marker            = ${ $marker_ref };
          $reduced_line      = ${ $reduced_line_ref };
          $list_with_metrics = ${ $list_with_metrics_ref };

$msg = "RESULT full_hex_address = " . $hex_address;
          $msg .= " -- metric values = " . $list_with_metrics;
          $msg .= " -- marker = " . $marker;
          $msg .= " -- function name = " . $reduced_line;
          gp_message ("debugXL", $subr_name, $msg);
 
#------------------------------------------------------------------------------
# Store the address and marker.
#------------------------------------------------------------------------------
          push (@the_function_name, $reduced_line);
          push (@hex_addresses, $hex_address);
          if ($marker eq "*")
            {
              push (@special_marker, "*");
            }
          else
            {
              push (@special_marker, "X");
            }
#------------------------------------------------------------------------------
# Processing of the metrics.
#------------------------------------------------------------------------------
          @metrics_array = split (" ", $list_with_metrics);

#------------------------------------------------------------------------------
# If the first metric is 0. (or 0, depending on the locale), the calculation
# of the length needs to be adjusted, because 0. is really 0.000.
#
# While we could easily add 3 to the length, we assign a symbolic value to the
# first metric (ZZZ) and then compute the length.  This makes things clearer.
# I hope ;-)
#------------------------------------------------------------------------------
          my $first_metric = $metrics_array[0];
          $msg = "first metric found = " . $first_metric;
          gp_message ("debugXL", $subr_name, $msg);
          if ($first_metric =~ /^0$decimal_separator$/)
            {
              $first_metric = "0.ZZZ";
              $msg = "fixed up $first_metric";
              gp_message ("debugXL", $subr_name, $msg);
            }
              $g_max_length_first_metric = max ($g_max_length_first_metric, 
						length ($first_metric));

$msg = "first_metric = $first_metric " .
                     "g_max_length_first_metric = $g_max_length_first_metric";
              gp_message ("debugXL", $subr_name, $msg);
              push (@length_first_metric, length ($first_metric));
              push (@the_metrics, $list_with_metrics);
        }
    }

$msg = "the following function names have been found";
  gp_message ("debugM", $subr_name, $msg);
  for my $i (0 .. $#the_function_name)
    {
      $msg = "the_function_name{" . $i . "] = " . $the_function_name[$i];
      gp_message ("debugM", $subr_name, $msg);
    }

$msg = "final: g_max_length_first_metric = " . $g_max_length_first_metric;
  gp_message ("debugM", $subr_name, $msg);
  $msg = "\$#hex_addresses = " . $#hex_addresses;
  gp_message ("debugM", $subr_name, $msg);

#------------------------------------------------------------------------------
# Main loop over the input data.
#------------------------------------------------------------------------------
  my $index_start = 0;  # 1
  my $index_end   = -1;  # 0
  for (my $line = 0; $line <= $#caller_callee_data; $line++)
    {
      $input_line = $caller_callee_data[$line];

if ($input_line =~ /$header_name_regex/)
        {
          $scan_header = $TRUE;
          $msg  = "line = " . $line . " encountered start of the header";
          $msg .= " scan_header = " . $scan_header . " first = " . $first;
          gp_message ("debugXL", $subr_name, $msg);
        }
      elsif (($input_line =~ /$sorted_by_regex/) or
             ($input_line =~ /$current_regex/))
        {
          $msg =  "line = " . $line . " captured top level header: " .
                     "input_line = " . $input_line;
          gp_message ("debugXL", $subr_name, $msg);

push (@top_level_header, $input_line);
        }
      elsif ($input_line =~ /$line_of_interest_regex/)
        {
          $index_end++;
          $scan_header             = $FALSE;
          $scan_caller_callee_data = $TRUE;
          $data_function_block    .= $separator . $input_line;

$msg = "line = $line updated index_end   = $index_end";
          gp_message ("debugXL", $subr_name, $msg);
          $msg = "line = $line input_line          = " . $input_line;
          gp_message ("debugXL", $subr_name, $msg);
          $msg = "line = $line data_function_block = " . $data_function_block;
          gp_message ("debugXL", $subr_name, $msg);
        }
      elsif (($input_line =~ /$empty_line_regex/) and
             ($scan_caller_callee_data))
        {
#------------------------------------------------------------------------------
# An empty line is interpreted as the end of the current block and we process
# this, including the generation of the html code for this block.
#------------------------------------------------------------------------------
          $first = $FALSE;
          $scan_caller_callee_data = $FALSE;

$msg = "new block";
          gp_message ("debugXL", $subr_name, $msg);
          $msg = "line = " . $line . " index_start = " . $index_start;
          gp_message ("debugXL", $subr_name, $msg);
          $msg = "line = " . $line . " index_end   = " . $index_end;
          gp_message ("debugXL", $subr_name, $msg);

$msg  = "line = " . $line . " data_function_block = ";
          $msg .= $data_function_block;
          gp_message ("debugXL", $subr_name, $msg);

push (@function_blocks, $data_function_block);

##          $msg  = "    generating the html blocks (";
##          $msg .= $index_start . " - " . $index_end .")";
##          gp_message ("verbose", $subr_name, $msg);

my ($html_block_prologue_ref, $html_code_function_block_ref) =
					generate_html_function_blocks (
						\$index_start,
						\$index_end,
						\@hex_addresses,
						\@the_metrics,
						\@length_first_metric,
						\@special_marker,
						\@the_function_name,
						\$separator,
						$number_of_metrics_ref,
						\$data_function_block,
						$function_info_ref,
						$function_view_structure_ref);

@html_block_prologue      = @{ $html_block_prologue_ref };
          @html_code_function_block = @{ $html_code_function_block_ref };

for my $lines (0 .. $#html_code_function_block)
            {
              $msg = "final html_code_function_block[" . $lines . "] = " .
                        $html_code_function_block[$lines];
              gp_message ("debugXL", $subr_name, $msg);
            }

$data_function_block = "";

push (@html_caller_callee, @html_block_prologue);
          push (@html_caller_callee, @header_lines);
          push (@html_caller_callee, @html_code_function_block);

$index_start = $index_end + 1;
          $index_end   = $index_start - 1;
          $msg = "line = " . $line . " reset index_start = " . $index_start;
          gp_message ("debugXL", $subr_name, $msg);
          $msg = "line = " . $line . " reset index_end   = " . $index_end;
          gp_message ("debugXL", $subr_name, $msg);
        }

#------------------------------------------------------------------------------
# Only capture the first header.  They are all identical.
#------------------------------------------------------------------------------
      if ($scan_header and $first)
        {
          if (defined ($4))
            {
#------------------------------------------------------------------------------
# This group is only defined for the first line of the header.
#------------------------------------------------------------------------------
              gp_message ("debugXL", $subr_name, "header1 = $4");
              gp_message ("debugXL", $subr_name, "extra   = $3 spaces=x$2x");
              my $newline = "<b>" . $4 . "</b>";
              push (@header_lines, $newline);
            }
          elsif ($input_line =~ /\s*(.*)/)
            {
#------------------------------------------------------------------------------
# Capture the subsequent header lines.
#------------------------------------------------------------------------------
              gp_message ("debugXL", $subr_name, "headern = $1");
              my $newline = "<b>" . $1 . "</b>";
              push (@header_lines, $newline);
            }
        }

}

for my $i (0 .. $#header_lines)
    {
      gp_message ("debugXL", $subr_name, "header_lines[$i] = $header_lines[$i]");
    }
  for my $i (0 .. $#function_blocks)
    {
      gp_message ("debugXL", $subr_name, "function_blocks[$i] = $function_blocks[$i]");
    }

my $number_of_blocks = $#function_blocks + 1;
  gp_message ("debugXL", $subr_name, "There are " . $number_of_blocks . " function blocks:");

for my $i (0 .. $#function_blocks)
    {
#------------------------------------------------------------------------------
# The split produces an empty first field and is why we skip the first field.
#------------------------------------------------------------------------------
##      my @entries = split ("cuthere", $function_blocks[$i]);
      my @entries = split ($separator, $function_blocks[$i]);
      for my $k (1 .. $#entries)
        {
          my $msg = "entries[" . $k . "] = ". $entries[$k];
          gp_message ("debugXL", $subr_name, $k . $msg);
        }
    }

#------------------------------------------------------------------------------
# Parse and process the individual function blocks.
#------------------------------------------------------------------------------
  $msg  = "Parse and process function blocks - total blocks = ";
  $msg .= $#function_blocks + 1;
  gp_message ("verbose", $subr_name, $msg);

for my $i (0 .. $#function_blocks)
    {
      $msg = "process function block " . $i;
      gp_message ("debugXL", $subr_name, $msg);

$msg = "function_blocks[" . $i . "] = ". $function_blocks[$i];
      gp_message ("debugXL", $subr_name, $msg);
#------------------------------------------------------------------------------
# This split produces an empty first field.  This is why we skip this in the
# loop below.
#------------------------------------------------------------------------------
      my @entries = split ($separator, $function_blocks[$i]);

#------------------------------------------------------------------------------
# An example of the content of array @entries:
# <empty line>
# 6:0x0003ad20   drand48           0.100     0.084        768240570          0
# 6:0x0003af50  *erand48_r         0.080     0.084        768240570          0
# 6:0x0003b160   __drand48_iterate 0.020     0.                   0          0
#------------------------------------------------------------------------------
      for my $k (1 .. $#entries)
        {
          my $input_line = $entries[$k];

$msg = "input_line = entries[" . $k . "] = ". $entries[$k];
          gp_message ("debugXL", $subr_name, $msg);

my ($hex_address_ref, $marker_ref, $reduced_line_ref,
              $list_with_metrics_ref) =
                                       split_function_data_line (\$input_line);

$full_hex_address       = ${ $hex_address_ref };
          $marker_target_function = ${ $marker_ref };
          $routine                = ${ $reduced_line_ref };
          $all_metrics            = ${ $list_with_metrics_ref };

$msg = "RESULT full_hex_address = " . $full_hex_address;
          $msg .= " -- metric values = " . $all_metrics;
          $msg .= " -- marker = " . $marker_target_function;
          $msg .= " -- function name = " . $routine;
          gp_message ("debugXL", $subr_name, $msg);

$metrics_length = length ($all_metrics);
          $max_metrics_length = max ($max_metrics_length, $metrics_length);

if ($full_hex_address =~ /(\d+):0x(\S+)/)
            {
              $hex_address = "0x" . $2;
            }
          push (@marker, $marker_target_function);

push (@address_field, $hex_address);
          push (@address_field, $full_hex_address);
          $msg  = "pushed " . $full_hex_address;
          $msg .= " to array address_field";
          gp_message ("debugXL", $subr_name, $msg);

$modified_line = $all_metrics . " " . $routine;
          gp_message ("debugXL", $subr_name, "xxxxxxx = $modified_line");

push (@metric_values, $all_metrics);
          $msg = "pushed " . $all_metrics . " to array metric_values";
          gp_message ("debugXL", $subr_name, $msg);

push (@function_names, $routine);
          $msg = "pushed " . $routine . " to array function_names";
          gp_message ("debugXL", $subr_name, $msg);
        }

$total_header_lines = $#header_lines + 1;
      $msg = "total_header_lines = " . $total_header_lines;
      gp_message ("debugXL", $subr_name, $msg);

gp_message ("debugXL", $subr_name, "Final output");
      for my $i (keys @header_lines)
        {
          gp_message ("debugXL", $subr_name, "$header_lines[$i]");
        }
      for my $i (0 .. $#function_names)
        {
          $msg  = $metric_values[$i] . " " . $marker[$i]; 
          $msg .= $function_names[$i] . " (" . $address_field[$i] . ")";
          gp_message ("debugXL", $subr_name, $msg);
        }
#------------------------------------------------------------------------------
# Check if this function has multiple occurrences.
# TBD: Replace by the function call for this.
#------------------------------------------------------------------------------
      $msg  = "check for multiple occurrences - function_names = ";
      $msg .= ($#function_names + 1);
      gp_message ("debugXL", $subr_name, $msg);

for my $i (0 .. $#function_names)
        {
          my $current_address = $address_field[$i];
          my $found_a_match;
          my $ref_index;
          my $alt_name;
          my $addr_offset;
 
          $routine = $function_names[$i];
          $alt_name = $routine;
          gp_message ("debugXL", $subr_name, "checking for routine = $routine");
          if (exists ($g_multi_count_function{$routine}))
            {
#------------------------------------------------------------------------------
# TBD: Scan all of the function_info list. Or beter: add index to
# g_multi_count_function.
#------------------------------------------------------------------------------

$found_a_match = $FALSE;

$msg  = $routine . ": occurrences = ";
              $msg .= $g_function_occurrences{$routine};
              gp_message ("debugXL", $subr_name, $msg);

for my $ref (keys @{ $g_map_function_to_index{$routine} })
                {
                  $ref_index = $g_map_function_to_index{$routine}[$ref];

$msg  = $routine . ": retrieving duplicate entry at ";
                  $msg .= "ref_index = " . $ref_index;
                  gp_message ("debugXL", $subr_name, $msg);
                  $msg  = $routine . ": function_info[" . $ref_index;
                  $msg .= "]{alt_name} = ";
                  $msg .= $function_info[$ref_index]{'alt_name'};
                  gp_message ("debugXL", $subr_name, $msg);

$addr_offset = $function_info[$ref_index]{"addressobjtext"};
                  $msg = $routine . ": addr_offset = " . $addr_offset;
                  gp_message ("debugXL", $subr_name, $msg);

$addr_offset =~ s/$get_addr_offset_regex//;
                  $msg = $routine . ": addr_offset = " . $addr_offset;
                  gp_message ("debugXL", $subr_name, $msg);

if ($addr_offset eq $current_address)
                    {
                      $found_a_match = $TRUE;
                      last;
                    }
                }
              $msg  = $function_info[$ref_index]{'alt_name'};
              $msg .= " is the actual function for i = " . $i . " ";
              $msg .= $found_a_match;
              gp_message ("debugXL", $subr_name, $msg);

$alt_name = $function_info[$ref_index]{'alt_name'};
            }
          gp_message ("debugXL", $subr_name, "alt_name = $alt_name");
        }
      $msg = "completed the check for multiple occurrences";
      gp_message ("debugXL", $subr_name, $msg);

#------------------------------------------------------------------------------
# Figure out the column width.  Since the columns in the header may include
# spaces, we use the first line with metrics for this.
#------------------------------------------------------------------------------
      my $top_header = $metric_values[0];
      my $word_index_values_ref = find_words_in_line (\$top_header);
      my @word_index_values = @{ $word_index_values_ref };

# $i = 0 0 4
# $i = 1 10 14
# $i = 2 21 31
# $i = 3 35 42
      for my $i (keys @word_index_values)
        {
          $msg  = "i = " . $i . " " . $word_index_values[$i][0] . " ";
          $msg .= $word_index_values[$i][1];
          gp_message ("debugXL", $subr_name, $msg);
        }

#------------------------------------------------------------------------------
# Empty the buffers before processing the next block with data.
#------------------------------------------------------------------------------
      @function_names = ();
      @metric_values = ();
      @address_field = ();
      @marker = ();
 
      $msg  = "erased contents of arrays function_names, metric_values, ";
      $msg .= "address_field, and marker";
      gp_message ("debugXL", $subr_name, $msg);

}

push (@html_metric_sort_header, "<i>");
  for my $i (0 .. $#top_level_header)
    {
      $html_line = $top_level_header[$i] . "<br>";
      push (@html_metric_sort_header, $html_line);
    }
  push (@html_metric_sort_header, "</i>");

print CALLER_CALLEE_OUT $html_header;
  print CALLER_CALLEE_OUT $html_home;
  print CALLER_CALLEE_OUT $html_title_header;
  print CALLER_CALLEE_OUT "$_" for @g_html_experiment_stats;
##  print CALLER_CALLEE_OUT "<br>\n";
##  print CALLER_CALLEE_OUT "$_\n" for @html_metric_sort_header;
  print CALLER_CALLEE_OUT "<pre>\n";
  print CALLER_CALLEE_OUT "$_\n" for @html_caller_callee;
  print CALLER_CALLEE_OUT "</pre>\n";

#------------------------------------------------------------------------------
# Get the acknowledgement, return to main link, and final html statements.
#------------------------------------------------------------------------------
  $html_home            = ${ generate_home_link ("left") };
  $html_acknowledgement = ${ create_html_credits () };
  $html_end             = ${ terminate_html_document () };

print CALLER_CALLEE_OUT $html_home;
  print CALLER_CALLEE_OUT "<br>\n";
  print CALLER_CALLEE_OUT $html_acknowledgement;
  print CALLER_CALLEE_OUT $html_end;

close (CALLER_CALLEE_OUT);

$msg = "the caller-callee information has been generated";
  gp_message ("verbose", $subr_name, $msg);

return (0);

} #-- End of subroutine generate_caller_callee

#------------------------------------------------------------------------------
# Generate the html version of the disassembly file.
#
# Note to self (TBD)
# https://community.intel.com/t5/Intel-oneAPI-AI-Analytics/bd-p/ai-analytics-toolkit
#------------------------------------------------------------------------------
sub generate_dis_html
{
  my $subr_name = get_my_name ();

my ($target_function_ref, $number_of_metrics_ref, $function_info_ref,
      $function_address_and_index_ref, $outputdir_ref, $func_ref,
      $source_line_ref, $metric_ref, $addressobj_index_ref) = @_;

my $target_function            = ${ $target_function_ref };
  my $number_of_metrics          = ${ $number_of_metrics_ref };
  my @function_info              = @{ $function_info_ref };
  my %function_address_and_index = %{ $function_address_and_index_ref };
  my $outputdir                  = ${ $outputdir_ref };
  my $func                       = ${ $func_ref };
  my @source_line                = @{ $source_line_ref };
  my @metric                     = @{ $metric_ref };
  my %addressobj_index           = %{ $addressobj_index_ref };

my $dec_instruction_start;
  my $dec_instruction_end;
  my $hex_instruction_start;
  my $hex_instruction_end;

my @colour_line = ();
  my $hot_line;
  my $metric_values;
  my $src_line;
  my $dec_instr_address;
  my $instruction;
  my $operands;

my $html_new_line = "<br>";
  my $add_new_line_before;
  my $add_new_line_after;
  my $address_key;
  my $boldface;
  my $file;
  my $filename = $func;
  my $func_name;
  my $orig_hex_instr_address;
  my $hex_instr_address;
  my $index_string;
  my $input_metric;
  my $linenumber;
  my $name;
  my $last_address;
  my $last_address_in_hex;

my $file_title;
  my $html_header;
  my $html_home;
  my $html_end;

my $branch_regex      = $g_arch_specific_settings{"regex"};
  my $convert_to_dot    = $g_locale_settings{"convert_to_dot"};
  my $decimal_separator = $g_locale_settings{"decimal_separator"};
  my $hp_value          = $g_user_settings{"highlight_percentage"}{"current_value"};
  my $linksubexp        = $g_arch_specific_settings{"linksubexp"};
  my $subexp            = $g_arch_specific_settings{"subexp"};

my $file_is_empty;

my %branch_target = ();
  my %branch_target_no_ref = ();
  my @disassembly_file = ();
  my %extended_branch_target = ();
  my %inverse_branch_target = ();
  my @metrics = ();
  my @modified_html = ();

my $branch_target_ref;
  my $extended_branch_target_ref;
  my $branch_target_no_ref_ref;

my $branch_address;
  my $dec_branch_address;
  my $found_it;
  my $found_it_ref;
  my $func_name_in_dis_file;
  my $hex_branch_target;
  my $instruction_address;
  my $instruction_offset;
  my $link;
  my $modified_line;
  my $raw_hex_branch_target;
  my $src_line_ref;
  my $threshold_line;
  my $html_dis_out = $func . ".html";

#------------------------------------------------------------------------------
# The regex section.
#------------------------------------------------------------------------------
  my $call_regex = '.*([0-9a-fA-F]*):\s+(call)\s*0x([0-9a-fA-F]+)';
  my $line_of_interest_regex = '^#*\s+([\d' . $decimal_separator . '\s+]+)\[\s*(\d+|\?)\]';
  my $white_space_regex = '\s+';
  my $first_integer_regex = '^\d+$';
  my $integer_regex = '\d+';
  my $qmark_regex = '\?';
  my $src_regex = '(\s*)(\d+)\.(.*)';
  my $function_regex = '^(\s*)<Function:\s(.*)>';
  my $end_src_header_regex = "(^\\s+)(\\d+)\\.\\s+(.*)";
  my $end_dis_header_regex = "(^\\s+)(<Function: )(.*)>";
  my $control_flow_1_regex = 'j[a-z]+';
  my $control_flow_2_regex = 'call';
  my $control_flow_3_regex = 'ret';

##  my $function_call_regex2 = '(.*)\s+([0-9a-fA-F]*):\s+(call)\s*0x([0-9a-fA-F]+)\s*';
##  my $endbr_regex          = '\.*([0-9a-fA-F]*):\s+(endbr[32|64])';
#------------------------------------------------------------------------------
# Dynamic. Computed below.
#
# TBD: Try to move these up.
#------------------------------------------------------------------------------
  my $dis_regex;
  my $metric_regex;

gp_message ("debug", $subr_name, "g_branch_regex = $g_branch_regex");
  gp_message ("debug", $subr_name, "call_regex = $call_regex");
  gp_message ("debug", $subr_name, "g_function_call_v2_regex = $g_function_call_v2_regex");

my $the_title = set_title ($function_info_ref, $func, "disassembly");

gp_message ("debug", $subr_name, "the_title = $the_title");

$file_title      = $the_title;
  $html_header     = ${ create_html_header (\$file_title) };
  $html_home       = ${ generate_home_link ("right") };

push (@modified_html, $html_header);
  push (@modified_html, $html_home);
  push (@modified_html, "<pre>");

#------------------------------------------------------------------------------
# Open the input and output files.
#------------------------------------------------------------------------------
  open (INPUT_DISASSEMBLY, "<", $filename)
    or die ("$subr_name - unable to open disassembly file $filename for reading: '$!'");
  gp_message ("debug", $subr_name , "opened file $filename for reading");

open (HTML_OUTPUT, ">", $html_dis_out)
    or die ("$subr_name - unable to open file $html_dis_out for writing: '$!'");
  gp_message ("debug", $subr_name , "opened file $html_dis_out for writing");

#------------------------------------------------------------------------------
# Check if the file is empty
#------------------------------------------------------------------------------
  $file_is_empty = is_file_empty ($filename);
  if ($file_is_empty)
    {

#------------------------------------------------------------------------------
# The input file is empty.  Write a message in the html file and exit.
#------------------------------------------------------------------------------
      gp_message ("debug", $subr_name ,"file $filename is empty");

my $comment = "No disassembly generated by $tool_name - file $filename is empty";
      my $gp_error_file = $outputdir . "gp-listings.err";

my $html_empty_file_ref = html_text_empty_file (\$comment, \$gp_error_file);
      my @html_empty_file = @{ $html_empty_file_ref };

print HTML_OUTPUT "$_\n" for @html_empty_file;

close (HTML_OUTPUT);

return (\@source_line);
    }
  else
    {

#------------------------------------------------------------------------------
# Read the file into memory.
#------------------------------------------------------------------------------
      chomp (@disassembly_file = <INPUT_DISASSEMBLY>);
      gp_message ("debug", $subr_name ,"read file $filename into memory");
    }

my $max_length_first_metric = 0;
  my $src_line_no;

#------------------------------------------------------------------------------
# First scan through the assembly listing.
#------------------------------------------------------------------------------
  for (my $line_no=0; $line_no <= $#disassembly_file; $line_no++)
    {
      my $input_line = $disassembly_file[$line_no];
      gp_message ("debugXL", $subr_name, "[line $line_no] $input_line");

if ($input_line =~ /$line_of_interest_regex/)
        {

#------------------------------------------------------------------------------
# Found a matching line.  Examples are:
#      0.370                [37]   4021d1:  addsd  %xmm0,%xmm1
#   ## 1.001                [36]   4021d5:  add    $0x1,%rax
#------------------------------------------------------------------------------
          gp_message ("debugXL", $subr_name, "selected line \$1 = $1 \$2 = $2");

if (defined ($2) and defined($1))
            {
              @metrics = split (/$white_space_regex/ ,$1);
              $src_line_no = $2;
            }
          else
            {
              my $msg = "$input_line has an unexpected format";
              gp_message ("assertion", $subr_name, $msg);
            }

#------------------------------------------------------------------------------
# Compute the maximum length of the first metric and pad the field from the
# left later on.  The fractional part is ignored.
#------------------------------------------------------------------------------
          my $first_metric = $metrics[0];
          my $new_length;
          if ($first_metric =~ /$first_integer_regex/)
            {
              $new_length = length ($first_metric);
            }
          else
            {
              my @fields = split (/$decimal_separator/, $first_metric);
              $new_length = length ($fields[0]);
            }
          $max_length_first_metric = max ($max_length_first_metric, $new_length);
          my $msg;
          $msg = "first_metric = $first_metric " .
                 "max_length_first_metric = $max_length_first_metric";
          gp_message ("debugXL", $subr_name, $msg);

if ($src_line_no !~ /$qmark_regex/)
#------------------------------------------------------------------------------
# The source code line number is known and is stored.
#------------------------------------------------------------------------------
            {
              $source_line[$line_no] = $src_line_no;
              my $msg;
              $msg  = "found an instruction with a source line ref:";
              $msg .= " source_line[$line_no] = $source_line[$line_no]";
              gp_message ("debugXL", $subr_name, $msg);
            }

#------------------------------------------------------------------------------
# Check for function calls.  If found, get the address offset from $4 and
# compute the target address.
#------------------------------------------------------------------------------
          ($found_it_ref, $branch_target_ref, $extended_branch_target_ref) =
                                                 check_and_proc_dis_func_call (
                                                   \$input_line,
                                                   \$line_no,
                                                   \%branch_target,
                                                   \%extended_branch_target);
          $found_it = ${ $found_it_ref };

if ($found_it)
            {
              %branch_target = %{ $branch_target_ref };
              %extended_branch_target = %{ $extended_branch_target_ref };
            }

#------------------------------------------------------------------------------
# Look for a branch instruction, or the special endbr32/endbr64 instruction
# that is also considered to be a branch target.  Note that the latter is x86
# specific.
#------------------------------------------------------------------------------
          ($found_it_ref, $branch_target_ref, $extended_branch_target_ref,
           $branch_target_no_ref_ref) = check_and_proc_dis_branches (
                                               \$input_line,
                                               \$line_no,
                                               \%branch_target,
                                               \%extended_branch_target,
                                               \%branch_target_no_ref);
          $found_it = ${ $found_it_ref };

if ($found_it)
            {
              %branch_target = %{ $branch_target_ref };
              %extended_branch_target = %{ $extended_branch_target_ref };
              %branch_target_no_ref = %{ $branch_target_no_ref_ref };
            }
        }
    } #-- End of loop over line_no

%inverse_branch_target = reverse (%extended_branch_target);

gp_message ("debug", $subr_name, "generated inverse of branch target structure");
  gp_message ("debug", $subr_name, "completed parsing file $filename");

for my $key (sort keys %branch_target)
    {
      gp_message ("debug", $subr_name, "branch_target{$key} = $branch_target{$key}");
    }
  for my $key (sort keys %extended_branch_target)
    {
      gp_message ("debug", $subr_name, "extended_branch_target{$key} = $extended_branch_target{$key}");
    }
  for my $key (sort keys %inverse_branch_target)
    {
      gp_message ("debug", $subr_name, "inverse_branch_target{$key} = $inverse_branch_target{$key}");
    }
  for my $key (sort keys %branch_target_no_ref)
    {
      gp_message ("debug", $subr_name, "branch_target_no_ref{$key} = $branch_target_no_ref{$key}");
      $inverse_branch_target{$key} = $key;
    }
  for my $key (sort keys %inverse_branch_target)
    {
      gp_message ("debug", $subr_name, "inverse_branch_target{$key} = $inverse_branch_target{$key}");
    }

#------------------------------------------------------------------------------
# Process the disassembly.
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# Dynamically generate the regexes.
#------------------------------------------------------------------------------
  $metric_regex = '';
  for my $metric_used (1 .. $number_of_metrics)
    {
      $metric_regex .= '(\d+' . $decimal_separator . '*\d*)\s+';
    }

$dis_regex  = '^(#{2}|\s{2})\s+';
  $dis_regex .= '(.*)';
##  $dis_regex .= '\[\s*([0-9?]+)\]\s+([0-9a-fA-F]+):\s+([a-z0-9]+)\s+(.*)';
  $dis_regex .= '\[\s*([0-9?]+)\]\s+([0-9a-fA-F]+):\s+([a-z0-9]+)(.*)';

gp_message ("debugXL", $subr_name, "metric_regex = $metric_regex");
  gp_message ("debugXL", $subr_name, "dis_regex    = $dis_regex");
  gp_message ("debugXL", $subr_name, "src_regex    = $src_regex");
  gp_message ("debugXL", $subr_name, "contents of lines array");

#------------------------------------------------------------------------------
# Identify the header lines.  Make the minimal assumptions.
#
# In both cases, the first line after the header has whitespace.  This is
# followed by:
#
# - A source line file has "<line_no>."
# - A dissasembly file has "<Function:"
#
# These are the characteristics we use below.
#------------------------------------------------------------------------------
  for (my $line_no=0; $line_no <= $#disassembly_file; $line_no++)
    {
      my $input_line = $disassembly_file[$line_no];
      gp_message ("debugXL", $subr_name, "[line $line_no] $input_line");

if ($input_line =~ /$end_src_header_regex/)
        {
          gp_message ("debugXL", $subr_name, "header time is over - hit source line\n");
          gp_message ("debugXL", $subr_name, "$1 $2 $3\n");
          last;
        }
      if ($input_line =~ /$end_dis_header_regex/)
        {
          gp_message ("debugXL", $subr_name, "header time is over - hit disassembly line\n");
          last;
        }
      push (@modified_html, "<i>" . $input_line . "</i>");
    }
  my $line_index = scalar (@modified_html);
  gp_message ("debugXL", $subr_name, "final line_index = $line_index");

for (my $line_no=0; $line_no <= $line_index-1; $line_no++)
    {
      my $msg = " modified_html[$line_no] = $modified_html[$line_no]";
      gp_message ("debugXL", $subr_name, $msg);
    }

#------------------------------------------------------------------------------
# Source line:
#  20.       for (int64_t r=0; r<repeat_count; r++) {
#
# Disassembly:
#    0.340                [37]   401fec:  addsd   %xmm0,%xmm1
# ## 1.311                [36]   401ff0:  addq    $1,%rax
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# Find the hot PCs and store them.
#------------------------------------------------------------------------------
  my @hot_program_counters = ();
  my @transposed_hot_pc = ();
  my @max_metric_values = ();

gp_message ("debug", $subr_name, "determine the maximum metric values");
  for (my $line_no=$line_index-1; $line_no <= $#disassembly_file; $line_no++)
    {
      my $input_line = $disassembly_file[$line_no];

if ( $input_line =~ /$dis_regex/ )
        {
##          if ( defined ($1) and defined ($2) and defined ($3) and
##               defined ($4) and defined ($5) and defined ($6) )
          if ( defined ($1) and defined ($2) and defined ($3) and
               defined ($4) and defined ($5) )
            {
              $hot_line      = $1;
              $metric_values = $2;
              $src_line      = $3;
              $dec_instr_address = bigint::hex ($4);
              $instruction   = $5;
              if (defined ($6))
                {
                  my $white_space_regex = '\s*';
                  $operands = $6;
                  $operands =~ s/$white_space_regex//;
                }

if ($hot_line eq "##")
                {
                  my @metrics = split (" ", $metric_values);
                  push (@hot_program_counters, [@metrics]);
                }
            }
        }
    }
  for my $row (keys @hot_program_counters)
    {
      my $msg = "$filename row[" . $row . "] =";
      for my $col (keys @{$hot_program_counters[$row]})
        {
          $msg .= " $hot_program_counters[$row][$col]";
          $transposed_hot_pc[$col][$row] = $hot_program_counters[$row][$col];
        }
      gp_message ("debugXL", $subr_name, "hot PC = $msg");
    }
  for my $row (keys @transposed_hot_pc)
    {
      my $msg = "$filename row[" . $row . "] =";
      for my $col (keys @{$transposed_hot_pc[$row]})
        {
          $msg .= " $transposed_hot_pc[$row][$col]";
        }
      gp_message ("debugXL", $subr_name, "$filename transposed = $msg");
    }
#------------------------------------------------------------------------------
# Get the maximum metric values and if integer, convert to floating-point.
# Since it is easier, we transpose the array and access it over the columns.
#------------------------------------------------------------------------------
  for my $row (0 .. $#transposed_hot_pc)
    {
      my $max_val = 0;
      for my $col (0 .. $#{$transposed_hot_pc[$row]})
        {
          $max_val = max ($transposed_hot_pc[$row][$col], $max_val);
        }
      if ($max_val =~ /$integer_regex/)
        {
          $max_val = sprintf ("%f", $max_val);
        }
      gp_message ("debugXL", $subr_name, "$filename row = $row max_val = $max_val");
      push (@max_metric_values, $max_val);
    }

for my $metric (0 .. $#max_metric_values)
      {
        my $msg = "$filename maximum[$metric] = $max_metric_values[$metric]";
        gp_message ("debugM", $subr_name, $msg);
      }

#------------------------------------------------------------------------------
# TBD - Integrate this better.
#
# Scan the instructions to find the instruction address range.  This is used
# to determine if a branch is external to this function.
#------------------------------------------------------------------------------
  $dec_instruction_start = undef;
  $dec_instruction_end   = undef;
  for (my $line_no=$line_index-1; $line_no <= $#disassembly_file; $line_no++)
    {
      my $input_line = $disassembly_file[$line_no];
      if ( $input_line =~ /$dis_regex/ )
        {
#          if ( defined ($1) and defined ($2) and defined ($3) and
##               defined ($4) and defined ($5) and defined ($6) )
          if ( defined ($1) and defined ($2) and defined ($3) and
               defined ($4) and defined ($5) )
            {
              $hot_line      = $1;
              $metric_values = $2;
              $src_line      = $3;
              $dec_instr_address = bigint::hex ($4);
              $instruction   = $5;
##              $operands      = $6;
              if (defined ($6))
                {
                  my $white_space_regex = '\s*';
                  $operands = $6;
                  $operands =~ s/$white_space_regex//;
                }

if (defined ($dec_instruction_start))
                {
                  if ($dec_instr_address < $dec_instruction_start)
                    {
                      $dec_instruction_start = $dec_instr_address;
                    }
                }
              else
                {
                  $dec_instruction_start = $dec_instr_address;
                }
              if (defined ($dec_instruction_end))
                {
                  if ($dec_instr_address > $dec_instruction_end)
                    {
                      $dec_instruction_end = $dec_instr_address;
                    }
                }
              else
                {
                  $dec_instruction_end = $dec_instr_address;
                }
            }
        }
    }

if (defined ($dec_instruction_start) and defined ($dec_instruction_end))
    {
      $hex_instruction_start = sprintf ("%x", $dec_instruction_start);
      $hex_instruction_end = sprintf ("%x", $dec_instruction_end);

my $msg;
      $msg = "$filename $func dec_instruction_start = " .
             "$dec_instruction_start (0x$hex_instruction_start)";
      gp_message ("debugXL", $subr_name, $msg);
      $msg = "$filename $func dec_instruction_end   = " .
             "$dec_instruction_end (0x$hex_instruction_end)";
      gp_message ("debugXL", $subr_name, $msg);
    }

#------------------------------------------------------------------------------
# This is where all the results from above come together.
#------------------------------------------------------------------------------
  for (my $line_no=$line_index-1; $line_no <= $#disassembly_file; $line_no++)
    {
      my $input_line = $disassembly_file[$line_no];
      gp_message ("debugXL", $subr_name, "input_line[$line_no] = $input_line");
      if ( $input_line =~ /$dis_regex/ )
        {
          gp_message ("debugXL", $subr_name, "found a disassembly line: $input_line");

if ( defined ($1) and defined ($2) and defined ($3) and
               defined ($4) and defined ($5) )
            {
#                      $branch_target{$hex_branch_target} = 1;
#                      $extended_branch_target{$instruction_address} = $raw_hex_branch_target;
              $hot_line      = $1;
              $metric_values = $2;
              $src_line      = $3;
              $orig_hex_instr_address = $4;
              $instruction   = $5;
##              $operands      = $6;

my $msg = "disassembly line: $1 $2 $3 $4 $5";
              if (defined ($6))
                {
                  $msg .= " \$6 = $6";
                  my $white_space_regex = '\s*';
                  $operands = $6;
                  $operands =~ s/$white_space_regex//;
                }
              gp_message ("debugXL", $subr_name, $msg);

#------------------------------------------------------------------------------
# Pad the line with the metrics to ensure correct alignment.
#------------------------------------------------------------------------------
              my $the_length;
              my @split_metrics = split (" ", $metric_values);
              my $first_metric = $split_metrics[0];
##              if ($first_metric =~ /^\d+$/)
              if ($first_metric =~ /$first_integer_regex/)
                {
                  $the_length = length ($first_metric);
                }
              else
                {
                  my @fields = split (/$decimal_separator/, $first_metric);
                  $the_length = length ($fields[0]);
                }
              my $spaces = $max_length_first_metric - $the_length;
              my $pad = "";
              for my $p (1 .. $spaces)
                {
                  $pad .= "&nbsp;";
                }
              $metric_values = $pad . $metric_values;
              gp_message ("debugXL", $subr_name, "pad = $pad");
              gp_message ("debugXL", $subr_name, "metric_values = $metric_values");

#------------------------------------------------------------------------------
# Since the instruction address variable may change and because we need the
# original address without html controls, we use a new variable for the
# (potentially) modified address.
#------------------------------------------------------------------------------
              $hex_instr_address   = $orig_hex_instr_address;
              $add_new_line_before = $FALSE;
              $add_new_line_after  = $FALSE;

if ($src_line eq "?")

#------------------------------------------------------------------------------
# There is no source line number.  Do not add a link.
#------------------------------------------------------------------------------
                {
                  $modified_line = $hot_line . ' ' . $metric_values . ' [' . $src_line . '] ';
                  gp_message ("debugXL", $subr_name, "initialized modified_line = $modified_line");
                }
              else
                {
#------------------------------------------------------------------------------
# There is a source line number.  Mark it as link.
#------------------------------------------------------------------------------
                  $src_line_ref = "[<a href='#line_".$src_line."'>".$src_line."</a>]";
                  gp_message ("debugXL", $subr_name, "src_line_ref = $src_line_ref");
                  gp_message ("debugXL", $subr_name, "hex_instr_address = $hex_instr_address");

$modified_line = $hot_line . ' ' . $metric_values . ' ' . $src_line_ref . ' ';
                  gp_message ("debugXL", $subr_name, "initialized modified_line = $modified_line");
                }

#------------------------------------------------------------------------------
# Mark control flow instructions.  Several cases need to be distinguished.
#
# In all cases we give the instruction a specific color, mark it boldface
# and add a new-line after the instruction
#------------------------------------------------------------------------------
              if ( ($instruction =~ /$control_flow_1_regex/)   or
                   ($instruction =~ /$control_flow_2_regex/)   or
                   ($instruction =~ /$control_flow_3_regex/) )
                {
                  gp_message ("debugXL", $subr_name, "instruction = $instruction is a control flow instruction");

$add_new_line_after = $TRUE;

$boldface = $TRUE;
                  $instruction = color_string ($instruction, $boldface, $g_html_color_scheme{"control_flow"});
                }

if (exists ($extended_branch_target{$hex_instr_address}))
#------------------------------------------------------------------------------
# This is a branch instruction and we need to add the target address.
#
# In case the target address is outside of this load object, the link is
# colored differently.
#
# TBD: Add the name and if possible, a working link to this code.
#------------------------------------------------------------------------------
                {
                  $branch_address = $extended_branch_target{$hex_instr_address};

$dec_branch_address = bigint::hex ($branch_address);

if ( ($dec_branch_address >= $dec_instruction_start) and
                       ($dec_branch_address <= $dec_instruction_end) )
#------------------------------------------------------------------------------
# The instruction is within the range.
#------------------------------------------------------------------------------
                    {
                      $link = "[ <a href='#".$branch_address."'>".$branch_address."</a> ]";
                    }
                  else
                    {
#------------------------------------------------------------------------------
# The instruction is outside of the range.  Change the color of the link.
#------------------------------------------------------------------------------
                      gp_message ("debugXL", $subr_name, "address is outside of range");

$link = "[ <a href='#".$branch_address;
                      $link .= "' style='color:$g_html_color_scheme{'link_outside_range'}'>";
                      $link .= $branch_address."</a> ]";
                    }
                  gp_message ("debugXL", $subr_name, "address exists new link = $link");

$operands .= ' ' . $link;
                  gp_message ("debugXL", $subr_name, "update #1 modified_line = $modified_line");
                }
              if (exists ($branch_target_no_ref{$hex_instr_address}))
                {
                  gp_message ("debugXL", $subr_name, "NEWBR branch_target_no_ref{$hex_instr_address} = $branch_target_no_ref{$hex_instr_address}");
                }
##              if (exists ($inverse_branch_target{$hex_instr_address}) or
##                  exists ($branch_target_no_ref{$hex_instr_address}))
              if (exists ($inverse_branch_target{$hex_instr_address}))
#------------------------------------------------------------------------------
# This is a target address and we need to define the instruction address to be
# a label.
#------------------------------------------------------------------------------
                {
                  $add_new_line_before = $TRUE;

my $branch_target = $inverse_branch_target{$hex_instr_address};
                  my $target = "<a name='".$hex_instr_address."'><b>".$hex_instr_address."</b></a>:";
                  gp_message ("debugXL", $subr_name, "inverse exists - hex_instr_address = $hex_instr_address");
                  gp_message ("debugXL", $subr_name, "inverse exists - add a target target = $target");

$hex_instr_address = "<a name='".$hex_instr_address."'><b>".$hex_instr_address."</b></a>";
                  gp_message ("debugXL", $subr_name, "update #2 hex_instr_address = $hex_instr_address");
                  gp_message ("debugXL", $subr_name, "update #2 modified_line     = $modified_line");
                }

$modified_line .= $hex_instr_address . ': ' . $instruction . ' ' . $operands;

gp_message ("debugXL", $subr_name, "final modified_line = $modified_line");

#------------------------------------------------------------------------------
# This is a control flow instruction, but it is the last one and we do not
# want to add a newline.
#------------------------------------------------------------------------------
              gp_message ("debugXL", $subr_name, "decide where the <br> should go in the html");
              gp_message ("debugXL", $subr_name, "add_new_line_after  = $add_new_line_after");
              gp_message ("debugXL", $subr_name, "add_new_line_before = $add_new_line_before");

if ( $add_new_line_after and ($orig_hex_instr_address eq $hex_instruction_end) )
                {
                  $add_new_line_after = $FALSE;
                  gp_message ("debugXL", $subr_name, "$instruction is the last instruction - do not add a newline");
                }

if ($add_new_line_before)
                {

#------------------------------------------------------------------------------
# Get the previous line, if any, so that we can check what it is.
#------------------------------------------------------------------------------
                  my $prev_line = pop (@modified_html);
                  if ( defined ($prev_line) )
                    {
                      gp_message ("debugXL", $subr_name, "prev_line = $prev_line");

#------------------------------------------------------------------------------
# Restore the previously popped line.
#------------------------------------------------------------------------------
                      push (@modified_html, $prev_line);
                      if ($prev_line ne $html_new_line)
                        {
                          gp_message ("debugXL", $subr_name, "add_new_line_before = $add_new_line_before pushed $html_new_line");
#------------------------------------------------------------------------------
# There is no new-line yet, so add it.
#------------------------------------------------------------------------------
                          push (@modified_html, $html_new_line);
                        }
                      else
                        {
#------------------------------------------------------------------------------
# It was a new-line, so do nothing and continue.
#------------------------------------------------------------------------------
                          gp_message ("debugXL", $subr_name, "need to restore $html_new_line");
                        }
                    }
                }
#------------------------------------------------------------------------------
# Add the newly created line.
#------------------------------------------------------------------------------

if ($hot_line eq "##")
#------------------------------------------------------------------------------
# Highlight the most expensive line.
#------------------------------------------------------------------------------
                {
                  $modified_line = set_background_color_string (
                                 $modified_line,
                                 $g_html_color_scheme{"background_color_hot"});
                }
#------------------------------------------------------------------------------
# Sub-highlight the lines close enough to the hot line.
#------------------------------------------------------------------------------
              else
                {
                  my @current_metrics = split (" ", $metric_values);
                  for my $metric (0 .. $#current_metrics)
                    {
                      my $current_value;
                      my $max_value;
                      $current_value = $current_metrics[$metric];
#------------------------------------------------------------------------------
# As part of the padding process, non-breaking spaces may have been inserted
# in an earlier phase.  Temporarily remove these to make sure that the maximum
# metric values can be computed.
#------------------------------------------------------------------------------
                      $current_value =~ s/&nbsp;//g;
                      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) )
                            {
# TBD: abs needed?
                              gp_message ("debugXL", $subr_name, "metric = $metric current_value = $current_value max_value = $max_value");
                              my $relative_distance = 1.00 - abs ( ($max_value - $current_value)/$max_value );
                              gp_message ("debugXL", $subr_name, "relative_distance = $relative_distance");
                              if (($hp_value > 0) and ($relative_distance >= $hp_value/100.0))
                                {
                                  gp_message ("debugXL", $subr_name, "metric $metric is within the relative_distance");
                                  gp_message ("debugXL", $subr_name, "change bg modified_line = $modified_line");
                                  $modified_line = set_background_color_string (
                                                     $modified_line,
                                                     $g_html_color_scheme{"background_color_lukewarm"});
                                  last;
                                }
                            }
                        }
                    }
                }

##  my @max_metric_values = ();
              push (@modified_html, $modified_line);
              if ($add_new_line_after)
                {
                  gp_message ("debugXL", $subr_name, "add_new_line_after = $add_new_line_after pushed $html_new_line");
                  push (@modified_html, $html_new_line);
                }

}
          else
            {
              my $msg = "parsing line $input_line";
              gp_message ("assertion", $subr_name, $msg);
            }
        }
      elsif ( $input_line =~ /$src_regex/ )
        {
          if ( defined ($1) and defined ($2) )
            {
####### BUG?
              gp_message ("debugXL", $subr_name, "found a source code line: $input_line");
              gp_message ("debugXL", $subr_name, "\$1 = $1");
              gp_message ("debugXL", $subr_name, "\$2 = $2");
              gp_message ("debugXL", $subr_name, "\$3 = $3");
              my $blanks        = $1;
              my $src_line      = $2;
              my $src_code      = $3;

#------------------------------------------------------------------------------
# We need to replace the "<" symbol in the code by "&lt;".
#------------------------------------------------------------------------------
              $src_code =~ s/$g_less_than_regex/$g_html_less_than_regex/g;

my $target = "<a name='line_".$src_line."'>".$src_line.".</a>";
              gp_message ("debugXL", $subr_name, "src target = $target $src_code");

my $modified_line = $blanks . $target . $src_code;
              gp_message ("debugXL", $subr_name, "modified_line = $modified_line");
              push (@modified_html, $modified_line);
            }
          else
            {
              my $msg = "parsing line $input_line";
              gp_message ("assertion", $subr_name, $msg);
            }
        }
      elsif ( $input_line =~ /$function_regex/ )
        {
          my $html_name;
          if (defined ($1) and defined ($2))
            {
              $func_name_in_dis_file = $2;
              my $spaces = $1;
              my $boldface = $TRUE;
              gp_message ("debugXL", $subr_name, "function_name = $2");
              my $function_line       = "&lt;Function: " . $func_name_in_dis_file . ">";

##### HACK

if ($func_name_in_dis_file eq $target_function)
                {
                  my $color_function_name = color_string (
                                 $function_line,
                                 $boldface,
                                 $g_html_color_scheme{"target_function_name"});
                  my $label = "<a id=\"" . $g_function_tag_id{$target_function} . "\"></a>";
                  $html_name = $label . $spaces . "<i>" . $color_function_name . "</i>";
                }
              else
                {
                  my $color_function_name = color_string (
                             $function_line,
                             $boldface,
                             $g_html_color_scheme{"non_target_function_name"});
                  $html_name = "<i>" . $spaces . $color_function_name . "</i>";
                }
              push (@modified_html, $html_name);
            }
          else
            {
              my $msg = "parsing line $input_line";
              gp_message ("assertion", $subr_name, $msg);
            }
        }
    }

#------------------------------------------------------------------------------
# Add an extra line with diagnostics.
#
# TBD: The same is done in process_source but should be done only once.
#------------------------------------------------------------------------------
  if ($hp_value > 0)
    {
      my $rounded_percentage = sprintf ("%.1f", $hp_value);
      $threshold_line = "<i>The setting for the highlight percentage";
      $threshold_line .= " (--highlight-percentage) option:";
      $threshold_line .= " " . $rounded_percentage . " (%)</i>";
    }
  else
    {
      $threshold_line  = "<i>The highlight percentage feature has not been";
      $threshold_line .= " enabled</i>";
    }

$html_home = ${ generate_home_link ("left") };
  $html_end  = ${ terminate_html_document () };

push (@modified_html, "</pre>");
  push (@modified_html, $html_new_line);
  push (@modified_html, $threshold_line);
  push (@modified_html, $html_home);
  push (@modified_html, $html_new_line);
  push (@modified_html, $g_html_credits_line);
  push (@modified_html, $html_end);

for my $i (0 .. $#modified_html)
    {
      gp_message ("debugXL", $subr_name, "[$i] -> $modified_html[$i]");
    }

for my $i (0 .. $#modified_html)
    {
      print HTML_OUTPUT "$modified_html[$i]" . "\n";
    }

close (HTML_OUTPUT);
  close (INPUT_DISASSEMBLY);

gp_message ("debug", $subr_name, "output is in file $html_dis_out");
  gp_message ("debug", $subr_name ,"completed processing disassembly");

undef %branch_target;
  undef %extended_branch_target;
  undef %inverse_branch_target;

return (\@source_line, \@metric);

} #-- End of subroutine generate_dis_html

#------------------------------------------------------------------------------
# Generate all the function level information.
#------------------------------------------------------------------------------
sub generate_function_level_info
{
  my $subr_name = get_my_name ();

my ($exp_dir_list_ref, $call_metrics, $summary_metrics, $input_string,
      $sort_fields_ref) = @_;

my @exp_dir_list = @{ $exp_dir_list_ref };
  my @sort_fields  = @{ $sort_fields_ref };

my $expr_name;
  my $first_metric;
  my $gp_display_text_cmd;
  my $gp_functions_cmd;
  my $ignore_value;
  my $msg;
  my $script_pc_metrics;

my $outputdir      = append_forward_slash ($input_string);

my $script_file_PC = $outputdir."gp-script-PC";
  my $result_file    = $outputdir."gp-out-PC.err";
  my $gp_error_file  = $outputdir."gp-out-PC.err";
  my $func_limit     = $g_user_settings{func_limit}{current_value};

#------------------------------------------------------------------------------
# The number of entries in the Function Overview includes <Total>, but that is
# not a concern to the user and we add "1" to compensate for this.
#------------------------------------------------------------------------------
  $func_limit += 1;

gp_message ("debug", $subr_name, "increased the local value for func_limit = $func_limit");

$expr_name = join (" ", @exp_dir_list);

gp_message ("debug", $subr_name, "expr_name = $expr_name");

for my $i (0 .. $#sort_fields)
    {
       gp_message ("debug", $subr_name, "sort_fields[$i] = $sort_fields[$i]");
    }

# Ruud $count = 0;

gp_message ("debug", $subr_name, "calling $GP_DISPLAY_TEXT to get function information files");

open (SCRIPT_PC, ">", $script_file_PC)
    or die ("$subr_name - unable to open script file $script_file_PC for writing: '$!'");
  gp_message ("debug", $subr_name, "opened file $script_file_PC for writing");

#------------------------------------------------------------------------------
# Get the list of functions.
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# Get the first metric.
#------------------------------------------------------------------------------
  $summary_metrics   =~ /^([^:]+)/;
  $first_metric      = $1;
  $g_first_metric    = $1;
  $script_pc_metrics = "address:$summary_metrics";

gp_message ("debugXL", $subr_name, "$func_limit");
  gp_message ("debugXL", $subr_name, "$summary_metrics");
  gp_message ("debugXL", $subr_name, "$first_metric");
  gp_message ("debugXL", $subr_name, "$script_pc_metrics");

# Temporarily disabled   print SCRIPT_PC "# limit $func_limit\n";
# Temporarily disabled  print SCRIPT_PC "limit $func_limit\n";
  print SCRIPT_PC "# thread_select all\n";
  print SCRIPT_PC "thread_select all\n";

#------------------------------------------------------------------------------
# Empty header.
# TBD: Is still needed? Also, add the header command.
#------------------------------------------------------------------------------
  print SCRIPT_PC "# outfile $outputdir"."header\n";
  print SCRIPT_PC "outfile $outputdir"."header\n";

#------------------------------------------------------------------------------
# Else the output from the next line goes to last sort.func
#------------------------------------------------------------------------------
  print SCRIPT_PC "# outfile $outputdir"."gp-metrics-functions-PC\n";
  print SCRIPT_PC "outfile $outputdir"."gp-metrics-functions-PC\n";
  print SCRIPT_PC "# metrics $script_pc_metrics\n";
  print SCRIPT_PC "metrics $script_pc_metrics\n";
#------------------------------------------------------------------------------
# Not really sorted
#------------------------------------------------------------------------------
  print SCRIPT_PC "# outfile $outputdir"."functions.sort.func-PC\n";
  print SCRIPT_PC "outfile $outputdir"."functions.sort.func-PC\n";
  print SCRIPT_PC "# functions\n";
  print SCRIPT_PC "functions\n";

print SCRIPT_PC "# outfile $outputdir"."functions.sort.func-PC2\n";
  print SCRIPT_PC "outfile $outputdir"."functions.sort.func-PC2\n";
  print SCRIPT_PC "# metrics address:name:$summary_metrics\n";
  print SCRIPT_PC "metrics address:name:$summary_metrics\n";
  print SCRIPT_PC "# sort $first_metric\n";
  print SCRIPT_PC "sort $first_metric\n";
  print SCRIPT_PC "# functions\n";
  print SCRIPT_PC "functions\n";
#------------------------------------------------------------------------------
# Go through all the possible metrics and sort by each of them.
#------------------------------------------------------------------------------
  for my $field (@sort_fields)
    {
      gp_message ("debug", $subr_name, "sort_fields field = $field");
#------------------------------------------------------------------------------
# Else the output from the next line goes to last sort.func
#------------------------------------------------------------------------------
      print SCRIPT_PC "# outfile $outputdir"."gp-metrics-".$field."-PC\n";
      print SCRIPT_PC "outfile $outputdir"."gp-metrics-".$field."-PC\n";
      print SCRIPT_PC "# metrics $script_pc_metrics\n";
      print SCRIPT_PC "metrics $script_pc_metrics\n";
      print SCRIPT_PC "# outfile $outputdir".$field.".sort.func-PC\n";
      print SCRIPT_PC "outfile $outputdir".$field.".sort.func-PC\n";
      print SCRIPT_PC "# sort $field\n";
      print SCRIPT_PC "sort $field\n";
      print SCRIPT_PC "# functions\n";
      print SCRIPT_PC "functions\n";

print SCRIPT_PC "# metrics address:name:$summary_metrics\n";
      print SCRIPT_PC "metrics address:name:$summary_metrics\n";
      print SCRIPT_PC "# outfile $outputdir".$field.".sort.func-PC2\n";
      print SCRIPT_PC "outfile $outputdir".$field.".sort.func-PC2\n";
      print SCRIPT_PC "# sort $field\n";
      print SCRIPT_PC "sort $field\n";
      print SCRIPT_PC "# functions\n";
      print SCRIPT_PC "functions\n";
    }

#------------------------------------------------------------------------------
# Get caller-callee list
#------------------------------------------------------------------------------
  print SCRIPT_PC "# outfile " . $outputdir."caller-callee-PC2\n";
  print SCRIPT_PC "outfile " . $outputdir."caller-callee-PC2\n";
  print SCRIPT_PC "# metrics address:name:$summary_metrics\n";
  print SCRIPT_PC "metrics address:name:$summary_metrics\n";
  print SCRIPT_PC "# callers-callees\n";
  print SCRIPT_PC "callers-callees\n";
#------------------------------------------------------------------------------
# Else the output from the next line goes to last sort.func
#------------------------------------------------------------------------------
  print SCRIPT_PC "# outfile $outputdir"."gp-metrics-calls-PC\n";
  print SCRIPT_PC "outfile $outputdir"."gp-metrics-calls-PC\n";
  $script_pc_metrics = "address:$call_metrics";
  print SCRIPT_PC "# metrics $script_pc_metrics\n";
  print SCRIPT_PC "metrics $script_pc_metrics\n";

#------------------------------------------------------------------------------
# Not really sorted
#------------------------------------------------------------------------------
  print SCRIPT_PC "# outfile $outputdir"."calls.sort.func-PC\n";
  print SCRIPT_PC "outfile $outputdir"."calls.sort.func-PC\n";

if ($g_user_settings{"calltree"}{"current_value"} eq "on")
    {
      gp_message ("verbose", $subr_name, "Generate the file with the calltree information");
#------------------------------------------------------------------------------
# Get calltree list
#------------------------------------------------------------------------------
      print SCRIPT_PC "# outfile $outputdir"."calltree.sort.func-PC\n";
      print SCRIPT_PC "outfile $outputdir"."calltree.sort.func-PC\n";
      print SCRIPT_PC "# calltree\n";
      print SCRIPT_PC "calltree\n";
    }

#------------------------------------------------------------------------------
# Get the default set of metrics
#------------------------------------------------------------------------------
  my $full_metrics_ref;
  my $all_metrics;
  my $full_function_view = $outputdir . "functions.full";

$full_metrics_ref = get_all_the_metrics (\$expr_name, \$outputdir);

$all_metrics  = "address:name:";
  $all_metrics .= ${$full_metrics_ref};
  gp_message ("debug", $subr_name, "all_metrics = $all_metrics");
#------------------------------------------------------------------------------
# Get the name, address, and full overview of all metrics for all functions
#------------------------------------------------------------------------------
   print SCRIPT_PC "# limit 0\n";
   print SCRIPT_PC "limit 0\n";
   print SCRIPT_PC "# metrics $all_metrics\n";
   print SCRIPT_PC "metrics $all_metrics\n";
   print SCRIPT_PC "# thread_select all\n";
   print SCRIPT_PC "thread_select all\n";
   print SCRIPT_PC "# sort default\n";
   print SCRIPT_PC "sort default\n";
   print SCRIPT_PC "# outfile $full_function_view\n";
   print SCRIPT_PC "outfile $full_function_view\n";
   print SCRIPT_PC "# functions\n";
   print SCRIPT_PC "functions\n";

close (SCRIPT_PC);

$result_file    = $outputdir."gp-out-PC.err";
  $gp_error_file  = $outputdir.$g_gp_error_logfile;

$gp_functions_cmd  = "$GP_DISPLAY_TEXT -limit $func_limit ";
  $gp_functions_cmd .= "-viewmode machine -compare off ";
  $gp_functions_cmd .= "-script $script_file_PC $expr_name";

gp_message ("debug", $subr_name, "calling $GP_DISPLAY_TEXT to get function level information");

$gp_display_text_cmd = "$gp_functions_cmd 1> $result_file 2>> $gp_error_file";

gp_message ("debugXL", $subr_name,"cmd = $gp_display_text_cmd");

my ($error_code, $cmd_output) = execute_system_cmd ($gp_display_text_cmd);

#------------------------------------------------------------------------------
# Parse the full function view and store the data.
#------------------------------------------------------------------------------
  my @input_data = ();
  my $empty_line_regex = '^\s*$';

##  my $full_function_view = $outputdir . "functions.full";

open (ALL_FUNC_DATA, "<", $full_function_view)
    or die ("$subr_name - unable to open output file $full_function_view for reading '$!'");
  gp_message ("debug", $subr_name, "opened file $full_function_view for reading");

chomp (@input_data = <ALL_FUNC_DATA>);

my $start_scanning = $FALSE;
  for (my $line = 0; $line <= $#input_data; $line++)
    {
      my $input_line = $input_data[$line];

$input_line =~ s/ --  no functions found//;
      $input_data[$line] =~ s/ --  no functions found//;

$msg = "line = " . $line . " input_line = " . $input_line;
      gp_message ("debugXL", $subr_name, $msg);

#      if ($input_line =~ /^<Total>\s+.*/)
      if ($input_line =~ /\s*(\d+:0x[a-fA-F0-9]+)\s+(\S+)\s+(.*)/)
        {
          $start_scanning = $TRUE;
        }
      elsif ($input_line =~ /$empty_line_regex/)
        {
          $start_scanning = $FALSE;
        }

if ($start_scanning)
        {
          gp_message ("debugXL", $subr_name, "$line: $input_data[$line]");

push (@g_full_function_view_table, $input_data[$line]);

my $hex_address;
          my $full_hex_address = $1;
          my $routine = $2;
          my $all_metrics = $3;
          if ($full_hex_address =~ /(\d+):0x(\S+)/)
            {
              $hex_address = "0x" . $2;
            }
          $g_function_view_all{$routine}{"hex_address"} = $hex_address;
          $g_function_view_all{$routine}{"all_metrics"} = $all_metrics;
        }
    }

for my $i (keys %g_function_view_all)
    {
      gp_message ("debugXL", $subr_name, "key = $i $g_function_view_all{$i}{'hex_address'} $g_function_view_all{$i}{'all_metrics'}");
    }

for my $i (keys @g_full_function_view_table)
    {
      gp_message ("debugXL", $subr_name, "g_full_function_view_table[$i] = $i $g_full_function_view_table[$i]");
    }

return ($script_pc_metrics);

} #-- End of subroutine generate_function_level_info

#------------------------------------------------------------------------------
# Generate all the files needed for the function view.
#------------------------------------------------------------------------------
sub generate_function_view
{
  my $subr_name = get_my_name ();

my ($directory_name_ref, $summary_metrics_ref, $number_of_metrics_ref,
      $function_info_ref, $function_view_structure_ref, $function_address_info_ref,
      $sort_fields_ref, $exp_dir_list_ref, $addressobjtextm_ref) = @_;

my $directory_name          = ${ $directory_name_ref };
  my @function_info           = @{ $function_info_ref };
  my %function_view_structure = %{ $function_view_structure_ref };
  my $summary_metrics         = ${ $summary_metrics_ref };
  my $number_of_metrics       = ${ $number_of_metrics_ref };
  my %function_address_info   = %{ $function_address_info_ref };
  my @sort_fields             = @{ $sort_fields_ref };
  my @exp_dir_list            = @{ $exp_dir_list_ref };
  my %addressobjtextm         = %{ $addressobjtextm_ref };

my @abs_path_exp_dirs = ();
  my @experiment_directories;

my $target_function;
  my $html_line;
  my $ftag;
  my $routine_length;
  my %html_source_functions = ();

my $href_link;
  my $infile;
  my $input_experiments;
  my $keep_value;
  my $loadobj;
  my $address_field;
  my $address_offset;
  my $msg;
  my $exe;
  my $extra_field;
  my $new_target_function;
  my $file_title;
  my $html_output_file;
  my $html_function_view;
  my $overview_file;
  my $exp_name;
  my $exp_type;
  my $html_header;
  my $routine;
  my $length_header;
  my $length_metrics;
  my $full_index_line;
  my $acknowledgement;
  my @full_function_view_line = ();
  my $spaces;
  my $size_text;
  my $position_text;
  my $html_first_metric_file;
  my $html_new_line = "<br>";
  my $html_acknowledgement;
  my $html_end;
  my $html_home;
  my $page_title;
  my $html_title_header;

my $outputdir         = append_forward_slash ($directory_name);
  my $LANG              = $g_locale_settings{"LANG"};
  my $decimal_separator = $g_locale_settings{"decimal_separator"};

$input_experiments = join (", ", @exp_dir_list);

for my $i (0 .. $#exp_dir_list)
    {
      my $dir = get_basename ($exp_dir_list[$i]);
      push @abs_path_exp_dirs, $dir;
    }
  $input_experiments = join (", ", @abs_path_exp_dirs);

gp_message ("debug", $subr_name, "input_experiments = $input_experiments");

#------------------------------------------------------------------------------
# TBD: This should be done only once and much earlier.
#------------------------------------------------------------------------------
  @experiment_directories = split (",", $input_experiments);

#------------------------------------------------------------------------------
# Core loop that generates an HTML line for each function.
#------------------------------------------------------------------------------
  my $top_of_table = $FALSE;
  for my $i (0 .. $#function_info)
    {
      if (defined ($function_info[$i]{"alt_name"}))
        {
          $target_function = $function_info[$i]{"alt_name"};
        }
      else
        {
          my $msg = "function_info[$i]{\"alt_name\"} is not defined";
          gp_message ("assertion", $subr_name, $msg);
        }

$html_source_functions{$target_function} = $function_info[$i]{"html function block"};
    }

for my $i (sort keys %html_source_functions)
    {
      gp_message ("debugXL", $subr_name, "html_source_functions{$i} = $html_source_functions{$i}");
    }

$file_title = "Function view for experiments " . $input_experiments;

#------------------------------------------------------------------------------
# Example input file:

# Current metrics: address:name:e.totalcpu:e.cycles:e+insts:e+llm
# Current Sort Metric: Exclusive Total CPU Time ( e.totalcpu )
# Current Sort Metric: Exclusive Total CPU Time ( e.totalcpu )
# Functions sorted by metric: Exclusive Total CPU Time
#
# PC Addr.        Name              Excl.     Excl. CPU  Excl.         Excl.
#                                   Total     Cycles     Instructions  Last-Level
#                                   CPU sec.   sec.      Executed      Cache Misses
#  1:0x00000000   <Total>           3.502     4.005      15396819700   24024250
#  2:0x000021ae   mxv_core          3.342     3.865      14500538981   23824045
#  6:0x0003af50   erand48_r         0.080     0.084        768240570          0
#  2:0x00001f7b   init_data         0.040     0.028         64020043     200205
#  6:0x0003b160   __drand48_iterate 0.020     0.                   0          0
#  ...
#------------------------------------------------------------------------------

for my $metric (@sort_fields)
    {
      $overview_file = $outputdir . $metric . ".sort.func-PC2";

$exp_type = $metric;

if ($metric eq "functions")
        {
          $html_function_view .= $g_html_base_file_name{"function_view"} . ".html";
        }
      else
        {
          $html_function_view = $g_html_base_file_name{"function_view"} . "." . $metric . ".html";
        }
#------------------------------------------------------------------------------
# The default function view is based upon the first metric in the list.  We use
# this file in the index.html file.
#------------------------------------------------------------------------------
      if ($metric eq $g_first_metric)
        {
          $html_first_metric_file = $html_function_view;
          my $txt = "g_first_metric = $g_first_metric ";
          $txt   .= "html_first_metric_file = $html_first_metric_file";
          gp_message ("debugXL", $subr_name, $txt);
        }

$html_output_file = $outputdir . $html_function_view;

open (FUNCTION_VIEW, ">", $html_output_file)
        or die ("$subr_name - unable to open file $html_output_file for writing - '$!'");
      gp_message ("debug", $subr_name, "opened file $html_output_file for writing");

$html_home       = ${ generate_home_link ("right") };
      $html_header     = ${ create_html_header (\$file_title) };

$page_title    = "Function View";
      $size_text     = "h2";
      $position_text = "center";
      $html_title_header = ${ generate_a_header (\$page_title, \$size_text, \$position_text) };

print FUNCTION_VIEW $html_header;
      print FUNCTION_VIEW $html_home;
      print FUNCTION_VIEW $html_title_header;
      print FUNCTION_VIEW "$_" for @g_html_experiment_stats;
      print FUNCTION_VIEW $html_new_line . "\n";

my $function_view_structure_ref = process_function_overview (
                                          \$metric,
                                          \$exp_type,
                                          \$summary_metrics,
                                          \$number_of_metrics,
                                          \@function_info,
                                          \%function_view_structure,
                                          \$overview_file);

my %function_view_structure = %{ $function_view_structure_ref };

#------------------------------------------------------------------------------
# Core part: extract the true function name and find the html code for it.
#------------------------------------------------------------------------------
      gp_message ("debugXL", $subr_name, "the final table");

print FUNCTION_VIEW "<pre>\n";
      print FUNCTION_VIEW "$_\n" for @{ $function_view_structure{"header"} };

my $max_length_header  = $function_view_structure{"max header length"};
      my $max_length_metrics = $function_view_structure{"max metrics length"};

#------------------------------------------------------------------------------
# Add 4 more spaces for the distance to the function names.  Purely cosmetic.
#------------------------------------------------------------------------------
      my $pad    = max ($max_length_metrics, $max_length_header) + 4;
      my $spaces = "";
      for my $i (1 .. $pad)
        {
          $spaces .= "&nbsp;";
        }

#------------------------------------------------------------------------------
# Add extra space for the /blank/*/ marker!
#------------------------------------------------------------------------------
      $spaces .= "&nbsp;";
      my $func_header = $spaces . $function_view_structure{"table name"};
      gp_message ("debugXL", $subr_name, "func_header = " . $func_header);

print FUNCTION_VIEW $spaces . "<b>" .
                          $function_view_structure{"table name"} .
                          "</b>" . $html_new_line . "\n";

#------------------------------------------------------------------------------
# If the header is longer than the metrics, add spaces to padd the difference.
# Also add the same 4 spaces between the metric values and the function name.
#------------------------------------------------------------------------------
      $pad = 0;
      if ($max_length_header > $max_length_metrics)
        {
          $pad = $max_length_header - $max_length_metrics;
        }
      $pad += 4;
      $spaces = "";
      for my $i (1 .. $pad)
        {
          $spaces .= "&nbsp;";
        }

#------------------------------------------------------------------------------
# This is where it literally all comes together.  The metrics and function
# parts are combined.
#------------------------------------------------------------------------------
##      for my $i (keys @{ $function_view_structure{"function table"} })
      for my $i (0 .. $#{ $function_view_structure{"function table"} })
        {
          my $p1 = $function_view_structure{"metrics part"}[$i];
          my $p2 = $function_view_structure{"function table"}[$i];

$full_index_line = $p1 . $spaces . $p2;

push (@full_function_view_line, $full_index_line);
        }

print FUNCTION_VIEW "$_\n" for @full_function_view_line;

#------------------------------------------------------------------------------
# Clear the array before filling it up again.
#------------------------------------------------------------------------------
      @full_function_view_line = ();

#------------------------------------------------------------------------------
# Get the acknowledgement, return to main link, and final html statements.
#------------------------------------------------------------------------------
      $html_home            = ${ generate_home_link ("left") };
      $html_acknowledgement = ${ create_html_credits () };
      $html_end             = ${ terminate_html_document () };

print FUNCTION_VIEW "</pre>\n";
      print FUNCTION_VIEW $html_home;
      print FUNCTION_VIEW $html_new_line . "\n";
      print FUNCTION_VIEW $html_acknowledgement;
      print FUNCTION_VIEW $html_end;

close (FUNCTION_VIEW);
    }

return (\$html_first_metric_file);

} #-- End of subroutine generate_function_view

#------------------------------------------------------------------------------
# Generate an html line that links back to index.html.  The text can either
# be positioned to the left or to the right.
#------------------------------------------------------------------------------
sub generate_home_link
{
  my $subr_name = get_my_name ();

my ($which_side) = @_;

my $html_home_line;

if (($which_side ne "left") and ($which_side ne "right"))
    {
      my $msg = "which_side = $which_side not supported";
      gp_message ("assertion", $subr_name, $msg);
    }

$html_home_line .= "<div class=\"" . $which_side . "\">";
  $html_home_line .= "<br><a href='" . $g_html_base_file_name{"index"};
  $html_home_line .= ".html' style='background-color:";
  $html_home_line .= $g_html_color_scheme{"index"};
  $html_home_line .= "'><b>Return to main view</b></a>";
  $html_home_line .= "</div>";

return (\$html_home_line);

} #-- End of subroutine generate_home_link

#------------------------------------------------------------------------------
# Generate a block of html for this function block.
#------------------------------------------------------------------------------
sub generate_html_function_blocks
{
  my $subr_name = get_my_name ();

my (
  $index_start_ref,
  $index_end_ref,
  $hex_addresses_ref,
  $the_metrics_ref,
  $length_first_metric_ref,
  $special_marker_ref,
  $the_function_name_ref,
  $separator_ref,
  $number_of_metrics_ref,
  $data_function_block_ref,
  $function_info_ref,
  $function_view_structure_ref) = @_;

my $index_start = ${ $index_start_ref };
  my $index_end   = ${ $index_end_ref };
  my @hex_addresses = @{ $hex_addresses_ref };
  my @the_metrics     = @{ $the_metrics_ref };
  my @length_first_metric = @{ $length_first_metric_ref };
  my @special_marker = @{ $special_marker_ref };
  my @the_function_name = @{ $the_function_name_ref};

my $separator               = ${ $separator_ref };
  my $number_of_metrics       = ${ $number_of_metrics_ref };
  my $data_function_block     = ${ $data_function_block_ref };
  my @function_info           = @{ $function_info_ref };
  my %function_view_structure = %{ $function_view_structure_ref };

my $decimal_separator = $g_locale_settings{"decimal_separator"};

my @html_block_prologue = ();
  my @html_code_function_block = ();
  my @function_lines           = ();
  my @fields = ();
  my @address_field = ();
  my @metric_values = ();
  my @function_names = ();
  my @final_function_names = ();
  my @marker = ();
  my @split_number = ();
  my @function_tags = ();

my $all_metrics;
  my $current_function_name;
  my $no_of_fields;
  my $name_regex;
  my $full_hex_address;
  my $hex_address;
  my $target_function;
  my $marker_function;
  my $routine;
  my $routine_length;
  my $metrics_length;
  my $max_metrics_length = 0;
  my $modified_line;
  my $string_length;
  my $addr_offset;
  my $current_address;
  my $found_a_match;
  my $ref_index;
  my $alt_name;
  my $length_first_field;
  my $gap;
  my $ipad;
  my $html_line;
  my $target_tag;
  my $tag_for_header;
  my $href_file;
  my $found_alt_name;
  my $name_in_header;
  my $create_hyperlinks;

state $first_call = $TRUE;
  state $reference_length;

#------------------------------------------------------------------------------
# If the length of the first metric is less than the maximum over all first
# metrics, add spaces to the left to ensure correct alignment.
#------------------------------------------------------------------------------
  for my $k ($index_start .. $index_end)
    {
      my $pad = $g_max_length_first_metric - $length_first_metric[$k];
      if ($pad ge 1)
        {
          my $spaces = "";
          for my $s (1 .. $pad)
            {
              $spaces .= "&nbsp;";
            }
          $the_metrics[$k] = $spaces . $the_metrics[$k];

my $msg = "padding spaces = $spaces the_metrics[$k] = $the_metrics[$k]";
          gp_message ("debugXL", $subr_name, $msg);
        }

##      my $end_game = "end game3=> pad = $pad" . $hex_addresses[$k] . " " . $the_metrics[$k] . " " . $special_marker[$k] . $the_function_name[$k];
##      gp_message ("debugXL", $subr_name, $end_game);
    }

#------------------------------------------------------------------------------
# An example what @function_lines should look like after the split:
# <empty>
# 6:0x0003ad20   drand48           0.100     0.084        768240570          0
# 6:0x0003af50  *erand48_r         0.080     0.084        768240570          0
# 6:0x0003b160   __drand48_iterate 0.020     0.                   0          0
#------------------------------------------------------------------------------
  @function_lines = split ($separator, $data_function_block);

#------------------------------------------------------------------------------
# Parse the individual lines.  Replace multi-occurrence functions by their
# unique alternative name and mark the target function.
#
# The above split operation produces an empty first field because the line
# starts with the separator.  This is why skip the first field.
#------------------------------------------------------------------------------
  for my $i ($index_start .. $index_end)
    {
      my $input_line = $the_metrics[$i];

gp_message ("debugXL", $subr_name, "the_metrics[$i] = ". $the_metrics[$i]);

$the_metrics[$i] .= "ZZZ";
            }
        }

$hex_address     = $hex_addresses[$i];
      $marker_function = $special_marker[$i];
      $routine         = $the_function_name[$i];
#------------------------------------------------------------------------------
# Get the length of the metrics line before ZZZ is replaced by spaces.
#------------------------------------------------------------------------------
      $all_metrics     = $the_metrics[$i];
      $metrics_length  = length ($all_metrics);
      $all_metrics     =~ s/ZZZ/&nbsp;&nbsp;&nbsp;/g;

$max_metrics_length = max ($max_metrics_length, $metrics_length);

push (@marker, $marker_function);
      push (@address_field, $hex_address);
      push (@metric_values, $all_metrics);
      push (@function_names, $routine);

my $index_into_function_info_ref = get_index_function_info (
                                         \$routine,
                                         \$hex_addresses[$i],
                                         $function_info_ref);

my $index_into_function_info = ${ $index_into_function_info_ref };
      $target_tag = $function_info[$index_into_function_info]{"tag_id"};
      $alt_name = $function_info[$index_into_function_info]{"alt_name"};

#------------------------------------------------------------------------------
# Keep the name of the target function (the one marked with a *) for later use.
# This is the tag that identifies the block in the caller-callee output.  The
# tag is used in the link to the caller-callee in the function overview.
#------------------------------------------------------------------------------
      if ($marker_function eq "*")
        {
          $tag_for_header = $target_tag;
          $name_in_header = $alt_name;

#------------------------------------------------------------------------------
# We need to replace the "<" symbol in the code by "&lt;".
#------------------------------------------------------------------------------
          $name_in_header =~ s/$g_less_than_regex/$g_html_less_than_regex/g;

}
      push (@final_function_names, $alt_name);
      push (@function_tags, $target_tag);

gp_message ("debugXL", $subr_name, "index_into_function_info = $index_into_function_info");
      gp_message ("debugXL", $subr_name, "target_tag = $target_tag");
      gp_message ("debugXL", $subr_name, "alt_name   = $alt_name");

} #-- End of loop for my $i ($index_start .. $index_end)

my $tag_line = "<a id='" . $tag_for_header . "'></a>";
  $html_line  = "<br>\n";
  $html_line .= $tag_line . "Function name: ";
  $html_line .= "<span style='color:" . $g_html_color_scheme{"target_function_name"} . "'>";
  $html_line .= "<b>" . $name_in_header . "</b></span>\n";
  $html_line .= "<br>";

push (@html_block_prologue, $html_line);

gp_message ("debugXL", $subr_name, "the final function block for $name_in_header");

$href_file = $g_html_base_file_name{"caller_callee"} . ".html";

#------------------------------------------------------------------------------
# Process the function blocks and generate the HTML structure for them.
#------------------------------------------------------------------------------
  for my $i (0 .. $#final_function_names)
    {
      $current_function_name = $final_function_names[$i];
      gp_message ("debugXL", $subr_name, "current_function_name = $current_function_name");

#------------------------------------------------------------------------------
# Do not add hyperlinks for <Total>.
#------------------------------------------------------------------------------
      if ($current_function_name eq "<Total>")
        {
          $create_hyperlinks = $FALSE;
        }
      else
        {
          $create_hyperlinks = $TRUE;
        }

#------------------------------------------------------------------------------
# We need to replace the "<" symbol in the code by "&lt;".
#------------------------------------------------------------------------------
      $current_function_name =~ s/$g_less_than_regex/$g_html_less_than_regex/g;

$html_line = $metric_values[$i] . " ";

if ($marker[$i] eq "*")
        {
          $current_function_name = "<b>" . $current_function_name . "</b>";
        }
      $html_line .= " <a href='" . $href_file . "#" . $function_tags[$i] . "'>" . $current_function_name . "</a>";

if ($marker[$i] eq "*")
        {
            $html_line = "<br>" . $html_line;
        }
      elsif (($marker[$i] ne "*") and ($i == 0))
        {
            $html_line = "<br>" . $html_line;
        }

gp_message ("debugXL", $subr_name, "html_line = $html_line");

#------------------------------------------------------------------------------
# Find the index into "function_info" for this particular function.
#------------------------------------------------------------------------------
      $routine         = $function_names[$i];
      $current_address = $address_field[$i];

my $target_index_ref = find_index_in_function_info (\$routine, \$current_address, \@function_info);
      my $target_index     = ${ $target_index_ref };

gp_message ("debugXL", $subr_name, "routine = $routine current_address = $current_address target_index = $target_index");

#------------------------------------------------------------------------------
# TBD Do this once for each function and store the result.  This is a saving
# because functions may and typically will appear more than once.
#------------------------------------------------------------------------------
      my $spaces_left = $function_view_structure{"max function length"} - $function_info[$target_index]{"function length"};

#------------------------------------------------------------------------------
# Add the links to the line. Make sure there is at least one space.
#------------------------------------------------------------------------------
      my $spaces = "&nbsp;";
      for my $k (1 .. $spaces_left)
        {
          $spaces .= "&nbsp;";
        }

if ($create_hyperlinks)
        {
          $html_line .= $spaces;
          $html_line .= $function_info[$target_index]{"href_source"};
          $html_line .= "&nbsp;";
          $html_line .= $function_info[$target_index]{"href_disassembly"};
        }

push (@html_code_function_block, $html_line);
    }

for my $lines (0 .. $#html_code_function_block)
      {
        gp_message ("debugXL", $subr_name, "final html block = " . $html_code_function_block[$lines]);
      }

return (\@html_block_prologue, \@html_code_function_block);

} #-- End of subroutine generate_html_function_blocks

#------------------------------------------------------------------------------
# Get all the metrics available
#
# (gp-display-text) metric_list
# Current metrics: e.totalcpu:i.totalcpu:e.cycles:e+insts:e+llm:name
# Current Sort Metric: Exclusive Total CPU Time ( e.totalcpu )
# Available metrics:
#          Exclusive Total CPU Time: e.%totalcpu
#          Inclusive Total CPU Time: i.%totalcpu
#              Exclusive CPU Cycles: e.+%cycles
#              Inclusive CPU Cycles: i.+%cycles
#   Exclusive Instructions Executed: e+%insts
#   Inclusive Instructions Executed: i+%insts
# Exclusive Last-Level Cache Misses: e+%llm
# Inclusive Last-Level Cache Misses: i+%llm
#  Exclusive Instructions Per Cycle: e+IPC
#  Inclusive Instructions Per Cycle: i+IPC
#  Exclusive Cycles Per Instruction: e+CPI
#  Inclusive Cycles Per Instruction: i+CPI
#                              Size: size
#                        PC Address: address
#                              Name: name
#------------------------------------------------------------------------------
sub get_all_the_metrics
{
  my $subr_name = get_my_name ();

my ($experiments_ref, $outputdir_ref) = @_;

my $experiments = ${ $experiments_ref };
  my $outputdir   = ${ $outputdir_ref };

my $ignore_value;
  my $gp_functions_cmd;
  my $gp_display_text_cmd;

my $metrics_output_file = $outputdir . "metrics-all";
  my $result_file   = $outputdir . $g_gp_output_file;
  my $gp_error_file = $outputdir . $g_gp_error_logfile;
  my $script_file_metrics = $outputdir . "script-metrics";

my @metrics_data = ();

open (SCRIPT_METRICS, ">", $script_file_metrics)
    or die ("$subr_name - unable to open script file $script_file_metrics for writing: '$!'");
  gp_message ("debug", $subr_name, "opened script file $script_file_metrics for writing");

print SCRIPT_METRICS "# outfile $metrics_output_file\n";
  print SCRIPT_METRICS "outfile $metrics_output_file\n";
  print SCRIPT_METRICS "# metric_list\n";
  print SCRIPT_METRICS "metric_list\n";

close (SCRIPT_METRICS);

$gp_functions_cmd  = "$GP_DISPLAY_TEXT -script $script_file_metrics $experiments";

gp_message ("debug", $subr_name, "calling $GP_DISPLAY_TEXT to get all the metrics");

$gp_display_text_cmd = "$gp_functions_cmd 1>> $result_file 2>> $gp_error_file";
  gp_message ("debug", $subr_name, "cmd = $gp_display_text_cmd");

my ($error_code, $cmd_output) = execute_system_cmd ($gp_display_text_cmd);

open (METRICS_INFO, "<", $metrics_output_file)
    or die ("$subr_name - unable to open file $metrics_output_file for reading '$!'");
  gp_message ("debug", $subr_name, "opened file $metrics_output_file for reading");

#------------------------------------------------------------------------------
# Read the input file into memory.
#------------------------------------------------------------------------------
  chomp (@metrics_data = <METRICS_INFO>);
  gp_message ("debug", $subr_name, "read all contents of file $metrics_output_file into memory");
  gp_message ("debug", $subr_name, "\$#metrics_data = $#metrics_data");

my $input_line;
  my $ignore_lines_regex = '^(?:Current|Available|\s+Size:|\s+PC Address:|\s+Name:)';
  my $split_line_regex = '(.*): (.*)';
  my $empty_line_regex = '^\s*$';
  my @metric_list_all = ();
  for (my $line_no=0; $line_no <= $#metrics_data; $line_no++)
    {

$input_line = $metrics_data[$line_no];

##      if ( not (($input_line =~ /$ignore_lines_regex/ or ($input_line =~ /^\s*$/))))
      if ( not ($input_line =~ /$ignore_lines_regex/) and not ($input_line =~ /$empty_line_regex/) )
        {
          if ($input_line =~ /$split_line_regex/)
            {
#------------------------------------------------------------------------------
# Remove the percentages.
#------------------------------------------------------------------------------
              my $metric_definition = $2;
              $metric_definition =~ s/\%//g;
              gp_message ("debug", $subr_name, "line_no = $line_no $metrics_data[$line_no] metric_definition = $metric_definition");
              push (@metric_list_all, $metric_definition);
            }
        }

}

gp_message ("debug", $subr_name, "\@metric_list_all = @metric_list_all");

my $final_list = join (":", @metric_list_all);
  gp_message ("debug", $subr_name, "final_list = $final_list");

close (METRICS_INFO);

return (\$final_list);

} #-- End of subroutine get_all_the_metrics

#------------------------------------------------------------------------------
# A simple function to return the basename using fileparse.  To keep things
# simple, a suffixlist is not supported.  In case this is needed, use the
# fileparse function directly.
#------------------------------------------------------------------------------
sub get_basename
{
  my ($full_name) = @_;

my $ignore_value_1;
  my $ignore_value_2;
  my $basename_value;

($basename_value, $ignore_value_1, $ignore_value_2) = fileparse ($full_name);

return ($basename_value);

} #-- End of subroutine get_basename

#------------------------------------------------------------------------------
# Get the details on the experiments and store these in a file.  Each
# experiment has its own file.  This makes the processing easier.
#------------------------------------------------------------------------------
sub get_experiment_info
{
  my $subr_name = get_my_name ();

my ($outputdir_ref, $exp_dir_list_ref) = @_;

my $outputdir    = ${ $outputdir_ref };
  my @exp_dir_list = @{ $exp_dir_list_ref };

my $cmd_output;
  my $current_slot;
  my $error_code;
  my $exp_info_file;
  my @exp_info       = ();
  my @experiment_data = ();
  my $gp_error_file;
  my $gp_display_text_cmd;
  my $gp_functions_cmd;
  my $gp_log_file;
  my $ignore_value;
  my $msg;
  my $overview_file;
  my $result_file;
  my $script_file;
  my $the_experiments;

$the_experiments = join (" ", @exp_dir_list);

$script_file   = $outputdir . "gp-info-exp.script";
  $exp_info_file = $outputdir . "gp-info-exp-list.out";
  $overview_file = $outputdir . "gp-overview.out";
  $gp_log_file   = $outputdir . $g_gp_output_file;
  $gp_error_file = $outputdir . $g_gp_error_logfile;

open (SCRIPT_EXPERIMENT_INFO, ">", $script_file)
    or die ("$subr_name - unable to open script file $script_file for writing: '$!'");
  gp_message ("debug", $subr_name, "opened script file $script_file for writing");

#------------------------------------------------------------------------------
# Attributed User CPU Time=a.user : for calltree - see P37 in manual
#------------------------------------------------------------------------------
  print SCRIPT_EXPERIMENT_INFO "# compare on\n";
  print SCRIPT_EXPERIMENT_INFO "compare on\n";
  print SCRIPT_EXPERIMENT_INFO "# outfile $exp_info_file\n";
  print SCRIPT_EXPERIMENT_INFO "outfile $exp_info_file\n";
  print SCRIPT_EXPERIMENT_INFO "# exp_list\n";
  print SCRIPT_EXPERIMENT_INFO "exp_list\n";
  print SCRIPT_EXPERIMENT_INFO "# outfile $overview_file\n";
  print SCRIPT_EXPERIMENT_INFO "outfile $overview_file\n";
  print SCRIPT_EXPERIMENT_INFO "# overview\n";
  print SCRIPT_EXPERIMENT_INFO "overview\n";

close SCRIPT_EXPERIMENT_INFO;

$gp_functions_cmd = "$GP_DISPLAY_TEXT -script $script_file $the_experiments";

gp_message ("debug", $subr_name, "executing $GP_DISPLAY_TEXT to get the experiment information");

$gp_display_text_cmd = "$gp_functions_cmd 1>> $gp_log_file 2>> $gp_error_file";

($error_code, $cmd_output) = execute_system_cmd ($gp_display_text_cmd);

#------------------------------------------------------------------------------
# The first file has the following format:
#
# ID Sel     PID Experiment
# == === ======= ======================================================
#  1 yes 2078714 <absolute_path/mxv.hwc.1.thr.er
#  2 yes 2078719 <absolute_path/mxv.hwc.2.thr.er
#------------------------------------------------------------------------------
  open (EXP_INFO, "<", $exp_info_file)
    or die ("$subr_name - unable to open file $exp_info_file for reading '$!'");
  gp_message ("debug", $subr_name, "opened script file $exp_info_file for reading");

chomp (@exp_info = <EXP_INFO>);

#------------------------------------------------------------------------------
# TBD - Check for the groups to exist below:
#------------------------------------------------------------------------------
  $current_slot = 0;
  for my $i (0 .. $#exp_info)
    {
      my $input_line = $exp_info[$i];

gp_message ("debug", $subr_name, "$i => exp_info[$i] = $exp_info[$i]");

if ($input_line =~ /^\s*(\d+)\s+(.+)/)
        {
          my $exp_id    = $1;
          my $remainder = $2;
          $experiment_data[$current_slot]{"exp_id"} = $exp_id;
          $experiment_data[$current_slot]{"exp_data_file"} = $outputdir . "gp-info-exp-" . $exp_id . ".out";
          gp_message ("debug", $subr_name, $i . " " . $exp_id . " " . $remainder);
          if ($remainder =~ /^(\w+)\s+(\d+)\s+(.+)/)
            {
              my $exp_name = $3;
              $experiment_data[$current_slot]{"exp_name_full"} = $exp_name;
              $experiment_data[$current_slot]{"exp_name_short"} = get_basename ($exp_name);
              $current_slot++;
              gp_message ("debug", $subr_name, $i . " " . $1 . " " . $2 . " " . $3);
            }
          else
            {
              $msg = "remainder = $remainder has an unexpected format";
              gp_message ("assertion", $subr_name, $msg);
            }
        }
    }
#------------------------------------------------------------------------------
# The experiment IDs and names are known.  We can now generate the info for
# each individual experiment.
#------------------------------------------------------------------------------
  $gp_log_file   = $outputdir . $g_gp_output_file;
  $gp_error_file = $outputdir . $g_gp_error_logfile;

$script_file = $outputdir . "gp-details-exp.script";

open (SCRIPT_EXPERIMENT_DETAILS, ">", $script_file)
    or die ("$subr_name - unable to open script file $script_file for writing: '$!'");
  gp_message ("debug", $subr_name, "opened script file $script_file for writing");

for my $i (sort keys @experiment_data)
    {
      my $exp_id = $experiment_data[$i]{"exp_id"};

$result_file = $experiment_data[$i]{"exp_data_file"};

# statistics
# header
      print SCRIPT_EXPERIMENT_DETAILS "# outfile "    . $result_file . "\n";
      print SCRIPT_EXPERIMENT_DETAILS "outfile "      . $result_file . "\n";
      print SCRIPT_EXPERIMENT_DETAILS "# header "     . $exp_id . "\n";
      print SCRIPT_EXPERIMENT_DETAILS "header "       . $exp_id . "\n";
      print SCRIPT_EXPERIMENT_DETAILS "# statistics " . $exp_id . "\n";
      print SCRIPT_EXPERIMENT_DETAILS "statistics "   . $exp_id . "\n";

}

close (SCRIPT_EXPERIMENT_DETAILS);

$gp_functions_cmd = "$GP_DISPLAY_TEXT -script $script_file $the_experiments";

$msg = "executing $GP_DISPLAY_TEXT to get the experiment details";
  gp_message ("debug", $subr_name, $msg);

$gp_display_text_cmd = "$gp_functions_cmd 1>> $gp_log_file 2>> $gp_error_file";

($error_code, $cmd_output) = execute_system_cmd ($gp_display_text_cmd);

return (\@experiment_data);

} #-- End of subroutine get_experiment_info

#------------------------------------------------------------------------------
# This subroutine returns a string of the type "size=<n>", where <n> is the
# size of the file passed in.  If n > 1024, a unit is appended.
#------------------------------------------------------------------------------
sub getfilesize
{
  my $subr_name = get_my_name ();

my ($filename) = @_;

my $size;
  my $file_stat;

if (not -e $filename)
    {
#------------------------------------------------------------------------------
# The return value is used in the caller.  This is why we return the empty
# string in case the file does not exist.
#------------------------------------------------------------------------------
      gp_message ("debug", $subr_name, "filename = $filename not found");
      return ("");
    }
  else
    {
      $file_stat = stat ($filename);
      $size      = $file_stat->size;

gp_message ("debug", $subr_name, "filename = $filename");
      gp_message ("debug", $subr_name, "size     = $size");

if ($size > 1024)
        {
          if ($size > 1024*1024)
            {
              $size = $size/1024/1024;
              $size =~ s/\..*//;
              $size = $size."MB";
            }
          else
            {
              $size = $size/1024;
              $size =~ s/\..*//;
              $size = $size."KB";
            }
        }
      else
        {
          $size=$size." bytes";
        }
      gp_message ("debug", $subr_name, "size = $size title=\"$size\"");

return ("title=\"$size\"");
    }

} #-- End of subroutine getfilesize

#------------------------------------------------------------------------------
# Parse the fsummary output and for all functions, store all the information
# found in "function_info".  In addition to this, several derived structures
# are stored as well, making this structure a "onestop" place to get all the
# info that is needed.
#------------------------------------------------------------------------------
sub get_function_info
{
  my $subr_name = get_my_name ();

my ($FSUMMARY_FILE) = @_;

my @function_info              = ();
  my %function_address_and_index = ();
  my %LINUX_vDSO                 = ();
  my %function_view_structure    = ();
  my %addressobjtextm            = ();
#------------------------------------------------------------------------------
# TBD: This structure is no longer used and most likely can be removed.
#------------------------------------------------------------------------------
  my %functions_index             = ();

my $msg;

# TBD: check
  my $full_address_field;
  my %source_files   = ();

my $i;
  my $line;
  my $routine_flag;
  my $value;
  my $field;
  my $df_flag;
  my $address_decimal;
  my $routine;

my $num_source_files           = 0;
  my $number_of_unique_functions = 0;
  my $number_of_non_unique_functions = 0;

my $function_info_regex   = '\s*(\S+[a-zA-Z\s]*):(.*)';
  my $get_hex_address_regex = '(\d+):(0x\S+)';
#------------------------------------------------------------------------------
# Open the file generated using the -fsummary option.
#------------------------------------------------------------------------------
  $msg = " - unable to open file $FSUMMARY_FILE for reading:";
  open (FSUMMARY_FILE, "<", $FSUMMARY_FILE)
    or die ($subr_name . $msg . " " . $!);
  $msg = "opened file $FSUMMARY_FILE for reading";
  gp_message ("debug", $subr_name, $msg);

#------------------------------------------------------------------------------
# This is the typical structure of the fsummary output:
#
# Current Sort Metric: Exclusive Total CPU Time ( e.totalcpu )
# Functions sorted by metric: Exclusive Total CPU Time
#
# <Total>
#         Exclusive Total CPU Time: 11.538 (100.0%)
#         Inclusive Total CPU Time: 11.538 (100.0%)
#                             Size:      0
#                       PC Address: 1:0x00000000
#                      Source File: (unknown)
#                      Object File: (unknown)
#                      Load Object: <Total>
#                     Mangled Name:
#                          Aliases:
#
# a_function_name
#         Exclusive Total CPU Time:  4.003 ( 34.7%)
#         Inclusive Total CPU Time:  4.003 ( 34.7%)
#                             Size:    715
#                       PC Address: 2:0x00006c61
#                      Source File: <absolute path to source file>
#                      Object File: <object filename>
#                      Load Object: <executable name>
#                     Mangled Name:
#                          Aliases:
#
# The previous block is repeated for every function.
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# Skip the header.  The header is defined to end with a blank line.
#------------------------------------------------------------------------------
  while (<FSUMMARY_FILE>)
    {
      $line = $_;
      chomp ($line);
      if ($line =~ /^\s*$/)
        {
          last;
        }
    }

#------------------------------------------------------------------------------
# Process the remaining blocks.  Note that the first line should be <Total>,
# but this is currently not checked.
#------------------------------------------------------------------------------
  $i = 0;
  $routine_flag = $TRUE;
  while (<FSUMMARY_FILE>)
    {
      $line = $_;
      chomp ($line);

#------------------------------------------------------------------------------
# Legacy issue to deal with. Up until somewhere between binutils 2.40 and 2.41,
# gprofng display text might print the " --  no functions found" comment.
# No, the two spaces after -- are not my typo ;-)
#
# Since then, this comment is no longer printed, but the safe approach is to
# remove any occurrence upfront.
#------------------------------------------------------------------------------
      $line =~ s/ --  no functions found//;

$msg = "line = " . $line;
      gp_message ("debugXL", $subr_name, $msg);

if ($line =~ /^\s*$/)
#------------------------------------------------------------------------------
# Blank line.
#------------------------------------------------------------------------------
        {
          $routine_flag = $TRUE;
          $df_flag = 0;

#------------------------------------------------------------------------------
# Linux vDSO exception
#
# TBD: Check if still relevant.
#------------------------------------------------------------------------------
          if ($function_info[$i]{"Load Object"} eq "DYNAMIC_FUNCTIONS")
            {
              $LINUX_vDSO{substr ($function_info[$i]{"addressobjtext"},1)} = $function_info[$i]{"routine"};
            }
          $i++;
          next;
        }

if ($routine_flag)
#------------------------------------------------------------------------------
# Should be the first line after the blank line.
#------------------------------------------------------------------------------
        {
          $routine                      = $line;
          push (@{ $g_map_function_to_index{$routine} }, $i);
          gp_message ("debugXL", $subr_name, "pushed i = $i to g_map_function_to_index{$routine}");

#------------------------------------------------------------------------------
# In a later parsing phase we need to know how many fields there are in a
# function name. For example, "<static>@0x21850 (<libc-2.28.so>)" is name that
# may show up in a function list.
#
# Here we determine the number of fields and store it.
#
# REVISIT This may not be needed anymore
#------------------------------------------------------------------------------
          my @fields_in_name = split (" ", $routine);
          $function_info[$i]{"fields in routine name"} = scalar (@fields_in_name);

#------------------------------------------------------------------------------
# This name may change if the function has multiple occurrences, but in any
# case, at the end of this routine this component has the final name to be
# used.
#------------------------------------------------------------------------------
          $function_info[$i]{"alt_name"} = $routine;
          if (not exists ($g_function_occurrences{$routine}))
            {
              gp_message ("debugXL", $subr_name, "the entry in function_info for $routine does not exist");
              $function_info[$i]{"routine"} = $routine;
              $g_function_occurrences{$routine} = 1;

gp_message ("debugXL", $subr_name, "g_function_occurrences{$routine} = $g_function_occurrences{$routine}");
            }
          else
            {
              gp_message ("debugXL", $subr_name, "the entry in function_info for $routine exists already");
              $function_info[$i]{"routine"} = $routine;
              $g_function_occurrences{$routine} += 1;
              if (not exists ($g_multi_count_function{$routine}))
                {
                  $g_multi_count_function{$routine} = $TRUE;
                }
              $msg  = "g_function_occurrences{$routine} = ";
              $msg .= $g_function_occurrences{$routine};
              gp_message ("debugXL", $subr_name, $msg);
            }
#------------------------------------------------------------------------------
# New: used when generating the index.
#------------------------------------------------------------------------------
          $function_info[$i]{"function length"} = length ($routine);
          $function_info[$i]{"tag_id"} = create_function_tag ($i);
          if (not exists ($g_function_tag_id{$routine}))
            {
              $g_function_tag_id{$routine} = create_function_tag ($i);
            }
          else
            {

#------------------------------------------------------------------------------
## TBD HACK!!! CHECK!!!!!
#------------------------------------------------------------------------------
              $g_function_tag_id{$routine} = $i;
            }

$routine_flag = $FALSE;
          gp_message ("debugXL", $subr_name, "stored " . $function_info[$i]{"routine"});

#------------------------------------------------------------------------------
# The $functions_index hash contains an array.  After an initial assignment,
# other values that have been found are pushed onto the arrays.
#------------------------------------------------------------------------------
          if (not exists ($functions_index{$routine}))
            {
              $functions_index{$routine} = [$i];
            }
          else
            {
#------------------------------------------------------------------------------
# Add the array index to the list
#------------------------------------------------------------------------------
              push (@{$functions_index{$routine}}, $i);
            }
          next;
        }

#------------------------------------------------------------------------------
# Example format of an input block, where $line is one of the following:
#         Exclusive Total CPU Time: 0.001 (  0.0%)
#         Inclusive Total CPU Time: 0.001 (  0.0%)
#                             Size:    92
#                       PC Address: 5:0x00125de0
#                      Source File: (unknown)
#                      Object File: (unknown)
#                      Load Object: /usr/lib64/libc-2.28.so
#                     Mangled Name:
#                          Aliases: __brk
#------------------------------------------------------------------------------
      $line =~ s/^\s+//;
      if ($line =~ /$function_info_regex/)
        {
          if (defined ($1) and defined($2))
            {
              $field = $1;
              $value = $2;
              $value =~ s/$g_rm_surrounding_spaces_regex//g;

$msg = "initial - field = " . $field . " value = " . $value;
              gp_message ("debugM", $subr_name, $msg);
            }
          else
            {
              $msg = "the input line pattern was not recognized";
              gp_message ("warning", $subr_name, $msg);
              gp_message ("debug", $subr_name, $msg);
              $msg = "execution continues, but there may be a problem later";
              gp_message ("warning", $subr_name, $msg);
              gp_message ("debug", $subr_name, $msg);

$field = "not recognized";
              $value = "not recognized";
            }
#------------------------------------------------------------------------------
# The field has no value.
#------------------------------------------------------------------------------
          if (length ($value) eq 0)
##          if ($value =~ /^\s+$/)
##              if (length ($2) gt 0)
##              if ($2 == " ")
            {
              if ($field eq "Mangled Name")
                {
                  $value = $routine;

$msg =  "no mangled name found - use the routine name ";
                  $msg .= $routine . " as the mangled name";
                  gp_message ("debugM", $subr_name, $msg);
                }
              else
                {
                  $value = "no_value_given";

$msg  =  "no value was found for this field - set to ";
                  $msg .=  $value;
                  gp_message ("debugM", $subr_name, $msg);
                }
            }
#------------------------------------------------------------------------------
# Remove any leading whitespace characters.
#------------------------------------------------------------------------------
          $value =~ s/$white_space_regex//;
#------------------------------------------------------------------------------
# These are the final values that will be used.
#------------------------------------------------------------------------------
          $msg = "final - field = " . $field . " value = " . $value;
          gp_message ("debugM", $subr_name, $msg);

$function_info[$i]{$field} = $value;
        }
##      $value =~ s/$white_space_regex//;

## \s*(\S+[a-zA-Z\s]*):\ *(.*)

###      my @input_fields   = split (":", $line);
###      my $no_of_elements = scalar (@input_fields);

###      gp_message ("debugXL", $subr_name, "#input_fields   = $#input_fields");
###      gp_message ("debugXL", $subr_name, "no_of_elements  = $no_of_elements");
###      gp_message ("debugXL", $subr_name, "input_fields[0] = $input_fields[0]");

###      if ($no_of_elements == 1)
#------------------------------------------------------------------------------
# No value
#------------------------------------------------------------------------------
###         {
###           $whatever = $input_fields[0];
###           $value    = "";
###         }
###       elsif ($no_of_elements == 2)
###         {
### #------------------------------------------------------------------------------
### # Note that $value may consist of multiple fields (e.g. 1.651 ( 95.4%)).
### #------------------------------------------------------------------------------
###           $whatever = $input_fields[0];
###           $value    = $input_fields[1];
###         }
###       elsif ($no_of_elements == 3)
###         {
###           $whatever = $input_fields[0];
### 	  if ($whatever eq "PC Address")
### #------------------------------------------------------------------------------
### # Must be an address field.  Restore the second colon.
### #------------------------------------------------------------------------------
### 	    {
###               $value = $input_fields[1] . ":" . $input_fields[2];
### 	    }
### 	  elsif ($whatever eq "Mangled Name")
### #------------------------------------------------------------------------------
### # The mangled name includes a colon (:).  Just copy the entire string.
### #------------------------------------------------------------------------------
### 	    {
###               $value = $input_fields[2];
### 	    }
###         }
###       else
###         {
### 	  if ($whatever eq "Aliases")
### #------------------------------------------------------------------------------
### # The mangled name includes a colon (:).  Just copy the entire string.
### #------------------------------------------------------------------------------
### 	    {
###               $value = $input_fields[2];
### 	    }
### 	  else
### 	    {
###               $msg = "input line = " . $line;
###               gp_message ("debug", $subr_name, $msg);
###               for my $i (keys @input_fields)
###                 {
###                   $msg = "input_fields[$i] = " . $input_fields[$i];
###                   gp_message ("debug", $subr_name, $msg);
###                 }
###               $msg = "unexpected input: number of fields = " . $no_of_elements;
###               gp_message ("debug", $subr_name, $msg);
### ##              gp_message ("assertion", $subr_name, $msg);
### 	    }
###        }
##      $function_info[$i]{$field} = $value;

#------------------------------------------------------------------------------
# TBD: Seems to be not used anymore and can most likely be removed. Check this.
#------------------------------------------------------------------------------
      if ($field =~ /Source File/)
        {
          if (!exists ($source_files{$value}))
            {
              $source_files{$value} = $TRUE;
              $num_source_files++;
            }
        }

if ($field =~ /PC Address/)
        {
          my $segment;
          my $offset;
#------------------------------------------------------------------------------
# The format of the address is assumed to be the following 2:0x000070a8
# Note that the regex is pretty wide.  This is from the original code and
# could be made more specific:
#          if ($value =~ /\s*(\S+):(\S+)/)
#------------------------------------------------------------------------------
#          if ($value =~ /\s*(\S+):(\S+)/)
          if ($value =~ /\s*(\d+):0x([0-9a-zA-Z]+)/)
            {
              $segment = $1;
              $offset  = $2;
#------------------------------------------------------------------------------
# Convert to a base 10 number
#------------------------------------------------------------------------------
              $address_decimal = bigint::hex ($offset); # decimal
#------------------------------------------------------------------------------
# Construct the address field.  Note that we use the hex address here.
# For example @2:0x0003f280
#------------------------------------------------------------------------------
              $full_address_field = $segment.":0x".$offset;

$function_info[$i]{"addressobj"}     = $address_decimal;
              $function_info[$i]{"addressobjtext"} = $full_address_field;
              $addressobjtextm{$full_address_field} = $i; # $RI
            }
          if (not exists ($function_address_and_index{$routine}{$value}))
            {
              $function_address_and_index{$routine}{$value} = $i;

$msg  = "function_address_and_index{$routine}{$value} = ";
              $msg .= $function_address_and_index{$routine}{$value};
              gp_message ("debugXL", $subr_name, $msg);
            }
          else
            {
              $msg  = "function_info: $FSUMMARY_FILE: function $routine";
              $msg .= " already has a PC Address";
              gp_message ("debugXL", $subr_name, $msg);
            }

$g_total_function_count++;
        }
    }
  close (FSUMMARY_FILE);

#------------------------------------------------------------------------------
# For every function in the function overview, set up an html structure with
# the various hyperlinks.
#------------------------------------------------------------------------------
  gp_message ("debugXL", $subr_name, "augment function_info with alt_name");
  my $target_function;
  my $html_line;
  my $ftag;
  my $routine_length;
  my %html_source_functions = ();
  for my $i (keys @function_info)
    {
      $target_function = $function_info[$i]{"routine"};

gp_message ("debugXL", $subr_name, "i = $i target_function = $target_function");

my $href_link;
##      $href_link  = "<a href=\'file." . $i . ".src.new.html#";
      $href_link  = "<a href=\'file." . $i . ".";
      $href_link .= $g_html_base_file_name{"source"};
      $href_link .= ".html#";
      $href_link .= $function_info[$i]{"tag_id"};
      $href_link .= "\'>source</a>";
      $function_info[$i]{"href_source"} = $href_link;

$href_link  = "<a href=\'file." . $i . ".";
      $href_link .= $g_html_base_file_name{"disassembly"};
      $href_link .= ".html#";
      $href_link .= $function_info[$i]{"tag_id"};
      $href_link .= "\'>disassembly</a>";
      $function_info[$i]{"href_disassembly"} = $href_link;

$href_link  = "<a href=\'";
      $href_link .= $g_html_base_file_name{"caller_callee"};
      $href_link .= ".html#";
      $href_link .= $function_info[$i]{"tag_id"};
      $href_link .= "\'>caller-callee</a>";
      $function_info[$i]{"href_caller_callee"} = $href_link;

gp_message ("debug", $subr_name, "g_function_occurrences{$target_function} = $g_function_occurrences{$target_function}");

if ($g_function_occurrences{$target_function} > 1)
        {
#------------------------------------------------------------------------------
# In case a function occurs more than one time in the function overview, we
# add the load object and address offset info to make it unique.
#
# This forces us to update some entries in function_info too.
#------------------------------------------------------------------------------
          my $loadobj = $function_info[$i]{"Load Object"};
          my $address_field = $function_info[$i]{"addressobjtext"};
          my $address_offset;

#------------------------------------------------------------------------------
# The address field has the following format: @<n>:<address_offset>
# We only care about the address offset.
#------------------------------------------------------------------------------
          if ($address_field =~ /$get_hex_address_regex/)
            {
              $address_offset = $2;
            }
          else
            {
              my $msg = "failed to extract the address offset from $address_field - use the full field";
              gp_message ("warning", $subr_name, $msg);
              $address_offset = $address_field;
            }
          my $exe = get_basename ($loadobj);
          my $extra_field = " (<" . $exe . " $address_offset" .">)";
###          $target_function .= $extra_field;
          $function_info[$i]{"alt_name"} = $target_function . $extra_field;
          gp_message ("debugXL", $subr_name, "function_info[$i]{\"alt_name\"} = " . $function_info[$i]{"alt_name"});

#------------------------------------------------------------------------------
# Store the length of the function name and get the tag id.
#------------------------------------------------------------------------------
          $function_info[$i]{"function length"} = length ($target_function . $extra_field);
          $function_info[$i]{"tag_id"} = create_function_tag ($i);

gp_message ("debugXL", $subr_name, "updated function_info[$i]{'routine'} = $function_info[$i]{'routine'}");
          gp_message ("debugXL", $subr_name, "updated function_info[$i]{'alt_name'} = $function_info[$i]{'alt_name'}");
          gp_message ("debugXL", $subr_name, "updated function_info[$i]{'function length'} = $function_info[$i]{'function length'}");
          gp_message ("debugXL", $subr_name, "updated function_info[$i]{'tag_id'} = $function_info[$i]{'tag_id'}");
        }
    }
  gp_message ("debug", $subr_name, "augment function_info with alt_name completed");

#------------------------------------------------------------------------------
# Compute the maximum function name length.
#
# The maximum length is stored in %function_view_structure.
#------------------------------------------------------------------------------
  my $max_function_length = 0;
  for my $i (0 .. $#function_info)
    {
      $max_function_length = List::Util::max ($max_function_length, $function_info[$i]{"function length"});

gp_message ("debugXL", $subr_name, "function_info[$i]{\"alt_name\"} = " . $function_info[$i]{"alt_name"} . " length = " . $function_info[$i]{"function length"});
    }

#------------------------------------------------------------------------------
# Define the name of the table and take the length into account, since it may
# be longer than the function name(s).
#------------------------------------------------------------------------------
  $function_view_structure{"table name"} = "Function name";

$max_function_length = max ($max_function_length, length ($function_view_structure{"table name"}));

$function_view_structure{"max function length"} = $max_function_length;

#------------------------------------------------------------------------------
# Core loop that generates an HTML line for each function.  This line is
# stored in function_info.
#------------------------------------------------------------------------------
  my $top_of_table = $FALSE;
  for my $i (keys @function_info)
    {
      my $new_target_function;

if (defined ($function_info[$i]{"alt_name"}))
        {
          $target_function = $function_info[$i]{"alt_name"};
          gp_message ("debugXL", $subr_name, "retrieved function_info[$i]{'alt_name'} = $function_info[$i]{'alt_name'}");
        }
      else
        {
          my $msg = "function_info[$i]{\"alt_name\"} is not defined";
          gp_message ("assertion", $subr_name, $msg);
        }

my $function_length  = $function_info[$i]{"function length"};
      my $number_of_blanks = $function_view_structure{"max function length"} - $function_length;

my $spaces = "&nbsp;&nbsp;";
      for my $i (1 .. $number_of_blanks)
        {
          $spaces .= "&nbsp;";
        }
      if ($target_function eq "<Total>")
#------------------------------------------------------------------------------
# <Total> is a pseudo function and there is no source, or disassembly for it.
# We could add a link to the caller-callee part, but this is currently not
# done.
#------------------------------------------------------------------------------
        {
          $top_of_table = $TRUE;
          $html_line  = "&nbsp;<b>&lt;Total></b>";
        }
      else
        {
#------------------------------------------------------------------------------
# Add the * symbol as a marker in case the same function occurs multiple times.
# Otherwise insert a space.
#------------------------------------------------------------------------------
          my $base_function_name = $function_info[$i]{"routine"};
          if (exists ($g_function_occurrences{$base_function_name}))
            {
              if ($g_function_occurrences{$base_function_name} > 1)
                {
                  $new_target_function = "*" . $target_function;
                }
              else
                {
                  $new_target_function = "&nbsp;" . $target_function;
                }
            }
          else
            {
              my $msg = "g_function_occurrences{$base_function_name} does not exist";
              gp_message ("assertion", $subr_name, $msg);
            }

#------------------------------------------------------------------------------
# Create the block with the function name, in boldface, plus the links to the
# source, disassembly and caller-callee views.
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# We need to replace the "<" symbol in the code by "&lt;".
#------------------------------------------------------------------------------
          $new_target_function =~ s/$g_less_than_regex/$g_html_less_than_regex/g;

$html_line  = "<b>$new_target_function</b>" . $spaces;
          $html_line .= $function_info[$i]{"href_source"}      . "&nbsp;";
          $html_line .= $function_info[$i]{"href_disassembly"} . "&nbsp;";
          $html_line .= $function_info[$i]{"href_caller_callee"};
        }

$msg = "target_function = $target_function html_line = $html_line";
      gp_message ("debugM", $subr_name, $msg);
      $html_source_functions{$target_function} = $html_line;

#------------------------------------------------------------------------------
# TBD: In the future we want to re-use this block elsewhere.
#------------------------------------------------------------------------------
      $function_info[$i]{"html function block"} = $html_line;
    }

for my $i (keys %html_source_functions)
    {
      $msg = "html_source_functions{$i} = $html_source_functions{$i}";
      gp_message ("debugM", $subr_name, $msg);
    }
  for my $i (keys @function_info)
    {
      $msg  = "function_info[$i]{\"html function block\"} = ";
      $msg .= $function_info[$i]{"html function block"};
      gp_message ("debugM", $subr_name, $msg);
    }

#------------------------------------------------------------------------------
# Print the key data structure %function_info.  This is a nested hash.
#------------------------------------------------------------------------------
  for my $i (0 .. $#function_info)
    {
      for my $role (sort keys %{ $function_info[$i] })
        {
           $msg  = "on return: function_info[$i]{$role} = ";
           $msg .= $function_info[$i]{$role};
           gp_message ("debugM", $subr_name, $msg);
        }
    }
#------------------------------------------------------------------------------
# Print the data structure %function_address_and_index. This is a nested hash.
#------------------------------------------------------------------------------
  for my $F (keys %function_address_and_index)
    {
      for my $fields (sort keys %{ $function_address_and_index{$F} })
        {
           $msg  = "on return: function_address_and_index{$F}{$fields} = ";
           $msg .= $function_address_and_index{$F}{$fields};
           gp_message ("debugM", $subr_name, $msg);
        }
    }
#------------------------------------------------------------------------------
# Print the data structure %functions_index. This is a hash with an arrray.
#------------------------------------------------------------------------------
  for my $F (keys %functions_index)
    {
      gp_message ("debug", $subr_name, "on return: functions_index{$F} = @{ $functions_index{$F} }");
# alt code      for my $i (0 .. $#{ $functions_index{$F} } )
# alt code        {
# alt code           gp_message ("debug", $subr_name, "on return: \$functions_index{$F} = $functions_index{$F}[$i]");
# alt code        }
    }

#------------------------------------------------------------------------------
# Print the data structure %function_view_structure. This is a hash.
#------------------------------------------------------------------------------
  for my $F (keys %function_view_structure)
    {
      gp_message ("debug", $subr_name, "on return: function_view_structure{$F} = $function_view_structure{$F}");
    }

#------------------------------------------------------------------------------
# Print the data structure %g_function_occurrences and use this structure to
# gather statistics about the functions.
#
# TBD: add this info to the experiment data overview.
#------------------------------------------------------------------------------
  $number_of_unique_functions = 0;
  $number_of_non_unique_functions = 0;
  for my $F (keys %g_function_occurrences)
    {
      gp_message ("debug", $subr_name, "on return: g_function_occurrences{$F} = $g_function_occurrences{$F}");
      if ($g_function_occurrences{$F} == 1)
        {
          $number_of_unique_functions++;
        }
      else
        {
          $number_of_non_unique_functions++;
        }
    }

for my $i (keys %g_map_function_to_index)
    {
      my $n = scalar (@{ $g_map_function_to_index{$i} });
      gp_message ("debug", $subr_name, "on return: g_map_function_to_index [$n] : $i => @{ $g_map_function_to_index{$i} }");
    }

#------------------------------------------------------------------------------
# TBD: Include this info on the page with experiment data.  Include names
# with multiple occurrences.
#------------------------------------------------------------------------------
  $msg = "Number of source files                            : " .
         $num_source_files;
  gp_message ("debug", $subr_name, $msg);
  $msg = "Total number of functions                         : " .
         $g_total_function_count;
  gp_message ("debug", $subr_name, $msg);
  $msg = "Number of functions with a unique name            : " .
         $number_of_unique_functions;
  gp_message ("debug", $subr_name, $msg);
  $msg = "Number of functions with more than one occurrence : " .
         $number_of_non_unique_functions;
  gp_message ("debug", $subr_name, $msg);
  my $multi_occurrences = $g_total_function_count -
                          $number_of_unique_functions;
  $msg = "Total number of multiple occurences of the same function name : " .
         $multi_occurrences;
  gp_message ("debug", $subr_name, $msg);

return (\@function_info, \%function_address_and_index, \%addressobjtextm,
          \%LINUX_vDSO, \%function_view_structure);

} #-- End of subroutine get_function_info
#------------------------------------------------------------------------------
# TBD
#------------------------------------------------------------------------------
sub get_hdr_info
{
  my $subr_name = get_my_name ();

my ($outputdir, $file) = @_;

state $first_call = $TRUE;

my $ASORTFILE;
  my @HDR;
  my $HDR;
  my $metric;
  my $line;
  my $ignore_directory;
  my $ignore_suffix;
  my $number_of_header_lines;

#------------------------------------------------------------------------------
# Add a "/" to simplify the construction of path names in the remainder.
#------------------------------------------------------------------------------
  $outputdir = append_forward_slash ($outputdir);

# Could get more header info from
# <metric>[e.bit_fcount].sort.func file - etc.

gp_message ("debug", $subr_name, "input file->$file<-");
#-----------------------------------------------
  if ($file eq $outputdir."calls.sort.func")
    {
      $ASORTFILE=$outputdir."calls";
      $metric = "calls"
    }
  elsif ($file eq $outputdir."calltree.sort.func")
    {
      $ASORTFILE=$outputdir."calltree";
      $metric = "calltree"
    }
  elsif ($file eq $outputdir."functions.sort.func")
    {
      $ASORTFILE=$outputdir."functions.func";
      $metric = "functions";
    }
  else
    {
      $ASORTFILE = $file;
#      $metric = basename ($file,".sort.func");
      ($metric, $ignore_directory,  $ignore_suffix) = fileparse ($file, ".sort.func");
      gp_message ("debug", $subr_name, "ignore_directory = $ignore_directory ignore_suffix = $ignore_suffix");
    }

gp_message ("debug", $subr_name, "file = $file metric = $metric");

open (ASORTFILE,"<", $ASORTFILE)
    or die ("$subr_name - unable to open file $ASORTFILE for reading: '$!'");
  gp_message ("debug", $subr_name, "opened file $ASORTFILE for reading");

$number_of_header_lines = 0;
  while (<ASORTFILE>)
    {
      $line =$_;
      chomp ($line);

if ($line  =~ /^Current/)
        {
          next;
        }
      if ($line  =~ /^Functions/)
        {
          next;
        }
      if ($line  =~ /^Callers/)
        {
          next;
        }
      if ($line  =~ /^\s*$/)
        {
          next;
        }
      if (!($line  =~ /^\s*\d/))
        {
          $HDR[$number_of_header_lines] = $line;
          $number_of_header_lines++;
          next;
        }
      last;
     }
  close (ASORTFILE);
#------------------------------------------------------------------------------
# Ruud - Fixed a bug. The output should not be appended, but overwritten.
# open (HI,">>$OUTPUTDIR"."hdrinfo");
#------------------------------------------------------------------------------
  my $outfile = $outputdir."hdrinfo";

if ($first_call)
    {
      $first_call = $FALSE;
      open (HI ,">", $outfile)
        or die ("$subr_name - unable to open file $outfile for writing: '$!'");
      gp_message ("debug", $subr_name, "opened file $outfile for writing");
    }
  else
    {
      open (HI ,">>", $outfile)
        or die ("$subr_name - unable to open file $outfile in append mode: '$!'");
      gp_message ("debug", $subr_name, "opened file $outfile in append mode");
    }

print HI "\#$metric hdrlines=$number_of_header_lines\n";
  my $len = 0;
  for $HDR (@HDR)
    {
      print HI "$HDR\n";
      gp_message ("debugXL", $subr_name, "HDR = $HDR\n");
    }
  close (HI);
  if ($first_call)
    {
      gp_message ("debug", $subr_name, "wrote file $outfile");
    }
  else
    {
      gp_message ("debug", $subr_name, "updated file $outfile");
    }
#-----------------------------------------------

} #-- End of subroutine get_hdr_info

#------------------------------------------------------------------------------
# Get the home directory and the location(s) of the configuration file on the
# current system.
#------------------------------------------------------------------------------
sub get_home_dir_and_rc_path
{
  my $subr_name = get_my_name ();

my ($rc_file_name) = @_;

my @rc_file_paths;
  my $target_cmd;
  my $home_dir;
  my $error_code;

$target_cmd  = $g_mapped_cmds{"printenv"} . " HOME";

($error_code, $home_dir) = execute_system_cmd ($target_cmd);

if ($error_code != 0)
    {
      my $msg = "cannot find a setting for HOME - please set this";
      gp_message ("assertion", $subr_name, $msg);
    }
  else

#------------------------------------------------------------------------------
# The home directory is known and we can define the locations for the
# configuration file.
#------------------------------------------------------------------------------
    {
      @rc_file_paths = (".", "$home_dir");
    }

gp_message ("debug", $subr_name, "upon return: \@rc_file_paths = @rc_file_paths");

return ($home_dir, \@rc_file_paths);

} #-- End of subroutine get_home_dir_and_rc_path

#------------------------------------------------------------------------------
# This subroutine generates a list with the hot functions.
#------------------------------------------------------------------------------
sub get_hot_functions
{
  my $subr_name = get_my_name ();

my ($exp_dir_list_ref, $summary_metrics, $input_string) = @_;

my @exp_dir_list = @{ $exp_dir_list_ref };

my $cmd_output;
  my $error_code;
  my $expr_name;
  my $first_metric;
  my $gp_display_text_cmd;
  my $ignore_value;

my @sort_fields = ();

$expr_name = join (" ", @exp_dir_list);

gp_message ("debug", $subr_name, "expr_name = $expr_name");

my $outputdir = append_forward_slash ($input_string);

my $script_file   = $outputdir."gp-fsummary.script";
  my $outfile       = $outputdir."gp-fsummary.out";
  my $result_file   = $outputdir."gp-fsummary.stderr";
  my $gp_error_file = $outputdir.$g_gp_error_logfile;

@sort_fields = split (":", $summary_metrics);

#------------------------------------------------------------------------------
# This is extremely unlikely to happen, but if so, it is a fatal error.
#------------------------------------------------------------------------------
  my $number_of_elements = scalar (@sort_fields);

gp_message ("debug", $subr_name, "number of fields in summary_metrics = $number_of_elements");

if ($number_of_elements == 0)
    {
      my $msg = "there are $number_of_elements in the metrics list";
      gp_message ("assertion", $subr_name, $msg);
    }

#------------------------------------------------------------------------------
# Get the summary of the hot functions
#------------------------------------------------------------------------------
  open (SCRIPT, ">", $script_file)
    or die ("$subr_name - unable to open script file $script_file for writing: '$!'");
  gp_message ("debug", $subr_name, "opened script file $script_file for writing");

#------------------------------------------------------------------------------
# TBD: Check what this is about:
# Attributed User CPU Time=a.user : for calltree - see P37 in manual
#------------------------------------------------------------------------------
  print SCRIPT "# limit 0\n";
  print SCRIPT "limit 0\n";
  print SCRIPT "# metrics $summary_metrics\n";
  print SCRIPT "metrics $summary_metrics\n";
  print SCRIPT "# thread_select all\n";
  print SCRIPT "thread_select all\n";

#------------------------------------------------------------------------------
# Use first out of summary metrics as first (it doesn't matter which one)
# $first_metric = (split /:/,$summary_metrics)[0];
#------------------------------------------------------------------------------

$first_metric = $sort_fields[0];

print SCRIPT "# outfile $outfile\n";
  print SCRIPT "outfile $outfile\n";
  print SCRIPT "# sort $first_metric\n";
  print SCRIPT "sort $first_metric\n";
  print SCRIPT "# fsummary\n";
  print SCRIPT "fsummary\n";

close SCRIPT;

my $gp_functions_cmd = "$GP_DISPLAY_TEXT -viewmode machine -compare off -script $script_file $expr_name";

gp_message ("debug", $subr_name, "executing $GP_DISPLAY_TEXT to get the list of functions");

$gp_display_text_cmd = "$gp_functions_cmd 1> $result_file 2>> $gp_error_file";

($error_code, $cmd_output) = execute_system_cmd ($gp_display_text_cmd);

if ($error_code != 0)
    {
      $ignore_value = msg_display_text_failure ($gp_display_text_cmd,
                                                $error_code,
                                                $gp_error_file);
      gp_message ("abort", $subr_name, "execution terminated");
      my $msg = "error code = $error_code - failure executing command $gp_display_text_cmd";
      gp_message ("abort", $subr_name, $msg);
    }

return ($outfile,\@sort_fields);

} #-- End of subroutine get_hot_functions

#------------------------------------------------------------------------------
# For a given function name, return the index into "function_info".  This
# index gives access to all the meta data for the input function.
#------------------------------------------------------------------------------
sub get_index_function_info
{
  my $subr_name = get_my_name ();

my ($routine_ref, $hex_address_ref, $function_info_ref) = @_;

my $routine     = ${ $routine_ref };
  my $hex_address = ${ $hex_address_ref };
  my @function_info = @{ $function_info_ref };

my $alt_name = $routine;
  my $current_address = $hex_address;
  my $found_a_match;
  my $index_into_function_info;
  my $msg;
  my $target_tag;

#------------------------------------------------------------------------------
# Check if this function has multiple occurrences.
#------------------------------------------------------------------------------
  $msg = "check for multiple occurrences";
  gp_message ("debugM", $subr_name, $msg);
  $msg = "target routine name = " . $routine;
  gp_message ("debugM", $subr_name, $msg);

if (not exists ($g_multi_count_function{$routine}))
    {
#------------------------------------------------------------------------------
# There is only a single occurrence and it is straightforward to get the tag.
#--------------------------------------------------------------------------
##          push (@final_function_names, $routine);
## KANWEG      for my $key (sort keys %g_map_function_to_index)
## KANWEG        {
## KANWEG          $msg = "g_map_function_to_index{". $key . "} = " . $g_map_function_to_index{$key};
## KANWEG          gp_message ("debugXL", $subr_name, $msg);
## KANWEG        }
      if (exists ($g_map_function_to_index{$routine}))
        {
          $index_into_function_info = $g_map_function_to_index{$routine}[0];
        }
      else
        {
          my $msg = "no entry for $routine in g_map_function_to_index";
          gp_message ("assertion", $subr_name, $msg);
        }
    }
  else
    {
#------------------------------------------------------------------------------
# The function name has more than one occurrence and we need to find the one
# that matches with the address.
#------------------------------------------------------------------------------
      $found_a_match = $FALSE;
      gp_message ("debug", $subr_name, "$routine: occurrences = $g_function_occurrences{$routine}");
      for my $ref (keys @{ $g_map_function_to_index{$routine} })
        {
          my $ref_index   = $g_map_function_to_index{$routine}[$ref];
          my $addr_offset = $function_info[$ref_index]{"addressobjtext"};

gp_message ("debug", $subr_name, "$routine: retrieving duplicate entry at ref_index = $ref_index");
          gp_message ("debug", $subr_name, "$routine: addr_offset = $addr_offset");
 
#------------------------------------------------------------------------------
# TBD: Do this substitution when storing "addressobjtext" in function_info.
#------------------------------------------------------------------------------
          $addr_offset =~ s/^@\d+://;
          gp_message ("debug", $subr_name, "$routine: addr_offset = $addr_offset");
          if ($addr_offset eq $current_address)
            {
              $found_a_match = $TRUE;
              $index_into_function_info = $ref_index;
              last;
            }
        }

#------------------------------------------------------------------------------
# If there is no match, something has gone really wrong and we bail out.
#------------------------------------------------------------------------------
      if (not $found_a_match)
        {
          my $msg = "cannot find the mapping in function_info for function $routine";
          gp_message ("assertion", $subr_name, $msg);
        }
    }

return (\$index_into_function_info);

} #-- End of subroutine get_index_function_info

#------------------------------------------------------------------------------
# Get the setting for LANG, or assign a default if it is not set.
#------------------------------------------------------------------------------
sub get_LANG_setting
{
  my $subr_name = get_my_name ();

my $error_code;
  my $lang_setting;
  my $target_cmd;
  my $command_string;
  my $LANG;

$target_cmd = $g_mapped_cmds{"printenv"};
#------------------------------------------------------------------------------
# Use the printenv command to get the settings for LANG.
#------------------------------------------------------------------------------
  if ($target_cmd eq "road to nowhere")
    {
      $error_code = 1;
    }
  else
    {
      $command_string = $target_cmd . " LANG";
      ($error_code, $lang_setting) = execute_system_cmd ($command_string);
    }

if ($error_code == 0)
    {
      chomp ($lang_setting);
      $LANG = $lang_setting;
    }
  else
    {
      $LANG = $g_default_setting_lang;
      my $msg = "cannot find a setting for LANG - use a default setting";
      gp_message ("warning", $subr_name, $msg);
    }

return ($LANG);

} #-- End of subroutine get_LANG_setting

#------------------------------------------------------------------------------
# This subroutine gathers the basic information about the metrics.
#------------------------------------------------------------------------------
sub get_metrics_data
{
  my $subr_name = get_my_name ();

my ($exp_dir_list_ref, $outputdir, $outfile1, $outfile2, $error_file) = @_;

my @exp_dir_list = @{ $exp_dir_list_ref };

my $cmd_options;
  my $cmd_output;
  my $error_code;
  my $expr_name;
  my $metrics_cmd;
  my $metrics_output;
  my $target_cmd;

$expr_name = join (" ", @exp_dir_list);

gp_message ("debug", $subr_name, "expr_name = $expr_name");

#------------------------------------------------------------------------------
# Execute the $GP_DISPLAY_TEXT tool with the appropriate options.  The goal is
# to get all the output in files $outfile1 and $outfile2.  These are then
# parsed.
#------------------------------------------------------------------------------
  $cmd_options   = " -viewmode machine -compare off -thread_select all";
  $cmd_options  .= " -outfile $outfile2";
  $cmd_options  .= " -fsingle '<Total>' -metric_list $expr_name";

$metrics_cmd   = "$GP_DISPLAY_TEXT $cmd_options 1> $outfile1 2> $error_file";

gp_message ("debug", $subr_name, "command used to gather the information:");
  gp_message ("debug", $subr_name, $metrics_cmd);

($error_code, $metrics_output) = execute_system_cmd ($metrics_cmd);

#------------------------------------------------------------------------------
# Error handling.  Any error that occurred is fatal and execution
# should be aborted by the caller.
#------------------------------------------------------------------------------
  if ($error_code == 0)
    {
      gp_message ("debug", $subr_name, "metrics data in files $outfile1 and $outfile2");
    }
  else
    {
      $target_cmd  = $g_mapped_cmds{"cat"} . " $error_file";

($error_code, $cmd_output) = execute_system_cmd ($target_cmd);

chomp ($cmd_output);

gp_message ("error", $subr_name, "contents of file $error_file:");
      gp_message ("error", $subr_name, $cmd_output);
    }

return ($error_code);

} #-- End of subroutine get_metrics_data

#------------------------------------------------------------------------------
# Wrapper that returns the last part of the subroutine name.  The assumption is
# that the last part of the input name is of the form "aa::bb" or just "bb".
#------------------------------------------------------------------------------
sub get_my_name
{
  my $called_by = (caller (1))[3];
  my @parts     = split ("::", $called_by);
  return ($parts[$#parts]);

##  my ($the_full_name_ref) = @_;

##  my $the_full_name = ${ $the_full_name_ref };
##  my $last_part;

#------------------------------------------------------------------------------
# If the regex below fails, use the full name."
#------------------------------------------------------------------------------
##  $last_part = $the_full_name;

#------------------------------------------------------------------------------
# Capture the last part if there are multiple parts separated by "::".
#------------------------------------------------------------------------------
##  if ($the_full_name =~ /.*::(.+)$/)
##    {
##      if (defined ($1))
##        {
##          $last_part = $1;
##        }
##    }

##  return (\$last_part);

} #-- End of subroutine get_my_name

#------------------------------------------------------------------------------
# Determine the characteristics of the current system
#------------------------------------------------------------------------------
sub get_system_config_info
{
#------------------------------------------------------------------------------
# The output from the "uname" command is used for this. Although not all of
# these are currently used, we store all fields in separate variables.
#------------------------------------------------------------------------------
#
#------------------------------------------------------------------------------
# The options supported on uname from GNU coreutils 8.22:
#------------------------------------------------------------------------------
#   -a, --all                print all information, in the following order,
#                              except omit -p and -i if unknown:
#   -s, --kernel-name        print the kernel name
#   -n, --nodename           print the network node hostname
#   -r, --kernel-release     print the kernel release
#   -v, --kernel-version     print the kernel version
#   -m, --machine            print the machine hardware name
#   -p, --processor          print the processor type or "unknown"
#   -i, --hardware-platform  print the hardware platform or "unknown"
#   -o, --operating-system   print the operating system
#------------------------------------------------------------------------------
# Sample output:
# Linux ruudvan-vm-2-8-20200701 4.14.35-2025.400.8.el7uek.x86_64 #2 SMP Wed Aug 26 12:22:05 PDT 2020 x86_64 x86_64 x86_64 GNU/Linux
#------------------------------------------------------------------------------
  my $subr_name = get_my_name ();

my $error_code;
  my $hostname_current;
  my $ignore_output;
  my $msg;
  my $target_cmd;
#------------------------------------------------------------------------------
# Test once if the command succeeds.  This avoids we need to check every
# specific # command below.
#------------------------------------------------------------------------------
  $target_cmd    = $g_mapped_cmds{uname};
  ($error_code, $ignore_output) = execute_system_cmd ($target_cmd);

if ($error_code != 0)
#------------------------------------------------------------------------------
# This is unlikely to happen, but you never know.
#------------------------------------------------------------------------------
    {
      gp_message ("abort", $subr_name, "failure to execute the uname command");
    }
 
  my $kernel_name       = qx ($target_cmd -s); chomp ($kernel_name);
  my $nodename          = qx ($target_cmd -n); chomp ($nodename);
  my $kernel_release    = qx ($target_cmd -r); chomp ($kernel_release);
  my $kernel_version    = qx ($target_cmd -v); chomp ($kernel_version);
  my $machine           = qx ($target_cmd -m); chomp ($machine);
  my $processor         = qx ($target_cmd -p); chomp ($processor);
  my $hardware_platform = qx ($target_cmd -i); chomp ($hardware_platform);
  my $operating_system  = qx ($target_cmd -o); chomp ($operating_system);
 
  $local_system_config{"kernel_name"}       = $kernel_name;
  $local_system_config{"nodename"}          = $nodename;
  $local_system_config{"kernel_release"}    = $kernel_release;
  $local_system_config{"kernel_version"}    = $kernel_version;
  $local_system_config{"machine"}           = $machine;
  $local_system_config{"processor"}         = $processor;
  $local_system_config{"hardware_platform"} = $hardware_platform;
  $local_system_config{"operating_system"}  = $operating_system;
 
  gp_message ("debug", $subr_name, "the output from the $target_cmd command is split into the following variables:");
  gp_message ("debug", $subr_name, "kernel_name       = $kernel_name");
  gp_message ("debug", $subr_name, "nodename          = $nodename");
  gp_message ("debug", $subr_name, "kernel_release    = $kernel_release");
  gp_message ("debug", $subr_name, "kernel_version    = $kernel_version");
  gp_message ("debug", $subr_name, "machine           = $machine");
  gp_message ("debug", $subr_name, "processor         = $processor");
  gp_message ("debug", $subr_name, "hardware_platform = $hardware_platform");
  gp_message ("debug", $subr_name, "operating_system  = $operating_system");
 
#------------------------------------------------------------------------------
# Check if the system we are running on is supported.
#------------------------------------------------------------------------------
  my $is_supported = ${ check_support_for_processor (\$machine) };

if (not $is_supported)
    {
      $msg = "the $machine instruction set architecture is not supported";
      gp_message ("error", $subr_name, $msg);
      gp_message ("diag", $subr_name, "Error: " . $msg);

$msg = "temporarily ignored for development purposes";
      gp_message ("error", $subr_name, $msg);

$g_total_error_count++;
      exit (0);
    }
#------------------------------------------------------------------------------
# The current hostname is used to compare against the hostname(s) found in the
# experiment directories.
#------------------------------------------------------------------------------
  $target_cmd       = $g_mapped_cmds{hostname};
  $hostname_current = qx ($target_cmd); chomp ($hostname_current);
  $error_code       = ${^CHILD_ERROR_NATIVE};
 
  if ($error_code == 0)
    {
      $local_system_config{"hostname_current"} = $hostname_current;
    }
  else
#------------------------------------------------------------------------------
# This is unlikely to happen, but you never know.
#------------------------------------------------------------------------------
    {
      gp_message ("abort", $subr_name, "failure to execute the hostname command");
    }
  for my $key (sort keys %local_system_config)
    {
      gp_message ("debug", $subr_name, "local_system_config{$key} = $local_system_config{$key}");
    }

return (0);

} #-- End of subroutine get_system_config_info

#------------------------------------------------------------------------------
# This subroutine prints a message.  Several types of messages are supported.
# In case the type is "abort", or "error", execution is terminated.
#
# Note that "debug", "warning", and "error" mode, the name of the calling
# subroutine is truncated to 30 characters.  In case the name is longer,
# a warning message # is issued so you know this has happened.
#
# Note that we use lcfirst () and ucfirst () to enforce whether the first
# character is printed in lower or uppercase.  It is nothing else than a
# convenience, but creates more consistency across messages.
#------------------------------------------------------------------------------
sub gp_message
{
  my $subr_name = get_my_name ();

my ($action, $caller_name, $comment_line) = @_;

#------------------------------------------------------------------------------
# The debugXL identifier is special.  It is accepted, but otherwise ignored.
# This allows to (temporarily) disable debug print statements, but keep them
# around.
#------------------------------------------------------------------------------
  my %supported_identifiers = (
    "verbose"   => "[Verbose]",
    "debug"     => "[Debug]",
    "error"     => "[Error]",
    "warning"   => "[Warning]",
    "abort"     => "[Abort]",
    "assertion" => "[Assertion error]",
    "diag"      => "",
  );

my $debug_size;
  my $identifier;
  my $fixed_size_name;
  my $ignore_value;
  my $string_limit = 30;
  my $strlen = length ($caller_name);
  my $trigger_debug = $FALSE;
  my $truncated_name;
  my $msg;

if ($action =~ /debug\s*(.+)/)
    {
      if (defined ($1))
        {
          my $orig_value = $1;
          $debug_size = lc ($1);

if ($debug_size =~ /^s$|^m$|^l$|^xl$/)
            {
              if ($g_debug_size{$debug_size})
                {
#------------------------------------------------------------------------------
# All we need to know is whether a debug action is requested and whether the
# size has been enabled.  By setting $action to "debug", the code below is
# simplified.  Note that only using $trigger_debug below is actually sufficient.
#------------------------------------------------------------------------------
                  $trigger_debug = $TRUE;
                }
            }
          else
            {
              die "$subr_name: debug size $orig_value is not supported";
            }
          $action = "debug";
        }
    }
  elsif ($action eq "debug")
    {
      $trigger_debug = $TRUE;
    }

#------------------------------------------------------------------------------
# Catch any non-supported identifier.
#------------------------------------------------------------------------------
  if (defined ($supported_identifiers{$action}))
    {
      $identifier = $supported_identifiers{$action};
    }
  else
    {
      die ("$subr_name - input error: $action is not supported");
    }
  if (($action eq "debug") and (not $g_debug))
    {
      $trigger_debug = $FALSE;
    }

#------------------------------------------------------------------------------
# Unconditionally buffer all warning messages.  These are available through the
# index.html page and cannot be disabled.
#
# If the quiet mode has been enabled, warnings are not printed though.
#------------------------------------------------------------------------------
  if ($action eq "warning")
    {
#------------------------------------------------------------------------------
# Remove any leading <br>, capitalize the first letter, and put the <br> back
# before storing the message in the buffer.
#------------------------------------------------------------------------------
      if ($comment_line =~ /^$g_html_new_line/)
        {
          $msg = $comment_line;
          $msg =~ s/$g_html_new_line//;
          $comment_line = $g_html_new_line . ucfirst ($msg);

push (@g_warning_msgs, $comment_line);
        }
      else
        {
          push (@g_warning_msgs, ucfirst ($comment_line));
        }
    }

#------------------------------------------------------------------------------
# Unconditionally buffer all errror messages.  These will be printed prior to
# terminate execution.
#------------------------------------------------------------------------------
  if ($action eq "error")
#------------------------------------------------------------------------------
# Remove any leading <br>, capitalize the first letter, and put the <br> back.
#------------------------------------------------------------------------------
    {
      if ($comment_line =~ /^$g_html_new_line/)
        {
          $msg = $comment_line;
          $msg =~ s/$g_html_new_line//;
          $comment_line = $g_html_new_line . ucfirst ($msg);

push (@g_error_msgs, $comment_line);
        }
      else
        {
          push (@g_error_msgs, ucfirst ($comment_line));
        }
    }

#------------------------------------------------------------------------------
# Quick return in several cases.  Note that "debug", "verbose", "warning", and
# "diag" messages are suppressed in quiet mode, but "error", "abort" and
# "assertion" always pass.
#------------------------------------------------------------------------------
  if ((
           ($action eq "verbose") and (not $g_verbose))
       or (($action eq "debug")   and (not $trigger_debug))
       or (($action eq "verbose") and ($g_quiet))
       or (($action eq "debug")   and ($g_quiet))
       or (($action eq "warning") and ($g_quiet))
       or (($action eq "diag")    and ($g_quiet)))
    {
      return (0);
    }

#------------------------------------------------------------------------------
# In diag mode, just print the input line and nothing else.
#------------------------------------------------------------------------------
  if ((
          $action eq "debug")
      or ($action eq "abort")
      or ($action eq "assertion"))
##      or ($action eq "error"))
    {
#------------------------------------------------------------------------------
# Construct the string to be printed.  Include an identifier and the name of
# the function.
#------------------------------------------------------------------------------
      if ($strlen > $string_limit)
        {
          $truncated_name  = substr ($caller_name, 0, $string_limit);
          $fixed_size_name = sprintf ("%-"."$string_limit"."s", $truncated_name);
          print "Warning in $subr_name - the name of the caller is: " .
		$caller_name . "\n";
          print "Warning in $subr_name - the string length is $strlen and " .
                "exceeds $string_limit\n";
        }
      else
        {
          $fixed_size_name = sprintf ("%-"."$string_limit"."s", $caller_name);
        }

##      if (($action eq "error") or ($action eq "abort"))
      if ($action eq "abort")
#------------------------------------------------------------------------------
# Enforce that the message starts with a lowercase symbol.  Since these are
# user errors, the name of the routine is not shown.  The same for "abort".
# If you want to display the routine name too, use an assertion.
#------------------------------------------------------------------------------
        {
          my $error_identifier = $supported_identifiers{"error"};
          if (@g_error_msgs)
            {
              $ignore_value = print_errors_buffer (\$error_identifier);
            }
          printf ("%-9s %s", $identifier, ucfirst ($comment_line));
          printf (" - %s\n", "execution is terminated");
        }
      elsif ($action eq "assertion")
#------------------------------------------------------------------------------
# Enforce that the message starts with a lowercase symbol.
#------------------------------------------------------------------------------
        {
#------------------------------------------------------------------------------
# The lines are too long, but breaking the argument list gives this warning:
# printf (...) interpreted as function
#------------------------------------------------------------------------------
          printf ("%-17s %-30s", $identifier, $fixed_size_name);
          printf (" - %s\n", $comment_line);
        }
      elsif (($action eq "debug") and ($trigger_debug))
#------------------------------------------------------------------------------
# Debug messages are printed "as is".  Avoids issues when searching for them ;-)
#------------------------------------------------------------------------------
        {
          printf ("%-9s %-30s", $identifier, $fixed_size_name);
          printf (" - %s\n", $comment_line);
        }
      else
#------------------------------------------------------------------------------
# Enforce that the message starts with a lowercase symbol.
#------------------------------------------------------------------------------
        {
          printf ("%-9s %-30s", $identifier, $fixed_size_name);
          printf (" - %s\n", $comment_line);
        }
    }
  elsif ($action eq "verbose")
#------------------------------------------------------------------------------
# The first character in the verbose message is capatilized.
#------------------------------------------------------------------------------
    {
      printf ("%s\n", ucfirst ($comment_line));
    }
  elsif ($action eq "diag")
#------------------------------------------------------------------------------
# The diag messages are meant to be diagnostics.  Only the comment line is
# printed.
#------------------------------------------------------------------------------
    {
      printf ("%s\n", $comment_line);
      return (0);
    }

#------------------------------------------------------------------------------
# Terminate execution in case the identifier is "abort".
#------------------------------------------------------------------------------
  if (($action eq "abort") or ($action eq "assertion"))
    {
##      print "ABORT temporarily disabled for testing purposes\n";
      exit (-1);
    }
  else
    {
      return (0);
    }
 
} #-- End of subroutine gp_message

#------------------------------------------------------------------------------
# Create an HTML page with the warnings.  If there are no warnings, include
# line to this extent.  The alternative is to supporess the entire page, but
# that breaks the consistency in the output.
#------------------------------------------------------------------------------
sub html_create_warnings_page
{
  my $subr_name = get_my_name ();

my ($outputdir_ref) = @_;

my $outputdir = ${ $outputdir_ref };

my $file_title;
  my $html_acknowledgement;
  my $html_end;
  my $html_header;
  my $html_home_left;
  my $html_home_right;
  my $html_title_header;
  my $msg_no_warnings = "There are no warning messages issued.";
  my $page_title;
  my $position_text;
  my $size_text;

my $outfile = $outputdir . $g_html_base_file_name{"warnings"} . ".html";

gp_message ("debug", $subr_name, "outfile = $outfile");

open (WARNINGS_OUT, ">", $outfile)
    or die ("unable to open $outfile for writing - '$!'");
  gp_message ("debug", $subr_name, "opened file $outfile for writing");

gp_message ("debug", $subr_name, "building warning file $outfile");

#------------------------------------------------------------------------------
# Generate some of the structures used in the HTML output.
#------------------------------------------------------------------------------
  $file_title  = "Warning messages";
  $html_header = ${ create_html_header (\$file_title) };
  $html_home_right   = ${ generate_home_link ("right") };

$page_title    = "Warning Messages";
  $size_text     = "h2";
  $position_text = "center";
  $html_title_header = ${ generate_a_header (\$page_title, \$size_text, \$position_text) };

#------------------------------------------------------------------------------
# Get the acknowledgement, return to main link, and final html statements.
#------------------------------------------------------------------------------
  $html_home_left       = ${ generate_home_link ("left") };
  $html_acknowledgement = ${ create_html_credits () };
  $html_end             = ${ terminate_html_document () };

#------------------------------------------------------------------------------
# Generate the HTML file.
#------------------------------------------------------------------------------
  print WARNINGS_OUT $html_header;
  print WARNINGS_OUT $html_home_right;
  print WARNINGS_OUT $html_title_header;

if ($g_total_warning_count > 0)
    {
      print WARNINGS_OUT "<pre>\n";
      print WARNINGS_OUT "$_\n" for @g_warning_msgs;
      print WARNINGS_OUT "</pre>\n";
    }
  else
    {
      print WARNINGS_OUT $msg_no_warnings;
    }

print WARNINGS_OUT $html_home_left;
  print WARNINGS_OUT "<br>\n";
  print WARNINGS_OUT $html_acknowledgement;
  print WARNINGS_OUT $html_end;

close (WARNINGS_OUT);

return (0);

} #-- End of subroutine html_create_warnings_page

#------------------------------------------------------------------------------
# Generate the HTML with the experiment summary.
#------------------------------------------------------------------------------
sub html_generate_exp_summary
{
  my $subr_name = get_my_name ();

my ($outputdir_ref, $experiment_data_ref) = @_;

my $outputdir       = ${ $outputdir_ref };
  my @experiment_data = @{ $experiment_data_ref };
  my $file_title;
  my $outfile;
  my $page_title;
  my $size_text;
  my $position_text;
  my $html_header;
  my $html_home;
  my $html_title_header;
  my $html_acknowledgement;
  my $html_end;
  my @html_exp_table_data = ();
  my $html_exp_table_data_ref;
  my @table_execution_stats = ();
  my $table_execution_stats_ref;

gp_message ("debug", $subr_name, "outputdir = $outputdir");
  $outputdir = append_forward_slash ($outputdir);
  gp_message ("debug", $subr_name, "outputdir = $outputdir");

$file_title = "Experiment information";
  $page_title = "Experiment Information";
  $size_text = "h2";
  $position_text = "center";
  $html_header = ${ create_html_header (\$file_title) };
  $html_home   = ${ generate_home_link ("right") };

$html_title_header = ${ generate_a_header (\$page_title, \$size_text, \$position_text) };

$outfile = $outputdir . $g_html_base_file_name{"experiment_info"} . ".html";
  open (EXP_INFO, ">", $outfile)
    or die ("unable to open $outfile for writing - '$!'");
  gp_message ("debug", $subr_name, "opened file $outfile for writing");

print EXP_INFO $html_header;
  print EXP_INFO $html_home;
  print EXP_INFO $html_title_header;

($html_exp_table_data_ref, $table_execution_stats_ref) = html_generate_table_data ($experiment_data_ref);

@html_exp_table_data   = @{ $html_exp_table_data_ref };
  @table_execution_stats = @{ $table_execution_stats_ref };

print EXP_INFO "$_" for @html_exp_table_data;
;
##  print EXP_INFO "<pre>\n";
##  print EXP_INFO "$_\n" for @html_caller_callee;
##  print EXP_INFO "</pre>\n";

print EXP_INFO $html_home;
  print EXP_INFO "<br>\n";
  print EXP_INFO $html_acknowledgement;
  print EXP_INFO $html_end;

close (EXP_INFO);

return (\@table_execution_stats);

} #-- End of subroutine html_generate_exp_summary

#------------------------------------------------------------------------------
# Generate the index.html file.
#------------------------------------------------------------------------------
sub html_generate_index
{
  my $subr_name = get_my_name ();

my ($outputdir_ref, $html_first_metric_file_ref, $summary_metrics_ref,
      $number_of_metrics_ref, $function_info_ref, $function_address_info_ref,
      $sort_fields_ref, $exp_dir_list_ref, $addressobjtextm_ref,
      $metric_description_reversed_ref, $table_execution_stats_ref) = @_;

my $outputdir               = ${ $outputdir_ref };
  my $html_first_metric_file  = ${ $html_first_metric_file_ref };
  my $summary_metrics         = ${ $summary_metrics_ref };
  my $number_of_metrics       = ${ $number_of_metrics_ref };
  my @function_info           = @{ $function_info_ref };
  my %function_address_info   = %{ $function_address_info_ref };
  my @sort_fields             = @{ $sort_fields_ref };
  my @exp_dir_list            = @{ $exp_dir_list_ref };
  my %addressobjtextm         = %{ $addressobjtextm_ref };
  my %metric_description_reversed = %{ $metric_description_reversed_ref };
  my @table_execution_stats   = @{ $table_execution_stats_ref };

my @file_contents = ();

my $acknowledgement;
  my @abs_path_exp_dirs = ();
  my $input_experiments;
  my $target_function;
  my $html_line;
  my $ftag;
  my $max_length = 0;
  my %html_source_functions = ();
  my $html_header;
  my @experiment_directories = ();
  my $html_acknowledgement;
  my $html_file_title;
  my $html_output_file;
  my $html_function_view;
  my $html_caller_callee_view;
  my $html_experiment_info;
  my $html_warnings_page;
  my $href_link;
  my $file_title;
  my $html_gprofng;
  my $html_end;
  my $max_length_metrics;
  my $page_title;
  my $size_text;
  my $position_text;

my $ln;
  my $base;
  my $base_index_page;
  my $infile;
  my $outfile;
  my $rec;
  my $skip;
  my $callsize;
  my $dest;
  my $final_string;
  my @headers;
  my $header;
  my $sort_index;
  my $pc_address;
  my $anchor;
  my $directory_name;
  my $f2;
  my $f3;
  my $file;
  my $sline;
  my $src;
  my $srcfile_name;
  my $tmp1;
  my $tmp2;
  my $fullsize;
  my $regf2;
  my $trimsize;
  my $EIL;
  my $EEIL;
  my $AOBJ;
  my $RI;
  my $HDR;
  my $CALLER_CALLEE;
  my $NAME;
  my $SRC;
  my $TRIMMED;

#------------------------------------------------------------------------------
# Add a forward slash to make it easier when creating file names.
#------------------------------------------------------------------------------
  $outputdir         = append_forward_slash ($outputdir);
  gp_message ("debug", $subr_name, "outputdir = $outputdir");

my $LANG              = $g_locale_settings{"LANG"};
  my $decimal_separator = $g_locale_settings{"decimal_separator"};

$input_experiments = join (", ", @exp_dir_list);

for my $i (0 .. $#exp_dir_list)
    {
      my $dir = get_basename ($exp_dir_list[$i]);
      push @abs_path_exp_dirs, $dir;
    }
  $input_experiments = join (", ", @abs_path_exp_dirs);

gp_message ("debug", $subr_name, "input_experiments = $input_experiments");
 
#------------------------------------------------------------------------------
# TBD: Pass in the values for $expr_name and $cmd
#------------------------------------------------------------------------------
  $html_file_title = "Main index page";

@experiment_directories = split (",", $input_experiments);
  $html_acknowledgement = ${ create_html_credits () };

$html_end              = ${ terminate_html_document () };

$html_output_file = $outputdir . $g_html_base_file_name{"index"} . ".html";

open (INDEX, ">", $html_output_file)
    or die ("$subr_name - unable to open file $html_output_file for writing - '$!'");
  gp_message ("debug", $subr_name, "opened file $html_output_file for writing");

$page_title    = "GPROFNG Performance Analysis";
  $size_text     = "h1";
  $position_text = "center";
  $html_gprofng = ${ generate_a_header (\$page_title, \$size_text, \$position_text) };

$html_header     = ${ create_html_header (\$html_file_title) };

print INDEX $html_header;
  print INDEX $html_gprofng;
  print INDEX "$_" for @g_html_experiment_stats;
  print INDEX "$_" for @table_execution_stats;

$html_experiment_info  = "<a href=\'";
  $html_experiment_info .= $g_html_base_file_name{"experiment_info"} . ".html";
  $html_experiment_info .= "\'><h3>Experiment Details</h3></a>\n";

$html_warnings_page  = "<a href=\'";
  $html_warnings_page .= $g_html_base_file_name{"warnings"} . ".html";
  $html_warnings_page .= "\'><h3>Warnings (" . $g_total_warning_count;
  $html_warnings_page .= ")</h3></a>\n";

$html_function_view  = "<a href=\'";
  $html_function_view .= $html_first_metric_file;
  $html_function_view .= "\'><h3>Function View</h3></a>\n";

$html_caller_callee_view  = "<a href=\'";
  $html_caller_callee_view .= $g_html_base_file_name{"caller_callee"} . ".html";
  $html_caller_callee_view .= "\'><h3>Caller Callee View</h3></a>\n";

print INDEX "<br>\n";
##  print INDEX "<b>\n";
  print INDEX $html_experiment_info;
  print INDEX $html_warnings_page;
##  print INDEX "<br>\n";
##  print INDEX "<br>\n";
  print INDEX $html_function_view;
##  print INDEX "<br>\n";
##  print INDEX "<br>\n";
  print INDEX $html_caller_callee_view;
##  print INDEX "</b>\n";
##  print INDEX "<br>\n";
##  print INDEX "<br>\n";

print INDEX $html_acknowledgement;
  print INDEX $html_end;

close (INDEX);

gp_message ("debug", $subr_name, "closed file $html_output_file");

return (0);

} #-- End of subroutine html_generate_index

#------------------------------------------------------------------------------
# Generate the entries for the tables with the experiment info.
#------------------------------------------------------------------------------
sub html_generate_table_data
{
  my $subr_name = get_my_name ();

my ($experiment_data_ref) = @_;

my @experiment_data     = ();
  my @html_exp_table_data = ();
  my $html_line;
##  my $html_header_line;
  my $entry_name;
  my $key;
  my $size_text;
  my $position_text;
  my $title_table_1;
  my $title_table_2;
  my $title_table_3;
  my $title_table_summary;
  my $html_table_title;

my @experiment_table_1_def = ();
  my @experiment_table_2_def = ();
  my @experiment_table_3_def = ();
  my @exp_table_summary_def = ();
  my @experiment_table_1 = ();
  my @experiment_table_2 = ();
  my @experiment_table_3 = ();
  my @exp_table_summary = ();
  my @exp_table_selection = ();

@experiment_data = @{ $experiment_data_ref };

for my $i (sort keys @experiment_data)
    {
      for my $fields (sort keys %{ $experiment_data[$i] })
        {
          gp_message ("debugXL", $subr_name, "$i => experiment_data[$i]{$fields} = $experiment_data[$i]{$fields}");
        }
    }

$title_table_1 = "Target System Configuration";
  $title_table_2 = "Experiment Statistics";
  $title_table_3 = "Run Time Statistics";
  $title_table_summary = "Main Statistics";

$size_text     = "h3";
  $position_text = "left";

push @experiment_table_1_def, { name => "Experiment name" , key => "exp_name_short"};
  push @experiment_table_1_def, { name => "Hostname"        , key => "hostname"};
  push @experiment_table_1_def, { name => "Operating system", key => "OS"};
  push @experiment_table_1_def, { name => "Architecture",     key => "architecture"};
  push @experiment_table_1_def, { name => "Page size",        key => "page_size"};

push @experiment_table_2_def, { name => "Target command"          , key => "target_cmd"};
  push @experiment_table_2_def, { name => "Date command executed"   , key => "start_date"};
  push @experiment_table_2_def, { name => "Data collection duration", key => "data_collection_duration"};
  push @experiment_table_2_def, { name => "End time of the experiment", key => "end_experiment"};

push @experiment_table_3_def, { name => "User CPU time (seconds)", key => "user_cpu_time"};
##  push @experiment_table_3_def, { name => "User CPU time (percentage)", key => "user_cpu_percentage"};
  push @experiment_table_3_def, { name => "System CPU time (seconds)", key => "system_cpu_time"};
##  push @experiment_table_3_def, { name => "System CPU time (percentage)", key => "system_cpu_percentage"};
  push @experiment_table_3_def, { name => "Sleep time (seconds)", key => "sleep_time"};
##  push @experiment_table_3_def, { name => "Sleep time (percentage)", key => "sleep_percentage"};

push @exp_table_summary_def, { name => "Experiment name" , key => "exp_name_short"};
  push @exp_table_summary_def, { name => "Hostname"        , key => "hostname"};
  push @exp_table_summary_def, { name => "User CPU time (seconds)", key => "user_cpu_time"};
  push @exp_table_summary_def, { name => "System CPU time (seconds)", key => "system_cpu_time"};
  push @exp_table_summary_def, { name => "Sleep time (seconds)", key => "sleep_time"};

$html_table_title = ${ generate_a_header (\$title_table_1, \$size_text, \$position_text) };

push (@html_exp_table_data, $html_table_title);

@experiment_table_1 = @{ create_table (\@experiment_data, \@experiment_table_1_def) };

push (@html_exp_table_data, @experiment_table_1);

$html_table_title = ${ generate_a_header (\$title_table_2, \$size_text, \$position_text) };

push (@html_exp_table_data, $html_table_title);

@experiment_table_2 = @{ create_table (\@experiment_data, \@experiment_table_2_def) };

push (@html_exp_table_data, @experiment_table_2);

$html_table_title = ${ generate_a_header (\$title_table_3, \$size_text, \$position_text) };

push (@html_exp_table_data, $html_table_title);

@experiment_table_3 = @{ create_table (\@experiment_data, \@experiment_table_3_def) };

push (@html_exp_table_data, @experiment_table_3);

$html_table_title = ${ generate_a_header (\$title_table_summary, \$size_text, \$position_text) };

push (@exp_table_summary, $html_table_title);

@exp_table_selection = @{ create_table (\@experiment_data, \@exp_table_summary_def) };

push (@exp_table_summary, @exp_table_selection);

return (\@html_exp_table_data, \@exp_table_summary);

} #-- End of subroutine html_generate_table_data

#------------------------------------------------------------------------------
# Generate the HTML text to print in case a file is empty.
#------------------------------------------------------------------------------
sub html_text_empty_file
{
  my $subr_name = get_my_name ();

my ($comment_ref, $error_file_ref) = @_;

my $comment;
  my $error_file;
  my $error_message;
  my $file_title;
  my $html_end;
  my $html_header;
  my $html_home;

my @html_empty_file = ();

$comment     = ${ $comment_ref };
  $error_file  = ${ $error_file_ref };

$file_title  = "File is empty";
  $html_header = ${ create_html_header (\$file_title) };
  $html_end    = ${ terminate_html_document () };
  $html_home   = ${ generate_home_link ("left") };

push (@html_empty_file, $html_header);

$error_message = "<b>" . $comment . "</b>";
  $error_message = set_background_color_string ($error_message, $g_html_color_scheme{"error_message"});
  push (@html_empty_file, $error_message);

if (not is_file_empty ($error_file))
    {
      $error_message = "<p><em>Check file $error_file for more information</em></p>";
    }
  push (@html_empty_file, $error_message);
  push (@html_empty_file, $html_home);
  push (@html_empty_file, "<br>");
  push (@html_empty_file, $g_html_credits_line);
  push (@html_empty_file, $html_end);

return (\@html_empty_file);

} #-- End of subroutine html_text_empty_file

#------------------------------------------------------------------------------
# This subroutine checks if a file is empty and returns $TRUE or $FALSE.
#------------------------------------------------------------------------------
sub is_file_empty
{
  my $subr_name = get_my_name ();

my ($filename) = @_;

my $is_empty;
  my $file_stat;
  my $msg;
  my $size;

chomp ($filename);

if (not -e $filename)
    {
#------------------------------------------------------------------------------
# The return value is used in the caller.  This is why we return the empty
# string in case the file does not exist.
#------------------------------------------------------------------------------
      $msg = "filename = $filename not found";
      gp_message ("debug", $subr_name, $msg);
      $is_empty = $TRUE;
    }
  else
    {
      $file_stat = stat ($filename);
      $size      = $file_stat->size;
      $is_empty  = ($size == 0) ? $TRUE : $FALSE;
    }

$msg = "filename = $filename size = $size is_empty = $is_empty";
  gp_message ("debug", $subr_name, $msg);

return ($is_empty);

} #-- End of subroutine is_file_empty

#------------------------------------------------------------------------------
# Check if a file is executable and return $TRUE or $FALSE.
#------------------------------------------------------------------------------
sub is_file_executable
{
  my $subr_name = get_my_name ();

my ($filename) = @_;

my $file_permissions;
  my $index_offset;
  my $is_executable;
  my $mode;
  my $number_of_bytes;
  my @permission_settings = ();
  my %permission_values = ();

chomp ($filename);

gp_message ("debug", $subr_name, "check if filename = $filename is executable");

if (not -e $filename)
    {
#------------------------------------------------------------------------------
# The return value is used in the caller.  This is why we return the empty
# string in case the file does not exist.
#------------------------------------------------------------------------------
      gp_message ("debug", $subr_name, "filename = $filename not found");
      $is_executable = $FALSE;
    }
  else
    {
      $mode = stat ($filename)->mode;

gp_message ("debugXL", $subr_name, "mode = $mode");
#------------------------------------------------------------------------------
# Get username.  We currently do not do anything with this though and the
# code is commented out.
#
#      my $my_name = getlogin () || getpwuid($<) || "Kilroy";
#      gp_message ("debug", $subr_name, "my_name = $my_name");
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# Convert file permissions to octal, split the individual numbers and store
# the values for the respective users.
#------------------------------------------------------------------------------
      $file_permissions = sprintf("%o", $mode & 07777);

@permission_settings = split (//, $file_permissions);

$number_of_bytes = scalar (@permission_settings);

gp_message ("debugXL", $subr_name, "file_permissions = $file_permissions");
      gp_message ("debugXL", $subr_name, "permission_settings = @permission_settings");
      gp_message ("debugXL", $subr_name, "number_of_settings = $number_of_bytes");

if ($number_of_bytes == 4)
        {
          $index_offset = 1;
        }
      elsif ($number_of_bytes == 3)
        {
          $index_offset = 0;
        }
      else
        {
          my $msg = "unexpected number of $number_of_bytes bytes " .
                    "in permission settings: @permission_settings";
          gp_message ("assertion", $subr_name, $msg);
        }

$permission_values{user}  = $permission_settings[$index_offset++];
      $permission_values{group} = $permission_settings[$index_offset++];
      $permission_values{other} = $permission_settings[$index_offset];

#------------------------------------------------------------------------------
# The executable bit should be set for user, group and other.  If this fails
# we mark the file as not executable.  Note that this is gprofng specific.
#------------------------------------------------------------------------------
      $is_executable = $TRUE;
      for my $k (keys %permission_values)
        {
          my $msg = "permission_values{" . $k . "} = " .
                    $permission_values{$k};
          gp_message ("debugXL", $subr_name, $msg);

if ($permission_values{$k} % 2 == 0)
            {
              $is_executable = $FALSE;
              last;
            }
        }
    }

gp_message ("debug", $subr_name, "is_executable = $is_executable");

return ($is_executable);

} #-- End of subroutine is_file_executable

#------------------------------------------------------------------------------
# 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

my ($metric_description_ref, $metrics, $field, $file) = @_;

my %metric_description = %{ $metric_description_ref };

my @splitted_metrics;
  my $splitted_metrics;
  my $m;
  my $mf;
  my $nf;
  my $re;
  my $Xre;
  my $noPCfile;
  my @reported_metrics;
  my $reported_metrics;
  my $hdr_regex;
  my $hdr_href_regex;
  my $hdr_src_regex;
  my $new_metrics;
  my $pre;
  my $post;
  my $rat;
  my @moo = ();

my $gp_metrics_file;
  my $gp_metrics_dir;
  my $suffix_not_used;

my $is_calls    = $FALSE;
  my $is_calltree = $FALSE;

gp_message ("debugXL", $subr_name,"1:metrics->$metrics<- field->$field<- file->$file<-");

#------------------------------------------------------------------------------
# According to https://perldoc.perl.org/File::Basename, both dirname and
# basename are not reliable and fileparse () is recommended instead.
#
# Note that $gp_metrics_dir has a trailing "/".
#------------------------------------------------------------------------------
  ($gp_metrics_file, $gp_metrics_dir, $suffix_not_used) = fileparse ($file, ".sort.func-PC");

gp_message ("debugXL", $subr_name, "gp_metrics_dir = $gp_metrics_dir gp_metrics_file = $gp_metrics_file");
  gp_message ("debugXL", $subr_name, "suffix_not_used = $suffix_not_used");

if ($gp_metrics_file eq "calls")
    {
      $is_calls = $TRUE;
    }
  if ($gp_metrics_file eq "calltree")
    {
      $is_calltree = $TRUE;
    }

$gp_metrics_file = "gp-metrics-" . $gp_metrics_file . "-PC";
  $gp_metrics_file = $gp_metrics_dir . $gp_metrics_file;

gp_message ("debugXL", $subr_name, "gp_metrics_file is $gp_metrics_file");

open (GP_METRICS, "<", $gp_metrics_file)
    or die ("$subr_name - unable to open gp_metrics file $gp_metrics_file for reading - '$!'");
  gp_message ("debug", $subr_name, "opened file $gp_metrics_file for reading");

$new_metrics = $metrics;

while (<GP_METRICS>)
    {
      $rat = $_;
      chomp ($rat);
      gp_message ("debugXL", $subr_name, "rat = $rat - new_metrics = $new_metrics");
#------------------------------------------------------------------------------
# Capture the string after "Current metrics:" and if it ends with ":name",
# remove it.
#------------------------------------------------------------------------------
      if ($rat =~ /^\s*Current metrics:\s*(.*)$/)
        {
          $new_metrics = $1;
          if ($new_metrics =~ /^(.*):name$/)
            {
              $new_metrics = $1;
            }
          last;
        }
    }
  close (GP_METRICS);

if ($is_calls or $is_calltree)
    {
#------------------------------------------------------------------------------
# Remove any inclusive metrics from the list.
#------------------------------------------------------------------------------
      while ($new_metrics =~ /(.*)(i\.[^:]+)(.*)$/)
        {
          $pre  = $1;
          $post = $3;
          gp_message ("debugXL", $subr_name, "1b: new_metrics = $new_metrics pre = $pre post = $post");
          if (substr ($post,0,1) eq ":")
            {
              $post = substr ($post,1);
            }
          $new_metrics = $pre.$post;
        }
    }

$metrics = $new_metrics;

gp_message ("debugXL", $subr_name, "2:metrics->$metrics<- field->$field<- file->$file<-");

#------------------------------------------------------------------------------
# Find the line starting with "address:" and strip this part away.
#------------------------------------------------------------------------------
  if ($metrics =~ /^address:(.*)/)
    {
      $reported_metrics = $1;
#------------------------------------------------------------------------------
# Focus on the filename ending with "-PC".  When found, strip this part away.
#------------------------------------------------------------------------------
      if ($file =~ /^(.*)-PC$/)
        {
          $noPCfile = $1;
          if ($noPCfile =~ /^(.*)functions.sort.func$/)
            {
              $noPCfile = $1."functions.func";
            }
          push (@moo, "$reported_metrics\n");
        }
    }

#------------------------------------------------------------------------------
# Split the list into an array with the individual metrics.
#
# TBD: This should be done only once!
#------------------------------------------------------------------------------
  @reported_metrics = split (":", $reported_metrics);
  for my $i (@reported_metrics)
    {
      gp_message ("debugXL", $subr_name, "reported_metrics = $i");
    }

$hdr_regex      = "^\\s*";
  $hdr_href_regex = "^\\s*";
  $hdr_src_regex  = "^(\\s+|<i>\\s+)";

for my $m (@reported_metrics)
    {

my $description = ${ retrieve_metric_description (\$m, \%metric_description) };
      gp_message ("debugXL", $subr_name, "m = $m description = $description");
      if (substr ($m,0,1) eq "e")
        {
          push (@moo,"$m:$description\n");
          $hdr_regex .= "(Excl\\.\.*)";
          $hdr_href_regex .= "(<a.*>)(Excl\\.)(<\/a>)([^<]+)";
          $hdr_src_regex .= "(Excl\\.\.*)";
          next;
        }
      if (substr ($m,0,1) eq "i")
        {
          push (@moo,"$m:$description\n");
          $hdr_regex .= "(Incl\\.\.*)";
          $hdr_href_regex .= "(<a.*>)(Incl\\.)(<\/a>)([^<]+)";
          $hdr_src_regex .= "(Incl\\.\.*)";
          next;
        }
      if (substr ($m,0,1) eq "a")
        {
          my $a;
          my $am;
          $a = $m;
          $a =~ s/^a/e/;
          $am = ${ retrieve_metric_description (\$a, \%metric_description) };
          $am =~ s/Exclusive/Attributed/;
          push (@moo,"$m:$am\n");
          $hdr_regex .= "(Attr\\.\.*)";
          $hdr_href_regex .= "(<a.*>)(Attr\\.)(<\/a>)([^<]+)";
          $hdr_src_regex .= "(Attr\\.\.*)";next;
        }
    }

$hdr_regex      .= "(Name\.*)";
  $hdr_href_regex .= "(Name\.*)";

@splitted_metrics = split (":","$metrics");
  $nf               = scalar (@splitted_metrics);
  gp_message ("debug", $subr_name,"number of fields in $metrics -> $nf");

open (ZMETRICS, ">", "$noPCfile.metrics")
    or die ("Not able to open file $noPCfile.metrics for writing - '$!'");
  gp_message ("debug", $subr_name, "$noPCfile - opened file $noPCfile.metrics for writing");

print ZMETRICS @moo;
  close (ZMETRICS);

gp_message ("debug", $subr_name, "wrote file $noPCfile.metrics");

open (XREGEXP, ">", "$noPCfile.c.regex")
    or die ("Not able to open file $noPCfile.c.regex for writing - '$!'");
  gp_message ("debug", $subr_name, "$noPCfile - opened file $noPCfile.c.regex for writing");

print XREGEXP "\# Number of metric fields\n";
  print XREGEXP "$nf\n";
  print XREGEXP "\# Header regex\n";
  print XREGEXP "$hdr_regex\n";
  print XREGEXP "\# href Header regex\n";
  print XREGEXP "$hdr_href_regex\n";
  print XREGEXP "\# src Header regex\n";
  print XREGEXP "$hdr_src_regex\n";

$mf = 1;
#---------------------------------------------------------------------------
# Find the index of "field" in the metric list, plus one.
#---------------------------------------------------------------------------
  if ( ($field eq "functions") or ($field eq "calls") or ($field eq "calltree"))
    {
      $mf = $nf + 1;
    }
  else
    {
      for my $candidate_metric (@splitted_metrics)
        {
          gp_message ("debugXL", $subr_name, "field = $field candidate_metric = $candidate_metric and mf = $mf");
          if ($candidate_metric eq $field)
            {
              last;
            }
          $mf++;
        }
    }
  gp_message ("debugXL", $subr_name, "Final value mf = $mf");

if ($mf == 1)
    {
      $re = "^\\s*(\\S+)"; # metric value
    }
  else
    {
      $re = "^\\s*\\S+";
    }
  $Xre = "^\\s*(\\S+)";

$m = 2;
  while (--$nf)
    {
      if ($nf)
        {
          if ($m == $mf)
            {
              $re .= "\\s+(\\S+)"; # metric value
            }
          else
            {
              $re .= "\\s+\\S+";
            }
          if ($nf != 1)
            {
              $Xre .= "\\s+(\\S+)";
            }
          $m++;
        }
    }

if ($field eq "calltree")
    {
      $re .= "\\s+.*\\+-(.*)"; # name
      $Xre .= "\\s+.*\\+-(.*)\$"; # name (Right?)
    }
  else
    {
      $re .= "\\s+(.*)"; # name
      $Xre .= "\\s+(.*)\$"; # name
    }

print XREGEXP "\# Metrics and Name regex\n";
  print XREGEXP "$Xre\n";
  close (XREGEXP);

gp_message ("debug", $subr_name, "wrote file $noPCfile.c.regex");
  gp_message ("debugXL", $subr_name, "on return Xre = $Xre");
  gp_message ("debugXL", $subr_name, "on return re  = $re");

return ($re);

} #-- End of subroutine name_regex

my ($input_string) = @_;

my $directory_name = append_forward_slash ($input_string);
  my $LANG           = $g_locale_settings{"LANG"};
  my $result_file    = $directory_name."no_source.html";

gp_message ("debug", $subr_name, "result_file = $result_file");

open (NS, ">", $result_file)
    or die ("$subr_name: cannot open file $result_file for writing - '$!'");

print NS "<!doctype html public \"-//w3c//dtd html 3.2//en\">\n<html lang=\"$LANG\">\n<head>\n".
           "<meta http-equiv=\"content-type\" content=\"text/html; charset=iso-8859-1\">\n" .
           "<title>No source</title></head><body lang=\"$LANG\" bgcolor=".$g_html_color_scheme{"background_color_page"}."><pre>\n";
  print NS "<a name=\"line1\"></a><font color=#C80707>"."No source was found"."</font>\n"; # red font
  print NS "</pre>\n<pre>Output generated by $version_info</pre>\n";
  print NS "</body></html>\n";

close (NS);

return (0);

} #-- End of subroutine nosrc

if ($a =~ /^([^\d]*)(\d+)/)
    {
      $f1 = int ($2);
      if ($b=~ /^([^\d]*)(\d+)/)
        {
          $f2 = int ($2);
          $f1 == $f2 ? 0 : ($f1 < $f2 ? -1 : +1);
        }
    }
  else
    {
      return ($a <=> $b);
    }
} #-- End of subroutine numerically

#------------------------------------------------------------------------------
# Parse the user options. Also perform a basic check.  More checks and also
# some more specific to the option, plus cross option checks,  will be
# performed soon after this subroutine has executed.
#
# Warnings, but also errors, are buffered.  In this way we can collect as many
# warnings and errors as possible, before bailing out in case of an error.
#------------------------------------------------------------------------------
sub parse_and_check_user_options
{
  my $subr_name = get_my_name ();

my @exp_dir_list;

my $arg;
  my $calltree_value;
  my $debug_value;
  my $default_metrics_value;
  my $func_limit_value;
  my $found_exp_dir = $FALSE;
  my $ignore_metrics_value;
  my $ignore_value;
  my $msg;
  my $outputdir_value;
  my $quiet_value;
  my $hp_value;
  my $valid;
  my $verbose_value;

my $number_of_fields;

my $internal_option_name;
  my $option_name;

my $verbose = undef;
  my $warning = undef;

my @opt_debug                = ();
  my @opt_highlight_percentage = ();
  my @opt_nowarnings           = ();
  my @opt_obsoleted_hp         = ();
  my @opt_output               = ();
  my @opt_overwrite            = ();
  my @opt_quiet                = ();
  my @opt_verbose              = ();
  my @opt_warnings             = ();

#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
  my $no_of_warnings;
  my $total_warning_msgs = 0;
  my $option_value;
  my $option_warnings;
  my $no_of_warnings_ref;
  my $no_of_errors_ref;

my $index_exp;
  my $first = $TRUE;
  my $trigger = $FALSE;
  my $found_non_exp = $FALSE;
  my $name_non_exp_dir;
  my $no_of_experiments = 0;

my @opt_help = ();
  my @opt_version = ();
  my $stop_execution = $FALSE;

my $option_value_ref;
  my $max_occurrences;
#------------------------------------------------------------------------------
# Configure Getopt to:
# - Silence warnings, since these are handled by the code.
# - Enforce case sensitivity in order to support -o and -O for example.
#------------------------------------------------------------------------------
  Getopt::Long::Configure("pass_through", "no_ignore_case");

#------------------------------------------------------------------------------
# Check for the --help and --version options.  Print a message and exit.
# Note that we support using both options simultaneously on the command line.
#------------------------------------------------------------------------------
  GetOptions (
    "help"    => \@opt_help,
    "version" => \@opt_version
  );

if (@opt_help)
    {
      $stop_execution = $TRUE;
      $ignore_value   = print_help_info ();
    }
  if (@opt_version)
    {
      $stop_execution = $TRUE;
      $ignore_value   = print_version_info ();
    }

if ($stop_execution)
    {
      exit (0);
    }

#------------------------------------------------------------------------------
# First, scan ARGV for the experiment names.  If there are no names, or the
# list with the names is not contiguous (meaning there is an non-experiment
# name in this list), an error message is printed and execution is terminated.
#
# Upon return from this function, the list with the experiment names is
# known and has been removed from ARGV.
#
# As a result, exp_dir_list is available from there on.
#
# This makes the subsequent processing of ARGV with GetOptions()  easier.
#------------------------------------------------------------------------------
  @exp_dir_list = @{ check_the_experiment_list () };

#------------------------------------------------------------------------------
# Configure Getopt to:
# - Silence warnings, since these are handled by the code.
# - Enforce case sensitivity in order to support -o and -O for example.
# - Allow unique abbreviations (also the default).
#------------------------------------------------------------------------------
  Getopt::Long::Configure("pass_through", "no_ignore_case", "auto_abbrev");
#------------------------------------------------------------------------------
# Get the remaining command line options.
#
# Recall:
# = => option requires a value
# : => option value is optional
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# All options are considered to be a string.
#
# We request every option supported to have an optional value.  Otherwise,
# GetOptions skips an option that does not have a value.
#
# The logic that parses the options deals with this and checks if an option
# that should have a value, actually has one.
#------------------------------------------------------------------------------
  GetOptions (
    "verbose|v:s"            => \@opt_verbose,
    "debug|d:s"              => \@opt_debug,
    "warnings|w:s"           => \@opt_warnings,
    "nowarnings:s"           => \@opt_nowarnings,
    "quiet|q:s"              => \@opt_quiet,
    "output|o=s"             => \@opt_output,
    "overwrite|O=s"          => \@opt_overwrite,
    "highlight-percentage=s" => \@opt_highlight_percentage,
    "hp=s"                   => \@opt_obsoleted_hp
  );

#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
# Handle the user input and where needed, generate warnings.  In a later stage
# we check for (cross option) errors and warnings.
#------------------------------------------------------------------------------
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# The very first thing to do is to determine if the user has enabled one of the
# following options and take action accordingly:
# --quiet, --verbose, --debug, --warnings
#
# We first need to check for quiet mode to be set.  If so, all messages need to
# be silenced, regardless of the settings for verbose, debug, and warnings.
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# The quiet option.
#------------------------------------------------------------------------------
  if (@opt_quiet)
    {
      $max_occurrences      = 1;
      $internal_option_name = "quiet";
      $option_name          = "--quiet";

my ($valid_ref) = extract_option_value (\@opt_quiet,
					      \$max_occurrences,
					      \$internal_option_name,
					      \$option_name);

$valid = ${ $valid_ref };

if ($valid)
        {
          $g_quiet = $g_user_settings{"quiet"}{"current_value"} eq "on" ?
								$TRUE : $FALSE;
        }
    }

#------------------------------------------------------------------------------
# The debug option.
#------------------------------------------------------------------------------
  if (@opt_debug)
    {
      $max_occurrences      = 1;
      $internal_option_name = "debug";
      $option_name          = "-d/--debug";

my ($valid_ref) = extract_option_value (\@opt_debug,
					      \$max_occurrences,
					      \$internal_option_name,
					      \$option_name);

$valid = ${ $valid_ref };

if ($valid)
#------------------------------------------------------------------------------
# Set the appropriate debug size (e.g. "XL") in a table that is used in the
# gp_message() subroutine.
#------------------------------------------------------------------------------
        {
          $g_debug = $TRUE;
          $ignore_value = set_debug_size ();
        }
    }

#------------------------------------------------------------------------------
# The verbose option.
#------------------------------------------------------------------------------
  if (@opt_verbose)
    {
      $max_occurrences      = 1;
      $internal_option_name = "verbose";
      $option_name          = "--verbose";

my ($valid_ref) = extract_option_value (\@opt_verbose,
					      \$max_occurrences,
					      \$internal_option_name,
					      \$option_name);
      $valid = ${ $valid_ref };

if ($valid)
        {
          $g_verbose = $g_user_settings{"verbose"}{"current_value"} eq "on" ?
								$TRUE : $FALSE;
        }
    }

#------------------------------------------------------------------------------
# The nowarnings option.
#------------------------------------------------------------------------------
  if (@opt_nowarnings)
    {
      $max_occurrences      = 1;
      $internal_option_name = "nowarnings";
      $option_name          = "--nowarnings";

my ($valid_ref) = extract_option_value (\@opt_nowarnings,
					      \$max_occurrences,
					      \$internal_option_name,
					      \$option_name);

$valid = ${ $valid_ref };

if ($valid)
        {
          $g_warnings =
		$g_user_settings{"nowarnings"}{"current_value"} eq "on" ?
								$FALSE : $TRUE;
        }
    }

#------------------------------------------------------------------------------
# The warnings option (deprecated).
#------------------------------------------------------------------------------
  if (@opt_warnings)
    {
      $max_occurrences      = 1;
      $internal_option_name = "warnings";
      $option_name          = "--warnings";

my ($valid_ref) = extract_option_value (\@opt_warnings,
					      \$max_occurrences,
					      \$internal_option_name,
					      \$option_name);
    }

#------------------------------------------------------------------------------
# At this point, the debug, verbose, warnings and quiet settings are known.
# This subroutine makes the final decision on these settings.  For example, if
# quiet mode has been specified, the settings for debug, verbose and warnings
# are ignored.
#------------------------------------------------------------------------------
  $ignore_value = finalize_special_options ();

#------------------------------------------------------------------------------
# A this point we know we can start printing messages in case verbose and/or
# debug mode have been set.
#------------------------------------------------------------------------------
  $msg = "the original command line options: " . join (", ", @CopyOfARGV);
  gp_message ("debug", $subr_name, $msg);

$msg = "the command line options after the special options: " .
         join (", ", @ARGV);
  gp_message ("debug", $subr_name, $msg);

gp_message ("verbose", $subr_name, "Parsing the user options");

#------------------------------------------------------------------------------
# The output option.
#------------------------------------------------------------------------------
  if (@opt_output)
    {
      $max_occurrences      = 1;
      $internal_option_name = "output";
      $option_name          = "-o/--output";

my ($valid_ref) = extract_option_value (\@opt_output,
					      \$max_occurrences,
					      \$internal_option_name,
					      \$option_name);
    }

#------------------------------------------------------------------------------
# The overwrite option.
#------------------------------------------------------------------------------
  if (@opt_overwrite)
    {
      $max_occurrences      = 1;
      $internal_option_name = "overwrite";
      $option_name          = "-O/--overwrite";

my ($valid_ref) = extract_option_value (\@opt_overwrite,
					      \$max_occurrences,
					      \$internal_option_name,
					      \$option_name);
    }

#------------------------------------------------------------------------------
# The highlight-percentage option.
#------------------------------------------------------------------------------
  if (@opt_highlight_percentage)
    {
      $max_occurrences      = 1;
      $internal_option_name = "highlight_percentage";
      $option_name          = "--highlight-percentage";

my ($valid_ref) = extract_option_value (\@opt_highlight_percentage,
					      \$max_occurrences,
					      \$internal_option_name,
					      \$option_name);
    }

#------------------------------------------------------------------------------
# The hp option (deprecated)
#------------------------------------------------------------------------------
  if (@opt_obsoleted_hp)
    {
      $max_occurrences      = 1;
      $internal_option_name = "hp";
      $option_name          = "-hp";

my ($valid_ref) = extract_option_value (\@opt_obsoleted_hp,
					      \$max_occurrences,
					      \$internal_option_name,
					      \$option_name);
    }

#------------------------------------------------------------------------------
# By now, all options given on the command line have been processed and the
# list with experiment directories is known.
#
# Process the remainder of ARGV, but other than the option generated by the
# driver, ARGV should be empty.
#------------------------------------------------------------------------------
  $ignore_value = wrap_up_user_options ();

# Temporarily disabled       elsif (($arg eq "-fl") or ($arg eq "--func-limit"))
# Temporarily disabled       elsif (($arg eq "-ct") or ($arg eq "--calltree"))
# Temporarily disabled       elsif (($arg eq "-tp") or ($arg eq "--threshold-percentage"))
# Temporarily disabled       elsif (($arg eq "-dm") or ($arg eq "--default-metrics"))
# Temporarily disabled       elsif (($arg eq "-im") or ($arg eq "--ignore-metrics"))

if (@exp_dir_list)
#------------------------------------------------------------------------------
# Print the list of the experiment directories found.
#
# Note that later we also check for these directories to actually exist
# and be valid experiments..
#------------------------------------------------------------------------------
    {
      $found_exp_dir = $TRUE;
      $msg = "the following experiment directories will be used:";
      gp_message ("debug", $subr_name, $msg);
      for my $i (keys @exp_dir_list)
        {
          my $msg = "exp_dir_list[$i] = $exp_dir_list[$i]";
          gp_message ("debug", $subr_name, $msg);
        }
    }
  else
#------------------------------------------------------------------------------
# Print a message if the experiment list is not valid, or empty.  There will
# also be error messages in the buffer. These will be printed later.
#------------------------------------------------------------------------------
    {
      $msg = "experiment directory name(s) are either not valid, or missing";
      gp_message ("debug", $subr_name, $msg);
    }

return (\$found_exp_dir, \@exp_dir_list);

} #-- End of subroutine parse_and_check_user_options

#------------------------------------------------------------------------------
# Parse the generated .dis files
#------------------------------------------------------------------------------
sub parse_dis_files
{
  my $subr_name = get_my_name ();

my ($number_of_metrics_ref, $function_info_ref,
      $function_address_and_index_ref, $input_string_ref,
      $addressobj_index_ref) = @_;

#------------------------------------------------------------------------------
# Note that $function_address_and_index_ref is not used, but we need to pass
# in the address into generate_dis_html.
#------------------------------------------------------------------------------
  my $number_of_metrics = ${ $number_of_metrics_ref };
  my @function_info     = @{ $function_info_ref };
  my $input_string      = ${ $input_string_ref };
  my %addressobj_index  = %{ $addressobj_index_ref };

my $filename;
  my $msg;
  my $outputdir = append_forward_slash ($input_string);

my @source_line = ();
  my $source_line_ref;

my @metric = ();
  my $metric_ref;

my $target_function;

gp_message ("debug", $subr_name, "building disassembly files");
  gp_message ("debug", $subr_name, "outputdir = $outputdir");

while (glob ($outputdir.'*.dis'))
    {
      gp_message ("debug", $subr_name, "processing disassembly file: $_");

my $base_name = get_basename ($_);

if ($base_name =~ /$dis_filename_id_regex/)
        {
          if (defined ($1))
            {
              gp_message ("debug", $subr_name, "processing disassembly file: $base_name $1");
              if (exists ($function_info[$1]{"routine"}))
                {
                  $target_function = $function_info[$1]{"routine"};
                  gp_message ("debug", $subr_name, "processing disassembly file: $base_name target_function = $target_function");
                }
              if (exists ($g_function_tag_id{$target_function}))
                {
                  gp_message ("debug", $subr_name, "target_function = $target_function ftag = $g_function_tag_id{$target_function}");
                }
              else
                {
                  my $msg = "no function tag found for $target_function";
                  gp_message ("assertion", $subr_name, $msg);
                }
            }
          else
            {
              gp_message ("debug", $subr_name, "processing disassembly file: $base_name unknown id");
            }
        }
 
      $filename = $_;
      gp_message ("verbose", $subr_name, "  Processing disassembly file $filename");
      ($source_line_ref, $metric_ref) = generate_dis_html (
                                          \$target_function,
                                          \$number_of_metrics,
                                          $function_info_ref,
                                          $function_address_and_index_ref,
                                          \$outputdir,
                                          \$filename,
                                          \@source_line,
                                          \@metric,
                                          \%addressobj_index);

@source_line = @{ $source_line_ref };

#------------------------------------------------------------------------------
# TBD.  This part needs work.  The return variables from generate_dis_html ()
# are not used, so the code below is meaningless, but awaiting a true fix,
# the problem which appears on aarch64 is bypassed.
#------------------------------------------------------------------------------
      if (defined ($metric_ref))
        {
          @metric = @{ $metric_ref };
        }
      else
        {
          $msg = "metric_ref after generate_dis_html is undefined";
          gp_message ("debug", $subr_name, $msg);
        }
    }

return (0)

} #-- End of subroutine parse_dis_files

#------------------------------------------------------------------------------
# Parse the .src.txt files
#------------------------------------------------------------------------------
sub parse_source_files
{
  my $subr_name = get_my_name ();

my ($number_of_metrics_ref, $function_info_ref, $outputdir_ref) = @_;

my $number_of_metrics = ${ $number_of_metrics_ref };
  my $outputdir         = ${ $outputdir_ref };
  my $ignore_value;

my $outputdir_with_slash = append_forward_slash ($outputdir);

gp_message ("verbose", $subr_name, "building source files");

while (glob ($outputdir_with_slash.'*.src.txt'))
    {
      gp_message ("verbose", $subr_name, "  Processing source file: $_");
      gp_message ("debug", $subr_name, "processing source file: $_");

my $found_target = process_source (
                           $number_of_metrics,
                           $function_info_ref,
                           $outputdir_with_slash,
                           $_);

if (not $found_target)
        {
          gp_message ("debug", $subr_name, "target function not found");
        }
    }

} #-- End of subroutine parse_source_files

#------------------------------------------------------------------------------
# Routine to prepend \\ to selected symbols.
#------------------------------------------------------------------------------
sub prepend_backslashes
{
  my $subr_name = get_my_name ();

my ($target_string) = @_;

gp_message ("debug", $subr_name, "target_string on entry  = $target_string");

$target_string =~ s/$/\\\(/g;
  $target_string =~ s/$/\\\)/g;
  $target_string =~ s/\+/\\\+/g;
  $target_string =~ s/\[/\\\[/g;
  $target_string =~ s/\]/\\\]/g;
  $target_string =~ s/\*/\\\*/g;
  $target_string =~ s/\./\\\./g;
  $target_string =~ s/\$/\\\$/g;
  $target_string =~ s/\^/\\\^/g;
  $target_string =~ s/\#/\\\#/g;

gp_message ("debug", $subr_name, "target_string on return = $target_string");

return ($target_string);

} #-- End of subroutine prepend_backslashes

#------------------------------------------------------------------------------
# TBD
#------------------------------------------------------------------------------
sub preprocess_function_files
{
  my $subr_name = get_my_name ();

my ($metric_description_ref, $script_pc_metrics, $input_string, $sort_fields_ref) = @_;

my $outputdir   = append_forward_slash ($input_string);
  my @sort_fields = @{ $sort_fields_ref };

my $error_code;
  my $cmd_output;
  my $re;

# TBD  $outputdir .= "/";

my %metric_description = %{ $metric_description_ref };

for my $m (keys %metric_description)
    {
      gp_message ("debug", $subr_name, "metric_description{$m} = $metric_description{$m}");
    }

$re = name_regex ($metric_description_ref, $script_pc_metrics, "functions", $outputdir."functions.sort.func-PC");
  ($error_code, $cmd_output) = execute_system_cmd ("echo '$re' > $outputdir"."functions.sort.func-PC.name-regex");
  if ($error_code != 0 )
    {
      gp_message ("abort", $subr_name, "execution terminated");
    }

for my $field (@sort_fields)
    {
      $re = name_regex ($metric_description_ref, $script_pc_metrics, $field, $outputdir."$field.sort.func-PC");
      ($error_code, $cmd_output) = execute_system_cmd ("echo '$re' > $outputdir"."$field.sort.func-PC.name-regex");
      if ($error_code != 0 )
        {
          gp_message ("abort", $subr_name, "execution terminated");
        }
    }

$re = name_regex ($metric_description_ref, $script_pc_metrics, "calls", $outputdir."calls.sort.func-PC");
  ($error_code, $cmd_output) = execute_system_cmd ("echo '$re' > $outputdir"."calls.sort.func-PC.name-regex");
  if ($error_code != 0 )
    {
      gp_message ("abort", $subr_name, "execution terminated");
    }

if ($g_user_settings{"calltree"}{"current_value"} eq "on")
    {
      $re = name_regex ($metric_description_ref, $script_pc_metrics, "calltree", $outputdir."calltree.sort.func-PC");
      ($error_code, $cmd_output) = execute_system_cmd ("echo '$re' > $outputdir"."calltree.sort.func-PC.name-regex");
      if ($error_code != 0 )
        {
          gp_message ("abort", $subr_name, "execution terminated");
        }
    }

return (0);

} #-- End of subroutine preprocess_function_files

#------------------------------------------------------------------------------
# Print the original list with the command line options.
#------------------------------------------------------------------------------
sub print_command_line_options
{
  my ($identifier_ref) = @_;

my $identifier = ${ $identifier_ref };
  my $msg;

$msg = "The command line options (shown for ease of reference): ";
  printf ("%-9s %s\n", $identifier, ucfirst ($msg));

$msg = join (", ", @CopyOfARGV);
  printf ("%-9s %s\n", $identifier, $msg);

#  printf ("%-9s\n", $identifier);

return (0);

} #-- End of subroutine print_command_line_options

#------------------------------------------------------------------------------
# Print all the errors messages in the buffer.
#------------------------------------------------------------------------------
sub print_errors_buffer
{
  my $subr_name = get_my_name ();

my ($identifier_ref) = @_;

my $ignore_value;
  my $msg;
  my $plural_or_single;
  my $identifier = ${ $identifier_ref };

$plural_or_single = ($g_total_error_count > 1) ? "errors have" : "error has";

if (@g_warning_msgs and $g_warnings)
#------------------------------------------------------------------------------
# Make sure that all warnings are printed in case of an error.  This is to
# avoid that warnings get lost in case the program terminates early.
#------------------------------------------------------------------------------
    {
      $ignore_value = print_warnings_buffer ();
    }

if (not $g_options_printed)
#------------------------------------------------------------------------------
# The options are printed as part of the warnings, so only if the warnings are
# not printed, we need to print them in case of errors.
#------------------------------------------------------------------------------
    {
      $g_options_printed = $TRUE;
      $ignore_value =  print_command_line_options (\$identifier);
    }

$msg  =  "a total of " . $g_total_error_count;
  $msg .=  " fatal " . $plural_or_single . " been detected:";
  printf ("%-9s %s\n", $identifier, ucfirst ($msg));

for my $key (keys @g_error_msgs)
    {
      $msg = $g_error_msgs[$key];
      printf ("%-11s %s\n", $identifier, ucfirst ($msg));
    }

return (0);

} #-- End of subroutine print_errors_buffer

#------------------------------------------------------------------------------
# Print the help overview
#------------------------------------------------------------------------------
sub print_help_info
{
  my $space = " ";

printf("%s\n",
  "Usage: $driver_cmd [OPTION(S)] EXPERIMENT(S)");
  printf("\n");
  printf("%s\n",
  "Process one or more experiments to generate a directory containing the");
  printf("%s\n",
  "index.html file that may be used to browse the experiment data.");
  printf("\n");
  printf("%s\n",
  "Options:");
  printf("\n");
  #-------Marker line - do not go beyond this line ----------------------------
  print_help_line ("--help",
  "Print usage information and exit.");

#-------Marker line - do not go beyond this line ----------------------------
  print_help_line ("--version",
  "Print the version number and exit.");

#-------Marker line - do not go beyond this line ----------------------------
  print_help_line ("--verbose",
  "Enable verbose mode to show diagnostic messages about the");
  print_help_line ("",
  "processing of the data.  By default verbose mode is disabled.");

#-------Marker line - do not go beyond this line ----------------------------
  print_help_line ("-d [<db-vol-size>], --debug[=<db-vol-size>]",
  "Control the printing of run time debug information to assist with");
  print_help_line ("",
  "the troubleshooting, or further development of this tool.");
  print_help_line ("",
  "The <db-vol-size> parameter controls the output volume and is");
  print_help_line ("",
  "one from the list {s | S | m | M | l | L | xl | XL}.");
  print_help_line ("",
  "If db-vol-size is not specified, a modest amount of information");
  print_help_line ("",
  "is printed.  This is equivalent to select size s, or S. The");
  print_help_line ("",
  "volume of data goes up as the size increases.  Note that");
  print_help_line ("",
  "currently l/L is  equivalent to xl/XL, but this is expected to");
  print_help_line ("",
  "change in future updates.  By default debug mode is disabled.");

#-------Marker line - do not go beyond this line ----------------------------
  print_help_line ("--highlight-percentage=<value>",
  "A percentage value in the interval [0,100] to select and color");
  print_help_line ("",
  "code source lines, as well as instructions, that are within this");
  print_help_line ("",
  "percentage of the maximum metric value(s).  A value of zero");
  print_help_line ("",
  "disables this feature.  The default value is 90 (%).");

#-------Marker line - do not go beyond this line ----------------------------
  print_help_line ("-o <dirname>, --output=<dirname>",
  "Use <dirname> as the directory name to store the results in.");
  print_help_line ("",
  "In absence of this option, the default name is display.<n>.html.");
  print_help_line ("",
  "This directory is created in the current directory.  The number");
  print_help_line ("",
  "<n> is the first positive integer number not in use in this");
  print_help_line ("",
  "naming scheme.  An existing directory with the same name is not");
  print_help_line ("",
  "overwritten.  Make sure that umask is set to the correct access");
  print_help_line ("",
  "permissions.");

#-------Marker line - do not go beyond this line --------------------------
  print_help_line ("-O <dirname>, --overwrite=<dirname>",
  "Use <dirname> as the directory name to store the results in.");
  print_help_line ("",
  "In absence of this option, the default name is display.<n>.html.");
  print_help_line ("",
  "This directory is created in the current directory.  The number");
  print_help_line ("",
  "<n> is the first positive integer number not in use in this");
  print_help_line ("",
  "naming scheme.  An existing directory with the same name is");
  print_help_line ("",
  "silently overwritten.  Make sure that umask is set to the");
  print_help_line ("",
  "correct access permissions.");

#-------Marker line - do not go beyond this line --------------------------
  print_help_line ("-q, --quiet",
  "Disable the display of all warning, debug, verbose and any");
  print_help_line ("",
  "other messages.  If enabled, the settings for verbose and debug");
  print_help_line ("",
  "are accepted, but ignored.  With this option, there is no screen");
  print_help_line ("",
  "output, other than errors.  By default quiet mode is disabled");

#-------Marker line - do not go beyond this line --------------------------
  print_help_line ("--nowarnings",
  "Disable the printing of warning messages on stdout.  By default");
  print_help_line ("",
  "warning messages are printed.");

#-------Marker line - do not go beyond this line --------------------------
  printf("\n");
  printf ("%s\n","Report bugs to <https://sourceware.org/bugzilla/>");

return (0);

} #-- End of subroutine print_help_info

#------------------------------------------------------------------------------
# Print a single line as part of the help output.
#
# If the first item is not the empty string, it is considered to be the
# option.  If the length of the option exceeds the limit set by $max_space,
# it is printed by itself and the text is printed on the next line.  Otherwise
# the text follows the option.
#
# To assist with the development of the help text, we check if the total length
# of the line exceeds the max numbers of columns (79 according to the GNU
# coding standards).
#------------------------------------------------------------------------------
sub print_help_line
{
  my $subr_name = get_my_name ();

my ($item, $help_text) = @_;

my $length_item = length ($item);
  my $max_col = 79;
  my $max_space = 14;
  my $no_of_spaces;
  my $pad;
  my $space = " ";
  my $the_message;

if ($length_item > $max_col)
    {
      printf ("Error: $item is $length_item long - exceeds $max_col\n");
      exit (0);
    }
  elsif ( $length_item == 0 )
    {
      $no_of_spaces = $max_space;

$pad = "";
      for my $i (1..$no_of_spaces)
        {
          $pad .= $space;
        }
      $the_message = $pad . $help_text;
    }
  else
    {
    if ($length_item < $max_space)
      {
        $no_of_spaces = $max_space - length ($item);
        $pad = "";
        for my $i (1..$no_of_spaces)
          {
            $pad .= $space;
          }
        $the_message = $item . $pad . $help_text;
      }
    else
      {
        $pad = "";
        for my $i (1..$max_space)
          {
            $pad .= $space;
          }
        printf("%s\n", $item);
        $the_message = $pad . $help_text;
      }
    }

if (length ($the_message) <= $max_col)
    {
      printf ("%s\n", $the_message);
    }
  else
    {
      my $delta = length ($the_message) - $max_col;
      printf ("%s\n", "$the_message - exceeds $max_col by $delta");
      exit (0);
    }

return (0);

} #-- End of subroutine print_help_line

#------------------------------------------------------------------------------
# Print the meta data for each experiment directory.
#------------------------------------------------------------------------------
sub print_meta_data_experiments
{
  my $subr_name = get_my_name ();

my ($mode) = @_;

for my $exp (sort keys %g_exp_dir_meta_data)
    {
      for my $meta (sort keys %{$g_exp_dir_meta_data{$exp}})
        {
          gp_message ($mode, $subr_name, "$exp => $meta = $g_exp_dir_meta_data{$exp}{$meta}");
        }
    }

return (0);

} #-- End of subroutine print_meta_data_experiments

#------------------------------------------------------------------------------
# Brute force subroutine that prints the contents of a structure with function
# level information.  This version is for a top level array structure,
# followed by a hash.
#------------------------------------------------------------------------------
sub print_metric_function_array
{
  my $subr_name = get_my_name ();

my ($metric, $struct_type_name, $target_structure_ref) = @_;

my @target_structure = @{$target_structure_ref};

gp_message ("debugXL", $subr_name, "contents of structure ".$struct_type_name."{".$metric."}:");

for my $fields (sort keys @target_structure)
    {
          for my $elems (sort keys % {$target_structure[$fields]})
            {
              my $msg = $struct_type_name."{$metric}[$fields]{$elems} = ";
              $msg   .= $target_structure[$fields]{$elems};
              gp_message ("debugXL", $subr_name, $msg);
            }
    }

return (0);

} #-- End of subroutine print_metric_function_array

#------------------------------------------------------------------------------
# Brute force subroutine that prints the contents of a structure with function
# level information.  This version is for a top level hash structure.  The
# next level may be another hash, or an array.
#------------------------------------------------------------------------------
sub print_metric_function_hash
{
  my $subr_name = get_my_name ();

my ($sub_struct_type, $metric, $struct_type_name, $target_structure_ref) = @_;

my %target_structure = %{$target_structure_ref};

gp_message ("debugXL", $subr_name, "contents of structure ".$struct_type_name."{".$metric."}:");

for my $fields (sort keys %target_structure)
    {
      gp_message ("debugXL", $subr_name, "metric = $metric fields = $fields");
      if ($sub_struct_type eq "hash_hash")
        {
          for my $elems (sort keys %{$target_structure{$fields}})
            {
              my $txt = $struct_type_name."{$metric}{$fields}{$elems} = ";
              $txt   .= $target_structure{$fields}{$elems};
              gp_message ("debugXL", $subr_name, $txt);
            }
        }
      elsif ($sub_struct_type eq "hash_array")
        {
          my $values = "";
          for my $elems (sort keys @{$target_structure{$fields}})
            {
              $values .= "$target_structure{$fields}[$elems] ";
            }
          gp_message ("debugXL", $subr_name, $struct_type_name."{$metric}{$fields} = $values");
        }
      else
        {
          my $msg = "sub-structure type '$sub_struct_type' is not supported";
          gp_message ("assertion", $subr_name, $msg);
        }
    }
 
  return (0);

} #-- End of subroutine print_metric_function_hash

#------------------------------------------------------------------------------
# Print the opening message.
#------------------------------------------------------------------------------
sub print_opening_message
{
  my $subr_name = get_my_name ();
#------------------------------------------------------------------------------
# Since the second argument is an array, we pass it in by reference.  The
# alternative is to make it the last argument.
#------------------------------------------------------------------------------
  my ($outputdir, $exp_dir_list_ref, $time_percentage_multiplier) = @_;

my @exp_dir_list = @{$exp_dir_list_ref};

my $msg;
  my $no_of_dirs = scalar (@exp_dir_list);
#------------------------------------------------------------------------------
# Build a comma separated list with all directory names.  If there is only one
# entry, the leading comma will not be inserted.
#------------------------------------------------------------------------------
  my $dir_list   = join (", ", @exp_dir_list);

#------------------------------------------------------------------------------
# If there are at least two entries, find the last comma and replace it by
# " and".  Note that we know there is at least one comma, so the value
# returned by rindex () cannot be -1.
#------------------------------------------------------------------------------
  if ($no_of_dirs > 1)
    {
      my $last_comma   = rindex ($dir_list, ",");
      my $ignore_value = substr ($dir_list, $last_comma, 1, " and");
    }
  $msg = "start $tool_name, generating directory $outputdir from $dir_list";

gp_message ("verbose", $subr_name, $msg);

if ($time_percentage_multiplier < 1.0)
    {
      $msg = "Handle at least ";
    }
  else
    {
      $msg = "Handle ";
    }

$msg .= ($time_percentage_multiplier*100.0)."% of the time";
 
  gp_message ("verbose", $subr_name, $msg);

} #-- End of subroutine print_opening_message

my ($mode, $tool_name, $binutils_version) = @_;

my $header_limit = 60;
  my $dashes = "-";

#------------------------------------------------------------------------------
# Generate the dashed line
#------------------------------------------------------------------------------
  for (2 .. $header_limit)
    {
      $dashes .= "-";
    }

gp_message ($mode, $subr_name, $dashes);
    gp_message ($mode, $subr_name, "Tool name: $tool_name");
    gp_message ($mode, $subr_name, "Version  : $binutils_version");
    gp_message ($mode, $subr_name, "Date     : " . localtime ());
    gp_message ($mode, $subr_name, $dashes);

} #-- End of subroutine print_program_header

#------------------------------------------------------------------------------
# Print a comment string, followed by the values of the options. The list
# with the keywords is sorted alphabetically.
#
# The value stored in $mode is passed on to gp_message ().  The intended use
# for this is to call this function in verbose and/or debug mode.
#
# The comment string is converted to uppercase.
#
# In case the length of the comment exceeds the length of the dashed line,
# the comment line is allowed to stick out to the right.
#
# If the length of the comment is less than the dashed line, it is centered
# relative to the # length of the dashed line.

# If the length of the comment and this line do not divide, an extra space is
# added to the left of the comment.
#
# For example, if the comment is 55 long, there are 5 spaces to be distributed.
# There will be 3 spaces, followed by the comment.
#------------------------------------------------------------------------------
sub print_table_user_settings
{
  my $subr_name = get_my_name ();

my ($mode, $comment) = @_;

my $data_type;
  my $debug_size_value = $g_user_settings{"debug"}{"current_value"};
  my $db_size;
  my $defined;
  my $keyword;
  my $leftover;
  my $padding;
  my $user_option;
  my $value;

my $HEADER_LIMIT = 79;
  my $header = sprintf ("%-20s   %-22s   %8s   %s",
                        "keyword", "option", "user set", "internal value");

#------------------------------------------------------------------------------
# Generate the dashed line
#------------------------------------------------------------------------------
  my $dashes = "-";
  for (2 .. $HEADER_LIMIT)
    {
      $dashes .= "-";
    }

#------------------------------------------------------------------------------
# Determine the padding needed to the left of the comment.
#------------------------------------------------------------------------------
  my $length_comment = length ($comment);

$leftover = $length_comment%2;

if ($length_comment <= ($HEADER_LIMIT-2))
    {
      $padding = ($HEADER_LIMIT - $length_comment + $leftover)/2;
    }
  else
    {
      $padding = 0;
    }
 
#------------------------------------------------------------------------------
# Generate the first blank part of the line.
#------------------------------------------------------------------------------
  my $blank_line = "";
  for (1 .. $padding)
    {
      $blank_line .= " ";
    }

#------------------------------------------------------------------------------
# Add the comment line with the first letter in uppercase.
#------------------------------------------------------------------------------
  my $final_comment = $blank_line.ucfirst ($comment);

gp_message ($mode, $subr_name, $dashes);
  gp_message ($mode, $subr_name, $final_comment);
  gp_message ($mode, $subr_name, $dashes);
  gp_message ($mode, $subr_name, $header);
  gp_message ($mode, $subr_name, $dashes);

#------------------------------------------------------------------------------
# Print a line for each option. The list is sorted alphabetically.
#------------------------------------------------------------------------------
  for my $key  (sort keys %g_user_settings)
    {
      $keyword     = $key;
      $user_option = $g_user_settings{$key}{"option"};
      $defined     = ($g_user_settings{$key}{"defined"} ? "set" : "not set");
      $data_type   = $g_user_settings{$key}{"data_type"};

if (defined ($g_user_settings{$key}{"current_value"}))
        {
          $value = $g_user_settings{$key}{"current_value"};
          if ($data_type eq "boolean")
            {
              $value = $value ? "on" : "off";
            }
#------------------------------------------------------------------------------
# In case of the debug option, we add the "(size)" string to remind the user
# that this is the size.
#------------------------------------------------------------------------------
          if ($key eq "debug")
            {
              $db_size = ($debug_size_value eq "on") ? "s" : $debug_size_value;
              $value = $db_size . " (size)";
            }
        }
      else
        {
          $value = "undefined";
        }

my $print_line = sprintf ("%-20s   %-22s   %8s   %s",
                                $keyword, $user_option, $defined, $value);

gp_message ($mode, $subr_name, $print_line);
    }
} #-- End of subroutine print_table_user_settings

#------------------------------------------------------------------------------
# Dump the contents of nested hash "g_user_settings".  Some simple formatting
# is applied to make it easier to distinguish the various values.
#------------------------------------------------------------------------------
sub print_user_settings
{
  my $subr_name = get_my_name ();

my ($mode, $comment) = @_;

my $keyword_value_pair;

gp_message ($mode, $subr_name, $comment);

for my $key (keys %g_user_settings)
    {
      my $print_line = sprintf ("%-20s =>", $key);
      for my $fields (sort keys %{ $g_user_settings{$key} })
        {
          if (defined ($g_user_settings{$key}{$fields}))
            {
              $keyword_value_pair = $fields." = ".$g_user_settings{$key}{$fields};
            }
          else
            {
              $keyword_value_pair = $fields." = ". "undefined";
            }
           $print_line = join ("  ", $print_line, $keyword_value_pair);
        }
        gp_message ($mode, $subr_name, $print_line);
    }
} #-- End of subroutine print_user_settings

#------------------------------------------------------------------------------
# Print the version number and license information.
#------------------------------------------------------------------------------
sub print_version_info
{
  print "$version_info\n";
  print "Copyright (C) 2023 Free Software Foundation, Inc.\n";
  print "License GPLv3+: GNU GPL version 3 or later <https://gnu.org/licenses/gpl.html>.\n";
  print "This is free software: you are free to change and redistribute it.\n";
  print "There is NO WARRANTY, to the extent permitted by law.\n";

return (0);

} #-- End of subroutine print_version_info

#------------------------------------------------------------------------------
# Dump all the warning messages in the buffer.
#------------------------------------------------------------------------------
sub print_warnings_buffer
{
  my $subr_name = get_my_name ();

my $ignore_value;
  my $msg;

if (not $g_options_printed)
#------------------------------------------------------------------------------
# Only if the options have not yet been printed, print them.
#------------------------------------------------------------------------------
    {
      $g_options_printed = $TRUE;
      $ignore_value = print_command_line_options (\$g_warn_keyword);
    }

for my $i (keys @g_warning_msgs)
    {
      $msg = $g_warning_msgs[$i];
      if ($msg =~ /^$g_html_new_line/)
        {
          $msg =~ s/$g_html_new_line//;
          printf ("%-9s\n", $g_warn_keyword);
        }
      printf ("%-9s %s\n", $g_warn_keyword, ucfirst ($msg));
    }

return (0);

} #-- End of subroutine print_warnings_buffer

#------------------------------------------------------------------------------
# Process the call tree input data and generate HTML output.
#------------------------------------------------------------------------------
sub process_calltree
{
  my $subr_name = get_my_name ();

my ($function_info_ref, $function_address_info_ref, $addressobjtextm_ref,
       $input_string) = @_;

my @function_info         = @{ $function_info_ref };
  my %function_address_info = %{ $function_address_info_ref };
  my %addressobjtextm       = %{ $addressobjtextm_ref };

my $outputdir = append_forward_slash ($input_string);

my @call_tree_data = ();

my $LANG              = $g_locale_settings{"LANG"};
  my $decimal_separator = $g_locale_settings{"decimal_separator"};

my $infile  = $outputdir . "calltree";
  my $outfile = $outputdir . "calltree.html";

open (CALL_TREE_IN, "<", $infile)
    or die ("Not able to open calltree file $infile for reading - '$!'");
  gp_message ("debug", $subr_name, "opened file $infile for reading");

open (CALL_TREE_OUT, ">", $outfile)
    or die ("Not able to open $outfile for writing - '$!'");
  gp_message ("debug", $subr_name, "opened file $outfile for writing");

gp_message ("debug", $subr_name, "building calltree file $outfile");

#------------------------------------------------------------------------------
# The directory name is potentially used below, but since it is a constant,
# we get it here and only once.
#------------------------------------------------------------------------------
#  my ($ignore_file_name, $directory_name, $ignore_suffix) = fileparse ($infile,"");
#  gp_message ("debug", $subr_name, "directory_name = $directory_name");

#------------------------------------------------------------------------------
# Generate some of the structures used in the HTML output.
#------------------------------------------------------------------------------
  my $file_title      = "Call Tree overview";
  my $html_header     = ${ create_html_header (\$file_title) };
  my $html_home_right = ${ generate_home_link ("right") };

my $page_title    = "Call Tree View";
  my $size_text     = "h2";
  my $position_text = "center";
  my $html_title_header = ${ generate_a_header (
                            \$page_title,
                            \$size_text,
                            \$position_text) };

#------------------------------------------------------------------------------
# Get the acknowledgement, return to main link, and final html statements.
#------------------------------------------------------------------------------
  my $html_home_left       = ${ generate_home_link ("left") };
  my $html_acknowledgement = ${ create_html_credits () };
  my $html_end             = ${ terminate_html_document () };

#------------------------------------------------------------------------------
# Read all of the file into array with the name call_tree_data.
#------------------------------------------------------------------------------
  chomp (@call_tree_data = <CALL_TREE_IN>);
  close (CALL_TREE_IN);

#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
# Process the data here and generate the HTML lines.
#------------------------------------------------------------------------------
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# Print the top part of the HTML file.
#------------------------------------------------------------------------------
  print CALL_TREE_OUT $html_header;
  print CALL_TREE_OUT $html_home_right;
  print CALL_TREE_OUT $html_title_header;

#------------------------------------------------------------------------------
# Print the generated HTML structures here.
#------------------------------------------------------------------------------
##  print CALL_TREE_OUT "$_" for @whatever;
##  print CALL_TREE_OUT "<pre>\n";
##  print CALL_TREE_OUT "$_\n" for @whatever2;
##  print CALL_TREE_OUT "</pre>\n";

#------------------------------------------------------------------------------
# Print the last part of the HTML file.
#------------------------------------------------------------------------------
  print CALL_TREE_OUT $html_home_left;
  print CALL_TREE_OUT "<br>\n";
  print CALL_TREE_OUT $html_acknowledgement;
  print CALL_TREE_OUT $html_end;

close (CALL_TREE_OUT);

return (0);

} #-- End of subroutine process_calltree

#------------------------------------------------------------------------------
# Process the generated experiment info file(s).
#------------------------------------------------------------------------------
sub process_experiment_info
{
  my $subr_name = get_my_name ();

my ($experiment_data_ref) = @_;

my @exp_info;
  my @experiment_data = @{ $experiment_data_ref };

my $exp_id;
  my $exp_name;
  my $exp_data_file;
  my $input_line;
  my $target_cmd;
  my $hostname ;
  my $OS;
  my $page_size;
  my $architecture;
  my $start_date;
  my $end_experiment;
  my $data_collection_duration;
  my $total_thread_time;
  my $user_cpu_time;
  my $user_cpu_percentage;
  my $system_cpu_time;
  my $system_cpu_percentage;
  my $sleep_time;
  my $sleep_percentage;

#------------------------------------------------------------------------------
# Define the regular expressions used to capture the info.
#------------------------------------------------------------------------------
# Target command (64-bit): './../bindir/mxv-pthreads.exe -m 3000 -n 2000 -t 2'

my $target_cmd_regex = '\s*Target command\s+($.+$):\s+\'(.+)\'';

# Host `ruudvan-vm-haswell-2-20210609', OS `Linux 5.4.17-2102.202.5.el8uek.x86_64', page size 4096, architecture `x86_64'

my $host_system_regex = '\s*Host\s+\`(.+)\',\s+OS\s+\`(.+)\',\s+page size\s+(\d+),\s+architecture\s+\`(.+)\'';

# Experiment started Mon Aug 30 13:03:20 2021

my $start_date_regex = '\s*Experiment started\s+(.+)';

# Experiment Ended: 1.812441219

my $end_experiment_regex = '\s*Experiment Ended:\s+(.+)';

# Data Collection Duration: 1.812441219

my $data_collection_duration_regex = '\s*Data Collection Duration:\s+(.+)';

#                           Total Thread Time (sec.): 1.812

my $total_thread_time_regex = '\s*Total Thread Time (sec.):\s+(.+)';

#                                          User CPU: 1.685 ( 95.0%)

my $user_cpu_regex = '\s*User CPU:\s+(.+)\s+$\s*(.+)$';

#                                        System CPU: 0.088 (  5.0%)

my $system_cpu_regex = '\s*System CPU:\s+(.+)\s+$\s*(.+)$';

#                                             Sleep: 0.    (  0. %)

my $sleep_regex = '\s*Sleep:\s+(.+)\s+$\s*(.+)$';

#------------------------------------------------------------------------------
# Scan the experiment data and select the info of interest.
#------------------------------------------------------------------------------
  for my $i (sort keys @experiment_data)
    {
      $exp_id        = $experiment_data[$i]{"exp_id"};
      $exp_name      = $experiment_data[$i]{"exp_name_full"};
      $exp_data_file = $experiment_data[$i]{"exp_data_file"};

my $msg = "exp_id = $exp_id name = $exp_name file = $exp_data_file";
      gp_message ("debug", $subr_name, $msg);

open (EXPERIMENT_INFO, "<", $exp_data_file)
        or die ("$subr_name - unable to open file $exp_data_file for reading '$!'");
      gp_message ("debug", $subr_name, "opened file $exp_data_file for reading");

chomp (@exp_info = <EXPERIMENT_INFO>);

#------------------------------------------------------------------------------
# Process the info for the current experiment.
#------------------------------------------------------------------------------
      for my $line (0 .. $#exp_info)
        {
          $input_line = $exp_info[$line];

my $msg = "exp_id = $exp_id: input_line = $input_line";
          gp_message ("debugM", $subr_name, $msg);

if ($input_line =~ /$target_cmd_regex/)
            {
              $target_cmd = $2;
              gp_message ("debugM", $subr_name, "$exp_id => $target_cmd");
              $experiment_data[$i]{"target_cmd"} = $target_cmd;
            }
          elsif ($input_line =~ /$host_system_regex/)
            {
              $hostname  = $1;
              $OS        = $2;
              $page_size = $3;
              $architecture = $4;
              gp_message ("debugM", $subr_name, "$exp_id => $hostname $OS $page_size $architecture");
              $experiment_data[$i]{"hostname"} = $hostname;
              $experiment_data[$i]{"OS"} = $OS;
              $experiment_data[$i]{"page_size"} = $page_size;
              $experiment_data[$i]{"architecture"} = $architecture;
            }
          elsif ($input_line =~ /$start_date_regex/)
            {
              $start_date = $1;
              gp_message ("debugM", $subr_name, "$exp_id => $start_date");
              $experiment_data[$i]{"start_date"} = $start_date;
            }
          elsif ($input_line =~ /$end_experiment_regex/)
            {
              $end_experiment = $1;
              gp_message ("debugM", $subr_name, "$exp_id => $end_experiment");
              $experiment_data[$i]{"end_experiment"} = $end_experiment;
            }
          elsif ($input_line =~ /$data_collection_duration_regex/)
            {
              $data_collection_duration = $1;
              gp_message ("debugM", $subr_name, "$exp_id => $data_collection_duration");
              $experiment_data[$i]{"data_collection_duration"} = $data_collection_duration;
            }
#------------------------------------------------------------------------------
#                                       Start Label: Total
#                                          End Label: Total
#                                  Start Time (sec.): 0.000
#                                    End Time (sec.): 1.812
#                                    Duration (sec.): 1.812
#                           Total Thread Time (sec.): 1.812
#                          Average number of Threads: 1.000
#
#                               Process Times (sec.):
#                                           User CPU: 1.666 ( 91.9%)
#                                         System CPU: 0.090 (  5.0%)
#                                           Trap CPU: 0.    (  0. %)
#                                          User Lock: 0.    (  0. %)
#                                    Data Page Fault: 0.    (  0. %)
#                                    Text Page Fault: 0.    (  0. %)
#                                  Kernel Page Fault: 0.    (  0. %)
#                                            Stopped: 0.    (  0. %)
#                                           Wait CPU: 0.    (  0. %)
#                                              Sleep: 0.056 (  3.1%)
#------------------------------------------------------------------------------
          elsif ($input_line =~ /$total_thread_time_regex/)
            {
              $total_thread_time = $1;
              gp_message ("debugM", $subr_name, "$exp_id => $total_thread_time");
              $experiment_data[$i]{"total_thread_time"} = $total_thread_time;
            }
          elsif ($input_line =~ /$user_cpu_regex/)
            {
              $user_cpu_time       = $1;
              $user_cpu_percentage = $2;
              gp_message ("debugM", $subr_name, "$exp_id => $user_cpu_time $user_cpu_percentage");
              $experiment_data[$i]{"user_cpu_time"} = $user_cpu_time . "&nbsp; (" . $user_cpu_percentage . ")";
              $experiment_data[$i]{"user_cpu_percentage"} = $user_cpu_percentage;
            }
          elsif ($input_line =~ /$system_cpu_regex/)
            {
              $system_cpu_time       = $1;
              $system_cpu_percentage = $2;
              gp_message ("debugM", $subr_name, "$exp_id => $system_cpu_time $system_cpu_percentage");
              $experiment_data[$i]{"system_cpu_time"} = $system_cpu_time . "&nbsp; (" . $system_cpu_percentage . ")";
              $experiment_data[$i]{"system_cpu_percentage"} = $system_cpu_percentage;
            }
          elsif ($input_line =~ /$sleep_regex/)
            {
              $sleep_time       = $1;
              $sleep_percentage = $2;
              $experiment_data[$i]{"sleep_time"} = $sleep_time . "&nbsp; (" . $sleep_percentage . ")";
              $experiment_data[$i]{"sleep_percentage"} = $sleep_percentage;

my $msg = "exp_id = $exp_id => sleep_time = $sleep_time " .
                        "sleep_percentage = $sleep_percentage";
              gp_message ("debugM", $subr_name, $msg);
            }
        }
    }

for my $keys (0 .. $#experiment_data)
    {
      for my $fields (sort keys %{ $experiment_data[$keys] })
        {
          my $msg = "experiment_data[$keys]{$fields} = " .
             $experiment_data[$keys]{$fields};
          gp_message ("debugM", $subr_name, $msg);
        }
    }

return (\@experiment_data);

} #-- End of subroutine process_experiment_info

#------------------------------------------------------------------------------
# TBD
#------------------------------------------------------------------------------
sub process_function_files
{
  my $subr_name = get_my_name ();

my ($exp_dir_list_ref, $executable_name, $time_percentage_multiplier,
      $summary_metrics, $process_all_functions, $elf_loadobjects_found,
      $outputdir, $sort_fields_ref, $function_info_ref,
      $function_address_and_index_ref, $LINUX_vDSO_ref,
      $metric_description_ref, $elf_arch, $base_va_executable,
      $ARCHIVES_MAP_NAME, $ARCHIVES_MAP_VADDR, $elf_rats_ref) = @_;

my $old_fsummary;
  my $total_attributed_time;
  my $current_attributed_time;
  my $value;

my @exp_dir_list               = @{ $exp_dir_list_ref };
  my @function_info              = @{ $function_info_ref };
  my %function_address_and_index = %{ $function_address_and_index_ref };
  my @sort_fields                = @{ $sort_fields_ref };
  my %metric_description         = %{ $metric_description_ref };
  my %elf_rats                   = %{ $elf_rats_ref };

#------------------------------------------------------------------------------
# The regex section.
#
# TBD: Remove the part regarding clones. Legacy.
#------------------------------------------------------------------------------
  my $find_clone_regex    = '^(.*)(\s+--\s+cloned\s+version\s+\[)([^]]+)(\])';
  my $remove_number_regex = '^\d+:';
  my $replace_quote_regex = '"/\"';

my %addressobj_index = ();
  my %function_address_info = ();
  my $function_address_info_ref;

$outputdir = append_forward_slash ($outputdir);

my %functions_per_metric_indexes = ();
  my $functions_per_metric_indexes_ref;

my %functions_per_metric_first_index = ();
  my $functions_per_metric_first_index_ref;

my %routine_list = ();
  my %handled_routines = ();

#------------------------------------------------------------------------------
# TBD: Name cleanup needed.
#------------------------------------------------------------------------------

my $number_of_metrics;
  my $expr_name;
  my $routine;
  my $tmp;
  my $loadobj;
  my $PCA;
  my $address_field;
  my $limit_txt;
  my $n_metrics_text;
  my $disfile;
  my $srcfile;
  my $RIN;
  my $gp_listings_cmd;
  my $gp_display_text_cmd;
  my $ignore_value;

my $result_file   = $outputdir . "gp-listings.out";
  my $gp_error_file = $outputdir . "gp-listings.err";

my $convert_to_dot    = $g_locale_settings{"convert_to_dot"};
  my $decimal_separator = $g_locale_settings{"decimal_separator"};
  my $length_of_string  = length ($outputdir);

$expr_name = join (" ", @exp_dir_list);

gp_message ("debug", $subr_name, "expr_name = $expr_name");

#------------------------------------------------------------------------------
# Loop over the files in $outputdir.
#------------------------------------------------------------------------------
  while (glob ($outputdir.'*.sort.func-PC'))
    {
      my $metric;
      my $infile;
      my $ignore_value;
      my $suffix_not_used;

$infile = $_;

($metric, $ignore_value, $suffix_not_used) = fileparse ($infile, ".sort.func-PC");

gp_message ("debugXL", $subr_name, "suffix_not_used = $suffix_not_used");
      gp_message ("debugXL", $subr_name, "func-PC->$infile<- metric->$metric<-");

# Function_info creates the functions files from the PC ones
   # as well as culling PC and metric information

($function_address_info_ref,
       $functions_per_metric_first_index_ref,
       $functions_per_metric_indexes_ref) = function_info (
                                              $outputdir,
                                              $infile,
                                              $metric,
                                              $LINUX_vDSO_ref);

@{$function_address_info{$metric}}            = @{$function_address_info_ref};
      %{$functions_per_metric_indexes{$metric}}     = %{$functions_per_metric_indexes_ref};
      %{$functions_per_metric_first_index{$metric}} = %{$functions_per_metric_first_index_ref};

$ignore_value = print_metric_function_array ($metric,
                                                   "function_address_info",
                                                   \@{$function_address_info{$metric}});
      $ignore_value = print_metric_function_hash ("hash_hash",  $metric,
                                                  "functions_per_metric_first_index",
                                                  \%{$functions_per_metric_first_index{$metric}});
      $ignore_value = print_metric_function_hash ("hash_array", $metric,
                                                  "functions_per_metric_indexes",
                                                  \%{$functions_per_metric_indexes{$metric}});
    }

#------------------------------------------------------------------------------
# Get header info for use in post processing er_html output
#------------------------------------------------------------------------------
  gp_message ("debugXL", $subr_name, "get_hdr_info section");

get_hdr_info ($outputdir, $outputdir."functions.sort.func");

for my $field (@sort_fields)
    {
      get_hdr_info ($outputdir, $outputdir."$field.sort.func");
    }

#------------------------------------------------------------------------------
# Caller-callee
#------------------------------------------------------------------------------
  get_hdr_info ($outputdir, $outputdir."calls.sort.func");

#------------------------------------------------------------------------------
# Calltree
#------------------------------------------------------------------------------
  if ($g_user_settings{"calltree"}{"current_value"} eq "on")
    {
      get_hdr_info ($outputdir, $outputdir."calltree.sort.func");
    }

gp_message ("debug", $subr_name, "process functions");

my $scriptfile     = $outputdir.'gp-script';
  my $script_metrics = "$summary_metrics";
  my $func_limit     = $g_user_settings{"func_limit"}{"current_value"};

open (SCRIPT, ">", $scriptfile)
    or die ("Unable to create script file $scriptfile - '$!'");
  gp_message ("debug", $subr_name, "opened script file $scriptfile for writing");

print SCRIPT "# limit $func_limit\n";
  print SCRIPT "limit $func_limit\n";
  print SCRIPT "# thread_select all\n";
  print SCRIPT "thread_select all\n";
  print SCRIPT "# metrics $script_metrics\n";
  print SCRIPT "metrics $script_metrics\n";

for my $metric (@sort_fields)
    {
      gp_message ("debug", $subr_name, "handling $metric->$metric_description{$metric}");

$total_attributed_time   = 0;
      $current_attributed_time = 0;

$value = $function_address_info{$metric}[0]{"metric_value"}; # <Total>
      if ($convert_to_dot)
        {
          $value =~ s/$decimal_separator/\./;
        }
      $total_attributed_time = $value;

#------------------------------------------------------------------------------
# start at 1 - skipping <Total>
#------------------------------------------------------------------------------
      for my $INDEX (1 .. $#{$function_address_info{$metric}})
        {
#------------------------------------------------------------------------------
#Looking to handle at least 99% of the time - or what the user asked for
#------------------------------------------------------------------------------
          $value   = $function_address_info{$metric}[$INDEX]{"metric_value"};
          $routine = $function_address_info{$metric}[$INDEX]{"routine"};

gp_message ("debugXL", $subr_name, " total $total_attributed_time current $current_attributed_time");
          gp_message ("debugXL", $subr_name, "  (found routine $routine : value $value)");

if ($convert_to_dot)
            {
              $value =~ s/$decimal_separator/\./;
            }

if ( ($value > $total_attributed_time*(1-$time_percentage_multiplier)) or
               ( ($total_attributed_time == 0) and ($value>0) ) or
               $process_all_functions)
            {
              $PCA = $function_address_info{$metric}[$INDEX]{"PC Address"};

if (not exists ($functions_per_metric_first_index{$metric}{$routine}{$PCA}))
                {
                  gp_message ("debugXL", $subr_name, "not exists: functions_per_metric_first_index{$metric}{$routine}{$PCA}");
                }
              if (not exists ($function_address_and_index{$routine}{$PCA}))
                {
                  gp_message ("debugXL", $subr_name, "not exists: function_address_and_index{$routine}{$PCA}");
                }

if (exists ($functions_per_metric_first_index{$metric}{$routine}{$PCA}) and
                  exists ($function_address_and_index{$routine}{$PCA}))
                {
#------------------------------------------------------------------------------
# handled_routines now contains $RI from "first_metric" (?)
#------------------------------------------------------------------------------
                  $handled_routines{$function_address_and_index{$routine}{$PCA}} = 1;
                  my $description = ${ retrieve_metric_description (\$metric, \%metric_description) };
                  if ($metric_description{$metric} =~ /Exclusive Total CPU Time/)
                    {
                      $routine_list{$routine} = 1
                    }

gp_message ("debugXL", $subr_name, " $routine is candidate");
                }
              else
                {
                  die ("internal error for metric $metric and routine $routine");
                }

$current_attributed_time += $value;
            }
        }
    }
#------------------------------------------------------------------------------
# Sort numerically in ascending order.
#------------------------------------------------------------------------------
  for my $routine_index (sort {$a <=> $b} keys %handled_routines)
    {
      $routine = $function_info[$routine_index]{"routine"};
      gp_message ("debugXL", $subr_name, "routine_index = $routine_index routine = $routine");
      next unless $routine_list{$routine};

# not used      $source = $function_info[$routine_index]{"Source File"};

$function_info[$routine_index]{"srcline"} = "";
      $address_field = $function_info[$routine_index]{"addressobjtext"};

#------------------------------------------------------------------------------
# Strip the internal number from the address field.
#------------------------------------------------------------------------------
      $address_field =~ s/$remove_number_regex//;

##      $disfile = "file\.$routine_index\.dis";
      $disfile = "file." . $routine_index . "." . $g_html_base_file_name{"disassembly"};
      $srcfile = "";
      $srcfile = "file\.$routine_index\.src.txt";

#------------------------------------------------------------------------------
# If the file is unknown, we can disassemble anyway and add disassembly
# to the script.
#------------------------------------------------------------------------------
      print SCRIPT "# outfile $outputdir"."$disfile\n";
      print SCRIPT "outfile $outputdir"."$disfile\n";
#------------------------------------------------------------------------------
# TBD: Legacy. Not sure why this is needed, but it won't harm things. I hope.
#------------------------------------------------------------------------------
      $tmp = $routine;
      $tmp =~ s/$replace_quote_regex//g;
      print SCRIPT "# disasm \"$tmp\" $address_field\n";
#------------------------------------------------------------------------------
## TBD: adding the address is not supported.  Need to find a way to figure
## out the ID of the function.
##      print SCRIPT "disasm \"$tmp\" $address_field\n";
##      print SCRIPT "source \"$tmp\" $address_field\n";
#------------------------------------------------------------------------------
      print SCRIPT "disasm \"$tmp\"\n";
      if ($srcfile=~/file/)
        {
          print SCRIPT "# outfile $outputdir"."$srcfile\n";
          print SCRIPT "outfile $outputdir"."$srcfile\n";
          print SCRIPT "# source \"$tmp\" $address_field\n";
          print SCRIPT "source \"$tmp\"\n";
        }

if ($routine =~ /$find_clone_regex/)
        {
          my ($clone_routine) = $1.$2.$3.$4;
          my ($clone) = $3;
        }
     }
  close SCRIPT;

#------------------------------------------------------------------------------
# Remember the number of handled routines depends on the limit setting passed
# to er_print together with the sorting order on the metrics, which usually results
# in different routines at the top. Thus $RIN below can be greater than the limit.
#------------------------------------------------------------------------------

$RIN = scalar (keys %handled_routines);

if (!$func_limit)
    {
      $limit_txt = "unlimited";
    }
  else
    {
      $limit_txt = $func_limit - 1;
  }

$number_of_metrics = scalar (@sort_fields);

$n_metrics_text = ($number_of_metrics == 1) ? "metric" : "metrics";

gp_message ("debugXL", $subr_name, "built function list with $RIN functions");
  gp_message ("debugXL", $subr_name, "$number_of_metrics $n_metrics_text and a function limit of $limit_txt");

# add ELF program header offset

for my $routine_index (sort {$a <=> $b} keys %handled_routines)
    {
      $routine = $function_info[$routine_index]{"routine"};
      $loadobj = $function_info[$routine_index]{"Load Object"};

gp_message ("debugXL", $subr_name, "routine = $routine loadobj = $loadobj elf_arch = $elf_arch");

if ($loadobj ne '')
        {
    # <Truncated-stack> is associated with <Total>. Its load object is <Total>
          if ($loadobj eq "<Total>")
            {
              next;
            }
    # Have seen a routine called <Unknown>. Its load object is <Unknown>
          if ($loadobj eq "<Unknown>")
            {
              next;
            }
###############################################################################
## RUUD: The new approach gives a different result. Investigate this.
#
# Turns out the new code improves the result.  The addresses are now correct
# and as a result, more ftag's are created later on.
###############################################################################
          gp_message ("debugXL", $subr_name, "before function_info[$routine_index]{addressobj} = $function_info[$routine_index]{'addressobj'}");

$function_info[$routine_index]{"addressobj"} += bigint::hex (
                                                determine_base_va_address (
                                                  $executable_name,
                                                  $base_va_executable,
                                                  $loadobj,
                                                  $routine));
          $addressobj_index{$function_info[$routine_index]{"addressobj"}} = $routine_index;

gp_message ("debugXL", $subr_name, "after  function_info[$routine_index]{addressobj} = $function_info[$routine_index]{'addressobj'}");
          gp_message ("debugXL", $subr_name, "after  addressobj_index{function_info[$routine_index]{addressobj}} = $addressobj_index{$function_info[$routine_index]{'addressobj'}}");
        }
    }

#------------------------------------------------------------------------------
# Get the disassembly and source code output.
#------------------------------------------------------------------------------
  $gp_listings_cmd = "$GP_DISPLAY_TEXT -limit $func_limit -viewmode machine " .
                     "-compare off -script $scriptfile $expr_name";

$gp_display_text_cmd = "$gp_listings_cmd 1> $result_file 2>> $gp_error_file";

gp_message ("debugXL", $subr_name,"gp_display_text_cmd = $gp_display_text_cmd");

gp_message ("debug", $subr_name, "calling $GP_DISPLAY_TEXT to produce disassembly and source code output");

my ($error_code, $cmd_output) = execute_system_cmd ($gp_display_text_cmd);

return (\@function_info, \%function_address_info, \%addressobj_index);

} #-- End of subroutine process_function_files

#------------------------------------------------------------------------------
# Process the information found in the function overview file passed in.
#
# Example input:
#
# Current Sort Metric: Exclusive Total CPU Time ( e.totalcpu )
# Functions sorted by metric: Exclusive Total CPU Time
#
# PC Addr.       Name              Excl.     Excl. CPU  Excl.         Excl.         Excl.   Excl.
#                                  Total     Cycles     Instructions  Last-Level    IPC     CPI
#                                  CPU sec.   sec.      Executed      Cache Misses
# 1:0x00000000   <Total>           3.713     4.256      15396819712   27727992       1.577  0.634
# 2:0x000021ae   mxv_core          3.532     4.116      14500538992   27527781       1.536  0.651
# 2:0x00001f7b   init_data         0.070     0.084         64020034     200211       0.333  3.000
#------------------------------------------------------------------------------
sub process_function_overview
{
  my $subr_name = get_my_name ();

my ($metric_ref, $exp_type_ref, $summary_metrics_ref, $number_of_metrics_ref,
      $function_info_ref, $function_view_structure_ref, $overview_file_ref) = @_;

my $metric                  = ${ $metric_ref };
  my $exp_type                = ${ $exp_type_ref };
  my $summary_metrics         = ${ $summary_metrics_ref };
  my $number_of_metrics       = ${ $number_of_metrics_ref };
  my @function_info           = @{ $function_info_ref };
  my %function_view_structure = %{ $function_view_structure_ref };
  my $overview_file           = ${ $overview_file_ref };

my $all_metrics;
  my $decimal_separator = $g_locale_settings{"decimal_separator"};
  my $length_of_block;
  my $elements_in_name;
  my $full_hex_address;
  my $header_line;
  my $hex_address;
  my $html_line;
  my $input_line;
  my $marker;
  my $name_regex;
  my $no_of_fields;
  my $metrics_length;
  my $missing_digits;
  my $msg;
  my $remaining_part_header;
  my $routine;
  my $routine_length;
  my $scan_header        = $FALSE;
  my $scan_function_data = $FALSE;
  my $string_length;
  my $total_header_lines;

my @address_field           = ();
  my @fields                  = ();
  my @function_data           = ();
  my @function_names          = ();
  my @function_view_array     = ();
  my @function_view_modified  = ();
  my @header_lines            = ();
  my @metrics_part            = ();
  my @metric_values           = ();

#------------------------------------------------------------------------------
# The regex section.
#------------------------------------------------------------------------------
  my $header_name_regex     = '(.*\.)(\s+)(Name)\s+(.*)';
  my $total_marker_regex    = '\s*(\d+:0x[a-fA-F0-9]+)\s+(<Total>)\s+(.*)';
  my $empty_line_regex      = '^\s*$';
  my $catch_all_regex       = '\s*(.*)';
  my $get_hex_address_regex = '(\d+):0x(\S+)';
  my $get_addr_offset_regex = '^@\d+:';
  my $zero_dot_at_end_regex = '[\w0-9' . $decimal_separator . ']*(0' . $decimal_separator . '$)';
  my $backward_slash_regex  = '\/';

$msg = "enter subroutine " . $subr_name;
  gp_message ("debug", $subr_name, $msg);

#------------------------------------------------------------------------------
  if (is_file_empty ($overview_file))
    {
      gp_message ("assertion", $subr_name, "file $overview_file is empty");
    }

open (FUNC_OVERVIEW, "<", $overview_file)
    or die ("$subr_name - unable to open file $overview_file for reading '$!'");
  gp_message ("debug", $subr_name, "opened file $overview_file for reading");

gp_message ("debug", $subr_name, "processing file for exp_type = $exp_type");

gp_message ("debugM", $subr_name, "header_name_regex  = $header_name_regex");
  gp_message ("debugM", $subr_name, "total_marker_regex = $total_marker_regex");
  gp_message ("debugM", $subr_name, "empty_line_regex   = $empty_line_regex");
  gp_message ("debugM", $subr_name, "catch_all_regex    = $catch_all_regex");
  gp_message ("debugM", $subr_name, "get_hex_address_regex = $get_hex_address_regex");
  gp_message ("debugM", $subr_name, "get_addr_offset_regex = $get_addr_offset_regex");
  gp_message ("debugM", $subr_name, "zero_dot_at_end_regex = $zero_dot_at_end_regex");
  gp_message ("debugM", $subr_name, "backward_slash_regex  = $backward_slash_regex");

#------------------------------------------------------------------------------
# Read the input file into memory.
#------------------------------------------------------------------------------
  chomp (@function_data = <FUNC_OVERVIEW>);
  gp_message ("debug", $subr_name, "read all of file $overview_file into memory");

#------------------------------------------------------------------------------
# Remove a legacy redundant string, if any.
#------------------------------------------------------------------------------
  @function_data = @{ remove_redundant_string (\@function_data)};

#------------------------------------------------------------------------------
# Parse the function view info and store the data.
#------------------------------------------------------------------------------
  my $max_header_length  = 0;
  my $max_metrics_length = 0;

#------------------------------------------------------------------------------
# Loop over all the lines.  Extract the header, metric values, function names,
# and the addresses.
#
# This is also where the maximum lengths for the header and metric lines are
# computed.  This is used to get the correct alignment in the HTML output.
#------------------------------------------------------------------------------
  for (my $line = 0; $line <= $#function_data; $line++)
    {
      $input_line = $function_data[$line];
##      $input_line =~ s/ --  no functions found//;

gp_message ("debugXL", $subr_name, "input_line = $input_line");

#------------------------------------------------------------------------------
# The table header is assumed to start at the line that has "Name" in it.
# The header ends when we see the function name "<Total>".
#------------------------------------------------------------------------------
      if ($input_line =~ /$header_name_regex/)
        {
          $scan_header = $TRUE;
        }
      elsif ($input_line =~ /$total_marker_regex/)
        {
          $scan_header        = $FALSE;
          $scan_function_data = $TRUE;
        }

if ($scan_header)
        {
#------------------------------------------------------------------------------
# This group is only defined for the first line of the header and $4 contains
# the remaining part of the line after "Name", without the leading spaces.
#------------------------------------------------------------------------------
          if (defined ($4))
            {
              $remaining_part_header = $4;
              $msg =  "remaining_part_header = $remaining_part_header";
              gp_message ("debugXL", $subr_name, $msg);

#------------------------------------------------------------------------------
# Determine the maximum length of the header.  This needs to be done before
# the HTML controls are added.
#------------------------------------------------------------------------------
              my $header_length = length ($remaining_part_header);
              $max_header_length = max ($max_header_length, $header_length);

#------------------------------------------------------------------------------
# TBD Should change this and not yet include html in header_lines
#------------------------------------------------------------------------------
              $html_line = "<b>" . $remaining_part_header . "</b>";

push (@header_lines, $html_line);

gp_message ("debugXL", $subr_name, "max_header_length = $max_header_length");
              gp_message ("debugXL", $subr_name, "html_line = $html_line");
            }
#------------------------------------------------------------------------------
# Captures the subsequent header lines.  Assume they exist.
#------------------------------------------------------------------------------
          elsif ($input_line =~ /$catch_all_regex/)
            {
              $header_line = $1;
              gp_message ("debugXL", $subr_name, "header_line = $header_line");

my $header_length = length ($header_line);
              $max_header_length = max ($max_header_length, $header_length);

push (@header_lines, $html_line);

gp_message ("debugXL", $subr_name, "max_header_length = $max_header_length");
              gp_message ("debugXL", $subr_name, "html_line = $html_line");
            }
        }
#------------------------------------------------------------------------------
# This is a line with function data.
#------------------------------------------------------------------------------
      if ($scan_function_data and (not ($input_line =~ /$empty_line_regex/)))
        {
          $msg = "detected a line with function data";
          gp_message ("debugXL", $subr_name, $msg);

my ($hex_address_ref, $marker_ref, $reduced_line_ref, 
              $list_with_metrics_ref) =
                                       split_function_data_line (\$input_line);

$full_hex_address  = ${ $hex_address_ref };
          $marker            = ${ $marker_ref };
          $routine           = ${ $reduced_line_ref };
          $all_metrics       = ${ $list_with_metrics_ref };

$msg = "RESULT full_hex_address = " . $full_hex_address;
          $msg .= " -- metric values = " . $all_metrics;
          $msg .= " -- marker = " . $marker;
          $msg .= " -- function name = " . $routine;
          gp_message ("debugXL", $subr_name, $msg);

@fields = split (" ", $input_line);

$no_of_fields = $#fields + 1;
          $elements_in_name = $no_of_fields - $number_of_metrics - 1;

$msg  = "no_of_fields = " . $no_of_fields;
          $msg .= " elements_in_name = " . $elements_in_name;
          gp_message ("debugXL", $subr_name, $msg);

#------------------------------------------------------------------------------
# In case the last metric is 0. only, we append 3 extra characters that
# represent zero.  We cannot change the number to 0.000 though because that
# has a different interpretation than 0.
# In a later phase, the "ZZZ" symbol will be removed again, but for now it
# creates consistency in, for example, the length of the metrics part.
#------------------------------------------------------------------------------
              if ($all_metrics =~ /$zero_dot_at_end_regex/)
                {
                  if (defined ($1) )
                    {
#------------------------------------------------------------------------------
# Somewhat overkill, but remove the leading "\" from the decimal separator
# in the debug print since it is used for internal purposes only.
#------------------------------------------------------------------------------
                      my $decimal_point = $decimal_separator;
                      $decimal_point =~ s/$backward_slash_regex//;
                      my $txt = "all_metrics = $all_metrics ended with 0";
                      $txt   .= "$decimal_point ($decimal_separator)";
                      gp_message ("debugXL", $subr_name, $txt);

$all_metrics .= "ZZZ";
                    }
                }
              $metrics_length = length ($all_metrics);
              $max_metrics_length = max ($max_metrics_length, $metrics_length);
              gp_message ("debugXL", $subr_name, "$routine all_metrics = $all_metrics metrics_length = $metrics_length");

$msg = "verify full_hex_address = " . $full_hex_address;
              gp_message ("debugXL", $subr_name, $msg);

if ($full_hex_address =~ /$get_hex_address_regex/)
                {
                  $hex_address = "0x" . $2;
                }
              else
                {
                  $msg = "full_hex_address = $full_hex_address has the wrong format";
                  gp_message ("assertion", $subr_name, $msg);
                }

push (@address_field, $full_hex_address);

$msg = "pushed full_hex_address = " . $full_hex_address; 
              gp_message ("debugXL", $subr_name, $msg);

push (@metric_values, $all_metrics);

#------------------------------------------------------------------------------
# Record the function name "as is".  Below we figure out what the final name
# should be in case there are multiple occurrences of the same name.
#
# The reason to decouple this is to avoid the code gets too complex here.
#------------------------------------------------------------------------------
              push (@function_names, $routine);
        }
    } #-- End of loop over the input lines

#------------------------------------------------------------------------------
# Store the maximum lengths for the header and metrics.
#------------------------------------------------------------------------------
    gp_message ("debugXL", $subr_name, "final max_header_length  = $max_header_length");
    gp_message ("debugXL", $subr_name, "final max_metrics_length = $max_metrics_length");

$function_view_structure{"max header length"}  = $max_header_length;
    $function_view_structure{"max metrics length"} = $max_metrics_length;

#------------------------------------------------------------------------------
# Determine the final name for the functions and set up the HTML block.
#------------------------------------------------------------------------------
  my @final_html_function_block = ();
  my @function_index_list       = ();

#------------------------------------------------------------------------------
# First, an index list is built.  If we are to index the functions in order of
# appearance in the function overview from 0 to n-1, the value of the array
# for index "i" is the index into the large "function_info" structure.  This
# has the final name, the html function block, etc.
#------------------------------------------------------------------------------

for my $i (keys @address_field)
    {
      $msg = "address_field[" . $i ."] = " . $address_field[$i];
      gp_message ("debugM", $subr_name, $msg);
    }
#------------------------------------------------------------------------------
## TBD: Use get_index_function_info??!!
#------------------------------------------------------------------------------
  for my $i (keys @function_names)
    {
#------------------------------------------------------------------------------
# Get the function name and the address from the function overview.  The
# address is used to differentiate in case a function has multiple occurences.
#------------------------------------------------------------------------------
      my $routine = $function_names[$i];
      my $current_address = $address_field[$i];

my $final_function_name;
      my $found_a_match = $FALSE;
      my $msg;
      my $ref_index;

$msg  = "on entry - routine = " . $routine; 
      $msg .= " current_address = " . $current_address;
      gp_message ("debugM", $subr_name, $msg);

#------------------------------------------------------------------------------
# Check if there are duplicate entries for this function.  If there are, use
# the address to find the right match in the function_info structure.
#------------------------------------------------------------------------------
      gp_message ("debugXL", $subr_name, "$routine: first check for multiple occurrences");
      if (exists ($g_multi_count_function{$routine}))
        {
          $msg = "$g_multi_count_function{$routine} exists";
          gp_message ("debugXL", $subr_name, $msg);
          $msg  = "g_function_occurrences{$routine} = ";
          $msg .= $g_function_occurrences{$routine};
          gp_message ("debugXL", $subr_name, $msg);

for my $ref (keys @{ $g_map_function_to_index{$routine} })
            {
              my $ref_index = $g_map_function_to_index{$routine}[$ref];
              my $addr_offset = $function_info[$ref_index]{"addressobjtext"};
#------------------------------------------------------------------------------
# The address has the following format: 6:0x0003af50, but we only need the
# part after the colon and remove the first part.
#------------------------------------------------------------------------------
              $addr_offset =~ s/$get_addr_offset_regex//;
 
              gp_message ("debugXL", $subr_name, "$routine: ref_index = $ref_index");
              gp_message ("debugXL", $subr_name, "$routine: function_info[$ref_index]{'alt_name'} = $function_info[$ref_index]{'alt_name'}");
              gp_message ("debugXL", $subr_name, "$routine: addr_offset = $addr_offset");

if ($addr_offset eq $current_address)
#------------------------------------------------------------------------------
# There is a match and we can store the index.
#------------------------------------------------------------------------------
                {
                  $found_a_match = $TRUE;
                  push (@function_index_list, $ref_index);
                  last;
                }
            }
        }
      else
        {
#------------------------------------------------------------------------------
# This is the easy case.  There is only one index value.  We do check if the
# array element that contains it, exists.  If this is not the case, something
# has gone horribly wrong earlier and we need to bail out.
#------------------------------------------------------------------------------
          if (defined ($g_map_function_to_index{$routine}[0]))
            {
              $found_a_match = $TRUE;
              $ref_index = $g_map_function_to_index{$routine}[0];
              push (@function_index_list, $ref_index);
              my $final_function_name = $function_info[$ref_index]{"routine"};
              gp_message ("debugXL", $subr_name, "pushed single occurrence: ref_index = $ref_index final_function_name = $final_function_name");
            }
          }
      if (not $found_a_match)
#------------------------------------------------------------------------------
# This should not happen. All we can do is print an error message and stop.
#------------------------------------------------------------------------------
        {
          $msg  = "cannot find the index for $routine: found_a_match = ";
          $msg .= ($found_a_match == $TRUE) ? "TRUE" : "FALSE";
          gp_message ("assertion", $subr_name, $msg);
        }
    }

#------------------------------------------------------------------------------
# The loop over all function names has completed and @function_index_list
# contains the index values into @function_info for the functions.
#
# All we now need to do is to retrieve the correct field(s) from the array.
#------------------------------------------------------------------------------
  for my $i (keys @function_index_list)
    {
      my $index_for_function = $function_index_list[$i];
      push (@final_html_function_block, $function_info[$index_for_function]{"html function block"});
    }
  for my $i (keys @final_html_function_block)
    {
      my $txt = "final_html_function_block[$i] = $final_html_function_block[$i]";
      gp_message ("debugXL", $subr_name, $txt);
    }

#------------------------------------------------------------------------------
# Since the numbers are right aligned, we know that any difference between the
# metric line length and the maximum must be caused by the first column.  All
# we need to do is to prepend spaces in case of a difference.
#
# While we have the line with the metric values, we also replace ZZZ by 3
# spaces.
#------------------------------------------------------------------------------
    for my $i (keys @metric_values)
      {
        if (length ($metric_values[$i]) < $max_metrics_length)
          {
            my $pad = $max_metrics_length - length ($metric_values[$i]);
            my $spaces = "";
            for my $s (1 .. $pad)
              {
                $spaces .= "&nbsp;";
              }
            $metric_values[$i] = $spaces . $metric_values[$i];
          }
          $metric_values[$i] =~ s/ZZZ/&nbsp;&nbsp;&nbsp;/g;
      }

#------------------------------------------------------------------------------
# Determine the column widths.  The start and end index of the words in the
# input line are stored in elements 0 and 1 of @word_index_values.
#
# The assumption made is that the first digit of a metric value on the first
# line is left # aligned with the header text.  These are the Total values
# and other than for some derived metrics, e.g. CPI, should be the largest.
#
# The positions of the start of the value is what we should then use for the
# word "(sort)" to start.
#
# For example:
#
# Excl.     Excl. CPU  Excl.         Excl.         Excl.  Excl.
# Total     Cycles     Instructions  Last-Level    IPC    CPI
# CPU sec.     sec.    Executed      Cache Misses
# 174.664   179.250    175838403203  1166209617    0.428   2.339
#------------------------------------------------------------------------------

my $foundit_ref;
    my $foundit;
    my @index_values = ();
    my $index_values_ref;

#------------------------------------------------------------------------------
# Search for "Excl." in the top row.  The metric values are aligned with this
# word and we can use it to position "(sort)" in the last header line.
#
# In @index_values, we store the position(s) of "Excl." in the header line.
# If none can be found, an exception is raised because at least one should
# be there.
#
# TBD: Check if this can be done only once.
#------------------------------------------------------------------------------
    my $target_keyword = "Excl.";

($foundit_ref, $index_values_ref) = find_keyword_in_string (
                                          \$remaining_part_header,
                                          \$target_keyword);

$foundit      = ${ $foundit_ref };
    @index_values = @{ $index_values_ref };

if ($foundit)
      {
        for my $i (keys @index_values)
          {
            my $txt = "index_values[$i] = $index_values[$i]";
            gp_message ("debugXL", $subr_name, $txt);
          }
      }
    else
      {
        $msg = "keyword $target_keyword not found in $remaining_part_header";
        gp_message ("assertion", $subr_name, $msg);
      }

#------------------------------------------------------------------------------
# Compute the number of spaces we need to add between the "(sort)" strings.
#
# For example:
#
# 01234567890123456789
#
# Excl.         Excl.
# (sort)        (sort)
#       xxxxxxxx
#
# The number of spaces required is 14 - 6 = 8.
#
# The number of spaces to be added is stored in @padding_values.  These are
# the spaces to be added before the occurrence of "(sort)".  This is why the
# first padding value is 0.
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# TBD: This needs to be done only once.
#------------------------------------------------------------------------------
    my @padding_values = ();
    my $P_previous     = 0;
    for my $i (keys @index_values)
      {
        my $L = $index_values[$i];
        my $P = $L + length ("(sort)");
        my $pad_spaces = $L - $P_previous;

push (@padding_values, $pad_spaces);

$P_previous = $P;
      }

for my $i (keys @padding_values)
      {
        my $txt = "padding_values[$i] = $padding_values[$i]";
        gp_message ("debugXL", $subr_name, $txt);
      }
 
#------------------------------------------------------------------------------
# Build up the sort line.  Mark the current metric and make sure the line is
# aligned with the header.
#------------------------------------------------------------------------------
    my $sort_string = "(sort)";
    my $length_sort_string = length ($sort_string);
    my $sort_line = "";
    my @active_metrics = split (":", $summary_metrics);
    for my $i (0 .. $number_of_metrics-1)
      {
        my $pad          = $padding_values[$i];
        my $metric_value = $active_metrics[$i];

my $spaces = "";
        for my $s (1 .. $pad)
          {
            $spaces .= "&nbsp;";
          }

gp_message ("debugXL", $subr_name, "i = $i metric_value = $metric_value pad = $pad");

if ($metric_value eq $exp_type)
#------------------------------------------------------------------------------
# The current metric should have a different background color.
#------------------------------------------------------------------------------
          {
            $sort_string = "<a href=\'" . $g_html_base_file_name{"function_view"} .
                           "." . $metric_value . ".html' style='background-color:" .
                           $g_html_color_scheme{"background_selected_sort"} .
                           "\'><b>(sort)</b></a>";
          }
        elsif (($exp_type eq "functions") and ($metric_value eq $g_first_metric))
#------------------------------------------------------------------------------
# Set the background color for the sort metric in the main function overview.
#------------------------------------------------------------------------------
          {
            $sort_string = "<a href=\'" . $g_html_base_file_name{"function_view"} .
                           "." . $metric_value . ".html' style='background-color:" .
                           $g_html_color_scheme{"background_selected_sort"} .
                           "'><b>(sort)</b></a>";
          }
        else
#------------------------------------------------------------------------------
# Do not set a specific background for all other metrics.
#------------------------------------------------------------------------------
          {
            $sort_string = "<a href=\'" . $g_html_base_file_name{"function_view"} .
                           "." . $metric_value . ".html'>(sort)</a>";
          }

#------------------------------------------------------------------------------
# Prepend the spaces to ensure correct alignment with the rest of the header.
#------------------------------------------------------------------------------
          $sort_line .= $spaces . $sort_string;
      }

push (@header_lines, $sort_line);

#------------------------------------------------------------------------------
# Print the final results for the header and metrics.
#------------------------------------------------------------------------------
  for my $i (keys @header_lines)
    {
      gp_message ("debugXL", $subr_name, "header_lines[$i] = $header_lines[$i]");
    }
  for my $i (keys @metric_values)
    {
      gp_message ("debugXL", $subr_name, "metric_values[$i] = $metric_values[$i]");
    }

#------------------------------------------------------------------------------
# Construct the lines for the function overview.
#
# TBD: We could eliminate two structures here because metric_values and
# final_html_function_block are only copied and the result stored.
#------------------------------------------------------------------------------
   for my $i (keys @function_names)
      {
        push (@metrics_part, $metric_values[$i]);
        push (@function_view_array, $final_html_function_block[$i]);
      }

for my $i (0 .. $#function_view_array)
    {
      $msg = "function_view_array[$i] = $function_view_array[$i]";
      gp_message ("debugXL", $subr_name, $msg);
    }
#------------------------------------------------------------------------------
# Element "function table" contains the array with all the function view data.
#------------------------------------------------------------------------------
  $function_view_structure{"header"}         = [@header_lines];
  $function_view_structure{"metrics part"}   = [@metrics_part];
  $function_view_structure{"function table"} = [@function_view_array];

$msg = "leave subroutine " . $subr_name;
  gp_message ("debug", $subr_name, $msg);

return (\%function_view_structure);

} #-- End of subroutine process_function_overview

#------------------------------------------------------------------------------
# TBD
#------------------------------------------------------------------------------
sub process_metrics
{
  my $subr_name = get_my_name ();

my ($input_string, $sort_fields_ref, $metric_description_ref, $ignored_metrics_ref) = @_;

my @sort_fields        = @{ $sort_fields_ref };
  my %metric_description = %{ $metric_description_ref };
  my %ignored_metrics    = %{ $ignored_metrics_ref };

my $outputdir = append_forward_slash ($input_string);
  my $LANG      = $g_locale_settings{"LANG"};
  my $max_len   = 0;
  my $metric_comment;

my ($imetricn,$outfile);
  my ($html_metrics_record,$imetric,$metric);

$html_metrics_record =
    "<!doctype html public \"-//w3c//dtd html 3.2//EN\">\n<html lang=\"$LANG\">\n<head>\n" .
    "<meta http-equiv=\"content-type\" content=\"text/html; charset=iso-8859-1\">\n" .
    "<title>Function Metrics</title></head><body lang=\"$LANG\" bgcolor=".$g_html_color_scheme{"background_color_page"}."<pre>\n";

$outfile = $outputdir . "metrics.html";

open (METRICSOUT, ">", $outfile)
    or die ("$subr_name - unable to open file $outfile for writing - '$!'");
  gp_message ("debug", $subr_name, "opened file $outfile for writing");

for $metric (@sort_fields)
    {
      $max_len = max ($max_len, length ($metric));
      gp_message ("debug", $subr_name, "sort_fields: metric = $metric max_len = $max_len");
    }

# TBD: Check this
#  for $imetric (@IMETRICS)
  for $imetric (keys %ignored_metrics)
    {
      $max_len = max ($max_len, length ($imetric));
      gp_message ("debug", $subr_name, "ignored_metrics imetric = $imetric max_len = $max_len");
    }

$max_len++;

gp_message ("debug", $subr_name, "max_len = $max_len");

$html_metrics_record .= "<p style=\"font-size:14px;color:red\"> Metrics used (".($#sort_fields + 1).")\n</p><p style=\"font-size:14px\">";
  for $metric (@sort_fields)
    {
      my $description = ${ retrieve_metric_description (\$metric, \%metric_description) };
      gp_message ("debug", $subr_name, "handling metric metric = $metric->$description");
      $html_metrics_record .= "       $metric".(' ' x ($max_len - length ($metric)))."$description\n";
    }

#  $imetricn = scalar (keys %IMETRICS);
  $imetricn = scalar (keys %ignored_metrics);
  if ($imetricn)
    {
      $html_metrics_record .= "</p><p style=\"font-size:14px;color:red\"> Metrics ignored ($imetricn)\n</p><p style=\"font-size:14px\">";
#      for $imetric (sort keys %IMETRICS){
      for $imetric (sort keys %ignored_metrics)
        {
              $metric_comment = "(inclusive, exclusive, and percentages)";
          $html_metrics_record .= "       $imetric".(' ' x ($max_len - length ($imetric))).$metric_comment."\n";
          gp_message ("debug", $subr_name, "handling metric imetric = $imetric $metric_comment");
        }
    }

print METRICSOUT $html_metrics_record;
  print METRICSOUT $g_html_credits_line;
  close (METRICSOUT);

gp_message ("debug", $subr_name, "closed metrics file $outfile");

return (0);

} #-- End of subroutine process_metrics

#------------------------------------------------------------------------------
# TBD
#------------------------------------------------------------------------------
sub process_metrics_data
{
  my $subr_name = get_my_name ();

my ($outfile1, $outfile2, $ignored_metrics_ref) = @_;

my %ignored_metrics    = %{ $ignored_metrics_ref };

my %metric_value       = ();
  my %metric_description = ();
  my %metric_found       = ();

my $user_metrics;
  my $system_metrics;
  my $wall_metrics;
  my $metric_spec;
  my $metric_flavor;
  my $metric_visibility;
  my $metric_name;
  my $metric_text;
  my $metricdata;
  my $metric_line;
  my $msg;

my $summary_metrics;
  my $detail_metrics;
  my $detail_metrics_system;
  my $call_metrics;

if ($g_user_settings{"default_metrics"}{"current_value"} eq "off")
    {
      $msg  = "g_user_settings{default_metrics}{current_value} = ";
      $msg .= $g_user_settings{"default_metrics"}{"current_value"};
      gp_message ("debug", $subr_name, $msg);
  # get metrics

$summary_metrics       = '';
      $detail_metrics        = '';
      $detail_metrics_system = '';
      $call_metrics          = '';
      $user_metrics          = 0;
      $system_metrics        = 0;
      $wall_metrics          = 0;

my ($last_metric,$metric,$value,$i,$r);

open (METRICTOTALS, "<", $outfile2)
        or die ("Unable to open metric value data file $outfile2 for reading - '$!'");
      gp_message ("debug", $subr_name, "opened $outfile2 to parse metric value data");

#------------------------------------------------------------------------------
# Below an example of the file that has just been opened.  The lines I marked
# with a * has been wrapped by my for readability.  This is not the case in the
# file, but makes for a really long line.
#
# Also, the data comes from one PC experiment and two HWC experiments.
#------------------------------------------------------------------------------
# <Total>
#              Exclusive Total CPU Time:      32.473 (100.0%)
#              Inclusive Total CPU Time:      32.473 (100.0%)
#                  Exclusive CPU Cycles:      23.586 (100.0%)
#                               " count: 47054706905
#                  Inclusive CPU Cycles:      23.586 (100.0%)
#                               " count: 47054706905
#       Exclusive Instructions Executed: 54417033412 (100.0%)
#       Inclusive Instructions Executed: 54417033412 (100.0%)
#     Exclusive Last-Level Cache Misses:   252730685 (100.0%)
#     Inclusive Last-Level Cache Misses:   252730685 (100.0%)
#  *   Exclusive Instructions Per Cycle:      Inclusive Instructions Per Cycle:
#  *         Exclusive Cycles Per Instruction:
#  *         Inclusive Cycles Per Instruction:
#  *         Size:           0
#                            PC Address: 1:0x00000000
#                           Source File: (unknown)
#                           Object File: (unknown)
#                           Load Object: <Total>
#                          Mangled Name:
#                               Aliases:
#------------------------------------------------------------------------------

while (<METRICTOTALS>)
        {
          $metricdata = $_; chomp ($metricdata);
          gp_message ("debug", $subr_name, "file metrictotals: $metricdata");

#------------------------------------------------------------------------------
# Ignoring whitespace, search for any line with a ":" in it, followed by
# a number with or without a dot.  So, an integer or floating-point number.
#------------------------------------------------------------------------------
          if ($metricdata =~ /\s*(.*):\s+(\d+\.*\d*)/)
            {
              gp_message ("debug", $subr_name, "  candidate => $metricdata");
              $metric = $1;
              $value  = $2;
              if ( ($metric eq "PC Address") or ($metric eq "Size"))
                {
                  gp_message ("debug", $subr_name, "  skipped => $metric $value");
                  next;
                }
              gp_message ("debug", $subr_name, "  proceed => $metric $value");
              if ($metric eq '" count')
#------------------------------------------------------------------------------
# Hardware counter experiments have this info.  Note that this line is not the
# first one to be encountered, so $last_metric has been defined already.
#------------------------------------------------------------------------------
                {
                  $metric = $last_metric." Count"; # we presume .......
                  gp_message ("debug", $subr_name, "last_metric = $last_metric metric = $metric");
                }
              $i=index ($metricdata,":");
              $r=rindex ($metricdata,":");
              gp_message ("debug", $subr_name, "metricdata = $metricdata => i = $i r = $r");
              if ($i == $r)
                {
                  if ($value > 0) # Not interested in metrics contributing zero
                    {
                      $metric_value{$metric} = $value;
                      gp_message ("debug", $subr_name, "archived metric_value{$metric} = $metric_value{$metric}");
                      # e.g. $metric_value{Exclusive Total Thread Time} = 302.562
                      # e.g. $metric_value{Exclusive Instructions Executed} = 2415126222484
                    }
                }
              else
#------------------------------------------------------------------------------
# TBD This code deals with an old bug and may be removed.
#------------------------------------------------------------------------------
                { # er_print bug - e.g.
#  Exclusive Instructions Per Cycle:       Inclusive Instructions Per Cycle:       Exclusive Cycles Per Instruction:   Inclusive Cycles Per Instruction:             Exclusive OpenMP Work Time: 162.284 (100.0%)
                  gp_message ("debug", $subr_name, "metrictotals odd line:->$metricdata<-");
                  $r=rindex ($metricdata,":",$r-1);
                  if ($r == -1)
                    { # ignore
                      gp_message ("debug", $subr_name, "metrictotals odd line ignored<-");
                      $last_metric = "foo";
                      next;
                    }
                  my ($good_part)=substr ($metricdata,$r+1);
                  if ($good_part =~ /\s*(.*):\s+(\d+\.*\d*)/)
                    {
                      $metric = $1;
                      $value  = $2;
                      if ($value>0) # Not interested in metrics contributing zero
                        {
                          $metric_value{$metric} = $value;
                          $msg = "metrictotals odd line rescued '$metric'=$value";
                          gp_message ("debug", $subr_name, $msg);
                        }
                    }
                }
#------------------------------------------------------------------------------
# Preserve the current metric.
#------------------------------------------------------------------------------
              $last_metric = $metric;
            }
        }
      close (METRICTOTALS);
    }

if (scalar (keys %metric_value) == 0)
#------------------------------------------------------------------------------
# If we have no metrics > 0, fudge a "Exclusive Total CPU Time", else we
# blow up later.
#
# TBD: See if this can be handled differently.
#------------------------------------------------------------------------------
      {
        $metric_value{"Exclusive Total CPU Time"} = 0;
        gp_message ("debug", $subr_name, "no metrics found and a stub was added");
      }

for my $metric (sort keys %metric_value)
    {
      gp_message ("debug", $subr_name, "Stored metric_value{$metric} = $metric_value{$metric}");
    }

gp_message ("debug", $subr_name, "proceed to process file $outfile1");

#------------------------------------------------------------------------------
# Open and process the metrics file.
#------------------------------------------------------------------------------
  open (METRICS, "<", $outfile1)
    or die ("Unable to open metrics file $outfile1: '$!'");
  gp_message ("debug", $subr_name, "opened file $outfile1 for reading");

#------------------------------------------------------------------------------
# Parse the file.  This is a typical example:
#
# Exp Sel Total
# === === =====
#   1 all     2
#   2 all     1
#   3 all     2
# Current metrics: e.totalcpu:i.totalcpu:e.cycles:e+insts:e+llm:name
# Current Sort Metric: Exclusive Total CPU Time ( e.totalcpu )
# Available metrics:
#          Exclusive Total CPU Time: e.%totalcpu
#          Inclusive Total CPU Time: i.%totalcpu
#              Exclusive CPU Cycles: e.+%cycles
#              Inclusive CPU Cycles: i.+%cycles
#   Exclusive Instructions Executed: e+%insts
#   Inclusive Instructions Executed: i+%insts
# Exclusive Last-Level Cache Misses: e+%llm
# Inclusive Last-Level Cache Misses: i+%llm
#  Exclusive Instructions Per Cycle: e+IPC
#  Inclusive Instructions Per Cycle: i+IPC
#  Exclusive Cycles Per Instruction: e+CPI
#  Inclusive Cycles Per Instruction: i+CPI
#                              Size: size
#                        PC Address: address
#                              Name: name
#------------------------------------------------------------------------------
  while (<METRICS>)
    {
      $metric_line = $_;
      chomp ($metric_line);

gp_message ("debug", $subr_name, "processing line $metric_line");
#------------------------------------------------------------------------------
# The original regex has bugs because the line should not be allowed to start
# with a ":".  So this is wrong:
#  if (($metric =~ /\s*(.*):\s+(\S)((\.\S+)|(\+\S+))/) and !($metric =~/^Current/))
#
# This is better:
#      if (($metric =~ /\s*(.+):\s+(\S)((\.\S+)|(\+\S+))/) and !($metric =~/^Current/))
#
# In general, this regex has some potential issues and has been replaced by
# the one shown below.
#
# We select a line that does not start with "Current" and aside from whitespace
# starts with anything (although it should be a string with words only),
# followed by whitespace and either an "e" or "i". This is called the "flavor"
# and is followed by a visibility marker (.,+,%, or !) and a metric name.
#------------------------------------------------------------------------------
# Ruud   if (($metric =~ /\s*(.*):\s+(\S)((\.\S+)|(\+\S+))/) && !($metric =~/^Current/)){

($metric_spec, $metric_flavor, $metric_visibility, $metric_name, $metric_text) =
              extract_metric_specifics ($metric_line);

#      if (($metric_line =~ /\s*(.+):\s+([ei])([\.\+%]+)(\S*)/) and !($metric_line =~/^Current/))
      if ($metric_spec eq "skipped")
        {
          gp_message ("debug", $subr_name, "skipped line: $metric_line");
        }
      else
        {
          gp_message ("debug", $subr_name, "line of interest: $metric_line");

$metric_found{$metric_spec} = 1;

if ($g_user_settings{"ignore_metrics"}{"defined"})
            {
              gp_message ("debug", $subr_name, "check for $metric_spec");
              if (exists ($ignored_metrics{$metric_name}))
                {
                  gp_message ("debug", $subr_name, "user asked to ignore metric $metric_name");
                  next;
                }
              }

#------------------------------------------------------------------------------
# This metric is not on the ignored list and qualifies, so store it.
#------------------------------------------------------------------------------
          $metric_description{$metric_spec} = $metric_text;

# TBD: add for other visibilities too, like +
          gp_message ("debug", $subr_name, "stored $metric_description{$metric_spec}          = $metric_description{$metric_spec}");

if ($metric_flavor ne "e")
            {
              gp_message ("debug", $subr_name, "metric $metric_spec is ignored");
            }
          else
#------------------------------------------------------------------------------
# Only the exclusive metrics are shown.
#------------------------------------------------------------------------------
            {
              gp_message ("debug", $subr_name, "metric $metric_spec ($metric_text) is considered");

if ($metric_spec =~ /user/)
                {
                  $user_metrics = $TRUE;
                  gp_message ("debug", $subr_name, "m: user_metrics set to TRUE");
                }
              elsif ($metric_spec =~ /system/)
                {
                  $system_metrics = $TRUE;
                  gp_message ("debug", $subr_name, "m: system_metrics set to TRUE");
                }
              elsif ($metric_spec =~ /wall/)
                {
                  $wall_metrics = $TRUE;
                  gp_message ("debug", $subr_name, "m: wall_metrics set to TRUE");
                }
#------------------------------------------------------------------------------
# TBD I don't see why these need to be skipped.  Also, should be totalcpu.
#------------------------------------------------------------------------------
              elsif (($metric_spec =~ /^e\.total$/) or ($metric_spec =~/^e\.total_cpu$/))
                {
                # skip total thread time and total CPU time
                  gp_message ("debug", $subr_name, "m: skip above");
                }
              elsif (defined ($metric_value{$metric_text}))
                {
                  gp_message ("debug", $subr_name, "Total attributed to this metric metric_value{$metric_text} = $metric_value{$metric_text}");
                  if ($summary_metrics ne '')
                    {
                      $summary_metrics = $summary_metrics.':'.$metric_spec;
                      gp_message ("debug", $subr_name, "updated summary_metrics = $summary_metrics - 1");
                      if ($metric_spec !~ /\.wait$|\.ulock$|\.text$|\.data$|\.owait$|total$|mpiwork$|mpiwait$|ompwork$|ompwait$/)
                        {
                          $detail_metrics = $detail_metrics.':'.$metric_spec;
                          gp_message ("debug", $subr_name, "updated m:detail_metrics=$detail_metrics - 1");
                          $detail_metrics_system = $detail_metrics_system.':'.$metric_spec;
                          gp_message ("debug", $subr_name, "updated m:detail_metrics_system=$detail_metrics_system - 1");
                        }
                      else
                        {
                          gp_message ("debug", $subr_name, "m: no want above metric for detail_metrics or detail_metrics_system");
                        }
                    }
                  else
                    {
                      $summary_metrics = $metric_spec;
                      gp_message ("debug", $subr_name, "initialized summary_metrics = $summary_metrics - 2");
                      if ($metric_spec !~ /\.wait$|\.ulock$|\.text$|\.data$|\.owait$|total$|mpiwork$|mpiwait$|ompwork$|ompwait$/)
                        {
                          $detail_metrics = $metric_spec;
                          gp_message ("debug", $subr_name, "m:detail_metrics=$detail_metrics - 2");
                          $detail_metrics_system = $metric_spec;
                          gp_message ("debug", $subr_name, "m:detail_metrics_system=$detail_metrics_system - 2");
                        }
                      else
                        {
                          gp_message ("debug", $subr_name, "m: no want above metric for detail_metrics or detail_metrics_system");
                        }
                    }
                  gp_message ("debug", $subr_name, " metric $metric_spec added");
                }
              else
                {
                  gp_message ("debug", $subr_name, "m: no want above metric was a 0 total");
                }
            }
        }
    }

close METRICS;

if ($wall_metrics > 0)
    {
      gp_message ("debug", $subr_name,"m:wall_metrics set adding to summary_metrics");
      $summary_metrics = "e.wall:".$summary_metrics;
      gp_message ("debug", $subr_name,"m:summary_metrics=$summary_metrics - 3");
    }

if ($system_metrics > 0)
    {
      gp_message ("debug", $subr_name,"m:system_metrics set adding to summary_metrics,call_metrics and detail_metrics_system");
      $summary_metrics       = "e.system:".$summary_metrics;
      $call_metrics          = "i.system:".$call_metrics;
      $detail_metrics_system ='e.system:'.$detail_metrics_system;

gp_message ("debug", $subr_name,"m:summary_metrics=$summary_metrics - 4");
      gp_message ("debug", $subr_name,"m:call_metrics=$call_metrics");
      gp_message ("debug", $subr_name,"m:detail_metrics_system=$detail_metrics_system - 3");
    }

#------------------------------------------------------------------------------
# TBD: e.user and i.user do not always exist!!
#------------------------------------------------------------------------------

if ($user_metrics > 0)
    {
      gp_message ("debug", $subr_name,"m:user_metrics set adding to summary_metrics,detail_metrics,detail_metrics_system and call_metrics");
# Ruud      if (!exists ($IMETRICS{"i.user"})){
      if ($g_user_settings{"ignore_metrics"}{"defined"} and exists ($ignored_metrics{"user"}))
        {
          $summary_metrics = "e.user:".$summary_metrics;
        }
      else
        {
          $summary_metrics = "e.user:i.user:".$summary_metrics;
        }
      $detail_metrics        = "e.user:".$detail_metrics;
      $detail_metrics_system = "e.user:".$detail_metrics_system;

gp_message ("debug", $subr_name,"m:summary_metrics=$summary_metrics - 5");
      gp_message ("debug", $subr_name,"m:detail_metrics=$detail_metrics - 3");
      gp_message ("debug", $subr_name,"m:detail_metrics_system=$detail_metrics_system - 4");

if ($g_user_settings{"ignore_metrics"}{"defined"} and exists ($ignored_metrics{"user"}))
        {
          $call_metrics = "a.user:".$call_metrics;
        }
      else
        {
          $call_metrics = "a.user:i.user:".$call_metrics;
        }
      gp_message ("debug", $subr_name,"m:call_metrics=$call_metrics - 2");
    }

if ($call_metrics eq "")
    {
      $call_metrics = $detail_metrics;

gp_message ("debug", $subr_name,"m:call_metrics is not set, setting it to detail_metrics ");
      gp_message ("debug", $subr_name,"m:call_metrics=$call_metrics - 3");
    }

for my $metric (sort keys %ignored_metrics)
    {
      if ($ignored_metrics{$metric})
        {
          gp_message ("debug", $subr_name, "active metric, but ignored: $metric");
        }

}

return (\%metric_value, \%metric_description, \%metric_found, $user_metrics, $system_metrics, $wall_metrics,
          $summary_metrics, $detail_metrics, $detail_metrics_system, $call_metrics);

} #-- End of subroutine process_metrics_data

#------------------------------------------------------------------------------
# Process source lines that are not part of the target function.
#
# Generate straightforward HTML, but define an anchor based on the source line
# number in the list.
#------------------------------------------------------------------------------
sub process_non_target_source
{
  my $subr_name = get_my_name ();

my ($start_scan, $end_scan,
      $src_times_regex, $function_regex, $number_of_metrics,
      $file_contents_ref, $modified_html_ref) = @_;

my @file_contents = @{ $file_contents_ref };
  my @modified_html = @{ $modified_html_ref };
  my $colour_code_line = $FALSE;
  my $input_line;
  my $line_id;
  my $modified_line;

#------------------------------------------------------------------------------
# Main loop to parse all of the source code and take action as needed.
#------------------------------------------------------------------------------
  for (my $line_no=$start_scan; $line_no <= $end_scan; $line_no++)
    {
      $input_line = $file_contents[$line_no];

#------------------------------------------------------------------------------
# Generate straightforward HTML, but define an anchor based on the source line
# number in the list.
#------------------------------------------------------------------------------
      $line_id = extract_source_line_number ($src_times_regex,
                                             $function_regex,
                                             $number_of_metrics,
                                             $input_line);

if ($input_line =~ /$function_regex/)
        {
          $colour_code_line = $TRUE;
        }

#------------------------------------------------------------------------------
# We need to replace the "<" symbol in the code by "&lt;".
#------------------------------------------------------------------------------
      $input_line =~ s/$g_less_than_regex/$g_html_less_than_regex/g;

#------------------------------------------------------------------------------
# Add an id.
#------------------------------------------------------------------------------
      $modified_line = "<a id=\"line_" . $line_id . "\"></a>";

my $coloured_line;
      if ($colour_code_line)
        {
          my $boldface = $TRUE;
          $coloured_line = color_string (
                             $input_line,
                             $boldface,
                             $g_html_color_scheme{"non_target_function_name"});
          $colour_code_line = $FALSE;
          $modified_line .= "$coloured_line";
        }
      else
        {
          $modified_line .= "$input_line";
        }
      gp_message ("debugXL", $subr_name, " $line_no : modified_line = $modified_line");
      push (@modified_html, $modified_line);
    }

return (\@modified_html);

} #-- End of subroutine process_non_target_source

#------------------------------------------------------------------------------
# This function scans the configuration file and adapts the internal settings
# accordingly.
#
# Errors are stored during the parsing and processing phase.  They are printed
# at the end and sorted by line number.
#
#
# TBD: Does not yet use the warnings/error system.  This needs to be fixed.
#------------------------------------------------------------------------------
sub process_rc_file
{
  my $subr_name = get_my_name ();

my ($rc_file_name, $rc_file_paths_ref) = @_;

#------------------------------------------------------------------------------
# Local structures.
#------------------------------------------------------------------------------
# Stores the values extracted from the config file:
  my %rc_settings_user = ();
  my %error_and_warning_msgs = ();
  my @rc_file_paths = ();

my @split_line;
  my @my_fields;

my $msg;
  my $first_part;
  my $line;
  my $line_number;
  my $no_of_arguments;
  my $number_of_fields;
  my $number_of_paths;
  my $parse_errors;   #-- Count the number of errors
  my $parse_warnings; #-- Count the number of errors

my $rc_config_file;
  my $rc_file_found;
  my $rc_keyword;
  my $rc_value;

@rc_file_paths   = @{$rc_file_paths_ref};
  $number_of_paths = scalar (@rc_file_paths);

if ($number_of_paths == 0)
#------------------------------------------------------------------------------
# This should not happen, but is a good safety net to add.
#------------------------------------------------------------------------------
    {
      my $msg = "search path list is empty";
      gp_message ("assertion", $subr_name, $msg);
    }

#------------------------------------------------------------------------------
# Check for the presence of a configuration file.
#------------------------------------------------------------------------------
  $msg = "number_of_paths = $number_of_paths rc_file_paths = @rc_file_paths";
  gp_message ("debug", $subr_name, $msg);

$rc_file_found = $FALSE;
  for my $path_name (@rc_file_paths)
    {
      $rc_config_file = $path_name . "/" . $rc_file_name;
      $msg = "looking for configuration file " . $rc_config_file;
      gp_message ("debug", $subr_name, $msg);
      if (-f $rc_config_file)
        {
          $msg = "found configuration file " . $rc_config_file;
          gp_message ("debug", $subr_name, $msg);
          $rc_file_found  = $TRUE;
          last;
        }
    }

if (not $rc_file_found)
#------------------------------------------------------------------------------
# There is no configuration file and we can skip this subroutine.
#------------------------------------------------------------------------------
    {
      $msg = "configuration file $rc_file_name not found";
      gp_message ("verbose", $subr_name, $msg);
      return (0);
    }
  else
    {
      $msg = "unable to open file $rc_config_file for reading:";
      open (GP_DISPLAY_HTML_RC, "<", "$rc_config_file")
        or die ($subr_name . " - " . $msg . " " . $!);
#------------------------------------------------------------------------------
# The configuration file has been opened for reading.
#------------------------------------------------------------------------------
      $msg = "file $rc_config_file has been opened for reading";
      gp_message ("debug", $subr_name, $msg);
    }

$msg = "found configuration file $rc_config_file";
  gp_message ("verbose", $subr_name, $msg);
  $msg = "processing configuration file " . $rc_config_file;
  gp_message ("debug", $subr_name, $msg);

#------------------------------------------------------------------------------
# Here we scan the configuration file for the settings.
#
# A setting consists of a keyword, optionally followed by a value.  It is
# optional because not all keywords may require a value.
#
# At the end of this block, all keyword/value pairs are stored in a hash.
#
# We do not yet check for the validity of these pairs. This is done next.
#
# The original code had this all integrated, but it made the code very
# complex with deeply nested if-statements. The flow was also hard to follow.
#------------------------------------------------------------------------------
  $parse_errors   = 0;
  $parse_warnings = 0;
  $line_number    = 0;
  while (my $line = <GP_DISPLAY_HTML_RC>)
    {
      chomp ($line);
      $line_number++;

gp_message ("debug", $subr_name, "read input line = $line");

#------------------------------------------------------------------------------
# Ignore a line with whitespace only
#------------------------------------------------------------------------------
      if ($line =~ /^\s*$/)
        {
          gp_message ("debug", $subr_name, "ignored a line with whitespace");
          next;
        }

#------------------------------------------------------------------------------
# Ignore a comment line, defined by starting with a "#", possibly prepended by
# whitespace.
#------------------------------------------------------------------------------
      if ($line =~ /^\s*\#/)
        {
          gp_message ("debug", $subr_name, "ignored a full comment line");
          next;
        }

#------------------------------------------------------------------------------
# Split the input line using the "#" symbol as a separator.  We have already
# handled the case of an isolated comment line, so there may only be an
# embedded comment.
#
# Regardless of this, we are only interested in the first part.
#------------------------------------------------------------------------------
      @split_line = split ("#", $line);

for my $i (@split_line)
        {
          gp_message ("debug", $subr_name, "elements after split of line: $i");
        }

$first_part = $split_line[0];
      gp_message ("debug", $subr_name, "relevant part = $first_part");

if ($first_part =~ /[&\^\*\@\$]+/)
#------------------------------------------------------------------------------
# The &, ^, *, @ and $ symbols should not occur.  If they do, we flag an error
# an fetch the next line.
#------------------------------------------------------------------------------
        {
          $parse_errors++;
          $msg = "non-supported character(s) (\&,\^,\*,\@,\$) found: $line";
          $error_and_warning_msgs{"error"}{$line_number}{"message"} = $msg;
          next;
        }
      else
#------------------------------------------------------------------------------
# Split the first part on whitespace and verify the number of fields to be
# valid.  Although we currently only have keywords with a value, a keyword
# without value is supported to.
#
# If the number of fields is valid, the keyword and value are stored.  In case
# of a single field, the value is assigned a special string.
#
# Although this situation should not occur, we do abort if something unexpected
# is encountered here.
#------------------------------------------------------------------------------
        {
          @my_fields = split (/\s/, $split_line[0]);

$number_of_fields = scalar (@my_fields);
          $msg = "number of fields = " . $number_of_fields;
          gp_message ("debug", $subr_name, $msg);
        }

if ($number_of_fields ge 3)
#------------------------------------------------------------------------------
# This is not supported.
#------------------------------------------------------------------------------
        {
          $parse_errors++;
          $msg = "more than 2 fields found: $first_part";
          $error_and_warning_msgs{"error"}{$line_number}{"message"} = $msg;
          next;
        }
      elsif ($number_of_fields eq 2)
        {
          $rc_keyword = $my_fields[0];
          $rc_value   = $my_fields[1];
        }
      elsif ($number_of_fields eq 1)
        {
          $rc_keyword = $my_fields[0];
          $rc_value   = "the_field_is_empty";
        }
      else
        {
          $msg  = "[line $line_number] $rc_config_file -";
          $msg .= " number of fields = $number_of_fields";
          gp_message ("assertion", $subr_name, $msg);
        }

#------------------------------------------------------------------------------
# Store the keyword, value and line number.
#------------------------------------------------------------------------------
      if (exists ($rc_settings_user{$rc_keyword}))
        {
          $parse_warnings++;
          my $prev_value = $rc_settings_user{$rc_keyword}{"value"};
          my $prev_line_number = $rc_settings_user{$rc_keyword}{"line_no"};
          if ($rc_value ne $prev_value)
            {
              $msg  = "option $rc_keyword previously set at line";
              $msg .= " $prev_line_number: new value '$rc_value'";
              $msg .= " ' overrides '$prev_value'";
            }
          else
            {
              $msg  = "option $rc_keyword previously set to the same value";
              $msg .= " at line $prev_line_number";
            }
          $error_and_warning_msgs{"warning"}{$line_number}{"message"} = $msg;
        }
      $rc_settings_user{$rc_keyword}{"value"}   = $rc_value;
      $rc_settings_user{$rc_keyword}{"line_no"} = $line_number;

gp_message ("debug", $subr_name, "stored keyword     = $rc_keyword");
      gp_message ("debug", $subr_name, "stored value       = $rc_value");
      gp_message ("debug", $subr_name, "stored line number = $line_number");
    }

#------------------------------------------------------------------------------
# Completed the parsing of the configuration file. It can be closed.
#------------------------------------------------------------------------------
  close (GP_DISPLAY_HTML_RC);

#------------------------------------------------------------------------------
# Print the raw input as just collected from the configuration file.
#------------------------------------------------------------------------------
  gp_message ("debug", $subr_name, "contents of %rc_settings_user:");
  for my $keyword (keys %rc_settings_user)
    {
      my $key_value = $rc_settings_user{$keyword}{"value"};
      $msg = "keyword = " . $keyword . " value = " . $key_value;
      gp_message ("debug", $subr_name, $msg);
    }

for my $rc_keyword  (keys %g_user_settings)
    {
       for my $fields (keys %{ $g_user_settings{$rc_keyword} })
         {
           $msg  = "before config file: $rc_keyword $fields =";
           $msg .= " " . $g_user_settings{$rc_keyword}{$fields};
           gp_message ("debug", $subr_name, $msg);
         }
    }

#------------------------------------------------------------------------------
# We are almost done.  Check for all keywords found whether they are valid.
# Also verify that the corresponding value is valid.
#
# Update the g_user_settings table if everything is okay.
#------------------------------------------------------------------------------

for my $rc_keyword (keys %rc_settings_user)
    {
      my $rc_value = $rc_settings_user{$rc_keyword}{"value"};

if (exists ( $g_user_settings{$rc_keyword}))
        {

#------------------------------------------------------------------------------
# This is a supported keyword.  There are two more things left to do:
# - Check how many values it requires (currently exactly one is supported)
# - Is the value a valid number or string?
#------------------------------------------------------------------------------
          $no_of_arguments = $g_user_settings{$rc_keyword}{"no_of_arguments"};

if ($no_of_arguments eq 1)
            {
              my $input_value = $rc_value;
              if ($input_value ne "the_field_is_empty")
#
#------------------------------------------------------------------------------
# So far, so good.  We only need to check if the value is valid for the keyword.
#------------------------------------------------------------------------------
                {
                  my $data_type   = $g_user_settings{$rc_keyword}{"data_type"};
                  my $valid_input =
			verify_if_input_is_valid ($input_value, $data_type);
#------------------------------------------------------------------------------
# Check if the value is valid.
#------------------------------------------------------------------------------
                  if ($valid_input)
                    {
                      $g_user_settings{$rc_keyword}{"current_value"} =
								$rc_value;
                      $g_user_settings{$rc_keyword}{"defined"}  = $TRUE;
                    }
                  else
                    {
                      $parse_errors++;
                      $line_number = $rc_settings_user{$rc_keyword}{"line_no"};
                      $msg  = "input value '$input_value' for keyword";
                      $msg .= " $rc_keyword is not valid";
                      $error_and_warning_msgs{"error"}{$line_number}{"message"}
								= $msg;
                      next;
                    }
                }
              else
#------------------------------------------------------------------------------
# This keyword requires a value, but none has been found.
#------------------------------------------------------------------------------
                {
                  $parse_errors++;
                  $line_number = $rc_settings_user{$rc_keyword}{"line_no"};
                  $msg = "missing value for keyword '$rc_keyword'";
                  $error_and_warning_msgs{"error"}{$line_number}{"message"}
								= $msg;
                  next;
                }
            }
          elsif ($no_of_arguments eq 0)
#------------------------------------------------------------------------------
# Currently a theoretical scenario since all commands require a value, but in
# case this is no longer true, we need to at least flag the fact the user set
# this command.
#------------------------------------------------------------------------------
            {
              $g_user_settings{$rc_keyword}{"defined"}  = $TRUE;
            }
          else
#------------------------------------------------------------------------------
# The code is not prepared for the situation one command has multiple values,
# but this situation should never occur. Still it won't hurt to add a check.
#------------------------------------------------------------------------------
            {
               my $msg = "cannot handle $no_of_arguments in the input";
               gp_message ("assertion", $subr_name, $msg);
            }
        }
      else
#------------------------------------------------------------------------------
# A non-valid keyword is found. This is flagged as an error.
#------------------------------------------------------------------------------
        {
          $parse_errors++;
          $line_number = $rc_settings_user{$rc_keyword}{"line_no"};
          $msg = "keyword $rc_keyword is not supported";
          $error_and_warning_msgs{"error"}{$line_number}{"message"} = $msg;
        }
    }
  for my $rc_keyword  (keys %g_user_settings)
    {
       for my $fields (keys %{ $g_user_settings{$rc_keyword} })
         {
           $msg  = "after config file: $rc_keyword $fields =";
           $msg .= " " . $g_user_settings{$rc_keyword}{$fields};
           gp_message ("debug", $subr_name, $msg);
         }
    }
  print_table_user_settings ("debug", "upon the return from $subr_name");

if ( ($parse_errors == 0) and ($parse_warnings == 0) )
    {
      $msg = "successfully parsed and processed the configuration file";
      gp_message ("verbose", $subr_name, $msg);
    }
  else
    {
      if ($parse_errors > 0)
        {
          my $plural_or_single = ($parse_errors > 1) ? "errors" : "error";
          $msg  = $g_error_keyword . "found $parse_errors fatal";
          $msg .= " " .  $plural_or_single . " in the configuration file:";
          gp_message ("debug", $subr_name, $msg);
#------------------------------------------------------------------------------
# Sort the hash keys, the line numbers, alphabetically and print the
# corresponding error messages.
#------------------------------------------------------------------------------
          for my $line_no (sort {$a <=> $b}
				(keys %{ $error_and_warning_msgs{"error"} }))
            {
              $msg  = $g_error_keyword . "[line $line_no] in file";
              $msg .=  $rc_config_file . " - ";
              $msg .= $error_and_warning_msgs{"error"}{$line_no}{"message"};
              gp_message ("debug", $subr_name, $msg);
            }
        }

if (not $g_quiet)
        {
          if ($parse_warnings > 0)
            {
              $msg  = $g_warn_keyword . " found $parse_warnings warnings in";
              $msg .= "  the configuration file:";
              gp_message ("debug", $subr_name, $msg);
              for my $line_no (sort {$a <=> $b}
				(keys %{ $error_and_warning_msgs{"warning"} }))
                {
                  $msg  = $g_warn_keyword;
                  $msg .= " [line $line_no] in file $rc_config_file - ";
                  $msg .= $error_and_warning_msgs{"warning"}{$line_no}{"message"};
                  gp_message ("debug", $subr_name, $msg);
                }
            }
        }
    }

return ($parse_errors);

} #-- End of subroutine process_rc_file

#------------------------------------------------------------------------------
# Generate the annotated html file for the source listing.
#------------------------------------------------------------------------------
sub process_source
{
  my $subr_name = get_my_name ();

my ($number_of_metrics, $function_info_ref,
      $outputdir, $input_filename) = @_;

my @function_info = @{ $function_info_ref };

#------------------------------------------------------------------------------
# The regex section
#------------------------------------------------------------------------------
  my $end_src1_header_regex = '(^\s+)(\d+)\.\s+(.*)';
  my $end_src2_header_regex = '(^\s+)(<Function: )(.*)>';
  my $function_regex        = '^(\s*)<Function:\s(.*)>';
  my $function2_regex       = '^(\s*)&lt;Function:\s(.*)>';
  my $src_regex             = '(\s*)(\d+)\.(.*)';
  my $txt_ext_regex         = '\.txt$';
  my $src_filename_id_regex = '^file\.(\d+)\.src\.txt$';
  my $integer_only_regex    = '\d+';
#------------------------------------------------------------------------------
# Computed dynamically below.
# TBD: Try to move this up.
#------------------------------------------------------------------------------
  my $src_times_regex;
  my $hot_lines_regex;
  my $metric_regex;
  my $metric_extra_regex;

my @components = ();
  my @fields_in_line = ();
  my @file_contents = ();
  my @hot_source_lines  = ();
  my @max_metric_values = ();
  my @modified_html = ();
  my @transposed_hot_lines = ();

my $colour_coded_line;
  my $colour_coded_line_ref;
  my $line_id;
  my $ignore_value;
  my $func_name_in_src_file;
  my $html_new_line = "<br>";
  my $input_line;
  my $metric_values;
  my $modified_html_ref;
  my $modified_line;
  my $is_empty;
  my $start_all_source;
  my $start_target_source;
  my $end_target_source;
  my $output_line;
  my $hot_line;
  my $src_line_no;
  my $src_code_line;

my $decimal_separator = $g_locale_settings{"decimal_separator"};
  my $hp_value = $g_user_settings{"highlight_percentage"}{"current_value"};

my $file_title;
  my $found_target;
  my $html_dis_record;
  my $html_end;
  my $html_header;
  my $html_home;
  my $rounded_percentage;
  my $start_tracking;
  my $threshold_line;

my $base;
  my $boldface;
  my $msg;
  my $routine;

my $LANG      = $g_locale_settings{"LANG"};
  my $the_title = set_title ($function_info_ref, $input_filename,
                             "process source");
  my $outfile   = $input_filename . ".html";

#------------------------------------------------------------------------------
# Remove the .txt from file.<n>.src.txt
#------------------------------------------------------------------------------
  my $html_output_file  = $input_filename;
  $html_output_file     =~ s/$txt_ext_regex/.html/;

gp_message ("debug", $subr_name, "input_filename = $input_filename");
  gp_message ("debug", $subr_name, "the_title = $the_title");

$file_title  = $the_title;
  $html_header = ${ create_html_header (\$file_title) };
  $html_home   = ${ generate_home_link ("right") };

push (@modified_html, $html_header);
  push (@modified_html, $html_home);
  push (@modified_html, "<pre>");

#------------------------------------------------------------------------------
# Open the html file used for the output.
#------------------------------------------------------------------------------
  open (NEW_HTML, ">", $html_output_file)
    or die ("$subr_name - unable to open file $html_output_file for writing: '$!'");
  gp_message ("debug", $subr_name , "opened file $html_output_file for writing");

$base = get_basename ($input_filename);

gp_message ("debug", $subr_name, "base = $base");

if ($base =~ /$src_filename_id_regex/)
    {
      my $file_id = $1;
      if (defined ($function_info[$file_id]{"routine"}))
        {
          $routine = $function_info[$file_id]{"routine"};

gp_message ("debugXL", $subr_name, "target routine = $routine");
        }
      else
        {
          my $msg = "cannot retrieve routine name for file_id = $file_id";
          gp_message ("assertion", $subr_name, $msg);
        }
    }

#------------------------------------------------------------------------------
# Check if the input file is empty.  If so, generate a short text in the html
# file and return.  Otherwise open the file and read the contents.
#------------------------------------------------------------------------------
  $is_empty = is_file_empty ($input_filename);

if ($is_empty)
    {
#------------------------------------------------------------------------------
# The input file is empty. Write a diagnostic message in the html file and exit.
#------------------------------------------------------------------------------
      gp_message ("debug", $subr_name ,"file $input_filename is empty");

my $comment = "No source listing generated by $tool_name - " .
                    "file $input_filename is empty";
      my $error_file = $outputdir . "gp-listings.err";

my $html_empty_file_ref = html_text_empty_file (\$comment, \$error_file);
      my @html_empty_file     = @{ $html_empty_file_ref };

print NEW_HTML "$_\n" for @html_empty_file;

close NEW_HTML;

return (0);
    }
  else
#------------------------------------------------------------------------------
# Open the input file with the source code
#------------------------------------------------------------------------------
    {
      open (SRC_LISTING, "<", $input_filename)
        or die ("$subr_name - unable to open file $input_filename for reading: '$!'");
      gp_message ("debug", $subr_name, "opened file $input_filename for reading");
    }

#------------------------------------------------------------------------------
# Generate the regex for the metrics.  This depends on the number of metrics.
#------------------------------------------------------------------------------
  gp_message ("debug", $subr_name, "decimal_separator = $decimal_separator<--");

$metric_regex = '';
  $metric_extra_regex = '';
  for my $metric_used (1 .. $number_of_metrics)
    {
      $metric_regex .= '(\d+' . $decimal_separator . '*\d*)\s+';
    }
  $metric_extra_regex = $metric_regex . '(\d+' . $decimal_separator . ')';

$hot_lines_regex = '^(#{2})\s+';
  $hot_lines_regex .= '('.$metric_regex.')';
  $hot_lines_regex .= '([0-9?]+)\.\s+(.*)';

$src_times_regex = '^(#{2}|\s{2})\s+';
  $src_times_regex .= '('.$metric_extra_regex.')';
  $src_times_regex .= '(.*)';

gp_message ("debugXL", $subr_name, "metric_regex   = $metric_regex");
  gp_message ("debugXL", $subr_name, "hot_lines_regex = $hot_lines_regex");
  gp_message ("debugXL", $subr_name, "src_times_regex = $src_times_regex");
  gp_message ("debugXL", $subr_name, "src_regex      = $src_regex");

gp_message ("debugXL", $subr_name, "end_src1_header_regex = $end_src1_header_regex");
  gp_message ("debugXL", $subr_name, "end_src2_header_regex = $end_src2_header_regex");
  gp_message ("debugXL", $subr_name, "function_regex = $function_regex");
  gp_message ("debugXL", $subr_name, "function2_regex = $function2_regex");
  gp_message ("debugXL", $subr_name, "src_regex = $src_regex");

#------------------------------------------------------------------------------
# Identify the header lines.  Make the minimal assumptions.
#
# In both cases, the first line after the header has whitespace.  This is
# followed by either one of the following:
#
# - <line_no>.
# - <Function:
#
# These are the characteristics we use below.
#------------------------------------------------------------------------------
  for (my $line_number=0; $line_number <= $#file_contents; $line_number++)
    {
      $input_line = $file_contents[$line_number];

#------------------------------------------------------------------------------
# We found the first source code line.  Bail out.
#------------------------------------------------------------------------------
      if (($input_line =~ /$end_src1_header_regex/) or
          ($input_line =~ /$end_src2_header_regex/))
        {
          gp_message ("debugXL", $subr_name, "header time is over - hit source line");
          gp_message ("debugXL", $subr_name, "line_number = $line_number");
          gp_message ("debugXL", $subr_name, "input_line = $input_line");
          last;
        }
      else
#------------------------------------------------------------------------------
# Store the header lines in the html structure.
#------------------------------------------------------------------------------
        {
          $modified_line = "<i>" . $input_line . "</i>";
          push (@modified_html, $modified_line);
        }
    }
#------------------------------------------------------------------------------
# We know the source code starts at this index value:
#------------------------------------------------------------------------------
  $start_all_source = scalar (@modified_html);
  gp_message ("debugXL", $subr_name, "source starts at start_all_source = $start_all_source");

#------------------------------------------------------------------------------
# Scan the file to identify where the target source starts and ends.
#------------------------------------------------------------------------------
  gp_message ("debugXL", $subr_name, "search for target function $routine");
  $start_tracking = $FALSE;
  $found_target   = $FALSE;
  for (my $line_number=0; $line_number <= $#file_contents; $line_number++)
    {
      $input_line = $file_contents[$line_number];

gp_message ("debugXL", $subr_name, "[$line_number] $input_line");

if ($input_line =~ /$function_regex/)
        {
          if (defined ($1) and defined ($2))
            {
              $func_name_in_src_file = $2;
              my $msg = "found a function - name = $func_name_in_src_file";
              gp_message ("debugXL", $subr_name, $msg);

if ($start_tracking)
                {
                  $start_tracking = $FALSE;
                  $end_target_source = $line_number - 1;
                  my $msg =  "end_target_source = $end_target_source";
                  gp_message ("debugXL", $subr_name, $msg);
                  last;
                }

if ($func_name_in_src_file eq $routine)
                {
                  $found_target        = $TRUE;
                  $start_tracking      = $TRUE;
                  $start_target_source = $line_number;

gp_message ("debugXL", $subr_name, "found target function $routine");
                  gp_message ("debugXL", $subr_name, "function_name = $2 routine = $routine");
                  gp_message ("debugXL", $subr_name, "routine = $routine start_tracking = $start_tracking");
                  gp_message ("debugXL", $subr_name, "start_target_source = $start_target_source");
                }
            }
          else
            {
              my $msg = "parsing line $input_line";
              gp_message ("assertion", $subr_name, $msg);
            }
        }
    }

#------------------------------------------------------------------------------
# This is not supposed to happen, but it is not a fatal error either.  The
# hyperlinks related to this function will not work, so a warning is issued.
# A message is issued both in debug mode, and as a warning.
#------------------------------------------------------------------------------
  if (not $found_target)
    {
      my $msg;

$msg = "target function $routine not found in $base - " .
             "links to source code involving this function will not work";
      gp_message ("debug", $subr_name, $msg);
      gp_message ("warning", $subr_name, $msg);
      $g_total_warning_count++;

return ($found_target);
    }

#------------------------------------------------------------------------------
# Catch the line number of the last function.
#------------------------------------------------------------------------------
  if ($start_tracking)
    {
      $end_target_source = $#file_contents;
    }
  gp_message ("debugXL", $subr_name, "routine = $routine start_tracking = $start_tracking");
  gp_message ("debugXL", $subr_name, "start_target_source = $start_target_source");
  gp_message ("debugXL", $subr_name, "end_target_source   = $end_target_source");

#------------------------------------------------------------------------------
# We now have the index range for the function of interest and will parse it.
# Since we already handled the first line with the function marker, we start
# with the line following.
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# Find the hot source lines and store them.
#------------------------------------------------------------------------------
  gp_message ("debugXL", $subr_name, "determine the maximum metric values");
  for (my $line_number=$start_target_source+1; $line_number <= $end_target_source; $line_number++)
    {
      $input_line = $file_contents[$line_number];
      gp_message ("debugXL", $subr_name, " $line_number : check input_line = $input_line");

if ( $input_line =~ /$hot_lines_regex/ )
        {
          gp_message ("debugXL", $subr_name, " $line_number : found a hot line");
#------------------------------------------------------------------------------
# We found a hot line and the metric fields are stored in $2.  We turn this
# string into an array and add it as a row to hot_source_lines.
#------------------------------------------------------------------------------
              $hot_line      = $1;
              $metric_values = $2;

gp_message ("debugXL", $subr_name, "hot_line = $hot_line");
              gp_message ("debugXL", $subr_name, "metric_values = $metric_values");

my @metrics = split (" ", $metric_values);
              push (@hot_source_lines, [@metrics]);
        }
      gp_message ("debugXL", $subr_name, " $line_number : completed check for hot line");
    }

#------------------------------------------------------------------------------
# Transpose the array with the hot lines.  This means each row has all the
# values for a metrict and it makes it easier to determine the maximum values.
#------------------------------------------------------------------------------
  for my $row (keys @hot_source_lines)
    {
      my $msg = "row[" . $row . "] =";
      for my $col (keys @{$hot_source_lines[$row]})
        {
          $msg .= " $hot_source_lines[$row][$col]";
          $transposed_hot_lines[$col][$row] = $hot_source_lines[$row][$col];
        }
    }

#------------------------------------------------------------------------------
# Print the maximum metric values found.  Each row contains the data for a
# different metric.
#------------------------------------------------------------------------------
  for my $row (keys @transposed_hot_lines)
    {
      my $msg = "row[" . $row . "] =";
      for my $col (keys @{$transposed_hot_lines[$row]})
        {
          $msg .= " $transposed_hot_lines[$row][$col]";
        }
      gp_message ("debugXL", $subr_name, "hot lines = $msg");
    }

#------------------------------------------------------------------------------
# Determine the maximum value for each metric.
#------------------------------------------------------------------------------
  for my $row (keys @transposed_hot_lines)
    {
      my $max_val = 0;
      for my $col (keys @{$transposed_hot_lines[$row]})
        {
          $max_val = max ($transposed_hot_lines[$row][$col], $max_val);
        }
#------------------------------------------------------------------------------
# Convert to a floating point number.
#------------------------------------------------------------------------------
      if ($max_val =~ /$integer_only_regex/)
        {
          $max_val = sprintf ("%f", $max_val);
        }
      push (@max_metric_values, $max_val);
    }

for my $metric (keys @max_metric_values)
      {
        my $msg = "$input_filename max_metric_values[$metric] = " .
                  $max_metric_values[$metric];
        gp_message ("debugXL", $subr_name, $msg);
      }

#------------------------------------------------------------------------------
# Process those functions that are not the current target.
#------------------------------------------------------------------------------
  $modified_html_ref = process_non_target_source ($start_all_source,
                                                  $start_target_source-1,
                                                  $src_times_regex,
                                                  $function_regex,
                                                  $number_of_metrics,
                                                  \@file_contents,
                                                  \@modified_html);
  @modified_html = @{ $modified_html_ref };

#------------------------------------------------------------------------------
# This is the core part to process the information for the target function.
#------------------------------------------------------------------------------
  gp_message ("debugXL", $subr_name, "parse and process the target source");
  $modified_html_ref = process_target_source ($start_target_source,
                                              $end_target_source,
                                              $routine,
                                              \@max_metric_values,
                                              $src_times_regex,
                                              $function2_regex,
                                              $number_of_metrics,
                                              \@file_contents,
                                              \@modified_html);
  @modified_html = @{ $modified_html_ref };

if ($end_target_source < $#file_contents)
    {
      $modified_html_ref = process_non_target_source ($end_target_source+1,
                                                      $#file_contents,
                                                      $src_times_regex,
                                                      $function_regex,
                                                      $number_of_metrics,
                                                      \@file_contents,
                                                      \@modified_html);
      @modified_html = @{ $modified_html_ref };
    }

gp_message ("debug", $subr_name, "completed reading source");

#------------------------------------------------------------------------------
# Add an extra line with diagnostics.
#
# TBD: The same is done in generate_dis_html but should be done only once.
#------------------------------------------------------------------------------
  if ($hp_value > 0)
    {
      my $rounded_percentage = sprintf ("%.1f", $hp_value);
      $threshold_line = "<i>The setting for the highlight percentage";
      $threshold_line .= " (--highlight-percentage) option:";
      $threshold_line .= " " . $rounded_percentage . " (%)</i>";
    }
  else
    {
      $threshold_line  = "<i>The highlight percentage feature has not been";
      $threshold_line .= " enabled</i>";
    }

$html_home = ${ generate_home_link ("left") };
  $html_end  = ${ terminate_html_document () };

push (@modified_html, "</pre>");
  push (@modified_html, "<br>");
  push (@modified_html, $threshold_line);
  push (@modified_html, $html_home);
  push (@modified_html, "<br>");
  push (@modified_html, $g_html_credits_line);
  push (@modified_html, $html_end);

for my $i (0 .. $#modified_html)
    {
      gp_message ("debugXL", $subr_name, "[$i] -> $modified_html[$i]");
    }

#------------------------------------------------------------------------------
# Write the generated HTML text to file.
#------------------------------------------------------------------------------
  for my $i (0 .. $#modified_html)
    {
      print NEW_HTML "$modified_html[$i]" . "\n";
    }
  close (NEW_HTML);
  close (SRC_LISTING);

return ($found_target);

} #-- End of subroutine process_source

#------------------------------------------------------------------------------
# Process the source lines for the target function.
#------------------------------------------------------------------------------
sub process_target_source
{
  my $subr_name = get_my_name ();

my ($start_scan, $end_scan, $target_function, $max_metric_values_ref,
      $src_times_regex, $function2_regex, $number_of_metrics,
      $file_contents_ref, $modified_html_ref) = @_;

my @file_contents = @{ $file_contents_ref };
  my @modified_html = @{ $modified_html_ref };
  my @max_metric_values = @{ $max_metric_values_ref };

my @components = ();

my $colour_coded_line;
  my $colour_coded_line_ref;
  my $hot_line;
  my $input_line;
  my $line_id;
  my $modified_line;
  my $metric_values;
  my $src_code_line;
  my $src_line_no;

gp_message ("debug", $subr_name, "parse and process the core loop");

for (my $line_number=$start_scan; $line_number <= $end_scan; $line_number++)
    {
      $input_line = $file_contents[$line_number];

#------------------------------------------------------------------------------
# We need to replace the "<" symbol in the code by "&lt;".
#------------------------------------------------------------------------------
      $input_line =~ s/$g_less_than_regex/$g_html_less_than_regex/g;

$line_id = extract_source_line_number ($src_times_regex,
                                             $function2_regex,
                                             $number_of_metrics,
                                             $input_line);

gp_message ("debug", $subr_name, "line_number = $line_number : input_line = $input_line line_id = $line_id");

if ($input_line =~ /$function2_regex/)
#------------------------------------------------------------------------------
# Found the function marker.
#------------------------------------------------------------------------------
        {
          if (defined ($1) and defined ($2))
            {
              my $func_name_in_file = $2;
              my $spaces = $1;
              my $boldface = $TRUE;
              gp_message ("debug", $subr_name, "function_name = $2");
              my $function_line       = "&lt;Function: " . $func_name_in_file . ">";
              my $color_function_name = color_string (
                                          $function_line,
                                          $boldface,
                                          $g_html_color_scheme{"target_function_name"});
              my $ftag;
              if (exists ($g_function_tag_id{$target_function}))
                {
                  $ftag = $g_function_tag_id{$target_function};
                  gp_message ("debug", $subr_name, "target_function = $target_function ftag = $ftag");
                }
              else
                {
                  my $msg = "no ftag found for $target_function";
                  gp_message ("assertion", $subr_name, $msg);
                }
              $modified_line = "<a id=\"" . $ftag . "\"></a>";
              $modified_line .= $spaces . "<i>" . $color_function_name . "</i>";
            }
        }
      elsif ($input_line =~ /$src_times_regex/)
#------------------------------------------------------------------------------
# This is a line with metric values.
#------------------------------------------------------------------------------
        {
          gp_message ("debug", $subr_name, "input line has metrics");

$hot_line      = $1;
          $metric_values = $2;
          $src_line_no   = $3;
          $src_code_line = $4;

gp_message ("debug", $subr_name, "hot_line = $hot_line");
          gp_message ("debug", $subr_name, "metric_values = $metric_values");
          gp_message ("debug", $subr_name, "src_line_no = $src_line_no");
          gp_message ("debug", $subr_name, "src_code_line = $src_code_line");

$colour_coded_line_ref = check_metric_values ($metric_values, \@max_metric_values);

$colour_coded_line = $ {$colour_coded_line_ref};
              if ($colour_coded_line)
                {
                  gp_message ("debugXL", $subr_name, "$line_number : change background colour modified_line = $modified_line");
                  $modified_line = set_background_color_string ($input_line, $g_html_color_scheme{"background_color_lukewarm"});
                }
              else
                {
                  $modified_line = "<a id=\"line_" . $line_id . "\"></a>";
                  $modified_line .= "$input_line";
                }
            }
        }
      else
#------------------------------------------------------------------------------
# This is a regular line that is not modified.
#------------------------------------------------------------------------------
        {
#------------------------------------------------------------------------------
# Add an id.
#------------------------------------------------------------------------------
          gp_message ("debug", $subr_name, "$line_number : input line is a regular line");
          $modified_line = "<a id=\"line_" . $line_id . "\"></a>";
          $modified_line .= "$input_line";
        }
      gp_message ("debug", $subr_name, "$line_number : mod = $modified_line");
      push (@modified_html, $modified_line);
    }

return (\@modified_html);

} #-- End of subroutine process_target_source

#------------------------------------------------------------------------------
# Process the options.  Set associated variables and check the options for
# correctness.  For example, detect if conflicting options have been set.
#------------------------------------------------------------------------------
sub process_user_options
{
  my $subr_name = get_my_name ();

my ($exp_dir_list_ref) = @_;

my @exp_dir_list = @{ $exp_dir_list_ref };

my %ignored_metrics = ();

my $abs_path_dir;
  my @candidate_ignored_metrics = ();
  my $error_code;
  my $hp_value;
  my $msg;

my $outputdir;

my $target_cmd;
  my $rm_output_msg;
  my $mkdir_output_msg;
  my $time_percentage_multiplier;
  my $process_all_functions;

#------------------------------------------------------------------------------
# The -o and -O options are mutually exclusive.
#------------------------------------------------------------------------------
  my $define_new_output_dir = $g_user_settings{"output"}{"defined"};
  my $overwrite_output_dir  = $g_user_settings{"overwrite"}{"defined"};
  my $dir_o_option          = $g_user_settings{"output"}{"current_value"};
  my $dir_O_option          = $g_user_settings{"overwrite"}{"current_value"};

if ($define_new_output_dir and $overwrite_output_dir)
    {
      $msg  = "the -o/--output and -O/--overwrite options are both set, " .
              "but are mutually exclusive";
      gp_message ("error", $subr_name, $msg);

$msg  = "(setting for -o = $dir_o_option, " .
              "setting for -O = $dir_O_option)";
      gp_message ("error", $subr_name, $msg);

$g_total_error_count++;
    }

#------------------------------------------------------------------------------
# The warnings option is deprecated.  Print a warning to this extent and point
# to the --nowarnings option.
#------------------------------------------------------------------------------
#------------------------------------------------------------------------------
# Handle the situation that both or one of the highlight-percentage and hp
# options are set.
#------------------------------------------------------------------------------
  if ($g_user_settings{"warnings"}{"defined"})
    {
      $msg  = "<br>" . "the --warnings option has been deprecated and";
      $msg .= " will be ignored";
      gp_message ("warning", $subr_name, $msg);

if ($g_user_settings{"nowarnings"}{"defined"})
        {
          $msg  = "since the --nowarnings option is also used, warnings";
          $msg .= " are disabled";
          gp_message ("warning", $subr_name, $msg);
        }
      else
        {
          $msg = "by default, warnings are enabled and can be disabled with";
          gp_message ("warning", $subr_name, $msg);
          $msg = " the --nowarnings option";
          gp_message ("warning", $subr_name, $msg);
        }
      $g_total_warning_count++;
    }

#------------------------------------------------------------------------------
# In case both the --highlight-percentage and -hp option are set, issue a
# warning and continue with the --highlight-percentage value.
#------------------------------------------------------------------------------
  if ($g_user_settings{"hp"}{"defined"})
    {
      $msg  = "<br>" . "the -hp option has been deprecated and";
      $msg .= " will be ignored";
      gp_message ("warning", $subr_name, $msg);

if ($g_user_settings{"highlight_percentage"}{"defined"})
        {
          $msg  = "since the --highlight-percentage option is also used,";
          $msg .= " the value of ";
          $msg .= $g_user_settings{"highlight_percentage"}{"current_value"};
          $msg .= " will be applied";
          gp_message ("warning", $subr_name, $msg);
        }
      else
        {
#------------------------------------------------------------------------------
# If only the -hp option is set, we use it, because we do not want to break
# compatibility (yet) and force the user to change the option.
#------------------------------------------------------------------------------

## FUTURE          $msg  = "instead, the default setting of "
## FUTURE          $msg .= $g_user_settings{"highlight_percentage"}{"current_value"};
## FUTURE          $msg .= " for the --highlight-percentage will be used";
## FUTURE          gp_message ("warning", $subr_name, $msg);

## FUTURE          $msg = "please use this option to set the highlighting value";
## FUTURE          gp_message ("warning", $subr_name, $msg);

$g_user_settings{"highlight_percentage"}{"current_value"} =
          $g_user_settings{"hp"}{"current_value"};

$g_user_settings{"highlight_percentage"}{"defined"} = $TRUE;

$msg = "for now, the value of " .
                 $g_user_settings{"hp"}{"current_value"} .
                 " for the -hp option is used, but please change the" .
                 " option to --highlight-percentage";
          gp_message ("warning", $subr_name, $msg);
        }

$g_total_warning_count++;
    }

#------------------------------------------------------------------------------
# Regardless of the use of the -hp option, we continue with the value for
# highlight-percentage.  Some more checks are carried out now.
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# This value should be in the interval [0,100].
# the number to be positive, but the limits have not been checked yet.
#------------------------------------------------------------------------------
  $hp_value = $g_user_settings{"highlight_percentage"}{"current_value"};

if (($hp_value < 0) or ($hp_value > 100))
    {
      $msg  = "the value for the highlight percentage is set to $hp_value,";
      $msg .= " but must be in the range [0, 100]";
      gp_message ("error", $subr_name, $msg);

$g_total_error_count++;
    }
  elsif ($hp_value == 0.0)
#------------------------------------------------------------------------------
# A value of zero is interpreted to mean that highlighting should be disabled.
# To make the checks for this later on easier, set it to an integer value of 0.
#------------------------------------------------------------------------------
    {
      $g_user_settings{"highlight_percentage"}{"current_value"} = 0;

$msg  = "reset the highlight percentage value from 0.0 to";
      $msg .= " " . $g_user_settings{"highlight_percentage"}{"current_value"};
      gp_message ("debug", $subr_name, $msg);
    }

#------------------------------------------------------------------------------
# The value for TP should be in the interval (0,100].  We already enforced
# the number to be positive, but the limits have not been checked yet.
#------------------------------------------------------------------------------
  my $tp_value = $g_user_settings{"threshold_percentage"}{"current_value"};

if (($tp_value < 0) or ($tp_value > 100))
    {
      $msg  = "the value for the total percentage is set to $tp_value,";
      $msg .=   " but must be in the range (0, 100]";
      gp_message ("error", $subr_name, $msg);

$g_total_error_count++;
    }
  else
    {
      $time_percentage_multiplier = $tp_value/100.0;

# Ruud  if (($TIME_PERCENTAGE_MULTIPLIER*100.) >= 100.)

if ($tp_value == 100)
        {
          $process_all_functions = $TRUE; # ensure that all routines are handled
        }
      else
        {
          $process_all_functions = $FALSE;
        }

$msg = "value of time_percentage_multiplier = " .
             $time_percentage_multiplier;
      gp_message ("debugM", $subr_name, $msg);
      $msg = "value of process_all_functions      = " .
             ($process_all_functions ? "TRUE" : "FALSE");
      gp_message ("debugM", $subr_name, $msg);
    }

#------------------------------------------------------------------------------
# If imetrics has been set, split the list into the individual metrics that
# need to be excluded.  The associated hash called $ignore_metrics has the
# to be excluded metrics as an index.  The value of $TRUE assigned does not
# really matter.
#------------------------------------------------------------------------------
  if ($g_user_settings{"ignore_metrics"}{"defined"})
    {
      @candidate_ignored_metrics =
              split (":", $g_user_settings{"ignore_metrics"}{"current_value"});
    }
  for my $metric (@candidate_ignored_metrics)
    {
# TBD: bug?      $ignored_metrics{$metric} = $FALSE;
      $ignored_metrics{$metric} = $TRUE;
    }
  for my $metric (keys %ignored_metrics)
    {
      my $msg = "ignored_metrics{$metric} = $ignored_metrics{$metric}";
      gp_message ("debugM", $subr_name, $msg);
    }

#------------------------------------------------------------------------------
# Check if the experiment directories exist and if they do, add the absolute
# path.  This is easier in the remainder.
#------------------------------------------------------------------------------
  for my $i (0 .. $#exp_dir_list)
    {
      if (-d $exp_dir_list[$i])
        {
          $abs_path_dir = Cwd::abs_path ($exp_dir_list[$i]);
          $exp_dir_list[$i] = $abs_path_dir;

$msg = "directory $exp_dir_list[$i] exists";
          gp_message ("debugM", $subr_name, $msg);
        }
    }

return (\%ignored_metrics, $outputdir, $time_percentage_multiplier,
	  $process_all_functions, \@exp_dir_list);

} #-- End of subroutine process_user_options

#------------------------------------------------------------------------------
# This function addresses a legacy issue.
#
# In binutils 2.40, the "gprofng display text" tool may add a string in the
# function overviews.  This did not add any value and was disruptive to the
# output.  It has been removed in 2.41, but in order to support the older
# versions of gprofng, the string is removed before the data is processed.
#
# Note: the double space in "--  no" is not a typo in this code!
#------------------------------------------------------------------------------
sub remove_redundant_string
{
  my $subr_name = get_my_name ();

my ($target_array_ref) = @_;

my @target_array = @{ $target_array_ref };

my $msg;
  my $redundant_string = " --  no functions found";

for (my $line = 0; $line <= $#target_array; $line++)
    {
      $target_array[$line] =~ s/$redundant_string//;
    }

$msg = "removed any occurrence of " . $redundant_string;
  gp_message ("debugM", $subr_name, $msg);

return (\@target_array);

} #-- End of subroutine remove_redundant_string

#------------------------------------------------------------------------------
# This is a hopefully temporary routine to disable/ignore selected user
# settings.  As the functionality expands, this list will get shorter.
#------------------------------------------------------------------------------
sub reset_selected_settings
{
  my $subr_name = get_my_name ();

$g_locale_settings{"decimal_separator"} = "\\.";
  $g_locale_settings{"convert_to_dot"}    = $FALSE;
  $g_user_settings{func_limit}{current_value} = 1000000;

gp_message ("debug", $subr_name, "reset selected settings");

return (0);

} #-- End of subroutine reset_selected_settings

#------------------------------------------------------------------------------
# There may be various different visibility characters in a metric definition.
# For example: e+%CPI.
#
# Internally we use a normalized definition that only uses the dot (e.g.
# e.CPI) as an index into the description structure.
#
# Here we reduce the incoming metric definition to the normalized form, look
# up the text, and return a pointer to it.
#------------------------------------------------------------------------------
sub retrieve_metric_description
{
  my $subr_name = get_my_name ();

my ($metric_name_ref, $metric_description_ref) = @_;

my $metric_name        = ${ $metric_name_ref };
  my %metric_description = %{ $metric_description_ref };

my $description;
  my $normalized_metric;

$metric_name =~ /([ei])([\.\+%]+)(.*)/;

if (defined ($1) and defined ($3))
    {
      $normalized_metric = $1 . "." . $3;
    }
  else
    {
      my $msg = "metric $metric_name has an unknown format";
      gp_message ("assertion", $subr_name, $msg);
    }

if (defined ($metric_description{$normalized_metric}))
    {
      $description = $metric_description{$normalized_metric};
    }
  else
    {
      my $msg = "description for normalized metric $normalized_metric not found";
      gp_message ("assertion", $subr_name, $msg);
    }

return (\$description);

} #-- End of subroutine retrieve_metric_description

#------------------------------------------------------------------------------
# TBD.
#------------------------------------------------------------------------------
sub rnumerically
{
  my ($f1,$f2);
  if ($a =~ /^([^\d]*)(\d+)/)
    {
      $f1 = int ($2);
      if ($b=~ /^([^\d]*)(\d+)/)
        {
          $f2 = int ($2);
          $f1 == $f2 ? 0 : ($f1 > $f2 ? -1 : +1);
        }
    }
  else
    {
      return ($b <=> $a);
    }
} #-- End of subroutine rnumerically

#------------------------------------------------------------------------------
# TBD: Remove - not used any longer.
# Set the architecture and associated regular expressions.
#------------------------------------------------------------------------------
sub set_arch_and_regexes
{
  my $subr_name = get_my_name ();

my ($arch_uname) = @_;

my $architecture_supported;

gp_message ("debug", $subr_name, "arch_uname = $arch_uname");

if ($arch_uname eq "x86_64")
    {
      #x86/x64 hardware uses jump
      $architecture_supported = $TRUE;
#      $arch='x64';
#      $regex=':\s+(j).*0x[0-9a-f]+';
#      $subexp='(\[\s*)(0x[0-9a-f]+)';
#      $linksubexp='(\[\s*)(0x[0-9a-f]+)';
      gp_message ("debug", $subr_name, "detected $arch_uname hardware");

$architecture_supported = $TRUE;
      $g_arch_specific_settings{"arch_supported"}  = $TRUE;
      $g_arch_specific_settings{"arch"}       = 'x64';
      $g_arch_specific_settings{"regex"}     = ':\s+(j).*0x[0-9a-f]+';
      $g_arch_specific_settings{"subexp"}     = '(\[\s*)(0x[0-9a-f]+)';
      $g_arch_specific_settings{"linksubexp"} = '(\[\s*)(0x[0-9a-f]+)';
    }
#------------------------------------------------------------------------------
# TBD: Remove the elsif block
#------------------------------------------------------------------------------
  elsif ($arch_uname=~m/sparc/s)
    {
      #sparc hardware uses branch
      $architecture_supported = $FALSE;
#      $arch='sparc';
#      $regex=':\s+(c|b|fb).*0x[0-9a-f]+\s*$';
#      $subexp='(\s*)(0x[0-9a-f]+)\s*$';
#      $linksubexp='(\s*)(0x[0-9a-f]+\s*$)';
#      gp_message ("debug", $subr_name, "detected $arch_uname hardware arch = $arch - this is no longer supported");
      $architecture_supported = $FALSE;
      $g_arch_specific_settings{arch_supported}  = $FALSE;
      $g_arch_specific_settings{arch}       = 'sparc';
      $g_arch_specific_settings{regex}     = ':\s+(c|b|fb).*0x[0-9a-f]+\s*$';
      $g_arch_specific_settings{subexp}     = '(\s*)(0x[0-9a-f]+)\s*$';
      $g_arch_specific_settings{linksubexp} = '(\s*)(0x[0-9a-f]+\s*$)';
    }
  else
    {
      $architecture_supported = $FALSE;
      gp_message ("debug", $subr_name, "detected $arch_uname hardware - this not supported; limited functionality");
    }

return ($architecture_supported);

} #-- End of subroutine set_arch_and_regexes

#------------------------------------------------------------------------------
# Set the background color of the input string.
#
# For supported colors, see:
# https://www.w3schools.com/colors/colors_names.asp
#------------------------------------------------------------------------------
sub set_background_color_string
{
  my $subr_name = get_my_name ();

my ($input_string, $color) = @_;

my $background_color_string;
  my $msg;

$msg = "color = $color input_string = $input_string";
  gp_message ("debugXL", $subr_name, $msg);

$background_color_string = "<span style='background-color: " . $color .
                             "'>" . $input_string . "</span>";

$msg = "color = $color background_color_string = " .
         $background_color_string;
  gp_message ("debugXL", $subr_name, $msg);

return ($background_color_string);

} #-- End of subroutine set_background_color_string

#------------------------------------------------------------------------------
# Set the g_debug_size structure for a given value for "size".  Also set the
# value in $g_user_settings{"debug"}{"current_value"}
#------------------------------------------------------------------------------
sub set_debug_size
{
  my $subr_name = get_my_name ();

my $debug_value = lc ($g_user_settings{"debug"}{"current_value"});

#------------------------------------------------------------------------------
# Set the corresponding sizes in the table.  A value of "on" is equivalent to
# size "s".
#------------------------------------------------------------------------------
  if (($debug_value eq "on") or ($debug_value eq "s"))
    {
      $g_debug_size{"on"} = $TRUE;
      $g_debug_size{"s"}  = $TRUE;
    }
  elsif ($debug_value eq "m")
    {
      $g_debug_size{"on"} = $TRUE;
      $g_debug_size{"s"}  = $TRUE;
      $g_debug_size{"m"}  = $TRUE;
    }
  elsif ($debug_value eq "l")
    {
      $g_debug_size{"on"} = $TRUE;
      $g_debug_size{"s"}  = $TRUE;
      $g_debug_size{"m"}  = $TRUE;
      $g_debug_size{"l"}  = $TRUE;
    }
  elsif ($debug_value eq "xl")
    {
      $g_debug_size{"on"} = $TRUE;
      $g_debug_size{"s"}  = $TRUE;
      $g_debug_size{"m"}  = $TRUE;
      $g_debug_size{"l"}  = $TRUE;
      $g_debug_size{"xl"} = $TRUE;
    }
  else
#------------------------------------------------------------------------------
# Any other value is considered to disable debugging.
#------------------------------------------------------------------------------
    {
##      $g_user_settings{"debug"}{"current_value"} = "off";
      $g_debug            = $FALSE;
      $g_debug_size{"on"} = $FALSE;
      $g_debug_size{"s"}  = $FALSE;
      $g_debug_size{"m"}  = $FALSE;
      $g_debug_size{"l"}  = $FALSE;
      $g_debug_size{"xl"} = $FALSE;
    }

#------------------------------------------------------------------------------
# Activate in case of an emergency :-)
#------------------------------------------------------------------------------
  my $show_sizes = $FALSE;

if ($show_sizes)
    {
      if ($g_debug_size{$debug_value})
        {
          for my $i (keys %g_debug_size)
            {
              print "$subr_name g_debug_size{$i} = $g_debug_size{$i}\n";
            }
        }
    }

return (0);

} #-- End of subroutine set_debug_size

#------------------------------------------------------------------------------
# This subroutine defines the default metrics.
#------------------------------------------------------------------------------
sub set_default_metrics
{
  my $subr_name = get_my_name ();

my ($outfile1, $ignored_metrics_ref) = @_;

my %ignored_metrics = %{ $ignored_metrics_ref };

my %metric_description = ();
  my %metric_found       = ();

my $detail_metrics;
  my $detail_metrics_system;

my $call_metrics    = "";
  my $summary_metrics = "";

open (METRICS, "<", $outfile1)
    or die ("Unable to open metrics file $outfile1 for reading - '$!'");
  gp_message ("debug", $subr_name, "opened $outfile1 for reading");

while (<METRICS>)
    {
      my $metric_line = $_;
      chomp ($metric_line);

gp_message ("debug", $subr_name,"the value of metric_line = $metric_line");

#------------------------------------------------------------------------------
# Decode the metric part of the input line. If a valid line, return the
# metric components. Otherwise return "skipped" in the metric_spec field.
#------------------------------------------------------------------------------
      my ($metric_spec, $metric_flavor, $metric_visibility, $metric_name,
                $metric_description) = extract_metric_specifics ($metric_line);

gp_message ("debug", $subr_name, "metric_spec   = $metric_spec");
      gp_message ("debug", $subr_name, "metric_flavor = $metric_flavor");

if ($metric_spec eq "skipped")
#------------------------------------------------------------------------------
# Not a valid input line.
#------------------------------------------------------------------------------
        {
          gp_message ("debug", $subr_name, "skipped line: $metric_line");
        }
      else
        {
#------------------------------------------------------------------------------
# A valid metric field has been found.
#------------------------------------------------------------------------------
          gp_message ("debug", $subr_name, "metric_name        = $metric_name");
          gp_message ("debug", $subr_name, "metric_description = $metric_description");

#        if (exists ($IMETRICS{$m})){
          if ($g_user_settings{"ignore_metrics"}{"defined"} and exists ($ignored_metrics{$metric_name}))
            {
              gp_message ("debug", $subr_name, "user requested to ignore metric $metric_name");
              next;
            }

#------------------------------------------------------------------------------
# Only the exclusive metric is selected.
#------------------------------------------------------------------------------
          if ($metric_flavor eq "e")
            {
              $metric_found{$metric_spec}       = $TRUE;
              $metric_description{$metric_spec} = $metric_description;

# TBD: remove the -AO:
              gp_message ("debug", $subr_name,"-AO metric_description{$metric_spec} = $metric_description{$metric_spec}");

$summary_metrics .= $metric_spec.":";
              $call_metrics .= "a.".$metric_name.":";
            }
        }
    }
  close (METRICS);

chop ($call_metrics);
  chop ($summary_metrics);

$detail_metrics        = $summary_metrics;
  $detail_metrics_system = $summary_metrics;

return (\%metric_description, \%metric_found,
         $summary_metrics, $detail_metrics, $detail_metrics_system, $call_metrics);

} #-- End of subroutine set_default_metrics

#------------------------------------------------------------------------------
# Set various system specific variables.  These depend upon both the processor
# architecture and OS. The values are stored in global structure
# g_arch_specific_settings.
#------------------------------------------------------------------------------
sub set_system_specific_variables
{
  my $subr_name = get_my_name ();

my ($arch_uname, $arch_uname_s) = @_;

my $elf_arch;
  my $read_elf_cmd;
  my $elf_support;
  my $architecture_supported;
  my $arch;
  my $regex;
  my $subexp;
  my $linksubexp;

if ($arch_uname eq "x86_64")
    {
#------------------------------------------------------------------------------
# x86/x64 hardware uses jump
#------------------------------------------------------------------------------
      $architecture_supported = $TRUE;
      $arch       = 'x64';
      $regex     =':\s+(j).*0x[0-9a-f]+';
      $subexp     ='(\[\s*)(0x[0-9a-f]+)';
      $linksubexp ='(\[\s*)(0x[0-9a-f]+)';

#      gp_message ("debug", $subr_name, "detected $arch_uname hardware arch = $arch");

$g_arch_specific_settings{"arch_supported"} = $TRUE;
      $g_arch_specific_settings{"arch"}           = 'x64';
#------------------------------------------------------------------------------
# Define the regular expressions to parse branch instructions.
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# TBD: Need much more than these
#------------------------------------------------------------------------------
      $g_arch_specific_settings{"regex"} = '\.*([0-9a-fA-F]*):\s+(j).*\s*0x([0-9a-fA-F]+)';
      $g_arch_specific_settings{"subexp"} = '(0x[0-9a-f]+)';
      $g_arch_specific_settings{"linksubexp"} = '(\s*)(0x[0-9a-f]+)';
    }
  else
    {
      $architecture_supported = $FALSE;
      $g_arch_specific_settings{"arch_supported"}  = $FALSE;
    }

#------------------------------------------------------------------------------
# TBD Ruud: need to handle this better
#------------------------------------------------------------------------------
  if ($arch_uname_s eq "Linux")
    {
      $elf_arch     = $arch_uname_s;
      $read_elf_cmd = $g_mapped_cmds{"readelf"};

if ($read_elf_cmd eq "road to nowhere")
        {
          $elf_support = $FALSE;
        }
      else
        {
          $elf_support = $TRUE;
        }
      gp_message ("debugXL", $subr_name, "elf_support = $elf_support read_elf_cmd = $read_elf_cmd elf_arch = $elf_arch");
    }
  else
    {
      gp_message ("abort", $subr_name, "the $arch_uname_s operating system is not supported");
    }

return ($architecture_supported, $elf_arch, $elf_support);

} #-- End of subroutine set_system_specific_variables

my ($function_info_ref, $func, $from_where) = @_ ;

my $msg;
  my @function_info = @{$function_info_ref};
  my $filename = $func ;

my $base;
  my $first_line;
  my $file_is_empty;
  my $src_file;
  my $RI;
  my $the_title;
  my $routine = "?";
  my $DIS;
  my $SRC;

chomp ($filename);

$base = get_basename ($filename);

gp_message ("debug", $subr_name, "from_where = $from_where");
  gp_message ("debug", $subr_name, "base = $base filename = $filename");

if ($from_where eq "process source")
    {
      if ($base =~ /^file\.(\d+)\.src\.txt$/)
        {
          if (defined ($1))
            {
              $RI = $1;
            }
          else
            {
              $msg = "unexpected error encountered parsing $filename";
              gp_message ("assertion", $subr_name, $msg);
            }
        }
      $the_title = "Source";
    }
  elsif ($from_where eq "disassembly")
    {
      if ($base =~ /^file\.(\d+)\.dis$/)
        {
          if (defined ($1))
            {
              $RI = $1;
            }
          else
            {
              $msg = "unexpected error encountered parsing $filename";
              gp_message ("assertion", $subr_name, $msg);
            }
        }
      $the_title = "Disassembly";
    }
  else
    {
      $msg = "called from unknown routine - $from_where";
      gp_message ("assertion", $subr_name, $msg);
    }

if (defined ($function_info[$RI]{"routine"}))
    {
      $routine = $function_info[$RI]{"routine"};
    }

if ($from_where eq "process source")
    {
      $file_is_empty = is_file_empty ($filename);

if ($file_is_empty)
        {
          $src_file = "";
        }
      else
        {
          open ($SRC, "<", $filename)
            or die ("$subr_name - unable to open source file $filename for reading:'$!'");
          gp_message ("debug", $subr_name, "opened file $filename for reading");

$first_line = <$SRC>;
          chomp ($first_line);

close ($SRC);

gp_message ("debug", $subr_name, "first_line = $first_line");

if ($first_line =~ /^Source\s+file:\s+([^\s]+)/)
            {
              $src_file = $1
            }
          else
            {
              $src_file = "";
            }
        }
    }
  elsif ($from_where eq "disassembly")
    {
      $msg = "unable to open disassembly file $filename for reading:";
      open ($DIS, "<", $filename)
        or die ($subr_name . " - " . $msg . " " . $!);
      gp_message ("debug", $subr_name, "opened file $filename for reading");

$file_is_empty = is_file_empty ($filename);

if ($file_is_empty)
#------------------------------------------------------------------------------
# Currently, the disassembly file for <static> functions appears to be empty
# on aarch64.  This might be a bug, but it is in any case better to handle
# this situation.
#------------------------------------------------------------------------------
        {
          $first_line = "";
          $msg = "file $filename is empty";
          gp_message ("debugM", $subr_name, $msg);
        }
      else
        {
          $first_line = <$DIS>;
        }

close ($DIS);

if ($first_line =~ /^Source\s+file:\s+([^\s]+)/)
        {
          $src_file = "$1"
        }
      else
        {
          $src_file = "";
        }
    }

if (length ($routine))
    {
      $the_title .= " $routine";
    }

if (length ($src_file))
    {
      if ($src_file ne "(unknown)")
        {
          $the_title .= " ($src_file)";
        }
      else
        {
          $the_title .= " $src_file";
        }
    }

return ($the_title);

} #-- End of subroutine set_title

#------------------------------------------------------------------------------
# Handles where the output should go.  If needed, a directory to store the
# results in is created.
#------------------------------------------------------------------------------
sub set_up_output_directory
{
  my $subr_name = get_my_name ();

my $error_code;
  my $msg;
  my $mkdir_output_msg;
  my $outputdir = "does_not_exist_yet";
  my $rm_output_msg;
  my $success;
  my $target_cmd;

my $define_new_output_dir = $g_user_settings{"output"}{"defined"};
  my $overwrite_output_dir  = $g_user_settings{"overwrite"}{"defined"};

if ((not $define_new_output_dir) and (not $overwrite_output_dir))
#------------------------------------------------------------------------------
# If neither -o or -O are set, find the next number to be used in the name for
# the default output directory.
#------------------------------------------------------------------------------
    {
      my $dir_id = 1;
      while (-d "display.".$dir_id.".html")
        { $dir_id++; }
      $outputdir = "display.".$dir_id.".html";
    }
  elsif ($define_new_output_dir)
#------------------------------------------------------------------------------
# The output directory is defined with the -o option.
#------------------------------------------------------------------------------
    {
      $outputdir = $g_user_settings{"output"}{"current_value"};
    }
  elsif ($overwrite_output_dir)
#------------------------------------------------------------------------------
# The output directory is defined with the -O option.
#------------------------------------------------------------------------------
    {
      $outputdir = $g_user_settings{"overwrite"}{"current_value"};
    }

#------------------------------------------------------------------------------
# The name of the output directory is known and we can proceed.
#------------------------------------------------------------------------------
  $msg = "the target output directory is $outputdir";
  gp_message ("debug", $subr_name, $msg);

if (-d $outputdir)
    {
#------------------------------------------------------------------------------
# The -o option is used, but the directory already exists.
#------------------------------------------------------------------------------
      if ($define_new_output_dir)
        {
          $msg  = "directory $outputdir already exists";
          gp_message ("error", $subr_name, $msg);
          $msg  = "use the -O/--overwite  option to overwrite an";
          $msg .= " existing directory";
          gp_message ("error", $subr_name, $msg);

$g_total_error_count++;

gp_message ("abort", $subr_name, $g_abort_msg);

}
      elsif ($overwrite_output_dir)
#------------------------------------------------------------------------------
# It is a bit risky to remove this directory and so we proceed with caution.
# What if the user decides to call it "*" e.g. "-O \*" for example? While this
# should have been caught when processing the options, we still like to
# be very cautious here before executing /bin/rm -rf.
#------------------------------------------------------------------------------
        {
          if ($outputdir eq "*")
            {
              $msg = "it is not allowed to use * as a value for the -O option";
              gp_message ("error", $subr_name, $msg);

$g_total_error_count++;

gp_message ("abort", $subr_name, $g_abort_msg);
            }
          else
            {
#------------------------------------------------------------------------------
# The output directory exists, but it is okay to overwrite it. It is
# removed here and created again below.
#------------------------------------------------------------------------------
              $target_cmd = $g_mapped_cmds{"rm"} . " -rf " . $outputdir;
              ($error_code, $rm_output_msg) = execute_system_cmd ($target_cmd);

if ($error_code != 0)
                  {
                    $msg = "fatal error when trying to remove $outputdir";
                    gp_message ("error", $subr_name, $rm_output_msg);
                    gp_message ("error", $subr_name, $msg);

$g_total_error_count++;

gp_message ("abort", $subr_name, $g_abort_msg);
                  }
                else
                  {
                    $msg = "directory $outputdir has been removed";
                    gp_message ("debug", $subr_name, $msg);
                  }
            }
        }
    } #-- End of if-check for $outputdir

#------------------------------------------------------------------------------
# When we get here, the fatal scenarios have not occurred and the name for
# $outputdir is known.  Time to create it.  Note that recursive creation is
# supported and the user umask settings control the access permissions.
#------------------------------------------------------------------------------
  $target_cmd = $g_mapped_cmds{"mkdir"} . " -p " . $outputdir;
  ($error_code, $mkdir_output_msg) = execute_system_cmd ($target_cmd);

if ($error_code != 0)
    {
      $msg = "a fatal problem occurred when creating directory $outputdir";
      gp_message ("error", $subr_name, $mkdir_output_msg);
      gp_message  ("error", $subr_name, $msg);

$g_total_error_count++;

gp_message ("abort", $subr_name, $g_abort_msg);
    }
  else
    {
      $msg = "created output directory $outputdir";
      gp_message  ("debug", $subr_name, $msg);
    }

return ($outputdir);

} #-- End of subroutine set_up_output_directory

#------------------------------------------------------------------------------
# Split a line with function data into 3 components.
#------------------------------------------------------------------------------
sub split_function_data_line
{
  my $subr_name = get_my_name ();

my ($input_line_ref) = @_;

my $input_line = ${ $input_line_ref };

my $decimal_separator = $g_locale_settings{"decimal_separator"};
  my $full_hex_address;
  my $function_name;
  my $hex_address;
  my $length_metric_list;
  my $length_remainder;
  my $length_target_string;
  my $list_with_metrics;
  my $marker;
  my $msg;
  my $reduced_line;
  my $remainder;
 
  my @hex_addresses = ();
  my @special_marker = ();
  my @the_function_name = ();

my $find_hex_address_regex = '\s*(\d+:0x[a-fA-F0-9]+)\s+(.*)';
  my $find_marker_regex = '(^\*).*';
  my $find_metrics_1_regex  = '\)*\ +([0-9,' . $decimal_separator;
     $find_metrics_1_regex .= '\ ]*$)';
  my $find_metrics_2_regex  = '\)*\ +\[.+\]\s+([0-9,' . $decimal_separator;
     $find_metrics_2_regex  = '\ ]*$)';
  my $get_hex_address_regex = '(\d+):0x(\S+)';

$reduced_line = $input_line;

if ($input_line =~ /$find_hex_address_regex/)
    {
      if (defined ($1) )
        {
          $full_hex_address = $1;
          $reduced_line =~ s/$full_hex_address//;

$msg = "full_hex_address = " . $full_hex_address;
          gp_message ("debugXL", $subr_name, $msg);
          $msg = "reduced_line = " . $reduced_line;
          gp_message ("debugXL", $subr_name, $msg);
        }
      if (defined ($2) )
        {
          $remainder = $2;
          $msg = "remainder = " . $remainder;
          gp_message ("debugXL", $subr_name, $msg);

if (($remainder =~ /$find_metrics_1_regex/) or
              ($remainder =~ /$find_metrics_2_regex/))
            {
              if (defined ($1))
                {
                  $list_with_metrics = $1;
                  $msg = "before list_with_metrics = " . $list_with_metrics;
                  gp_message ("debugXL", $subr_name, $msg);

$list_with_metrics =~ s/$g_rm_surrounding_spaces_regex//g;
                  $msg = "after list_with_metrics = " . $list_with_metrics;
                  gp_message ("debugXL", $subr_name, $msg);

#------------------------------------------------------------------------------
# Remove the function name from the string.
#------------------------------------------------------------------------------
                  $length_remainder   = length ($remainder);
                  $length_metric_list = length ($list_with_metrics);

$msg = "length remainder = " . $length_remainder;
                  gp_message ("debugXL", $subr_name, $msg);

$msg = "length list_with_metrics = " . $length_metric_list;
                  gp_message ("debugXL", $subr_name, $msg);

$length_target_string = $length_remainder -
                                          $length_metric_list - 1;
                  $function_name = substr ($remainder, 0,
                                           $length_target_string, '');

$msg = "new function_name  = " . $function_name;
                  gp_message ("debugXL", $subr_name, $msg);

$reduced_line = $function_name;
                  $reduced_line =~ s/$g_rm_surrounding_spaces_regex//g;

$msg = "reduced_line = " . $reduced_line;
                  gp_message ("debugXL", $subr_name, $msg);

#------------------------------------------------------------------------------
# In some lines, the function name has a "*" prepended.  Isolate this marker
# and later on remove it from the function name.
# TBD: Can probably be done more efficiently.
#------------------------------------------------------------------------------
                  if ($reduced_line =~ /$find_marker_regex/)
                    {
                      if (defined ($1))
                        {
                          $marker = $1;
                          $msg = "found the marker = " . $marker;
                          gp_message ("debugXL", $subr_name, $msg);
                        }
                      else
                        {
                          $msg  = "first character in " . $reduced_line ;
                          $msg .= " is not expected";
                          gp_message ("assertion", $subr_name, $msg);
                        }
                    }
                  else
                    {
                          $marker = "X";
                    }
                }
              else
                {
                  $msg  = "failure to find metric values following the ";
                  $msg .= "function name";
                  gp_message ("assertion", $subr_name, $msg);
                }
            }
          else
            {
              $msg = "cannot find metric values in remainder";
              gp_message ("debugXL", $subr_name, $msg);
              gp_message ("assertion", $subr_name, $msg);
            }
        }
#------------------------------------------------------------------------------
# We now have the 3 main objects from the input line.  Next, they are processed
# and stored.
#------------------------------------------------------------------------------
      if ($full_hex_address =~ /$get_hex_address_regex/)
        {
          if (defined ($1) and defined ($2))
            {
              $hex_address = "0x" . $2;
              push (@hex_addresses, $full_hex_address);

$msg = "pushed full_hex_address = " . $full_hex_address;
              gp_message ("debugXL", $subr_name, $msg);
            }
        }
      else
        {
          $msg = "full_hex_address = $full_hex_address has an unknown format";
          gp_message ("assertion", $subr_name, $msg);
        }
      if ($marker eq "*")
        {
          push (@special_marker, "*");
        }
      else
        {
          push (@special_marker, "X");
        }

$reduced_line =~ s/^\*//;

$msg = "RESULT full_hex_address = " . $full_hex_address;
      $msg .= " -- metric values = " . $list_with_metrics;
      $msg .= " -- marker = " . $marker;
      $msg .= " -- function name = " . $reduced_line;
      gp_message ("debugXL", $subr_name, $msg);
    }

return (\$full_hex_address, \$marker, \$reduced_line, \$list_with_metrics);

} #-- End of subroutine split_function_data_line

#------------------------------------------------------------------------------
# Routine to generate webfriendly names
#------------------------------------------------------------------------------
sub tag_name
{
  my $subr_name = get_my_name ();

my ($target_name) = @_;

#------------------------------------------------------------------------------
# Keeps track how many names have been tagged already.
#------------------------------------------------------------------------------
  state $S_total_tagged_names = 0;

my $msg;
  my $unique_name;

gp_message ("debug", $subr_name, "target_name on entry  = $target_name");

#------------------------------------------------------------------------------
# Undo conversion of < in to &lt;
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
# TBD: Legacy - What is going on here and is this really needed?!
# We need to replace the "<" symbol in the code by "&lt;".
#------------------------------------------------------------------------------
  $target_name =~ s/$g_html_less_than_regex/$g_less_than_regex/g;

#------------------------------------------------------------------------------
# Remove inlining info
#------------------------------------------------------------------------------
  $target_name =~ s/, instructions from source file.*//;

if (defined $g_tagged_names{$target_name})
    {
      $msg  = "target_name = $target_name is already defined: ";
      $msg .= $g_tagged_names{$target_name};
      gp_message ("debug", $subr_name, $msg);

$msg = "target_name on return = $target_name";
      gp_message ("debug", $subr_name, $msg);

return ($g_tagged_names{$target_name});
    }
  else
    {
      $unique_name = "ftag".$S_total_tagged_names;
      $S_total_tagged_names++;
      $g_tagged_names{$target_name} = $unique_name;

$msg  = "target_name = $target_name is new and added: ";
      $msg .= "g_tagged_names{$target_name} = $g_tagged_names{$target_name}";
      gp_message ("debug", $subr_name, $msg);

$msg = "target_name on return = $target_name";
      gp_message ("debug", $subr_name, $msg);

return ($unique_name);
    }

} #-- End of subroutine tag_name

#------------------------------------------------------------------------------
# Generate a string to terminate the HTML document.
#------------------------------------------------------------------------------
sub terminate_html_document
{
  my $subr_name = get_my_name ();

my $html_line;

$html_line  = "</body>\n";
  $html_line .= "</html>";

return (\$html_line);

} #-- End of subroutine terminate_html_document

#------------------------------------------------------------------------------
# Perform some basic checks to ensure the input data is consistent.  This part
# could be refined and expanded over time.  For example by using a checksum
# mechanism to verify the consistency of the executables.
#------------------------------------------------------------------------------
sub verify_consistency_experiments
{
  my $subr_name = get_my_name ();

my ($exp_dir_list_ref) = @_;

my @exp_dir_list    = @{ $exp_dir_list_ref };

my $executable_name;
  my $full_path_executable_name;
  my $msg;
  my $ref_executable_name;

my $first_exp_dir     = $TRUE;
  my $count_differences = 0;

#------------------------------------------------------------------------------
# Enforce that the full path names to the executable are the same.  This could
# be overkill and a checksum approach would be more flexible.
#------------------------------------------------------------------------------
  for my $full_exp_dir (@exp_dir_list)
    {
      my $exp_dir = get_basename ($full_exp_dir);
      gp_message ("debug", $subr_name, "exp_dir = $exp_dir");
      if ($first_exp_dir)
        {
          $first_exp_dir = $FALSE;
          $ref_executable_name =
			$g_exp_dir_meta_data{$exp_dir}{"full_path_exec"};
          $msg = "ref_executable_name = " . $ref_executable_name;
          gp_message ("debug", $subr_name, $msg);
          next;
        }
        $full_path_executable_name =
			$g_exp_dir_meta_data{$exp_dir}{"full_path_exec"};
        $msg = "full_path_executable_name = " . $full_path_executable_name;
        gp_message ("debug", $subr_name, $msg);

if ($full_path_executable_name ne $ref_executable_name)
          {
            $count_differences++;
            $msg  = $full_path_executable_name . " does not match";
            $msg .= " " . $ref_executable_name;
            gp_message ("debug", $subr_name, $msg);
          }
    }

$executable_name = get_basename ($ref_executable_name);

return ($count_differences, $executable_name);

} #-- End of subroutine verify_consistency_experiments

#------------------------------------------------------------------------------
# Check if the input item is valid for the data type specified. Validity is
# verified in the context of gprofng.  The definition for the metrics is a
# good example of that.
#------------------------------------------------------------------------------
sub verify_if_input_is_valid
{
  my $subr_name = get_my_name ();

my ($input_item, $data_type) = @_;

my $msg;
  my $return_value = $FALSE;

#------------------------------------------------------------------------------
# These value are allowed to be case insensitive, so we convert to lower
# case first.
#------------------------------------------------------------------------------
  if (($data_type eq "onoff") or ($data_type eq "size"))
    {
      $input_item = lc ($input_item);
    }

if ($data_type eq "metrics")
#------------------------------------------------------------------------------
# A gprofng metric definition.  Either consists of "default" only, or starts
# with e or i, followed by one or more from the set {.,%,!,+} and a keyword.
# This pattern may be repeated with a ":" as the separator.
#------------------------------------------------------------------------------
    {
      my @metric_list = split (":", $input_item);

#------------------------------------------------------------------------------
# Check if the pattern is valid.  If not, bail out and return $FALSE.
#------------------------------------------------------------------------------
      for my $metric (@metric_list)
        {
          if ($metric =~ /^default$|^[a-z]*$/)
            {
              $return_value = $TRUE;
            }
          else
            {
              $return_value = $FALSE;
              last;
            }
        }
    }
  elsif ($data_type eq "path")
#------------------------------------------------------------------------------
# This can be almost anything, including "/" and "."
#------------------------------------------------------------------------------
    {
      if ($input_item =~ /^[\w\/\.\-]*$/)
        {
          $return_value = $TRUE;
        }
    }
  elsif ($data_type eq "boolean")
    {
#------------------------------------------------------------------------------
# This is TRUE (=1) or FALSE (0).
#------------------------------------------------------------------------------
      if ($input_item =~ /^[01]$/)
        {
          $return_value = $TRUE;
        }
    }
  elsif ($data_type eq "onoff")
#------------------------------------------------------------------------------
# This is either "on" OR "off".
#------------------------------------------------------------------------------
    {
      if ($input_item =~ /^on$|^off$/)
        {
          $return_value = $TRUE;
        }
    }
  elsif ($data_type eq "size")
#------------------------------------------------------------------------------
# Supported values are "on", "off", "s", "m", "l", or "xl".
#------------------------------------------------------------------------------
    {
      if ($input_item =~ /^on$|^off$|^s$|^m$|^l$|^xl$/)
        {
          $return_value = $TRUE;
        }
    }
  elsif ($data_type eq "pinteger")
#------------------------------------------------------------------------------
# This is a positive integer.
#------------------------------------------------------------------------------
    {
      if ($input_item =~ /^\d*$/)
        {
          $return_value = $TRUE;
        }
    }
  elsif ($data_type eq "integer")
#------------------------------------------------------------------------------
# This is a positive or negative integer.
#------------------------------------------------------------------------------
    {
      if ($input_item =~ /^\-?\d*$/)
        {
          $return_value = $TRUE;
        }
    }
  elsif ($data_type eq "pfloat")
#------------------------------------------------------------------------------
# This is a positive floating point number, but we accept a positive integer
# number as well.
#
# TBD: Note that we use the "." here. Maybe should support a "," too.
#------------------------------------------------------------------------------
    {
      if (($input_item =~ /^\d*\.\d*$/) or ($input_item =~ /^\d*$/))
        {
          $return_value = $TRUE;
        }
    }
  elsif ($data_type eq "float")
#------------------------------------------------------------------------------
# This is a positive or negative floating point number, but we accept an
# integer number as well.
#
# TBD: Note that we use the "." here. Maybe should support a "," too.
#------------------------------------------------------------------------------
    {
      if (($input_item =~ /^\-?\d*\.\d*$/) or ($input_item =~ /^\-?\d*$/))
        {
          $return_value = $TRUE;
        }
    }
  else
    {
      $msg = "the $data_type data type for input $input_item is not supported";
      gp_message ("assertion", $subr_name, $msg);
    }

return ($return_value);

} #-- End of subroutine verify_if_input_is_valid

#------------------------------------------------------------------------------
# Scan the leftovers in ARGV.  Other than the option generated by the driver,
# this list should be empty.  Anything left here is considered to be a fatal
# error and pushed into the g_error_msgs buffer.
#
# We use two different arrays for the errors found.  This allows us to group
# the same type of errors.
#------------------------------------------------------------------------------
sub wrap_up_user_options
{
  my $subr_name = get_my_name ();

my @opt_unsupported = ();
  my @opt_ignored     = ();

my $current_option;
  my $driver_inserted = "--whoami=gprofng display html";
  my $ignore_option;
  my $msg;
  my $option_delimiter = "--";

if (@ARGV)
    {
      $msg = "items in ARGV: " . join (" ", @ARGV);
      gp_message ("debugXL", $subr_name, $msg);

$ignore_option = $FALSE;
      for my $i (keys @ARGV)
        {
          $current_option = $ARGV[$i];

$msg = "ARGV[$i] = $current_option";

if ($current_option eq $option_delimiter)
#------------------------------------------------------------------------------
# The user may use a feature of GetOptions to delimit the options.  After
# this, only experiment names are allowed and these have been handled already,
# so anything found after this delimite is an error.
#
# This is why we set a flag if the delimiter has been found.
#------------------------------------------------------------------------------
            {
              $ignore_option = $TRUE;
              gp_message ("debugXL", $subr_name, $msg . " (option delimiter)");
            }
          elsif ($ignore_option)
#------------------------------------------------------------------------------
# We have seen the delimiter, but there are still options, or other strings.
# In any case, it is not allowed.
#------------------------------------------------------------------------------
            {
              push (@opt_ignored, $current_option);
              gp_message ("debugXL", $subr_name, $msg . " (ignored)");
            }
          elsif ($current_option ne $driver_inserted)
#------------------------------------------------------------------------------
# The gprofng driver inserts this and it should be ignored.  This is why we
# only recorded those options different than the one inserted by the driver.
#------------------------------------------------------------------------------
            {
              push (@opt_unsupported, $current_option);
              gp_message ("debugXL", $subr_name, $msg . " (unsupported)");
            }
          else
#------------------------------------------------------------------------------
# The gprofng driver inserts this option and it should be ignored.
#------------------------------------------------------------------------------
            {
              gp_message ("debugXL", $subr_name, $msg .
                          " (driver inserted and ignored)");
            }
        }
    }

#------------------------------------------------------------------------------
# Store any illegal input in the g_error_msgs buffer.
#------------------------------------------------------------------------------
  if (@opt_ignored)
    {
      $msg = "the following input is out of place:";
      for my $i (keys @opt_ignored)
        {
          $msg .= " " . $opt_ignored[$i];
        }
      gp_message ("error", $subr_name, $msg);

$g_total_error_count++;
    }
  if (@opt_unsupported)
    {
      $msg = "the following items in the input are not supported:";
      for my $i (keys @opt_unsupported)
        {
          $msg .= " " . $opt_unsupported[$i];
        }
      gp_message ("error", $subr_name, $msg);

$msg  = "perhaps an error in the option name, or an option value";
      $msg .= " is missing?";
      gp_message ("error", $subr_name, $msg);

$g_total_error_count++;
    }

return (0);

} #-- End of subroutine wrap_up_user_options