Downloader.pm 22.7 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
#-------------------------------------------------------------------------------
#  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
#-------------------------------------------------------------------------------

Christian Fibich's avatar
Christian Fibich committed
20
21
## @file Downloader.pm
# @brief Contains class \ref FIJI::Downloader
22

Christian Fibich's avatar
Christian Fibich committed
23
24
## @class FIJI::Downloader
# @brief contains functionality to download tests via serial
25

26
27
28
29
30
package FIJI::Downloader;

use strict;
use warnings;

31
use Log::Log4perl qw(get_logger);
32
33
34
35
36
use FIJI::Tests;
use FIJI::Settings;
use FIJI::Connection;
use FIJI qw(:all);
use Data::Dumper;
Christian Fibich's avatar
Christian Fibich committed
37
use Clone 'clone';
38
39
use threads;
use threads::shared;
40

Christian Fibich's avatar
Christian Fibich committed
41
## @function public new ($testsname,%$existing_tests,$cfgname,%$existing_cfg)
42
43
44
45
46
#
# @param testsname          (optional) Name of a FIJI::Tests configuration file
# @param existing_tests     (optional) Reference to an existing FIJI::Tests object
# @param cfgname            (optional) Name of a FIJI::Settings configuration file
# @param existing_cfg       (optional) Reference to an existing FIJI::Settings object
Christian Fibich's avatar
Christian Fibich committed
47
#
48
49
# Either $testsname or $existing_tests must be present
# Either $cfgname or $existing_cfg must be present
Christian Fibich's avatar
Christian Fibich committed
50
sub new(;$$) {
51
    my $logger = get_logger("");
52
    my ($class, $mode, $testsname, $existing_tests, $cfgname, $existing_cfg) = @_;
53
    my $self = {};
Christian Fibich's avatar
Christian Fibich committed
54
55
    my $rvt  = "Constructor has no means of obtaining a FIJI::Tests object" . bless $self, $class;
    my $rvs  = "Constructor has no means of obtaining a FIJI::Settings object" . bless $self, $class;
Christian Fibich's avatar
Christian Fibich committed
56

Christian Fibich's avatar
Christian Fibich committed
57
    if (defined $existing_cfg) {
58
        $rvt = $self->existing_settings($existing_cfg);
Christian Fibich's avatar
Christian Fibich committed
59
    } elsif (defined $cfgname) {
60
        $rvt = $self->settings_from_file($cfgname);
Christian Fibich's avatar
Christian Fibich committed
61
    }
62

Christian Fibich's avatar
Christian Fibich committed
63
    if (defined $existing_tests) {
64
        $rvs = $self->existing_tests($existing_tests);
Christian Fibich's avatar
Christian Fibich committed
65
    } elsif (defined $testsname) {
66
        $rvs = $self->tests_from_file($mode, $self->{'fiji_settings'}->{'design'}->{'CFGS_PER_MSG'}, $self->{'fiji_settings'}->{'design'}->{'FIU_NUM'}, $testsname);
67
    }
Christian Fibich's avatar
Christian Fibich committed
68

Christian Fibich's avatar
Christian Fibich committed
69
70
    $logger->error($rvt) if (!ref $rvt);
    $logger->error($rvs) if (!ref $rvs);
71
    return "Error creating Downloader." if (!ref $rvt || !ref $rvs);
72
73
74
    return $self;
}

75
76
77
78
79
## @method public settings_from_file ($cfgname)
# @brief read settings from a given file
# @param cfgname the file to read from
# @returns STRING if an error ocurred
# @returns FIJI::Settings object if sucessful
Christian Fibich's avatar
Christian Fibich committed
80
sub settings_from_file {
81
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
82
    my $rv;
Christian Fibich's avatar
Christian Fibich committed
83
    my ($self, $cfgname) = @_;
84
85
86
    my ($fiji_settings, $warn) = FIJI::Settings->new("download", $cfgname);
    if (!defined($fiji_settings)) {
        $rv = $warn . " Aborting.\n";
Christian Fibich's avatar
Christian Fibich committed
87
    } else {
88
        $logger->warn($warn) if defined $warn;
Christian Fibich's avatar
Christian Fibich committed
89
90
91
92
93
94
95
        $rv = $self->{'fiji_settings'} = $fiji_settings;
    }
    return $rv;
}

