#!/usr/bin/perl -w

# Copyright (C) CNRS, INRIA, Université Bordeaux 1, Télécom SudParis
# See COPYING in top-level directory.


my $prefix;
my $libdir;
my $includedir;
my $bindir;
my $topdatadir;

BEGIN {
    $prefix="@prefix@";
    $libdir="@INSTALL_LIBDIR@";
    $includedir="@INSTALL_INCLUDEDIR@";
    $bindir="@INSTALL_BINDIR@";
    $topdatadir="@INSTALL_INPUTDIR@";
    $input_dir="${topdatadir}/eztrace";
}

use lib "${input_dir}";
use function;
use Getopt::Long;
use Pod::Usage;

my $common_cflags="`pkg-config --cflags eztrace`";
my $common_ldflags="`pkg-config --libs eztrace`";

my $header_name;
my $module_name;
my $module_desc;
my $language;

my $record_callbacks = "";
my $record_functions = "";
my $sampling_functions = "";
my $post_init = "";
my $record_intercepts = "";
my $record_counters = "";
my $event_definition = "";

my $cur_line = 0;
my $cur_function;

my %variables;

my $include_str="";
my $header_user="";

my $output_dir="output";

my $keep_this_line = 0;

sub parse_options {
    my $man = 0;
    my $help = 0;
    my $includedir_str = "";
    GetOptions ('include_dir|I=s' => \$includedir_str,
		'output|o=s' => \$output_dir,
		'help|h' => \$help,
		man => \$man) or pod2usage(2);

    pod2usage(1) if $help;
    pod2usage(-exitstatus => 0, -verbose => 2) if $man;

    # Convert list of include directories to -I option
    foreach  my $dir ( split( ',', $includedir_str ) )
    { 
        $common_cflags .= " -I$dir";
    }
}

parse_options();

# Create the identifier of a variable.
# params:
#     $var_name Name of the variable (may contain spaces)
sub register_var_name( $ ) {
    my $var_name = shift;
    my $var_id_prefix = "${module_name}_VAR_";

    $nb_vars = values(%variables);
    my $var_id = "${var_id_prefix}_${nb_vars}";

    while (($c,$v) = each(%variables)) {
	if($v eq $var_name) {
	    return "${var_id_prefix}_${c}";
	}
    }
    $nb_vars = values(%variables);
    $variables{$nb_vars}=$var_name;

    $convert_init .= <<END;
    if(get_mode() == EZTRACE_CONVERT) {
	addVarType("$var_id", "$var_name", "CT_Process");
    }
END

    return $var_id;
}

# Add an event that pushes a new state
# params:
#     $fname function name
#     $state_description description of the state in the output trace
sub add_PUSH_STATE($$) {
    my $fname = shift;
    my $state_description = shift;

    $cur_function->add_body("FUNCTION_ENTRY;");
}

# Add an event that restore the previous state
# params:
#     $fname function name
sub add_POP_STATE( $ ) {
    my $fname = shift;
    $cur_function->add_body("FUNCTION_EXIT;");
}


# Add an LiTL event and fills the convert file in order to interpret
# it as a addEvent
# params:
#     $fname function name
#     $event_description description of the event in the output trace
sub add_EVENT($$) {
    my $fname = shift;
    my $event_description = shift;

    printf "add_EVENT not implemented !\n";
    exit -1;

#    $cur_function->add_event($cur_event_name);
#    convert_function_event($cur_event_name, $event_description);
}


# Add an LiTL event and fills the convert file in order to interpret
# it as a set_var
# params:
#     $fname function name
#     $var_name Name of the variable
#     $var_value Value of the variable
sub add_SET_VAR($$$) {
    my $fname = shift;
    my $var_name = shift;
    my $var_value = shift;

    printf "add_SET_VAR not implemented !\n";
    exit -1;

#    $var_id = register_var_name($var_name);

#    $cur_function->add_event($cur_event_name);
#    convert_function_set_var($cur_event_name, $var_id, $var_value);
}

# Add an LiTL event and fills the convert file in order to interpret
# it as a add_var
# params:
#     $fname function name
#     $var_name Name of the variable
#     $var_value Value of the variable
sub add_ADD_VAR( $$$ ) {
    my $fname = shift;
    my $var_name = shift;
    my $var_value = shift;

    printf "add_ADD_VAR not implemented !\n";
    exit -1;

    #   $var_id = register_var_name($var_name);
 
#    $cur_function->add_event($cur_event_name);
#    convert_function_add_var($cur_event_name, $var_id, $var_value);
}

