Netlist.pm

#-------------------------------------------------------------------------------
#  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:              Netlist.pm
#  Created on:        29.04.2015
#  $LastChangedBy$
#  $LastChangedDate$
#
#  Description:
#
#  FIJI Netlist class: Functions to instrument & export a Verilog::Netlist
#-------------------------------------------------------------------------------

## @file

## @class FIJI::Netlist
#
#
package FIJI::Netlist;

use strict;
use warnings;

use Log::Log4perl qw(get_logger :easy);

use Verilog::Netlist;
use Verilog::Language;
use Data::Dumper;

use FIJI::VHDL;

my $HIERSEP               = "|";
my $FIJI_PORT_PREFIX      = "fiji_";
my $FIJI_PORT_IN_POSTFIX  = "_inj_i";
my $FIJI_PORT_OUT_POSTFIX = "_ori_o";

my $FIJI_LOGO = <<logo_end;
//  FIJIFIJIFIJIFIJIFIJIFIJIFIJIFIJIFIJIFIJI
//  FIJIFIJIFIJIFIJIF   FIJIFIJIFIJIFIJIFIJI
//  FIJIFIJIFIJIFIJ    IFIJIFIJIFIJIFIJIFIJI
//  FIJIF       FI           IJIFIJIFIJIFIJI
//  FIJIFIJIFI            JIFIJIFIJIFIJIFIJI
//  FIJIFIJI            FIJIFIJIFIJIFIJIFIJI
//  FIJIFI     I   IFI   IJIFIJIFIJIFIJIFIJI
//  FIJIF         JIFIJ   JIFIJIFIJIFIJIFIJI
//  FIJIFIJIFI   IJIFIJI   IFIJIFIJIFIJIFIJI
//  FIJIFIJIF    IJIFIJIFIJIFIJIFIJIFIJIFIJI
//  FIJIFIJI    FIJIFIJIFIJIFIJIFIJIFIJIFIJI
//  FIJIFIJ     FIJIF           FIJIFIJIFIJI
//  FIJIFI     IFI      Fault      IFIJIFIJI
//  FIJIF             InJection     FIJIFIJI
//  FIJ              Instrumenter    IJIFIJI
//  F                                    IJI
//  FIJIFIJIFIJIFIJIFIJIFIJIFIJIFIJIFIJIFIJI
logo_end

#FIXME Verilog-Perl "link"ing...
# Linking a module
#   ->links Ports, Cells, and Pins
#
# Linking a Port
#   if port has no net assigned, assign net with matching name or create a new
#   net. does not assign netname (needed for correct ->verilog_text output)

sub new ($) {
    my ($class) = @_;

    my $self = {};
    bless $self, $class;

    $self->{'nl'} = new Verilog::Netlist(

        # options => $opt,
        # keep_comments => 1, # include comments in netlist
        link_read_nonfatal => 1,    # do not fail if module description not found
        use_vars           => 1,
    );
    return $self;
}

sub read_file ($) {
    my $logger = get_logger("");
    my ( $self, $filename ) = @_;

    ## Netlist synthesized from VHDL could contain SV keywords at this point.
    Verilog::Language::language_standard("1364-2001");

    eval {
        $self->{'nl'}->read_file( filename => $filename );    # read Verilog file
        $self->{'nl'}->link();                                # Read in any sub-modules
    };

    if ( $self->{'nl'}->errors() != 0 || $@ ) {
        $logger->error( "Could not parse $filename!", $@ ? "\n" . $@ : "" );
        return 1;
    }

    $self->{'filename'} = $filename;

    $logger->info("Successfully read in netlist from file \"$filename\".");
    return 0;
}

sub get_toplevel_port_names ($) {
    my ($self) = @_;
    my $ports_ref = [];
    foreach my $mod ( $self->{'nl'}->top_modules_sorted ) {
        foreach my $port ( $mod->ports_sorted ) {
            push @{$ports_ref}, $port->name;
        }
    }
    return $ports_ref;
}

