#!/usr/bin/perl -w
my $prefix;
my $exec_prefix;
my $libdir;
my $includedir;
my $bindir;

BEGIN {
    $prefix="@prefix@";
    $exec_prefix="@exec_prefix@";
    $libdir="@libdir@";
    $includedir="@includedir@";
    $bindir="@bindir@";
}

use lib "$bindir";
use function;
use Getopt::Long;
use Pod::Usage;

my $gtg_cflags="@GTG_CPPFLAGS@";
my $gtg_ldflags="@GTG_LDFLAGS@";

my $fxt_cflags="@FXT_CPPFLAGS@";
my $fxt_ldflags="@FXT_LDFLAGS@";

my $common_cflags="$gtg_cflags $fxt_cflags";
my $common_ldflags="";

my $convert_ldflags="$gtg_ldflags $fxt_ldflags";
my $record_ldflags="$fxt_ldflags";
my $dyninst_ldflags="";

my $header_name;
my $module_name;
my $module_desc;
my $module_type="LIBRARY";
my $module_id=99;
my $language;

my $record_callbacks = "";
my $record_functions = "";
my $record_intercepts = "";
my $event_definition = "";
my $convert_functions_prototypes = "";
my $convert_case = "";
my $convert_function_body = "";
my $convert_init = "";

my $next_event_id = 0x0001;

my $cur_line = 0;
my $cur_function;
my $cur_event_start_name;
my $cur_event_stop_name;
my $cur_event_start_code;
my $cur_event_stop_code;

my $next_gtg_state_id = 0;
my $next_gtg_event_id = 0;

my %variables;

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

my $output_dir="output";
my $input_dir="${includedir}";

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();

sub convert_add_prototype( $ ) {
    my $ev_code = shift;

    $convert_functions_prototypes .= <<END;
void handle$ev_code() ;
END
}

sub convert_add_switch_case( $ ) {
    my $ev_code = shift;

    $convert_case .= <<END;
	case $ev_code:
	handle$ev_code();
        break;
END
}

# do all the necessary stuff in the convert part for handling a push state
sub convert_function_push_state {
    my ($ev_code, $state_desc) = @_;

    convert_add_prototype($ev_code);
    convert_add_switch_case($ev_code);

    $cur_state_id="${module_name}_STATE_$next_gtg_state_id";
    $next_gtg_state_id++;

    $convert_init .= <<END;
    addEntityValue("$cur_state_id", "ST_Thread", "$state_desc", GTG_PINK);
END

    $convert_function_body .= <<END;
void handle$ev_code() {
    FUNC_NAME;
    DECLARE_THREAD_ID_STR(thread_id, CUR_INDEX, CUR_THREAD_ID);
    CHANGE() pushState (CURRENT, "ST_Thread", thread_id, "$cur_state_id");
}
END

}

# do all the necessary stuff in the convert part for handling a pop state
sub convert_function_pop_state {
    my ($ev_code) = @_;

    convert_add_prototype($ev_code);
    convert_add_switch_case($ev_code);

    $convert_function_body .= <<END;
void handle$ev_code() {
    FUNC_NAME;
    DECLARE_THREAD_ID_STR(thread_id, CUR_INDEX, CUR_THREAD_ID);
    CHANGE() popState (CURRENT, "ST_Thread", thread_id);
}
END

}

# do all the necessary stuff in the convert part for handling an addEvent
sub convert_function_event {
    my ($ev_code, $event_desc) = @_;

    convert_add_prototype($ev_code);
    convert_add_switch_case($ev_code);

    $cur_event_id="${module_name}_EVENT_$next_gtg_event_id";
    $next_gtg_event_id++;

    $convert_init .= <<END;
    addEventType("$cur_event_id", "CT_Thread", "$event_desc");
END

    $output_asprintf = $cur_function->create_asprintf("opt_value_${ev_code}");

    $convert_function_body .= <<END;
void handle$ev_code() {
    FUNC_NAME;
    DECLARE_THREAD_ID_STR(thread_id, CUR_INDEX, CUR_THREAD_ID);
    char* opt_value_${ev_code} = NULL;
    ${output_asprintf}
    CHANGE() addEvent (CURRENT, "$cur_event_id", thread_id, opt_value_${ev_code});
    free(opt_value_${ev_code});
}
END

}


sub convert_function_set_var {
    my ($ev_code, $var_id, $var_value) = @_;

    convert_add_prototype($ev_code);
    convert_add_switch_case($ev_code);

    $convert_function_body .= <<END;
void handle$ev_code() {
    FUNC_NAME;
    DECLARE_THREAD_ID_STR(thread_id, CUR_INDEX, CUR_THREAD_ID);
    CHANGE() setVar (CURRENT, "$var_id", thread_id, $var_value);
}
END
}

sub convert_function_add_var {
    my ($ev_code, $var_id, $var_value) = @_;

    convert_add_prototype($ev_code);
    convert_add_switch_case($ev_code);

    $convert_function_body .= <<END;
void handle$ev_code() {
    FUNC_NAME;
    DECLARE_THREAD_ID_STR(thread_id, CUR_INDEX, CUR_THREAD_ID);
    CHANGE() addVar (CURRENT, "$var_id", thread_id, $var_value);
}
END
}

