autoassign.perl 2.61 KB
#! /bin/perl
#
# レジスタの自動アサインを行なう
#
#  Assign 文と EndAssign 文を処理することになる
#

# 全レジスタ名の設定
@Sreg = split(/,/, "0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31");
@Vreg = split(/,/, "v0,v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,v17,v18,v19,v20,v21,v22,v23,v24,v25,v26,v27,v28,v29,v30,v31");

# レジスタ使用フラグのクリア
foreach (@Sreg){ $name{$_} = ""; }
foreach (@Vreg){ $name{$_} = ""; }

while (<>){
    # #! Reserved 文の処理
    if (/^\s+#!\s*Reserved\s*\((.*)\)/){
	# 括弧内のパラメータを切り分ける
	@_ = split(/,/, $1);
	# 指定されたレジスタをアサイン変更禁止扱いにする
	foreach $n ( @_ ){
	    $name{$n} = "Reserved";
	}
    }
    
    # Assign 文の処理 $2:レジスタ名  $3:アサイン対象レジスタ
    if (/^(\s+Assign\s*\()\s*(.*)\s*,\s*([vV]?[0-9]+)\s*(\).*)/){
	# ベクトルレジスタのアサイン要求か ?
	if ($3 =~ /^[vV]/){
	    # ベクトルレジスタの空きを調べる
	    $reg = &unused_reg( @Vreg );
	} else {
	    # スカラレジスタの空きを調べる
	    $reg = &unused_reg( @Sreg );
	}
	# レジスタを使用状態にする & レジスタ名の保存
	$name{$reg} = $2;
	
	# Assign 文再構成
	$_ = $1.$2.", ".$reg.$4."\n";	
    }
    
    # FixedAssign 文の処理 $2:レジスタ名  $3:アサイン対象レジスタ
    if (/^(\s+FixedAssign\s*\()\s*(.*)\s*,\s*([vV]?[0-9]+)\s*(\).*)/){

	# レジスタが予約されているかあるいは空きかの判定 ?
	if ($name{$3} ne "Reserved" && $name{$3} ne ""){

	    # レジスタの衝突が起こっているので中止
	    print STDERR "Register assign conflicts!!\n";

	} else {

	    # レジスタを使用状態にする & レジスタ名の保存
	    $name{$3} = $2;
	}
    }

    # EndAssign 文の処理 $2:レジスタ名  $3:アサイン対象レジスタ
    if (/^(\s+EndAssign\s*\()\s*(.*)\s*,\s*([vV]?[0-9]+)\s*(\).*)/){
	
	# レジスタ名に対応するレジスタの取得
	$reg = &search_name($2);
	
	# レジスタを未使用状態にする
	$name{$reg} = "";
	
	# EndAssign 文再構成
	$_ = $1.$2.", ".$reg.$4."\n";	
    }
    print $_;
}


# 現在残っているレジスタを表示する
print STDERR "Still assigned registers\n";
foreach ( @Sreg ){
	if ( $name{$_} ne "" ){
		print STDERR $_." ".$name{$_}."\n";
	}
}
foreach ( @Vreg ){
	if ( $name{$_} ne "" ){
		print STDERR $_." ".$name{$_}."\n";
	}
}

# 未使用のレジスタを探す
sub unused_reg {
	local($n);
	foreach $n (@_){
		if ( $name{$n} eq "" ){
			 return($n);
		}
	}
	print STDERR "Too much assigns no more register\n";
}

# レジスタ名にアサインされているレジスタを探す
sub search_name {
	local($val) = @_;
	local($n);
	foreach $n (@Sreg){
		if ( $name{$n} eq $val ){
			return($n);
		}
	}
	foreach $n (@Vreg){
		if ( $name{$n} eq $val ){
			 return($n);
		}
	}
	print STDERR "Unmatch EndAssign (".$val.")\n"; 
}