# returns an array of hashes for all nets containing:
# 'name' the name of the net
# 'path' the hierarchical path of the net
# 'net'  the Verilog::Netlist::Net reference to the net
#
sub get_nets ($) {
    my ($self) = @_;

    # my $nets_ref = {'metadata' => [], 'names' => [], 'nets' => []};
    my $nets_ref = [];
    my $hier     = "";
    foreach my $mod ( $self->{'nl'}->top_modules_sorted ) {
        $self->_get_subnets( $nets_ref, $mod, $hier );
    }
    return $nets_ref;
}

sub _get_subnets ($$) {
    my $logger = get_logger("");
    my ( $self, $nets_ref, $mod, $hier ) = @_;

    my $thishier = $hier;
    $thishier .= $HIERSEP if $thishier ne "";
    $thishier .= $mod->name;

    foreach my $n ( $mod->nets ) {
        my $thisnet_ref = { name => $n->name, path => $thishier, net => $n };
        push( @{$nets_ref}, $thisnet_ref );
    }

    foreach my $cell ( $mod->cells_sorted ) {
        if ( defined( $cell->submod ) ) {
            $self->_get_subnets( $nets_ref, $cell->submod, $thishier );
        }
    }
}

# checks if a givn name exists as port, net, or cell name in the instantiation
# tree.
#
# params:
#   startmod the module to start with
#   name the name to check against
#
sub _check_name_in_hierarchy {
    my $logger = get_logger("");
    my ( $startmod, $name ) = @_;
    my $nl = $startmod->netlist;

    $logger->debug( "Checking " . $startmod->name . " for name $name" );

    # check if a net is named the same
    for my $net ( $startmod->nets_sorted ) {
        if ( $net->name eq $name ) {
            my $msg = "Name $name does already exist as net in " . $startmod->name;
            return $msg;
        }
    }

    # check if a port is named the same
    for my $port ( $startmod->ports_sorted ) {
        if ( $port->name eq $name ) {
            my $msg = "Name $name does already exist as port in " . $startmod->name;
            return $msg;
        }
    }

    for my $cell ( $startmod->cells_sorted ) {
        if ( $cell->name eq $name ) {
            my $msg = "Name $name does already exist as cell in " . $startmod->name;
            return $msg;
        }
    }

    # find any module instantiating the current start module
    foreach my $mod ( $nl->modules_sorted ) {
        foreach my $cell ( $mod->cells_sorted ) {
            if ( defined $cell->submod && $cell->submod == $startmod ) {
                my $msg = _check_name_in_hierarchy( $mod, $name );
                return $msg if defined $msg;
            }
        }
    }

    return undef;
}

# adds a port to all modules starting from a leaf node
#
# params
#   startmod the module to start with
#   name the port name to be generated
#   function the function of this port in FIJI (FIJI::VHDL->FIJI_PORTTYPE_xxx)
#   index for ORIGINAL,MODIFIED and FAULT_DETECT: the index of this net
#   (indent just for formatting output)
sub _add_port_to_hierarchy {
    my $logger = get_logger("");
    my ( $startmod, $name, $function, $index, $indent ) = @_;
    my $nl        = $startmod->netlist;
    my $direction = "undef";
    if ( !defined $indent ) {
        $indent = "";
    } else {
        $indent .= "  ";
    }

    return if ( $startmod->find_port($name) );

    $logger->debug( $indent . "Adding port $name to module " . $startmod->name );

    # decide direction
    if (   $function == FIJI::VHDL->FIJI_PORTTYPE_MODIFIED
        || $function == FIJI::VHDL->FIJI_PORTTYPE_RESET_TO_DUT )
    {
        $direction = "in";
    } else {
        $direction = "out";
    }

    # generate port
    my $np = $startmod->new_port( name => $name, direction => $direction );

    # set port type for wrapper generation
    $np->userdata( FIJI::VHDL->FIJI_USERDATA_PORTTYPE, $function );

    # set indices
    if (   $function == FIJI::VHDL->FIJI_PORTTYPE_MODIFIED
        || $function == FIJI::VHDL->FIJI_PORTTYPE_ORIGINAL )
    {
        $np->userdata( FIJI::VHDL->FIJI_USERDATA_FIU_INDEX, $index );
    } elsif ( $function == FIJI::VHDL->FIJI_PORTTYPE_FAULT_DETECTION ) {
        $np->userdata( FIJI::VHDL->FIJI_USERDATA_FD_INDEX, $index );
    }

    # let Verilog-Perl create a new net for the new port.
    $startmod->link;

    # find all modules instantiating the current module
    foreach my $mod ( $nl->modules_sorted ) {
        foreach my $cell ( $mod->cells_sorted ) {
            if ( defined $cell->submod && $cell->submod == $startmod ) {
                $logger->debug( $indent . "Adding pin $name to cell " . $cell->name );
                $logger->debug( $indent . "Connecting pin " . $cell->name . $HIERSEP . $name . " to port " . $np->module->name . $HIERSEP . $np->name );
                $cell->new_pin(
                    name     => $name,
                    portname => $np->name,
                    netname  => $np->net->name
                );

                # let verilog-perl find the net and port.
                # FIXME sufficient to link "mod" here?
                $mod->link;
                _add_port_to_hierarchy( $mod, $name, $function, $index, $indent );
            }
        }
    }

    return $np;
}

