#!/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 $Is_pgdl2sim = 0; # this program behave as 0:pgdl2vhdl / 1:pgdl2sim.
my $Infile          = undef;
my $Intext          = undef;
my $Typedef         = '';
my %Module          = ();
my %Signal          = ();
my $Ninstance       = 0;
my $Archinfo        = undef;
my $Additionallogic = '';

my $Vecfile         = undef;

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

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

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

    # generate .vhd files
    #
    if ($Is_pgdl2sim) {
        if (defined $Vecfile) {
            _generate_pg_sim_testvector();
        }
        else {
            _generate_pg_sim();
            _generate_pg_modules();
            _generate_pg_sim_random_testvector(); # generate .tbl for random input.
        }
    }
    else {
        _generate_pg_pipe();
        _generate_pg_proc();
        _generate_pg_ifbuf();
        _generate_pg_scfifo();
        _generate_pg_dcfifo();
        _generate_pg_ctl();
        _generate_pg_dpram();
        _generate_pg_modules();
        _generate_hostinterface();
    }
}

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

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

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

sub _parse_commandline_arguments {
    my @argv = @_;
    my $cmdname = undef;

    if (! defined $cmdname) {
        $cmdname = $0;
        $cmdname =~ s/.+\/(.+)/$1/g;
        $Is_pgdl2sim = ($cmdname eq 'pgdl2sim') ? 1 : 0;
    }

  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 {
            if ($Is_pgdl2sim) { # pgdl2sim
                die "generate sim for a pipeline logic described in a .pgdl file.\n"
                  . "the sim is for functional simulations on QuartusII.\n"
                  . "input is taken from stdin if no file name is given.\n"
                  . "  usage: $cmdname "
                  . '[-d|-h|-v|-t] [pgdl-file]' . "\n"
                  . "    -d: output messages for debugging purpose.\n"
                  . "    -h: print this mesage.\n"
                  . "    -t <vecfile>: generate .tbl taking input vectors from 'vecfile'.\n"
                  . "       .vhd files are neither generated nor overwritten.\n"
                  . "    -v: be verbose.\n";
            }
            else { # pgdl2vhdl
                die "generate a pipeline logic 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;
        };

        /-t/     and do {
            $Vecfile = shift @argv;
            die "specify an input-vector file.\n" if (!defined $Vecfile);
            die "cannot open an input-vector file '$Vecfile'.\n" if (! -r $Vecfile);
            next;
        };

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

# 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, $c, $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;
                }
            }

            # create component declaration
            if ($e_a =~ /entity .*? is (.*? end) .*;/sxi) {
                $c = 'component <$mname>' . $1 . ' component;';
            } else {
                croak "no 'entity' statement found in $name.template.vhd.\n" .
                  '$1: ' . $1 . "\n";
            }
            $c =~ s/^/    /gm;

            &{'_generate_' . $name}($name, $c, $e_a, \@ports, \@generics, $args);
        }
    }
}

# generate a VHDL file 'pg_pipe.vhd'.
#
sub _generate_pg_pipe {
    my $fnamebase = 'pg_pipe';
    my $intext = pg2_read_template($fnamebase);
    my $outtext = q{};

    while ($intext) {

        if ($intext =~ /<DELAY>/) {
            $intext = $';
            $outtext .= $`;
            $outtext .= pg2_get_parameter('DELAY');
        }
        elsif ($intext =~ /<DATAO>/) {
            $intext = $';
            $outtext .= $`;
            my $npipe = pg2_get_parameter('NPIPE');
            for my $i (0 .. $npipe - 1) {
                $outtext .= sprintf('        datao(64 * %2d - 1 downto 64 * %2d) ' .
                                    'when conv_std_logic_vector(%2d, 8),' . "\n",
                                    $i + 1, $i, $i);
            }
        }
        elsif ($intext =~ /<TYPEDEF>/) {
            $intext = $';
            $outtext .= $`;
            $outtext .= $Typedef;
        }
        elsif ($intext =~ /<COMPONENT>/) {
            $intext = $';
            $outtext .= $`;
            for my $m (values %Module) {
                $outtext .= $m->{component} . "\n\n";
            }
        }
        elsif ($intext =~ /<SIGNAL>/) {
            $intext = $';
            $outtext .= $`;
            for my $signal (sort {$a->{name} cmp $b->{name}} values %Signal) {
                next if $signal->{name} =~ /^\"\d+\"$/; # skip literal NUMBER
                if ($signal->{width} > 0) {
                    $outtext .= sprintf("    signal %-20s : %s(%d downto 0);\n",
                                        $signal->{name}, $signal->{type}, $signal->{width} - 1);
                }
                else {
                    $outtext .= sprintf("    signal %-20s : %s;\n",
                                        $signal->{name}, $signal->{type});
                }
            }
        }
        elsif ($intext =~ /<CID>/) {
            $intext = $';
            $outtext .= $`;

            my $use_fixed = pg2_get_parameter('USE_FIXED_CHIPID');
            if ($use_fixed) {
                my $chipid = pg2_get_parameter('CHIPID');
                $outtext .= "conv_std_logic_vector($chipid, 3); -- use a constant number '$chipid' as chip id.";
            }
            else {
                $outtext .= q{p_cid; -- use external input pin 'p_cid' as chip id.};
            }
        }
        elsif ($intext =~ /<JPSET>/) {
            $intext = $';
            $outtext .= $`;
            $outtext .= _generate_pg_pipe_jpset();
        }
        elsif ($intext =~ /<IPSET>/) {
            $intext = $';
            $outtext .= $`;
            $outtext .= _generate_pg_pipe_ipset();
        }
        elsif ($intext =~ /<COEFFSET>/) {
            $intext = $';
            $outtext .= $`;
            $outtext .= _generate_pg_pipe_coeffset();
        }
        elsif ($intext =~ /<INSTANCE>/) {
            $intext = $';
            $outtext .= $`;
            my @ilist = ();
            for my $module (values %Module) {
                for (@{$module->{instances}}) {
                    push @ilist, $_;
                }
            }
            for (sort @ilist) {
                $outtext .= $_ . "\n";
            }
        }
        elsif ($intext =~ /<FOUT>/) {
            $intext = $';
            $outtext .= $`;
            $outtext .= _generate_pg_pipe_foset();
        }
        elsif ($intext =~ /<ADDITIONALLOGIC>/) {
            $intext = $';
            $outtext .= $`;
            $outtext .= $Additionallogic;
        }
        else {
            $outtext .= $intext;
            $intext = '';
        }
    }
    pg2_write_file($fnamebase . '.vhd', $outtext);
}

sub _generate_pg_pipe_jpset {
    my $io = 'JPSET';

    my $do = sub {
        my ($args) = @_;
        my $var    = $args->{var};
        my $ne     = $args->{ne};
        my $index  = $args->{index};
        my $pjoff  = $args->{pjoff};
        my $width  = $args->{width};

        my $tmptxt = sprintf("    ${var}%s(%d downto 0)",
                             $ne > 1 ? "_$index" : q{}, $width - 1);
        my $outtext = sprintf("%-25s <= p_jdata(%d downto %d);\n",
                           $tmptxt, $width + $pjoff - 1, $pjoff);
        return $outtext;
    };

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

#        $pjoff = (floor(($pjoff - 1) / 64.0) + 1) * 64;
        _print_jpin_diagnostics($pjoff);
        return $outtext;
    };

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

    return $outtext;
}

sub _print_jpin_diagnostics {
    my ($width) = @_;
    my $buswidth = 64;
    my $jwords = pg2_get_parameter('JMEMSIZE');
    my $jdepth = width_of($jwords - 1);

    _vprintf("jpin diagnostics\n");
    _vprintf("    data width    : %3d bit\n", $width);
    _vprintf("    address width : %3d bit (%4d word depth)\n", $jdepth, $jwords);
    _vprintf("\n");
}

