#! /usr/bin/perl
#
#  TOPPERS Software
#      Toyohashi Open Platform for Embedded Real-Time Systems
# 
#  Copyright (C) 2007-2008 by Embedded and Real-Time Systems Laboratory
#              Graduate School of Information Science, Nagoya Univ., JAPAN
# 
#  嵭Ԥϡʲ(1)(4)ξ˸¤ꡤܥեȥ
#  ܥեȥѤΤޤࡥʲƱˤѡʣ
#  ѡۡʰʲѤȸƤ֡ˤ뤳Ȥ̵ǵ롥
#  (1) ܥեȥ򥽡ɤηѤˤϡ嵭
#      ɽѾ浪Ӳ̵ݾڵ꤬Τޤޤηǥ
#      ˴ޤޤƤ뤳ȡ
#  (2) ܥեȥ򡤥饤֥ʤɡ¾Υեȥȯ˻
#      ѤǤǺۤˤϡۤȼɥȡ
#      ԥޥ˥奢ʤɡˤˡ嵭ɽѾ浪Ӳ
#      ̵ݾڵǺܤ뤳ȡ
#  (3) ܥեȥ򡤵Ȥ߹ʤɡ¾Υեȥȯ˻
#      ѤǤʤǺۤˤϡΤ줫ξ
#      ȡ
#    (a) ۤȼɥȡѼԥޥ˥奢ʤɡˤˡ嵭
#        ɽѾ浪Ӳ̵ݾڵǺܤ뤳ȡ
#    (b) ۤη֤̤ˡˤäơTOPPERSץȤ
#        𤹤뤳ȡ
#  (4) ܥեȥѤˤľŪޤϴŪ뤤ʤ»
#      ⡤嵭ԤTOPPERSץȤդ뤳ȡ
#      ޤܥեȥΥ桼ޤϥɥ桼Τʤ
#      ͳ˴Ťᤫ⡤嵭ԤTOPPERSץȤ
#      դ뤳ȡ
# 
#  ܥեȥϡ̵ݾڤ󶡤ƤΤǤ롥嵭Ԥ
#  TOPPERSץȤϡܥեȥ˴ؤơλŪ
#  ФŬޤơʤݾڤԤʤޤܥեȥ
#  ѤˤľŪޤϴŪʤ»˴ؤƤ⡤
#  Ǥʤ
# 
#  @(#) $Id: gentest 1546 2009-05-08 10:05:22Z ertl-hiro $
# 

#
#		ƥȥץġ
#

$infile = $ARGV[0];

%parampos = (
	"get_pri" => 2,
	"get_inf" => 1,
	"ref_tsk" => 2,
	"ref_tex" => 2,
	"ref_sem" => 2,
	"ref_flg" => 2,
	"ref_dtq" => 2,
	"ref_pdq" => 2,
	"ref_mbx" => 2,
	"ref_mtx" => 2,
	"ref_mpf" => 2,
	"get_tim" => 1,
	"get_utm" => 1,
	"ref_cyc" => 2,
	"ref_alm" => 2,
	"get_tid" => 1,
	"iget_tid" => 1,
	"get_ipm" => 1,
);

%paramtype = (
	"get_pri" => "PRI",
	"get_inf" => "intptr_t",
	"ref_tsk" => "T_RTSK",
	"ref_tex" => "T_RTEX",
	"ref_sem" => "T_RSEM",
	"ref_flg" => "T_RFLG",
	"ref_dtq" => "T_RDTQ",
	"ref_pdq" => "T_RPDQ",
	"ref_mbx" => "T_RMBX",
	"ref_mtx" => "T_RMTX",
	"ref_mpf" => "T_RMPF",
	"get_tim" => "SYSTIM",
	"get_utm" => "SYSUTM",
	"ref_cyc" => "T_RCYC",
	"ref_alm" => "T_RALM",
	"get_tid" => "ID",
	"iget_tid" => "ID",
	"get_ipm" => "PRI",
);

sub gen_var_def {
	local($svc_call) = @_;
	local($svcname, @params);
	local($typename, $varname);

	if ($svc_call =~ /^([a-z_]+)\((.*)\)$/) {
		$svcname = $1;
		@params = split(/\s*,\s*/, $2);

		if ($parampos{$svcname}) {
			$varname = $params[@parampos{$svcname} - 1];
			$varname =~ s/^\&//;
			$typename = $paramtype{$svcname};
			${$TASKVAR{$tskid}}{$typename} = ${varname};
		}
	}
}

sub gen_svc_call {
	local($svc_call, $error_code_string) = @_;
	local($error_code);

	$TASKCODE{$tskid} .= $indentstr;
	$TASKCODE{$tskid} .= sprintf("ercd = %s;\n", $svc_call);
	do gen_var_def($svc_call);

	if ($error_code_string eq "") {
		$TASKCODE{$tskid} .= $indentstr;
		$TASKCODE{$tskid} .= sprintf("check_ercd(ercd, E_OK);\n");
	}
	elsif ($error_code_string =~ /^\-\>\s*noreturn$/) {
		# do nothing.
	}
	else {
		$error_code = $error_code_string;
		$error_code =~ s/^\-\>\s*([A-Z_]*)$/$1/;
		$TASKCODE{$tskid} .= $indentstr;
		$TASKCODE{$tskid} .= sprintf("check_ercd(ercd, %s);\n", $error_code);
	}
}