# Generate external access to a single net
# Performs the following steps:
#    1.  check if the default port name does not yet exist
#    1a. if it exists, generate a new net name
#    2.  add a port through the entire hierarchy
#    3.  assign the net to the port using a contassign statement
#
# params:
#   net the Verilog::Net object to be used
#   function the function out of FIJI::VHDL->FIJI_PORTTYPE_xxx
#   port_name how the port shall be named (will be prefixed with "fiji_")
#   index for some FIJI_PORTTYPEs, an index is needed (FIU and Fault Detect)
sub net_add_function ($$$;$) {
    my $logger = get_logger("");
    my ( $self, $net, $function, $port_name, $index ) = @_;

    $logger->debug( "Adding function to " . $net->module->name . ", net " . $net->name );

    my $prefix = "fiji_";
    while (1) {
        my $msg = _check_name_in_hierarchy( $net->module, $prefix . $port_name );
        if ( !defined $msg ) {
            $port_name = $prefix . $port_name;
            last;
        } else {
            $prefix = sprintf( "fiji_%4x_", rand(0xffff) );
        }
    }

    $logger->debug( $port_name . " can be used as fiji connector" );
    my $op = _add_port_to_hierarchy( $net->module, $port_name, $function, $index );

    $logger->debug( "Connecting Port " . $op->name . " to net " . $net->name );

    # connect the net to the newly created port
    $net->module->new_contassign(
        keyword => "assign",
        lhs     => $op->name,
        rhs     => $net->name,
        module  => $op->module,
        netlist => $op->module->netlist
    );

    return undef;
}