sub _print_ipin_diagnostics {
    my ($adr) = @_;
    my $buswidth = 64;
    my $npipe = pg2_get_parameter('NPIPE');

    _vprintf("ipin diagnostics\n");
    _vprintf("    max address  : 0x%02x\n", $adr);
    _vprintf("    size/pieline : %4d byte\n", ($adr + 1) * $buswidth / 8);
    _vprintf("    size/chip    : %4d byte", ($adr + 1) * $buswidth / 8 * $npipe);
    _vprintf(" (%d pipes/chip)\n", $npipe);
    _vprintf("    size/card    : %4d byte", ($adr + 1) * $buswidth / 8 * $npipe);
    _vprintf(" (IPs are shared among all chips)\n");
    _vprintf("\n");
}

sub _print_fout_diagnostics {
    my ($adr) = @_;
    my $buswidth = 64;

    my $npipe = pg2_get_parameter('NPIPE');
    my $nsum = $Archinfo->{reduce_fout} ? 1 : $Archinfo->{nchip};

    _vprintf("fout diagnostics\n");
    _vprintf("    max address  : 0x%02x\n", $adr);
    _vprintf("    size/pieline : %4d byte\n", ($adr + 1) * $buswidth / 8);
    _vprintf("    size/chip    : %4d byte", ($adr + 1) * $buswidth / 8 * $npipe);
    _vprintf(" (%d pipes/chip)\n", $npipe);
    _vprintf("    size/card    : %4d byte", ($adr + 1) * $buswidth / 8 * $npipe * $nsum);
    _vprintf(" (%d chip/card, %s reduction)\n", $Archinfo->{nchip}, $Archinfo->{reduce_fout} ? 'do' : 'no');
    _vprintf("\n");
}

sub _print_coeff_diagnostics {
    my ($adr) = @_;
    my $buswidth = 24;

    my $npipe = pg2_get_parameter('NPIPE');

    _vprintf("cin diagnostics\n");
    _vprintf("    max address  : 0x%02x\n", $adr);
    _vprintf("    size/pieline : %4d byte\n", ($adr + 1) * $buswidth / 8);
    _vprintf("\n");
}

# generate a '[els]if (p_adr[io] = "$adr") then' statement,
#
sub _generate_pg_pipe_ioset_ifclause {
    my ($io, $adr) = @_;
    my $outtext = '';
    my $portname;
    my ($w, $addrmax);

    if ($io eq 'FOSET') {
        $w = $Archinfo->{fout_depth};
        $portname = 'p_adro';
    }
    elsif ($io eq 'COEFFSET') {
        $w = $Archinfo->{cin_depth};
        $portname = 'p_adri';
    }
    else {
        $w = $Archinfo->{ipin_depth};
        $portname = 'p_adri';
    }
    $addrmax = 2**$w;
    croak "too large $portname: $adr\n" if ($adr >= $addrmax);

    if ($io eq 'FOSET') {
        $outtext .= ' ' x 12;
        $outtext .= sprintf("%sif ($portname = \"%0" . $w . "b\") then\n",
                            ($adr == 0 ? "" : "els"), $adr);
    }
    elsif ($io eq 'COEFFSET') {
        $outtext .= ' ' x 16;
        $outtext .= sprintf("%sif ($portname = \"%0" . $w . "b\") then\n",
                            ($adr == 0 ? "" : "els"), $adr);
    }
    else {
        $outtext .= ' ' x 16;
        $outtext .= sprintf("%sif ($portname = \"%0" . $w . "b\") then\n",
                            ($adr == 0 ? "" : "els"), $adr);
    }
    return $outtext;
}

sub _generate_pg_pipe_ipset {
    my $io = 'IPSET';

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

        if ($pdoff % $buswidth == 0) {
            $outtext .= _generate_pg_pipe_ioset_ifclause($io, $adr);
        }
        if ($slicewidth == 1) { # special care for a variable with single-bit width.
            my $tmptxt = sprintf("${var}%s", $ne > 1 ? "_$index" : q{});
            $outtext .= sprintf("                    %-22s <= p_datai($pdoff);\n", $tmptxt);
        }
        else {
            my $tmptxt = sprintf("${var}%s(%d downto %d)",
                                 $ne > 1 ? "_$index" : q{},
                                 $sigoff + $slicewidth - 1, $sigoff);
            $outtext .= sprintf("                    " .
                                "%-22s <= p_datai(%d downto %d);\n",
                                $tmptxt, $pdoff + $slicewidth - 1, $pdoff);
        }
        return $outtext;
    };

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

        _print_ipin_diagnostics($adr);
        return $outtext;
    };

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

    return $outtext;
}

sub _generate_pg_pipe_foset {
    my $io = 'FOSET';

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

        if ($pdoff % $buswidth == 0) {
            $outtext .= _generate_pg_pipe_ioset_ifclause($io, $adr);
        }

        if ($slicewidth == 1) {
            my $tmptxt = sprintf("p_datao(%d)", $pdoff);
            $outtext .= sprintf("                %-22s <= %s;\n",
                                $tmptxt, $ne > 1 ? $var . '_' . $index : $var);
        }
        else {
            my $tmptxt = sprintf("p_datao(%d downto %d)",
                                 $pdoff + $slicewidth - 1, $pdoff);
            $outtext .= sprintf("                " .
                                "%-22s <= %s(%d downto %d);\n",
                                $tmptxt, $ne > 1 ? $var . '_' . $index : $var,
                                $sigoff + $slicewidth - 1, $sigoff);
        }

        return $outtext;
    };

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

        _print_fout_diagnostics($adr);
        return $outtext;
    };

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

    return $outtext;
}

sub _generate_pg_pipe_coeffset
{
    my $io = 'COEFFSET';

    # do not output anything if not cin parameter exists.
    return q{} if (! defined pg2_get_parameter($io));

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

        if ($pdoff % $buswidth == 0) {
            $outtext .= _generate_pg_pipe_ioset_ifclause($io, $adr);
        }
        if ($slicewidth == 1) {
            my $tmptxt = sprintf("%s",
                                 $ne > 1 ? $var . '_' . $index : $var);
            $outtext .= sprintf("                    %-22s <= p_datai(%d);\n",
                                $tmptxt, $pdoff);
        }
        else {
            my $tmptxt = sprintf("%s(%d downto %d)",
                                 $ne > 1 ? $var . '_' . $index : $var,
                                 $sigoff + $slicewidth - 1, $sigoff);
            $outtext .= sprintf("                    " .
                                "%-22s <= p_datai(%d downto %d);\n",
                                $tmptxt, $pdoff + $slicewidth - 1, $pdoff);
        }

        return $outtext;
    };

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

        _print_coeff_diagnostics($adr);
        return $outtext;
    };

    my $outtext = << 'END_COEFFSET0';
    -- CIN: 24-bit width x 8-bit depth
    process (pclk)
    begin
        if (pclk'event and pclk='1') then
            if (p_bcast ='1') then
END_COEFFSET0

    my $outtext1 = << 'END_COEFFSET1';
                end if;
            end if;
        end if;
    end process;
END_COEFFSET1

    $outtext .= pg2_foreach_ioport_of_type($io, $do, $return);
    $outtext .= $outtext1;

    return $outtext;
}

