#! /usr/bin/perl
#
#  TOPPERS Software
#      Toyohashi Open Platform for Embedded Real-Time Systems
# 
#  Copyright (C) 2007-2012 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 2417 2012-09-07 08:16:42Z 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);
	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) = @_;

	while ($line =~ s/\\$//) {
		$line1 = <INFILE>;
		chomp $line1;
		$line1 =~ s/^\s*\*\s*//;
		$line1 =~ s/\s*\/\/.*$//;
		$line1 =~ s/\s*\.\.\..*$//;
		$line .= $line1;
	}

	if ($line =~ /^\.\./) {
		# do nothing.
	}
	elsif ($line =~ /^==\s*((TASK|ALM|CPUEXC|EXTSVC)[0-9]*)(.*)$/) {
		$startflag = 1;
		$tskid = $1;
		$line2 = $3;
		if ($line2 =~ /^\-TEX(.*)$/) {
			$tskid = $tskid."-TEX";
			$line2 = $1;
		}
		if ($line2 =~ /^\-([0-9]+)(.*)$/) {
			$tskcount = $1;
			$line3 = $2;
			$indentstr = "\t\t";
			if (!$TASKCOUNT{$tskid}) {
				$TASKCOUNT{$tskid} = 0;
				if ($tskid =~ /^TASK([0-9]*)$/) {
					$countvar = "task$1_count";
				}
				elsif ($tskid =~ /^TASK([0-9]*)-TEX$/) {
					$countvar = "tex_task$1_count";
				}
				elsif ($tskid =~ /^ALM([0-9]*)$/) {
					$countvar = "alarm$1_count";
				}
				elsif ($tskid =~ /^CPUEXC([0-9]*)$/) {
					$countvar = "cpuexc$1_count";
				}
				elsif ($tskid =~ /^EXTSVC([0-9]*)$/) {
					$countvar = "extsvc$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} && $line3 !~ /^-/) {
				printf STDERR "Subtask count error: %s-%s\n",$tskid,$tskcount;
			}
		}
		else {
			$tskcount = "";
			$indentstr = "\t";
		}
	}
	elsif (!$startflag) {
		# do nothing.
	}
	elsif ($line =~ /^([0-9]+)\:\s*END$/) {
		$check_no = $1;
		$TASKCODE{$tskid} .= "\n".$indentstr;
		$TASKCODE{$tskid} .= sprintf("check_finish(%d);\n", $check_no);
		$endflag = 1;
	}
	else {
		if ($line =~ /^([0-9]+)\:\s*(.*)/) {
			$check_no = $1;
			$line = $2;
			$TASKCODE{$tskid} .= "\n".$indentstr;
			$TASKCODE{$tskid} .= sprintf("check_point(%d);\n", $check_no);
		}
		if ($line =~ /^(assert\(.*\))$/) {
			$assert_string = $1;
			$TASKCODE{$tskid} .= $indentstr;
			$TASKCODE{$tskid} .= sprintf("check_%s;\n", $assert_string);
		}
		elsif ($line =~ /^(state(_i)?\(.*\))$/) {
			$state_string = $1;
			$TASKCODE{$tskid} .= $indentstr;
			$TASKCODE{$tskid} .= sprintf("check_%s;\n", $state_string);
		}
		elsif ($line =~ /^call\((.*)\)$/ || $line =~ /^DO\((.*)\)$/) {
			$call_string = $1;
			$TASKCODE{$tskid} .= "\n".$indentstr;
			$TASKCODE{$tskid} .= sprintf("%s;\n", $call_string);
		}
		elsif ($line =~ /^MISSING$/) {
			# do nothing.
		}
		elsif ($line =~ /^RETURN((\(.*\))?)$/) {
			$return_string = $1;
			$TASKCODE{$tskid} .= "\n".$indentstr;
			$TASKCODE{$tskid} .= "return".$return_string.";\n";
		}
		elsif ($line =~ /^GOTO\((.*)\)$/) {
			$goto_string = $1;
			$TASKCODE{$tskid} .= "\n".$indentstr;
			$TASKCODE{$tskid} .= sprintf("goto %s;\n", $goto_string);
		}
		elsif ($line =~ /^LABEL\((.*)\)$/) {
			$label_string = $1;
			$indent_string = $indentstr;
			$indent_string =~ s/\t$//;
			$TASKCODE{$tskid} .= "\n".$indent_string;
			$TASKCODE{$tskid} .= sprintf("%s:", $label_string);
		}
		elsif ($line =~ /^([a-z_]+\(.*\))\s*(\-\>\s*[A-Za-z_]*)?\s*$/) {
			$svc_call = $1;
			$error_code_string = $2;
			$TASKCODE{$tskid} .= "\n";
			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);
	parse_line($line);
}
close(INFILE);

#
#  タスクコードの出力
#
sub output_task {
	if ($TASKCOUNT{$tskid}) {
		printf "\nstatic uint_t\t%s = 0;\n", $TASKCOUNTVAR{$tskid};
	}
	if ($tskid =~ /^TASK([0-9]*)$/) {
		print "\nvoid\n";
		print "task$1(intptr_t exinf)\n";
	}
	elsif ($tskid =~ /^TASK([0-9]*)-TEX$/) {
		print "\nvoid\n";
		print "tex_task$1(TEXPTN texptn, intptr_t exinf)\n";
	}
	elsif ($tskid =~ /^ALM([0-9]*)$/) {
		print "\nvoid\n";
		print "alarm$1_handler(intptr_t exinf)\n";
	}
	elsif ($tskid =~ /^CPUEXC([0-9]*)$/) {
		print "\nvoid\n";
		print "cpuexc$1_handler(void *p_excinf)\n";
	}
	elsif ($tskid =~ /^EXTSVC([0-9]*)$/) {
		print "\nER_UINT\n";
		print "extsvc$1_routine(intptr_t par1, intptr_t par2, intptr_t par3,\n";
		print "\t\t\t\t\t\t\t\tintptr_t par4, intptr_t par5, ID cdmid)\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";
	if ($tskid =~ /^EXTSVC([0-9]*)$/) {
		print "\treturn(E_SYS);\n";
	}
	print "}\n";
}

#
#  テストプログラム出力処理
#
foreach $tskid (sort(keys(%TASKCODE))) {
	output_task();
}