# instruments a single net for fault injection
#   1. tries to determine the driver, or otherwise prompts the user to select it
#   2. generate external access output and input ports
#   3. interconnects these ports to the matching driver and driven cells
#
# params
#   net the Verilog::Net to instrument
#   fiu_idx the FIU number this external access shall be connected to
#   driver the driver of this net (optional)
#   driver_type the type of the driver (can be PIN, PORT, ASSIGN)
sub instrument_net ($$;$$) {

    #FIXME only works with single-bit pins/ports/nets
    my $logger = get_logger("");
    my ( $self, $net, $fiu_idx, $driver, $driver_type ) = @_;
    my $msg;

    $logger->info( "Instrumenting " . $net->module->name . ", net " . $net->name );

    # 1. Try to find a suitable driver.
    #   - Get all candidates from _get_net_connections()
    #     (this includes identified drivers as well as candidates)
    #   - If we can't identify any drivers then rely on the parameter, or
    #     if that is undefined we ask the user here (FIXME: this seems like a candidate for refactoring)
    #     To that end, modify the connections hash accordingly.
    #   - If a single driver is found then we make sure it matches the parameter (if available)
    #   - If no or mulitple drivers are found eventually we abort.
    my %connections;
    $self->_get_net_connections( $net, \%connections );

    # if _get_net_connections() could not determine a driver
    # the user must choose manually
    if ( !defined $driver && @{ $connections{'drivers'} } == 0 ) {
        $driver = _select_driver( $connections{'connected'}, $net );

        if ( ref($driver) eq "STRING" ) {
            return $driver;
        }
    }

    # if _get_net_connections() could not determine a driver
    #   take the one chosen by the user
    if ( @{ $connections{'drivers'} } == 0 ) {
        foreach my $connection ( @{ $connections{'connected'} } ) {
            if ( $connection == $driver ) {
                push @{ $connections{'drivers'} }, $connection;
            } else {
                push @{ $connections{'driven'} }, $connection;
            }
        }

        # if _get_net_connections() determined a driver
    } elsif ( @{ $connections{'drivers'} } == 1 ) {

        # and the user supplied a driver, check if they both match
        if ( defined $driver && @{ $connections{'drivers'} }[0] != $driver ) {
            $msg = "Driver mismatch on net " . $net->name;
            return $msg;
        }
        @{ $connections{'driven'} } = @{ $connections{'connected'} };
    } else {
        $msg = "Net " . $net->name . " has multiple drivers";
        return $msg;
    }

    if ( @{ $connections{'drivers'} } == 0 ) {
        $msg = "No driver for net " . $net->name;
        return $msg;
    }

    # VHDL signals must not contain multiple subsequent underscores
    my $output_name = ( ( $FIJI_PORT_PREFIX . $net->name . $FIJI_PORT_OUT_POSTFIX ) =~ s/__+/_/gr );
    my $input_name  = ( ( $FIJI_PORT_PREFIX . $net->name . $FIJI_PORT_IN_POSTFIX ) =~ s/__+/_/gr );

    $msg = _check_name_in_hierarchy( $net->module, $output_name );
    return $msg if defined $msg;

    $logger->debug( $output_name . " can be used as fiji connector" );
    my $op = _add_port_to_hierarchy( $net->module, $output_name, FIJI::VHDL->FIJI_PORTTYPE_ORIGINAL, $fiu_idx );

    $msg = _check_name_in_hierarchy( $net->module, $input_name );
    return $msg if defined $msg;

    $logger->debug( $input_name . " can be used as fiji connector" );
    my $ip = _add_port_to_hierarchy( $net->module, $input_name, FIJI::VHDL->FIJI_PORTTYPE_MODIFIED, $fiu_idx );

    # connecting newly created output to driver
    foreach my $connection ( @{ $connections{'drivers'} } ) {
        my $log = "Original: Connecting ";
        if ( ref($connection) eq "Verilog::Netlist::Pin" ) {

            # if it is a pin of a cell, connect this pin to the newly created net
            $log .= "(output) pin " . $connection->cell->name . $HIERSEP . $connection->name;
            $connection->netname( $op->net->name );
            $connection->portname( $op->name );
            $connection->net(undef);     # resolved by link
            $connection->port(undef);    # resolved by link
        } elsif ( ref($connection) eq "Verilog::Netlist::Port" ) {

            # if it is a port of a module, connect this port to the newly created net
            $log .= "(input)  port " . $connection->name;
            $connection->net( $op->net );
            $net->module->new_contassign(
                keyword => "assign",
                lhs     => $op->name,
                rhs     => $connection->name,
                module  => $net->module,
                netlist => $net->module->netlist
            );
        } elsif ( ref($connection) eq "Verilog::Netlist::Contassign" ) {
            $log .= "assignment " . $connection->lhs;
            $connection->rhs( $connection->rhs =~ s/^\Q$net->name\E$/oip->net->name/r );
        }
        $log .= " to generated output " . $op->name;
        $logger->debug($log);

        # create interconnections for newly created port/pin
        # FIXME needed here or OK linking once after loop?
        # $net->module->link;
    }

    # exactly the same for the input
    # connecting newly created input to driven cells
    foreach my $connection ( @{ $connections{'driven'} } ) {
        my $log = "Modified: Connecting ";
        if ( ref($connection) eq "Verilog::Netlist::Pin" ) {
            $log .= "(input)  pin " . $connection->cell->name . $HIERSEP . $connection->name;
            $connection->netname( $ip->net->name );
            $connection->portname( $ip->name );
            $connection->net(undef);     # resolved by link
            $connection->port(undef);    # resolved by link
        } elsif ( ref($connection) eq "Verilog::Netlist::Port" ) {
            $log .= "(output) port " . $connection->module->name . $HIERSEP . $connection->name;
            $net->module->new_contassign(
                keyword => "assign",
                lhs     => $connection->name,
                rhs     => $ip->name,
                module  => $net->module,
                netlist => $net->module->netlist
            );
        } elsif ( ref($connection) eq "Verilog::Netlist::Contassign" ) {
            $log .= "assignment " . $connection->rhs;
            $connection->lhs( $connection->lhs =~ s/\Q$net->name\E)?$/$ip->net->name/r );
        }
        $log .= " to generated input " . $ip->name;
        $logger->debug($log);

        # create interconnections for newly created port/pin
        # FIXME needed here or OK linking once after loop?
        # $net->module->link;
    }

    # create interconnections for newly created ports/pins
    # FIXME OK linking once after loop?
    $net->module->link;

    return undef;
}