# Generate an instance of module $mname.
# Its port and generic parameters are given in $nodes_ref.
#
sub _instantiate_module {
    my ($mname, $nodes_ref) = @_;
    my $instance = '';

    my @ports    = grep {defined $_->{port}}    @$nodes_ref;
    my @generics = grep {defined $_->{generic}} @$nodes_ref;

    $instance .= sprintf("    u%03d : %s\n", $Ninstance++, $mname);

    if (@generics) {
        $instance .= sprintf("        generic map (");
        while (@generics) {
            my $node = shift @generics;
            $instance .= sprintf('%s => %s', $node->{generic}, $node->{name});
            if (@generics) {
                $instance .= ', ';
            }
        }
        $instance .= sprintf(")\n");
    }

    $instance .= sprintf("        port map (");
    while (@ports) {
        my $node = shift @ports;
	$instance .= sprintf('%s => %s', $node->{port}, $node->{name});
        if (@ports) {
          $instance .= ', ';
        }
    }
    $instance .= sprintf(");\n");
    return $instance;
}

sub _register_a_signal {
    my ($name, $w, $t) = @_;
    my $signal0 = $Signal{$name};

    if (!defined $t) {
      $t = 'std_logic_vector';
    }
    if (defined $signal0) {
        my $signal1 = {
            name  => $name . '(new)',
            width => $w,
            type => $t,
        };
        _signal_type_match_or_die($signal0, $signal1);
    }
    else {
        $Signal{$name} = {
            name  => $name,
            width => $w,
            type => $t,
        }
    }
}

sub _signal_type_match_or_die {
    my ($s0, $s1) = @_;
    my $buf;

    if (!defined($s0->{type}) ||  !defined($s1->{type})) {
        $buf = sprintf("signal %s of type %s, or %s of type %s: type not defined.\n",
                       $s0->{name}, $s0->{type}, $s1->{name}, $s1->{type});
        croak $buf;
    }
    elsif ($s0->{type}  ne $s1->{type}) {
        $buf = sprintf("signal %s of type %s, or %s of type %s: type mismatch.\n",
                       $s0->{name}, $s0->{type}, $s1->{name}, $s1->{type});
        croak $buf;
    }
    elsif ($s0->{width} != $s1->{width}) {
        $buf = sprintf("signal %s of width %d, or %s of width %d: different width.\n",
                       $s0->{name}, $s0->{width}, $s1->{name}, $s1->{width});
        croak $buf;
    }
    else {
        return 1;
    }
}

sub _generate_hostinterface {

    # generate hib logic by calling gwrap_init.
    my $archname = $Archinfo->{name};
    my $gwrappath =  $ENV{PGPG2PATH} . '/src/gwrap';
    my $cmd = "export GWRAPPATH=$gwrappath; gwrap_init f $archname pg_proc.vhd";
    system($cmd);

    return if ($archname !~ /g7p[126]/);

    # generate a dummy boardinfo file for Model300/600.
    #
    my $binfo = <<"END_BINFO";
0 0 0 0 0 0

a dummy boardinfo file
END_BINFO
    pg2_write_file('boardinfo', $binfo);
}

sub _generate_pg_proc {
    my $fnamebase = 'pg_proc';
    my $intext = pg2_read_template($fnamebase);
    my $outtext = '';

    my $jwords = pg2_get_parameter('JMEMSIZE');
    my $jdepth = width_of($jwords - 1);
    $intext =~ s/<JDATA_DEPTH>/$jdepth/g;

    my $jpwidth = _calculate_jpwidth();
    my $buswidth = 64;
    $jpwidth = (floor(($jpwidth - 1) / $buswidth) + 1) * $buswidth;
    $intext =~ s/<JDATA_WIDTH>/$jpwidth/g;

    my $jmemblocks = floor (($jpwidth - 1) / 64) + 1;
    $intext =~ s/<JMEM_BLOCKS>/$jmemblocks/g;

    my $productid = $Archinfo->{productid};
    if (!defined $productid) {
        $productid = 0;
    }
    $intext =~ s/<PRODUCTID>/$productid/g;

    my $modelid = $Archinfo->{modelid};
    if (!defined $modelid) {
        $modelid = 0;
    }
    $intext =~ s/<MODELID>/$modelid/g;

    my $backendid = $Archinfo->{backendid};
    if (!defined $backendid) {
        $backendid = 0;
    }
    $intext =~ s/<BACKENDID>/$backendid/g;

    my $npipes = pg2_get_parameter('NPIPE');
    $intext =~ s/<NPIPES>/$npipes/g;

    $outtext = $intext;

    pg2_write_file($fnamebase . '.vhd', $outtext);
}

sub _generate_pg_ifbuf {
    my $fnamebase = 'pg_ifbuf';
    my $intext = pg2_read_template($fnamebase);
    my $outtext = '';

    $outtext = $intext;
    pg2_write_file($fnamebase . '.vhd', $outtext);
}

sub _generate_pg_scfifo {
    my $fnamebase = 'pg_scfifo';
    my $intext = pg2_read_template($fnamebase);
    my $outtext = '';

    $outtext = $intext;
    pg2_write_file($fnamebase . '.vhd', $outtext);
}

sub _generate_pg_dcfifo {
    my $fnamebase = 'pg_dcfifo';
    my $intext = pg2_read_template($fnamebase);
    my $outtext = '';

    $outtext = $intext;
    pg2_write_file($fnamebase . '.vhd', $outtext);
}

sub _generate_pg_ctl {
    my $fnamebase = 'pg_ctl';
    my $intext = pg2_read_template($fnamebase);
    my $outtext = '';

    $outtext = $intext;
    pg2_write_file($fnamebase . '.vhd', $outtext);
}

sub _generate_pg_dpram {
    my $fnamebase = 'pg_dpram';
    my $intext = pg2_read_template($fnamebase);
    my $jwords = pg2_get_parameter('JMEMSIZE');
    my $jdepth = width_of($jwords - 1);
    my $outtext = '';

    $intext =~ s/<JWORDS>/$jwords/gi;
    $intext =~ s/<JDEPTH>/$jdepth/gi;
    $intext =~ s/<DEVICE>/\"$Archinfo->{device}\"/gi;

    $outtext = $intext;
    pg2_write_file($fnamebase . '.vhd', $outtext);
}

sub _generate_pg_modules {
    my $fnamebase = 'pg_module';
    my $intext = pg2_read_template($fnamebase);
    my $outtext = '';

    $outtext = $intext;
    for my $module (values %Module) {
      $outtext .= sprintf($module->{architecture} . "\n\n");
    }
    pg2_write_file($fnamebase . '.vhd', $outtext);
}

