Settings.pm

#-----------------------------------------------------------------------
# Fault InJection Instrumenter (FIJI)
# https://embsys.technikum-wien.at/projects/vecs/fiji
#
# The creation of this file has been supported by the publicly funded
# R&D project Josef Ressel Center for Verification of Embedded Computing
# Systems (VECS) managed by the Christian Doppler Gesellschaft (CDG).
#
# Authors:
# Christian Fibich <fibich@technikum-wien.at>
# Stefan Tauner <tauner@technikum-wien.at>
#
# This module is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
# 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 LICENSE file for more details.
#-----------------------------------------------------------------------

## @file Settings.pm
# @brief Contains class \ref FIJI::Settings

## @class FIJI::Settings
# @brief Contains helper functions to deal with FIJI Settings files.

package FIJI::Settings;

use strict;
use warnings;

use Scalar::Util 'blessed';
use Log::Log4perl qw(get_logger);
use Scalar::Util "looks_like_number";
use POSIX qw(ceil);
use List::Util qw(max);
use File::Spec;

use FIJI::ConfigSorted;
use FIJI qw(:all);

## @var @base_resources stores the resource count for default config
my @base_resources;

## @function public new ($phase, $fiji_ini_file, $existing_settings, $nl_ref)
# Create a new settings instance.
#
# @param phase             Tool flow phase the settings need to be compatible with.
# @param fiji_ini_file     (optional) Path to the configuration file to read.
# @param existing_settings (optional) A reference to reuse and return with values read from file.
#                          Any contained data will be cleared.
# @param nl_ref            A reference to a FIJI::netlist (for validation of nets and drivers only)
# @returns                 A list comprising a) The new settings instance (or undef in the case of an error),
#                          b) a diagnostic string describing the reason why it could not be created (undef if successful),
#                          c) a diagnostic string describing any anomalies of \c $fiji_ini_file that did not hinder creation.
sub new {
    my $logger = get_logger("");
    my ($class, $phase, $fiji_ini_file, $existing_settings, $nl_ref) = @_;

    my $fiji_settings_ref;

    # if there is no existing settings instance yet, create one
    if (!defined($existing_settings)) {
        $fiji_settings_ref = {};
        $fiji_settings_ref = bless($fiji_settings_ref, $class);
    } else {
        $fiji_settings_ref = $existing_settings;
    }
    if (!blessed($fiji_settings_ref) || !$fiji_settings_ref->isa("FIJI::Settings")) {
        my $msg;
        if (!defined($existing_settings)) {
            $msg = "Could not create FIJI::Settings instance.";
        } else {
            $msg = "Given settings are not of type FIJI::Settings.";
        }
        $logger->error($msg);
        return (undef, $msg);
    }

    my ($errors, $warnings);
    # If there is a file given, try to read it. Else just create a default instance.
    if (defined($fiji_ini_file)) {
        ($fiji_settings_ref, $errors, $warnings) = read_settingsfile($phase, $fiji_ini_file, $fiji_settings_ref, $nl_ref);
        if (!defined($fiji_settings_ref)) {
            return (undef, $errors, $warnings);
        }
        $fiji_settings_ref->{'filename'} = $fiji_ini_file;
    } else {
        $fiji_settings_ref->{'design'} = {};
        _set_defaults(DESIGNMAP, $fiji_settings_ref->{'design'}, $phase);
        $fiji_settings_ref->{'fius'}     = [];
        $fiji_settings_ref->{'filename'} = File::Spec->curdir();
    }

    @base_resources = _est_resources(DESIGNMAP->{'FREQUENCY'}->{'default'}, DESIGNMAP->{'BAUDRATE'}->{'default'}, DESIGNMAP->{'TIMER_WIDTH'}->{'default'}, DESIGNMAP->{'RST_DUT_IN_DUR'}->{'default'}, DESIGNMAP->{'LFSR_WIDTH'}->{'default'}, 1, "logarithmic");

    return ($fiji_settings_ref, $errors, $warnings);
}

sub _export_value {
    my $logger = get_logger("");
    my ($map_ref, $k, $v_ref) = @_;

    if (defined($map_ref->{$k}->{'type'})) {
        my $orig = ${$v_ref};
        if ($map_ref->{$k}->{'type'} eq 'hexadecimal' || $map_ref->{$k}->{'type'} eq 'lfsrpoly') {
            ${$v_ref} = sprintf("0x%x", $orig);

            # } elsif ($map_ref->{$k}->{'type'} eq 'natural') {
            # } elsif ($map_ref->{$k}->{'type'} eq 'boolean') {
            $logger->trace("Converted value of $k (\"$orig\") to \"${$v_ref}\".") if ($orig ne ${$v_ref});
        } elsif ($map_ref->{$k}->{'type'} eq 'net' || $map_ref->{$k}->{'type'} eq 'driver') {
            # Due to an annoying behavior of Config::Simple we have to enclose
            # escaped identifiers with quotes. These are necessary to preserve spaces.
            # This also helps with concatenations... so simply quote all nets unconditionally.
            ${$v_ref} = "\"$orig\"";
        }
    }
}