## @method validate_driver(net_path, driver_path, driver_type)
# Check if the driver specified by $driver_type and $driver_path
# is actually connected to the net specified by $net_path
sub _validate_driver {
    my $logger = get_logger("");
    my ( $self, $net_path, $driver_path, $driver_type ) = @_;

    my $connection_object = $self->get_connection_object( $driver_path, $driver_type );
    my $net_ref           = $self->splitnet($net_path);
    my $connections       = {};

    if ( ref($net_ref) eq "HASH" ) {
        $self->_get_net_connections( $net_ref->{'net'}, $connections );
    } else {
        return $net_ref;
    }

    my @in_drivers     = grep { $_ == $connection_object } @{ $connections->{'drivers'} };
    my @in_connections = grep { $_ == $connection_object } @{ $connections->{'connected'} };

    if ( @in_drivers == 0 && @in_connections == 0 ) {
        my $msg = "No possible driver found";
        $logger->error($msg);
        return $msg;
    }

    return undef;
}

# Prompt the user to select a driver for a net from a set of given cells/outputs
# Params:
#   connected list reference containing connected Verilog::Perl instances
#   net the Verilog::Perl::Net instance to select the driver for
sub _select_driver($$) {
    my ( $connected, $net ) = @_;

    print "Select driver for net " . $net->name . ": \n";
    my $di;
    for ( $di = 0 ; $di < @{$connected} ; $di++ ) {
        printf( "[%d] %s\n", $di, FIJI::Netlist->_connection_tostr( @{$connected}[$di] ) );
    }
    printf( "[x] none of the above.\n", $di );
    my $sel;
    while (1) {
        $sel = <STDIN>;
        if ( $sel =~ m/[0-9]+/ && defined @{$connected}[$sel] ) {
            last;
        } elsif ( $sel =~ m/[xX]/ ) {
            my $msg = "No driver selected for net " . $net->name;
            return $msg;
        } else {
            print "Invalid driver.\n";
        }
    }
    return @{$connected}[$sel];
}

# prints the type of a connection
# and optionally pushes a hash {path=>...,type=>...,} onto the list @$conn_str_list_ref
#
# params
#   connection the connection to print
sub _connection_tostr($;$) {
    my ( $self, $connection, $conn_str_list_ref ) = @_;
    my $path;
    my $name;
    my $type;

    if ( ref($connection) eq "Verilog::Netlist::Pin" ) {
        $name = $connection->name;
        $path = $connection->cell->module->name . $HIERSEP . $connection->cell->name;
        $type = "PIN";
    } elsif ( ref($connection) eq "Verilog::Netlist::Port" ) {
        $name = $connection->name;
        $path = $connection->module->name;
        $type = "PORT";
    } elsif ( ref($connection) eq "Verilog::Netlist::Contassign" ) {
        $name = $connection->lhs;
        $path = $connection->module->name;
        $type = "ASSIGN";
    }
    push @{$conn_str_list_ref}, { path => $path . $HIERSEP . $name, type => $type } if defined $conn_str_list_ref;
    return $type . ": " . $path . $HIERSEP . $name;
}

