Downloader.pm 24.3 KB
Newer Older
1
2
3
#-----------------------------------------------------------------------
# Fault InJection Instrumenter (FIJI)
# https://embsys.technikum-wien.at/projects/vecs/fiji
4
#
5
6
7
8
# 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).
#
9
10
11
# Authors:
# Christian Fibich <fibich@technikum-wien.at>
# Stefan Tauner <tauner@technikum-wien.at>
12
#
13
14
# This module is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
15
#
16
17
18
19
20
21
# 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.
#-----------------------------------------------------------------------
22

Christian Fibich's avatar
Christian Fibich committed
23
24
## @file Downloader.pm
# @brief Contains class \ref FIJI::Downloader
25

Christian Fibich's avatar
Christian Fibich committed
26
## @class FIJI::Downloader
27
# @brief Download tests via serial to a FIJI FIC
28

29
30
31
32
33
package FIJI::Downloader;

use strict;
use warnings;

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

43
# FIXME: fix documentation, possibly refine settings_from_file and existing_settings
Christian Fibich's avatar
Christian Fibich committed
44
## @function public new ($testsname,%$existing_tests,$cfgname,%$existing_cfg)
45
46
47
48
49
#
# @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
50
#
51
52
# Either $testsname or $existing_tests must be present
# Either $cfgname or $existing_cfg must be present
Christian Fibich's avatar
Christian Fibich committed
53
sub new(;$$) {
54
    my $logger = get_logger("");
55
    my ($class, $mode, $testsname, $existing_tests, $cfgname, $existing_cfg) = @_;
56
    my $self = {};
57
58
59
    bless $self, $class;
    my $rvt;
    my $rvs;
Christian Fibich's avatar
Christian Fibich committed
60

Christian Fibich's avatar
Christian Fibich committed
61
    if (defined $existing_cfg) {
62
        $rvs = $self->existing_settings($existing_cfg);
Christian Fibich's avatar
Christian Fibich committed
63
    } elsif (defined $cfgname) {
64
65
66
67
        $rvs = $self->settings_from_file($cfgname);
    }

    if (!ref $rvs) {
68
        return"Constructor of " . $class . " could not obtain a FIJI::Settings object";
Christian Fibich's avatar
Christian Fibich committed
69
    }
70

Christian Fibich's avatar
Christian Fibich committed
71
    if (defined $existing_tests) {
72
        $rvt = $self->existing_tests($existing_tests);
Christian Fibich's avatar
Christian Fibich committed
73
    } elsif (defined $testsname) {
74
75
76
77
        $rvt = $self->tests_from_file($mode, $self->{'fiji_settings'}, $testsname);
    }

    if (!ref $rvt) {
78
        return "Constructor of " . $class . " could not obtain a FIJI::Tests object";
79
    }
Christian Fibich's avatar
Christian Fibich committed
80

81
82
83
    return $self;
}

84
85
86
87
88
## @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
89
sub settings_from_file {
90
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
91
    my $rv;
Christian Fibich's avatar
Christian Fibich committed
92
    my ($self, $cfgname) = @_;
93
    my ($fiji_settings, $errors, $warnings) = FIJI::Settings->new('download', $cfgname); # fixme
94
    if (!defined($fiji_settings)) {
95
        $rv = $errors;
Christian Fibich's avatar
Christian Fibich committed
96
    } else {
97
98
        $logger->warn($errors) if defined $errors;
        $logger->warn($warnings) if defined $warnings;
Christian Fibich's avatar
Christian Fibich committed
99
100
101
102
103
104
105
        $rv = $self->{'fiji_settings'} = $fiji_settings;
    }
    return $rv;
}

sub existing_settings {
    my $rv;
Christian Fibich's avatar
Christian Fibich committed
106
107
    my ($self, $existing_cfg) = @_;
    if (ref($existing_cfg) eq "FIJI::Settings") {
Christian Fibich's avatar
Christian Fibich committed
108
109
110
111
112
113
        $rv = $self->{'fiji_settings'} = $existing_cfg;
    } else {
        $rv = "Given Settings are not of type FIJI::Settings";
    }
}

