Downloader.pm

#-------------------------------------------------------------------------------
#  University of Applied Sciences Technikum Wien
#
#  Department of Embedded Systems
#  http://embsys.technikum-wien.at
#
#  Josef Ressel Center for Verification of Embedded Computing Systems
#  http://vecs.technikum-wien.at
#
#-------------------------------------------------------------------------------
#  File:              Downloader.pm
#  Created on:        01.07.2015
#  $LastChangedBy$
#  $LastChangedDate$
#
#  Description:
#  FIJI Downloader class
#-------------------------------------------------------------------------------

package FIJI::Downloader;

use strict;
use warnings;

use Log::Log4perl qw(get_logger :easy);
use FIJI::Tests;
use FIJI::Settings;
use FIJI::Connection;
use FIJI qw(:all);
use Data::Dumper;
use Clone 'clone';
use threads;
use threads::shared;

sub new(;$$) {
    my $logger = get_logger();
    my ( $class, $testsname, $existing_tests, $cfgname, $existing_cfg ) = @_;
    my $self = {};
    my $rv = "Constructor has no means of obtaining a FIJI::Tests/Settings object" . bless $self, $class;

    if ( defined $existing_cfg ) {
        $rv = $self->existing_settings($existing_cfg);
    } elsif ( defined $cfgname ) {
        $rv = $self->settings_from_file($cfgname);
    }

    if ( defined $existing_tests ) {
        $rv = $self->existing_tests($existing_tests);
    } elsif ( defined $testsname ) {
        $rv = $self->tests_from_file( $self->{'fiji_settings'}->{'design'}->{'CFGS_PER_MSG'}, $self->{'fiji_settings'}->{'design'}->{'FIU_NUM'}, $testsname );
    }

    $logger->error($rv) if ( !ref $rv );
    return $self;
}

sub settings_from_file {
    my $rv;
    my ( $self, $cfgname ) = @_;
    my $fiji_settings = FIJI::Settings->new( "download", $cfgname );
    if ( !ref($fiji_settings) ) {
        $rv = $fiji_settings . " Aborting.\n";
    } else {
        $rv = $self->{'fiji_settings'} = $fiji_settings;
    }
    return $rv;
}

sub existing_settings {
    my $rv;
    my ( $self, $existing_cfg ) = @_;
    if ( ref($existing_cfg) eq "FIJI::Settings" ) {
        $rv = $self->{'fiji_settings'} = $existing_cfg;
    } else {
        $rv = "Given Settings are not of type FIJI::Settings";
    }
}

sub tests_from_file {
    my $rv;
    my ( $self, $msgs_per_cfg, $fiu_num, $cfgname ) = @_;
    my $fiji_tests = FIJI::Tests->new( "automatic", $msgs_per_cfg, $fiu_num, $cfgname );
    if ( !ref($fiji_tests) ) {
        $rv = $fiji_tests . " Aborting.\n";
    } else {
        $rv = $self->{'fiji_tests'} = $fiji_tests;
    }
    return $rv;
}

sub existing_tests {
    my $rv;
    my ( $self, $existing_tests ) = @_;
    if ( ref($existing_tests) eq "FIJI::Tests" ) {
        $rv = $self->{'fiji_tests'} = $existing_tests;
    } else {
        $rv = "Given Tests are not of type FIJI::Tests";
    }
}

## Wrapper for port->send_config
# Generates a configuration hash from discrete parameters
#
sub _test_fi_uart {
    my $logger = get_logger();
    my ( $port, $payload_ref, $t1_duration, $t2_duration, $trigger_en, $trigger_ext, $reset, $fiji_consts ) = @_;

    # my @payload = map hex($_), $cfg_str =~ /(..)/g; # TODO: how to do this with unpack?
    my %config = (
        payload     => $payload_ref,
        t1_duration => $t1_duration,
        t2_duration => $t2_duration,
        trigger_en  => $trigger_en,
        trigger_ext => $trigger_ext,
        reset       => $reset,
        consts      => $fiji_consts,
    );

    # FIXME not sure if this is correct:
    #       total timeout = 1sec + sum of durations in sec

    my $timeout = ( ( ( $t1_duration + $t2_duration ) / $fiji_consts->{'FREQUENCY'} ) * 1000 ) + 1000;

    if ( $trigger_en == 1 ) {
        $logger->debug("Trigger specified, no timeout set.");
    }

    return $port->send_config( \%config, $timeout, 0, 1 );
}