sub parse_line {
	local($line) = @_;

	if ($line =~ /^\.\./) {
		# do nothing.
	}
	elsif ($line =~ /^==\s*((TASK|ALM)[0-9]+)(.*)$/) {
		$startflag = 1;
		$tskid = $1;
		$line2 = $3;
		if ($line2 =~ /^\-([0-9]+)/) {
			$tskcount = $1;
			$indentstr = "\t\t";
			if (!$TASKCOUNT{$tskid}) {
				$TASKCOUNT{$tskid} = 0;
				if ($tskid =~ /^TASK([0-9]+)$/) {
					$countvar = "task$1_count";
				}
				elsif ($tskid =~ /^ALM([0-9]+)$/) {
					$countvar = "alarm$1_count";
				}
				$TASKCOUNTVAR{$tskid} = $countvar;
			}
			if ($tskcount == $TASKCOUNT{$tskid} + 1) {
				if ($tskcount > 1) {
					$TASKCODE{$tskid} .= "\n".$indentstr;
					$TASKCODE{$tskid} .= sprintf("check_point(0);\n\n");
				}
				$TASKCOUNT{$tskid} = $tskcount;
				$TASKCODE{$tskid} .= sprintf("\tcase %d:", $tskcount);
			}
			elsif ($tskcount != $TASKCOUNT{$tskid}) {
				printf STDERR "Subtask count error: %d-%d\n",$tskid,$tskcount;
			}
		}
		else {
			$tskcount = "";
			$indentstr = "\t";
		}
	}
	elsif (!$startflag) {
		# do nothing.
	}
	elsif ($line =~ /^(assert\(.*\))$/) {
		$assert_string = $1;
		$TASKCODE{$tskid} .= $indentstr;
		$TASKCODE{$tskid} .= sprintf("check_%s;\n", $assert_string);
	}
	elsif ($line =~ /^call\((.*)\)$/) {
		$call_string = $1;
		$TASKCODE{$tskid} .= "\n".$indentstr;
		$TASKCODE{$tskid} .= sprintf("%s;\n", $call_string);
	}
	elsif ($line =~ /^([0-9]+)\:\s*MISSING$/) {
		$check_no = $1;
		$TASKCODE{$tskid} .= "\n".$indentstr;
		$TASKCODE{$tskid} .= sprintf("check_point(%d);\n", $check_no);
	}
	elsif ($line =~ /^([0-9]+)\:\s*RETURN$/) {
		$check_no = $1;
		$TASKCODE{$tskid} .= "\n".$indentstr;
		$TASKCODE{$tskid} .= sprintf("check_point(%d);\n", $check_no);
		$TASKCODE{$tskid} .= $indentstr;
		$TASKCODE{$tskid} .= "return;\n";
	}
	elsif ($line =~ /^RETURN$/) {
		$TASKCODE{$tskid} .= "\n".$indentstr;
		$TASKCODE{$tskid} .= "return;\n";
	}
	elsif ($line =~ /^([0-9]+)\:\s*END$/) {
		$check_no = $1;
		$TASKCODE{$tskid} .= "\n".$indentstr;
		$TASKCODE{$tskid} .= sprintf("check_finish(%d);\n", $check_no);
		$endflag = 1;
	}
	elsif ($line =~ /^([0-9]+)\:\s*([a-z_]+\(.*\))\s*(\-\>\s*[A-Za-z_]*)?\s*$/) {
		$check_no = $1;
		$svc_call = $2;
		$error_code_string = $3;
		$TASKCODE{$tskid} .= "\n".$indentstr;
		$TASKCODE{$tskid} .= sprintf("check_point(%d);\n", $check_no);
		do gen_svc_call($svc_call, $error_code_string);
	}
	elsif ($line =~ /^([a-z_]+\(.*\))\s*(\-\>\s*[A-Za-z_]*)?\s*$/) {
		$svc_call = $1;
		$error_code_string = $2;
		$TASKCODE{$tskid} .= "\n";
		do gen_svc_call($svc_call, $error_code_string);
	}
	else {
		print STDERR "Error: ",$line,"\n";
	}
}

#
#  ץȥեɹ߽
#
$startflag = 0;
$endflag = 0;
open(INFILE, $infile) || die "Cannot open $infile";
while (($line = <INFILE>) && !$endflag) {
	chomp $line;
	$line =~ s/^\s*\*\s*//;
	$line =~ s/\s*\/\/.*$//;
	$line =~ s/\s*\.\.\..*$//;
	next unless($line);
	do parse_line($line);
}
close(INFILE);

#
#  ɤν
#
sub output_task {
	if ($TASKCOUNT{$tskid}) {
		printf "\nstatic uint_t\t%s = 0;\n", $TASKCOUNTVAR{$tskid};
	}
	print "\nvoid\n";
	if ($tskid =~ /^TASK([0-9]+)$/) {
		print "task$1(intptr_t exinf)\n";
	}
	elsif ($tskid =~ /^ALM([0-9]+)$/) {
		print "alarm$1_handler(intptr_t exinf)\n";
	}
	print "{\n";
	print "\tER\t\tercd;\n";
	foreach $typename (keys(%{$TASKVAR{$tskid}})) {
		print "\t",$typename, (length($typename) < 4 ? "\t\t" : "\t"),
								${$TASKVAR{$tskid}}{$typename},";\n";
	}
	if ($TASKCOUNT{$tskid}) {
		printf "\n\tswitch (++%s) {\n", $TASKCOUNTVAR{$tskid};
	}
	print $TASKCODE{$tskid};
	if ($TASKCOUNT{$tskid}) {
		printf "\n\t\tcheck_point(0);\n";
		printf "\t}\n";
	}
	else {
		print "\n";
	}
	print "\tcheck_point(0);\n";
	print "}\n";
}

#
#  ƥȥץϽ
#
foreach $tskid (sort(keys(TASKCODE))) {
	do output_task();
}
