Downloader.pm 22.9 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
#-------------------------------------------------------------------------------
#  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
#
#-------------------------------------------------------------------------------
#  Description:
#  FIJI Downloader class
#-------------------------------------------------------------------------------

Christian Fibich's avatar
Christian Fibich committed
15
16
## @file Downloader.pm
# @brief Contains class \ref FIJI::Downloader
17

Christian Fibich's avatar
Christian Fibich committed
18
19
## @class FIJI::Downloader
# @brief contains functionality to download tests via serial
20

21
22
23
24
25
package FIJI::Downloader;

use strict;
use warnings;

26
use Log::Log4perl qw(get_logger);
27
28
29
30
use FIJI::Tests;
use FIJI::Settings;
use FIJI::Connection;
use FIJI qw(:all);
Christian Fibich's avatar
Christian Fibich committed
31
use Clone 'clone';
32
33
use threads;
use threads::shared;
34

35
# FIXME: fix documentation
Christian Fibich's avatar
Christian Fibich committed
36
## @function public new ($testsname,%$existing_tests,$cfgname,%$existing_cfg)
37
38
39
40
41
#
# @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
42
#
43
44
# Either $testsname or $existing_tests must be present
# Either $cfgname or $existing_cfg must be present
Christian Fibich's avatar
Christian Fibich committed
45
sub new(;$$) {
46
    my $logger = get_logger("");
47
    my ($class, $mode, $testsname, $existing_tests, $cfgname, $existing_cfg) = @_;
48
    my $self = {};
49
50
51
    bless $self, $class;
    my $rvt;
    my $rvs;
Christian Fibich's avatar
Christian Fibich committed
52

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

    if (!ref $rvs) {
        my $msg = "Constructor of " . $class . " could not obtain a FIJI::Settings object";
        $logger->error($msg);
        return $msg;
Christian Fibich's avatar
Christian Fibich committed
63
    }
64

Christian Fibich's avatar
Christian Fibich committed
65
    if (defined $existing_tests) {
66
        $rvt = $self->existing_tests($existing_tests);
Christian Fibich's avatar
Christian Fibich committed
67
    } elsif (defined $testsname) {
68
69
70
71
72
73
74
        $rvt = $self->tests_from_file($mode, $self->{'fiji_settings'}, $testsname);
    }

    if (!ref $rvt) {
        my $msg = "Constructor of " . $class . " could not obtain a FIJI::Tests object";
        $logger->error($msg);
        return $msg;
75
    }
Christian Fibich's avatar
Christian Fibich committed
76

77
78
79
    return $self;
}

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

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

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

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

142
## @method public download_auto ($$run_ref, %$$testref, $portname, &$intermediate_cb)
143
# @brief Download tests contained in the .cfg file
144
145
146
#
# @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
147
148
149
150
151
#                           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
152
sub download_auto ($) {
153
    my $msg;
154
    my $logger = get_logger("");
155
    my ($self, $run_ref, $testref, $portname, $intermediate_cb) = @_;
156

157
    my $fiji_tests         = $self->{'fiji_tests'};
Christian Fibich's avatar
Christian Fibich committed
158
    my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};
159

160
161
    my @tests;

Christian Fibich's avatar
Christian Fibich committed
162
    if (!defined $intermediate_cb) {
163
        $intermediate_cb = sub { return 1; };
Christian Fibich's avatar
Christian Fibich committed
164
165
    }

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

177
178
179
    my $recv_msg;
    my $ti;

Christian Fibich's avatar
Christian Fibich committed
180
    # download tests until halted
181
    while (1) {
Christian Fibich's avatar
Christian Fibich committed
182
        for ($ti = $toff ; $ti < @{$fiji_tests->{'tests'}} ; $ti++) {
183
184
185

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

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

188
            return $recv_msg if (ref($recv_msg) ne "HASH");
189

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

192
193
194
            my $check = $self->_check_halt($recv_msg);

            if (@{$check}) {
195
                $logger->error("Halt because of " . join(" and ", @{$check}) . ". Failed test: $ti, repetition $ri.");
196
                goto END;
197
            }
198

Christian Fibich's avatar
Christian Fibich committed
199
            if (&$intermediate_cb($recv_msg) == 0) {
Christian Fibich's avatar
Christian Fibich committed
200
                $logger->info("Fulfilling halt request after test: $ti, repetition $ri.");
201
                goto END;
Christian Fibich's avatar
Christian Fibich committed
202
203
            }

204
        }
205

Christian Fibich's avatar
Christian Fibich committed
206
207
        # @FIXME Repeat information comes from tests config file. OK?
        if ($fiji_tests->{'design'}->{'REPEAT'} == 0) {
208
209
210
211
212
213
214
            last;
        } else {
            $toff = $fiji_tests->{'design'}->{'REPEAT_OFFSET'};
            $logger->info("Repeat tests beginning with $toff.");
            $ri++;
        }
    }