114
## @method public tests_from_file ($mode, %$set_ref, $cfgname)
115
# @brief read tests from a given file
116
117
118
#
# @param mode           currently active FIJI settings
# @param set_ref        currently active FIJI settings
119
# @param cfgname        the file to read from
120
#
121
122
# @returns STRING if an error ocurred
# @returns FIJI::Tests object if sucessful
Christian Fibich's avatar
Christian Fibich committed
123
124
sub tests_from_file {
    my $rv;
125
    my $logger = get_logger("");
126
    my ($self, $mode, $set_ref, $cfgname) = @_;
127
    $logger->info("New Tests for mode '$mode'");
128
    my ($fiji_tests, $warn) = FIJI::Tests->new($mode, $set_ref, $cfgname);
Christian Fibich's avatar
Christian Fibich committed
129
    if (!ref($fiji_tests)) {
130
        $rv = $warn;
Christian Fibich's avatar
Christian Fibich committed
131
132
133
134
135
136
137
138
    } else {
        $rv = $self->{'fiji_tests'} = $fiji_tests;
    }
    return $rv;
}

sub existing_tests {
    my $rv;
Christian Fibich's avatar
Christian Fibich committed
139
140
    my ($self, $existing_tests) = @_;
    if (ref($existing_tests) eq "FIJI::Tests") {
Christian Fibich's avatar
Christian Fibich committed
141
142
143
144
145
146
        $rv = $self->{'fiji_tests'} = $existing_tests;
    } else {
        $rv = "Given Tests are not of type FIJI::Tests";
    }
}

147
## @method public download_auto ($$run_ref, %$$testref, $portname, &$intermediate_cb)
148
# @brief Download tests contained in the .cfg file
149
150
151
#
# @param run_ref            a reference to a boolean indicating that no abort is requested (yet).
# @param testref            (optional) reference (to a HASH REF) where this function shall put the
152
153
154
155
156
#                           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
157
sub download_auto ($) {
158
    my $msg;
159
    my $logger = get_logger("");
160
    my ($self, $run_ref, $testref, $portname, $intermediate_cb) = @_;
161

162
    my $fiji_tests         = $self->{'fiji_tests'};
Christian Fibich's avatar
Christian Fibich committed
163
    my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};
164

165
166
    my @tests;

Christian Fibich's avatar
Christian Fibich committed
167
    if (!defined $intermediate_cb) {
168
        $intermediate_cb = sub { return 1; };
Christian Fibich's avatar
Christian Fibich committed
169
170
    }

Christian Fibich's avatar
Christian Fibich committed
171
172
    $portname = $fiji_tests->{'design'}->{'UART'} if (!defined $portname);
    my $port = FIJI::Connection->init($portname, $fiji_design_consts->{'BAUDRATE'})
173
174
175
176
177
178
179
180
181
      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.");

182
183
184
    my $recv_msg;
    my $ti;

Christian Fibich's avatar
Christian Fibich committed
185
    # download tests until halted
186
    while (1) {
Christian Fibich's avatar
Christian Fibich committed
187
        for ($ti = $toff ; $ti < @{$fiji_tests->{'tests'}} ; $ti++) {
188
189
190

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

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

193
            return $recv_msg if (ref($recv_msg) ne "HASH");
194

195
196
            $logger->info("Test $ti: Underrun occurred.") if ($recv_msg->{'underrun_occurred'});

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

199
200
201
            my $check = $self->_check_halt($recv_msg);

            if (@{$check}) {
202
                $logger->error("Halt because of " . join(" and ", @{$check}) . ". Failed test: $ti, repetition $ri.");
203
                goto END;
204
            }
205

Christian Fibich's avatar
Christian Fibich committed
206
            if (&$intermediate_cb($recv_msg) == 0) {
Christian Fibich's avatar
Christian Fibich committed
207
                $logger->info("Fulfilling halt request after test: $ti, repetition $ri.");
208
                goto END;
Christian Fibich's avatar
Christian Fibich committed
209
210
            }

211
        }
212

Christian Fibich's avatar
Christian Fibich committed
213
214
        # @FIXME Repeat information comes from tests config file. OK?
        if ($fiji_tests->{'design'}->{'REPEAT'} == 0) {
215
216
217
            last;
        } else {
            $ri++;
218
219
220
221
222
223
224
            if ($fiji_tests->{'design'}->{'REPEAT_NUM'} > 0 && $fiji_tests->{'design'}->{'REPEAT_NUM'} == $ri) {
                $logger->info("Specified number of repetitions executed");
                last;
            } else {
                $toff = $fiji_tests->{'design'}->{'REPEAT_OFFSET'};
                $logger->info("Repeat tests beginning with $toff.");
            }
225
226
        }
    }