## Download tests contained in the .cfg file
# Params
#   portname Optional serial port to use
sub download_auto ($) {
    my $msg;
    my $logger = get_logger();
    my ( $self, $testref, $portname, $intermediate_cb ) = @_;

    my $fiji_tests         = $self->{'fiji_tests'};
    my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};

    my @tests;

    if ( !defined $intermediate_cb ) {
        $intermediate_cb = sub { return 1; };
    }

    $portname = $fiji_tests->{'design'}->{'UART'} if ( !defined $portname );
    my $port = FIJI::Connection->init( $portname, $fiji_design_consts->{'BAUDRATE'} )
      or $logger->fatal("Could not init UART.")
      and return "Could not init UART.";

    my $toff = 0;
    my $ri   = 0;
    my $halt;

    $logger->info("Downloading in auto mode.");

    my $recv_msg;
    my $ti;

    # download tests until halted
    while (1) {
        for ( $ti = $toff ; $ti < @{ $fiji_tests->{'tests'} } ; $ti++ ) {

            $logger->info("Downloading test $ti.");

            $recv_msg = $self->_download_test( @{ $fiji_tests->{'tests'} }[$ti], $port );

            if ( ref($recv_msg) ne "HASH" ) {
                $msg = "UART transaction failed.";
                return $msg;
            }

            push @tests, @{ $fiji_tests->{'tests'} }[$ti];

            if ( $self->_check_halt($recv_msg) == 1 ) {
                $logger->error("Halt because of HALT_ON_xxx. Failed test: $ti, repetition $ri.");
                goto END;
            }

            if ( &$intermediate_cb($recv_msg) == 0 ) {
                $logger->info("Fulfilling halt request after test: $ti, repetition $ri.");
                goto END;
            }

        }

        # FIXME Repeat information comes from tests config file. OK?
        if ( $fiji_tests->{'design'}->{'REPEAT'} == 0 ) {
            last;
        } else {
            $toff = $fiji_tests->{'design'}->{'REPEAT_OFFSET'};
            $logger->info("Repeat tests beginning with $toff.");
            $ri++;
        }
    }

  END:
    $$testref                                = clone( $self->{'fiji_tests'} );
    $$testref->{'design'}->{'NUM_TESTS'}     = $ti;
    $$testref->{'design'}->{'REPEAT'}        = 0;
    $$testref->{'design'}->{'REPEAT_OFFSET'} = 0;
    if ( is_shared($$testref) ) {
        $$testref->{'tests'} = shared_clone( \@tests );
    } else {
        $$testref->{'tests'} = \@tests;
    }

    return $recv_msg;
}

## Download randomly generated tests
# Params
#   cfg Configuration hash
#        cfg->{'min_duration'}[0..n]   Minimum duration constraints for patterns
#        cfg->{'max_duration'}[0..n]   Maximum duration constraints for patterns
#        cfg->{'probabilities'}[FIJI::FIUENUM->{'NONE'}]        Probability of fault-free case
#        cfg->{'probabilities'}[FIJI::FIUENUM->{'STUCK_AT_0'}]  Probability of stuck-at-0 error
#        cfg->{'probabilities'}[FIJI::FIUENUM->{'STUCK_AT_1'}]  Probability of stuck-at-1 error
#        cfg->{'probabilities'}[FIJI::FIUENUM->{'DELAY'}]       Probability of delay error
#        cfg->{'probabilities'}[FIJI::FIUENUM->{'SEU'}]         Probability of seu error
#        cfg->{'probabilities'}[FIJI::FIUENUM->{'STUCK_OPEN'}]  Probability of stuck-open error
#   testref  Reference where download_random() places the modified FIJI::Tests object
#            after the test execution
#   portname Optional serial port to use
sub download_random ($$$;$) {
    my $logger = get_logger();
    my ( $self, $testref, $portname, $intermediate_cb ) = @_;
    my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};

    $portname = $$testref->{'design'}->{'UART'} if ( !defined $portname );

    if ( !defined $intermediate_cb ) {
        $intermediate_cb = sub { return 1; };
    }

    my $port = FIJI::Connection->init( $portname, $fiji_design_consts->{'BAUDRATE'} )
      or $logger->fatal("Could not init UART.")
      and return "Could not init UART.";

    $logger->info("Downloading in random mode.");
    my @tests;
    my $ti = 0;
    my $recv_msg;
    my $check = 0;
    my $cont;

    do {
        my $temp_test = $self->{'fiji_tests'}->make_random_test( $self->{'fiji_settings'} );
        return $temp_test if ( !ref($temp_test) );
        @tests[$ti] = $temp_test;
        $logger->info("=== Test $ti ===");
        $recv_msg = $self->_download_test( $tests[ $ti++ ], $port );
        return "UART transaction failed." if ( ref($recv_msg) ne "HASH" );
        $check = $self->_check_halt($recv_msg);
        $cont  = &$intermediate_cb($recv_msg);
    } while ( $check != 1 && $cont != 0 );

    $logger->error( "Halt because of HALT_ON_xxx. Failed test: " . ( $ti - 1 ) ) if $check == 1;
    $logger->info( "Fulfilling halt request after test: " .        ( $ti - 1 ) ) if $cont == 0;

    $$testref                                = clone( $self->{'fiji_tests'} );
    $$testref->{'design'}->{'NUM_TESTS'}     = $ti;
    $$testref->{'design'}->{'REPEAT'}        = 0;
    $$testref->{'design'}->{'REPEAT_OFFSET'} = 0;
    if ( is_shared($$testref) ) {
        $$testref->{'tests'} = shared_clone( \@tests );
    } else {
        $$testref->{'tests'} = \@tests;
    }

    return $recv_msg;
}

