fiji_instrument.pl

#!/usr/bin/env perl

#-------------------------------------------------------------------------------
#  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 instrument script
#
#-------------------------------------------------------------------------------

## @file
# @brief FIJI instrument script
## @file
# Instruments a given netlist with the given settings

use strict;
use warnings;

use Scalar::Util 'blessed';

use FindBin;
use lib "$FindBin::Bin";

use File::Basename qw(basename);

use Log::Log4perl qw(get_logger);
use Clone qw(clone);
use Digest::CRC qw(crcccitt);

use FIJI qw(:all);

use FIJI::Settings;
use FIJI::Netlist;

use FIJI::VHDL;
use FIJI::Constraints;

use FIJI::Utils;

use File::Spec;
use File::Path qw(make_path);

use Getopt::Long qw(:config bundling);

use constant NETLIST_SUFFIX => {
    ALTERA_QUARTUS => 'vqm',
    XILINX_VIVADO  => 'vm',
    OTHER          => 'v',
};

my @argv;

sub log_start {
    my $name = basename($0);
    $name =~ s/\.p[lm]//;
    my $logger = get_logger("");
    $logger->debug("=== Starting new execution of $name ===");
    $logger->debug(sprintf("%d argument(s)%s", scalar(@argv), scalar(@argv) > 0 ? ": @argv" : ""));
}

# Filter file line by line and stuff result into $ctx->addfile.
# The filtering happens in a child attached to a pipe to avoid buffering it completely.
sub _crc_filtered {
    my ($file, $ctx, $matcher) = @_;
    my $logger = get_logger("");
    my $fh_filtered;
    # This forks another perl and basically connects its output to $fh_filtered.
    my $pid = open($fh_filtered, "-|");
    if (!defined($pid)) {
        $logger->fatal("Could not fork to filter netlist for CRC calculation: $!");
        return 1;
    }

    if ($pid != 0) {
        # Parent
        $ctx->addfile($fh_filtered); # Pass fh of filtering pipe to the CRC algorithm
        waitpid($pid, 0); # Wait till kid is done
        close($fh_filtered);
    } else {
        # Child
        open(my $in_fh, "<", $file);
        if (!defined $in_fh) {
            $logger->error($!);
            close($in_fh);
            exit(1);
        }
        # read from in_fh, filter, and print it to stdout
        while (my $line = <$in_fh>) {
            chomp($line);
            # print STDERR "line: >$line<, len:".length($line).", match? ".$matcher->($line)."\n";
            print "$line\n" or die "filter output failed: $!" if $matcher->($line);
        }
        close($in_fh);
        exit(1);
    }
}