sub existing_settings {
    my $rv;
Christian Fibich's avatar
Christian Fibich committed
96
97
    my ($self, $existing_cfg) = @_;
    if (ref($existing_cfg) eq "FIJI::Settings") {
Christian Fibich's avatar
Christian Fibich committed
98
99
100
101
102
103
        $rv = $self->{'fiji_settings'} = $existing_cfg;
    } else {
        $rv = "Given Settings are not of type FIJI::Settings";
    }
}

Christian Fibich's avatar
Christian Fibich committed
104
## @method public tests_from_file ($msgs_per_cfg, $fiu_num, $cfgname)
105
106
107
108
109
110
# @brief read tests from a given file
# @param cfgname        the file to read from
# @param msgs_per_cfg   the number of faults per FIU
# @param fiu_num        the number of FIUs
# @returns STRING if an error ocurred
# @returns FIJI::Tests object if sucessful
Christian Fibich's avatar
Christian Fibich committed
111
112
sub tests_from_file {
    my $rv;
113
114
115
116
    my $logger = get_logger("");
    my ($self, $mode, $msgs_per_cfg, $fiu_num, $cfgname) = @_;
    $logger->info("New Tests for mode '$mode'");
    my $fiji_tests = FIJI::Tests->new($mode, $msgs_per_cfg, $fiu_num, $cfgname);
Christian Fibich's avatar
Christian Fibich committed
117
    if (!ref($fiji_tests)) {
Christian Fibich's avatar
Christian Fibich committed
118
119
120
121
122
123
124
125
126
        $rv = $fiji_tests . " Aborting.\n";
    } else {
        $rv = $self->{'fiji_tests'} = $fiji_tests;
    }
    return $rv;
}

sub existing_tests {
    my $rv;
Christian Fibich's avatar
Christian Fibich committed
127
128
    my ($self, $existing_tests) = @_;
    if (ref($existing_tests) eq "FIJI::Tests") {
Christian Fibich's avatar
Christian Fibich committed
129
130
131
132
133
134
        $rv = $self->{'fiji_tests'} = $existing_tests;
    } else {
        $rv = "Given Tests are not of type FIJI::Tests";
    }
}

135
## @method private _test_fiu_uart ( $port, %$payload_ref, $t1_duration, $t2_duration, $trigger_en, $trigger_ext, $reset, %$fiji_consts, $dryrun )
136
# @brief Wrapper for port->send_config
Christian Fibich's avatar
Christian Fibich committed
137
# Generates a configuration hash from discrete parameters
138
# @returns the return value from FIJI::Connection->send_config
139
sub _test_fi_uart {
140
    my $logger = get_logger("");
141
142
143
    my ($port, $payload_ref, $t1_duration, $t2_duration, $trigger_en, $trigger_ext, $reset, $fiji_consts, $dryrun) = @_;

    $dryrun = 0 if !defined $dryrun;
144

Christian Fibich's avatar
Christian Fibich committed
145
    # my @payload = map hex($_), $cfg_str =~ /(..)/g; # @TODO: how to do this with unpack?
146
147
148
149
150
151
152
153
    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,
154
        dryrun      => $dryrun,
155
    );
156

157
158
159
    my $wait_for_ready = ($dryrun == 1) ? 0 : 1;

    return $port->send_config(\%config, 0, $wait_for_ready);
160
161
}