## Download manually defined tests prompted from <STDIN>
#   portname Optional serial port to use
sub download_manual ($;$) {
    my $msg;
    my $logger = get_logger();

    my ( $self, $portname ) = @_;

    my $fiji_tests         = $self->{'fiji_tests'};
    my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};

    # FIXME UART information can be defined in tests config file. OK?
    $portname = $fiji_design_consts->{'UART'} if ( !defined $portname );

    my $port = FIJI::Connection->init( $portname, $fiji_design_consts->{'BAUDRATE'} )
      or $logger->fatal("Could not init UART.")
      and return "Could not init UART.";

    $logger->info("Downloading in manual mode.");

    my $tests = ();

    while (1) {

        my $test = $self->_get_test_from_stdin();
        my $recv_msg = $self->_download_test( $test, $port );

        push @$tests, $test;

        if ( ref($recv_msg) ne "HASH" ) {
            $msg = "UART transaction failed.";
            last;
        }

        if ( $self->_check_halt($recv_msg) == 1 ) {
            $msg = "Halt because of HALT_ON_xxx.";
            return $msg;
        }

    }

    return $msg;
}

## Prompt tests from <STDIN>
# Params
#
sub _get_test_from_stdin {
    my $logger = get_logger();
    my ($self) = @_;

    my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};
    my $test               = {};

    my $cfg_mask    = 2**$fiji_design_consts->{'FIU_CFG_BITS'} - 1;
    my $default_cfg = $cfg_mask;

    for ( my $i = 0 ; $i < $fiji_design_consts->{'FIU_NUM'} ; $i++ ) {
        for ( my $t = 1 ; $t <= $fiji_design_consts->{'CFGS_PER_MSG'} ; $t++ ) {
            printf( "Enter configuration for FIU #%d in t%d (default: 0x%x): ", $i, $t, $default_cfg );

            my $cfg_str = <STDIN>;
            last unless defined $cfg_str;
            $cfg_str =~ s/\R//g;    # remove line breaks globally
                                    # $cfg_str =~ s/^0x//i; # remove optional 0x prefix
                                    # if ($cfg_str !~ m/^[0-9A-F]+$|^$/i) {
                                    # printf("This is not hexadecimal.\n");
                                    # next;
                                    # }
            my $cur_cfg = ( length($cfg_str) == 0 ) ? $default_cfg : $cfg_str;
            $cur_cfg = oct($cur_cfg) if $cur_cfg =~ /^0/;
            $logger->debug( sprintf( "Configuration of FIU #%d in t%d is 0x%x.", $i, $t, $cur_cfg ) );
            $test->{"FIU_${i}_FAULT_${t}"} = REVERSE_FIU_ENUM($cur_cfg);
        }
    }

    # default t1 is maximum/2
    my $default_t1_dur =
      oct( "0x" . ( "FF" x ( $fiji_design_consts->{'TIMER_WIDTH'} / 8 ) ) ) / 2;
    printf( "Enter duration t1 (default: 0x%x): ", $default_t1_dur );
    $test->{'TIMER_VALUE_1'} = <STDIN>;
    last unless defined $test->{'TIMER_VALUE_1'};
    $test->{'TIMER_VALUE_1'} =~ s/\R//g;    # remove line breaks globally
    $test->{'TIMER_VALUE_1'} =
      int( ( length( $test->{'TIMER_VALUE_1'} ) == 0 ) ? $default_t1_dur : $test->{'TIMER_VALUE_1'} );
    $test->{'TIMER_VALUE_1'} = oct( $test->{'TIMER_VALUE_1'} ) if $test->{'TIMER_VALUE_1'} =~ /^0/;
    $logger->debug( sprintf( "t1 duration is %d (0x%x).", $test->{'TIMER_VALUE_1'}, $test->{'TIMER_VALUE_1'} ) );

    # default t2 duration to maximum/2
    my $default_t2_dur =
      oct( "0x" . ( "FF" x ( $fiji_design_consts->{'TIMER_WIDTH'} / 8 ) ) ) / 2;
    printf( "Enter duration t2 (default: 0x%x): ", $default_t2_dur );
    $test->{'TIMER_VALUE_2'} = <STDIN>;
    last unless defined $test->{'TIMER_VALUE_2'};
    $test->{'TIMER_VALUE_2'} =~ s/\R//g;    # remove line breaks globally
    $test->{'TIMER_VALUE_2'} =
      int( ( length( $test->{'TIMER_VALUE_2'} ) == 0 ) ? $default_t2_dur : $test->{'TIMER_VALUE_2'} );
    $test->{'TIMER_VALUE_2'} = oct( $test->{'TIMER_VALUE_2'} ) if $test->{'TIMER_VALUE_2'} =~ /^0/;
    $logger->debug( sprintf( "t2 duration is %d (0x%x).", $test->{'TIMER_VALUE_2'}, $test->{'TIMER_VALUE_2'} ) );

    printf("Enable trigger (default: 0)? ");
    my $trigger_en = <STDIN>;
    last unless defined $trigger_en;
    $trigger_en =~ s/\R//g;                 # remove line breaks globally
    $trigger_en = ( $trigger_en =~ /1|yes|y/i ) ? 1 : 0;
    $logger->debug( sprintf( "trigger is %sabled.", $trigger_en == 0 ? "dis" : "en" ) );

    my $trigger_ext = 0;
    if ($trigger_en) {
        printf("Use external/not internal trigger (default: 0)? ");
        $trigger_ext = <STDIN>;
        last unless defined $trigger_ext;
        $trigger_ext =~ s/\R//g;            # remove line breaks globally
        $trigger_ext = ( $trigger_ext =~ /1|yes|y/i ) ? 1 : 0;
        $logger->debug( sprintf( "External trigger is %sabled, internal trigger is %sabled.", $trigger_ext == 0 ? "dis" : "en", $trigger_ext != 0 ? "dis" : "en" ) );
        if ( $trigger_ext == 1 ) {
            $test->{'TRIGGER'} = "EXT";
        } else {
            $test->{'TRIGGER'} = "INT";
        }
    } else {
        $test->{'TRIGGER'} = "NONE";
    }

    printf("Enable reset (default: 0)? ");
    $test->{'RESET_DUT_AFTER_CONFIG'} = <STDIN>;
    last unless defined $test->{'RESET_DUT_AFTER_CONFIG'};
    $test->{'RESET_DUT_AFTER_CONFIG'} =~ s/\R//g;    # remove line breaks globally
    $test->{'RESET_DUT_AFTER_CONFIG'} = ( $test->{'RESET_DUT_AFTER_CONFIG'} =~ /1|yes|y/i ) ? 1 : 0;
    $logger->debug( sprintf( "reset is %sabled.", $test->{'RESET_DUT_AFTER_CONFIG'} == 0 ? "dis" : "en" ) );

    return $test;
}