215

216
  END:
Christian Fibich's avatar
Christian Fibich committed
217
    $$testref                                = clone($self->{'fiji_tests'});
218
219
    $$testref->{'design'}->{'NUM_TESTS'}     = $ti;
    $$testref->{'design'}->{'REPEAT'}        = 0;
220
    $$testref->{'design'}->{'REPEAT_OFFSET'} = 0;
221
222
223
    # 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
224
225
    if (is_shared($$testref)) {
        $$testref->{'tests'} = shared_clone(\@tests);
226
227
228
229
230
    } else {
        $$testref->{'tests'} = \@tests;
    }

    return $recv_msg;
231
232
}

Christian Fibich's avatar
Christian Fibich committed
233
## @method public download_auto (%$testref, $portname, &$intermediate_cb)
234
# @brief Download randomly generated tests
235
236
#
# \param run_ref            a reference to a boolean indicating that no abort is requested (yet).
237
238
239
240
241
242
# @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
243
sub download_random ($$$;$) {
244
    my $logger = get_logger("");
245
    my ($self, $run_ref, $testref, $portname, $intermediate_cb) = @_;
Christian Fibich's avatar
Christian Fibich committed
246
    my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};
247
    my $fiji_tests_consts = $self->{'fiji_tests'}->{'design'};
Christian Fibich's avatar
Christian Fibich committed
248

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

Christian Fibich's avatar
Christian Fibich committed
251
    if (!defined $intermediate_cb) {
252
        $intermediate_cb = sub { return 1; };
Christian Fibich's avatar
Christian Fibich committed
253
    }
Christian Fibich's avatar
Christian Fibich committed
254

Christian Fibich's avatar
Christian Fibich committed
255
    my $port = FIJI::Connection->init($portname, $fiji_design_consts->{'BAUDRATE'})
Christian Fibich's avatar
Christian Fibich committed
256
257
258
259
260
261
262
      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
263
264
    my $check = 0;
    my $cont;
Christian Fibich's avatar
Christian Fibich committed
265
266

    do {
Christian Fibich's avatar
Christian Fibich committed
267
        my $temp_test = $self->{'fiji_tests'}->make_random_test($self->{'fiji_settings'}, ($ti == 0));
Christian Fibich's avatar
Christian Fibich committed
268
        return $temp_test if (!ref($temp_test));
269
        $tests[$ti] = $temp_test;
Christian Fibich's avatar
Christian Fibich committed
270
        $logger->info("=== Test $ti ===");
271
        $recv_msg = $self->_download_test($run_ref, $tests[$ti++], $port, 0);
272
        return $recv_msg if (ref($recv_msg) ne "HASH");
Christian Fibich's avatar
Christian Fibich committed
273
        $check = $self->_check_halt($recv_msg);
274
        $cont  = &$intermediate_cb($recv_msg);
275
    } while (@{$check} == 0 && $cont != 0);
Christian Fibich's avatar
Christian Fibich committed
276

Christian Fibich's avatar
Christian Fibich committed
277
278
    $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
279

Christian Fibich's avatar
Christian Fibich committed
280
    $$testref                                = clone($self->{'fiji_tests'});
281
282
    $$testref->{'design'}->{'NUM_TESTS'}     = $ti;
    $$testref->{'design'}->{'REPEAT'}        = 0;
283
    $$testref->{'design'}->{'REPEAT_OFFSET'} = 0;
Christian Fibich's avatar
Christian Fibich committed
284
285
    if (is_shared($$testref)) {
        $$testref->{'tests'} = shared_clone(\@tests);
286
287
288
    } else {
        $$testref->{'tests'} = \@tests;
    }
Christian Fibich's avatar
Christian Fibich committed
289
290

    return $recv_msg;
Christian Fibich's avatar
Christian Fibich committed
291
292
}

293
294
## @method download_manual
# @brief Download manually defined tests prompted from <STDIN>
295
296
297
#
# @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
298
sub download_manual ($;$) {
299
    my $msg;
300
    my $logger = get_logger("");
301

302
    my ($self, $run_ref, $portname) = @_;
303

Christian Fibich's avatar
Christian Fibich committed
304
    my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};