sub _generate_pg_sim {
    my $fnamebase = 'pg_sim';
    my $intext = pg2_read_template($fnamebase);
    my $outtext = '';

    while ($intext) {
        if ($intext =~ /<PORT>/) {
            $intext = $';
            $outtext .= $`;
            for my $signal (sort {$a->{name} cmp $b->{name}} values %Signal) {

                next if $signal->{name} =~ /^\"\d+\"$/; # skip literal NUMBER

                my $io = _has_io_attribute($signal->{name});
                my $ioname = $io > 0 ? 'in ' : 'out'; # pipeline-internal nodes are assigned to output ports.
                my $signalname = $io == 0 ? $signal->{name} . '_out' : $signal->{name};

                if ($signal->{width} > 0) {
                    $outtext .= sprintf("    %-20s : %3s %s(%d downto 0);\n",
                                        $signalname, $ioname, $signal->{type}, $signal->{width} - 1);
                } else {
                    $outtext .= sprintf("    %-20s : %3s %s;\n",
                                        $signalname, $ioname, $signal->{type});
                }
            }
            $outtext .= sprintf("    %-20s : in  std_logic_vector(%d downto 0);\n",
                                'run', pg2_get_parameter('DELAY'));
        } elsif ($intext =~ /<COMPONENT>/) {
            $intext = $';
            $outtext .= $`;
            for my $m (values %Module) {
                $outtext .= $m->{component} . "\n\n";
            }
        } elsif ($intext =~ /<SIGNAL>/) {
            $intext = $';
            $outtext .= $`;
            for my $signal (sort {$a->{name} cmp $b->{name}} values %Signal) {
                next if $signal->{name} =~ /^\"\d+\"$/; # skip literal NUMBER
                my $io = _has_io_attribute($signal->{name});
                next if $io != 0;

                if ($signal->{width} > 0) {
                    $outtext .= sprintf("    signal %-20s : %s(%d downto 0);\n",
                                        $signal->{name}, $signal->{type}, $signal->{width} - 1);
                } else {
                    $outtext .= sprintf("    signal %-20s : %s;\n",
                                        $signal->{name}, $signal->{type});
                }
            }
        } elsif ($intext =~ /<INSTANCE>/) {
            $intext = $';
            $outtext .= $`;
            my @ilist = ();

            # instantiate modules
            #
            for my $module (values %Module) {
                for (@{$module->{instances}}) {
                    push @ilist, $_;
                }
            }
            for (sort @ilist) {
                $outtext .= $_ . "\n";
            }

            # assign pipeline-internal nodes to output ports
            #
            for my $signal (sort {$a->{name} cmp $b->{name}} values %Signal) {
                next if $signal->{name} =~ /^\"\d+\"$/; # skip literal NUMBER
                my $io = _has_io_attribute($signal->{name});
                next if $io != 0;
                $outtext .= sprintf("    %-20s <= %s;\n",
                                    $signal->{name} . '_out', $signal->{name});
            }


        }
        else {
            $outtext .= $intext;
            $intext = '';
        }
    }
    pg2_write_file("$fnamebase.vhd", $outtext);
    pg2_write_file("$fnamebase.qpf", pg2_read_template($fnamebase, 'qpf'));
    pg2_write_file("$fnamebase.qsf", pg2_read_template($fnamebase, 'qsf'));
}

# 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 (\@coeffsignals, \@jpsignals, \@ipsignals, \@fosignals)
#   @XXsignals->[0]->{name}
#   @XXsignals->[0]->{width}
#
sub _get_io_signals {

    my @signals      = ();
    my @coeffsignals = ();
    my @jpsignals    = ();
    my @ipsignals    = ();
    my @fosignals    = ();

    # list of all variables
    for my $signal (sort {$a->{name} cmp $b->{name}} values %Signal) {
        next if $signal->{name} =~ /^\"\d+\"$/; # skip literal NUMBER
        next if ($signal->{width} <= 0);
        push @signals, $signal;
        my $io = _io_attribute_of($signal->{name});
    }

    for my $signal (@signals) {
        my $io = _io_attribute_of($signal->{name});
        next if ! defined $io;
        $signal->{io} = $io;

        for ($io) {
            /COEFFSET/ and do {
                push @coeffsignals, $signal;
                last;
            };

            /JPSET/ and do {
                push @jpsignals, $signal;
                last;
            };

            /IPSET/ and do {
                push @ipsignals, $signal;
                last;
            };

            /FOSET/ and do {
                push @fosignals, $signal;
                last;
            };
        }
    }
    return (\@coeffsignals, \@ipsignals, \@jpsignals, \@fosignals);
}

# calculate run[DELAY..0] from run[DELAY..0] of the previous clk cycle
# and current run[0].
#
sub _calculate_run_vector {
    my ($oldrun, $run0) = @_;
    my $delay = pg2_get_parameter('DELAY');

    my $newrun = $oldrun << 1;
    $newrun |= $run0;
    $newrun &= (1 << ($delay + 1)) - 1;
}

#
# 1) generate source codes of an emulator under /tmp using pgdl2emu.     eg) /tmp/{g6emu.c, g6util.h, Makefile}
# 2) compile the source to obtain an executable under /tmp.              eg) /tmp/g6pipe
# 3) execute the executable to obtain output vectors.
# 4) remove the emulator and its souce.
#
sub _generate_vectors {
    my $outtext = '';
    my $pipename = pg2_get_parameter('PREFIX') . 'pipe'; # name of pipeline emulator executable.
    my $tmpdir = '/tmp/pg2tmp';
    my $cmd = "/bin/mkdir $tmpdir; cd $tmpdir; (echo '$Intext' | pgdl2emu); make ";
    system($cmd);

    open(IN, "$tmpdir/$pipename 1 < $Vecfile | grep -v '#' | ")
      or croak "Cannot exec pipeline emulator '$pipename'.\n";

    my $pclk = 0;
    my $run = 0;
    my $pattern = q{};
    my $i = 0;

  PATTERN:
    while (1) {
        if (not $pclk) {
            $pattern = <IN>;
            last PATTERN if (! defined $pattern);

            # add delayed run signals
            $pattern =~ /(\d+) \s+ (.+$)/xms;
            my $run0 = $1;
            my $leftpattern = $2;
            $run = _calculate_run_vector($run, $run0);
            my $rundigits = floor pg2_get_parameter('DELAY') / 4 + 1;
            $pattern = sprintf(" %0" . $rundigits . "x %s", $run, $leftpattern);
        }
        my $time = $i * 5.0;
        $outtext .= sprintf("%7.1f> %d %s", $time, $pclk, $pattern);
        $pclk = not $pclk;
        $i++;
    }

    close IN;

# may be too dangerous to exec 'rm -rf'.
#    my $cmd = "/bin/rm -rf $tmpdir";
#    system($cmd);

    return $outtext;
}