sub download_test ($$) {
    my $logger = get_logger();
    my ( $self, $test, $portname ) = @_;

    my $port = FIJI::Connection->init( $portname, $self->{'fiji_settings'}->{'design'}->{'BAUDRATE'} )
      or $logger->fatal("Could not init UART.")
      and return "Could not init UART.";

    my $rmsg = $self->_download_test( $test, $port );

    $rmsg = "UART transaction failed." if ( ref($rmsg) ne "HASH" );

    return $rmsg;

}

sub update_rnd($) {
    my ( $self, $rnd ) = @_;
    for my $k ( keys( %{$rnd} ) ) {
        $self->{'fiji_tests'}->{'design'}->{$k} = $rnd->{$k};
    }
}

## Download a single test defined by a test hash
# Params
#   test The hash defining the test
#       test->{'TIMER_VALUE_1'}
#       test->{'TIMER_VALUE_2'}
#       test->{"FIU_[0..FIU_NUM]_FAULT_[0..CFGS_PER_MSG]"}
#       test->{'RESET_DUT_AFTER_CONFIG'}
#       test->{'TRIGGER'}
#   port serial port to use
sub _download_test ($$) {
    my $logger = get_logger();
    my ( $self, $test, $port ) = @_;

    my $fiji_tests         = $self->{'fiji_tests'};
    my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};
    my @payload;

    # first generate FIU configuration payload

    for ( my $i = 0 ; $i < $fiji_design_consts->{'FIU_NUM'} ; $i++ ) {
        for ( my $t = 1 ; $t <= $fiji_design_consts->{'CFGS_PER_MSG'} ; $t++ ) {
            my $k       = "FIU_${i}_FAULT_${t}";
            my $cur_cfg = FIUENUM->{ $test->{$k} };
            $cur_cfg = oct($cur_cfg) if $cur_cfg =~ /^0/;
            $logger->debug( sprintf( "Configuration of FIU #%d in t%d is 0x%x.", $i, $t, $cur_cfg ) );
            push( @payload, $cur_cfg );
        }
    }

    # then generate fixed configuration part (timers,trigger,reset)

    my $t1_duration = $test->{'TIMER_VALUE_1'};
    $logger->debug( sprintf( "t1 duration is %d (0x%x).", $t1_duration, $t1_duration ) );

    my $t2_duration = $test->{'TIMER_VALUE_2'};
    $logger->debug( sprintf( "t2 duration is %d (0x%x).", $t2_duration, $t2_duration ) );

    my $trigger_en  = ( $test->{'TRIGGER'} ne "NONE" ) ? 1 : 0;
    my $trigger_ext = ( $test->{'TRIGGER'} eq "EXT" )  ? 1 : 0;
    my $reset       = $test->{'RESET_DUT_AFTER_CONFIG'};

    $logger->debug( sprintf( "trigger is %sabled.", $trigger_en == 0 ? "dis" : "en" ) );
    if ( $trigger_en == 1 ) {
        $logger->debug( sprintf( "External trigger is %sabled, internal trigger is %sabled.", $trigger_ext == 0 ? "dis" : "en", $trigger_ext != 0 ? "dis" : "en" ) );
    }

    $logger->debug( sprintf( "reset is %sabled.", $reset == 0 ? "dis" : "en" ) );

    # download test via serial

    my $recv_msg = _test_fi_uart( $port, \@payload, $t1_duration, $t2_duration, $trigger_en, $trigger_ext, $reset, $fiji_design_consts );

    return $recv_msg;
}