305
    my $fiji_tests_consts = $self->{'fiji_tests'}->{'design'};
306

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

Christian Fibich's avatar
Christian Fibich committed
309
    my $port = FIJI::Connection->init($portname, $fiji_design_consts->{'BAUDRATE'})
310
311
312
313
314
315
      or $logger->fatal("Could not init UART.")
      and return "Could not init UART.";

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

    while (1) {
316

317
        my $test = $self->_get_test_from_stdin();
318
        my $recv_msg = $self->_download_test($run_ref, $test, $port, 0);
319

320
        return $recv_msg if (ref($recv_msg) ne "HASH");
321

322
        if (@{$self->_check_halt($recv_msg)}) {
Christian Fibich's avatar
Christian Fibich committed
323
            $msg = "Halt because of " . join(' and ', @{$self->_check_halt($recv_msg)});
324
325
326
327
328
329
330
331
            return $msg;
        }

    }

    return $msg;
}

332
## @method _get_test_from_stdin ()
Christian Fibich's avatar
Christian Fibich committed
333
# @brief Prompt tests from \<STDIN\>
334
sub _get_test_from_stdin {
335
    my $logger = get_logger("");
336
337
    my ($self) = @_;

Christian Fibich's avatar
Christian Fibich committed
338
    my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};
339
    my $test               = {};
340
341
342
343

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

Christian Fibich's avatar
Christian Fibich committed
344
345
    for (my $i = 0 ; $i < $fiji_design_consts->{'FIU_NUM'} ; $i++) {
        for (my $t = 1 ; $t <= $fiji_design_consts->{'CFGS_PER_MSG'} ; $t++) {
346
347
            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);
348
349
350
351

            my $cfg_str = <STDIN>;
            last unless defined $cfg_str;
            $cfg_str =~ s/\R//g;    # remove line breaks globally
352
353
354
355
356
                                    # $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
357
            my $cur_cfg = (length($cfg_str) == 0) ? $default_cfg : $cfg_str;
358
            $cur_cfg = oct($cur_cfg) if $cur_cfg =~ /^0/;
359
            $logger->debug(sprintf("Configuration of FIU #%d %s is 0x%x.", $i, $phase, $cur_cfg));
360
            $test->{"FIU_${i}_FAULT_${t}"} = REVERSE_FIU_ENUM($cur_cfg);
361
362
363
364
365
        }
    }

    # default t1 is maximum/2
    my $default_t1_dur =
Christian Fibich's avatar
Christian Fibich committed
366
367
      oct("0x" . ("FF" x ($fiji_design_consts->{'TIMER_WIDTH'} / 8))) / 2;
    printf("Enter duration t1 (default: 0x%x): ", $default_t1_dur);
368
369
370
371
    $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
372
373
374
      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'}));
375
376
377

    # default t2 duration to maximum/2
    my $default_t2_dur =
Christian Fibich's avatar
Christian Fibich committed
378
379
      oct("0x" . ("FF" x ($fiji_design_consts->{'TIMER_WIDTH'} / 8))) / 2;
    printf("Enter duration t2 (default: 0x%x): ", $default_t2_dur);
380
381
382
383
    $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
384
385
386
      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'}));
387
388
389
390

    printf("Enable trigger (default: 0)? ");
    my $trigger_en = <STDIN>;
    last unless defined $trigger_en;
391
    $trigger_en =~ s/\R//g;                 # remove line breaks globally
Christian Fibich's avatar
Christian Fibich committed
392
393
    $trigger_en = ($trigger_en =~ /1|yes|y/i) ? 1 : 0;
    $logger->debug(sprintf("trigger is %sabled.", $trigger_en == 0 ? "dis" : "en"));
394
395
396
397
398
399

    my $trigger_ext = 0;
    if ($trigger_en) {
        printf("Use external/not internal trigger (default: 0)? ");
        $trigger_ext = <STDIN>;
        last unless defined $trigger_ext;
400
        $trigger_ext =~ s/\R//g;            # remove line breaks globally
Christian Fibich's avatar
Christian Fibich committed
401
402
403
        $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) {
404
405
406
407
408
409
410
411
412
            $test->{'TRIGGER'} = "EXT";
        } else {
            $test->{'TRIGGER'} = "INT";
        }
    } else {
        $test->{'TRIGGER'} = "NONE";
    }

    printf("Enable reset (default: 0)? ");
413
414
415
416
417
    $test->{'RST_DUT_AFTER_CFG'} = <STDIN>;
    last unless defined $test->{'RST_DUT_AFTER_CFG'};
    $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"));
