#!/usr/bin/perl -w

use strict;
no strict 'refs';
use warnings;
use Carp;
$Carp::Verbose = 0;
use POSIX 'floor';

BEGIN {
    my $rootpath = $ENV{PGPG2PATH};
    if (defined $rootpath) {
        push @INC, $rootpath . '/bin';
    }
}

use pgdlutil;

my $Verbose         = 0;
my $Debug           = 0;
my $Infile          = undef;
my $Prefix          = 'pg2';
my $Libname         = 'pg2emu';
my %Module          = ();
my %Signal          = ();
my $Archinfo        = undef;


# regxp pattern of PGPG2 directive
# embedded in template files
# ($PGPG2PATH/src/templates/*.template.vhd).
#
my $Templatetag0    = q{<PG2>  (.*?)  </PG2>\s*\n};
my $Templatetag1    = q{<  ([^\=]+?)  >};
my $Rexp_var        = q{^[a-zA-Z][a-zA-Z0-9]*(?:_\d+)?$};
my $Rexp_var_suf    = q{(^[a-zA-Z][a-zA-Z0-9]*) (?: _(\d+))? $};
my $Rexp_literalnum = q{\"(\d+)\"};

##########################################
#
# the main function
#
{
    _parse_commandline_arguments(@ARGV);
    pg2_parse_pgdl($Infile);
    pg2_dump_parsed_pgdl();

    $Archinfo = pg2_get_parameter('ARCH');
    _register_modules();

    # generate source files
    #
    _generate_h();
    _generate_c();
    _generate_makefile();
}

##########################################
#
# local functions
#

sub _dprintf {
    if ($Debug) {
        printf STDERR @_;
    }
}

sub _vprintf {
    if ($Verbose) {
        printf STDERR @_;
    }
}

sub _parse_commandline_arguments {
    my @argv = @_;

  ARG:
    while (@argv) {
        $_ = shift @argv;
        /-v/     and do {
            $Verbose = 1;
            pg2_verbose();
            next ARG;
        };

        /-d/     and do {
            $Debug = 1;
            pg2_debug();
            next ARG;
        };

        /-h/     and do {
            my $cmdname = $0;
            $cmdname =~ s/.+\/(.+)/$1/g;
            die
                "generate a bit-level emulator library for a pipeline described in a .pgdl file.\n" .
                "input is taken from stdin if no file name is given.\n" .
                "  usage: $cmdname " . '[-d|-h|-v] [pgdl-file]' . "\n" .
                "    -d: output messages for debugging purpose.\n" .
                "    -h: print this mesage.\n" .
                "    -v: be verbose.\n";
            next ARG;
        };

        /[^-]+/  and do {
            if (! defined $Infile) {
                $Infile = $_;
            }
            next ARG;
        };
    }
}

# return I/O attribute (one of IPSET/JPSET/COEFFSET/FOSET or undef)
# of a variable who has name $varname.
#
sub _io_attribute_of {
    my ($varname) = @_;

    for my $paramname ('IPSET', 'JPSET', 'COEFFSET', 'FOSET') {
        my $params = pg2_get_parameter($paramname);

        next if ! defined $params;

        for my $param (@{$params}) {
            my $basename = $param->[0];
            return $paramname if ($varname =~ / ${basename} (?: _\d+)? $ /x);
        }
    }
    return undef;
}

# return width of an I/O variable (one of IPSET/JPSET/COEFFSET/FOSET)
# of an I/I variable who has name $varname. return undef if the
# variable is not an I/O variable.
#
sub _io_width_of {
    my ($varname) = @_;

    for my $paramname ('IPSET', 'JPSET', 'COEFFSET', 'FOSET') {
        my $params = pg2_get_parameter($paramname);

        next if ! defined $params;

        for my $param (@{$params}) {
            my $basename = $param->[0];
            return $param->[4] if ($varname =~ / ${basename} (?: _\d+)? $ /x);
        }
    }
    return undef;
}

#
# pgemu.[ch] generation functions.
#

sub _generate_iovars {
    my ($io, $index2) = @_;
    if (!defined $index2) {
        $index2 = q{};
    }

    my $do = sub {
        my ($args)   = @_;
        my $var      = $args->{var};
        my $sigoff   = $args->{signaloff};
        my $ne       = $args->{ne};
        my $index    = $args->{index};
        my $nvar     = $args->{nsignal};

        my $outtext  = q{};
        my $ioname   = q{};

        return q{} if $index > 0;
        return q{} if $sigoff > 0;

        for ($io) {
            /JPSET/ and do {
                $ioname = 'JP';
                last;
            };
            /IPSET/ and do {
                $ioname = 'IP';
                last;
            };
            /COEFFSET/ and do {
                $ioname = 'COEFF';
                last;
            };
            /FOSET/ and do {
                $ioname = 'FO';
                last;
            };
        }
        if ($nvar == 0) {
            $outtext .= "// $ioname variables\n";
        }
        $outtext .= sprintf("static UINT64 I${var}${index2}%s;\n",
                            $ne > 1 ? "[$ne]" : q{});

        return $outtext;
    };

    my $return = sub {
        my ($args)   = @_;
        my $outtext  = $args->{outtext};
        return $outtext;
    };

    my $outtext = pg2_foreach_ioport_of_type($io, $do, $return);

    return $outtext;

}

sub _generate_ioconv {
    my ($io, $index2, $indent, $ismc) = @_;

    my $do = sub {
        my ($args)   = @_;
        my $var      = $args->{var};
        my $sigoff   = $args->{signaloff};
        my $ne       = $args->{ne};
        my $index    = $args->{index};
        my $nvar     = $args->{nsignal};
        my $outtext = q{};

        return q{} if $sigoff > 0;
        return q{} if $index > 0;

        my $indent = q{ } x $indent;
        for ($io) {
            / JPSET | IPSET | COEFFSET/x and do {
                if ($ne > 1) {
                    $outtext .= $indent . "for (k = 0; k < $ne; k++) {\n";
                    $outtext .= $indent . "    I${var}${index2}[k] = convert_${var}(devid, ${var}${index2}[k]);\n";
                    $outtext .= $indent . "}\n";
                }
                else {
                    $outtext .= $indent;
                    $outtext .= "I${var}${index2} = convert_${var}(devid, ${var}${index2});\n";
                }
                last;
            };
            /FOSET/ and do {
                if ($ne > 1) {
                    $outtext .= $indent . "for (k = 0; k < $ne; k++) {\n";
                    $outtext .= $indent . "    ${var}[i][k] = convert_${var}(devid, I${var}[i][k]);\n";
                    $outtext .= $indent . "}\n";
                }
                else {
                    $outtext .= $indent;
                    $outtext .= "${var}[i] = convert_${var}(devid, I${var}[i]);\n";
                }
                last;
            };
        }
        return $outtext;
    };

    my $return = sub {
        my ($args)   = @_;
        my $outtext  = $args->{outtext};
        return $outtext;
    };

    my $outtext = pg2_foreach_ioport_of_type($io, $do, $return);

    return $outtext;
}

# generate <prefix>_set_range_<var> function
#
sub _generate_iorange_definition {
    my ($io) = @_;

    my $do = sub {
        my ($args)   = @_;
        my $var      = $args->{var};
        my $sigoff   = $args->{signaloff};
        my $index    = $args->{index};
        my $type     = $args->{type};
        my $w        = $args->{width};
        my $m        = $args->{mantissa};
        my $ctype    = $args->{ctype};
        my $scale    = $args->{scale};
        my $offset   = $args->{offset};
        my $outtext = q{};
        return q{} if $index > 0;
        my $t = defined $m ? ($type . $w . q{.} . $m) : ($type . $w);
        my $var_uc = ucfirst $var;

        #### embedded fragments of C source codes ########
        my $body = << "END_BODY";
/*
 * scaling utilities for '$var' of type int$w:
 */

static double ${var_uc}_scale[NHIB];
static double ${var_uc}_offset[NHIB];
static double ${var_uc}_min[NHIB];
static double ${var_uc}_max[NHIB];

void
${Prefix}_set_range_$var(double min, double max)
{
    ${Prefix}_set_range_${var}MC(0, min, max);
}

void
${Prefix}_set_range_${var}MC(int devid, double min, double max)
{
    double size;

    size = max - min;
    ${var_uc}_scale[devid] = pow(2.0, (double)$w) / size;
    ${var_uc}_offset[devid] = min;
    ${var_uc}_min[devid] = min;
    ${var_uc}_max[devid] = max;
}

void
${Prefix}_get_range_${var}(double *min, double *max)
{
    ${Prefix}_get_range_${var}MC(0, min, max);
}

void
${Prefix}_get_range_${var}MC(int devid, double *min, double *max)
{
    *min = ${var_uc}_min[devid];
    *max = ${var_uc}_max[devid];
}

inline double
${Prefix}_get_scale_${var}(void)
{
    return ${Prefix}_get_scale_${var}MC(0);
}

inline double
${Prefix}_get_scale_${var}MC(int devid)
{
    return ${var_uc}_scale[devid];
}

inline double
${Prefix}_get_offset_${var}(void)
{
    return ${Prefix}_get_offset_${var}MC(0);
}

inline double
${Prefix}_get_offset_${var}MC(int devid)
{
    return ${var_uc}_offset[devid];
}


END_BODY
        #########################################

        my $body2 = << "END_BODY2";
/*
 * scaling utilities for '$var' of type $t:
 */

static double ${var_uc}_scale[NHIB];

inline void
${Prefix}_set_scale_${var}(double scale)
{
    ${Prefix}_set_scale_${var}MC(0, scale);
}

inline void
${Prefix}_set_scale_${var}MC(int devid, double scale)
{
    ${var_uc}_scale[devid] = scale;
}

inline double
${Prefix}_get_scale_${var}(void)
{
    return ${Prefix}_get_scale_${var}MC(0);
}

inline double
${Prefix}_get_scale_${var}MC(int devid)
{
    return ${var_uc}_scale[devid];
}

END_BODY2
        #### end of C source codes #######################
        return q{} if $sigoff > 0;
        return q{} if $ctype ne 'double';

        if ($io =~ /JPSET|IPSET|COEFFSET/ && $type =~ /int/) {
            $outtext .= $body;
        }
        elsif (($io =~ /FOSET/) ||
               ($io =~ /JPSET|IPSET|COEFFSET/ && $type =~ /float|log/)) {
            $outtext .= $body2;
        }

        return $outtext;
    };

    my $return = sub {
        my ($args)   = @_;
        my $outtext  = $args->{outtext};
        return $outtext;
    };

    my $outtext = pg2_foreach_ioport_of_type($io, $do, $return);

    return $outtext;
}

sub _substitute_tags_in_a_file {
    my ($outtext) = @_;

    $outtext =~ s/<DELAY>/pg2_get_parameter('DELAY')/eg;

    $Prefix = pg2_get_parameter('PREFIX');
    $Prefix =~ s/\"//g;

    $outtext =~ s/<prefix>/$Prefix/g;
    $outtext =~ s/<PREFIX>/uc $Prefix/eg;

    # set library name.
    $Libname = $Prefix . 'emu';
    $outtext =~ s/<libname>/$Libname/g;
    $outtext =~ s/<LIBNAME>/uc $Libname/eg;

    # set path to header files.
    my $headerpath = pg2_get_parameter('HEADERPATH');
    my $hbuf = q{};
    for (@{$headerpath}) {
        $hbuf .= '-I' . $_ . ' ';
    }
    $outtext =~ s/<HEADERPATH>/$hbuf/g;

    # set path to libraries.
    my $libpath = pg2_get_parameter('LIBPATH');
    my $lbuf = q{};
    for (@{$libpath}) {
        $lbuf .= '-L' . $_ . ' ';
    }
    $outtext =~ s/<LIBPATH>/$lbuf/g;

    $outtext = pgdlutil::_remove_unused_func($outtext);

    $outtext =~ s{ <COEFFARGS> }{ pgdlutil::_generate_ioargs('COEFFSET') }egx;
    $outtext =~ s{ <COEFFCALL> }{ pgdlutil::_generate_iocall('COEFFSET') }egx;
    $outtext =~ s{ <COEFFVARS> }{ _generate_iovars('COEFFSET') }egx;
    $outtext =~ s{ <COEFFCONV> }{ _generate_ioconv('COEFFSET', q{}, 4) }egx;
    $outtext =~ s{ <COEFFCONV_PROTOTYPE> }{ pgdlutil::_generate_ioconv_prototype('COEFFSET') }egx;
    $outtext =~ s{ <COEFFCONV_DEFINITION> }{ pgdlutil::_generate_ioconv_definition('COEFFSET') }egx;
    $outtext =~ s{ <COEFFRANGE_PROTOTYPE> }{ pgdlutil::_generate_iorange_prototype('COEFFSET') }egx;
    $outtext =~ s{ <COEFFRANGE_DEFINITION> }{ _generate_iorange_definition('COEFFSET') }egx;
    $outtext =~ s{ <COEFFPACK> }{ _generate_coeffpack() }egx;

    # set JP memory depth.
    my $jwords = pg2_get_parameter('JMEMSIZE');
    $outtext =~ s/<JWORDS>/$jwords/g;

    $outtext =~ s{ <JPARGS> }{ pgdlutil::_generate_ioargs('JPSET') }egx;
    $outtext =~ s{ <JPCALL> }{ pgdlutil::_generate_iocall('JPSET') }egx;
    $outtext =~ s{ <JPVARS> }{ _generate_iovars('JPSET', '[JMEMSIZE]') }egx;
    $outtext =~ s{ <JPCONV> }{ _generate_ioconv('JPSET', '[j]', 8) }egx;
    $outtext =~ s{ <JPCONV_PROTOTYPE> }{ pgdlutil::_generate_ioconv_prototype('JPSET') }egx;
    $outtext =~ s{ <JPCONV_DEFINITION> }{ pgdlutil::_generate_ioconv_definition('JPSET') }egx;
    $outtext =~ s{ <JPRANGE_PROTOTYPE> }{ pgdlutil::_generate_iorange_prototype('JPSET') }egx;
    $outtext =~ s{ <JPRANGE_DEFINITION> }{ _generate_iorange_definition('JPSET') }egx;

    $outtext =~ s{ <IPARGS> }{ pgdlutil::_generate_ioargs('IPSET') }egx;
    $outtext =~ s{ <IPCALL> }{ pgdlutil::_generate_iocall('IPSET') }egx;
    $outtext =~ s{ <IPCALL_OFF> }{ pgdlutil::_generate_iocall('IPSET', 'off') }egx;
    $outtext =~ s{ <IPVARS> }{ _generate_iovars('IPSET', '[NPIPE]') }egx;
    $outtext =~ s{ <IPCONV> }{ _generate_ioconv('IPSET', '[i]', 8) }egx;
    $outtext =~ s{ <IPCONV_PROTOTYPE> }{ pgdlutil::_generate_ioconv_prototype('IPSET') }egx;
    $outtext =~ s{ <IPCONV_DEFINITION> }{ pgdlutil::_generate_ioconv_definition('IPSET') }egx;
    $outtext =~ s{ <IPRANGE_PROTOTYPE> }{ pgdlutil::_generate_iorange_prototype('IPSET') }egx;
    $outtext =~ s{ <IPRANGE_DEFINITION> }{ _generate_iorange_definition('IPSET') }egx;

    $outtext =~ s{ <FOARGS> }{ pgdlutil::_generate_ioargs('FOSET') }egx;
    $outtext =~ s{ <FOCALL> }{ pgdlutil::_generate_iocall('FOSET') }egx;
    $outtext =~ s{ <FOCALL_RAW> }{ pgdlutil::_generate_iocall('FOSET', 'raw') }egx;
    $outtext =~ s{ <FOCALL_OFF> }{ pgdlutil::_generate_iocall('FOSET', 'off') }egx;
    $outtext =~ s{ <FOVARS> }{ _generate_iovars('FOSET', '[NPIPE]') }egx;
    $outtext =~ s{ <FOCONV> }{ _generate_ioconv('FOSET', '[i]', 8) }egx;
    $outtext =~ s{ <FOCONV_PROTOTYPE> }{ pgdlutil::_generate_ioconv_prototype('FOSET') }egx;
    $outtext =~ s{ <FOCONV_DEFINITION> }{ pgdlutil::_generate_ioconv_definition('FOSET') }egx;
    $outtext =~ s{ <FORANGE_PROTOTYPE> }{ pgdlutil::_generate_iorange_prototype('FOSET') }egx;
    $outtext =~ s{ <FORANGE_DEFINITION> }{ _generate_iorange_definition('FOSET') }egx;

    $outtext =~ s{ <PIPEARGS> }{ _generate_pipeargs() }egx;
    $outtext =~ s{ <PIPECALL> }{ _generate_pipecall() }egx;
    $outtext =~ s{ <PIPETEST> }{ _generate_pipetest() }egx;
    $outtext =~ s{ <PIPELINE> }{ _generate_pipeline() }egx;

    $outtext =~ s{ <TESTVECVARS> }{ _generate_testvecvars() }egx;
    $outtext =~ s{ <TESTVECSCANF> }{ _generate_testvecscanf() }egx;
    $outtext =~ s{ <TESTVECCALL> }{ _generate_testveccall() }egx;
    $outtext =~ s{ <TESTVECSAVE> }{ _generate_testvecsave() }egx;
    $outtext =~ s{ <TESTVECHEAD> }{ _generate_testvechead() }egx;
    $outtext =~ s{ <TESTVECBODY> }{ _generate_testvecbody() }egx;

    $outtext =~ s{ <OLD_API_PROTOTYPE> }{ pgdlutil::_generate_old_api_prototype() }egx;
    $outtext = pgdlutil::_generate_old_api_definition($outtext);

    return $outtext;
}

sub _generate_h {
    my $fnamebase = 'pgemu';
    my $intext = pg2_read_template($fnamebase, 'h');
    my $outtext = $intext;
    $outtext = _substitute_tags_in_a_file($outtext);
    pg2_write_file($Prefix . 'util'. '.h', $outtext);
}

sub _generate_c {
    my $fnamebase = 'pgemu';
    my $intext = pg2_read_template($fnamebase, 'c');
    my $outtext = $intext;
    $outtext = _substitute_tags_in_a_file($outtext);
    pg2_write_file($Libname . '.c', $outtext);
}

sub _generate_makefile {
    my $fnamebase = 'pgemu';
    my $intext = pg2_read_template($fnamebase, 'makefile');
    my $outtext = $intext;
    $outtext = _substitute_tags_in_a_file($outtext);
    pg2_write_file('Makefile', $outtext);
}

sub _generate_pipeargs {
    my @ilist   = ();
    my $outtext = q{};
    my @vars    = ();
    my $indent = q{ } x 4;

    # variable definitions
    #
    for my $module (values %Module) {
        for my $instance (@{$module->{instances}}) {
            for my $arg (@{$instance->{args}}) {
                next if (((grep {$arg eq $_} @vars)) > 0);
                next if $arg !~ /$Rexp_var/;
                push @vars, $arg;
            }
        }
    }

    # COEFF variables
    #
    my $found_coeff = 0;
    for my $var (@vars) {
        my $io = _io_attribute_of($var);
        next if ! defined $io;
        next if $io ne 'COEFFSET';

        $found_coeff = 1;
        $var =~ /$Rexp_var_suf/x;
        my $basename = $1;
        my $index     = defined $2 ? "[$2]" : q{};
        $outtext .= "UINT64 $var, ";
    }

    # IP variables
    #
    if ($found_coeff) {
        $outtext .= "\n";
        $outtext .= $indent;
    }
    for my $var (@vars) {
        my $io = _io_attribute_of($var);
        next if ! defined $io;
        next if $io ne 'IPSET';

        $var =~ /$Rexp_var_suf/x;
        my $basename = $1;
        my $index     = defined $2 ? "[$2]" : q{};
        $outtext .= "UINT64 $var, ";
    }
    $outtext .=  "\n";

    # JP variables
    #
    $outtext .= $indent;
    for my $var (@vars) {
        my $io = _io_attribute_of($var);
        next if ! defined $io;
        next if $io ne 'JPSET';

        $var =~ /$Rexp_var_suf/x;
        my $basename = $1;
        my $index     = defined $2 ? "[$2]" : q{};
        $outtext .= "UINT64 $var, ";
    }
    $outtext .=  "\n";

    # FO variables
    #
    $outtext .= $indent;
    for my $var (@vars) {
        my $io = _io_attribute_of($var);
        next if ! defined $io;
        next if $io ne 'FOSET';

        $var =~ /$Rexp_var_suf/x;
        my $basename = $1;
        my $index     = defined $2 ? "[$2]" : q{};
        $outtext .= "UINT64 *${var}p, ";
    }
    
    return $outtext;
}


sub _generate_pipecall {
    my @ilist   = ();
    my $outtext = q{};
    my @vars    = ();
    my $indent = q{ } x 16;

    # variable definitions
    #
    for my $module (values %Module) {
        for my $instance (@{$module->{instances}}) {
            for my $arg (@{$instance->{args}}) {
                next if (((grep {$arg eq $_} @vars)) > 0);
                next if $arg !~ /$Rexp_var/;
                push @vars, $arg;
            }
        }
    }

    # COEFF variables
    #
    my $found_coeff = 0;
    for my $var (@vars) {
        my $io = _io_attribute_of($var);
        next if ! defined $io;
        next if $io ne 'COEFFSET';

        $found_coeff = 1;
        $var =~ /$Rexp_var_suf/x;
        my $basename = $1;
        my $index     = defined $2 ? "[$2]" : q{};
        $outtext .= "I${basename}$index, ";
    }

    # IP variables
    #
    if ($found_coeff) {
        $outtext .= "\n";
        $outtext .= $indent;
    }
    for my $var (@vars) {
        my $io = _io_attribute_of($var);
        next if ! defined $io;
        next if $io ne 'IPSET';

        $var =~ /$Rexp_var_suf/x;
        my $basename = $1;
        my $index     = defined $2 ? "[$2]" : q{};
        $outtext .= "I${basename}[i]$index, ";
    }
    $outtext .=  "\n";

    # JP variables
    #
    $outtext .= $indent;
    for my $var (@vars) {
        my $io = _io_attribute_of($var);
        next if ! defined $io;
        next if $io ne 'JPSET';

        $var =~ /$Rexp_var_suf/x;
        my $basename = $1;
        my $index     = defined $2 ? "[$2]" : q{};
        $outtext .= "I${basename}[j]$index, ";
    }
    $outtext .=  "\n";

    # FO variables
    #
    $outtext .= $indent;
    for my $var (@vars) {
        my $io = _io_attribute_of($var);
        next if ! defined $io;
        next if $io ne 'FOSET';

        $var =~ /$Rexp_var_suf/x;
        my $basename = $1;
        my $index     = defined $2 ? "[$2]" : q{};
        $outtext .= "&(I${basename}[i]$index), ";
    }

    return $outtext;
}

sub _generate_pipetest {
    my @ilist   = ();
    my $outtext = q{};
    my @vars    = ();
    my $indent = q{ } x 4;
    my ($cv, $jv, $iv, $fv) = _get_io_vars();
    my @coeffvars = map {$_->{name}} @{$cv};
    my @ipvars = map {$_->{name}} @{$iv};
    my @jpvars = map {$_->{name}} @{$jv};
    my @fovars = map {$_->{name}} @{$fv};

    for my $var (@coeffvars, @ipvars, @jpvars, @fovars) {
        $outtext .= $indent;
        $outtext .= "UINT64 $var;\n";
    }

    # read input variables from stdin.
    #
    $outtext .= "\n";
    $outtext .= $indent;
    $outtext .= qq{printf("input };

    for my $var (@coeffvars, @ipvars, @jpvars) {
        $outtext .= "$var ";
    }
    $outtext .= qq{: \\n");\n};

    $outtext .= "\n";
    $outtext .= $indent;
    $outtext .= qq{scanf("};
    for my $var (@coeffvars, @ipvars, @jpvars) {
        $outtext .= " 0x%016llx";
    }
    $outtext .= qq{",\n};
    my $firstcall = 1;
    for my $var (@coeffvars, @ipvars, @jpvars) {
        if ($firstcall) {
	    $outtext .= $indent x 2;
	}
	else {
            $outtext .= q{, };
        }
        $outtext .= "&$var";
        $firstcall = 0;
    }
    $outtext .= ");\n";

    $outtext .= "\n";
    $outtext .= $indent;
    $outtext .= qq{printf("inputs:\\n"\n};
    for my $var (@coeffvars, @ipvars, @jpvars) {
	$outtext .= $indent x 2;
        $outtext .= sprintf(qq{"    %8s: %s\\n"\n}, $var, '0x%016llx');
    }
    $firstcall = 1;
    for my $var (@coeffvars, @ipvars, @jpvars) {
        if ($firstcall) {
	    $outtext .= $indent x 2;
	}
	$outtext .= q{, };
        $outtext .= "$var";
        $firstcall = 0;
    }
    $outtext .= ");\n";

    # generate a pipeline call.
    #
    $outtext .= "\n";
    $outtext .= $indent;
    $outtext .= "pipeline(";

    for my $var (@coeffvars) {
        $outtext .= $indent;
        $outtext .= "$var, ";
    }
    if (@coeffvars) {
        $outtext .= "\n";
        $outtext .= $indent x 2;
    }
    for my $var (@ipvars) {
        $outtext .= "$var, ";
    }
    $outtext .= "\n";
    $outtext .= $indent x 2;
    for my $var (@jpvars) {
        $outtext .= "$var, ";
    }
    $outtext .= "\n";
    $outtext .= $indent x 2;
    for my $var (@fovars) {
        $outtext .= "&$var, ";
    }
    $outtext .= "1);\n\n";

    # print values of FO variables.
    #
    $outtext .= "\n";
    $outtext .= $indent;
    $outtext .= qq{printf("outputs:\\n"\n};
    for my $var (@fovars) {
	$outtext .= $indent x 2;
        $outtext .= sprintf(qq{"    %8s: %s\\n"\n}, $var, '0x%016llx');
    }
    $firstcall = 1;
    for my $var (@fovars) {
        if ($firstcall) {
	    $outtext .= $indent x 2;
	}
	$outtext .= q{, };
        $outtext .= "$var";
        $firstcall = 0;
    }
    $outtext .= ");\n";


    return $outtext;
}



sub _generate_pipeline {
    my @ilist   = ();
    my $outtext = q{};
    my @vars    = ();

    # define local variables
    #
    for my $module (values %Module) {
        for my $instance (@{$module->{instances}}) {
            for my $arg (@{$instance->{args}}) {
                next if (((grep {$arg eq $_} @vars)) > 0);
                next if $arg !~ /$Rexp_var/;
                push @vars, $arg;
            }
        }
    }
    my $indent  = q{ } x 4;
    $outtext .= $indent . "int i, j;\n";
    my $i = 0;
    for my $var (sort @vars) {
        my $io = _io_attribute_of($var);
        next if defined $io;

        if ($i % 8 == 0) {
            $outtext .= $indent . "UINT64 $var";
        }
        else {
            $outtext .=  ", $var";
        }
        $i++;
        if ($i % 8 == 0 || $i == @vars) {
            $outtext .=  ";\n";
        }
    }
    if ($i % 8 != 0) {
        $outtext .=  ";";
    }
    $outtext .=  "\n\n";

    # instantiate modules
    #
    for my $var (@vars) {
        my $io = _io_attribute_of($var);
        next if ! defined $io;
        next if $io ne 'FOSET';

        $outtext .= $indent . "// $var\n";
        $outtext .= _print_instance_tree_to_calculate_variable($var);
        $outtext .= "\n";
    }
    return $outtext;
}

#
# return (\@coeffvars, \@jpvars, \@ipvars, \@fovars)
#   @XXvars->[0]->{name}
#   @XXvars->[0]->{width}
#
sub _get_io_vars {

    my @coeffvars = ();
    my @jpvars    = ();
    my @ipvars    = ();
    my @fovars    = ();

    for my $module (values %Module) {
        for my $instance (@{$module->{instances}}) {
            for my $arg (@{$instance->{args}}) {
                next if (((grep {$arg eq $_->{name}} (@coeffvars, @jpvars, @ipvars, @fovars ))) > 0);
                next if $arg !~ /$Rexp_var/;
                my $io = _io_attribute_of($arg);
                next if ! defined $io;
                my %var = (
                           name => $arg,
                           io   => $io,
                          );
                for ($io) {
                    /COEFFSET/ and do {
                        push @coeffvars, \%var;
                        last;
                    };
                    /JPSET/ and do {
                        push @jpvars, \%var;
                        last;
                    };
                    /IPSET/ and do {
                        push @ipvars, \%var;
                        last;
                    };
                    /FOSET/ and do {
                        push @fovars, \%var;
                        last;
                    };
                }
            }
        }
    }
    return (\@coeffvars, \@jpvars, \@ipvars, \@fovars);
}

sub _generate_testvecvars {
    my @ilist     = ();
    my $outtext   = q{static UINT64 };

    my ($coeffvars, $jpvars, $ipvars, $fovars) = _get_io_vars();

    my $i = 0;
    for my $var (@{$coeffvars}, @{$jpvars}, @{$ipvars}, @{$fovars}) {
        $var->{name} =~ /$Rexp_var_suf/x;
        my $basename = $1;
        my $index    = defined $2 ? "_$2" : q{};
        if ($i) {
            $outtext .= q{, };
        }
        $outtext    .= $basename . $index . q{[NVEC]};
        $i++;
    }
    $outtext .=";";

    return $outtext;
}

sub _generate_testvecscanf {
    my @ilist     = ();
    my $fmttext   = q{};
    my $vartext   = q{};

    my ($coeffvars, $jpvars, $ipvars, undef) = _get_io_vars();

    my $nvars = @{$coeffvars} + @{$jpvars} + @{$ipvars};

    for my $var (@{$coeffvars}, @{$jpvars}, @{$ipvars}) {
        $var->{name} =~ /$Rexp_var_suf/x;
        my $basename = $1;
        my $index     = defined $2 ? "_$2" : q{};
        $vartext .= q{, &} . $basename . $index . q{[nvec]};
    }

    $fmttext .= q{ UINT64XFMT " " } x $nvars;
    
    return q{sscanf(buf, "%d "} . $fmttext . ",\n" .
      q{ } x 15 . q{&run[nvec]} . $vartext . q{);};
}

sub _generate_testveccall {
    my @ilist     = ();
    my $outtext   = q{};

    my ($coeffvars, $jpvars, $ipvars, $fovars) = _get_io_vars();

    my $i = 0;
    for my $var (@{$coeffvars}, @{$jpvars}, @{$ipvars}, @{$fovars}) {
        $var->{name} =~ /$Rexp_var_suf/x;
        my $basename = $1;
        my $index     = defined $2 ? "_$2" : q{};

        if ($var->{io} eq 'FOSET') {
            $outtext .= q{&};
        }
        $outtext .= $basename . $index . q{[nvec], };

        $i++;
        if ($i == @{$coeffvars} ||
            $i == @{$coeffvars} + @{$jpvars} ||
            $i == @{$coeffvars} + @{$jpvars} + @{$ipvars} ||
            $i == @{$coeffvars} + @{$jpvars} + @{$ipvars} + @{$fovars}) {
            $outtext .= "\n" . q{ } x 21;
        }
    }
    
    return $outtext;
}

sub _generate_testvecsave {
    my @ilist     = ();
    my $outtext   = q{};
    my $indent    = q{ } x 8;

    my ($coeffvars, $jpvars, $ipvars, $fovars) = _get_io_vars();

    for my $var (@{$fovars}) {
        $var->{name} =~ /$Rexp_var_suf/x;
        my $basename = $1;
        my $index    = defined $2 ? "_$2" : q{};

        $outtext .= $indent;
        $outtext .= $basename . $index . q{[nvec + 1] } . ' = ' .
                    $basename . $index . q{[nvec];} . "\n";
    }
    
    return $outtext;
}

sub _generate_testvechead {
    my @ilist     = ();
    my $outtext   = q{};
    my $indent    = q{ } x 4;

    my ($coeffvars, $jpvars, $ipvars, $fovars) = _get_io_vars();

    my $i = 0;
    for my $var (@{$coeffvars}, @{$jpvars}, @{$ipvars}, @{$fovars}) {
        $var->{name} =~ /$Rexp_var_suf/x;
        my $basename = $1;
        my $index     = defined $2 ? "_$2" : q{};
        my $name = $basename . $index;
        my $width = _io_width_of($var->{name});
        $outtext .= $indent . qq{sprintf(fmt, "%%-%ds ", ndigit($width));\n};
        $outtext .= $indent . qq{printf(fmt, "$name");\n};
        $i++;

        if ($i == @{$coeffvars} + @{$jpvars} + @{$ipvars}) {
            $outtext .= $indent . qq{printf(" = ");\n};
        }

    }
    return $outtext;
}

sub _generate_testvecbody {
    my @ilist     = ();
    my $outtext   = q{};

    my ($coeffvars, $jpvars, $ipvars, $fovars) = _get_io_vars();
    my $width;
    my $indent    = q{ } x 8;
    for my $var (@{$coeffvars}, @{$jpvars}, @{$ipvars}) {
        $var->{name} =~ /$Rexp_var_suf/x;
        my $basename = $1;
        my $index     = defined $2 ? "_$2" : q{};
        my $name = $basename . $index;
        $width = _io_width_of($var->{name});
        $outtext .= $indent . qq{sprintf(fmt, "%%0%dllx ", ndigit($width));\n};
        $outtext .= $indent . qq{printf(fmt, ${name}[i]);\n};
    }

    $outtext .= $indent . "\n";
    $outtext .= $indent . qq{printf(" = ");\n};
    $outtext .= $indent . "\n";
    $outtext .= $indent . qq/if (i < delay) {\n/;

    $indent    = q{ } x 12;
    for my $var (@{$fovars}) {
        $width = _io_width_of($var->{name});
        $outtext .= $indent . qq{print_X(ndigit($width));\n};
        $outtext .= $indent . qq{printf(" ");\n};
    }

    $indent    = q{ } x 8;
    $outtext .= $indent . qq/}\n/;
    $outtext .= $indent . qq/else {\n/;

    $indent    = q{ } x 12;
    for my $var (@{$fovars}) {
        $var->{name} =~ /$Rexp_var_suf/x;
        my $basename = $1;
        my $index     = defined $2 ? "_$2" : q{};
        my $name = $basename . $index;
        $width = _io_width_of($var->{name});

        if ($width < 64) {
            $outtext .= $indent . qq{${name}[i - delay] &= ((UINT64)1 << $width) - 1;\n};
        }
        elsif ($width == 64) {
            # do not need to mask the value.
        }
        else {
            croak "too large $width\n";
        }
        $outtext .= $indent . qq{sprintf(fmt, "%%0%dllx ", ndigit($width));\n};
        $outtext .= $indent . qq{printf(fmt, ${name}[i - delay]);\n};
    }

    $indent    = q{ } x 8;
    $outtext .= $indent . qq/}\n/;
    $outtext .= $indent . q{printf("\n");} . "\n";

    return $outtext;
}


# generate VHDL modules and register them to %Module
#
sub _register_modules {
    for my $m (values %{pg2_get_modules()}) {
        for my $args (@{$m->{argslist}}) {
            my $name = $m->{name};
            my (@generics, @ports, $e_a);

            $e_a = pg2_read_template($name);

            # extract port lists
            if ($e_a =~ /entity \s+ (?:<\$mname>|$name) \s+ is .*?
                         port \s* \( (.*?) \) \s* ;
                         \s* end \s+ (?:<\$mname>|$name) \s* ;/sxi) {
                my $p = $1;
                while ($p =~ s/(\w+?)\s*\://) {
                    push @ports, $1;
                }
            } else {
                croak "$name has no port statement.\n";
            }

            # extract generic lists (optional)
            if ($e_a =~ /entity \s+ (?:<\$mname>|$name) \s+ is .*?
                         generic \s* \( (.*?) \) \s* ;
                         \s* port .*? ;
                         \s* end \s+ (?:<\$mname>|$name) \s* ;/sxi) {
                my $g = $1;

                while ($g =~ s/(\w+?)\s*\://) {
                    push @generics, $1;
                }
            }
            &{'_generate_' . $name}($name, \@ports, \@generics, $args);
        }
    }
}

# Generate an instance of module $mname.
# Its port and generic parameters are given in $nodes_ref.
#
sub _instantiate_module {
    my ($module, $args_ref) = @_;
    my %instance = (
                    module => $module,
                    args   => $args_ref,
    );
    return \%instance;
}

# print a function call to a pg_module emulation function.
#   ex) pg_inc_int(node45_1, 64, 0, acc_1p, 64, 0, run_begin);
#
sub _print_an_instance {
    my ($instance) = @_;
    my $outtext    = q{};
    my $indent     = q{ } x 4;

    return q{} if defined $instance->{printed};

    $outtext .= $indent . $instance->{module}->{name} . "(";
    my $i = 0;
    for my $arg (@{$instance->{args}}) {
        if ($i > 0) {
            $outtext .= q{, };
        }
        my $io = _io_attribute_of($arg);
        my $dir = $instance->{module}->{dir}->[$i];
        if (defined $dir && $dir =~ /out/) {
            if (!defined $io || $io ne 'FOSET') {
                $outtext .= q{&};
            }
        }
        $outtext .= $arg;
        if (defined $io && $io eq 'FOSET') {
            $outtext .= 'p';
        }
        $i++;
    }
    $outtext .= ");\n";
    $instance->{printed} = 1;

    return $outtext;
}

# print all module-instances which an FO variable $rootvar depends on.
#
sub _print_instance_tree_to_calculate_variable {
    my ($rootvar) = @_;
    my $outtext = q{};
    my $io = _io_attribute_of($rootvar);

    return q{} if defined $io && $io =~ / JPSET | IPSET | COEFFSET/x; # $rootvar depends on no instance.

    my $instance = _instance_to_calculate_variable($rootvar);
    return q{} if !defined $instance; # $rootvar depends on no instance.

    my $i = 0;
    for my $var (@{$instance->{args}}) {
        if (($var =~ /$Rexp_var/) &&
            ($instance->{module}->{dir}->[$i] =~ /in/)) {
            $outtext .= _print_instance_tree_to_calculate_variable($var);
        }
        $i++;
    }

    $outtext .= _print_an_instance($instance);
    return $outtext;
}

# look for an instance on which $var depends.
#
sub _instance_to_calculate_variable {
    my ($var) = @_;
    my $found_instance = undef;

    for my $module (values %Module) {
        for my $instance (@{$module->{instances}}) {
            my $i = 0;
            for my $arg (@{$instance->{args}}) {
                if (($var eq $arg) && ($instance->{module}->{dir}->[$i] =~ /out/)) {
                    $found_instance = $instance;
                    last;
                }
                $i++;
            }
        }
    }

    if (!defined $found_instance) {
        if ($var eq 'run_begin' || $var eq 'i' || $var ne 'j') {
            return undef;
        }
        else {
            croak "no module calculates value of a variable $var.\n"
        }
    }

    return $found_instance;
}

# convert a binary expression to a hexa-decimal one.
#
sub _convert_bin_to_hex {
    my ($bin) = @_;
    my $digit;
    my $hex = 0;
    my $i = 0;
    for my $i (1..length $bin) {
        $digit = substr $bin, -$i, 1;
        $hex += 2**($i-1) * $digit;
    }
    $hex = sprintf "0x%xLL", $hex;

    return $hex;
}

#################################################################################################
#
# module generation functions
#
# Functions below are invoked by register_module().  Name and
# arguments of a function to be invoked are dynamically constructed by
# parsing .pgdl input file. AUTOLOAD is invoked by default. Only
# modules which have irregular arguments need their own generation
# functions.
#
# Once invoked, each function generate a module with a unique name,
# component, entity, and architecture, if not generated yet. Then
# generate its instance, and define signal lines connected to I/O
# ports of the instance.
#
our $AUTOLOAD;
sub AUTOLOAD {
    my ($module, $args_ref) = _generate_default_module(@_);
    _dprintf("AUTOLOAD:$AUTOLOAD module:$module->{name}\n");
    push @{$module->{instances}}, _instantiate_module($module, $args_ref);
}

sub _generate_default_module {
    my ($basename, $ports_ref, $generics_ref, $args_ref) = @_;
    my @ports    = @$ports_ref;
    my @generics = @$generics_ref;
    my @args     = @$args_ref;
    my @dir       = ();

    if (!defined $basename || !defined $ports_ref || !defined $generics_ref || !defined $args_ref) {
        croak("_generate_default_module: not enough arguments given.\n" .
              "Probably this is not a function call you intended.\n" .
              "Maybe you forgot to define a subroutine $AUTOLOAD, or just misspelled it.\n");
    }

    _dprintf "args:     @args\n" .
            "ports:    @ports\n" .
            "generics: @generics\n";

    my $mname = $basename;
    _dprintf("mname:    $mname\n");

    # check direction (input/output) of each signal.
    my $i = 0;
    my $j = 0;
    while ($i < @args) {
        last if !(($args[$i] =~ /$Rexp_var/) || ($args[$i] =~ /$Rexp_literalnum/));
        # end of a list of regular arguments, i.e., repetition of name, width, mantissa.

        if ($ports[$j] =~ /dst/) {
            push @dir, 'out';
        }
        else {
            push @dir, 'in';
        }
        push @dir, 'in';
        push @dir, 'in';
        if ($args[$i] =~ /$Rexp_literalnum/) {
            $args[$i] = '(UINT64)' . _convert_bin_to_hex($1);
        }
        $i += 3;
        $j++;
    }

    my $module = $Module{$mname};
    if (!defined $module) {
        $module->{name} = $mname;
        $module->{dir}   = \@dir;
        $Module{$mname} = $module;
    }

    return ($module, \@args);
}

sub _generate_pg_inc_int {
    my ($module, $args_ref) = _generate_default_module(@_);
    my @args = @{$args_ref};
    splice(@args, -1); # discard the right most arg.
    push @args, 'run_begin';
    push @{$module->{dir}}, 'in';
    push @{$module->{instances}}, _instantiate_module($module, \@args);
}

sub _generate_pg_inc_float {
    my ($module, $args_ref) = _generate_default_module(@_);
    my @args = @{$args_ref};
    splice(@args, -1); # discard the right most arg.
    push @args, 'run_begin';
    push @{$module->{dir}}, 'in';
    push @{$module->{instances}}, _instantiate_module($module, \@args);
}

sub _generate_pg_comp_ulog {
    my ($module, $args_ref) = _generate_default_module(@_);
    push @{$module->{instances}}, _instantiate_module($module, $args_ref);
}

sub _generate_pg_shift_float {
    my ($module, $args_ref) = _generate_default_module(@_);
    my @args = @{$args_ref};
    my $shiftdir = splice(@args, -1); # discard the right most arg.
    push @args, ($shiftdir eq q{"LEFT"} ? +1 : -1);
    push @{$module->{dir}}, 'in';
    push @{$module->{instances}}, _instantiate_module($module, \@args);
}

sub _generate_pg_delay {
    my ($basename, $ports_ref, $generics_ref, $args_ref) = @_;
    my $mname = $basename;
    my ($src, $dst) = @{$args_ref};

    for my $arg ($src) {
        if ($arg =~ /$Rexp_literalnum/) {
            $arg = $1;
        }
    }

    my @dir = ('in', 'out');
    my $module = $Module{$mname};
    if (!defined $module) {
        $module->{name} = $mname;
        $module->{dir}   = \@dir;
        $Module{$mname} = $module;
    }

    push @{$module->{instances}}, _instantiate_module($module, [$src, $dst]);
}

sub _generate_pg_store {
    my ($module, $args_ref) = _generate_default_module(@_);
    push @{$module->{instances}}, _instantiate_module($module, $args_ref);
}

# PGDL example:
# pg_pow_float(node31, node35, 34, 23, -5, 2, "pg_pow_float34.23_-5_2.mif", 12, 3, 23, 15, 5);
# new pg_pow_float(node24, node28, 34, 23, -5, 2, 9);
#
sub _generate_pg_pow_float {
    my ($basename, $ports_ref, $generics_ref, $args_ref) = @_;
    my $mname = $basename;
    my ($src, $dst, $width, $mantissa, $n, $m, $resolution) = @{$args_ref};
    my @args = ($src, $dst , $width, $mantissa, $n  , $m  , $resolution);
    for my $arg ($src) {
        if ($arg =~ /$Rexp_literalnum/) {
            $arg = $1;
        }
    }
    my @dir  = ('in', 'out', 'in',   'in',      'in', 'in', 'in');
    my $module = $Module{$mname};
    if (!defined $module) {
        $module->{name} = $mname;
        $module->{dir}   = \@dir;
        $Module{$mname} = $module;
    }

    push @{$module->{instances}}, _instantiate_module($module, \@args);
}
