#! /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
# 
#  L쌠҂́Cȉ(1)`(4)̏𖞂ꍇɌC{\tgEF
#  Ai{\tgEFAς̂܂ށDȉjgpEE
#  ρEĔzziȉCpƌĂԁj邱Ƃ𖳏ŋD
#  (1) {\tgEFA\[XR[ȟ`ŗpꍇɂ́CL̒
#      \C̗pщL̖ۏ؋K肪Ĉ܂܂̌`Ń\[
#      XR[hɊ܂܂Ă邱ƁD
#  (2) {\tgEFACCu`ȂǁC̃\tgEFAJɎg
#      pł`ōĔzzꍇɂ́CĔzzɔhLgip
#      ҃}jAȂǁjɁCL̒쌠\C̗pщL
#      ̖ۏ؋Kfڂ邱ƁD
#  (3) {\tgEFAC@ɑgݍނȂǁC̃\tgEFAJɎg
#      płȂ`ōĔzzꍇɂ́Ĉꂩ̏𖞂
#      ƁD
#    (a) ĔzzɔhLgip҃}jAȂǁjɁCL̒
#        쌠\C̗pщL̖ۏ؋Kfڂ邱ƁD
#    (b) Ĕzž`ԂCʂɒ߂@ɂāCTOPPERSvWFNg
#        񍐂邱ƁD
#  (4) {\tgEFA̗pɂ蒼ړI܂͊ԐړIɐ邢Ȃ鑹
#      QCL쌠҂TOPPERSvWFNgƐӂ邱ƁD
#      ܂C{\tgEFÃ[U܂̓Gh[ÛȂ闝
#      RɊÂCL쌠҂TOPPERSvWFNg
#      Ɛӂ邱ƁD
# 
#  {\tgEFÁCۏ؂Œ񋟂Ă̂łDL쌠҂
#  TOPPERSvWFNǵC{\tgEFAɊւāC̎gpړI
#  ɑ΂K܂߂āCȂۏ؂sȂD܂C{\tgEF
#  A̗pɂ蒼ړI܂͊ԐړIɐȂ鑹QɊւĂC
#  ̐ӔC𕉂ȂD
# 
#  @(#) $Id: gentest 1546 2009-05-08 10:05:22Z ertl-hiro $
# 

#
#		eXgvOc[
#

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

#
#  XNvgt@CǍݏ
#
$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);

#
#  ^XNR[h̏o
#
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";
}

#
#  eXgvOo͏
#
foreach $tskid (sort(keys(TASKCODE))) {
	do output_task();
}