## @method public save ($fiji_ini_file)
# @brief Store contained FIJI Settings to file.
#
# @attention Will happily overwrite existing files!
#
# @param fiji_ini_file The file name to write the FIJI Settings to.
sub save ($) {
    my $logger = get_logger("");
    my ($self, $fiji_ini_file) = @_;
    return "No file name given" if !defined($fiji_ini_file);

    my $fiji_ini = new FIJI::ConfigSorted(syntax => 'ini');
    my $design_ref;
    my $fiu_cnt = 0;
    foreach my $key (keys %{$self}) {
        my $val = $self->{$key};
        if (ref(\$val) eq "REF") {
            if (ref($val) eq "HASH") {
                if ($key eq "design") {
                    $design_ref = $val;
                    next;
                }
            } elsif (ref($val) eq "ARRAY") {
                if ($key eq "fius") {
                    foreach my $fiu (@{$val}) {
                        my $ini_fiu;

                        foreach my $k (keys(%{$fiu})) {
                            my $ini_name = FIUMAP->{$k}->{'ini_name'};
                            if (!defined($fiu->{$k})) {
                                $logger->debug("Skip saving undefined value of FIU constant with key $ini_name.");
                                next;
                            }

                            # Copy value to new hash with external naming.
                            $ini_fiu->{$ini_name} = $fiu->{$k};

                            # Convert value to external representation
                            _export_value(FIUMAP, $k, \$ini_fiu->{$ini_name});
                            $logger->trace(sprintf("Exporting FIU%d setting %s -> %s (%s -> %s).", $fiu_cnt, $k, $ini_name, defined($fiu->{$k}) ? $fiu->{$k} : "undef", defined($ini_fiu->{$ini_name}) ? $ini_fiu->{$ini_name} : "undef"),);
                        }
                        $fiji_ini->set_block("FIU" . $fiu_cnt++, $ini_fiu);
                    }
                    next;
                }
            }
        } elsif ($key eq "filename") {
            next;
        }

        my $err = "Unknown element found in FIJI Settings: key: \"$key\" val: \"$val\"";
        $logger->error($err);
        return $err;
    }
    $design_ref->{'FIU_NUM'} = $fiu_cnt;
    my $ini_design;
    foreach my $k (keys(%{$design_ref})) {
        my $ini_name = DESIGNMAP->{$k}->{'ini_name'};
        if (!defined($design_ref->{$k})) {
            $logger->debug("Skip saving undefined value of design constant with key $ini_name.");
            next;
        }

        # Copy value to new hash with external naming.
        $ini_design->{$ini_name} = $design_ref->{$k};

        # Convert value to external representation
        _export_value(DESIGNMAP, $k, \$ini_design->{$ini_name});
        $logger->trace(sprintf("Exporting Design setting %s -> %s (%s -> %s).", $k, $ini_name, defined($design_ref->{$k}) ? $design_ref->{$k} : "undef", defined($ini_design->{$ini_name}) ? $ini_design->{$ini_name} : "undef"),);
    }
    $fiji_ini->set_block("CONSTS", $ini_design);

    if (!defined($fiji_ini->write($fiji_ini_file))) {
        my $err = FIJI::ConfigSorted->error();
        $logger->error($err);
        return $err;
    }
    $self->{'filename'} = $fiji_ini_file;
    return undef;
}

