#!/usr/bin/perl

=pod

=head1 NAME

actor2flag2.0 - Calculate "flag" from F<actor.txt>.

=head1 SYNOPSIS

    perl actor2flag.pl [-c cache_size] actor.txt

=head1 DESCRIPTION

1行に空白区切りでB<(index, caller, callee, depth)>が記述されたファイルを読み込み，
更新flag&depthを表すデータを標準出力へ出力する．

=head1 OPTIONS

=over 4

=item -c call_size

キャッシュサイズ．

=back

=cut

#use strict;
use Getopt::Std;

# コマンドラインオプション
my %options;
getopts('c:', \%options);

# キャッシュサイズ
my @cache = ();           ## キャッシュ用配列（要素はオブジェクトID）
##  ※要素数は規定しない

my $cache_size = 1;       ## ユーザの指定するキャッシュサイズ（指定なしなら１）
if ($options{"c"}) {
	$cache_size = $options{"c"};
}


# 引数不正
if (@ARGV < 0) {
	exit(1);
}

my   %map = ();           ## キャッシュ内重複カウント用ハッシュ
keys %map = $cache_size;  ## ハッシュサイズは指定キャッシュサイズ以下

##解析・出力
while (<>) {
	chomp;            ## 改行を落とす
	# コメント
	next if (/^\#/);      ## 先頭が「#」だったら無視して次の行へ
	next if (/^\@thread/);## 先頭が「@thread」だったら無視して次の行へ

	# データ
	split(/\s+/);         ## 半角スペースで区切る
	my $line = shift(@_);     ##  index
	my $caller = shift(@_);   ##  呼び出し元ID
	my $callee = shift(@_);   ##  呼び出し先ID
	my $stackd = shift(@_);   ##  コールスタックの深さ

	my $flag1 = &add($caller);  ## 呼び出し元IDをキャッシュへ追加
	my $flag2 = &add($callee);  ## 呼び出し先IDをキャッシュへ追加
	my $flag = 0;
	if ($flag1 or $flag2) {
		$flag = 1;              ## 呼び出し元or呼び出し先どちらかの追加でキャッシュが溢れたらフラグを立てる
	}
	print "$line $flag $stackd @_\n";      ## indexとフラグとコールスタックの深さ（＋その他の情報）を出力
}
exit(0);


#---------------------------------------------------------------------
# @return キャッシュが更新されれば1，そうでなければ0
#
# パフォーマンスUPのため，該当要素を削除せず%mapに重複数を記憶
#---------------------------------------------------------------------

## 例）キャッシュサイズ３の場合
## time     理論上のキャッシュ  @cache         %map
## 
##  0       (0,1,2) <- 1        (0,1,2)        {0=>1,1=>1,2=>1}
##  1       (0.2.1) <- 1        (0,1,2,1)      {0=>1,1=>2,2=>1}
##  2       (0.2.1) <- 3        (0,1,2,1,1)    {0=>1,1=>3,2=>1}
##  3       (2.1,3) <- 4        (1,2,1,1,3)    {1=>3,2=>1,3=>1}
##  3                           (2,1,1,3)      {1=>2,2=>1,3=>1}
##  3                           (1,1,3)        {1=>2,2=>0,3=>1}
##  4       (1,3,4) <- X        (1,1,3,4)      {1=>2,3=>1,4=>1}


sub add {
	my ($data) = @_;                        ## 引数から追加するオブジェクトIDを得る
	my $hit_index = -1;                     ## 

	# 既にキャッシングされているかチェック
	if (exists $map{$data}) {
		# ヒット
		push(@cache, $data);                ## IDの位置を更新（最後尾へ）
		++$map{$data};                      ## 同IDの重複数を更新
		return 0;                           ## 要素の位置変更のみなので更新無しを返す
	} else {
		# ヒットせず
		if (keys(%map) == $cache_size) {      ## キャッシュ内IDの種類数が指定キャッシュ数に追いついた
			##  ＝配列内に重複要素が無い状態でキャッシュが溢れた
			my $removed;
			do {
				$removed = shift(@cache);     ## キャッシュの一番古い要素を捨てる
				--$map{$removed};             ## 捨てた要素の重複数を1減らす
			} while ($map{$removed} != 0);    ## キャッシュ要素の種類数が減るまで繰り返す
			##   重複した要素は本当はもっと新しい位置へ動いているので，捨てても意味が無い
			## 最新の位置であるもの（本当に現在その位置にある要素）を捨てられたらそこで止まる．
			delete $map{$removed};            ## 捨てた要素の重複数情報を消してしまう．
		}

		push(@cache, $data);                ## 新しい要素としてキャッシュへIDを追加
		$map{$data} = 1;                    ##（新しい＝重複は無いので１）
		return 1;                           ## キャッシュが更新されたので1を返す
	}
}