162
163
164
165
166
167
168
169
## @method public download_auto ($testref, $portname, &$intermediate_cb)
# @brief Download tests contained in the .cfg file
# @param testref            (optional) reference where this function shall put the
#                           executed tests
# @param portname           (optional) serial port to use
# @param intermediate_cb    (optional) reference to a function to call after each test
# @returns STRING if an error occurred
# @returns HASH containing the last received message if successfully sent
Christian Fibich's avatar
Christian Fibich committed
170
sub download_auto ($) {
171
    my $msg;
172
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
173
    my ($self, $testref, $portname, $intermediate_cb) = @_;
174

175
    my $fiji_tests         = $self->{'fiji_tests'};
Christian Fibich's avatar
Christian Fibich committed
176
    my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};
177

178
179
    my @tests;

Christian Fibich's avatar
Christian Fibich committed
180
    if (!defined $intermediate_cb) {
181
        $intermediate_cb = sub { return 1; };
Christian Fibich's avatar
Christian Fibich committed
182
183
    }

Christian Fibich's avatar
Christian Fibich committed
184
185
    $portname = $fiji_tests->{'design'}->{'UART'} if (!defined $portname);
    my $port = FIJI::Connection->init($portname, $fiji_design_consts->{'BAUDRATE'})
186
187
188
189
190
191
192
193
194
      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.");

195
196
197
    my $recv_msg;
    my $ti;

Christian Fibich's avatar
Christian Fibich committed
198
    # download tests until halted
199
    while (1) {
Christian Fibich's avatar
Christian Fibich committed
200
        for ($ti = $toff ; $ti < @{$fiji_tests->{'tests'}} ; $ti++) {
201
202
203

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

Christian Fibich's avatar
Christian Fibich committed
204
            $recv_msg = $self->_download_test(@{$fiji_tests->{'tests'}}[$ti], $port);
205

Christian Fibich's avatar
Christian Fibich committed
206
            if (ref($recv_msg) ne "HASH") {
207
208
209
210
                $msg = "UART transaction failed.";
                return $msg;
            }

Christian Fibich's avatar
Christian Fibich committed
211
            push @tests, @{$fiji_tests->{'tests'}}[$ti];
212

213
214
215
            my $check = $self->_check_halt($recv_msg);

            if (@{$check}) {
Christian Fibich's avatar
Christian Fibich committed
216
                $logger->error("Halt because of " . join("and", @{$check}) . ". Failed test: $ti, repetition $ri.");
217
                goto END;
218
            }
219

Christian Fibich's avatar
Christian Fibich committed
220
            if (&$intermediate_cb($recv_msg) == 0) {
Christian Fibich's avatar
Christian Fibich committed
221
                $logger->info("Fulfilling halt request after test: $ti, repetition $ri.");
222
                goto END;
Christian Fibich's avatar
Christian Fibich committed
223
224
            }

225
        }
226

Christian Fibich's avatar
Christian Fibich committed
227
228
        # @FIXME Repeat information comes from tests config file. OK?
        if ($fiji_tests->{'design'}->{'REPEAT'} == 0) {
229
230
231
232
233
234
235
            last;
        } else {
            $toff = $fiji_tests->{'design'}->{'REPEAT_OFFSET'};
            $logger->info("Repeat tests beginning with $toff.");
            $ri++;
        }
    }
236

237
  END:
Christian Fibich's avatar
Christian Fibich committed
238
    $$testref                                = clone($self->{'fiji_tests'});
239
240
    $$testref->{'design'}->{'NUM_TESTS'}     = $ti;
    $$testref->{'design'}->{'REPEAT'}        = 0;
241
    $$testref->{'design'}->{'REPEAT_OFFSET'} = 0;
Christian Fibich's avatar
Christian Fibich committed
242
243
    if (is_shared($$testref)) {
        $$testref->{'tests'} = shared_clone(\@tests);
244
245
246
247
248
    } else {
        $$testref->{'tests'} = \@tests;
    }

    return $recv_msg;
249
250
}