## @function public read_settingsfile ($phase, $fiji_ini_file, $existing_settings, $nl_ref)
# @brief Load the FIJI Settings file containing design and FIU constants.
#
# @param phase  Tool flow phase the settings stored in the given file
#               need to be compatible with.
# @param fiji_ini_file The name of an .ini file with FIJI Settings:
#         - a 'consts' block containing the constants specified by
#           \ref _sanitize_design.
#         - at least one FIU block named "FIU<number>" where "<number>"
#           is a strictly increasing integer starting with 0 containing
#           the constants for the respective FIU, see \ref _sanitize_fiu
# @param existing_settings (optional) A reference to reuse and return with values read from file.
#                          Any contained data will be cleared.
# @param nl_ref A reference to a FIJI::netlist (for validation of nets and drivers only)
#
# @returns A list comprising a) a reference to the hash containing the read constants (or undef in the case of an error),
#          b) a diagnostic string describing the reason why it could not be created (undef if successful),
#          c) a diagnostic string describing any anomalies of \c $fiji_ini_file that did not hinder creation.
sub read_settingsfile ($$$) {
    my $logger = get_logger("");
    my ($phase, $fiji_ini_file, $existing_settings, $nl_ref) = @_;
    my $fiji_ini;
    eval { $fiji_ini = new FIJI::ConfigSorted($fiji_ini_file) };    # pesky library tries to die on syntax errors
    if (!defined($fiji_ini)) {
        my $submsg = defined($@) ? $@ : FIJI::ConfigSorted->error();
        if (length($submsg) == 0) {
            $submsg = "Empty file?";
        }
        my $msg = "Could not read config file \"$fiji_ini_file\": $submsg";
        $logger->error($msg);
        return (undef, $msg);
    }

    my $design_ref = $fiji_ini->get_block("CONSTS");
    if (!(%$design_ref)) {
        my $msg = "Could not fetch CONSTS block from config file \"$fiji_ini_file\"";
        $logger->error($msg);
        return (undef, $msg);
    }
    _set_defaults(DESIGNMAP, $design_ref, $phase);

    $design_ref = _rename_import(DESIGNMAP, $design_ref);
    if (!defined($design_ref)) {
        my $msg = "Design constants do not match the FIJI Settings naming scheme.";
        $logger->error($msg);
        return (undef, $msg);
    }

    # Create a new instance or reuse the shallow hull of the existing one
    my $fiji_settings_ref;
    if (!defined($existing_settings)) {
        $fiji_settings_ref = {};
        bless($fiji_settings_ref, "FIJI::Settings");
    } else {
        $fiji_settings_ref = $existing_settings;

        # Clear the hash
        for (keys %$fiji_settings_ref) {
            delete $fiji_settings_ref->{$_};
        }
    }
    if (!blessed($fiji_settings_ref) || !$fiji_settings_ref->isa("FIJI::Settings")) {
        my $msg;
        if (!defined($existing_settings)) {
            $msg = "Could not create FIJI::Settings instance.";
        } else {
            $msg = "Given settings are not of type FIJI::Settings.";
        }
        $logger->error($msg);
        return (undef, $msg);
    }
    $fiji_settings_ref->{'design'} = $design_ref;
    $fiji_settings_ref->{'fius'}   = [];

    # sanitize and validate read design constants

    my ($errors, $warnings);
    ($design_ref, $errors, $warnings) = _sanitize_design($design_ref, $phase, $nl_ref);
    if (!ref($design_ref)) {
        $logger->error($errors);
        return (undef, $errors, $warnings);
    }

    my $fiu_num = 0;
    my $error;
    # Loop over all read FIUs
    while (1) {

        my $fiu_id = "FIU" . $fiu_num;
        my $fiu_ref  = $fiji_ini->get_block($fiu_id);
        if (!(%$fiu_ref)) {
            last;
        }
        $fiu_ref = _rename_import(FIUMAP, $fiu_ref);
        if (!defined($fiu_ref)) {
            my $msg = "FIU constants of $fiu_id do not match the FIJI Settings naming scheme.";
            $logger->error($msg);
            return (undef, $msg);
        }

        my $tmp_fiu = {};
        _set_defaults(FIUMAP, $tmp_fiu, $phase, $design_ref, $fiu_num);

        # overwrite default entries
        foreach my $k (keys(%{$fiu_ref})) {
            $tmp_fiu->{$k} = $fiu_ref->{$k};
        }
        $fiu_ref = $tmp_fiu;

        my ($fiu_errors, $fiu_warnings);
        ($fiu_ref, $fiu_errors, $fiu_warnings) = _sanitize_fiu($fiu_ref, $phase, $nl_ref);
        if (!ref($fiu_ref)) {
            my $msg = "";
            $msg .= "$errors\n" if defined($errors);
            $msg .= "Fatal problems sanitizing $fiu_id:\n$fiu_errors";
            $logger->error($msg);
            return (undef, $msg, $warnings);
        }
        my $name_str = $fiu_id;
        $name_str .= " (".$fiu_ref->{'FIU_NAME'} . ")" if (defined($fiu_ref->{'FIU_NAME'}) && $fiu_ref->{'FIU_NAME'} ne "");
        if (defined($fiu_errors)) {
            $errors = "" if !defined($errors);
            $errors .= "$name_str:\n$fiu_errors";
        }

        if (defined($fiu_warnings)) {
            $warnings = "" if !defined($warnings);
            $warnings .= "$name_str:\n$fiu_warnings";
        }

        $fiji_settings_ref->{'fius'}->[$fiu_num] = $fiu_ref;
        $fiu_num++;
        $logger->trace("Read in $fiu_id from FIJI Settings file successfully.");
    }

    if ($fiu_num == 0) {
        my $msg = "No FIU blocks in config file. Synthesis would fail.";
        $logger->warn($msg);
        if ($phase eq 'instrument') {
            $errors = "" if !defined($errors);
            $errors .= "$msg\n";
        } else {
            $warnings = "" if !defined($warnings);
            $warnings .= "$msg\n";
        }
    }

    # FIU_NUM is optional in the Settings file... if it was set check that
    # it corresponds to the number of FIU<number> blocks.
    if (defined($design_ref->{'FIU_NUM'}) && $design_ref->{'FIU_NUM'} != $fiu_num) {
        my $msg = FIU_NUM->{'ini_name'} . " does not match the numbers of FIU blocks found (and loaded).";
        $logger->warn($msg);
        $warnings = defined($warnings) ? "$warnings\n" : "";
        $warnings .= "$msg\n";
    }
    $design_ref->{'FIU_NUM'} = $fiu_num; # assume the best if FIU_NUM constant is not given or misleading

    my $dups = $fiji_settings_ref->determine_duplicate_fiu_nets();
    my @dup_nets = keys(%{$dups});
    if (scalar(@dup_nets) > 0) {
        my $msg = "More than one FIU is attached to the following net(s):\n";
        for my $dup (@dup_nets) {
            $msg .= "$dup is attached to FIUs " . join(", ", @{$dups->{$dup}}) . "\n";
        }
        chomp($msg);
        if ($phase eq 'instrument') {
            $logger->error($msg);
            if (defined($errors)) {
                $errors .= "\n$msg\n";
            } else {
                $errors = "$msg\n";
            }
        } else {
            $logger->warn($msg);
            if (defined($warnings)) {
                $warnings .= "\n$msg\n";
            } else {
                $warnings = "$msg\n";
            }
        }
    }

    $logger->info("Successfully read in design constants and $fiu_num FIU definitions from FIJI Settings file \"$fiji_ini_file\".") if !defined($errors);
    return (!defined($errors) ? $fiji_settings_ref : undef, $errors, $warnings);
}