# Add an LiTL event and fills the convert file in order to interpret
# it as a sub_var
# params:
#     $fname function name
#     $var_name Name of the variable
#     $var_value Value of the variable
sub add_SUB_VAR( $$$ ) {
    my $fname = shift;
    my $var_name = shift;
    my $var_value = shift;

    printf "add_SUB_VAR not implemented !\n";
    exit -1;
#    $var_id = register_var_name($var_name);

#    $cur_function->add_event($cur_event_name);
#    convert_function_sub_var($cur_event_name, $var_id, $var_value);
}

sub write_sampling_function( $$$ ) {
    my $fname = shift;
    my $interval = shift;
    my $code = shift;

    printf "write_sampling_function not implemented !\n";
    exit -1;

    @liste = split("\n",$code);
    foreach $instruction (@liste) {

	if( $instruction =~ m/\s*SAMPLING_RECORD\s*\([^\,]+\s*\,\s*[^\,]+\s*\)/ ) {
# detect SAMPLING_RECORD(value, description)
# and replace it by:
# EZTRACE_RECORD1($event_name, value)
	    ($value, $description) = ($instruction =~ m/\s*SAMPLING_RECORD\s*\(([^\,]+)\s*\,\s*([^\,]+)\s*\)/);
	    $sampling_functions .= "$`EZTRACE_EVENT_PACKED_1($cur_event_name, $value)$'";


# Create the variable during initialisation
	    $convert_init .= <<END;
	    if(get_mode() == EZTRACE_CONVERT) {
		addVarType ("VT_$cur_event_name", $description, "CT_Thread");
	    }
END

# Create the function that processes the event
		$convert_function_body .= <<END;
	    void handle$cur_event_name() {
		FUNC_NAME;
		DECLARE_THREAD_ID_STR(thread_id, CUR_INDEX, CUR_THREAD_ID);
		DECLARE_CUR_THREAD(p_thread);
		INIT_${module_name}_THREAD_INFO(p_thread, ptr);
		double value = GET_PARAM(CUR_EV, 1);
		CHANGE() setVar(CURRENT, "VT_$cur_event_name", thread_id, value);
	    }
END

	} else  {

# 'normal' instruction. Simply copy it
	    $sampling_functions .= "$instruction\n";
	}
    }
    $post_init .= "ezt_sampling_register_callback($fname, $interval);\n";

    printf "Sampling Function '%s' (interval=%d) done\n", $fname, $interval;
}

sub define_sampling_function {
    my $fname="";
    my $interval=0;

    printf "write_sampling_function not implemented !\n";
    exit -1;

    # $_ should look like this:
    # ( function_name, interval)
    if( /\s*\(\s*\w+\s*\,\s*\w+\s*\)/) {
	# extract "(fname,interval)"

	($fname, $interval) = ($_ =~ m/\s*\(\s*(\w+)\s*\,\s*(\w+)\s*\)/);
	# this line contains ( so let's copy the beginning
	# of the line in the prototype.
	s/\s*\(\s*(\w+)\s*\,\s*(\w+)\s*\)//;
    } else {
	printf "Invalid format!\n";
	exit -1;
    };

    my $function_code="";
# copy the source code of the function
    do {
	if(/\s*END_DEFINE/) {
	    s/\s*END_DEFINE//;
	    goto out;
	}

	$function_code .= $_;
	chomp;
    } while(<>);

out:
    write_sampling_function($fname, $interval, $function_code);
}

