Commit 8c0a23a2 authored by Stefan Tauner's avatar Stefan Tauner
Browse files

Refactor fiji_scripts into packages

 - objectify connection and configuration handling
 - work around Doxygen::Filter::Perl issue
 - add some missing documentation bits
 - make some functions private
 - always send 0 bytes to reset connection at the beginning
parent 80c1db26
......@@ -32,7 +32,7 @@ DOXYFILE_ENCODING = UTF-8
# title of most generated pages and in a few other places.
# The default value is: My Project.
PROJECT_NAME = "My Project"
PROJECT_NAME = "FIJI"
# The PROJECT_NUMBER tag can be used to enter a project or revision number. This
# could be handy for archiving the generated documentation or if some version
......@@ -743,7 +743,7 @@ WARN_LOGFILE =
# spaces.
# Note: If this tag is empty the current directory is searched.
INPUT =
INPUT = . FIJI
# This tag can be used to specify the character encoding of the source files
# that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses
......@@ -794,7 +794,7 @@ EXCLUDE_SYMLINKS = NO
# Note that the wildcards are matched against the file with absolute path, so to
# exclude all test directories for example use the pattern */test/*
EXCLUDE_PATTERNS =
EXCLUDE_PATTERNS = */FIJI/AnySerialPort.pm
# The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names
# (namespaces, classes, functions, etc.) that should be excluded from the
......@@ -805,7 +805,7 @@ EXCLUDE_PATTERNS =
# Note that the wildcards are matched against the file with absolute path, so to
# exclude all test directories use the pattern */test/*
EXCLUDE_SYMBOLS =
EXCLUDE_SYMBOLS = main
# The EXAMPLE_PATH tag can be used to specify one or more files or directories
# that contain example code fragments that are included (see the \include
......@@ -892,7 +892,7 @@ USE_MDFILE_AS_MAINPAGE =
# also VERBATIM_HEADERS is set to NO.
# The default value is: NO.
SOURCE_BROWSER = NO
SOURCE_BROWSER = yes
# Setting the INLINE_SOURCES tag to YES will include the body of functions,
# classes and enums directly into the documentation.
......@@ -1540,7 +1540,7 @@ EXTRA_SEARCH_MAPPINGS =
# If the GENERATE_LATEX tag is set to YES doxygen will generate LaTeX output.
# The default value is: YES.
GENERATE_LATEX = YES
GENERATE_LATEX = no
# The LATEX_OUTPUT tag is used to specify where the LaTeX docs will be put. If a
# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of
......
......@@ -13,8 +13,8 @@
# to change it:
# Device::SerialPort->mapPorts('COM1:' => '/dev/magicSerial0',
# 'COM2' => '/dev/magicSerial1');
package FIJI::AnySerialPort;
use strict;
package AnySerialPort;
use vars '@ISA';
BEGIN
......
## @file [Connection.pm]
## @class [FIJI::Connection]
#
# Instances of this class represent a single serial connection to a FIJI-compatible DUT.
# Besides handling all communication-related functions they are also responsible for generating and interpreting the respective payloads.
#
# The implementation relies on AnySerialPort.pm to be cross-platform-compatible.
package FIJI::Connection;
use Switch;
use Log::Log4perl qw(get_logger);
use Digest::CRC "crc";
use Time::HiRes "usleep";
use FIJI::AnySerialPort;
## @method init ($portname, $baudrate)
# @brief Initiate the given serial port and this abstraction.
#
# \param portname The path to the device file of the port.
# \param baudrate optional The baudrate to use.
#
# \returns a FIJI::Connection object, or undef if non could be obtained.
sub init {
my $logger = get_logger();
my ($class, $portname, $baudrate) = @_;
if (defined($baudrate)) {
if ($baudrate <= 0) {
$logger->error(sprintf("Baud rate is negative (%d).", $baudrate));
return undef;
}
} else {
$baudrate = 9600;
}
my $port = Device::SerialPort->new($portname);
if (!defined($port)) {
$logger->warn("Could not open serial port \"$portname\".");
return undef;
}
if ($port->can("are_baudrate")) {
my @rates = $port->are_baudrate;
if (grep(/^$baudrate$/, @rates) == 0) {
$logger->error("Invalid baud rate ($baudrate). Possible choices are:",
{
filter => sub {
my $opts = shift;
my $ret = "";
foreach my $o (@$opts) {
$ret .= sprintf("\n%d", $o);
}
return $ret;
},
value => \@rates
}
);
return undef;
}
}
$port->databits(8);
$port->baudrate($baudrate);
$port->parity("none");
$port->stopbits(1);
$port->handshake("none");
$port->read_char_time(0); # don't wait for each character
$port->read_const_time(1000); # 1 second per unfulfilled "read" call
if (!$port->write_settings) {
$logger->warn("Could not write UART settings for \"$portname\".");
return undef;
}
$logger->info("Using serial port $portname with baud rate $baudrate.");
my %hash;
$hash{'port'} = $port;
my $r = bless(\%hash, $class);
if (!ref($r) || !UNIVERSAL::can($r,'can')) {
$logger->error("Could not bless serial port for \"$portname\".");
return undef;
}
return $r;
}
## @method reset_comm ($self, %$consts_ref)
# @brief Reset communication protocol.
#
# Send an appropriate number of "idle" bytes and empty the receive buffer.
#
# The suitable idle string contains...
# - FIU_NUM 0x00 bytes (representing the FIU config)
# - 0x01 (representing the lower ID byte and triggering an FSM state
# change in the hardware to continue.
# - additional zero bytes for high ID byte, arm and injection durations,
# FIC configuration, CRC
#
# \param self An initialized FIJI::Connection object
# \param consts_ref a reference to a hash containing the fiji constants
#
# \returns 0 on success
sub reset_comm {
my $logger = get_logger();
my ($self, $consts_ref) = @_;
my $port = $self->{'port'};
my @bytes;
# FIU configs
my $fiu_cfg_bytes_cnt = int(($consts_ref->{'FIU_NUM'} * $consts_ref->{'FIU_CFG_BITS'} + 7) / 8);
for (my $i = 0; $i < $fiu_cfg_bytes_cnt; $i++) {
push(@bytes, 0x00);
}
# ID
push(@bytes, 0x01);
push(@bytes, 0x00);
# Everything else
for (my $i = 0; $i < $consts_ref->{'ARM_DURATION_WIDTH'} / 8 + $consts_ref->{'INJECTION_DURATION_WIDTH'} / 8 + 2; $i++) {
push(@bytes, 0x00);
}
if (_send_bitstream($port, \pack('C*', @bytes), 1000) != scalar(@bytes)) {
$logger->error("Could not send idle bytes to reset communication.");
return 1;
}
# wait till output is completed + an additional short amount of time, then clear the receive buffer
my $ret = 0;
$ret |= $port->write_drain;
usleep(50 * 1000);
$ret |= $port->purge_rx;
return $ret;
}
## @function sanitize_config (%$config_ref)
# @brief Do a sanity check on the FIJI configuration hash.
#
# \param config_ref a reference to a hash containing a FIJI configuration consisting of
# - payload: a byte array representing the FIU configuration
# - arm_duration and injection_duration (optional):
# initialization values for the arm and injection duration counters (minus one, actually).
# - consts: a reference to a hash representing FIJI constants (see \ref FIJI::Settings::_sanitize_consts).
# The following values are optional booleans and hence not checked:
# - reset
# - trigger
#
# \returns 0 if configuration seems sane.
sub sanitize_config {
my $logger = get_logger();
my ($config_ref) = @_;
my $consts_ref = $config_ref->{'consts'};
my $payload_ref = $config_ref->{'payload'};
# check payload
if (ref($payload_ref) ne 'ARRAY') {
$logger->error("payload parameter is not a reference to an array.");
return 1;
}
if (scalar(@$payload_ref) != $consts_ref->{'FIU_NUM'}) {
$logger->error(sprintf("Expected %d FIU configuration bytes but got %d.", $consts_ref->{'FIU_NUM'}, scalar(@$payload_ref)));
return 1;
}
my $cfg_mask = 2 ** $consts_ref->{'FIU_CFG_BITS'} - 1;
for (my $i = 0; $i < scalar(@$payload_ref); $i++) {
if ((@$payload_ref[$i] & ~$cfg_mask) != 0) {
$logger->error("Configuration of FIU #$i has undefined bits set.");
return 1;
}
}
# if payload would be a string...
# for (my $i = 0; $i < length($payload); $i++) {
# my $orig = substr($payload, $i, 1);
# my $c = ord($orig);
# if ($c > 127) {
# $logger->error(sprintf("%dth byte is too big (%d).", $i, $c));
# return 1;
# }
# $c <<= 1;
# substr($payload, $i, 1) = chr($c);
# $logger->trace(sprintf("%s (0x%02x) => %s (0x%02x).", $orig, ord($orig), substr($payload, $i, 1), ord(substr($payload, $i, 1))));
# }
# optional, positive values:
foreach my $k ('arm_duration', 'injection_duration') {
if (!exists($config_ref->{$k})) {
$logger->debug("$k not in configuration, using default 0.");
$config_ref->{$k} = 0;
} else {
if ($config_ref->{$k} < 0) {
$logger->error(sprintf("Configuration value \"%s\" is negative (%d).", $k, $config_ref->{$k}));
return 1;
}
my $width_name = uc($k)."_WIDTH"; # availablity must have been checked with FIJI::Settings::_sanitize_consts already
my $max_val = 2 ** $consts_ref->{$width_name} - 1;
if ($config_ref->{$k} > $max_val) {
$logger->error(sprintf("Configuration value \"%s\" is too big (%d) for %d bits.", $k, $config_ref->{$k}, $consts_ref->{$width_name}));
return 1;
}
}
}
return 0;
}
## @method send_config (%$config_ref, $timeout, $block_till_ready, $wait_for_ready)
# @brief Sends a complete configuration to the FI controller.
#
# \param config_ref a reference to a hash representing a FIJI configuration (see \ref sanitize_config).
# \param timeout An approximate(!) timeout for the whole operation.
# \param block_till_ready Normally the function immediately starts to transmit the new configuration. If this parameter is defined and non-zero the function first waits for a READY message (up to the timeout).
# \param wait_for_ready Normally the function returns immediately after the CONF_DONE message is received. If this parameter is defined and non-zero the function additionally waits for a READY/UNDERRUN message.
#
# \returns 0 on success
sub send_config {
my $logger = get_logger();
my ($self, $config_ref, $timeout, $block_till_ready, $wait_for_ready) = @_;
my $port = $self->{'port'};
if (ref($config_ref) ne 'HASH') {
$logger->error("Parameter is not a reference to a hash (containing a fiji configuration).");
return 1;
}
if (sanitize_config($config_ref) != 0) {
$logger->error("Fiji configuration invalid");
return 1;
}
my $consts_ref = $config_ref->{'consts'};
my $pay_ref = $config_ref->{'payload'};
my $reset = (exists($config_ref->{'reset'}) and ($config_ref->{'reset'} != 0)) ? 1 : 0;
my $trigger = (exists($config_ref->{'trigger'}) and ($config_ref->{'trigger'} != 0)) ? 1 : 0;
my $id = $consts_ref->{'ID'};
my $arm_duration = $config_ref->{'arm_duration'};
my $arm_duration_en = 0;
if ($arm_duration > 0) {
$arm_duration--;
$arm_duration_en = 1;
}
my @arm_duration_arr;
for (my $i = 0; $i < $consts_ref->{'ARM_DURATION_WIDTH'} / 8; $i++) {
push(@arm_duration_arr, ($arm_duration >> ($i * 8)) & 0xFF);
}
my $injection_duration = $config_ref->{'injection_duration'};
my $injection_duration_en = 0;
if ($injection_duration > 0) {
$injection_duration--;
$injection_duration_en = 1;
}
my @injection_duration_arr;
for (my $i = 0; $i < $consts_ref->{'INJECTION_DURATION_WIDTH'} / 8; $i++) {
push(@injection_duration_arr, ($injection_duration >> ($i * 8)) & 0xFF);
}
# create the actual bit stream
my $bits_per_cfg = $consts_ref->{'FIU_CFG_BITS'};
my $cfg_mask = 2 ** $consts_ref->{'FIU_CFG_BITS'} - 1;
my $cfg_bits = $consts_ref->{'FIU_NUM'} * $consts_ref->{'FIU_CFG_BITS'};
my $padding = $cfg_bits % 7;
my $padding_bits = ($padding != 0) ? 7 - $padding : 0;
my $stuff_bits = int(($cfg_bits + $padding_bits + 6) / 7);
my $cfg_bits_total = $cfg_bits + $padding_bits + $stuff_bits;
$logger->debug("Building the actual configuration bit string of $cfg_bits_total bits ($cfg_bits cfg bits + $padding_bits paddings bits + $stuff_bits stuffing bits)");
my @cfg;
my $byte = 0;
my $top = $cfg_bits_total;
my $bot = $padding_bits;
for (my $i = $bot, my $fiu = $consts_ref->{'FIU_NUM'} - 1, my $bit_off = $bits_per_cfg - 1; $i < $top; $i++) {
if (($i % 8) == 7 || $i == $top - 1) {
$logger->trace(sprintf("Appended new config byte: %b (0x%02x)", $byte, $byte));
push(@cfg, $byte);
$byte = 0;
next;
}
# prepend the next bit of the current FIU
$byte = ((($pay_ref->[$fiu] >> $bit_off) & 1) << 7) | $byte >> 1;
my $b = ($pay_ref->[$fiu] >> $bit_off) & 1;
$logger->trace("Appended $b (bit_off=$bit_off, fiu=$fiu, i=$i): $byte");
if ($bit_off == 0) {
$bit_off = $bits_per_cfg - 1;
$fiu--;
next;
}
$bit_off--;
}
$logger->debug("The resulting configuration payload: " . join(", ", unpack("H2" x scalar(@cfg), pack("C*",@cfg))));
my $config_byte = ($reset << 3) | ($injection_duration_en << 2) | ($arm_duration_en << 1) | ($trigger << 0);
my $bitstr = pack('C*', @cfg,
$id & 0xFF,
($id >> 8) & 0x7F,
@arm_duration_arr,
@injection_duration_arr,
$config_byte
); # oh my.
# generate input for http://www.zorc.breitbandkatze.de/crc.html
# printf("payload data: ");
# for (my $i = 0; $i < length($bitstr); $i++) {
# printf("%%%02x", ord(substr($bitstr, $i, 1)));
# }
# printf("\n");
my $ctx = Digest::CRC->new(width => 8,
init => 0xF9,
poly => 0xD5,
refin => 1,
refout => 1,
xorout => 0,
);
$ctx->add($bitstr);
my $crc = hex($ctx->hexdigest);
$bitstr .= chr($crc); # FIXME: this will probably break some day
my @rcv_buf = ();
my %err;
my $msg_type;
# if block_till_ready... wait for ready message first
if (defined($block_till_ready) && $block_till_ready != 0) {
if ((_rcv_bitstream($port, 1, $timeout, \@rcv_buf) != 0) || ((scalar @rcv_buf) != 1)) {
$logger->error("Receiving READY message failed");
return 1;
}
$msg_type = _parse_return_message($rcv_buf[0], \%err);
if (!defined($msg_type) || $msg_type ne 'READY') {
$logger->error(sprintf("Received message is not a valid READY message (but %s).", defined($msg_type) ? $msg_type : "invalid"));
return 1;
}
if ($err{'ANY'} != 0 ) {
$logger->error("Received READY message indicates errors on the DUT side.");
return 1;
}
}
# actually send new configuration
if (_send_bitstream($port, \$bitstr, $timeout) != length($bitstr)) {
$logger->error("Sending message failed.");
return 1;
}
# wait for CONF_DONE message and check for errors
@rcv_buf = ();
if ((_rcv_bitstream($port, 1, $timeout, \@rcv_buf) != 0) || ((scalar @rcv_buf) != 1)) {
$logger->error("Receiving CONF_DONE message failed");
return 1;
}
$msg_type = _parse_return_message($rcv_buf[0], \%err);
if (!defined($msg_type) || $msg_type ne 'CONF_DONE' || $err{'ANY'} != 0) {
$logger->error("Received message is not a valid CONF_DONE message, or it indicates errors on the DUT side.");
return 1;
}
if ($err{'ANY'} != 0) {
$logger->error("Received CONF_DONE message indicated errors.");
return 1;
}
# exit early if requested to not wait for another READY message
if (!defined($wait_for_ready) || $wait_for_ready == 0) {
$logger->debug("Returning after successfully receiving CONF_DONE message due to unset wait_for_ready.");
return 0;
}
# wait for READY/UNDERRUN message
@rcv_buf = ();
if ((_rcv_bitstream($port, 1, $timeout, \@rcv_buf) != 0) || ((scalar @rcv_buf) != 1)) {
$logger->error("Receiving READY message failed");
return 1;
}
$msg_type = _parse_return_message($rcv_buf[0], \%err);
if (!defined($msg_type) || $msg_type ne 'READY') {
$logger->error(sprintf("Received message is not a valid READY message (but %s).", defined($msg_type) ? $msg_type : "invalid"));
return 1;
}
if ($err{'ANY'} != 0 ) {
$logger->error("Received READY message indicates errors on the DUT side.");
return 1;
}
return 0;
}
## @function _send_bitstream ($port, $$str_ref, $timeout)
# @brief Sends a bitstream via a serial port
#
# \param port An initialized AnySerialPort port object
# \param str_ref A reference to the payload string
# \param timeout optional Approximate(!) timeout in ms. Unsupported on Unix.
#
# \returns the number of bytes actually transmitted
sub _send_bitstream {
my $logger = get_logger();
my ($port, $str_ref, $timeout) = @_;
if (!defined($port)) {
$logger->error("Undefined port");
return 1;
}
if (ref($str_ref) ne 'SCALAR') {
$logger->error("Invalid reference to payload");
return 1;
}
$timeout = 1000 unless $timeout >= 0;
my $str = $$str_ref;
$port->write_const_time($timeout) if $port->can("write_const_time");
# dump all bytes in a nice hex list within a closure
$logger->trace("send_bitstream writing:",
{
filter => sub {
my $payload = shift;
my $ret = "";
for (my $i = 0; $i < length($payload); $i++) {
$ret .= sprintf("\n% 3d: 0x%02x", $i, ord(substr($payload, $i, 1)));
}
return $ret;
},
value => $$str_ref
}
);
my $wrn = $port->write($str);
if ($wrn != length($str)) {
$logger->warn(sprintf("Sent less (%d) than expected (%d).", $wrn, length($str)));
}
return $wrn;
}
## @function _rcv_bitstream ($port, $todo, $timeout, @$out_ref)
# @brief Receives a bitstream via a serial port
#
# \param port An initialized AnySerialPort port object
# \param todo The number of bytes to read
# \param timeout optional Approximate(!) timeout for a reply in ms
# \param out_ref optional An array reference to store (append) all read bytes
#
# \returns 0 on success
sub _rcv_bitstream {
my $logger = get_logger();
my ($port, $todo, $timeout, $buf_ref) = @_;
my @bytes;
if (!defined($buf_ref)) {
$buf_ref = \@bytes;
$logger->debug("Throwing away up to $todo bytes in rcv_bitstream because buf_ref not given.");
} else {
if (ref($buf_ref) ne 'ARRAY') {
$logger->error("Parameter out_ref is not a reference to an array.");
return 1;
}
}
$port->read_const_time($timeout);
while ($todo > 0) {
my ($count, $tmp) = $port->read($todo);
if ($count > 0) {
$todo -= $count;
push($buf_ref, unpack('C*', $tmp));
} else {
$logger->debug("Empty read. $todo requested bytes NOT read.");
last;
}
}
# dump all bytes in a nice hex list within a closure
$logger->trace("rcv_bitstream read:",
{
filter => sub {
my $buf_ref = shift;
my $ret = "";
for (my $i = 0; $i < scalar(@$buf_ref); $i++) {
my $cur = @$buf_ref[$i];
$ret .= sprintf("\n% 3d: 0x%02x", $i, $cur);
$ret .= sprintf(" (%c)", $cur) if chr($cur) =~ /[[:print:]]/;
}
return $ret;
},
value => $buf_ref
}
);
return 0;
}
## @function _parse_return_message ($message_byte, %$error_ref)
#
# \returns The type of the return message, or undef in the case of errors.
# Possible types are: 'CONF_DONE', 'UNDERRUN', 'READY'
sub _parse_return_message {
my $logger = get_logger();
my ($message_byte, $error_ref) = @_;
if (defined($error_ref) && ref($error_ref) ne 'HASH') {
$logger->error("Parameter is not a reference to a hash.");
return undef;
}
$error_ref->{ANY} = 0; # be optimistic :) and ease error handling in callers
# Even parity bit calculation:
# Hardware XORs the seven LSB and transmits result as 8th bit.
# Code below XORs all 8 bits and checks for 0.
my $par = 0;
for (my $i = 0; $i < 8; $i++) {
$par = $par^(($message_byte >> $i) & 0x01);
}
if ($par != 0) {
$logger->error(sprintf("Return message parity error (msg=0x%02x).", $message_byte));
return undef;
}
if (($message_byte & 0x18) != 0) {
$logger->warn(sprintf("Return message has reserved bits set (msg=0x%02x).", $message_byte));
}
if (defined($error_ref)) {
$error_ref->{C} = (($message_byte & 0x01) != 0);
$error_ref->{I} = (($message_byte & 0x02) != 0);
$error_ref->{U} = (($message_byte & 0x04) != 0);
$error_ref->{ANY} = (($message_byte & 0x07) != 0);
if ($error_ref->{C} != 0) {
$logger->debug("Return message indicates CRC mismatch.");
}
if ($error_ref->{I} != 0) {
$logger->debug("Return message indicates design ID mismatch.");
}
if ($error_ref->{U} != 0) {
$logger->debug("Return message indicates an RX UART error.");
}
}
switch(($message_byte >> 5) & 0x03) {
case 0x01 { return 'UNDERRUN'; }
case 0x02 { return 'READY'; }
case 0x03 { return 'CONF_DONE'; }
else {return undef; }
}
}
1;
## @file [Settings.pm]