418
419
420
421

    return $test;
}

422
423
sub get_fic_status ($$) {
    my $logger = get_logger("");
424
    my ($self, $run_ref, $portname) = @_;
425
426
427
428
429
430
431
432

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

Christian Fibich's avatar
Christian Fibich committed
436
## @method public download_test (%$test, $portname)
437
438
439
440
441
# @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
442
sub download_test ($$) {
443
    my $logger = get_logger("");
444
    my ($self, $run_ref, $test, $portname) = @_;
445

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

450
    return $self->_download_test($run_ref, $test, $port, 0);
Christian Fibich's avatar
Christian Fibich committed
451
452
}

453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
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
470
    my ($self, $rnd) = @_;
471
472
    my $prob = {};
    my $sum  = 0;
Christian Fibich's avatar
Christian Fibich committed
473
    for my $k (keys(%{$rnd})) {
474
475
476
477
478
479
480
481
482
        $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
483
    }
484
    return undef;
Christian Fibich's avatar
Christian Fibich committed
485
486
}

Christian Fibich's avatar
Christian Fibich committed
487
## @method private _download_test (%$test, $port)
488
# @brief Download a single test defined by a test hash
489
490
#
# \param run_ref   a reference to a boolean indicating that no abort is requested (yet).
491
492
493
494
# @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]"}
495
#                - test->{'RST_DUT_AFTER_CFG'}
496
497
498
#                - test->{'TRIGGER'}
# @param port (optional) serial port to use
sub _download_test {
499
    my $logger = get_logger("");
500
    my ($self, $run_ref, $test, $port, $dryrun, $block_till_ready, $wait_for_ready) = @_;
501
502

    $dryrun = 0 if !defined $dryrun;
503

Christian Fibich's avatar
Christian Fibich committed
504
    my $fiji_design_consts = $self->{'fiji_settings'}->{'design'};
505
506
    my @payload;

Christian Fibich's avatar
Christian Fibich committed
507
508
    # first generate FIU configuration payload

Christian Fibich's avatar
Christian Fibich committed
509
510
    for (my $i = 0 ; $i < $fiji_design_consts->{'FIU_NUM'} ; $i++) {
        for (my $t = 1 ; $t <= $fiji_design_consts->{'CFGS_PER_MSG'} ; $t++) {
511
            my $k       = "FIU_${i}_FAULT_${t}";
Christian Fibich's avatar
Christian Fibich committed
512
            my $cur_cfg = FIUENUM->{$test->{$k}};
513
            $cur_cfg = oct($cur_cfg) if $cur_cfg =~ /^0/;
Christian Fibich's avatar
Christian Fibich committed
514
515
            $logger->debug(sprintf("Configuration of FIU #%d in t%d is 0x%x.", $i, $t, $cur_cfg));
            push(@payload, $cur_cfg);
516
517
518
        }
    }

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

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

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

Christian Fibich's avatar
Christian Fibich committed
527
528
    my $trigger_en  = ($test->{'TRIGGER'} ne "NONE") ? 1 : 0;
    my $trigger_ext = ($test->{'TRIGGER'} eq "EXT")  ? 1 : 0;
529
    my $reset       = $test->{'RST_DUT_AFTER_CFG'};
530

Christian Fibich's avatar
Christian Fibich committed
531
532
533
    $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"));
534
535
    }

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

538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
    # 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
554

555
556
    # Download test via serial
    my $recv_msg = $port->send_config(\%config, $run_ref, $block_till_ready, $wait_for_ready);
557
    if (ref($recv_msg) eq "HASH" && defined($recv_msg->{'msg_type'})) {
558
559
560
561
        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
562
    return $recv_msg;
563
564
}

Christian Fibich's avatar
Christian Fibich committed
565
## @method private _check_halt (%$recv_msg)
566
567
568
# @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
569
570
# @returns reference to list of reasons if execution shall be halted
# @returns reference to empty list otherwise
571
sub _check_halt ($) {
572
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
573
    my ($self, $recv_msg) = @_;
Christian Fibich's avatar
Christian Fibich committed
574
    my $reasons    = [];
575
576
    my $fiji_tests = $self->{'fiji_tests'};

577
578
    # NB: HALT_on_xxx information is defined in tests config file but
    # is not setable by any UI. If need be it can be hardcoded in the .ini
Christian Fibich's avatar
Christian Fibich committed
579

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

607
    return $reasons;
608
609
}

610
1;