sub get_connection_object($$) {
    my $logger = get_logger("");
    my ( $self, $connection_path, $connection_type ) = @_;

    my $rv;

    if ( $connection_type eq "PIN" ) {
        if ( $connection_path =~ /^(.+)\|(.+)\|(.+)$/ ) {

            $logger->info("Looking for $connection_type:$1|$2|$3");

            my $mod  = $self->{'nl'}->find_module($1);
            my $cell = $mod->find_cell($2) if ( defined $mod );
            my $pin  = $cell->find_pin($3) if ( defined $cell );
            $rv = $pin;
        }
    } elsif ( $connection_type eq "PORT" ) {
        if ( $connection_path =~ /^(.+)\|(.+)$/ ) {

            $logger->info("Looking for $connection_type:$1|$2");

            my $mod = $self->{'nl'}->find_module($1);
            my $port = $mod->find_port($2) if ( defined $mod );
            $rv = $port;
        }
    } elsif ( $connection_type eq "ASSIGN" ) {
        if ( $connection_path =~ /^(.+)\|(.+)$/ ) {
            my $lhs = $2;

            my $mod = $self->{'nl'}->find_module($1);
            my $assign;

            if ( defined $mod ) {
                for my $a ( grep { ref($_) eq "Verilog::ContAssign" } $mod->statements ) {
                    if ( $a->lhs eq $lhs ) {
                        $assign = $a;
                        last;
                    }
                }
            }
            $rv = $assign;
        }
    }
    return $rv;
}

# gets all pins, ports and assignments a net is connected to
# currently only works for single-bit signals and instantiations not using
# buses and concatenations
#
# params
#   net the net to be examined
#   connection_hashref a hashref where the results can be placed
#   -> connection_hashref->{'drivers'} contains a list of driver cells
#   -> connection_hashref->{'driven'} contains a list of driven cells
#   -> connection_hashref->{'connected'} contains a list cells connected to the
#      net but driver/driven cannot be decided
sub _get_net_connections ($$) {
    my $logger = get_logger("");
    my ( $self, $net, $connection_hashref ) = @_;

    my $mod = $net->module;

    my $connections = $connection_hashref;
    my @drivers     = ();
    my @driven      = ();
    my @connected   = ();

    # FIXME what to do with bussed nets
    # FIXME what to do with instantiations like that (concatenated nets):
    # input [5:0] p_nbus_byte_controller_c_state ;
    #  ...
    # .p_nbus_byte_controller_c_state (
    #                     {byte_controller_c_state[5],byte_controller_c_state[3]
    #                      ,byte_controller_c_state[2],byte_controller_c_state[1]
    #                      ,byte_controller_c_state[4],byte_controller_c_state[0]
    #                      })
    #
    # TODO: can Verilog::Language::split_bus help us here?

    # if ( $netname =~ m/.+\[([0-9]+)\]/ ) {
        # my $idx = $1;
    # }
    $logger->debug( "Net " . $mod->name . $HIERSEP . $net->name . ", connections:" );

    # find nets driven by continuous assignment (e.g., constant or inverter)
    foreach my $statement ( $mod->statements ) {
        if ( $statement->lhs eq $net->name ) {

            # continuous assign statement to this net, there can't be another driver
            $logger->debug( "    assign: " . $mod->name . ": " . $net->name . " = " . $statement->rhs );
            push @drivers, $statement;
        } elsif ( $statement->rhs =~ /\Q$net->name\E$/ ) {
            push @driven, $statement;
        }
    }

    # find nets driven by this module's input ports
    foreach my $port ( $mod->ports_sorted ) {
        if ( defined $port->net && ( $port->net->name eq $net->name ) ) {
            $logger->debug( "    port:   " . $mod->name . $HIERSEP . $port->name );

            # driven from an input, there can't be another driver
            if ( $port->direction eq "in" ) {
                push @drivers, $port;
            } elsif ( $port->direction eq "out" ) {
                push @driven, $port;
            } elsif ( $port->direction eq "inout" ) {
                push @connected, $port;
            }
        }
    }

    # find nets driven by other cells output pins
    foreach my $cell ( $mod->cells_sorted ) {
        foreach my $pin ( $cell->pins_sorted ) {
            foreach my $netname (@{$pin->netnames}) {
                if ( $netname eq $net->name ) {
                    $logger->debug( "    pin " . $pin->cell->name . $HIERSEP . $netname );
                    push @connected, $pin;
                }
            }
        }
    }
    $connections->{'drivers'}   = \@drivers;
    $connections->{'driven'}    = \@driven;
    $connections->{'connected'} = \@connected;
}