227

228
  END:
Christian Fibich's avatar
Christian Fibich committed
229
    $$testref                                = clone($self->{'fiji_tests'});
230
231
    $$testref->{'design'}->{'NUM_TESTS'}     = $ti;
    $$testref->{'design'}->{'REPEAT'}        = 0;
232
    $$testref->{'design'}->{'REPEAT_OFFSET'} = 0;
233
234
235
    # We make sure that the returned tests reference is pointing to
    # shareable objects only if the reference itself is already shared.
    # This makes things easier for multithreaded applications like the EE GUI.
Christian Fibich's avatar
Christian Fibich committed
236
237
    if (is_shared($$testref)) {
        $$testref->{'tests'} = shared_clone(\@tests);
238
239
240
241
242
    } else {
        $$testref->{'tests'} = \@tests;
    }

    return $recv_msg;
243
244
}

Christian Fibich's avatar
Christian Fibich committed
245
## @method public download_auto (%$testref, $portname, &$intermediate_cb)
246
# @brief Download randomly generated tests
247
248
#
# \param run_ref            a reference to a boolean indicating that no abort is requested (yet).
249
250
251
252
253
254
# @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
255
sub download_random ($$$;$) {
256
    my $logger = get_logger("");
257
    my ($self, $run_ref, $testref, $portname, $intermediate_cb) = @_;
Christian Fibich's avatar
Christian Fibich committed
258
    my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};
259
    my $fiji_tests_consts = $self->{'fiji_tests'}->{'design'};
Christian Fibich's avatar
Christian Fibich committed
260

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

Christian Fibich's avatar
Christian Fibich committed
263
    if (!defined $intermediate_cb) {
264
        $intermediate_cb = sub { return 1; };
Christian Fibich's avatar
Christian Fibich committed
265
    }
Christian Fibich's avatar
Christian Fibich committed
266

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

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

Christian Fibich's avatar
Christian Fibich committed
289
290
    $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
291

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

    return $recv_msg;
Christian Fibich's avatar
Christian Fibich committed
303
304
}

305
306
## @method download_manual
# @brief Download manually defined tests prompted from <STDIN>
307
308
309
#
# @param run_ref   a reference to a boolean indicating that no abort is requested (yet).
# @param portname  (optional) the serial port to use
Christian Fibich's avatar
Christian Fibich committed
310
sub download_manual ($;$) {
311
    my $msg;
312
    my $logger = get_logger("");
313

314
315
316
    my ($self, $run_ref, $portname, $once) = @_;

    $once = 0 if (!defined $once);
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
      or $logger->fatal("Could not init UART.")
      and return "Could not init UART.";

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

329
    do  {
330

331
        my $test = $self->_get_test_from_stdin();
332
333
334
335
        return "Test execution failed" unless defined $test;

        return undef if (ref($test) ne "HASH" && $test eq "EOF");

336
        my $recv_msg = $self->_download_test($run_ref, $test, $port, 0);
337

338
        return $recv_msg if (ref($recv_msg) ne "HASH");
339

340
        if (@{$self->_check_halt($recv_msg)}) {
Christian Fibich's avatar
Christian Fibich committed
341
            $msg = "Halt because of " . join(' and ', @{$self->_check_halt($recv_msg)});
342
343
344
            return $msg;
        }

345
    } while (!$once);
346
347
348
349

    return $msg;
}

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

Christian Fibich's avatar
Christian Fibich committed
356
    my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};
357
    my $fius = $self->{'fiji_settings'}->{'fius'};
358
    my $test               = {};
359
360
361
362

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