## Check the hash returned by _test_fi_uart() against HALT_ON_xxx-conditions
# Params
#   recv_msg The hash returned by _test_fi_uart() containing the decoded
#            return message
# Returns 1 if execution shall be halted and 0 otherwise
sub _check_halt ($) {
    my $halt   = 0;
    my $logger = get_logger();
    my ( $self, $recv_msg ) = @_;

    my $fiji_tests = $self->{'fiji_tests'};

    # FIXME HALT_on_xxx information is defined in tests config file. OK?

    if ( $recv_msg->{'msg_type'} eq "UNDERRUN" ) {
        $logger->info( "UNDERRUN message received. HALT_ON_UNDERRUN = " . $fiji_tests->{'design'}->{'HALT_ON_UNDERRUN'} . "." );
        $halt |= $fiji_tests->{'design'}->{'HALT_ON_UNDERRUN'};
    }
    if ( $recv_msg->{'error'}->{'U'} ) {
        $logger->info( "UART error. HALT_ON_UART_ERROR = " . $fiji_tests->{'design'}->{'HALT_ON_UART_ERROR'} . "." );
        $halt |= $fiji_tests->{'design'}->{'HALT_ON_UART_ERROR'};
    }
    if ( $recv_msg->{'error'}->{'I'} ) {
        $logger->info( "ID error. HALT_ON_ID_ERROR = " . $fiji_tests->{'design'}->{'HALT_ON_ID_ERROR'} . "." );
        $halt |= $fiji_tests->{'design'}->{'HALT_ON_ID_ERROR'};
    }
    if ( $recv_msg->{'error'}->{'C'} ) {
        $logger->info( "CRC error. HALT_ON_CRC_ERROR = " . $fiji_tests->{'design'}->{'HALT_ON_CRC_ERROR'} . "." );
        $halt |= $fiji_tests->{'design'}->{'HALT_ON_CRC_ERROR'};
    }
    for my $ei ( 1 .. 2 ) {
        if ( $recv_msg->{'fault_detect'}->{$ei} ) {
            $logger->info( "FAULT detected (Bit $ei). HALT_ON_FAULT_DETECT = " . $fiji_tests->{'design'}->{'HALT_ON_FAULT_DETECT'} . "." );
            $halt |= $fiji_tests->{'design'}->{'HALT_ON_FAULT_DETECT'};
        }
    }

    return $halt;
}

1;