# Writes the current netlist to a specified file
#
# params
#    filename the filename for the resulting Verilog file
#    id the FIJI id (included in a comment if defined)
#
sub export ($;$) {

    my $logger = get_logger("");
    my ( $self, $filename, $id ) = @_;

    open( my $fh_nl, ">", $filename );

    if ( !defined $fh_nl ) {
        my $msg = "Could not open $filename for writing: $!";
        return $msg;
    }

    print $fh_nl "//------------------------------------------------------------------------------\n";
    print $fh_nl "// FIJI instrumented netlist\n";
    print $fh_nl "//\n";
    print $fh_nl $FIJI_LOGO;
    print $fh_nl "//\n";
    print $fh_nl "//------------------------------------------------------------------------------\n";
    print $fh_nl "// Generated " . localtime() . " by $0\n";
    print $fh_nl "// Netlist ID: 0x" . sprintf( "%04x", $id ) . "\n" if defined $id;
    print $fh_nl "//------------------------------------------------------------------------------\n\n";

    for my $mod ( $self->{'nl'}->modules_sorted ) {
        my $verilog_text = _export_module($mod);
        print $fh_nl $verilog_text;
    }

    close($fh_nl);
    return undef;
}

# exports a Verilog::Netlist module to vqm-compatible Verilog.
# returns the Verilog text as a large string.
#
# params
#   mod the module to be exported
#
sub _export_module($) {

    # FIXME do we need any additional Verilog Syntax (Interface, Modport)?

    my $logger = get_logger("");
    my ($mod) = @_;

    $logger->info( "Generating verilog text for module " . $mod->name );

    my $module_header    = "module " . $mod->name . " (\n";
    my $net_declarations = "";
    my $assigns          = "";
    my $instantiations   = "";
    my $module_footer    = "endmodule /* " . $mod->name . " */\n\n";

    my @ports = $mod->ports_sorted;
    my %defparams;
    my @contassigns;

    $logger->info( "Generating ports for module " . $mod->name );

    for ( my $i = 0 ; $i < @ports ; $i++ ) {
        my $port = $ports[$i];

        # add port declaration to module header part "module (<PORTS>)"
        $module_header .= "    " . $port->name;

        # port direction
        # Verilog::Perl specifies them as 'in', 'out', or 'inout'
        # Correct Verilog syntax is 'input', 'output' or 'inout'
        # => Add the suffix 'put' where applicable
        my $direction = $port->direction . ( ( $port->direction =~ m/^(in|out)$/ ) ? "put" : "" );

        my $comment = "";
        if ( defined( $port->userdata( FIJI::VHDL->FIJI_USERDATA_PORTTYPE ) ) ) {
            $comment = " /* FIJI */";
        }

        # add port declaration to net declaration part "input <FOO>; output <BAR>; wire <SOME_WIRE>"
        # data_type also contains the vector specification ([7:0]) where applicable
        $net_declarations .= sprintf( "    %-6s %+7s %s;%s\n", $direction, ( defined $port->data_type ) ? $port->data_type : "", $port->name, $comment );
        if ( $i < @ports - 1 ) {
            $module_header .= ",";
        }
        $module_header .= $comment . "\n";
    }

    $module_header .= ");\n";

    $logger->info( "Generating nets for module " . $mod->name );

    foreach my $net ( $mod->nets ) {
        if ( $net->net_type ne "" && $net->decl_type eq "net" ) {

            # don't declare nets with empty net_type
            # FIXME when do we get empty net_types?
            $net_declarations .= sprintf( "    %-6s %+7s %s;\n", $net->net_type, ( defined $net->data_type ) ? $net->data_type : "", $net->name );
        }
    }

    my $assign_indent   = 0;
    my $defparam_indent = 0;

    $logger->info( "Generating assigns for module " . $mod->name );

    # NOTE we need to separate assigns from defparams because Quartus requires
    # the defparams setting LUT mask etc.to be right after the cell instantiation.
    foreach my $statement ( $mod->statements_sorted ) {
        if ( ref($statement) eq "Verilog::Netlist::ContAssign" ) {
            push @contassigns, $statement;
            $assign_indent = length $statement->lhs if ( length $statement->lhs > $assign_indent );
        } elsif ( ref($statement) eq "Verilog::Netlist::Defparam" ) {

            # Build a hash of defparams, with the key being the cell identifier.
            # FIXME this regex might break with other synthesis tool because of other delimiters
            my $k = ( split( /\./, $statement->lhs ) )[0];
            push @{ $defparams{$k} }, $statement;
        }
    }

    foreach my $assign (@contassigns) {
        $assigns .= sprintf( "    assign %-${assign_indent}s = %s;\n", $assign->lhs, $assign->rhs );
    }

    $logger->info( "Generating instantiations for module " . $mod->name );

    # FIXME this is somewhat slow for large modules. Other solutions?
    foreach my $cell ( $mod->cells_sorted ) {
        my $cellname = $cell->name;

        $instantiations .= "    " . $cell->submodname . " " . $cell->name . " (\n";
        my @pins = $cell->pins_sorted;
        for ( my $i = 0 ; $i < @pins ; $i++ ) {
            my $pin = $pins[$i];
            $instantiations .= "         ." . $pin->name . " (" . $pin->netname . ")";
            if ( $i < @pins - 1 ) {
                $instantiations .= ",\n";
            }
        }
        $instantiations .= "\n    );\n";

        # NOTE this is needed because Quartus requires the defparams setting LUT mask etc.
        #      to be right after the cell instantiation.
        foreach my $defparam ( @{ $defparams{$cellname} } ) {
            $instantiations .= sprintf( "    defparam %-${defparam_indent}s = %s;\n", $defparam->lhs, $defparam->rhs );
        }
        $instantiations .= "\n";

        # not needed anymore
        delete $defparams{$cellname};
    }

    # all defparams should be matched with a cell
    foreach my $k ( keys(%defparams) ) {
        $logger->warn( "Defparam " . $defparams{$k}->lhs . " could not be matched with a cell" );
        $instantiations .= sprintf( "    defparam %-${defparam_indent}s = %s;\n", $defparams{$k}->lhs, $defparams{$k}->rhs );
    }
    $instantiations .= "\n";

    return $module_header . "\n" . $net_declarations . "\n" . $assigns . "\n" . $instantiations . $module_footer;
}

## @method splitnet($netpath)
# splits a hierarchical path of a net in the form of module1|module2|netname
# to the net object corresponding to "netname" in module "module2"
#
sub splitnet ($) {
    my $logger = get_logger("");
    my ( $self, $netpath ) = @_;
    my $rv = {};

    my $msg;

    my @net_split = split( /\|/, $netpath );

    if ( !defined $net_split[-2] ) {
        $msg = "Not a valid net path.";
        return $msg;
    }

    my $mod = $self->{'nl'}->find_module( $net_split[-2] );

    if ( !defined $mod ) {
        $msg = "Could not find module '" . $net_split[-2] . "' in netlist $self->{'filename'}\n";
        return $msg;
    }

    my $net = $mod->find_net( $net_split[-1] );

    if ( !defined $net ) {
        $msg = "Could not find net '" . $mod->name . "|" . $net_split[-1] . " in netlist $self->{'filename'}'\n";
        return $msg;
    }

    $rv->{'mod'} = $mod;
    $rv->{'net'} = $net;

    return $rv;

}

1;