## @method determine_duplicate_fiu_nets (@$fius_ref)
# @brief Test for multiple instrumentations of a single net
#
# @param fius_ref   arrayref to a list of FIU hashes
# @param netname    (optional) Look only for a specific net.
#
# @returns          a (possible empty) hash keys by nets that are referred to multiple times.
#                   The values are arrays of FIU indices that refer to the key's net.
sub determine_duplicate_fiu_nets {
    my ($self, $target_net) = @_;

    my $fius_ref = $self->{'fius'};
    my $seen = {};
    my $dup_nets = {};
    my $i = 0;
    foreach my $fiu_ref (@{$fius_ref}) {
        my $netname = $fiu_ref->{'FIU_NET_NAME'};
        if (defined($netname) && length($netname) > 0) {
            if (!defined($target_net) || ($target_net eq $netname)) {
                if (defined $seen->{$netname}) {
                    if (!defined($dup_nets->{$netname})) {
                        $dup_nets->{$netname} = [$seen->{$netname}];
                    }
                    push(@{$dup_nets->{$netname}}, $i);
                } else {
                    $seen->{$netname} = $i;
                }
            }
        }
        $i += 1;
    }
    return $dup_nets;
}

## @method public set_fiu_defaults (%$fiu_ref)
# @brief Overwrite existing fields (if defined) with defaults defined in FIJI.pm.
#
sub set_fiu_defaults ($) {
    my ($self, $consts_ref, $phase, $fiu_num) = @_;
    return _set_defaults(FIUMAP, $consts_ref, $phase, $self->{'design'}, $fiu_num);
}

## @method public default_timer_value()
# @brief Return sensible default timer values for these settings
sub default_timer_value {
    my ($self) = @_;
    # default to 10 ms at default frequency
    return (10e-3 * $self->{'design'}->{'FREQUENCY'});
}

## @function _set_defaults (%$map_ref, %$consts_ref)
# @brief Set defaults according to FIJI.pm.
sub _set_defaults {
    my $logger = get_logger("");
    my ($map_ref, $consts_ref, $phase, $design_ref, $fiu_num) = @_;
    foreach my $k (keys(%{$map_ref})) {
        if (exists($map_ref->{$k}->{'default'})) {

            # Set default only if it is not mandatory in the given phase.
            if (defined($phase) && scalar(grep { $_ eq $phase } @{$map_ref->{$k}->{'phases_opt'}}) == 0) {
                next;
            }

            # Also, do not overwrite existing values
            if (defined($consts_ref->{$k})) {
                next;
            }
            my $default = $map_ref->{$k}->{default};
            if (ref($default) eq 'CODE') {
                $consts_ref->{$k} = $default->($consts_ref, $phase, $design_ref, $fiu_num);
            } else {
                $consts_ref->{$k} = $default;
            }
            $logger->trace(sprintf("Adding default constant: %s (%s) = %s.", $k, $map_ref->{$k}->{'ini_name'}, $map_ref->{$k}->{default}));
        }
    }
}

