Commit 6ec1e8a7 authored by Christian Fibich's avatar Christian Fibich Committed by Stefan Tauner
Browse files

Added Downloader class and FIJI::Tests Viewer Widget

parent 87a4463d
......@@ -413,6 +413,16 @@ BEGIN {
use constant \%fiuenum;
use constant FIUENUM => \%fiuenum;
sub REVERSE_FIU_ENUM {
my ($val) = @_;
for my $k (keys(%fiuenum)) {
if ($fiuenum{$k} == $val) {
return $k;
}
}
return "NONE";
}
## @function ini2constkey ($ini_name, %$map_ref)
#
......@@ -433,7 +443,7 @@ sub ini2constkey {
use base 'Exporter';
our @EXPORT = (keys(%designmap), keys(%fiumap), keys(%testpatmap), keys(%testconstmap), keys(%fiuenum));
our @EXPORT_OK = (keys(%designmap), 'DESIGNMAP', keys(%fiumap), 'FIUMAP', keys(%testpatmap), 'TESTPATMAP', keys(%testconstmap), 'TESTCONSTMAP', keys(%fiuenum), 'FIUENUM');
our @EXPORT_OK = (keys(%designmap), 'DESIGNMAP', keys(%fiumap), 'FIUMAP', keys(%testpatmap), 'TESTPATMAP', keys(%testconstmap), 'TESTCONSTMAP', keys(%fiuenum), 'FIUENUM', 'REVERSE_FIU_ENUM');
## @var @EXPORT_TAGS Export Tags
#
......
#-------------------------------------------------------------------------------
# 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;
sub new($) {
my ($class,$cfgname) = @_;
my $self = {};
bless $self,$class;
my $fiji_tests = FIJI::Tests->new( "automatic", $cfgname );
if ( !ref($fiji_tests) ) {
logger->error( $fiji_tests . " Aborting.\n" );
return 1;
}
$self->{'fiji_tests'} = $fiji_tests;
return $self;
}
sub _test_fi_uart {
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,
);
return $port->send_config( \%config, 1000, 0, 1 );
}
sub download_auto ($;$$) {
my $msg;
my $logger = get_logger();
my ($self,$portname) = @_;
my $fiji_tests = $self->{'fiji_tests'};
my $fiji_design_consts =
$fiji_tests->{'ext'}->{'global_settings'}->{'design'};
$portname = $self->{'fiji_tests'}->{'design'}->{'UART'} if (!defined $portname);
my $port =
FIJI::Connection->init( $portname, $fiji_tests->{'ext'}->{'global_settings'}->{'design'}->{'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.");
while(1) {
for (my $ti = $toff; $ti < @{$fiji_tests->{'tests'} }; $ti++) {
$logger->info("Downloading test $ti.");
my $recv_msg = $self->download_test(@{ $fiji_tests->{'tests'} }[$ti],$port);
if(ref($recv_msg) ne "HASH") {
$msg = "UART transaction failed.";
return $msg;
}
if ( $self->_check_halt($recv_msg) == 1 ) {
$msg = "Halt because of HALT_ON_xxx. Failed test: $ti, repetition $ri.";
my $rv = $fiji_tests->export_as_sim_script("sim.script",$ti,$ri);
$logger->error($rv) if defined ($rv);
return $msg;
}
}
if($fiji_tests->{'design'}->{'REPEAT'} == 0) {
last;
} else {
$toff = $fiji_tests->{'design'}->{'REPEAT_OFFSET'};
$logger->info("Repeat tests beginning with $toff.");
$ri++;
}
}
return $msg;
}
sub download_manual ($;$$) {
my $msg;
my $logger = get_logger();
my ($self,$portname) = @_;
my $fiji_tests = $self->{'fiji_tests'};
my $fiji_design_consts = $fiji_tests->{'ext'}->{'global_settings'}->{'design'};
$portname = $self->{'fiji_tests'}->{'design'}->{'UART'} if (!defined $portname);
my $port =
FIJI::Connection->init( $portname, $fiji_tests->{'ext'}->{'global_settings'}->{'design'}->{'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;
}
sub _get_test_from_stdin {
my $logger = get_logger();
my ($self) = @_;
my $fiji_design_consts = $self->{'fiji_tests'}->{'ext'}->{'global_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}_PATTERN_${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,$port) = @_;
my $fiji_tests = $self->{'fiji_tests'};
my $fiji_design_consts = $fiji_tests->{'ext'}->{'global_settings'}->{'design'};
my @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}_PATTERN_${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 );
}
}
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" ) );
my $recv_msg = _test_fi_uart(
$port, \@payload, $t1_duration,
$t2_duration, $trigger_en, $trigger_ext,
$reset, $fiji_design_consts);
}
sub _check_halt ($) {
my $halt = 0;
my $logger = get_logger();
my ($self,$recv_msg) = @_;
my $fiji_tests = $self->{'fiji_tests'};
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 ( 0 .. 1 ) {
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;
\ No newline at end of file
......@@ -35,6 +35,7 @@ use Tk::widgets qw(LabFrame Label Entry Pane Button Dialog Checkbutton CompleteE
use Tk::DynaMouseWheelBind;
use base qw(Tk::Frame);
use FIJI qw(:all);
......
#-------------------------------------------------------------------------------
# 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: FIJITestCanvas.pm
# Created on: 30.06.2015
# $LastChangedBy$
# $LastChangedDate$
#
# Description:
# FIJI Test Viewer Widget
#-------------------------------------------------------------------------------
package Tk::FIJITestCanvas;
use strict;
use warnings;
use Log::Log4perl qw(get_logger);
use Scalar::Util 'blessed';
use Tk;
use Tk::Balloon;
use Data::Dumper;
use Tk::widgets qw(Canvas);
use base qw(Tk::Derived Tk::Canvas);
Construct Tk::Widget 'FIJITestCanvas';
sub Populate {
my $logger = get_logger();
my($self, $args) = @_;
my $tests = delete $args->{'-tests'};
$self->{'xoff'} = delete $args->{'-xoff'};
$self->{'yoff'} = delete $args->{'-yoff'};
if (!defined($tests) || !blessed($tests) || !$tests->isa("FIJI::Tests")) {
$logger->error("Given settings are not of type FIJI::Settings. No way to report this back from the constructor...");
} else {
$self->{'tests'} = $tests;
}
$self->SUPER::Populate($args);
$self->{'width'} = $args->{'-width'};
$self->{'height'} = $args->{'-height'};
$self->_populate_widget($self);
$self->ConfigSpecs(
-tests => [qw/METHOD tests Tests/, undef],
);
}
sub _hh {
my ($test,$global_settings,$pattern) = @_;
my $duration;
my $fiucfg = "";
if($pattern == 1) {
$duration = $test->{'TIMER_VALUE_1'}+1;
} elsif($pattern == 2) {
$duration = $test->{'TIMER_VALUE_2'}+1;
}
for(my $fi = 0; $fi < $global_settings->{'design'}->{'FIU_NUM'}; $fi++) {
my $ps = "FIU_${fi}_PATTERN_${pattern}";
$fiucfg .= "\nFIU $fi: $test->{$ps}";
}
return "Duration: $duration".$fiucfg;
}
sub tests {
my $logger = get_logger();
my ($self, $tests) = @_;
if (defined($tests)) {
if (!blessed($tests) || !$tests->isa("FIJI::Tests")) {
$logger->error("Given settings are not of type FIJI::Tests.");
return undef;
}
$self->{'tests'} = $tests;
}
return $self->{'tests'}
}
sub _populate_widget {
my ($self,$p) = @_;
my $fiji_tests = $self->{'tests'};
$self->{'balloon'} = $p->Balloon();
my $total_duration = 0;
my $temp_duration = 0;
my $num_patterns = @{ $fiji_tests->{'tests'}};
my $draw_width = $self->{'width'}-$self->{'xoff'};
my $draw_height = $self->{'height'}-$self->{'yoff'};
foreach my $test (@{ $fiji_tests->{'tests'} }) {
my $t1_duration = $test->{'TIMER_VALUE_1'} + 1;
my $t2_duration = $test->{'TIMER_VALUE_2'} + 1;
$total_duration += $t1_duration + $t2_duration;
}
my $xfraction = $draw_width/$total_duration;
my $yfraction = $draw_height/($num_patterns*2);
my $x = $self->{'xoff'};
my $y = $self->{'yoff'};
my $x0 = $self->{'xoff'};
my $y0 = $self->{'yoff'};
$self->createLine(0,$y0,$self->{'width'},$y0,-fill=>"black");
$self->createLine($x0,0,$x0,$self->{'height'},-fill=>"black");
my $rgbb = 0;
$self->{'helphash'} = {};
my $time = 0;
my $repstart = $x;
for (my $ti = 0; $ti < @{$fiji_tests->{'tests'}}; $ti++) {
my $rgb = 0;
$rgbb = ($rgbb + 1) & 0xF;
$rgb |= (($rgbb & 0x8) > 0) ? 0x808080 : 0x00;
$rgb |= (($rgbb & 0x4) > 0) ? 0xF00000 : 0x00;
$rgb |= (($rgbb & 0x2) > 0) ? 0x00F000 : 0x00;
$rgb |= (($rgbb & 0x1) > 0) ? 0x0000F0 : 0x00;
my $col = sprintf("#%06X",$rgb);
my $test = @{ $fiji_tests->{'tests'} }[$ti];
my ($x1,$y1,$x2,$y2);
my $width1 = $xfraction * ($test->{'TIMER_VALUE_1'} + 1);
my $width2 = $xfraction * ($test->{'TIMER_VALUE_2'} + 1);
$x1 = $x + $width1;
$x2 = $x1 + $width2;
$y1 = $y + $yfraction;
$y2 = $y1 + $yfraction;
my $t1 = $self->createText($self->{'xoff'}/2,$y1-$yfraction/2,-text=>"$ti:1");
my $t2 = $self->createText($self->{'xoff'}/2,$y2-$yfraction/2,-text=>"$ti:2");
$self->{'helphash'}->{$t1} = "Test $ti, Pattern 1";
$self->{'helphash'}->{$t2} = "Test $ti, Pattern 2";
$self->createLine(0,$y1,$self->{'width'},$y1,-fill=>"black",-dash=>[2,8]);
$self->createLine(0,$y2,$self->{'width'},$y2,-fill=>"black",-dash=>[6,4]);
my $lx1 = $self->createLine($x1,$y0,$x1,$y2,-fill=>"black",-dash=>[2,8]);
my $lx2 = $self->createLine($x2,$y0,$x2,$y1,-fill=>"black",-dash=>[6,4]);
my $r1 = $self->createRectangle($x,$y,$x1,$y1,-fill=>"$col");
my $r2 = $self->createRectangle($x1,$y1,$x2,$y2,-fill=>"$col");
my $r3 = $self->createRectangle($x,0,$x+$width1+$width2,$self->{'yoff'}/2,-fill=>"$col");
$self->{'helphash'}->{$r1} = $self->{'helphash'}->{$t1}."\n"._hh($test,$fiji_tests->{'ext'}->{'global_settings'},1);
$self->{'helphash'}->{$r2} = $self->{'helphash'}->{$t2}."\n"._hh($test,$fiji_tests->{'ext'}->{'global_settings'},2);
$self->{'helphash'}->{$r3} = "Test $ti\n Total duration: ".($test->{'TIMER_VALUE_1'}+$test->{'TIMER_VALUE_2'})." (+2)";
if($test->{'RESET_DUT_AFTER_CONFIG'} == 1) {
$self->createText($x,$y1-$yfraction/4,-text=>"R",-justify=>"right",-fill=>"red");
$self->{'helphash'}->{$r1} .= "\nReset DUT";
}
if($test->{'TRIGGER'} ne "NONE") {
$self->createText($x,$y1-3*$yfraction/4,-justify=>"right",-text=>$test->{'TRIGGER'},-fill=>"red");
$self->{'helphash'}->{$r1} .= "\nWait for ".$test->{'TRIGGER'}."ernal trigger";
}
if($ti == $fiji_tests->{'design'}->{'REPEAT_OFFSET'}) {
$repstart = $x;
}
$self->createText($x,$y0-$self->{'yoff'}/4,-justify=>"left",-text=>($time));
$time += $test->{'TIMER_VALUE_1'} + 1;
$self->{'helphash'}->{$lx1} = "Time: ".$time;
$self->createText($x1,$y0-$self->{'yoff'}/4,-justify=>"left",-text=>($time));
$time += $test->{'TIMER_VALUE_2'} + 1;
$self->{'helphash'}->{$lx2} = "Time: ".$time;
$x = $x2;
$y = $y2;
}
if($fiji_tests->{'design'}->{'REPEAT'} == 1) {
my $ry = ($fiji_tests->{'design'}->{'REPEAT_OFFSET'})*2*$yfraction+$self->{'yoff'}+$yfraction/2;
my $rl1 = $self->createLine($repstart,$y0,$x,$y0,-fill=>"black",-arrow=>"first",width=>"4");
my $rl2 = $self->createLine($repstart,$ry,($x-$repstart)/2,(($y-$yfraction/2)-$ry)/2,$x,$y-$yfraction/2,-fill=>"red",-arrow=>"first",width=>"2",-smooth=>1);
$self->{'helphash'}->{$rl1} = $self->{'helphash'}->{$rl2} = "Repeat: "