Christian Fibich's avatar
Christian Fibich committed
251
## @method public download_auto (%$testref, $portname, &$intermediate_cb)
252
253
254
255
256
257
258
# @brief Download randomly generated tests
# @param testref            (optional) reference where this function shall put the
#                           executed tests
# @param portname           (optional) serial port to use
# @param intermediate_cb    (optional) reference to a function to call after each test
# @returns STRING if an error occurred
# @returns HASH containing the last received message if successfully sent
Christian Fibich's avatar
Christian Fibich committed
259
sub download_random ($$$;$) {
260
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
261
    my ($self, $testref, $portname, $intermediate_cb) = @_;
Christian Fibich's avatar
Christian Fibich committed
262
    my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};
263
    my $fiji_tests_consts = $self->{'fiji_tests'}->{'design'};
Christian Fibich's avatar
Christian Fibich committed
264

265
    $portname = $fiji_tests_consts->{'UART'} if (!defined $portname);
Christian Fibich's avatar
Christian Fibich committed
266

Christian Fibich's avatar
Christian Fibich committed
267
    if (!defined $intermediate_cb) {
268
        $intermediate_cb = sub { return 1; };
Christian Fibich's avatar
Christian Fibich committed
269
    }
Christian Fibich's avatar
Christian Fibich committed
270

Christian Fibich's avatar
Christian Fibich committed
271
    my $port = FIJI::Connection->init($portname, $fiji_design_consts->{'BAUDRATE'})
Christian Fibich's avatar
Christian Fibich committed
272
273
274
275
276
277
278
      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;
Christian Fibich's avatar
Christian Fibich committed
279
280
    my $check = 0;
    my $cont;
Christian Fibich's avatar
Christian Fibich committed
281
282

    do {
Christian Fibich's avatar
Christian Fibich committed
283
        my $temp_test = $self->{'fiji_tests'}->make_random_test($self->{'fiji_settings'}, ($ti == 0));
Christian Fibich's avatar
Christian Fibich committed
284
        return $temp_test if (!ref($temp_test));
285
        $tests[$ti] = $temp_test;
Christian Fibich's avatar
Christian Fibich committed
286
        $logger->info("=== Test $ti ===");
Christian Fibich's avatar
Christian Fibich committed
287
288
        $recv_msg = $self->_download_test($tests[$ti++], $port);
        return "UART transaction failed." if (ref($recv_msg) ne "HASH");
Christian Fibich's avatar
Christian Fibich committed
289
        $check = $self->_check_halt($recv_msg);
290
        $cont  = &$intermediate_cb($recv_msg);
291
    } while (@{$check} == 0 && $cont != 0);
Christian Fibich's avatar
Christian Fibich committed
292

Christian Fibich's avatar
Christian Fibich committed
293
294
    $logger->error("Halt because of " . join(" and ", @{$check}) . ". Failed test: " . ($ti - 1)) if @{$check};
    $logger->info("Fulfilling halt request after test: " . ($ti - 1)) if $cont == 0;
Christian Fibich's avatar
Christian Fibich committed
295

Christian Fibich's avatar
Christian Fibich committed
296
    $$testref                                = clone($self->{'fiji_tests'});
297
298
    $$testref->{'design'}->{'NUM_TESTS'}     = $ti;
    $$testref->{'design'}->{'REPEAT'}        = 0;
299
    $$testref->{'design'}->{'REPEAT_OFFSET'} = 0;
Christian Fibich's avatar
Christian Fibich committed
300
301
    if (is_shared($$testref)) {
        $$testref->{'tests'} = shared_clone(\@tests);
302
303
304
    } else {
        $$testref->{'tests'} = \@tests;
    }
Christian Fibich's avatar
Christian Fibich committed
305
306

    return $recv_msg;
Christian Fibich's avatar
Christian Fibich committed
307
308
}