sub main {
    my $logger = get_logger("");
    my ($options) = @_;

    my $rv;
    my %hash;
    my $self = bless(\%hash);
    my $output_dir;

    my ($settings_ref, $msg) = FIJI::Settings->new("setup", $options->{'fiji_settings_file'});
    my $netlist_filename = $options->{'netlist_file'};

    if (!ref($settings_ref)) {
        $logger->error($msg);
        return 1;
    }
    $self->{'settings'} = $settings_ref;

    # Retrieve directory meta data of the settings file
    my ($basevolume, $basedirs, $file) = File::Spec->splitpath($self->{'settings'}->{'filename'});

    # Set/Create output directory
    if (defined $options->{'output_dir'}) {
        # Command line parameter has highest precedence
        $output_dir = $options->{'output_dir'};
    } else {
        # If parameter is not given default is to use FIJI::Settings value
        # (which is either given in the settings file or by the default in FIJI.pm)
        $output_dir = File::Spec->rel2abs($self->{'settings'}->{'design'}->{'OUTPUT_DIR'}, File::Spec->catpath($basevolume, $basedirs, ""));
        $logger->info("Using output directory from FIJI settings: \"$output_dir\".");
    }

    if (!(-d $output_dir)) {
        make_path($output_dir, {error => \my $err});

        if (@$err) {
            my $msg = "Could not create output directory: $!";
            $logger->fatal($msg);
            return 1;
        }
    }

    # Configure logging
    if (defined $self->{'settings'}->{'design'}->{'INST_LOG'}) {
        my $logfile_path;
        # If an output dir is given put log file relatively to that
        if (defined($options->{'output_dir'})) {
            $logfile_path = $options->{'output_dir'};
        } else {
            # ... else put the log file relatively to the directory used for the settings file
            $logfile_path = File::Spec->catpath($basevolume, $basedirs, "");
        }
        $logfile_path = File::Spec->rel2abs($self->{'settings'}->{'design'}->{'INST_LOG'}, $logfile_path);

        my $file_appender        = $Log::Log4perl::Logger::APPENDER_BY_NAME{'logfile'};
        my $custom_file_appender = Log::Log4perl::Appender->new(
            "Log::Log4perl::Appender::File",
            name      => "custom_file_log",
            Threshold => "TRACE",
            filename  => $logfile_path,
        );
        my $layout = $file_appender->{'layout'};
        $custom_file_appender->layout(clone($layout));

        my $ign = new Log::Log4perl::Filter("ignore_all_filter", sub { 0 });
        foreach my $a (values %{Log::Log4perl->appenders()}) {
            if ($a->name eq "logfile") {
                $logger->info("Switching from initial log file to custom log file " . $custom_file_appender->filename);
                unlink($a->filename);
                Log::Log4perl->eradicate_appender($a->name);
                next;
            }
            $a->filter($ign);
        }
        $logger->add_appender($custom_file_appender);
        log_start();
        foreach my $a (values %{Log::Log4perl->appenders()}) {
            $a->{filter} = undef;
        }
    }

    my $nl = new FIJI::Netlist();

    if ($nl->read_file($netlist_filename) != 0) {
        my $msg = "Netlist could not be loaded correctly from \"$netlist_filename\".";
        $logger->fatal($msg);
        return 1;
    }

    #
    # Retrieve toplevel module
    #

    my $toplevel_module = $nl->get_toplevel_module();

    if (ref($toplevel_module) ne "Verilog::Netlist::Module") {
        $logger->fatal($toplevel_module);
        return 1;
    }

    if (!defined $options->{'file_prefix'}) {
        $options->{'file_prefix'} = $toplevel_module->name;
    }
    my $nsh = NETLIST_SUFFIX;
    my $netlist_suffix = (defined $nsh->{$settings_ref->{'design'}->{'IMPL_TOOL'}}) ?
                          $nsh->{$settings_ref->{'design'}->{'IMPL_TOOL'}} :
                          $nsh->{'OTHERS'};

    my $export_nl_filename                    = File::Spec->catfile($output_dir,  $options->{'file_prefix'} . "_instrumented.".$netlist_suffix);
    my $export_cfg_filename                   = File::Spec->catfile($output_dir,  $options->{'file_prefix'} . "_download.cfg");
    my $export_wrapper_filename               = File::Spec->catfile($output_dir,  $options->{'file_prefix'} . "_wrapper.vhd");
    my $export_pkg_filename                   = File::Spec->catfile($output_dir,  $options->{'file_prefix'} . "_config_pkg.vhd");
    my $export_constraints_filename           = File::Spec->catfile($output_dir,  $options->{'file_prefix'} . "_constraints");

    #
    # start FIU instrumentation
    #

    # FIU part
    for (my $fiu_idx = 0 ; $fiu_idx < @{$settings_ref->{'fius'}} ; $fiu_idx++) {

        my $fiu = @{$settings_ref->{'fius'}}[$fiu_idx];

        my $ret = $nl->instrument_net($fiu->{'FIU_NET_NAME'}, $fiu_idx, $fiu->{'FIU_DRIVER_PATH'}, $fiu->{'FIU_DRIVER_TYPE'});

        if ($ret) {
            $logger->error($ret);
            return 1;
        }
    }

    # Clock net
    $logger->info("Adding CLOCK net");
    my $clk_net_descriptor = $nl->get_netdescriptor_from_path($settings_ref->{'design'}->{'CLOCK_NET'});
    if (ref($clk_net_descriptor) ne 'HASH') {
        $logger->error($clk_net_descriptor);
        return 1;
    }

    my $ret = $nl->net_add_function($clk_net_descriptor, FIJI::VHDL->FIJI_PORTTYPE_CLOCK, "clock_from_dut_o");
    if ($ret) {
        $logger->error($ret);
        return 1;
    }

    # Instrument reset from DUT if enabled
    if ($settings_ref->{'design'}->{'RST_DUT_OUT_EN'} == 1) {
        $logger->info("Adding RST_DUT_OUT net");

        my $rst_in_net_descriptor = $nl->get_netdescriptor_from_path($settings_ref->{'design'}->{'RST_DUT_OUT_NAME'});
        if (ref($rst_in_net_descriptor) ne 'HASH') {
            $logger->error($rst_in_net_descriptor);
            return 1;
        }

        my $ret = $nl->net_add_function($rst_in_net_descriptor, FIJI::VHDL->FIJI_PORTTYPE_RST_FROM_DUT, "reset_from_dut_o");
        if ($ret) {
            $logger->error($ret);
            return 1;
        }
    }

    # Instrument reset to DUT if enabled
    if ($settings_ref->{'design'}->{'RST_DUT_IN_EN'} == 1) {
        $logger->info("Adding RST_DUT_IN net");

        my $port = $toplevel_module->find_port($settings_ref->{'design'}->{'RST_DUT_IN_NAME'});

        if (!defined $port) {
            $msg = "Could not find port '" . $toplevel_module->name . "|" . $settings_ref->{'design'}->{'RST_DUT_IN_NAME'} . "'\n";
            $logger->error($msg);
            return 1;
        }

        $port->userdata(FIJI::VHDL->FIJI_USERDATA_PORTTYPE, FIJI::VHDL->FIJI_PORTTYPE_RST_TO_DUT);
        $toplevel_module->link;
    }

    # Trigger from DUT if enabled

    if ($settings_ref->{'design'}->{'TRIG_DUT_EN'} == 1) {
        $logger->info("Adding TRIG_DUT net");
        my $rst_out_net_descriptor = $nl->get_netdescriptor_from_path($settings_ref->{'design'}->{'TRIG_DUT_NAME'});
        if (ref($rst_out_net_descriptor) ne 'HASH') {
            $logger->error($rst_out_net_descriptor);
            return 1;
        }

        my $ret = $nl->net_add_function($rst_out_net_descriptor, FIJI::VHDL->FIJI_PORTTYPE_TRIG_FROM_DUT, "trigger_from_dut_o");
        if ($ret) {
            $logger->error($ret);
            return 1;
        }
    }

    # instrument fault detect signal 1 if enabled
    if ($settings_ref->{'design'}->{'FD_1_EN'} == 1) {
        $logger->info("Adding FD_1 net");

        my $fd1_net_descriptor = $nl->get_netdescriptor_from_path($settings_ref->{'design'}->{'FD_1_NAME'});
        if (ref($fd1_net_descriptor) ne 'HASH') {
            $logger->error($fd1_net_descriptor);
            return 1;
        }

        my $ret = $nl->net_add_function($fd1_net_descriptor, FIJI::VHDL->FIJI_PORTTYPE_FAULT_DETECTION, "fault_detect_1_o", 0);
        if ($ret) {
            $logger->error($ret);
            return 1;
        }
    }

    # instrument fault detect signal 2 if enabled
    if ($settings_ref->{'design'}->{'FD_2_EN'} == 1) {
        $logger->info("Adding FD_2 net");

        my $fd2_net_descriptor = $nl->get_netdescriptor_from_path($settings_ref->{'design'}->{'FD_2_NAME'});
        if (ref($fd2_net_descriptor) ne 'HASH') {
            $logger->error($fd2_net_descriptor);
            return 1;
        }

        my $ret = $nl->net_add_function($fd2_net_descriptor, FIJI::VHDL->FIJI_PORTTYPE_FAULT_DETECTION, "fault_detect_2_o", 1);
        if ($ret) {
            $logger->error($ret);
            return 1;
        }
    }

    # calculate design ID
    # Design ID = CRC-CCITT of all input data:
    # - input netlist (file content excluding full-line comments)
    # - input settings file (file content excluding full-line comments)
    # - toplevel module name
    # - file prefix

    my $ctx = Digest::CRC->new(type => "crcccitt");

    # First process the netlist file:
    return 1 if _crc_filtered($netlist_filename, $ctx, sub {$_[0] !~ m{^\s*//}}) != 0;

    # Then the cfg file:
    return 1 if _crc_filtered($options->{'fiji_settings_file'}, $ctx, sub {$_[0] !~ /^\s*;/}) != 0;

    # Finally, the easy parts:
    $ctx->add($toplevel_module->name);
    $ctx->add($options->{'file_prefix'});

    my $id = hex $ctx->hexdigest;

    $logger->info(sprintf("Design ID chosen to be 0x%04X.", $id));
    #
    # Generate download cfg file
    # @FIXME should we overwrite the original file instead?
    #
    $settings_ref->{'design'}->{'ID'} = $id;
    $settings_ref->save($export_cfg_filename);

    #
    # output netlist
    #

    $rv = $nl->export($export_nl_filename, $id);

    if (defined $rv) {
        $logger->error($rv);
        return 1;
    }

    #
    # Make wrapper
    #
    my $wrapper_config = {};
    $wrapper_config->{'netlist'}                  = $nl->{'nl'};
    $wrapper_config->{'dut_toplevel_module_name'} = $toplevel_module->name;
    $wrapper_config->{'fiji_settings_filename'}   = $export_cfg_filename;
    $wrapper_config->{'vhdl_filename'}            = $export_wrapper_filename;

    $rv = FIJI::VHDL->generate_wrapper_module($wrapper_config);

    if (defined $rv) {
        $logger->error($rv);
        return 1;
    }

    #
    # Generate cfg vhd
    #
    $rv = FIJI::VHDL->generate_config_package($export_cfg_filename, $export_pkg_filename);

    if (defined $rv) {
        $logger->error($rv);
        return 1;
    }

    my $dut_inst_name  = (defined $settings_ref->{'design'}->{'DUT_INST_NAME'})     ? $settings_ref->{'design'}->{'DUT_INST_NAME'}     : FIJI::VHDL->FIJI_DEFAULTS->{'DUT_INST_NAME'};
    my $fiji_inst_name = (defined $settings_ref->{'design'}->{'FIJI_INST_NAME'})    ? $settings_ref->{'design'}->{'FIJI_INST_NAME'}    : FIJI::VHDL->FIJI_DEFAULTS->{'FIJI_INST_NAME'};
    my $wrapper_name   = (defined $settings_ref->{'design'}->{'FIJI_WRAPPER_NAME'}) ? $settings_ref->{'design'}->{'FIJI_WRAPPER_NAME'} : FIJI::VHDL->FIJI_DEFAULTS->{'FIJI_WRAPPER_NAME'};
    my $gen_fault_injection_label   = FIJI::VHDL->FIJI_DEFAULTS->{'FIJI_FAULT_INJECTION_GEN_LABEL'};


    #
    # Generate placement constraints
    #
    $rv = FIJI::Constraints->generate_constraints(
        $settings_ref->{'design'}->{'SYNTHESIS_TOOL'},
        $settings_ref->{'design'}->{'IMPL_TOOL'}, {
            dut_module  => $wrapper_config->{'dut_toplevel_module_name'},
            fiji_module => $wrapper_name,
            dut_inst    => $dut_inst_name,
            fiji_inst   => $fiji_inst_name,
            fiji_gen    => $gen_fault_injection_label,
            mode        => $settings_ref->{'design'}->{'OPTIMIZATIONS'},
        },
        $export_constraints_filename
    );

    # FIXME add constraint export to other tools

    if (defined $rv) {
        $logger->error($rv);
        return 1;
    }

    $logger->debug("=== Stopping execution ===");
    return 0;
}

sub usage {
    my ($err) = @_;
    my $scr = basename($0);
    my $msg = <<USAGE;

$scr is the FIJI Instrumentation tool

Usage: $0 [PARAMETERS]

Required parameters:

    -s, --settings=<filename>   FIJI Settings file

    -n, --netlist=<filename>    Netlist file to instrument

Optional parameters:

    -p, --file-prefix=<prefix>  Prefix for all generated files
                                Otherwise: toplevel module name
                                
    -o, --output-dir=<path>     The directory where the generated files are put.
                                The directory will be created if necessary.
                                Overrules the directory specified in
                                the FIJI settings file.
                                Otherwise: current working directory
                                
    -v, --verbose               Increase verbosity of output
                                (can be given multiple times to increase
                                 the verbosity level once per occurrence).

    --help                      Display this help and exit
USAGE

    if ($err == 0) {
        print STDOUT $msg;
    } else {
        print STDERR $msg;
    }
    return $err;
}

my $log_conf = File::Spec->catfile($FindBin::Bin, 'logger.conf');
Log::Log4perl::init_and_watch($log_conf, 'HUP');
Log::Log4perl->eradicate_appender("string"); # No need for buffered log output

my $logger = get_logger("");
my $break  = undef;

# ARGV gets modified by GetOptions below but we need it later in log_start (again)
@argv=@ARGV;
log_start();

# Defaults
my $options = {
    fiji_settings_file => undef,
    netlist_file       => undef,
    file_prefix        => undef,
    verbosity_delta    => 0,
    output_dir         => undef
};

GetOptions(
    "s|settings=s"     => \$options->{'fiji_settings_file'},
    "n|netlist=s"      => \$options->{'netlist_file'},
    "p|file-prefix=s"  => \$options->{'file_prefix'},
    "o|output-dir=s"   => \$options->{'output_dir'},
    "v|verbose+"       => \$options->{'verbosity_delta'},
    "help|h"           => sub { exit(usage(0)); },
);

# Check if all required options present
for my $k (keys(%{$options})) {
    if (!defined $options->{$k}) {
        if ($k eq 'output_dir' || $k eq 'file_prefix') {
        } else {
            $break = 1;
            $logger->error("Option $k is required.");
        }
    }
}

exit usage(1) if (defined $break);

# clean up the passed paths
# @FIXME needed ?
$options->{'fiji_settings_file'} = File::Spec->canonpath($options->{'fiji_settings_file'});
$options->{'netlist_file'}       = File::Spec->canonpath($options->{'netlist_file'});
$options->{'output_dir'}         = File::Spec->canonpath($options->{'output_dir'}) if defined $options->{'output_dir'};

FIJI::Utils::increase_verbosity($options->{'verbosity_delta'});

exit main($options);