# @method _validate_port_entry
# Checks if a port name is valid.
#
# @param map_ref    reference to FIJI Settings mappings
# @param nl_ref     reference to a FIJI::netlist (for validation of nets, drivers etc. only)
# @param k          key identifying the respective setting
# @param new        the proposed value
# @param consts_ref reference to related settings hash
sub _validate_port_entry {
    my $logger = get_logger("");
    my ($map_ref, $nl_ref, $k, $new, $consts_ref) = @_;
    my $ok = 0;

    return "Netlist not available" if !defined($nl_ref);
    return "Port name is empty" if ($new eq "");

    # We have to avoid names of other FIJI entries
    # (e.g. RST_EXT_IN_NAME could conflict with TRIG_EXT_IN_NAME)...
    my @other_fiji_ports;
    foreach my $map_key (keys %{$map_ref}) {
        my $type = $map_ref->{$map_key}->{'type'};
        # Gather entries of type dut_port and external_port only
        next if !($type eq 'dut_port' || $type eq 'external_port');
        # Ignore disabled entries
        next if _disabled_via_dependency($map_ref, $consts_ref, $map_key);
        # Push all remaining entries excluding the one under validation
        push(@other_fiji_ports, $consts_ref->{$map_key}) if $map_key ne $k;
    }
    return "Port name $new is already used for another FIJI port" if _is_in_list(\@other_fiji_ports, $new);

    # Additionally, we need to check against the top level ports of the DUT that will get passed on to FIJI's top.
    my $dut_ports = $nl_ref->get_toplevel_port_names;
    # For external ports originating in FIJI itself they need to be neither used by the DUT nor other FIJI elements, thus
    #   ok = not in ext_ports and not in dut_ports
    if ($map_ref->{$k}->{'type'} eq 'external_port') {
        return "Port name $new already exists as DUT port" if _is_in_list($dut_ports, $new);

    # In the case of elements connecting to existing DUT ports (type dut_port),
    # the latter need to exist in the DUT but are not allowed to be used for other purposes of FIJI. Thus:
    #   ok = not in ext_ports and in dut_ports
    } elsif ($map_ref->{$k}->{'type'} eq 'dut_port') {
        return "Port name $new does not refer to a DUT port" if not _is_in_list($dut_ports, $new);
    } else {
        my $msg = sprintf("Internal error: unknown type %s (used in %s)", $map_ref->{$k}->{'type'}, $k);
        $logger->fatal($msg);
        return $msg;
    }
    return undef;
}

sub _is_in_list {
    my ($valid_list_ref, $new) = @_;
    my $logger = get_logger("");
    if (!ref($valid_list_ref)) {
        return 1;
    }
    my @complete_matches = ();
    my @prefix_matches   = ();

    # this is not implemented using grep because of
    # https://rt.cpan.org/Public/Bug/Display.html?id=112427
    for my $entry (@{$valid_list_ref}) {
        push (@complete_matches, $entry) if ($entry =~ m/^\Q$new\E$/);
        push (@prefix_matches,$entry) if ($entry =~ m/^\Q$new\E$/);
    }

    $logger->trace("'$new' matches " . scalar(@complete_matches) . " nets completely and is a prefix of " . scalar(@prefix_matches));
    return @complete_matches == 1;
}


