#! /usr/bin/perl
#
#  TOPPERS Software
#      Toyohashi Open Platform for Embedded Real-Time Systems
# 
#  Copyright (C) 2007-2014 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$
# 

#
#		ƥȥץġ
#

use open ":encoding(euc-jp)";
use encoding "euc-jp";

$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_mbf" => 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_mbf" => "T_RMBF",
	"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",
);

$last_check_point = 0;

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

	${$TASKVAR{$tskid}}{"ER_UINT"} = "ercd";

	push(@{$TASKCODE{$tskid}{$tskcnt}}, sprintf("\tercd = %s;", $svc_call));
	gen_var_def($svc_call);

	if ($error_code_string eq "") {
		push(@{$TASKCODE{$tskid}{$tskcnt}},
								sprintf("\tcheck_ercd(ercd, E_OK);"), "");
	}
	elsif ($error_code_string =~ /^\-\>\s*noreturn$/) {
		push(@{$TASKCODE{$tskid}{$tskcnt}}, "");
	}
	else {
		$error_code = $error_code_string;
		$error_code =~ s/^\-\>\s*([A-Za-z0-9_]*)$/$1/;
		push(@{$TASKCODE{$tskid}{$tskcnt}},
						sprintf("\tcheck_ercd(ercd, %s);", $error_code), "");
	}
}

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

	while ($line =~ s/\\$//) {
		$line1 = <INFILE>;
		$output_line .= $line1;
		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]*)(.*)$/) {
		$procflag = 1;
		$tskid = $1;
		$line2 = $3;
		if ($line2 =~ /^\-TEX(.*)$/) {
			$tskid = $tskid."-TEX";
			$line2 = $1;
		}
		if ($line2 =~ /^\-([0-9]+)(.*)$/) {
			$tskcnt = $1;
			if (!$TASKCOUNTVAR{$tskid}) {
				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;
			}
		}
		else {
			$tskcnt = "";
		}
		if ($startflag) {
			push(@{$TASKCODE{$tskid}{$tskcnt}}, "\ttest_start(__FILE__);");
			push(@{$TASKCODE{$tskid}{$tskcnt}}, "");
			$startflag = 0;
		}
	}
	elsif (!$procflag) {
		# do nothing.
	}
	elsif ($line =~ /^([0-9]+\:)\s*END$/) {
		$check_str = $1;
		$check_no = ++$last_check_point;
		push(@{$TASKCODE{$tskid}{$tskcnt}},
								sprintf("\tcheck_finish(%d);", $check_no));
		$procflag = 0;
		$output_line =~ s/$check_str/$check_no:/;
	}
	else {
		if ($line =~ /^([0-9]+\:)\s*(.*)/) {
			$check_str = $1;
			$line = $2;
			$check_no = ++$last_check_point;
			push(@{$TASKCODE{$tskid}{$tskcnt}},
								sprintf("\tcheck_point(%d);", $check_no));
			$output_line =~ s/$check_str/$check_no:/;
		}
		if ($line =~ /^(assert\(.*\))$/) {
			$assert_string = $1;
			push(@{$TASKCODE{$tskid}{$tskcnt}},
								sprintf("\tcheck_%s;", $assert_string), "");
		}
		elsif ($line =~ /^(state(_i)?\(.*\))$/) {
			$state_string = $1;
			push(@{$TASKCODE{$tskid}{$tskcnt}},
								sprintf("\tcheck_%s;", $state_string), "");
		}
		elsif ($line =~ /^call\((.*)\)$/ || $line =~ /^DO\((.*)\)$/) {
			$call_string = $1;
			push(@{$TASKCODE{$tskid}{$tskcnt}},
									sprintf("\t%s;", $call_string), "");
		}
		elsif ($line =~ /^MISSING$/) {
			push(@{$TASKCODE{$tskid}{$tskcnt}}, "");
		}
		elsif ($line =~ /^RETURN((\(.*\))?)$/) {
			$return_string = $1;
			push(@{$TASKCODE{$tskid}{$tskcnt}},
									"\treturn".$return_string.";", "");
		}
		elsif ($line =~ /^GOTO\((.*)\)$/) {
			$goto_string = $1;
			push(@{$TASKCODE{$tskid}{$tskcnt}},
									sprintf("\tgoto %s;", $goto_string), "");
		}
		elsif ($line =~ /^LABEL\((.*)\)$/) {
			$label_string = $1;
			$indent_string = $indentstr;
			$indent_string =~ s/\t$//;
			push(@{$TASKCODE{$tskid}{$tskcnt}},
									sprintf("%s:", $label_string));
		}
		elsif ($line =~ /^([a-z_]+\(.*\))\s*(\-\>\s*[A-Za-z0-9_]*)?\s*$/) {
			$svc_call = $1;
			$error_code_string = $2;
			gen_svc_call($svc_call, $error_code_string);
		}
		else {
			print STDERR "Error: ",$line,"\n";
		}
	}
}

#
#  ץȥեɹ߽
#
$procflag = 0;
$startflag = 1;
$outflag = 1;
open(INFILE, $infile) || die "Cannot open $infile";
while (($line = <INFILE>) && $outflag) {
	$output_line = $line;
	chomp $line;
	$line =~ s/^\s*\*\s*//;
	$line =~ s/\s*\/\/.*$//;
	$line =~ s/\s*\.\.\..*$//;
	if ($line) {
		parse_line($line);
	}
	print $output_line;
	if ($output_line =~ /DO NOT DELETE THIS LINE/) {
		$outflag = 0;
	}
}
close(INFILE);

#
#  ѿΥɽ
#
sub output_task_vardef {
	my($tskid) = @_;

	foreach my $typename (keys(%{$TASKVAR{$tskid}})) {
		print "\t",$typename, (length($typename) < 4 ? "\t\t" : "\t"),
								${$TASKVAR{$tskid}}{$typename},";\n";
	}
}

#
#  ΤΥɽ
#
sub output_task_body {
	my($tskid) = @_;

	foreach my $tskcnt (sort {$a <=> $b} (keys(%{$TASKCODE{$tskid}}))) {
		printf "\tcase %d:\n", $tskcnt;
		foreach my $line (@{$TASKCODE{$tskid}{$tskcnt}}) {
			print "\t",$line if ($line);
			print "\n";
		}
		printf "\t\tcheck_point(0);\n\n";
	}
}

#
#  ɤν
#
sub output_task {
	if ($TASKCOUNTVAR{$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";
	output_task_vardef($tskid);
	print "\n";
	if ($TASKCOUNTVAR{$tskid}) {
		printf "\tswitch (++%s) {\n", $TASKCOUNTVAR{$tskid};
		output_task_body($tskid);
		printf "\tdefault:\n";
		printf "\t\tcheck_point(0);\n";
		printf "\t}\n";
	}
	else {
		foreach my $line (@{$TASKCODE{$tskid}{""}}) {
			print $line,"\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();
}