Christian Fibich's avatar
Christian Fibich committed
363
    for (my $i = 0 ; $i < $fiji_design_consts->{'FIU_NUM'} ; $i++) {
364
365
        my $fiu_name = @{$fius}[$i]->{'FIU_NAME'};
        my $fiu_name_str = (defined($fiu_name) and length($fiu_name) > 0) ? "(\"$fiu_name\") " : "";
Christian Fibich's avatar
Christian Fibich committed
366
        for (my $t = 1 ; $t <= $fiji_design_consts->{'CFGS_PER_MSG'} ; $t++) {
367
            my $phase = ($t < $fiji_design_consts->{'CFGS_PER_MSG'}) ? "in t".($t+1) : "after t$t";
368
            printf("Enter configuration for FIU #%d %s%s (default: 0x%x): ", $i, $fiu_name_str, $phase, $default_cfg);
369
370

            my $cfg_str = <STDIN>;
371
            goto PREMATURE_EOF unless defined $cfg_str;
372
            $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
    $test->{'TIMER_VALUE_1'} = <STDIN>;
390
    goto PREMATURE_EOF unless defined $test->{'TIMER_VALUE_1'};
391
392
    $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
    $test->{'TIMER_VALUE_2'} = <STDIN>;
402
    goto PREMATURE_EOF unless defined $test->{'TIMER_VALUE_2'};
403
404
    $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

    printf("Enable trigger (default: 0)? ");
    my $trigger_en = <STDIN>;
411
    goto PREMATURE_EOF 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

    my $trigger_ext = 0;
    if ($trigger_en) {
        printf("Use external/not internal trigger (default: 0)? ");
        $trigger_ext = <STDIN>;
420
        goto PREMATURE_EOF 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
            $test->{'TRIGGER'} = "EXT";
        } else {
            $test->{'TRIGGER'} = "INT";
        }
    } else {
        $test->{'TRIGGER'} = "NONE";
    }

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

    return $test;
441
442
443
444

PREMATURE_EOF:
   $logger->fatal("Premature EOF");
   return "EOF";
445
446
}

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

    # 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.";
458
    return $self->_download_test($run_ref, $test, $port, 1);
459
460
}

Christian Fibich's avatar
Christian Fibich committed
461
## @method public download_test (%$test, $portname)
462
463
464
465
466
# @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
467
sub download_test ($$) {
468
    my $logger = get_logger("");
469
    my ($self, $run_ref, $test, $portname) = @_;
470

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

475
    return $self->_download_test($run_ref, $test, $port, 0);
Christian Fibich's avatar
Christian Fibich committed
476
477
}

478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
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
495
    my ($self, $rnd) = @_;
496
497
    my $prob = {};
    my $sum  = 0;
Christian Fibich's avatar
Christian Fibich committed
498
    for my $k (keys(%{$rnd})) {
499
500
501
502
503
504
505
506
507
        $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
508
    }
509
    return undef;
Christian Fibich's avatar
Christian Fibich committed
510
511
}

Christian Fibich's avatar
Christian Fibich committed
512
## @method private _download_test (%$test, $port)
513
# @brief Download a single test defined by a test hash
514
515
#
# \param run_ref   a reference to a boolean indicating that no abort is requested (yet).
516
517
518
519
# @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]"}
520
#                - test->{'RST_DUT_AFTER_CFG'}
521
522
523
#                - test->{'TRIGGER'}
# @param port (optional) serial port to use
sub _download_test {
524
    my $logger = get_logger("");
525
    my ($self, $run_ref, $test, $port, $dryrun, $block_till_ready, $wait_for_ready) = @_;
526
527

    $dryrun = 0 if !defined $dryrun;
528

Christian Fibich's avatar
Christian Fibich committed
529
    my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};
530
531
    my @payload;

Christian Fibich's avatar
Christian Fibich committed
532
533
    # first generate FIU configuration payload

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

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

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

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

Christian Fibich's avatar
Christian Fibich committed
552
553
    my $trigger_en  = ($test->{'TRIGGER'} ne "NONE") ? 1 : 0;
    my $trigger_ext = ($test->{'TRIGGER'} eq "EXT")  ? 1 : 0;
554
    my $reset       = $test->{'RST_DUT_AFTER_CFG'};
555

Christian Fibich's avatar
Christian Fibich committed
556
557
558
    $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"));
559
560
    }

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