309
310
311
## @method download_manual
# @brief Download manually defined tests prompted from <STDIN>
# @param portname (optional) the serial port to use
Christian Fibich's avatar
Christian Fibich committed
312
sub download_manual ($;$) {
313
    my $msg;
314
    my $logger = get_logger("");
315

Christian Fibich's avatar
Christian Fibich committed
316
    my ($self, $portname) = @_;
317

Christian Fibich's avatar
Christian Fibich committed
318
    my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};
319
    my $fiji_tests_consts = $self->{'fiji_tests'}->{'design'};
320

321
    $portname = $fiji_tests_consts->{'UART'} if (!defined $portname);
322

Christian Fibich's avatar
Christian Fibich committed
323
    my $port = FIJI::Connection->init($portname, $fiji_design_consts->{'BAUDRATE'})
324
325
326
327
328
329
330
331
      or $logger->fatal("Could not init UART.")
      and return "Could not init UART.";

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

    my $tests = ();

    while (1) {
332

333
        my $test = $self->_get_test_from_stdin();
Christian Fibich's avatar
Christian Fibich committed
334
        my $recv_msg = $self->_download_test($test, $port);
335
336
337

        push @$tests, $test;

Christian Fibich's avatar
Christian Fibich committed
338
        if (ref($recv_msg) ne "HASH") {
339
340
341
342
            $msg = "UART transaction failed.";
            last;
        }

343
        if (@{$self->_check_halt($recv_msg)}) {
Christian Fibich's avatar
Christian Fibich committed
344
            $msg = "Halt because of " . join(' and ', @{$self->_check_halt($recv_msg)});
345
346
347
348
349
350
351
352
            return $msg;
        }

    }

    return $msg;
}

353
## @method _get_test_from_stdin ()
Christian Fibich's avatar
Christian Fibich committed
354
# @brief Prompt tests from \<STDIN\>
355
sub _get_test_from_stdin {
356
    my $logger = get_logger("");
357
358
    my ($self) = @_;

Christian Fibich's avatar
Christian Fibich committed
359
    my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};
360
    my $test               = {};
361
362
363
364

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

Christian Fibich's avatar
Christian Fibich committed
365
366
    for (my $i = 0 ; $i < $fiji_design_consts->{'FIU_NUM'} ; $i++) {
        for (my $t = 1 ; $t <= $fiji_design_consts->{'CFGS_PER_MSG'} ; $t++) {
367
368
            my $phase = ($t < $fiji_design_consts->{'CFGS_PER_MSG'}) ? "in t".($t+1) : "after t$t";
            printf("Enter configuration for FIU #%d %s (default: 0x%x): ", $i, $phase, $default_cfg);
369
370
371
372

            my $cfg_str = <STDIN>;
            last unless defined $cfg_str;
            $cfg_str =~ s/\R//g;    # remove line breaks globally
373
374
375
376
377
                                    # $cfg_str =~ s/^0x//i; # remove optional 0x prefix
                                    # if ($cfg_str !~ m/^[0-9A-F]+$|^$/i) {
                                    # printf("This is not hexadecimal.\n");
                                    # next;
                                    # }
Christian Fibich's avatar
Christian Fibich committed
378
            my $cur_cfg = (length($cfg_str) == 0) ? $default_cfg : $cfg_str;
379
            $cur_cfg = oct($cur_cfg) if $cur_cfg =~ /^0/;
380
            $logger->debug(sprintf("Configuration of FIU #%d %s is 0x%x.", $i, $phase, $cur_cfg));
381
            $test->{"FIU_${i}_FAULT_${t}"} = REVERSE_FIU_ENUM($cur_cfg);
382
383
384
385
386
        }
    }

    # default t1 is maximum/2
    my $default_t1_dur =
Christian Fibich's avatar
Christian Fibich committed
387
388
      oct("0x" . ("FF" x ($fiji_design_consts->{'TIMER_WIDTH'} / 8))) / 2;
    printf("Enter duration t1 (default: 0x%x): ", $default_t1_dur);
