fiji_instrument.pl

#-------------------------------------------------------------------------------
#  University of Applied Sciences Technikum Wien
#
#  Department of Embedded Systems
#  http://embsys.technikum-wien.at
#
#  Josef Ressel Center for Verification of Embedded Computing Systems
#  http://vecs.technikum-wien.at
#
#-------------------------------------------------------------------------------
#  File:              fiji_instrument.pl
#  Created on:        29.04.2015
#  $LastChangedBy$
#  $LastChangedDate$
#
#  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 File::Spec;
use File::Path qw(make_path);

use Data::Dumper;
use Getopt::Long;

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" : ""));
}

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

    my $msg;
    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 (defined $msg) {
        $logger->error($msg);
    }

    if (!ref($settings_ref)) {
        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'}->{'INSTRUMENTATION_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'}->{'INSTRUMENTATION_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'}->{'IMPLEMENTATION_TOOL'}}) ?
                          $nsh->{$settings_ref->{'design'}->{'IMPLEMENTATION_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 = $nl->get_net_from_path($settings_ref->{'design'}->{'CLOCK_NET'});
    if (!blessed($clk_net) || !$clk_net->isa("Verilog::Netlist::Net")) {
        $logger->error($clk_net);
        return 1;
    }

    my $ret = $nl->net_add_function($clk_net, 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'}->{'RESET_DUT_OUT_EN'} == 1) {
        $logger->info("Adding RESET_DUT_OUT net");

        my $rst_in_net = $nl->get_net_from_path($settings_ref->{'design'}->{'RESET_DUT_OUT_NAME'});
        if (!blessed($rst_in_net) || !$rst_in_net->isa("Verilog::Netlist::Net")) {
            $logger->error($rst_in_net);
            return 1;
        }

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

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

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

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

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

    # Trigger from DUT if enabled

    if ($settings_ref->{'design'}->{'TRIGGER_DUT_EN'} == 1) {
        $logger->info("Adding TRIGGER_DUT net");
        my $rst_out_net = $nl->get_net_from_path($settings_ref->{'design'}->{'TRIGGER_DUT_NAME'});
        if (!blessed($rst_out_net) || !$rst_out_net->isa("Verilog::Netlist::Net")) {
            $logger->error($rst_out_net);
            return 1;
        }

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

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

        my $fd1_net = $nl->get_net_from_path($settings_ref->{'design'}->{'FAULT_DETECT_1_NAME'});
        if (!blessed($fd1_net) || !$fd1_net->isa("Verilog::Netlist::Net")) {
            $logger->error($fd1_net);
            return 1;
        }

        my $ret = $nl->net_add_function($fd1_net, 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'}->{'FAULT_DETECT_2_EN'} == 1) {
        $logger->info("Adding FAULT_DETECT_2 net");

        my $fd2_net = $nl->get_net_from_path($settings_ref->{'design'}->{'FAULT_DETECT_2_NAME'});
        if (!blessed($fd2_net) || !$fd2_net->isa("Verilog::Netlist::Net")) {
            $logger->error($fd2_net);
            return 1;
        }

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

    # calculate design ID
    # Design ID = CRC-CCITT of all input data:
    # - input netlist (file content)
    # - input settings file (file content)
    # - toplevel module name
    # - file prefix
    #
    # @FIXME: OK generating the ID like this?
    #
    my $ctx = Digest::CRC->new(type => "crcccitt");

    open(my $fh, "<", $netlist_filename);

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

    $ctx->addfile($fh);

    close($fh);

    open($fh, "<", $options->{'fiji_settings_file'});

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

    $ctx->addfile($fh);

    close($fh);

    $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'}->{'IMPLEMENTATION_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 $msg = <<USAGE;
Usage: $0 [PARAMETERS]

Required parameters:

-s, --fiji-settings-file=<filename>   the cfg file with FIJI settings

-n, --netlist-file=<filename>         the 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

--help                          display this help and exit
USAGE

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

my $log_conf = File::Spec->catfile($FindBin::Bin, 'logger.conf');
Log::Log4perl::init_and_watch($log_conf, 'HUP');

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,
    output_dir         => undef
};

GetOptions(
    "fiji-settings-file|s=s" => \$options->{'fiji_settings_file'},
    "netlist-file|n=s"       => \$options->{'netlist_file'},
    "file-prefix|p=s"        => \$options->{'file_prefix'},
    "output-dir|o=s"         => \$options->{'output_dir'},
    "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'};

exit main($options);