#!/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         = 'pg2util';

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

    # generate .vhd 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 user 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;
        };
    }
}

#
# pgutil.[ch] generation functions.
#

sub _generate_founpackargs {
    my $io = 'FOSET';

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

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

	if (!$isfirst) {
	  $outtext .= q{, };
	}
        if ($ne > 1) {
            $outtext .= sprintf("UINT64 (*i$var)[$ne]");
        } else {
            $outtext .= sprintf("UINT64 *i$var");
        }
        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_iovars {
    my ($io, $ismc) = @_;

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

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

        if ($io eq 'FOSET') {
            $outtext .= '    static UINT64 ';
            $outtext .= sprintf("i${var}[NFOMAX]%s",
                                $ne > 1 ? q{[} . $ne . q{]} : q{});
#            if ($ismc) {
            if (1) {
                $outtext .= ";\n";
            } else {
                $outtext .= sprintf(", i${var}_sum[NFOMAX]%s;\n",
                                    $ne > 1 ? q{[} . $ne . q{]} : q{});
            }
        } else {
            $outtext .= sprintf("%s i%s",
                                $isfirst > 0 ? q{} : q{,},
                                $ne > 1   ? $var . q{[} . $ne . q{]} : $var);
        }

        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;
        if ($io eq 'FOSET') {
            my $suffix = $ismc ? q{} : '_sum';
            if ($ne > 1) {
                $outtext .= $indent . "for (k = 0; k < $ne; k++) {\n";
                $outtext .= $indent . "    ${var}[i][k] = convert_${var}(devid, i${var}${suffix}[i][k]);\n";
                $outtext .= $indent . "}\n";
            }
            else {
                $outtext .= $indent;
                $outtext .= "${var}[i] = convert_${var}(devid, i${var}${suffix}[i]);\n";
            }
        } else {
            if ($ne > 1) {
                $outtext .= $indent . "for (k = 0; k < $ne; k++) {\n";
                $outtext .= $indent . "    i${var}[k] = convert_${var}(devid, ${var}${index2}[k]);\n";
                $outtext .= $indent . "}\n";
            }
            else {
                $outtext .= $indent;
                $outtext .= "i${var} = convert_${var}(devid, ${var}${index2});\n";
            }
        }
        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)
{
    int ic;

    for (ic = 0; ic < NHIB; ic++) {
        if (${Prefix}_cards[ic] == 0) continue;
        ${Prefix}_set_range_${var}MC(ic, 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)
{
    int ic;

    for (ic = 0; ic < NHIB; ic++) {
        if (${Prefix}_cards[ic] != 0) break;
    }
    ${Prefix}_get_range_${var}MC(ic, 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)
{
    int ic;

    for (ic = 0; ic < NHIB; ic++) {
        if (${Prefix}_cards[ic] != 0) break;
    }
    return ${Prefix}_get_scale_${var}MC(ic);
}

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

inline double
${Prefix}_get_offset_${var}(void)
{
    int ic;

    for (ic = 0; ic < NHIB; ic++) {
        if (${Prefix}_cards[ic] != 0) break;
    }
    return ${Prefix}_get_offset_${var}MC(ic);
}

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)
{
    int ic;

    for (ic = 0; ic < NHIB; ic++) {
        if (${Prefix}_cards[ic] == 0) continue;
        ${Prefix}_set_scale_${var}MC(ic, scale);
    }
}

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

inline double
${Prefix}_get_scale_${var}(void)
{
    int ic;

    for (ic = 0; ic < NHIB; ic++) {
        if (${Prefix}_cards[ic] != 0) break;
    }
    return ${Prefix}_get_scale_${var}MC(ic);
}

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 _generate_ioclear {
    my ($io) = @_;

    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;

        if ($io eq 'FOSET') {
            my $indent  = q{ } x 8;
            if ($ne > 1) {
                $outtext .= $indent . "for (k = 0; k < $ne; k++) {\n";
#                $outtext .= $indent . "    i${var}_sum[i][k] = 0;\n";
                $outtext .= $indent . "    ${var}[i][k] = 0;\n";
                $outtext .= $indent . "}\n";
            }
            else {
                $outtext .= $indent;
                $outtext .= sprintf("i${var}_sum[i] = 0;\n");
            }
        } else {
            my $indent .= q{ } x 16;
            if ($ne > 1) {
                $outtext .= $indent . "for (k = 0; k < $ne; k++) {\n";
                $outtext .= $indent . "    i${var}[k] = 0;\n";
                $outtext .= $indent . "}\n";
            }
            else {
                $outtext .= $indent . "i${var} = 0;\n";
            }
        }
        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_founpackclear {
    my $io = 'FOSET';

    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;

        if ($io eq 'FOSET') {
            my $indent  = q{ } x 12;

            if ($ne > 1) {
                $outtext .= $indent . "for (k = 0; k < $ne; k++) {\n";
                $outtext .= $indent . "    i${var}[i][k] = 0;\n";
                $outtext .= $indent . "}\n";
            }
            else {
                $outtext .= $indent;
                $outtext .= "i${var}[i] = 0;\n";
            }
        }
        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_ioaccum {
    my ($io) = @_;

    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;

        if ($io eq 'FOSET') {
            my $indent .= q{ } x 12;
            if ($ne > 1) {
                $outtext .= $indent . "for (k = 0; k < $ne; k++) {\n";
                $outtext .= $indent . "    i${var}_sum[i][k] += i${var}[i][k];\n",
                $outtext .= $indent . "}\n";
            }
            else {
                $outtext .= $indent;
                $outtext .= sprintf("i${var}_sum[i] += i${var}[i];\n");
            }
        }
        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_ioaccum_conv {
    my ($io) = @_;

    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;

        if ($io eq 'FOSET') {
            my $indent .= q{ } x 12;
            if ($ne > 1) {
                $outtext .= $indent . "for (k = 0; k < $ne; k++) {\n";
                $outtext .= $indent . "    ${var}[i][k] += convert_${var}(ic, i${var}[i][k]);\n",
                $outtext .= $indent . "}\n";
            }
            else {
                $outtext .= $indent;
                $outtext .= sprintf("${var}[i] += convert_${var}(ic, i${var}[i]);;\n");
            }
        }
        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_coeffpack {
    my $io = 'COEFFSET';
    my $indent = q{ } x 4;

    # process each $slicewidth (width of IP bus or smaller) slice of a variable.
    #
    my $do = sub {
        my ($args)     = @_;
        my $adr        = $args->{adr};
        my $var        = $args->{var};
        my $ne         = $args->{ne};
        my $index      = $args->{index};
        my $width      = $args->{width};
        my $pdoff      = $args->{pdoff};
        my $sigoff     = $args->{signaloff};
        my $slicewidth = $args->{slicewidth};
        my $nvar       = $args->{nsignal};
        my $islast     = $args->{islast};

        my $outtext    = q{};
        my $bufwidth = 24;
        my $bufoff = $pdoff % $bufwidth;
        my $varoff0 = my $varoff = $sigoff;
        my $assign   = q{};

        # process each $maskwidth ($bufwidth or smaller) fraction of the slice.
        #
        while ($varoff - $varoff0 < $slicewidth) {
            if ($bufoff == 0) {
                $assign   = " =";
		$outtext .= $indent . "nword = 0;\n";
		$outtext .= $indent . "Rbuf[devid][nword++] = Coeffaddr[devid];\n";
            }
            else {
                $assign   = "|=";
            }

            my $maskwidth = $bufwidth - $bufoff;
            if ($varoff - $varoff0 + $maskwidth > $slicewidth) {
                $maskwidth = $slicewidth - ($varoff - $varoff0);
            }
            my $mask = sprintf("0x%08lx", (1 << $maskwidth) - 1);
            $mask = $maskwidth < 32 ? $mask : '0xffffffff'; # perl does not support bit shift more than 31-bit.

            my $ivar = 'i' . $var . ($ne > 1 ? "\[$index\]" : q{});
            my $bufoffshift = q{};
            my $varoffshift = q{};
            if ($bufoff > 0) {
                $bufoffshift = "<< $bufoff";
            }
            if ($varoff == 0) {
                $outtext .= "\n";
                $outtext .= $indent . "// $ivar\n";
            }
            else {
                $varoffshift = " >> $varoff";
            }
            my $cmttext = sprintf(" // ${ivar}[%d..%d]", $maskwidth + $varoff - 1, $varoff);

            $outtext .= $indent;
            $outtext .= "Rbuf[devid][nword] ";
            $outtext .= $assign;
            $outtext .= " ($mask & ($ivar$varoffshift))$bufoffshift;";
            $outtext .= $cmttext . "\n";

            $varoff += $maskwidth;
            $bufoff += $maskwidth;
            $bufoff %= $bufwidth;
            if (($islast && ($varoff - $varoff0 >= $slicewidth)) || $bufoff == 0) {
	        $outtext .= $indent . "Rbuf[devid][nword] |= (${adr} << 24); // address ${adr}\n";
	        $outtext .= $indent . "PAD_DUMMY_DATA(nword);\n";
		$outtext .= $indent . "hib_sendMC(devid, (nword+1)/2, (UINT64*)Rbuf[devid]);\n\n";
            }
        }
        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_jppack {
    my $io = 'JPSET';
    my $indent = q{ } x 12;

    # process each variable.
    #
    my $do = sub {
        my ($args)     = @_;
        my $var        = $args->{var};
        my $ne         = $args->{ne};
        my $index      = $args->{index};
        my $width      = $args->{width};
        my $pjoff      = $args->{pjoff};
        my $nvar       = $args->{nsignal};
        my $islast     = $args->{islast};

        my $bufwidth = 32;
        my $bufoff   = $pjoff % $bufwidth;
        my $varoff   = 0;
        my $outtext  = q{};
        my $assign   = q{};

        # process each $maskwidth ($bufwidth or smaller) slice of the variable
        #
        while ($varoff < $width) {
            if ($bufoff == 0) {
                $assign   = " =";
            }
            else {
                $assign   = "|=";
            }

            my $maskwidth = $bufwidth - $bufoff;
            if ($varoff + $maskwidth > $width) {
                $maskwidth = $width - $varoff;
            }
            my $mask = sprintf("0x%08lx", (1 << $maskwidth) - 1);
            $mask = $maskwidth < 32 ? $mask : '0xffffffff'; # perl does not support bit shift more than 31-bit.

            my $ivar = 'i' . $var . ($ne > 1 ? "\[$index\]" : q{});
            my $bufoffshift = q{};
            my $varoffshift = q{};
            if ($bufoff > 0) {
                $bufoffshift = "<< $bufoff";
            }
            if ($varoff == 0) {
                $outtext .= "\n";
                $outtext .= $indent . "// $ivar\n";
            }
            else {
                $varoffshift = " >> $varoff";
            }
            my $cmttext = sprintf(" // ${ivar}[%d..%d]", $maskwidth + $varoff - 1, $varoff);

            $outtext .= $indent;
            $outtext .= 'Rbuf[devid][nword] ';
            $outtext .= $assign;
            $outtext .= " ($mask & ($ivar$varoffshift))$bufoffshift;";
            $outtext .= $cmttext;
            $outtext .= "\n";

#            $outtext .= " // bufoff:$bufoff    maskwidth:$maskwidth\n";

            $varoff += $maskwidth;
            $bufoff += $maskwidth;
            $bufoff %= $bufwidth;
            if ($islast && $varoff >= $width) {
		$outtext .= $indent . "nword = nword0 + 2 * Jpsize[devid];\n";
            }
            elsif ($bufoff == 0) {
                $outtext .= $indent . "nword++;\n";
            }
        }
        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_ippack {
    my $io = 'IPSET';
    my $indent = q{ } x 8;

    # process each $slicewidth (width of IP bus or smaller) slice of a variable.
    #
    my $do = sub {
        my ($args)     = @_;
        my $var        = $args->{var};
        my $ne         = $args->{ne};
        my $index      = $args->{index};
        my $width      = $args->{width};
        my $pdoff      = $args->{pdoff};
        my $sigoff     = $args->{signaloff};
        my $slicewidth = $args->{slicewidth};
        my $nvar       = $args->{nsignal};
        my $islast     = $args->{islast};

        my $outtext    = q{};
        my $bufwidth = 32;
        my $bufoff = $pdoff % $bufwidth;
        my $varoff0 = my $varoff = $sigoff;
        my $assign   = q{};

        # process each $maskwidth ($bufwidth or smaller) fraction of the slice.
        #
        while ($varoff - $varoff0 < $slicewidth) {
            if ($bufoff == 0) {
                $assign   = " =";
            }
            else {
                $assign   = "|=";
            }

            my $maskwidth = $bufwidth - $bufoff;
            if ($varoff - $varoff0 + $maskwidth > $slicewidth) {
                $maskwidth = $slicewidth - ($varoff - $varoff0);
            }
            my $mask = sprintf("0x%08lx", (1 << $maskwidth) - 1);
            $mask = $maskwidth < 32 ? $mask : '0xffffffff'; # perl does not support bit shift more than 31-bit.

            my $ivar = 'i' . $var . ($ne > 1 ? "\[$index\]" : q{});
            my $bufoffshift = q{};
            my $varoffshift = q{};
            if ($bufoff > 0) {
                $bufoffshift = "<< $bufoff";
            }
            if ($varoff == 0) {
                $outtext .= "\n";
                $outtext .= $indent . "// $ivar\n";
            }
            else {
                $varoffshift = " >> $varoff";
            }
            my $cmttext = sprintf(" // ${ivar}[%d..%d]", $maskwidth + $varoff - 1, $varoff);

            $outtext .= $indent;
            $outtext .= 'Rbuf[devid][nword] ';
            $outtext .= $assign;
            $outtext .= " ($mask & ($ivar$varoffshift))$bufoffshift;";
            $outtext .= $cmttext;
            $outtext .= "\n";

            $varoff += $maskwidth;
            $bufoff += $maskwidth;
            $bufoff %= $bufwidth;
            if ($islast && ($varoff - $varoff0 >= $slicewidth)) {
		$outtext .= $indent . "nword = nword0 + 2 * Ipsize[devid];\n";
            }
            elsif ($bufoff == 0) {
                $outtext .= $indent . "nword++;\n";
            }
        }
        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_founpack {
    my $io = 'FOSET';
    my $indent = q{ } x 8;


    # process each $slicewidth (width of FO bus or smaller) slice of a variable.
    #
    my $do = sub {
        my ($args)     = @_;
        my $var        = $args->{var};
        my $ne         = $args->{ne};
        my $index      = $args->{index};
        my $width      = $args->{width};
        my $pdoff      = $args->{pdoff};
        my $sigoff     = $args->{signaloff};
        my $buswidth   = $args->{buswidth};
        my $slicewidth = $args->{slicewidth};
        my $nvar       = $args->{nsignal};
        my $islast     = $args->{islast};

        my $outtext    = q{};
        my $bufwidth = 32;
        my $bufoff = $pdoff % $bufwidth;
        my $varoff0 = my $varoff = $sigoff;
        my $assign   = q{};

        # process each $maskwidth ($bufwidth or smaller) fraction of the slice.
        #
        while ($varoff - $varoff0 < $slicewidth) {
            my $maskwidth = $bufwidth - $bufoff;
            if ($varoff - $varoff0 + $maskwidth > $slicewidth) {
                $maskwidth = $slicewidth - ($varoff - $varoff0);
            }
            my $mask = sprintf("0x%08lx", (1 << $maskwidth) - 1);
            $mask = $maskwidth < 32 ? "$mask & ": q{};

            my $ivar = 'i' . $var . '[i]' . ($ne > 1 ? "\[$index\]" : q{});
            my $bufoffshift = q{};
            my $varoffshift = q{};
            if ($bufoff > 0) {
                $bufoffshift = " >> $bufoff";
            }
            if ($varoff == 0) {
                $outtext .= "\n";
                $outtext .= $indent . "// $ivar\n";
                $assign   = "  =";
            }
            else {
                $varoffshift = " << $varoff";
                $assign   = " |=";
            }
            my $cmttext = sprintf(" // ${ivar}[%d..%d]", $maskwidth + $varoff - 1, $varoff);
            $cmttext .=  "  nvar:$nvar";

            $outtext .= $indent;
            $outtext .= $ivar;
            $outtext .= $assign;
            $outtext .= ' (UINT64)';
            $outtext .= "(${mask}(Wbuf[devid][nword]$bufoffshift))$varoffshift;";
            $outtext .= $cmttext;
            $outtext .= "\n";

            $varoff += $maskwidth;
            $bufoff += $maskwidth;
            $bufoff %= $bufwidth;
            if ($islast && ($varoff - $varoff0 >= $slicewidth)) {
		$outtext .= $indent . "nword = nword0 + 2 * Fosize[devid];\n";
            }
            elsif ($bufoff == 0) {
                $outtext .= $indent . "nword++;\n";
            }
        }
        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 _found_eta {
    my $found = 0;
    my $coeffs = pg2_get_parameter('COEFFSET');
    if (defined $coeffs && @{$coeffs} == 1) {
        # look for 'eta'
        my ($etaparam) = grep {$_->[0] eq 'eta'} @{$coeffs};
        if (!defined $etaparam) {
            return $found;
        }
        my ($var, $ctype, $ne) = @{$etaparam};
        $ne =~ s/.*\[(\d+)\]/$1/; # number of elements
        if ($ne != 1 || $ctype ne 'double') {
            return $found;
        }
        $found = 1;
    }
    return $found;
}

sub _found_xmj {
    my $found = 0;
    my $jps = pg2_get_parameter('JPSET');
    if (defined $jps && @{$jps} == 2) {
        # look for 'xj'
        my ($xjparam) = grep {$_->[0] eq 'xj'} @{$jps};
        if (!defined $xjparam) {
            return $found;
        }
        my ($xjvar, $xjctype, $xjne) = @{$xjparam};
        $xjne =~ s/.*\[(\d+)\]/$1/;
        if ($xjne != 3 || $xjctype ne 'double') {
            return $found;
        }

        # look for 'mj'
        my ($mjparam) = grep {$_->[0] eq 'mj'} @{$jps};
        if (!defined $mjparam) {
            return $found;
        }
        my ($mjvar, $mjctype, $mjne) = @{$mjparam};
        $mjne =~ s/.*\[(\d+)\]/$1/;
        if ($mjne != 1 || $mjctype ne 'double') {
            return $found;
        }

        $found = 1;
    }
    return $found;
}

sub _found_xi {
    my $found = 0;

    if (! _found_eps2()) {
        return $found;
    }

    my $ips = pg2_get_parameter('IPSET');
    if (defined $ips && @{$ips} == 2) {
        # look for 'xi'
        my ($xiparam) = grep {$_->[0] eq 'xi'} @{$ips};
        if (!defined $xiparam) {
            return $found;
        }
        my ($xivar, $xictype, $xine) = @{$xiparam};
        $xine =~ s/.*\[(\d+)\]/$1/;
        if ($xine != 3 || $xictype ne 'double') {
            return $found;
        }
        $found = 1;
    }
    return $found;
}

sub _found_eps2 {
    my $found = 0;
    my $ips = pg2_get_parameter('IPSET');
    if (defined $ips && @{$ips} == 2) {
        # look for 'eps2'
        my ($eps2param) = grep {$_->[0] eq 'eps2'} @{$ips};
        if (!defined $eps2param) {
            return $found;
        }
        my ($eps2var, $eps2ctype, $eps2ne) = @{$eps2param};
        $eps2ne =~ s/.*\[(\d+)\]/$1/;
        if ($eps2ne != 1 || $eps2ctype ne 'double') {
            return $found;
        }
        $found = 1;
    }
    return $found;
}

sub _found_a {
    my $found = 0;
    my $fos = pg2_get_parameter('FOSET');
    if (defined $fos && (@{$fos} == 1 || @{$fos} == 2)) {
        # look for 'a'
        my ($aparam) = grep {$_->[0] eq 'a'} @{$fos};
        if (!defined $aparam) {
            return $found;
        }
        my ($avar, $actype, $ane) = @{$aparam};
        $ane =~ s/.*\[(\d+)\]/$1/;
        if ($ane != 3 || $actype ne 'double') {
            return $found;
        }
        $found = 1;
    }
    return $found;
}

sub _found_p {
    my $found = 0;
    my $fos = pg2_get_parameter('FOSET');
    if (defined $fos && @{$fos} == 2) {
        # look for 'p'
        my ($pparam) = grep {$_->[0] eq 'p'} @{$fos};
        if (!defined $pparam) {
            return $found;
        }
        my ($pvar, $pctype, $pne) = @{$pparam};
        $pne =~ s/.*\[(\d+)\]/$1/;
        if ($pne != 1 || $pctype ne 'double') {
            return $found;
        }
        $found = 1;
    }
    return $found;
}

sub _generate_old_api_prototype {
    my $outtext = q{};
    my $indent = q{ } x 4;

    # generate 'set_eta' prototype if found 'eta'.
    if (_found_eta()) {
        $outtext .= $indent;
        $outtext .= "void   ${Prefix}_set_eta(double eta);\n";
        $outtext .= $indent;
        $outtext .= "void   ${Prefix}_set_etaMC(int devid, double eta);\n";
    }

    # generate 'set_xmj' prototype if found 'xj' & 'mj'.
    if (_found_xmj()) {
        $outtext .= $indent;
        $outtext .= "void   ${Prefix}_set_xmj(int adr, int nj, double (*xj)[3], double *mj);\n";
        $outtext .= $indent;
        $outtext .= "void   ${Prefix}_set_xmjMC(int devid, int adr, int nj, double (*xj)[3], double *mj);\n";
    }

    # generate 'set_xi' prototype if found 'xi'.
    if (_found_xi()) {
        $outtext .= $indent;
        $outtext .= "void   ${Prefix}_set_xi(int ni, double (*xi)[3]);\n";
        $outtext .= $indent;
        $outtext .= "void   ${Prefix}_set_xiMC(int devid, int ni, double (*xi)[3]);\n";
    }

    # generate 'get_force' prototype if found 'a'.
    # note that the prototype is generated even if 'p' may not exist.
    if (_found_a()) {
        $outtext .= $indent;
        $outtext .= "void   ${Prefix}_get_force(int ni, double (*a)[3], double *p);\n";
        $outtext .= $indent;
        $outtext .= "void   ${Prefix}_get_forceMC(int devid, int ni, double (*a)[3], double *p);\n";
    }

    # generate 'set_eps/eps2/eps_to_all/eps2_to_all' prototype if found 'eps2'.
    if (_found_eps2()) {
        $outtext .= $indent;
        $outtext .= "void   ${Prefix}_set_eps(int ni, double *eps);\n";
        $outtext .= $indent;
        $outtext .= "void   ${Prefix}_set_epsMC(int devid, int ni, double *eps);\n";

        $outtext .= $indent;
        $outtext .= "void   ${Prefix}_set_eps2(int ni, double *eps2);\n";
        $outtext .= $indent;
        $outtext .= "void   ${Prefix}_set_eps2MC(int devid, int ni, double *eps2);\n";

        $outtext .= $indent;
        $outtext .= "void   ${Prefix}_set_eps_to_all(double eps);\n";
        $outtext .= $indent;
        $outtext .= "void   ${Prefix}_set_eps_to_allMC(int devid, double eps);\n";

        $outtext .= $indent;
        $outtext .= "void   ${Prefix}_set_eps2_to_all(double eps2);\n";
        $outtext .= $indent;
        $outtext .= "void   ${Prefix}_set_eps2_to_allMC(int devid, double eps2);\n";

    }

    # generate 'calculate_force_on_x' prototype if found 'xi', 'a'.
    if (_found_xi() && _found_a()) {
        $outtext .= $indent;
        $outtext .= "void   ${Prefix}_calculate_force_on_x(double (*xi)[3], double (*a)[3], double *p, int ni);\n";
    }

    if ($outtext) {
        $outtext = "    // for backward compatibility\n" . $outtext;
    }
    return $outtext;
}

sub _generate_old_api_definition {
    my ($intext) = @_; # $intext contains entire pgutil.template.c file.
    my $indent = q{ } x 4;
    my $outtext = $intext;
    my $match = 0;

    if (_found_p()) {
        $outtext =~ s/<OLD_API_P>/, p/g;
        $match = 1;
    }
    else {
        $outtext =~ s/<OLD_API_P>//g;
    }

    if (_found_eta()) {
        $outtext =~ s{<OLD_API_FOUND_ETA>\s*?\n(.*?)</OLD_API_FOUND_ETA>\s*?\n}{$1}xmsg;
        $match = 1;
    }
    else {
        $outtext =~ s{<OLD_API_FOUND_ETA>\s*?\n(.*?)</OLD_API_FOUND_ETA>\s*?\n}{}xmsg;
    }

    if (_found_xmj()) {
        $outtext =~ s{<OLD_API_FOUND_XMJ>\s*?\n(.*?)</OLD_API_FOUND_XMJ>\s*?\n}{$1}xmsg;
        $match = 1;
    }
    else {
        $outtext =~ s{<OLD_API_FOUND_XMJ>\s*?\n(.*?)</OLD_API_FOUND_XMJ>\s*?\n}{}xmsg;
    }

    if (_found_eps2()) {
        $outtext =~ s{<OLD_API_FOUND_EPS2>\s*?\n(.*?)</OLD_API_FOUND_EPS2>\s*?\n}{$1}xmsg;
        $match = 1;
    }
    else {
        $outtext =~ s{<OLD_API_FOUND_EPS2>\s*?\n(.*?)</OLD_API_FOUND_EPS2>\s*?\n}{}xmsg;
    }

    if (_found_a()) {
        $outtext =~ s{<OLD_API_FOUND_A>\s*?\n(.*?)</OLD_API_FOUND_A>\s*?\n}{$1}xmsg;
        $match = 1;
    }
    else {
        $outtext =~ s{<OLD_API_FOUND_A>\s*?\n(.*?)</OLD_API_FOUND_A>\s*?\n}{}xmsg;
    }
    if (_found_eps2() && _found_a()) {
        $outtext =~ s{<OLD_API_FOUND_EPS2_A>\s*?\n(.*?)</OLD_API_FOUND_EPS2_A>\s*?\n}{$1}xmsg;
        $match = 1;
    }
    else {
        $outtext =~ s{<OLD_API_FOUND_EPS2_A>\s*?\n(.*?)</OLD_API_FOUND_EPS2_A>\s*?\n}{}xmsg;
    }

    if ($match) {
        $outtext =~ s{<OLD_API_EXISTS>\s*\n(.*?)</OLD_API_EXISTS>\s*\n}{$1}xmsg;
    }
    else {
        $outtext =~ s{<OLD_API_EXISTS>\s*\n(.*?)</OLD_API_EXISTS>\s*\n}{}xmsg;
    }

    return $outtext;
}

sub _calculate_jpsize {
    my $io = 'JPSET';
    my $return = sub {
        my ($args)   = @_;
        my $pjoff    = $args->{pjoff};

#        my $buswidth = $args->{buswidth};
#        $pjoff = (floor(($pjoff - 1) / $buswidth) + 1) * $buswidth;

        return $pjoff;
    };
    my $jpsize = pg2_foreach_ioport_of_type($io, sub { q{} }, $return);

    return $jpsize;
}

sub _calculate_ipsize {
    my $io = 'IPSET';
    my $return = sub {
        my ($args)   = @_;
        my $adr      = $args->{adr};
        my $buswidth = $args->{buswidth};

        return ($adr + 1) * $buswidth;
    };
    my $ipsize = pg2_foreach_ioport_of_type($io, sub { q{} }, $return);

    return $ipsize;
}

sub _calculate_fosize {
    my $io = 'FOSET';

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

        return ($adr + 1) * $buswidth;
    };

    my $fosize = pg2_foreach_ioport_of_type($io, sub { q{} }, $return);

    return $fosize;
}

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

    # set prefix.
    $Prefix = pg2_get_parameter('PREFIX');
    $Prefix =~ s/\"//g;

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

    # set library name.
    $Libname = $Prefix . 'util';
    $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 the number of real pipelines.
    my $npipe = pg2_get_parameter('NPIPE');
    $outtext =~ s/<NPIPE>/$npipe/g;

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

    $outtext =~ s{ <JPSIZE> }{ (floor((_calculate_jpsize() - 1) / 64)) + 1 }egx;
    $outtext =~ s{ <IPSIZE> }{ (floor((_calculate_ipsize() - 1) / 64)) + 1 }egx;
    $outtext =~ s{ <FOSIZE> }{ (floor((_calculate_fosize() - 1) / 64)) + 1 }egx;

    $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') }egx;
    $outtext =~ s{ <JPCONV> }{ _generate_ioconv('JPSET', '[jsent]', 16) }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{ <JPCLEAR> }{ _generate_ioclear('JPSET') }egx;
    $outtext =~ s{ <JPPACK> }{ _generate_jppack() }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') }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{ <IPCLEAR> }{ _generate_ioclear('IPSET') }egx;
    $outtext =~ s{ <IPPACK> }{ _generate_ippack() }egx;

    $outtext =~ s{ <FOARGS> }{ pgdlutil::_generate_ioargs('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', 0) }egx;
    $outtext =~ s{ <FOVARS_MC> }{ _generate_iovars('FOSET', 1) }egx;
    $outtext =~ s{ <FOCONV> }{ _generate_ioconv('FOSET', '[i]', 8) }egx;
    $outtext =~ s{ <FOCONV_MC> }{ _generate_ioconv('FOSET', '[i]', 8, 1) }egx;
    $outtext =~ s{ <FOCONV_PROTOTYPE> }{ pgdlutil::_generate_ioconv_prototype('FOSET') }egx;
    $outtext =~ s{ <FOCONV_DEFINITION> }{ pgdlutil::_generate_ioconv_definition('FOSET') }egx;
    $outtext =~ s{ <FOCLEAR> }{ _generate_ioclear('FOSET') }egx;
    $outtext =~ s{ <FOACCUM> }{ _generate_ioaccum('FOSET') }egx;
    $outtext =~ s{ <FOACCUM_CONV> }{ _generate_ioaccum_conv('FOSET') }egx;
    $outtext =~ s{ <FOUNPACKARGS> }{ _generate_founpackargs() }egx;
    $outtext =~ s{ <FOUNPACKCLEAR> }{ _generate_founpackclear() }egx;
    $outtext =~ s{ <FOUNPACK> }{ _generate_founpack() }egx;
    $outtext =~ s{ <FORANGE_PROTOTYPE> }{ pgdlutil::_generate_iorange_prototype('FOSET') }egx;
    $outtext =~ s{ <FORANGE_DEFINITION> }{ _generate_iorange_definition('FOSET') }egx;

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

    return $outtext;
}

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

sub _generate_c {
    my $fnamebase = 'pgutil';
    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 = 'pgutil';
    my $intext = pg2_read_template($fnamebase, 'makefile');
    my $outtext = $intext;
    $outtext = _substitute_tags_in_a_file($outtext);
    pg2_write_file('Makefile', $outtext);
}