563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
    # Default to NOT block before communication but to wait afterwards
    $block_till_ready = 0 if !ref($block_till_ready);
    $wait_for_ready = 1 if !ref($wait_for_ready);

    $logger->trace("dryrun = $dryrun, block_till_ready = $block_till_ready, wait_for_ready = $wait_for_ready");
    # my @payload = map hex($_), $cfg_str =~ /(..)/g; # @TODO: how to do this with unpack?
    my %config = (
        payload     => \@payload,
        t1_duration => $t1_duration,
        t2_duration => $t2_duration,
        trigger_en  => $trigger_en,
        trigger_ext => $trigger_ext,
        reset       => $reset,
        consts      => $fiji_design_consts,
        dryrun      => $dryrun,
    );
Christian Fibich's avatar
Christian Fibich committed
579

580
581
    # Download test via serial
    my $recv_msg = $port->send_config(\%config, $run_ref, $block_till_ready, $wait_for_ready);
582
    if (ref($recv_msg) eq "HASH" && defined($recv_msg->{'msg_type'})) {
583
584
585
586
        my $log_msg = "Received " . $recv_msg->{'msg_type'} . " message";
        $log_msg .= sprintf(": U=%d, I=%d, C=%d, F1=%d, F2=%d,", $recv_msg->{'error'}->{'U'}, $recv_msg->{'error'}->{'I'}, $recv_msg->{'error'}->{'C'}, $recv_msg->{'fault_detect'}->{'1'}, $recv_msg->{'fault_detect'}->{'2'}) if (defined($recv_msg->{'error'}));
        $logger->info($log_msg);
    }
Christian Fibich's avatar
Christian Fibich committed
587
    return $recv_msg;
588
589
}

Christian Fibich's avatar
Christian Fibich committed
590
## @method private _check_halt (%$recv_msg)
591
592
593
# @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
594
595
# @returns reference to list of reasons if execution shall be halted
# @returns reference to empty list otherwise
596
sub _check_halt ($) {
597
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
598
    my ($self, $recv_msg) = @_;
Christian Fibich's avatar
Christian Fibich committed
599
    my $reasons    = [];
600
601
    my $fiji_tests = $self->{'fiji_tests'};

602
603
    # NB: The HALT_ON_xxx_ERROR values are defined in test config files but
    # are not settable in any UI. If need be it can be hardcoded in the .tst
Christian Fibich's avatar
Christian Fibich committed
604

605
606
607
    if ($recv_msg->{'aborted'}) {
        return ["an active abort"];
    }
Christian Fibich's avatar
Christian Fibich committed
608
609
    if ($recv_msg->{'msg_type'} eq "UNDERRUN") {
        $logger->info("UNDERRUN message received. HALT_ON_UNDERRUN = " . $fiji_tests->{'design'}->{'HALT_ON_UNDERRUN'} . ".");
610
611
612
613
614
        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'};
615
    }
Christian Fibich's avatar
Christian Fibich committed
616
617
    if ($recv_msg->{'error'}->{'U'}) {
        $logger->info("UART error. HALT_ON_UART_ERROR = " . $fiji_tests->{'design'}->{'HALT_ON_UART_ERROR'} . ".");
618
        push @{$reasons}, 'HALT_ON_UART_ERROR' if $fiji_tests->{'design'}->{'HALT_ON_UART_ERROR'};
619
    }
Christian Fibich's avatar
Christian Fibich committed
620
621
    if ($recv_msg->{'error'}->{'I'}) {
        $logger->info("ID error. HALT_ON_ID_ERROR = " . $fiji_tests->{'design'}->{'HALT_ON_ID_ERROR'} . ".");
622
        push @{$reasons}, 'HALT_ON_ID_ERROR' if $fiji_tests->{'design'}->{'HALT_ON_ID_ERROR'};
623
    }
Christian Fibich's avatar
Christian Fibich committed
624
625
    if ($recv_msg->{'error'}->{'C'}) {
        $logger->info("CRC error. HALT_ON_CRC_ERROR = " . $fiji_tests->{'design'}->{'HALT_ON_CRC_ERROR'} . ".");
626
        push @{$reasons}, 'HALT_ON_CRC_ERROR' if $fiji_tests->{'design'}->{'HALT_ON_CRC_ERROR'};
627
    }
Christian Fibich's avatar
Christian Fibich committed
628
629
630
    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'} . ".");
631
            push @{$reasons}, "HALT_ON_FAULT_DETECT($ei)" if $fiji_tests->{'design'}->{'HALT_ON_FAULT_DETECT'};
632
633
634
        }
    }

635
    return $reasons;
636
637
}

638
1;