sub _generate_pg_sim_testvector {
    my $fnamebase = 'pg_sim';
    my $intext = pg2_read_template($fnamebase, 'tbl');
    my $outtext = '';
    my ($coeffsignals, $jpsignals, $ipsignals, $fosignals) = _get_io_signals();
    my @signals = (@{$coeffsignals}, @{$jpsignals}, @{$ipsignals}, @{$fosignals});

    while ($intext) {
        if ($intext =~ /<GROUP>/) {
            $intext = $';
            $outtext .= $`;
            for my $signal (@signals) {

                next if $signal->{name} =~ /^\"\d+\"$/; # skip literal NUMBER
                next if ($signal->{width} <= 0);

                $outtext .= "GROUP CREATE $signal->{name} = ";
                for my $i (reverse 0 .. $signal->{width} - 1) {
                    $outtext .= "$signal->{name}" . "[$i] ";
                }
                $outtext .= ";\n\n" ;
            }

            $outtext .= "GROUP CREATE run = ";
            for my $i (reverse 0 .. pg2_get_parameter('DELAY')) {
                $outtext .= "run[$i] ";
            }
            $outtext .= ";" ;
            $outtext .= "\n\n" ;
        }
        elsif ($intext =~ /<IO>/) {
            $intext = $';
            $outtext .= $`;

            my $inports  = 'INPUTS pclk run ';
            my $outports = 'OUTPUTS ';

            for my $signal (@signals) {

                next if $signal->{name} =~ /^\"\d+\"$/; # skip literal NUMBER

                if ($signal->{io} =~ /COEFFSET | JPSET | IPSET/x) {
                    $inports .= "$signal->{name} ";
                }
                elsif ($signal->{io} eq 'FOSET') {
                    $outports .= "$signal->{name} ";
                }
            }
            $outtext .= "$inports;\n\n";
            $outtext .= "$outports;\n\n";
        }
        elsif ($intext =~ /<PATTERN>/) {
            $intext = $';
            $outtext .= $`;
            $outtext .= _generate_vectors();
        }
        else {
            $outtext .= $intext;
            $intext = '';
        }
    }
    pg2_write_file("$fnamebase.tbl", $outtext);
}

# generate random input-vectors and give them to
# _generate_pg_sim_testvector() to obtain 
# .tbl file containing both input/output-vectors.
#
sub _generate_pg_sim_random_testvector {
    my $run = 0;
    my ($coeffsignals, $jpsignals, $ipsignals, $fosignals) = _get_io_signals();
    my @signals = (@{$coeffsignals}, @{$jpsignals}, @{$ipsignals}, @{$fosignals});

    my $outtext = "# run ";
    for my $signal (@{$coeffsignals}, @{$jpsignals}, @{$ipsignals}) {
        my $digits = floor (($signal->{width} - 1) / 4) + 4;
        $outtext .= sprintf("%-" . $digits . "s", $signal->{name});
    }
    $outtext .= " = ";
    for my $signal (@{$fosignals}) {
        my $digits = floor (($signal->{width} - 1) / 4) + 4;
        $outtext .= sprintf("%-" . $digits . "s", $signal->{name});
    }
    $outtext .= "\n";
    for my $i (0 .. 100) { # generate input-vectors for 100 clk cycles.
        my $pattern = q{};
        $pattern .= sprintf("  %d   ", $run);
        for my $signal (@{$coeffsignals}, @{$jpsignals}, @{$ipsignals}) {
            my $width = $signal->{width};
            $pattern .= "0x";

            my $ptmp = q{};
            while ($width > 0) {
                my $w = 4;
                if ($w > $width) {
                    $w = $width;
                }
                my $val = int(rand(2**$w));
                $ptmp .= sprintf("%x", $val);
                $width -= $w;
            }

            $pattern .= (reverse $ptmp) . q{ };
        }
        $outtext .= $pattern . "\n";
        $run = 1;
    }
    $Vecfile = "randomvec";
    pg2_write_file($Vecfile, $outtext);
    _generate_pg_sim_testvector();
}

sub _calculate_jpwidth {
    my $io = 'JPSET';
    my $return = sub {
        my ($args)   = @_;
        my $pjoff    = $args->{pjoff};
        return $pjoff;
    };
    my $jpwidth = pg2_foreach_ioport_of_type($io, sub { q{} }, $return);

    return $jpwidth;
}

sub _register_parameter {
    my $name = shift @_;
    my @args = @_;
    my $params = pg2_get_parameter($name);

    if (! defined $params) {
        croak "Parameter '$name' not defined.\n";
    }
    push @{$params}, \@args;
}


# returns a signal's I/O attribute.
#
# return  0 if $signalname is in none of JPSET, IPSET, COEFFSET, FOSET Parameter list.
# return  1 if it is in one of JPSET, IPSET, COEFFSET Parameter list.
# return -1 if it is in FOSET Parameter list.
#
sub _has_io_attribute {
    my ($signalname) = @_;
    my $isio = 0;

    # check if the signal is connected to an input port.
    #
    for my $paramname ('IPSET', 'JPSET', 'COEFFSET') {
        my $params = pg2_get_parameter($paramname);
        next if ! defined $params;
        for my $param (@{$params}) {
            my ($var, undef, $ne, undef, $w) = @{$param};
            my $suffix = q{};
            $ne =~ s/.*\[(\d+)\]/$1/; # number of elements

          IN_PORT_CHECK:
            for my $i (0..$ne-1) {
                if ($ne > 1) {
                    $suffix = '_' . $i;
                }
                if ($var . $suffix eq $signalname) {
                    $isio = 1;
                    last IN_PORT_CHECK;
                }
            }
        }
    }

    # check if the signal is connected to an output port.
    #
    for my $paramname ('FOSET') {
        my $params = pg2_get_parameter($paramname);
        next if ! defined $params;
        for my $param (@{$params}) {
            my ($var, undef, $ne, undef, $w) = @{$param};
            my $suffix = q{};
            $ne =~ s/.*\[(\d+)\]/$1/; # number of elements

          OUT_PORT_CHECK:
            for my $i (0..$ne-1) {
                if ($ne > 1) {
                    $suffix = '_' . $i;
                }
                if ($var . $suffix eq $signalname) {
                    $isio = -1;
                    last OUT_PORT_CHECK;
                }
            }
        }
    }

    return $isio;
}

#################################################################################################
#
# 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, $nodes_ref) = _generate_default_module(@_);

    _dprintf("AUTOLOAD:$AUTOLOAD module:$module->{name}\n");

    push @$nodes_ref, {name => 'pclk', port => 'clk', width => 1, mantissa => 0};
    push @{$module->{instances}}, _instantiate_module($module->{name}, $nodes_ref);
}


{
    # generate unique module ID.

    my $Mid = 0;

    sub _get_new_moduleid {
        return 'id' . $Mid++;
    }
}

# these variables have global scope, but are intended to be used only
# by _generate_default_module(), in order to substitute <$var> tags in
# .template.vhd files.
#
our $isadder = undef;
our $tablefilename = undef;

# $basename
# $c            : component statement.
# $e_a          : entity & architecture statement.
# $ports_ref    : a list of I/O ports.
# $generics_ref : a list of generic parameters.
# $args_ref     : a list of arguments passed to this module in PGDL description.
# $wexp_funcs   : a list of functions to calculate width of exponent which takes two arguments.
#                   &{$wexp_funcs->[$i]}($width_of_node_i, $width_of_mantissa_i)
#
=pod
    #### wexp_funcs example ####
    my @wexp_funcs;
    # function to calculate width of exponent of type 'float'.
    $wexp_funcs[0] = sub {
        my ($w, $m) = @_;
        return $w - $m - 1;
    };
    # function to calculate width of exponent of type 'log'.
    $wexp_funcs[1] = sub {
        my ($w, $m) = @_;
        return $w - $m - 2;
    };
=cut

sub _generate_default_module {
    my ($basename, $c, $e_a, $ports_ref, $generics_ref, $args_ref, $wexp_funcs) = @_;
    my @ports    = @$ports_ref;
    my @generics = @$generics_ref;
    my @args     = @$args_ref;
    my @nodes;

    if (!defined $basename || !defined $c || !defined $e_a ||
        !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";

    while (@args) {
        last if !(($args[0] =~ /^[a-zA-Z]\w*$/) || ($args[0] =~ /\"\d+\"/));
        my $node = {
            name     => shift @args,
            width    => shift @args,
            mantissa => shift @args,
            port     => shift @ports,
        };
        push @nodes, $node;
    }
    _dprintf "args not used: @args\n";
    _dprintf "connections:\n";
    for my $node (@nodes) {
        _dprintf "    $node->{name} => $node->{port} ($node->{width}.$node->{mantissa})\n";
    }
    my $mname = $basename;
    for my $node (@nodes) {
        $mname .= sprintf("_%d", $node->{width});
    }
    _dprintf("mname:    $mname\n");

    # define variables which may be used in *.template.vhd files.
    #
    my $mid = _get_new_moduleid();
    my (@wlist, @mlist, @elist);
    for my $node (@nodes) {
        push @wlist, $node->{width};
        push @mlist, $node->{mantissa};
    }
    my ($w1, $w2, $w3, $w4, $w5, $w6, $w7, $w8) = @wlist;
    my ($m1, $m2, $m3, $m4, $m5, $m6, $m7, $m8) = @mlist;
    for my $i (0..7) {
        if (defined $wlist[$i] && defined $mlist[$i]) {
            push @elist, $wlist[$i] - $mlist[$i] - 1;
        }
    }
    my ($e1, $e2, $e3, $e4, $e5, $e6, $e7, $e8) = @elist;

    my $module = $Module{$mname};
    if (!defined $module) {

        $module->{name} = $mname; # generate a module and name it
        $c =~ s/$Templatetag0/($1)/xmseeg;
        $c =~ s/$Templatetag1/($1)/xmseeg;
        $module->{component} = $c;

        $e_a =~ s/$Templatetag0/($1)/xmseeg;
        $e_a =~ s/$Templatetag1/($1)/xmseeg;

        $module->{architecture} = $e_a;
        
        $Module{$mname} = $module; # register a module to the hash
    }
    for my $node (@nodes) {
        _register_a_signal($node->{name}, $node->{width});
    }
    return ($module, \@nodes, \@args);
}

sub _generate_pg_inc_int {
    my ($module, $nodes_ref, $args_ref) = _generate_default_module(@_);
    push @$nodes_ref, {name => "run($args_ref->[0]-1)", port => 'run', width => 1, mantissa => 0};
    push @$nodes_ref, {name => 'pclk', port => 'clk', width => 1, mantissa => 0};
    push @{$module->{instances}}, _instantiate_module($module->{name}, $nodes_ref);
}

sub _generate_pg_inc_float {
    local $isadder = q{};
    my ($module, $nodes_ref, $args_ref) = _generate_default_module(@_);
    push @$nodes_ref, {name => "run($args_ref->[0]-1)", port => 'run', width => 1, mantissa => 0};
    push @$nodes_ref, {name => 'pclk', port => 'clk', width => 1, mantissa => 0};
    push @{$module->{instances}}, _instantiate_module($module->{name}, $nodes_ref);
}

sub _generate_pg_comp_ulog {
    my ($module, $nodes_ref, $args_ref) = _generate_default_module(@_);

    # generate portname from the last argument of pg_comp_ulog().
    my $outport = lc $args_ref->[0]; # one of "L", "LE", "GE", "G", "E", "NE"
    $outport =~ s/\"//g;             # is converted to
    $outport = 'a' . $outport . 'b'; # alb, aleb, ageb, agb, aeb, aneb.

    for my $node (@$nodes_ref) {
        next if ($node->{port} ne 'alb');
        $node->{port} = $outport;
        $node->{name} .= '(0)';
    }
    push @$nodes_ref, {name => 'pclk', port => 'clk', width => 1, mantissa => 0};
    push @{$module->{instances}}, _instantiate_module($module->{name}, $nodes_ref);
}

sub _generate_pg_shift_float {
    my ($module, $nodes_ref, $args_ref) = _generate_default_module(@_);
    my $direction = ((lc $args_ref->[0] eq '"left"') ? '"ADD"' : '"SUB"');
    push @$nodes_ref, {name => $direction, generic => "ADDSUB"};
    push @$nodes_ref, {name => 'pclk', port => 'clk', width => 1, mantissa => 0};
    push @{$module->{instances}}, _instantiate_module($module->{name}, $nodes_ref);
}

sub _generate_pg_add_float {
    local $isadder = q{};
    my ($module, $nodes_ref, $args_ref) = _generate_default_module(@_);
    push @$nodes_ref, {name => 'pclk', port => 'clk', width => 1, mantissa => 0};
    push @{$module->{instances}}, _instantiate_module($module->{name}, $nodes_ref);
}

sub _generate_pg_sub_float {
    local $isadder = q{not};
    my ($module, $nodes_ref, $args_ref) = _generate_default_module(@_);
    push @$nodes_ref, {name => 'pclk', port => 'clk', width => 1, mantissa => 0};
    push @{$module->{instances}}, _instantiate_module($module->{name}, $nodes_ref);
}

sub _generate_pg_delay {
    my ($basename, $c, $e_a, $ports_ref, $generics_ref, $args_ref) = @_;
    my @nodes;
    my $width = $args_ref->[2];
    my $delay = $args_ref->[3];

    for my $i (0..1) { # src, dst
        my $node = {
            name     => $args_ref->[$i],
            width    => $width,
            mantissa => 0,
            port     => $ports_ref->[$i],
        };
        push @nodes, $node;
    }
    my $mname = $basename;
    my $module = $Module{$mname};
    my $mid = _get_new_moduleid();

    if (!defined $module) {
        $module->{name} = $mname; # generate a module and name it
        
        $c   =~ s/$Templatetag0/($1)/xmseeg; # generate a component statement
        $c   =~ s/$Templatetag1/($1)/xmseeg;
        $module->{component} = $c;

        $e_a =~ s/$Templatetag0/($1)/xmseeg; # generate entity and architecture statement
        $e_a =~ s/$Templatetag1/($1)/xmseeg;
        $module->{architecture} = $e_a;
        
        $Module{$mname} = $module; # register a module to the hash
    }

    for my $node (@nodes) {
        _register_a_signal($node->{name}, $node->{width});
    }
    push @nodes, {name => $width, generic => 'WIDTH'};
    push @nodes, {name => $delay, generic => 'DELAY'};
    push @nodes, {name => 'pclk', port => 'clk', width => 1, mantissa => 0};
    push @{$module->{instances}}, _instantiate_module($module->{name}, \@nodes);
}

sub _generate_pg_store {
    my ($basename, $c, $e_a, $ports_ref, $generics_ref, $args_ref) = @_;
    my ($dataname, $storagename, $wename, $width, $depth, $delay) = @{$args_ref};
    my $mname       = $basename;
    my $ovflwwidth  = $Archinfo->{nchip};

    my $module = $Module{$mname};
    my $mid = _get_new_moduleid();

    if (!defined $module) {
        $module->{name} = $mname; # generate a module and name it
        
        $c   =~ s/$Templatetag0/($1)/xmseeg; # generate a component statement
        $c   =~ s/$Templatetag1/($1)/xmseeg;
        $module->{component} = $c;

        $e_a =~ s/$Templatetag0/($1)/xmseeg; # generate entity and architecture statement
        $e_a =~ s/$Templatetag1/($1)/xmseeg;
        $module->{architecture} = $e_a;
        
        $Module{$mname} = $module; # register a module to the hash
    }

    my $depth_per_pipe = $depth;
    if ($Archinfo->{reduce_fout}) {
      $depth_per_pipe /= $Archinfo->{nchip};
    }
    my $depthbits = (int (log($depth_per_pipe-1)/log(2)) + 1);

    for my $id (0..$depth_per_pipe-1) {
        my @nodes = ();
        push @nodes, { # src
                      name     => $dataname,
                      width    => $width,
                      mantissa => 0,
                      port     => $ports_ref->[0],
                     };
        push @nodes, { # dst
                      name     => $storagename . '_' . $id,
                      width    => $width,
                      mantissa => 0,
                      port     => $ports_ref->[1],
                     };
        push @nodes, { # we
                      name     => $wename,
                      width    => 1,
                      mantissa => 0,
                      port     => $ports_ref->[2],
                     };
        push @nodes, { # id
                      name     => $wename . '_cnt',
                      width    => $depthbits,
                      mantissa => 0,
                      port     => 'id',
                     };

        for my $node (@nodes) {
            _register_a_signal($node->{name}, $node->{width});
        }
        _register_a_signal($storagename . '_ovflw', 0, 'std_logic');
        if ($Archinfo->{reduce_fout}) {
            _register_a_signal($storagename . '_' . $id . '_out', 0, $storagename . '_fout_noreduce');
            _register_a_signal($storagename . '_ovflw_out', $ovflwwidth, 'std_logic_vector');
        }

        for my $node (@nodes) {
            next if ($node->{port} ne 'we');
            $node->{name} .= '(0)';
        }
        push @nodes, {name => $width                          , generic => 'WIDTH'};
        push @nodes, {name => $depthbits                      , generic => 'DEPTH'};
        push @nodes, {name => $id                             , generic => 'STORAGEID'};
        push @nodes, {name => "run($delay-1)", port => 'run', width => 1, mantissa => 0};
        push @nodes, {name => 'pclk' , port => 'clk', width => 1, mantissa => 0};
        push @{$module->{instances}}, _instantiate_module($module->{name}, \@nodes);
    }
    $Additionallogic .= _generate_counter($storagename, $wename . '_cnt', $wename,
                                         "run($delay-1)", "run($delay)", 'pclk', $depth_per_pipe);
    $Additionallogic .= _generate_overflow($storagename, $storagename . '_ovflw', $wename . '_cnt', $wename,
                                          "run($delay-1)", "run($delay)", 'pclk', $depth_per_pipe);

    # delete FOSET elements of $storagename signals.
    #
    my @fos = @{pg2_get_parameter('FOSET')};
    my @fos_new = ();
    for my $fo (@fos) {
        next if ($fo->[0] eq $storagename);
        next if ($fo->[0] eq $storagename . '_ovflw');
        push @fos_new, $fo;
    }
    @{pg2_get_parameter('FOSET')} = @fos_new;

    if (!$Archinfo->{reduce_fout}) {
        _register_parameter('FOSET',
                            $storagename . '_ovflw',
                            q{-},
                            $storagename . '[1]', 
                            'int', $Archinfo->{nchip}, 0, 1);
        for my $id (0..$depth_per_pipe-1) {
            _register_parameter('FOSET',
                                $storagename . '_' . $id,
                                q{-},
                                $storagename . '[1]',
                                'int', $width, 0, 1);
        }
    }
    else {
        $Typedef .= sprintf("    type %s is array (%d-1 downto 0) of std_logic_vector(%d-1 downto 0);\n",
                            $storagename . '_fout_noreduce', $Archinfo->{nchip}, $width);

        # add FOSET elements of selector output of $storagename signals.
        _register_parameter('FOSET',
                            $storagename . '_ovflw_out',
                            q{-},
                            $storagename . '[1]', 
                            'int', $ovflwwidth, 0, 1);
        for my $id (0..$depth_per_pipe-1) {
            for my $cid (0..$Archinfo->{nchip}-1) {
                _register_parameter('FOSET',
                                    $storagename . '_' . $id . '_out('  . $cid . ')',
                                    q{-},
                                    $storagename . '[1]',
                                    'int', $width, 0, 1);
            }
        }

        $Additionallogic .= _generate_fout_selector($storagename, 'cid',
                                                   $Archinfo->{nchip}, $depth_per_pipe);
    }

}

sub _generate_counter {
    my ($basename, $cnt, $ce, $run0, $run1, $clk, $size) = @_;
    my $outtext = << "END_BODY";
    -- data counter for $basename
    process ($clk)
    begin
        if ($clk\'event and $clk='1') then
            if ($run1 = '1') then
                if ($ce = "1" and $cnt < conv_std_logic_vector($size, $cnt\'length)) then
                    $cnt <= $cnt + conv_std_logic_vector(1, $cnt\'length);
                end if;
            elsif ($run0 = '1') then
                $cnt <= (others => '0');
            end if;
        end if;
    end process;

END_BODY
      return $outtext;
}

sub _generate_overflow {
    my ($basename, $of, $cnt, $ce, $run0, $run1, $clk, $size) = @_;
    my $outtext = << "END_BODY";
    -- overflow flag for $basename
    process ($clk)
    begin
        if ($clk\'event and $clk='1') then
            if ($run1 = '1') then
                if ($ce = "1" and $cnt = conv_std_logic_vector($size, $cnt\'length)) then
                    $of <= '1';
                end if;
            elsif ($run0 = '1') then
                $of <= '0';
            end if;
        end if;
    end process;

END_BODY
      return $outtext;
}

sub _generate_fout_selector {
    my ($basename, $cid, $nchip, $size) = @_;
    my $outtext = '';

    $outtext .= sprintf("    for_%s: for i in 0 to %d-1 generate\n", $basename, $nchip);
    for my $id (0..$size-1) {
        $outtext .= sprintf("        with %s select\n", $cid);
        $outtext .= sprintf("            %s_%d_out(i) <=\n", $basename, $id);
        $outtext .= sprintf("                %s_%d             when conv_std_logic_vector(i+1, %s'length),\n",
                            $basename, $id, $cid);
        $outtext .= sprintf("                (others => '0')" . ' ' x (length($basename . $id)-1) . "when others;\n");
    }
    $outtext .= sprintf("        with %s select\n", $cid);
    $outtext .= sprintf("            %s_ovflw_out(i) <=\n", $basename);
    $outtext .= sprintf("                %s_ovflw         when conv_std_logic_vector(i+1, %s'length),\n",
                        $basename, $cid);
    $outtext .= sprintf("                '0'" . ' ' x (length($basename . 'ovflw')+7) . "when others;\n");
    $outtext .= sprintf("    end generate for_%s;", $basename);

    return $outtext;
}    


# PGDL example:
# old 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, $c, $e_a, $ports_ref, $generics_ref, $args_ref) = @_;
    my @nodes;
    my $width              = $args_ref->[2];
    my $mantissa           = $args_ref->[3];
    my ($w1, $m1, $e1) = ($width, $mantissa, $width - $mantissa - 1);

    # variables used in pg_pow_float.template.vhd files.
    #
    my $signed_numerator   = $args_ref->[4];
    my $signed_denominator = $args_ref->[5];
    my $numerator          = $signed_numerator;
    my $denominator        = $signed_denominator;
    my $pindex_sign        = ($signed_numerator * $signed_denominator > 0) ? 1 : -1;
    my $wentry             = $args_ref->[6]; # width of table entry
    my $wentry_exp         = log($denominator)/log(2);
    my $wentry_man         = ($wentry - $wentry_exp);
    my $wmanlow            = $mantissa - $wentry_man;

    # generate table using pgemu.
    my ($tablefilename, $wdexp, $wman0th, $wman1st, $wman2nd) = 
        _generate_pg_pow_float_table($width, $mantissa, $wentry,
                                     $signed_numerator, $signed_denominator);
    my $wtable  = $wdexp + $wman0th + $wman1st + $wman2nd;

    for my $i (0..1) { # src, dst
        my $node = {
            name     => $args_ref->[$i],
            width    => $width,
            mantissa => $mantissa,
            port     => $ports_ref->[$i],
        };
        push @nodes, $node;
    }
    my $mname = $basename;
    my $module = $Module{$mname};
    my $mid = _get_new_moduleid();

    if (!defined $module) {
        $module->{name} = $mname; # generate a module and name it
        
        $c   =~ s/$Templatetag0/($1)/xmseeg; # generate a component statement
        $c   =~ s/$Templatetag1/($1)/xmseeg;
        $module->{component} = $c;

        $e_a =~ s/$Templatetag0/($1)/xmseeg; # generate entity and architecture statement
        $e_a =~ s/$Templatetag1/($1)/xmseeg;
        $module->{architecture} = $e_a;
        
        $Module{$mname} = $module; # register a module to the hash
    }

    for my $node (@nodes) {
        _register_a_signal($node->{name}, $node->{width});
    }
    push @nodes, {name => 'pclk', port => 'clk', width => 1, mantissa => 0};
    push @{$module->{instances}}, _instantiate_module($module->{name}, \@nodes);
}

# generate tables using pgemu.
# returns 5 values:
#   table file name
#   width of exp adjustment table
#   0th, 1st, and 2nd order of mantissa interpolation table 
#
sub _generate_pg_pow_float_table {
    my ($width, $man, $resolution, $numerator, $denominator) = @_;

    # table name
    my $tablename = 'pg_pow_float';
    $tablename .= $width . '.' . $man;
    my $sign = ($numerator * $denominator < 0) ? '-' : '+';
    my $an = abs $numerator;
    my $am = abs $denominator;
    $tablename .= '_' . $sign . $an . '_' . $am;
    $tablename .= '.mif';
    my $tmpfilename = 'tmp_' . $tablename;

    # generate table using pgemu.
    my $cmd = sprintf("($ENV{PGPG2PATH}/bin/pgemu 3 0 > %s) >& /dev/null << EOF\n", $tablename);
    $cmd .= sprintf("%s%d %d %d %d %d %s\n",
                    $sign, $an, $am,
                    $width - $man - 1,
                    $man,
                    $resolution,
                    $tmpfilename);
    $cmd .= sprintf("EOF\n");
    _dprintf("_generate_pg_pow_float_table: exec cmd: $cmd\n");
    system($cmd);

    # obtain widths of tables from output of pgemu.
    my ($wexp, $wman0th, $wman1st, $wman2nd);
    if (open( IN, "< $tmpfilename")) {
        my $intext = <IN>;
        close IN;

        chomp($intext);
        ($wexp, $wman0th, $wman1st, $wman2nd) = split(q{ }, $intext);

    }
    else {
        croak "warning: cannot open $tmpfilename";
    }
    system("rm $tmpfilename");
    return (q{"} . $tablename . q{"}, $wexp, $wman0th, $wman1st, $wman2nd);
}


# PGDL example:
# pg_conv_float_to_log(xj, 17, 9, res, 17, 8);
#
sub _generate_pg_conv_float_to_log {
    my ($basename, $c, $e_a, $ports_ref, $generics_ref, $args_ref) = @_;
    my @nodes;
    my (undef, $w1, $m1, undef, $w2, $m2) = @{$args_ref};
    my ($e1, $e2) = ($w1 - $m1 - 1, $w2 - $m2 - 1);
    my @args  = @$args_ref;
    my @ports = @$ports_ref;

    if ($e1 > $e2) {
        warn "Warning: _generate_pg_conv_float_to_log():\n" .
             "  width of exponent of source ($e1) is larger than that of destination ($e2).\n" .
             "  conversion result may overflow.\n\n";
    }

    while (@args) {
        last if !(($args[0] =~ /^[a-zA-Z]\w*$/) || ($args[0] =~ /\"\d+\"/));
        my $node = {
            name     => shift @args,
            width    => shift @args,
            mantissa => shift @args,
            port     => shift @ports,
        };
        push @nodes, $node;
    }
    _dprintf "args not used: @args\n";
    _dprintf "connections:\n";
    for my $node (@nodes) {
        _dprintf "    $node->{name} => $node->{port} ($node->{width}.$node->{mantissa})\n";
    }

    # define variables which may be used in *.template.vhd files.
    #
    my $mname = $basename;
    my $module = $Module{$mname};
    my $mid = _get_new_moduleid();

    # generate table using pgemu.
    my $tablefilename = _generate_pg_conv_float_to_log_table($w1, $m1, $w2, $m2);

    if (!defined $module) {
        $module->{name} = $mname; # generate a module and name it
        
        $c   =~ s/$Templatetag0/($1)/xmseeg; # generate a component statement
        $c   =~ s/$Templatetag1/($1)/xmseeg;
        $module->{component} = $c;

        $e_a =~ s/$Templatetag0/($1)/xmseeg; # generate entity and architecture statement
        $e_a =~ s/$Templatetag1/($1)/xmseeg;
        $module->{architecture} = $e_a;
        
        $Module{$mname} = $module; # register a module to the hash
    }

    for my $node (@nodes) {
        _register_a_signal($node->{name}, $node->{width});
    }
    push @nodes, {name => 'pclk', port => 'clk', width => 1, mantissa => 0};
    push @{$module->{instances}}, _instantiate_module($module->{name}, \@nodes);
}

# generate a table using pgemu.
# returns tablefilename.
#
sub _generate_pg_conv_float_to_log_table {
    my ($w1, $m1, $w2, $m2) = @_;

    # table name
    my $tablename = 'pg_conv';
    $tablename .= '_float' . $w1 . '.' . $m1;
    $tablename .= '_log' . $w2 . '.' . $m2;
    $tablename .= '.mif';

    # generate table using pgemu.
    my $cmd = sprintf("($ENV{PGPG2PATH}/bin/pgemu 6 0 > %s) >& /dev/null << EOF\n", $tablename);
    $cmd .= sprintf("%d %d\n", $m1, $m2);
    $cmd .= sprintf("EOF\n");
    _dprintf("_generate_pg_conv_float_to_log_table: exec cmd: $cmd\n");
    system($cmd);
    return (q{"} . $tablename . q{"});
}

# PGDL example:
# pg_conv_log_to_float(xj, 17, 8, res, 17, 9);
#
sub _generate_pg_conv_log_to_float {
    my ($basename, $c, $e_a, $ports_ref, $generics_ref, $args_ref) = @_;
    my @nodes;
    my (undef, $w1, $m1, undef, $w2, $m2) = @{$args_ref};
    my ($e1, $e2) = ($w1 - $m1 - 1, $w2 - $m2 - 1);
    my @args  = @$args_ref;
    my @ports = @$ports_ref;

    if ($e1 > $e2) {
        warn "Warning: _generate_pg_conv_log_to_float():\n" .
             "  width of exponent of source ($e1) is larger than that of destination ($e2).\n" .
             "  conversion result may overflow.\n\n";
    }

    while (@args) {
        last if !(($args[0] =~ /^[a-zA-Z]\w*$/) || ($args[0] =~ /\"\d+\"/));
        my $node = {
            name     => shift @args,
            width    => shift @args,
            mantissa => shift @args,
            port     => shift @ports,
        };
        push @nodes, $node;
    }
    _dprintf "args not used: @args\n";
    _dprintf "connections:\n";
    for my $node (@nodes) {
        _dprintf "    $node->{name} => $node->{port} ($node->{width}.$node->{mantissa})\n";
    }

    # define variables which may be used in *.template.vhd files.
    #
    my $mname = $basename;
    my $module = $Module{$mname};
    my $mid = _get_new_moduleid();

    # generate table using pgemu.
    my $tablefilename = _generate_pg_conv_log_to_float_table($w1, $m1, $w2, $m2);

    if (!defined $module) {
        $module->{name} = $mname; # generate a module and name it
        
        $c   =~ s/$Templatetag0/($1)/xmseeg; # generate a component statement
        $c   =~ s/$Templatetag1/($1)/xmseeg;
        $module->{component} = $c;

        $e_a =~ s/$Templatetag0/($1)/xmseeg; # generate entity and architecture statement
        $e_a =~ s/$Templatetag1/($1)/xmseeg;
        $module->{architecture} = $e_a;
        
        $Module{$mname} = $module; # register a module to the hash
    }

    for my $node (@nodes) {
        _register_a_signal($node->{name}, $node->{width});
    }
    push @nodes, {name => 'pclk', port => 'clk', width => 1, mantissa => 0};
    push @{$module->{instances}}, _instantiate_module($module->{name}, \@nodes);
}

# generate a table using pgemu.
# returns tablefilename.
#
sub _generate_pg_conv_log_to_float_table {
    my ($w1, $m1, $w2, $m2) = @_;

    # table name
    my $tablename = 'pg_conv';
    $tablename .= '_log' . $w1 . '.' . $m1;
    $tablename .= '_float' . $w2 . '.' . $m2;
    $tablename .= '.mif';

    # generate table using pgemu.
    my $cmd = sprintf("($ENV{PGPG2PATH}/bin/pgemu 7 0 > %s) >& /dev/null << EOF\n", $tablename);
    $cmd .= sprintf("%d %d\n", $m1, $m2);
    $cmd .= sprintf("EOF\n");
    _dprintf("_generate_pg_conv_log_to_float_table: exec cmd: $cmd\n");
    system($cmd);
    return (q{"} . $tablename . q{"});
}