389
390
391
392
    $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'} =
Christian Fibich's avatar
Christian Fibich committed
393
394
395
      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'}));
396
397
398

    # default t2 duration to maximum/2
    my $default_t2_dur =
Christian Fibich's avatar
Christian Fibich committed
399
400
      oct("0x" . ("FF" x ($fiji_design_consts->{'TIMER_WIDTH'} / 8))) / 2;
    printf("Enter duration t2 (default: 0x%x): ", $default_t2_dur);
401
402
403
404
    $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'} =
Christian Fibich's avatar
Christian Fibich committed
405
406
407
      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'}));
408
409
410
411

    printf("Enable trigger (default: 0)? ");
    my $trigger_en = <STDIN>;
    last unless defined $trigger_en;
412
    $trigger_en =~ s/\R//g;                 # remove line breaks globally
Christian Fibich's avatar
Christian Fibich committed
413
414
    $trigger_en = ($trigger_en =~ /1|yes|y/i) ? 1 : 0;
    $logger->debug(sprintf("trigger is %sabled.", $trigger_en == 0 ? "dis" : "en"));
415
416
417
418
419
420

    my $trigger_ext = 0;
    if ($trigger_en) {
        printf("Use external/not internal trigger (default: 0)? ");
        $trigger_ext = <STDIN>;
        last unless defined $trigger_ext;
421
        $trigger_ext =~ s/\R//g;            # remove line breaks globally
Christian Fibich's avatar
Christian Fibich committed
422
423
424
        $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) {
425
426
427
428
429
430
431
432
433
434
435
436
            $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
Christian Fibich's avatar
Christian Fibich committed
437
438
    $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"));
439
440
441
442

    return $test;
}

443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
sub get_fic_status ($$) {
    my $logger = get_logger("");
    my ($self, $portname) = @_;

    # generate empty test
    my $test = {};
    $self->{'fiji_tests'}->set_test_defaults($test);

    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, 1);
    $rmsg = "UART transaction failed." if (ref($rmsg) ne "HASH");
    return $rmsg;

}

Christian Fibich's avatar
Christian Fibich committed
460
## @method public download_test (%$test, $portname)
461
462
463
464
465
# @brief Download a single test defined by a test hash
# @param test       the hash describing the test
# @param portname   the name of the serial port to use
# @returns STRING if an error ocurred
# @returns HASH   returned by _test_fi_uart() containing the decoded return message
Christian Fibich's avatar
Christian Fibich committed
466
sub download_test ($$) {
467
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
468
    my ($self, $test, $portname) = @_;
469

Christian Fibich's avatar
Christian Fibich committed
470
    my $port = FIJI::Connection->init($portname, $self->{'fiji_settings'}->{'design'}->{'BAUDRATE'})
Christian Fibich's avatar
Christian Fibich committed
471
472
473
      or $logger->fatal("Could not init UART.")
      and return "Could not init UART.";

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

Christian Fibich's avatar
Christian Fibich committed
476
    $rmsg = "UART transaction failed." if (ref($rmsg) ne "HASH");
Christian Fibich's avatar
Christian Fibich committed
477
478
479

    return $rmsg;

Christian Fibich's avatar
Christian Fibich committed
480
481
}

482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
sub update_dur($) {
    my $logger = get_logger("");
    my ($self, $dur) = @_;
    my $rv;
    for my $k (grep {defined $dur->{$_}} keys(%{$dur})) {
        if ($dur->{$k} < 0 || $dur->{$k} >= 2**($self->{'fiji_settings'}->{'design'}->{'TIMER_WIDTH'}*8)) {
            return "Invalid timer value $k: ".($dur->{$k}).". Must be >= 0 && < 2^".($self->{'fiji_settings'}->{'design'}->{'TIMER_WIDTH'}*8);
        } else {
            $logger->info("Duration $k set to ".$dur->{$k});
            $self->{'fiji_tests'}->{'design'}->{$k} = $dur->{$k};
        }
    }
    return undef;
}