## @function validate_value (%$map_ref, $nl_ref, $k, $$v_ref, $dep_ref, $consts_ref, $log_func)
#   Do validation (and conversation from external->internal representation)
#
#   @param map_ref  reference to FIJI Settings mappings
#   @param nl_ref   reference to a FIJI::netlist (for validation of nets, drivers etc. only)
#   @param k        key identifying the respective setting
#   @param v_ref    scalar reference to the proposed value (that may be modified)
#   @param dep_ref  scalar reference to a value the proposed value depends on
#   @param consts_ref (optional) reference to related settings hash
#   @param log_func (optional) the (log4perl) log function to use
#                   (default is \&Log::Log4perl::Logger::trace)
#
#   @returns undef if value is valid, or a string to explain why it is invalid.
sub validate_value {
    my $logger = get_logger("");
    my ($map_ref, $nl_ref, $k, $v_ref, $dep_ref, $consts_ref, $log_func) = @_;
    $log_func = \&Log::Log4perl::Logger::trace if !defined($log_func);

    if (!defined (${$v_ref})) {
        # if a key does not contain a value, e.g.
        # DRIVER_TYPE=
        # set the corresponding value to an empty string instead of undef
        $logger->trace("$k is undef, setting to empty string");
        ${$v_ref} = ""
    }

    if (defined($map_ref->{$k}->{'type'})) {
        my $orig = ${$v_ref};

        if ($map_ref->{$k}->{'type'} eq 'net') {
            return "Netlist not available" if !defined($nl_ref);

            my $msg = $nl_ref->validate_net($orig);
            if (defined($msg)) {
                return $msg;
            }
        } elsif (($map_ref->{$k}->{'type'} eq 'external_port') || ($map_ref->{$k}->{'type'} eq 'dut_port')) {
            my $msg = _validate_port_entry($map_ref, $nl_ref, $k, $orig, $consts_ref);
            if (defined($msg)) {
                return $msg;
            }
        } elsif ($map_ref->{$k}->{'type'} eq 'driver') {
            return "Netlist not available" if !defined($nl_ref);

            my $net_path = $consts_ref->{'FIU_NET_NAME'};
            my $driver_path = $orig;
            my $driver_type = $consts_ref->{'FIU_DRIVER_TYPE'};
            
            my $msg = $nl_ref->validate_driver($net_path, $driver_path, $driver_type);
            if (defined($msg)) {
                return "$msg";
            }
        } elsif ($map_ref->{$k}->{'type'} eq 'hexadecimal' || $map_ref->{$k}->{'type'} eq 'lfsrpoly') {
            if ($orig !~ /^(0|(0[xX][[:xdigit:]]+))$/) {
                return "$orig does not look like a natural hexadecimal number";
            }
            return "$orig is too large" if (length($orig) > 2+8); # Hexadecimal numbers > 0xffffffff are non-portable
            ${$v_ref} = hex($orig);

            # Check for natural value range. Should never trigger due to the regex above.
            if (${$v_ref} < 0) {
                return "$orig is negative";
            }
        } elsif ($map_ref->{$k}->{'type'} eq 'natural') {

            # Match hexadecimal, binary, octal and decimal numbers (the latter also in scientific notation)
            if ($orig !~ /^(0|(0(x[0-9a-fA-F]+|[0-7]+))|(0b[01]+)|([1-9][0-9]*(e(-[0-9])?[0-9]+)?))$/) {
                return "$orig does not look like a number";
            }

            # convert non-decimal (hexadecimal, binary, octal) values to decimal
            ${$v_ref} = oct($orig) if $orig =~ /^0/;
            if (!looks_like_number(${$v_ref})) {
                return "$orig does not look like a number";
            }

            # Check for natural value range. Should never trigger due to the regex above.
            if (${$v_ref} < 0) {
                return "$orig is negative";
            }
        } elsif ($map_ref->{$k}->{'type'} eq 'boolean') {

            # convert strings to binary if need be
            if (!defined($orig)) {
                return "\"undef\" is not a boolean value";
            } elsif (lc($orig) eq 'true') {
                $orig = 1;
            } elsif (lc($orig) eq 'false') {
                $orig = 0;
            }
            if (($orig ne '0') && ($orig ne '1')) {
                return "\"$orig\" does not look like a boolean value";
            }

            # ensure proper boolean value, i.e. 0 or 1
            ${$v_ref} = (!!$orig) ? 1 : 0;
        }
        $logger->trace("Converted value of $k (\"$orig\") to \"${$v_ref}\".") if (defined($orig) && $orig ne ${$v_ref});
    }

    if (defined($map_ref->{$k}->{'values'})) {
        my $values_ref = $map_ref->{$k}->{'values'};
        if (ref($values_ref) eq 'ARRAY') {

            # Look for given value in allowed values
            if (scalar(grep { $_ eq ${$v_ref} } @{$values_ref}) == 0) {
                return "${$v_ref} is not allowed. Allowed values are: " . join(", ", @{$map_ref->{$k}->{'values'}});
            }
        } elsif (ref($values_ref) eq 'CODE') {
            if (!$values_ref->(${$v_ref}, $consts_ref->{$k}, $map_ref, $consts_ref, $$dep_ref)) {
                return "${$v_ref} is not allowed";
            }
        }
    }
    return undef;
}

# @function _rename_import (%$map_ref, %$consts_ref)
# Rename and convert entries in consts_ref according to map_ref.
#
# This function takes a hash of FIJI Settings and converts its keys
# to the respective internal representation. This allows us to use different
# name representations in the external file than within the implementation.
#
#
# \returns $consts_ref, or undef on errors
sub _rename_import {
    my $logger = get_logger("");
    my ($map_ref, $consts_ref) = @_;
    if (ref($consts_ref) ne 'HASH') {
        $logger->error("Parameter is not a reference to a hash (containing design constants).");
        return undef;
    }

    # Iterating over respective hash from FIJI.pm and rename the entries
    # to match our internal naming scheme.
    foreach my $k (keys(%{$map_ref})) {
        my $ini_name = $map_ref->{$k}->{'ini_name'};
        if (exists($consts_ref->{$ini_name}) && $ini_name ne $k) {
            $consts_ref->{$k} = $consts_ref->{$ini_name};
            $logger->trace(sprintf("Renaming Design setting %s -> %s (=%s).", $ini_name, $k, defined($consts_ref->{$ini_name}) ? $consts_ref->{$ini_name} : "<undef>"),);
            delete $consts_ref->{$ini_name};
        }
    }
    foreach my $entry_key (keys(%{$consts_ref})) {
        if (!exists($map_ref->{$entry_key})) {
            $logger->warn(sprintf("Deleting unknown setting %s = %s.", $entry_key, defined($consts_ref->{$entry_key}) ? $consts_ref->{$entry_key} : "<undef>"));
            delete $consts_ref->{$entry_key};
        }
    }

    return $consts_ref;
}

