#!/usr/bin/perl -w

use strict;
no strict 'refs';
use warnings;
use Carp;

use FindBin qw($Bin);
use lib "$Bin/../lib";
use gooseutil;

#
# local code starts from here
#
my $Goosepath     = "$Bin/..";
my @Infile        = ();
my @InfileToGoose = ();
my @InfileToCc    = ();
my @NPragmaFor    = ();
my @Wfile         = ();
my @Qfile         = ();
my @Vfile         = ();
my @Gfile         = ();
my $Backannotate  = undef;
my $CPPflags      = '';
my $Cflags        = undef;
my $Lsumppath     = undef;
my $Vsmpath       = undef;
my $Cc            = undef;
my $Archinfo      = undef;

#
# main function starts from here
#
{
    my ($cmd, $status, $data, $i);
    my @atmp;

    parse_commandline_arguments();

    #
    # check if mandatory environment variables are set.
    #
    if (!defined $Lsumppath) {
        croak "\$LSUMPPATH not defined. Abort.\n";
    }
    vprintf("\$LSUMPPATH                           : %s\n", $Lsumppath);

    if (!defined $Vsmpath) {
        croak "\$VSMPATH not defined. Abort.\n";
    }
    vprintf("\$VSMPATH                             : %s\n", $Vsmpath);

    if (!defined $Archinfo->{path} and $Archinfo->{name} eq 'gdr') {
        $Archinfo->{path} = $ENV{GRAPEPKGPATH};
        if (!defined $Archinfo->{path}) {
            croak "\$GRAPEPKGPATH not defined. Abort.\n";
        }
        vprintf("\$GRAPEPKGPATH                        : %s\n", $Archinfo->{path});
    }

    #
    # classify input files.
    #
    for my $fname (@Infile) {

#        if ($fname !~ / [.] (?: c | cc | CC | c[+][+]) \z/xms) {
        if ($fname !~ / [.] c \z/xms) {
            push @InfileToCc, $fname;
            next;
        }
        # look for '#pragma goose parallel for'.
        my @pragmafor;

        my $spc = qr{(?:[ \t]|\\\n)+};
        if (@pragmafor = read_text($fname) =~ m/ ^\#pragma $spc goose $spc parallel $spc for \b /xmsg) {
            push @InfileToGoose, $fname;
            push @NPragmaFor, scalar @pragmafor;
        }
        else {
            push @InfileToCc, $fname;
        }
    }

    #
    # set output file names.
    #
    my @fnameroot;
    if (defined $Infile[0]) {
        # remove directory names and the last extension.
        @fnameroot = map {/ ([^\/]*) [.] \w+ \z /x; $1;} @InfileToGoose; 
    }
    else {
        $fnameroot[0] = 'output';
    }

    for my $fileid (0..$#fnameroot) {
        my @qfile = ();
        my @vfile = ();
        my @gfile = ();
        push @Wfile, $fnameroot[$fileid] . "_$Archinfo->{name}" . '.c';
        for my $loopid (0..$NPragmaFor[$fileid]-1) {
            push @qfile, $fnameroot[$fileid] . q{_} . $loopid . q{.q};
            push @vfile, $fnameroot[$fileid] . q{_} . $loopid . q{.vsm};
            push @gfile, $fnameroot[$fileid] . q{_} . $loopid . q{.vsmgen};
        }
        push @Qfile, \@qfile;
        push @Vfile, \@vfile;
        push @Gfile, \@gfile;
    }

    #
    # print diagnostic messages.
    #
    vprintf("Architecture                         : $Archinfo->{name}\n");
    vprintf("Back annotate                        : %s\n", $Backannotate ? 'on' : 'off');
    vprintf("Options passed on to  $Cc             : $Cflags\n");
    vprintf("Input .c file\n");
    vprintf("  to be processed by Goose           : @InfileToGoose\n");
    vprintf("  number of 'parallel' pragmas in it : @NPragmaFor\n");
    vprintf("  directly passed on to  $Cc          : @InfileToCc\n");
    vprintf("%s API calls embedded .c file       : @Wfile\n", $Archinfo->{name});
    @atmp = get_flat_file_list(@Qfile);
    vprintf("LSUMP .q file                        : @atmp\n");
    if ($Archinfo->{name} eq 'gdr') {
        my @ghfile = map {$_ . '.h'} get_flat_file_list(@Gfile);
        my @gcfile = map {$_ . '.c'} get_flat_file_list(@Gfile);
        my @mcfile = map {$_ . '.gdr'} get_flat_file_list(@Gfile);

        @atmp = get_flat_file_list(@Vfile);
        vprintf("SING assembly .vsm file              : @atmp\n");
        vprintf("SING wrapper file header             : @ghfile\n");
        vprintf("SING wrapper file                    : @gcfile\n");
        vprintf("SING microcode .gdr file             : @mcfile\n");
    }

    #
    # process input files which contain goose pragmas.
    #
    my $tmpdir = 'goosetmp';
    if (! -d $tmpdir) {
        $cmd = "mkdir $tmpdir";
        vprintf($cmd . "\n");
        $status = system($cmd);
        vprintf("exit status : $status\n");
        if ($status != 0 ) {
            croak "cannot create temporal directory $tmpdir. Abort.\n";
        }
    }
    # cd to $tmpdir.
    #
    chdir $tmpdir;

    my @lsumpopt = ();
    my @valtfile = ();
    for my $fileid (0..$#InfileToGoose) {
        my @gfiles = map {$_ . '.[hc]'} @{$Gfile[$fileid]};
        my @qfiles = @{$Qfile[$fileid]};
        my @vfiles = @{$Vfile[$fileid]};

        my $infile = $InfileToGoose[$fileid];
        print_message("processing $infile.");

        if ($Backannotate == 1) {
            warn("Running in Backannotation mode.\n" .
                 "  Only @gfiles will be updated.\n" .
                 "  Note that @qfiles and @vfiles will remain untouched.\n");
            valtfile_given_by_goosec2q($fileid, \@qfiles, \@valtfile);
            printf("valtfile:$valtfile[0][0]\n");
        }
        else {
            #
            # fork & exec goosec2q.
            #
            my $prefix = sprintf("f%d", $fileid);
            $cmd = "$Goosepath/bin/goosec2q $CPPflags -i ../$infile -a $Archinfo->{name} -p $prefix";
            my $vlv = gs_get_verbose();
            $cmd .= " -v$vlv ";
            vprintf($cmd . "\n");
            $status = system($cmd);
            vprintf("exit status : $status\n");
            if ($status != 0 ) {
                print "\n\n";
                print_message("@qfiles generation failed.");
                croak "@qfiles generation failed. Abort.\n";
            }
            print_message("@qfiles generated successfully.");

            lsumpopt_given_by_goosec2q($fileid, \@qfiles, \@lsumpopt);
            valtfile_given_by_goosec2q($fileid, \@qfiles, \@valtfile);

            #
            # fork & exec LSUMP.
            #
            for my $loopid (0..$#qfiles) {
                vprintf("------------\n");
                vprintf("loopid : $loopid\n");
                vprintf("------------\n");

                if (defined $valtfile[$fileid][$loopid]) {
                    my $v = $valtfile[$fileid][$loopid];
                    print_message("Asmfile ($v) given. VSM file ($vfiles[$loopid]) generation suppressed.");
                    next;
                }

                my $qfile = $qfiles[$loopid];
                my $vfile = $vfiles[$loopid];

                my @opt = @{$lsumpopt[$loopid]};
                $cmd = "$Lsumppath/run @opt $qfile";

                if (gs_get_verbose() < 2) {
                    $cmd .= "> /dev/null";
                }
                if (gs_get_verbose() < 1) {
                    $cmd = "($cmd) >& /dev/null";
                }
                vprintf($cmd . "\n");

                $status = system($cmd);
                vprintf("exit status : $status\n");
                if ($status != 0 ) {
                    print "\n\n";
                    print_message("$vfile generation failed.");
                    croak "$vfile generation failed. Abort.\n";
                }
                print_message("$vfile generated successfully.");

                # rename gdrsource.vsm to $vfile.
                $cmd = "/bin/cp gdrsource.vsm $vfile ";
                vprintf($cmd . "\n");
                system($cmd);

                # add 1 line at the top of $vfile.
                $prefix = sprintf("f%d_%d", $fileid, $loopid);
                $data = "prefix $prefix\n";
                $data .= read_text("$vfile");
                write_text("$vfile", $data);

            } # for each loop
        }

        #
        # fork & exec VSM.
        #
        for my $loopid (0..$#qfiles) {
            my $vfile = $vfiles[$loopid];
            my $gfile = $Gfile[$fileid]->[$loopid];

            if (defined $valtfile[$fileid][$loopid]) {
                my $v = $valtfile[$fileid][$loopid];
                printf("Use '$v' instead of VSM file generated by goosecc ($vfile).\n");
                my @va = split(//, $v);
                if ($va[0] eq '/') { # absolute path.
                    $vfile = "$v";
                }
                else { # relative path.
                    $vfile = "../$v";
                }
            }
            if (! -f $vfile) {
                print "\n\n";
                print_message("Asmfile ($vfile) not found.");
                croak "\nAsmfile ($vfile) not found. Abort.\n";
            }
            $cmd = "$Vsmpath/vsm.rb -g $gfile -i $vfile -p $Archinfo->{npe} > $gfile.gdr";
            if (gs_get_verbose() < 3) {
                $cmd = "($cmd) >& /dev/null";
            }
            vprintf($cmd . "\n");
            $status = system($cmd);
            vprintf("exit status : $status\n");
            if ($status != 0 ) {
                print "\n\n";
                print_message("$gfile.h, $gfile.c, $gfile.gdr generation failed.");
                croak "\n$gfile.h, $gfile.c, $gfile.gdr generation failed. Abort.\n";
            }
            print "\n\n";
            print_message("$gfile.h, $gfile.c, $gfile.gdr generated successfully.");

            #
            # this part should be removed when the VSM bug is fixed.
            #

            #rename $gfile.h to $gfile.h.bak.
            $cmd = "/bin/cp $gfile.h $gfile.h.bak";
            vprintf($cmd . "\n");
            system($cmd);

            # remove the 3rd line of $gfile.h.
            $cmd = sprintf("%s %s.h.bak > %s.h", q{awk '{if (NR != 3) {print $0;} }'}, $gfile, $gfile);
            vprintf($cmd . "\n");
            system($cmd);

            # add 1 line at the top of $gfile.h.
            $data = "\#include <stdio.h>\n";
            $data .= read_text("$gfile.h");
            write_text("$gfile.h", $data);

            # add 1 line at the top of $gfile.c.
            $data = "\#include <stdlib.h>\n";
            $data .= read_text("$gfile.c");
            write_text("$gfile.c", $data);

            # make vsm-generated structure names and function names unique.
            # this is necessary in order to avoid name collision when multiple
            # '#pragma goose for' exists.
            my $prefix = sprintf("f%d_%d", $fileid, $loopid);
            rename_sing_defs($gfile, $prefix);

        } # for each loop

    } # for each file

    # cd to ..
    #
    chdir q{..};

    #
    # compile & link all C files.
    #

    # append the path to input file names.
    my @wfile = map {"./$tmpdir/$_"} @Wfile;
    my @gcfile = map {"./$tmpdir/$_" . '.c'} get_flat_file_list(@Gfile);

    $cmd =
        "$Cc $Cflags -I. -I$Bin/../include -Igoosetmp -I$Vsmpath " .
        "@wfile @gcfile @InfileToCc " .
        "-L$Bin/../lib -L$Archinfo->{path}/lib -lsing -lhib -fopenmp";

    vprintf($cmd . "\n");
    $status = system($cmd);
    if ($status != 0 ) {
        print "\n\n";
        print_message("executable file generation failed.");
        croak "executable file generation failed. Abort.\n";
    }
    print_message("executable file generated successfully.");
}

#############################################################
#
# sub routines used by the main routine
#

# parse command line arguments
#
sub parse_commandline_arguments {
    # default values
    #
    $Archinfo     = gs_get_archinfo('gdr');
    $Backannotate = 0;
    $Cc           = defined $ENV{CC} ? $ENV{CC} : 'cc';
    $Cflags       = defined $ENV{CFLAGS} ? $ENV{CFLAGS} : q{};
    $Lsumppath    = $ENV{LSUMPPATH};
    $Vsmpath      = $ENV{VSMPATH};

    my $umsg = << "EOUMSG";
  usage: $0 [options] inputfile(s)...

  options:
      --goose-arch <arch>    : architecture type of the hardware accelerator. [gdr]

      --goose-backannotate   : back annotate the assembly code.

      -o <outputfile>        : name of executable file to be generated. [a.out]

      -I <headerpath>        : Search path for header files.

      --verbose[=level]      : be verbose. the level can optionally be given. [2]
      -v[level]                the higher level gives the more verbose messages. level 0 for silence.

      --help                 : print this help.
      -h

      -Wcc "options"         : options passed on to $Cc.

  inputfile(s) : input C source file containing Goose directive.
                 input is taken from stdin if omitted.
                 files without Goose directive are directly passed on to $Cc.

  Note that all options not listed above are implicitly passed on to $Cc,
  in addition to those explicitly specified by '-Wcc'.

EOUMSG

    while (@ARGV) {
        $_ = shift @ARGV;

        /\A (?: --goose-arch) \z/x and do {
            my $a = shift @ARGV;
            $Archinfo = gs_get_archinfo($a);
            next;
        };

        /\A (?: --goose-backannotate)\z/x  and do {
            $Backannotate = 1;
            next;
        };

        /\A -Wcc \z/x  and do {
            $Cflags .= q{ } . shift @ARGV;
            next;
        };

        /\A -o \z/x  and do {
            $Cflags .= q{ -o };
            $Cflags .= shift @ARGV;
            next;
        };

        /\A -I (.+) \z/x  and do {
            $Cflags .= q{ -I };
            $Cflags .= $1;
            $CPPflags .= "-I$1";
            next;
        };

        /\A -I \z/x  and do {
            $Cflags .= q{ -I };
            my $hpath = shift @ARGV;
            $Cflags .= $hpath;
            $CPPflags .= "-I$hpath";
            next;
        };

        # verbose-option with level.
        /\A (?: --verbose= | -v ) (\d+)\b/x     and do {
            gs_set_verbose($1);
            next;
        };

        # verbose-option without level. use default+1.
        /\A (?: --verbose | -v ) \z/x     and do {
            gs_set_verbose(3);
            next;
        };

        /\A (?: --help | -h ) \z/x     and do {
            die $umsg;
            next;
        };

        /\A [^-].* \z/x  and do {
            push @Infile, $_;
            next;
        };

        /.*/x  and do {
            # unrecognized options are passed on to $Cc.
            $Cflags .= q{ } . $_;
            next;
        };
    }
    if (!@Infile) {
        die $umsg;
    }
}

#
# find vsm-generated SING structures and functions,
# and substitue their name with unique ones.
# e.g. substitute SING_xxx with infile_SING_xxx.
#
sub rename_sing_defs {
    my ($gfile, $prefix) = @_;

    #
    # find grape_ structures and functions in $gfile.h.
    #
    my @key0 = read_text("$gfile.h") =~ / \s+ grape [^({\s]* /xmsg;
#    my @key0 = read_text("$gfile.h") =~ / (?: SING | grape ) [^({\s]* /xmsg;
    @key0 = map {s/ \A \s+  //xms; $_} @key0;
    my @key = ();
    my $elem0 = q{};
    for my $elem (sort @key0) {
        if ($elem ne $elem0) {
            push @key, $elem;
            $elem0 = $elem;
        }
    }

    #
    # generate unique names.
    #
    my @newkey = map {"$prefix" . q{_} . "$_"} @key;

    dprintf("keys:");
    for my $elem (@newkey) {
        dprintf("$elem|");
    }
    dprintf("\n");

    #
    # substitute structure and function names in $gfile.[hc] with
    # unique ones.
    #
    my $htext = read_text("$gfile.h");
    my $ctext = read_text("$gfile.c");
    for my $i (0..$#key) {
        $htext =~ s/ $key[$i] / $newkey[$i] /xmsg;
        $ctext =~ s/ $key[$i] / $newkey[$i] /xmsg;
    }
    write_text("$gfile.h", $htext);
    write_text("$gfile.c", $ctext);
}

sub get_flat_file_list {
    my @array_of_array_of_file = @_;
    my @flat_array = ();
    for my $array_of_file_ref (@array_of_array_of_file) {
        for my $file (@{$array_of_file_ref}) {
            push @flat_array, $file;
        }
    }
    return @flat_array;
}

sub print_message {
    my ($msg) = @_;
    my $len = length($msg) + 2;
    if (gs_get_verbose() > 0) {
        printf(STDERR "=" x $len . "\n");
        printf(STDERR q{ } . $msg . "\n");
        printf(STDERR "=" x $len . "\n");
    }
}

sub lsumpopt_given_by_goosec2q {
    my ($fileid, $qfiles_ref, $opt_ref) = @_;
    my @qfiles = @{$qfiles_ref};

    for my $loopid (0..$#qfiles) {
        $opt_ref->[$loopid] = [];
        my $qfile = $qfiles[$loopid];
        my $dict = gs_get_opt_from_dictfile($qfile . '.opt');
        my @dictkeys = (keys %{$dict});
        my $dictval;
        for (@dictkeys) {
            /precision/ and do {
                $dictval = $dict->{$_};
                vprintf("$_ : $dictval\n");
                for ($dictval) {
                    /\A single \z/xms and do {
                        push @{$opt_ref->[$loopid]}, '-S';
                        next;
                    };
                    /\A double \z/xms and do {
                        push @{$opt_ref->[$loopid]}, '-D';
                        next;
                    };
                    /\A double-single \z/xms and do {
                        push @{$opt_ref->[$loopid]}, '-DS';
                        next;
                    };
                    /\A quadruple \z/xms and do {
                        push @{$opt_ref->[$loopid]}, '-DD';
                        next;
                    };
                    /.*/ and do {
                        croak "invalid 'precision' parameter '$_'. abort.\n";
                        next;
                    };
                }
                ;
                next;
            };
        }
    }
}

sub valtfile_given_by_goosec2q {
    my ($fileid, $qfiles_ref, $valtfile_ref) = @_;
    my @qfiles = @{$qfiles_ref};

    for my $loopid (0..$#qfiles) {
        my $qfile = $qfiles[$loopid];
        my $dict = gs_get_opt_from_dictfile($qfile . '.opt');
        my @dictkeys = (keys %{$dict});
        my $dictval;
        for (@dictkeys) {
            /asmfile/ and do {
                $dictval = $dict->{$_};
                vprintf("$_ : $dictval\n");
                $valtfile_ref->[$fileid][$loopid] = $dictval;
            }
        }
    }
}