sub update_prob($) {
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
499
    my ($self, $rnd) = @_;
500
501
    my $prob = {};
    my $sum  = 0;
Christian Fibich's avatar
Christian Fibich committed
502
    for my $k (keys(%{$rnd})) {
503
504
505
506
507
508
509
510
511
        $prob->{$k} = $rnd->{$k};
        $prob->{$k} = $self->{'fiji_tests'}->{'design'}->{$k} if (!defined $prob->{$k});
        $sum += $prob->{$k};    
        $logger->info("Probability $k set to ".$prob->{$k});
    }
    return "Sum of probabilities larger than 1." if $sum > 1.0;

    for my $k (keys(%{$prob})) {
        $self->{'fiji_tests'}->{'design'}->{$k} = $prob->{$k};
Christian Fibich's avatar
Christian Fibich committed
512
    }
513
    return undef;
Christian Fibich's avatar
Christian Fibich committed
514
515
}

Christian Fibich's avatar
Christian Fibich committed
516
## @method private _download_test (%$test, $port)
517
518
519
520
521
522
523
524
525
# @brief Download a single test defined by a test hash
# @param 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'}
# @param port (optional) serial port to use
sub _download_test {
526
    my $logger = get_logger("");
527
528
529
    my ($self, $test, $port, $dryrun) = @_;

    $dryrun = 0 if !defined $dryrun;
530

531
    my $fiji_tests         = $self->{'fiji_tests'};
Christian Fibich's avatar
Christian Fibich committed
532
    my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};
533
534
    my @payload;

Christian Fibich's avatar
Christian Fibich committed
535
536
    # first generate FIU configuration payload

Christian Fibich's avatar
Christian Fibich committed
537
538
    for (my $i = 0 ; $i < $fiji_design_consts->{'FIU_NUM'} ; $i++) {
        for (my $t = 1 ; $t <= $fiji_design_consts->{'CFGS_PER_MSG'} ; $t++) {
539
            my $k       = "FIU_${i}_FAULT_${t}";
Christian Fibich's avatar
Christian Fibich committed
540
            my $cur_cfg = FIUENUM->{$test->{$k}};
541
            $cur_cfg = oct($cur_cfg) if $cur_cfg =~ /^0/;
Christian Fibich's avatar
Christian Fibich committed
542
543
            $logger->debug(sprintf("Configuration of FIU #%d in t%d is 0x%x.", $i, $t, $cur_cfg));
            push(@payload, $cur_cfg);
544
545
546
        }
    }

Christian Fibich's avatar
Christian Fibich committed
547
    # then generate fixed configuration part (timers,trigger,reset)
548

549
    my $t1_duration = $test->{'TIMER_VALUE_1'};
Christian Fibich's avatar
Christian Fibich committed
550
    $logger->debug(sprintf("t1 duration is %d (0x%x).", $t1_duration, $t1_duration));
551
552

    my $t2_duration = $test->{'TIMER_VALUE_2'};
Christian Fibich's avatar
Christian Fibich committed
553
    $logger->debug(sprintf("t2 duration is %d (0x%x).", $t2_duration, $t2_duration));
554

Christian Fibich's avatar
Christian Fibich committed
555
556
    my $trigger_en  = ($test->{'TRIGGER'} ne "NONE") ? 1 : 0;
    my $trigger_ext = ($test->{'TRIGGER'} eq "EXT")  ? 1 : 0;
557
558
    my $reset       = $test->{'RESET_DUT_AFTER_CONFIG'};

Christian Fibich's avatar
Christian Fibich committed
559
560
561
    $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"));
562
563
    }

Christian Fibich's avatar
Christian Fibich committed
564
    $logger->debug(sprintf("reset is %sabled.", $reset == 0 ? "dis" : "en"));
565