## @function _sanitize_fiu (%$fiu_ref, $phase)
# @brief Convert and sanity check FIJI Settings.
#
# \param fiu_ref a reference to a hash containing FIJI Settings for a
#                single FIU.
# \param phase   the current design phase
#
# \returns A new hash with all constants required in the FIU settings
#          in sanitized form, or undef on errors.
# @returns A list comprising a) the given hash with all constants required in the FIU settings in sanitized form (or undef in the case of an error),
#          b) a diagnostic string describing the reason why sanitation failed (undef if successful),
#          c) a diagnostic string describing any anomalies that did not hinder sanitation.
sub _sanitize_fiu {
    my $logger = get_logger("");
    my ($fiu_ref, $phase, $nl_ref) = @_;
    if (ref($fiu_ref) ne 'HASH') {
        my $msg = "Parameter is not a reference to a hash (containing FIU constants).";
        $logger->error($msg);
        return (undef, $msg);
    }

    my ($warnings, $errors);
    ($fiu_ref, $errors, $warnings) = _validate_hashmap(FIUMAP, $nl_ref, $fiu_ref, $phase);
    if (!ref($fiu_ref)) {
        my $msg = "Could not validate FIU Constants. $errors";
        return chomp $msg;
    }

    return ($fiu_ref, $errors, $warnings);
}

sub _disabled_via_dependency {
    my ($map_ref, $consts_ref, $k) = @_;
    my $depends_on = $map_ref->{$k}->{'depends_on'};

    # If we can't find the template for an entry in $map_ref, we assume
    # everything's OK. 
    # Rationale: We would need to pass >1 different maps to cross-check
    # entries defined in other maps (e.g., FIU_LFSR_MASK in the FIUMAP depends on LFSR_MASK in the DESIGNMAP)


    # For an entry to be disabled by a dependency, ...
    return defined($depends_on)                           && # ... it must depend on something
           defined($map_ref->{$depends_on})               && # ... that something must be found in the map
           $map_ref->{$depends_on}->{'type'} eq 'boolean' && # ... that something must be of type boolean
           !$consts_ref->{$depends_on};                      # ... that something must be set to false
}

sub _validate_hashmap {
    my $logger = get_logger("");
    my ($map_ref, $nl_ref, $consts_ref, $phase) = @_;
    my @map_keys = keys(%{$map_ref});
    my $errors;
    my $warnings;
    foreach my $entry_key (keys(%{$consts_ref})) {
        my $forbidden_by = $map_ref->{$entry_key}->{'forbidden_by'};
        my $ini_name     = $map_ref->{$entry_key}->{'ini_name'};

        @map_keys = grep { $_ ne $entry_key } @map_keys;    # mark constant key as done
        if (_disabled_via_dependency($map_ref, $consts_ref, $entry_key)) {
            $logger->debug(sprintf("Key %s is disabled via %s. Skipping validation.", $entry_key, $map_ref->{$entry_key}->{'depends_on'}));
        } elsif (scalar(grep { $_ eq $phase } @{$map_ref->{$entry_key}->{'phases_moot'}}) != 0) {
            $logger->debug(sprintf("Key %s is irrelevant in phase %s. Skipping validation.", $entry_key, $phase));
        } else {
            my $rv = validate_value($map_ref, $nl_ref, $entry_key, \$consts_ref->{$entry_key}, undef, $consts_ref);
            if (defined($rv)) {
                my $msg = sprintf("%s = \"%s\" is invalid (%s)%s.", $entry_key, !defined($consts_ref->{$entry_key}) ? "<undef>" : $consts_ref->{$entry_key}, $rv, defined($phase) ? " in phase $phase" : "");
                if (scalar(grep { $_ eq $phase } @{$map_ref->{$entry_key}->{'phases_opt'}}) == 0) {
                    $logger->error($msg);
                    $errors = "" if !defined($errors);
                    $errors .= "$msg\n";
                } else {
                    $logger->warn($msg);
                    $warnings = "" if !defined($warnings);
                    $warnings .= "$msg\n";
                }
            }
        }

        if (defined($forbidden_by) && $consts_ref->{$entry_key} && $consts_ref->{$forbidden_by}) {
            my $msg = "$entry_key is forbidden when $forbidden_by is enabled";
            $logger->error($msg);
            $errors = "" if !defined($errors);
            $errors .= "$msg\n";
        }
    }

    if (!defined($phase)) {

        # If there is no phase we are creating an "empty" hash that has
        # all possible defaults set earlier already and the there is
        # nothing we can or should do here.
        return ($consts_ref, $errors, $warnings);
    }

    # Iterate over the constants defined in FIJI.pm that apparently are
    # not contained in $consts_ref.
    foreach my $k (@map_keys) {
        my $dependency = $map_ref->{$k}->{'depends_on'};
        if (
            scalar(grep { $_ eq $phase } @{$map_ref->{$k}->{'phases_opt'}}) == 0 &&    # mandatory in current phase
            !_disabled_via_dependency($map_ref, $consts_ref, $k)                       # no dependency or dependency is enabled
           )
        {
            my $msg = "$k is mandatory in phase $phase.";
            $logger->error($msg);
            $errors = "" if !defined($errors);
            $errors .= "$msg\n";
        }

    }

    # @TODO: implement the same mechanism with forbidden_by

    return ($consts_ref, $errors, $warnings);
}