sub handle_function {
    my $rettype;
    my $fname="";
    my @args;
    my $nb_arg;

    $nb_arg=0;
    my $new_callback = "";
    my $new_function;
    my $function_body="";

    $cur_function = Function->new();
    $cur_function->set_type($module_type);

# retrieve the return type and the function name
    my $proto_string = "";
    do {
      SWITCH: {
	  /^$/ && do {
	      next;
	  };

	  /.*\.\.\..*/ && do {
	      $proto_string.=$_;
	      printf "Cannot process Function '%s'\n", $proto_string;
	      return;
	  };

	  /\(/ && ($fname eq "") && do {
	      # this line contains ( so let's copy the beginning
	      # of the line in the prototype.
	      my $line_len = index($_, "\(");
	      $proto_string .= substr($_, 0, $line_len);

	      # in order to ease the parsing, add a space after each * we find
	      $proto_string =~ s/\*/\* /g;

	      # extract the return type and the function name
	      ($rettype, $fname) = ($proto_string =~ m/^\s*([\S+\s*]+\**)\s+(\S+)\s*$/);

	      substr($_, 0, $line_len, "");
	      s/\s*\(\s*//;

	      $proto_string = "";
	  };

	  /\)/ && do {
	      my $line_len = index($_, "\)");
	      $proto_string .= substr($_, 0, $line_len);
	      # remove multiple spaces/newlines
	      $proto_string =~ s/\s+/ /g;
	      $proto_string =~ s/\n+/ /g;
	      $proto_string =~ s/^\s*//g;
	      $proto_string =~ s/\s*$//g;

	      goto body;
	      next;
	  };
	  do {
	      $proto_string .= $_;
	  };
	}
    } while(<>);

body:
    # first, let's fill the Function object
    $cur_function->set_fname($fname);
    $cur_function->set_ret_type($rettype);

    # extract all the parameters for this function and give them
    # once at a time to the Function class
    my @params= (split m/,\s*/, $proto_string);

    my $i;
    my $nb_param=0;
    for($i=0; $i<@params; $i++) {
	my $cur_param = $params[$i];

#remove trailing white spaces
	$cur_param =~ s/^\s*//g;
	$cur_param =~ s/\s*$//g;

	my $arg_name ="";
	my $arg_type="";
	my $suffix="";

# extract [] (if any)
	if( $cur_param =~ m/((\[\s*\]\s*)+)/) {
	    ($suffix) = ($cur_param =~  m/((\[\s*\]\s*)+)/);
	    $cur_param =~ s/((\[\s*\]\s*)+)/ /g;
	    # convert [] into * (so that we can declare the parameter as "int []a")
	    $suffix =~ s/\[\s*\]/\*/g;
	}

# extract * (if any)
	if( $cur_param =~ m/((\*\s*)+)/) {
	    ($suffix) = ($cur_param =~  m/((\*\s*)+)/);
	    $cur_param =~ s/((\*\s*)+)/ /g;
	}

# extract the parameter name
	$arg_name = (split m/\s+/, $cur_param)[-1];

# the remaining is the parameter type
	$arg_type = $cur_param;

	# escape special characters in arg_name (eg. []) so that they are not
	# interpreted during the substitution
	my $arg_name_pat=quotemeta($arg_name);
	$arg_type =~ s/\s*$arg_name_pat\s*$//;

# add the [] or * that were found
	$arg_type .= $suffix;
	if($arg_name ne "" && $arg_type ne "") {
	    $nb_param++;
	    $cur_function->add_arg($arg_type, $arg_name);
	}
    }

    my $begin_detected = 0;
    while(<>) {
	SWITCH: {
	    /^$/ && do {
		next;
	    };

	    /^\s*BEGIN\s/ && do {
		$begin_detected = 1;
		$new_callback = $cur_function->create_callback();
		next;
	    };

	    /^\s*CALL_FUNC/ && do {
		chomp;
		$cur_function->add_fcall();
		next;
	    };

# handling of states
	    /^\s*PUSH_STATE/ && do {
		chomp;
		s/^\s*PUSH_STATE\s*\(\"//;
		s/\s*\"\)//;
		s/\s*$//;
		$state_description=$_;
		$event = add_PUSH_STATE($fname, $state_description);
		next;
	    };

	    /^\s*POP_STATE/ && do {
		chomp;
		$event = add_POP_STATE($fname);
		next;
	    };

	    /^\s*RECORD_STATE/ && do {
		chomp;
		s/^\s*RECORD_STATE\s*\(\"//;
		s/\s*\"\)//;
		s/\s*$//;
		$state_description=$_;

		# push
		my $event = add_PUSH_STATE($fname, $state_description);
                # fcall
		$cur_function->add_fcall();
		# pop
		$event = add_POP_STATE($fname);
		next;
	    };

# handling of events
	    /^\s*EVENT/ && do {
		chomp;
		s/^\s*EVENT\s*\(\"//;
		s/\s*\"\)//;
		s/\s*$//;
		$event_description=$_;
		$event = add_EVENT($fname, $event_description);
		next;
	    };

# handling of variables
	    /^\s*SET_VAR/ && do {
		chomp;
		s/^\s*SET_VAR\s*\(\"//;

		# retrieve the var name
		$var_name_len = index($_, "\"");
		if($var_name_len < 0) {
		    printf "line $cur_line: syntax error in SET_VAR\n";
		    exit(1);
		}
		$var_name=substr($_, 0, $var_name_len);

		# remove the var name and the trailing ",
		s/^$var_name\",\s*//;
		# remove the ')' at the end of the line
		s/\s*\)\s*$//;
		$var_value=$_;

		$event = add_SET_VAR($fname, $var_name, $var_value);
		next;
	    };

	    /^\s*ADD_VAR/ && do {
		chomp;
		s/^\s*ADD_VAR\s*\(\"//;

		# retrieve the var name
		$var_name_len = index($_, "\"");
		if($var_name_len < 0) {
		    printf "line $cur_line: syntax error in ADD_VAR\n";
		    exit(1);
		}
		$var_name=substr($_, 0, $var_name_len);

		# remove the var name and the trailing ",
		s/^$var_name\",\s*//;
		# remove the ')' at the end of the line
		s/\s*\)\s*$//;
		$var_value=$_;

		$event = add_ADD_VAR($fname, $var_name, $var_value);
		next;
	    };

	    /^\s*SUB_VAR/ && do {
		chomp;
		s/^\s*SUB_VAR\s*\(\"//;

		# retrieve the var name
		$var_name_len = index($_, "\"");
		if($var_name_len < 0) {
		    printf "line $cur_line: syntax error in SUB_VAR\n";
		    exit(1);
		}
		$var_name=substr($_, 0, $var_name_len);

		# remove the var name and the trailing ",
		s/^$var_name\",\s*//;
		# remove the ')' at the end of the line
		s/\s*\)\s*$//;
		$var_value=$_;

		$event = add_SUB_VAR($fname, $var_name, $var_value);
		next;
	    };

	    /^\s*END\s/ && do {
		$new_function = $cur_function->create_function();
		goto out;
	    };

	    if($begin_detected == 0) {
		# there was only the function prototype
		# Let's say that the user wants RECORD_STATE
		printf "\temulate record_state for '$fname'\n";
		$new_callback = $cur_function->create_callback();
		# push
		my $event = add_PUSH_STATE($fname, "Doing function $fname");
                # fcall
		$cur_function->add_fcall();
		# pop
		$event = add_POP_STATE($fname);
		$new_function = $cur_function->create_function();

		$keep_this_line = 1;
		goto out;
	    }

	    printf "line $cur_line: unknown command '$_'\n";
	    exit 1;
	}
	  $cur_line++;
    };

out:
    $new_intercept = $cur_function->create_intercept();

    $record_intercepts .= "$new_intercept\n";
    $record_callbacks .= "$new_callback\n";
    $record_functions .= "$new_function\n";
    printf "Function '%s' done\n", $fname;
}

sub handle_includes {
    while(<>) {
	$cur_line++;
	SWITCH: {
	    /^\s*END_INCLUDE/ && do {
		return;
	    };
	    do {
		$header_user .= $_;
	    };
	}
    }
}

sub handle_cflags {
    my $cflags = " ";
    while(<>) {
	$cur_line++;
	SWITCH: {
	    /^\s*END_CFLAGS/ && do {
		goto end;
	    };
	    /^\s*#/ && do {
		next;
	    };
	    do {
		$cflags .= $_;
	    };
	}
    }
end:
    $cflags =~ s/\n/ /g;
    $common_cflags .= $cflags
}

sub handle_ldflags {
    my $ldflags = " ";
    while(<>) {
	$cur_line++;
	SWITCH: {
	    /^\s*END_LDFLAGS/ && do {
		goto end;
	    };
	    /^\s*#/ && do {
		next;
	    };
	    do {
		$ldflags .= $_;
	    };
	}
    }
end:
    $ldflags =~ s/\n/ /g;
    $common_ldflags .= $ldflags
}



while (<>) {
    $cur_line++;
main_loop:
    if($keep_this_line == 1) {
	$keep_this_line = 0;
    }

    SWITCH: {
	/^\s*$/ && do {
	    next;
	};

	/^\s*BEGIN_MODULE/ && do {
	    printf "New Module\n";
	    next;
	};

	/^\s*END_MODULE/ && do {
	    printf "End of Module $module_name\n";
	    goto end_module;
	};

	/^\s*BEGIN_INCLUDE/ && do {
	    s/^\s*BEGIN_INCLUDE\s*//;
	    # remove trailing whitespaces
	    s/\s*$//;
	    handle_includes;
	    next;
	};

	/^\s*BEGIN_CFLAGS/ && do {
	    s/^\s*BEGIN_CFLAGS\s*//;
	    # remove trailing whitespaces
	    s/\s*$//;
	    handle_cflags;
	    next;
	};

	/^\s*BEGIN_LDFLAGS/ && do {
	    s/^\s*BEGIN_LDFLAGS\s*//;
	    # remove trailing whitespaces
	    s/\s*$//;
	    handle_ldflags;
	    next;
	};

	/^\s*NAME/ && do {
	    s/^\s*NAME\s*//;
	    # remove trailing whitespaces
	    s/\s*$//;
	    chomp;
	    $module_name=$_;
	    if (!$module_name) { print "Choose a name for your module : operation stopped\n"; exit 1; }
	    printf "Module name : '$module_name'\n";
	    next;
	};
	/^\s*DESC/ && do {
	    chomp;
	    s/^\s*DESC\s*//;
	    # remove trailing whitespaces
	    s/\s*$//;
	    $module_desc=$_;
	    printf "Module description : '$module_desc'\n";
	    next;
	};
	/^\s*LANGUAGE/ && do {
	    chomp;
	    s/^\s*LANGUAGE\s*//;
	    # remove trailing whitespaces
	    s/\s*$//;
	    $language=$_;
	    printf "Language : '$language'\n";
	    next;
	};

# DEFINE_SAMPLING_FUNCTION(function_name, interval)
# code function
# END_DEFINE
	/^\s*DEFINE_SAMPLING_FUNCTION/ && do {
	    chomp;
	    s/^\s*DEFINE_SAMPLING_FUNCTION//;
	    define_sampling_function;
	    next;
	};

	/^\s*\#/ && do {
	    # this is a comment, skip this line
	    next;
	};

	do {
	    chomp;
	    handle_function;
	    if($keep_this_line == 1) {
		goto main_loop;
	    }
	    next;
	};
    }
}

sub apply_changes($$) {

    my $ifile = shift;
    my $ofile = shift;

    open(OUTPUT_FILE, "> $ofile") or die "can't open $ofile";
    open(INPUT_FILE, "< $ifile") or die "can't open $ifile";

    while(<INPUT_FILE>)
    {
	s/\@MODULE\@/$module_name/g;
	s/\@MODULE_DESC\@/$module_desc/g;
	s/\@HEADER_USER\@/$header_user/g;

	s/\@RECORD_CALLBACKS\@/$record_callbacks/g;
#	s/\@RECORD_COUNTERS\@/$record_counters/g;
	s/\@RECORD_FUNCTIONS\@/$record_functions/g;
#	s/\@SAMPLING_FUNCTIONS\@/$sampling_functions/g;
	s/\@POST_INIT\@/$post_init/g;
	s/\@RECORD_INTERCEPTS\@/$record_intercepts/g;

	s/\@CUSTOM_CFLAGS\@/$common_cflags/g;
	s/\@CUSTOM_LDFLAGS\@/$common_ldflags/g;

	(print OUTPUT_FILE $_);
    }

    close(OUTPUT_FILE) or die "can't close $ofile";
    close(INPUT_FILE) or die "can't close $ifile";
}

end_module:

`mkdir -p $output_dir`;

my $input_file = "${input_dir}/example.c.template";
my $input_makefile = "${input_dir}/Makefile.template";

$output_file="${module_name}.c";
$output_makefile="Makefile";

apply_changes($input_file, "$output_dir/$output_file");
apply_changes($input_makefile, "$output_dir/$output_makefile");


__DATA__

=head1 NAME

eztrace_create_plugin - Generate EZTrace plugins

=head1 SYNOPSIS

Generate EZTrace plugins.

eztrace_create_plugin [options] file

  Options:
    -I, --include_dir <incdir1,incdir2,...>       include directories
    -o, --ouput <dir>              output directory
    -h, --help                     brief help message
    --man                          full documentation

=head1 OPTIONS

=over 8

=item B<-I <incdir1,incdir2,...>, --include_dir=<incdir1,incdir2,...>>

    Add specific include directories for the compilation of the generated code.

=item B<-o <dir>, --output=<dir>>

    Select the output directory.

=item B<-h --help>

    Print a brief help message and exits.

=item B<--man>

    Prints the manual page and exits.

=back

=head1 DESCRIPTION

    B<This program> will read the given input file(s) and do something
    useful with the contents thereof.

=cut