Christian Fibich's avatar
Christian Fibich committed
566
567
    # download test via serial

568
    my $recv_msg = _test_fi_uart($port, \@payload, $t1_duration, $t2_duration, $trigger_en, $trigger_ext, $reset, $fiji_design_consts, $dryrun);
Christian Fibich's avatar
Christian Fibich committed
569
570

    return $recv_msg;
571
572
}

Christian Fibich's avatar
Christian Fibich committed
573
## @method private _check_halt (%$recv_msg)
574
575
576
# @brief Check the hash returned by _test_fi_uart() against HALT_ON_xxx-conditions
# @param recv_msg The hash returned by _test_fi_uart() containing the decoded
#                 return message
577
578
# @returns reference to list of reasons if execution shall be halted
# @returns reference to empty list otherwise
579
sub _check_halt ($) {
580
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
581
    my ($self, $recv_msg) = @_;
Christian Fibich's avatar
Christian Fibich committed
582
    my $reasons    = [];
583
584
    my $fiji_tests = $self->{'fiji_tests'};

Christian Fibich's avatar
Christian Fibich committed
585
    # @FIXME HALT_on_xxx information is defined in tests config file. OK?
Christian Fibich's avatar
Christian Fibich committed
586

Christian Fibich's avatar
Christian Fibich committed
587
588
    if ($recv_msg->{'msg_type'} eq "UNDERRUN") {
        $logger->info("UNDERRUN message received. HALT_ON_UNDERRUN = " . $fiji_tests->{'design'}->{'HALT_ON_UNDERRUN'} . ".");
589
590
591
592
593
        push @{$reasons}, 'HALT_ON_UNDERRUN' if $fiji_tests->{'design'}->{'HALT_ON_UNDERRUN'};
    }
    if ($recv_msg->{'underrun_occurred'}) {
        $logger->info("UNDERRUN occurred. HALT_ON_UNDERRUN = " . $fiji_tests->{'design'}->{'HALT_ON_UNDERRUN'} . ".");
        push @{$reasons}, 'HALT_ON_UNDERRUN' if $fiji_tests->{'design'}->{'HALT_ON_UNDERRUN'};
594
    }
Christian Fibich's avatar
Christian Fibich committed
595
596
    if ($recv_msg->{'error'}->{'U'}) {
        $logger->info("UART error. HALT_ON_UART_ERROR = " . $fiji_tests->{'design'}->{'HALT_ON_UART_ERROR'} . ".");
597
        push @{$reasons}, 'HALT_ON_UART_ERROR' if $fiji_tests->{'design'}->{'HALT_ON_UART_ERROR'};
598
    }
Christian Fibich's avatar
Christian Fibich committed
599
600
    if ($recv_msg->{'error'}->{'I'}) {
        $logger->info("ID error. HALT_ON_ID_ERROR = " . $fiji_tests->{'design'}->{'HALT_ON_ID_ERROR'} . ".");
601
        push @{$reasons}, 'HALT_ON_ID_ERROR' if $fiji_tests->{'design'}->{'HALT_ON_ID_ERROR'};
602
    }
Christian Fibich's avatar
Christian Fibich committed
603
604
    if ($recv_msg->{'error'}->{'C'}) {
        $logger->info("CRC error. HALT_ON_CRC_ERROR = " . $fiji_tests->{'design'}->{'HALT_ON_CRC_ERROR'} . ".");
605
        push @{$reasons}, 'HALT_ON_CRC_ERROR' if $fiji_tests->{'design'}->{'HALT_ON_CRC_ERROR'};
606
    }
Christian Fibich's avatar
Christian Fibich committed
607
608
609
    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'} . ".");
610
            push @{$reasons}, "HALT_ON_FAULT_DETECT($ei)" if $fiji_tests->{'design'}->{'HALT_ON_FAULT_DETECT'};
611
612
613
        }
    }

614
    return $reasons;
615
616
}

617
1;