## @function _sanitize_design (%$consts_ref, $phase, $nl_ref)
# @brief Sanity check FIJI Design Settings.
#
# The function deals with sanity checks for the values themselves as
# specified by FIJI.pm. Additionally, it checks for the following conditions:
#
#   - FIU_CFG_BITS: > 0
#   - TIMER_WIDTH: > 0, <= 16
#   - ID: > 0, < 2^15-1
#   - BAUDRATE: > 0
#
# @param consts_ref A reference to a hash containing some design settings
# @param phase      The tool flow phase that defines the rules to check against
# @param nl_ref     A reference to a FIJI::netlist (for validation of nets and drivers only)
#
# @returns A list comprising a) the given hash ref with all constants required in the design settings in sanitized form (or undef in the case of an error),
#          b) a diagnostic string describing the reason why it could not be created (undef if successful),
#          c) a diagnostic string describing any anomalies that did not hinder sanitation.
sub _sanitize_design {
    my $logger = get_logger("");
    my ($consts_ref, $phase, $nl_ref) = @_;
    if (ref($consts_ref) ne 'HASH') {
        return (undef, "Parameter is not a reference to a hash (containing design constants).");
    }

    # check for sane values
    my ($warnings, $errors);
    ($consts_ref, $errors, $warnings) = _validate_hashmap(DESIGNMAP, $nl_ref, $consts_ref, $phase);
    if (!ref($consts_ref)) {
        my $msg = "Could not validate Design Constants:\n$errors";
        return (undef, chomp $msg, $warnings);
    }

    if (($consts_ref->{'FIU_CFG_BITS'} <= 0)) {
        $errors = "" if !defined($errors);
        $errors .= "FIU_CFG_BITS is <= 0.\n";
    }
    if (($consts_ref->{'TIMER_WIDTH'} <= 0) || ($consts_ref->{'TIMER_WIDTH'} > 16)) {
        $errors = "" if !defined($errors);
        $errors .= "TIMER_WIDTH is invalid ($consts_ref->{'TIMER_WIDTH'}).\n";
    }
    if (defined($consts_ref->{'ID'}) && ($consts_ref->{ID} < 0 || $consts_ref->{ID} > (2**16 - 1))) {
        $errors = "" if !defined($errors);
        $errors .= sprintf("ID is invalid (0x%04X).\n", $consts_ref->{ID});
    }
    if (($consts_ref->{'BAUDRATE'} <= 0)) {
        $errors = "" if !defined($errors);
        $errors .= "BAUDRATE is <= 0.\n";
    }

    return ($consts_ref, $errors, $warnings);
}

sub _log2 {
    my $val = shift;
    return ($val > 0) ? (log($val) / log(2)) : 0;
}

## @function private _est_resources ($FREQUENCY, $BAUD, $TIMER_WIDTH, $RST_CYCLES, $LFSR_WIDTH, $FIU_NUM, $algo)
# @brief estimates the number of registers and LUTs to implement FIJI logic with the given settings
#
# The function ant its parameters were determined by experiment & fitted by scipy.optimize.curve_fit
#
# @param FREQUENCY      the clock frequency the FIJI logic will run at in Hz
# @param BAUD           the baud rate for DUT <-> FIJI communication
# @param TIMER_WIDTH    the width of the injection timer (durations) in Bytes
# @param RST_CYCLES   the number of cycles to apply a FIJI-to-DUT reset
# @param LFSR_WIDTH     width of the LFSR used for stuck-open emulation
# @param FIU_NUM        the number of FIUs in the configuration
#
# @returns ($registers, $lutsum)

sub _est_resources {
    # We recalculate resources even if parameters are bogus. Disabling
    # warnings at least hides this stupidity from the user.
    no warnings 'numeric';

    my $logger = get_logger("");
    my ($FREQUENCY, $BAUD, $TIMER_WIDTH, $RST_CYCLES, $LFSR_WIDTH, $FIU_NUM) = @_;

    # @FIXME where do we put these values? they are likely to change if the VHDL
    # source is changed...