sub convert_function_sub_var {
    my ($ev_code, $var_id, $var_value) = @_;

    convert_add_prototype($ev_code);
    convert_add_switch_case($ev_code);

    $convert_function_body .= <<END;
void handle$ev_code() {
    FUNC_NAME;
    DECLARE_THREAD_ID_STR(thread_id, CUR_INDEX, CUR_THREAD_ID);
    CHANGE() subVar (CURRENT, "$var_id", thread_id, $var_value);
}
END
}


# Create a new FxT event. You can then manipulate this event
# using $cur_event_name
# params:
#     $fname function name
sub new_event($) {
    my $fname = shift;
    $cur_event_name=sprintf("FUT_%s_%s_%d", $module_name, $fname, $next_event_id);
    $cur_event_code=sprintf("0x%x", $next_event_id);
    $next_event_id++;
    $event_definition .= "#define $cur_event_name (${module_name}_PREFIX | $cur_event_code)\n";
}


# 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;
    addVarType("$var_id", "$var_name", "CT_Process");
END

    return $var_id;
}

# Add an FxT event and the fills the convert file in order to interpret
# it as a push_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;

    new_event($fname);
    $cur_function->add_event($cur_event_name);
    convert_function_push_state($cur_event_name, $state_description);
}

# Add an FxT event and the fills the convert file in order to interpret
# it as a pop_state
# params:
#     $fname function name
sub add_POP_STATE( $ ) {
    my $fname = shift;
    new_event($fname);
    $cur_function->add_event($cur_event_name);
    convert_function_pop_state($cur_event_name);
}


# Add an FxT 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;

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


# Add an FxT 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;

    $var_id = register_var_name($var_name);

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

# Add an FxT 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;

    $var_id = register_var_name($var_name);

    new_event($fname);
    $cur_function->add_event($cur_event_name);
    convert_function_add_var($cur_event_name, $var_id, $var_value);
}

# Add an FxT 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;

    $var_id = register_var_name($var_name);

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

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;
	  };

	  /\(/ && ($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);
	      $fname = (split m/\s+/, $proto_string)[-1];
	      $proto_string =~ s/\s*$fname\s*//;
	      $rettype = $proto_string;
	      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;
    for($i=0; $i<@params; $i++) {
	my $cur_param = $params[$i];

	$cur_param =~ s/^\s*//g;
	$cur_param =~ s/\s*$//g;

	my $arg_name = (split m/\s+\**/, $cur_param)[-1];
	my $arg_type = $cur_param;
	$arg_type =~ s/\s*$arg_name\s*$//;
	$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 .= $_;
	    };
	}
    }
}


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*NAME/ && do {
	    s/^\s*NAME\s*//;
	    # remove trailing whitespaces
	    s/\s*$//;
	    chomp;
	    $module_name=$_;
	    printf "Module name : '$module_name'\n";
	    next;
	};
	/^\s*ID/ && do {
	    s/^\s*ID\s*//;
	    # remove trailing whitespaces
	    s/\s*$//;
	    chomp;
	    $module_id=$_;
	    printf "Module id : '$module_id'\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;
	};
	/^\s*TYPE/ && do {
	    chomp;
	    s/^\s*TYPE\s*//;
	    # remove trailing whitespaces
	    s/\s*$//;
	    my $type=$_;
	    if($type eq "LIBRARY") {
		printf "Type : library\n";
	    } elsif($type eq "APPLICATION") {
		printf "Type : application\n";
	    } else {
		printf "line $cur_line: Unknown module type: '$type'\n";
		printf "\tfailing back to default ($module_type)\n";
		$type = $module_type;
	    }
	    $module_type = $type;
	    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_FILE\@/$output_header/g;
	s/\@HEADER_USER\@/$header_user/g;
	s/\@RECORD_CALLBACKS\@/$record_callbacks/g;
	s/\@RECORD_FUNCTIONS\@/$record_functions/g;
	s/\@RECORD_INTERCERPTS\@/$record_intercepts/g;
	s/\@EVENT_DEFINITION\@/$event_definition/g;
	s/\@MODULE_ID\@/$module_id/g;
	s/\@CONVERT_FUNCTIONS_PROTOTYPES\@/$convert_functions_prototypes/g;
	s/\@CONVERT_FUNCTIONS_BODY\@/$convert_function_body/g;
	s/\@CONVERT_CASE\@/$convert_case/g;
	s/\@CONVERT_INIT\@/$convert_init/g;

	s/\@CUSTOM_CFLAGS\@/$common_cflags/g;
	s/\@CUSTOM_LDFLAGS\@/$common_ldflags/g;
	s/\@CONVERT_LDFLAGS\@/$convert_ldflags/g;
	s/\@RECORD_LDFLAGS\@/$record_ldflags/g;
	s/\@DYNINST_LDFLAGS\@/$dyninst_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;
my $input_makefile;

if($module_type eq "LIBRARY") {
    $input_file = "${input_dir}/example.c.template";
    $input_makefile = "${input_dir}/Makefile.template";
} else {
    $input_file = "${input_dir}/example_dyninst.c.template";
    $input_makefile = "${input_dir}/Makefile_dyninst.template";
}

my $input_eztrace_file="${input_dir}/eztrace_convert_example.c.template";
my $input_header="${input_dir}/example_ev_codes.h.template";

$output_header="${module_name}_ev_codes.h";
$output_eztrace_file="eztrace_convert_${module_name}.c";
$output_file="${module_name}.c";
$output_makefile="Makefile";


apply_changes($input_file, "$output_dir/$output_file");
apply_changes($input_eztrace_file, "$output_dir/$output_eztrace_file");
apply_changes($input_header, "$output_dir/$output_header");
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
