#!/bin/perl $multiple_modulef=0; $multiple_module=0; #more than one module in a file $entrym=""; #global $entry=""; #global @a=(); #Add a data base with file name and its module / arch. @a_file_ModArc=(); $b_file_ModArc=""; $i_file_ModArc=0; $t_file_ModArc=0; $debug=0; $fpn="no_name_report.txt"; if($ARGV[0] =~ /(.*)\.(.*)/) { $fpn=$1 . "_report.txt" } open(FPW, ">$fpn") || die("open fail $fpn\n"); open(FPTB, $ARGV[0]) || die("open fail $ARGV[0]\n"); while(eof(FPTB) != 1) { $line=; chomp($line); $line =~ s/ //g; if($line =~ /.*\.v$/) { $b_file_ModArc=$line; &get_hier_verilog($line, $entry, $multiple_module); } elsif($line =~ /.*\.vhd$/) { $b_file_ModArc=$line; $multiple_module=0;#not supported yet &get_hier_vhdl($line, $entry); $i_file_ModArc=index($entry, "::"); $b_file_ModArc=$b_file_ModArc . " " . substr($entry, 0, $i_file_ModArc); } elsif($line =~ /.*\.VHD$/) { $b_file_ModArc=$line; $multiple_module=0;#not supported yet &get_hier_vhdl($line, $entry); $i_file_ModArc=index($entry, "::"); $b_file_ModArc=$b_file_ModArc . " " . substr($entry, 0, $i_file_ModArc); } else { die("unsupported file type \"$line\"\n"); } if($multiple_module == 1) { $multiple_modulef=0; while($multiple_modulef == 0) { if($entry =~ /(^[a-zA-Z].*::.* )([a-zA-Z].*::.*)/) { $entry=$1; $entrym=$2; push(@a_entry, $entrym); $t_file_ModArc=$entrym; $t_file_ModArc =~ s/:://; $b_file_ModArc=$b_file_ModArc . " " . $t_file_ModArc; } else { push(@a_entry, $entry); $multiple_modulef=1; $i_file_ModArc=index($entry, "::"); $b_file_ModArc=$b_file_ModArc . " " . substr($entry, 0, $i_file_ModArc); } }#while } else {#single module in HDL file push(@a_entry, $entry); $i_file_ModArc=index($entry, "::"); $b_file_ModArc=$b_file_ModArc . " " . substr($entry, 0, $i_file_ModArc); } push(@a_file_ModArc, $b_file_ModArc); $entry=""; }#while close(FPTB); &prt_entry($ARGV[1]); print FPW ("file -> module / architecture\n"); foreach $b_file_ModArc ( @a_file_ModArc ) { print FPW ("$b_file_ModArc\n"); } sub prt_entry { print FPW ("$_[0]\n"); &get_mod($_[0], 0); } sub get_mod { my $j=""; my $k=""; my $ix=0; my $spc=""; my @as=""; my $cmp=""; my $hier=""; my @amod=""; my $src=""; if($_[0] eq "") { print FPW ("start a not ordered report\n"); foreach $j ( @a_entry ) { print FPW ("$j\n"); } exit(0); } # my $src_a=lc($_[0]); foreach $j ( @a_entry ) { $src=$src_a . "::"; #to avoid a match on ABC -> ABCD $ix=index($j, $src); if($ix == 0) {#match module if($j =~ /;/) {#has children if($j =~ /.*:: *(.*)/) { $cmp=$1; @as=split(/ /, $cmp); } $hier=$_[1]+1; if($hier > 30) { foreach $k ( @as ) { print("as-$k\n");} print FPW ("hierarchy level is too deep\n"); print("hierarchy level is too deep\n"); exit(0); } foreach $k ( @as ) { for($spc=0; $spc < $hier; $spc++) {print FPW (" ");} print FPW ("$k\n"); @amod=split(/;/, $k); &get_mod($amod[0], $hier); }#foreach } } }#foreach } exit(0); sub get_hier_vhdl { my $start=0; my $arch=""; my $arch_cnt=0; my $arch_mul=""; my $buf=""; my $t1=""; my $t2=""; my @at=""; my $last=0; my $file=$_[0]; my $line=""; open(FPR, $_[0]) || die("open fail $_[0]\n"); my $skip_line=0; while(eof(FPR) != 1) { $line=; chomp($line); $line =~ s/\t/ /g; $line =~ s/\r//g; $line=lc($line); if($line =~ /^ *--/) {#comment $skip_line=1; } elsif($line =~ /^ *$/) { $skip_line=1; } else { #remove remark my @line_r = split(/--/, $line); $line=$line_r[0]; $skip_line=0; } if($skip_line == 0) { #get architecture if($start == 0) { if( length($arch) == 0 ) { if($line =~ /architecture/) { $arch=$line; $start=1; } } else { $arch=$arch . $line; } if($arch =~ /architecture .* of *([a-zA-Z].*) *is/) { $start=2; $_[1]=$1 . "::"; $_[1] =~ s/ *//g; } } #get hier if($start == 2) { $buf=$buf . " " . $line; if($buf =~ /;/) { if( $buf =~ /([a-zA-Z].*) *: *([a-zA-Z].*) *port *map.*;/ ) { $t2=$2; $t1=$1; $t2 =~ s/^ *//; @at=split(/ /, $t2); $t2=$at[0]; if($t1 =~ / /) { @at=split(/ /, $t1); $last=$#at; $t1=$at[$last]; } $_[1]=$_[1] . " " . $t2 . ";" . $t1; } $buf=""; } if($line =~ /^ *architecture /) { if($arch_cnt > 0) { $arch_mul=""; if($line =~ /architecture *.* of ([a-zA-Z].*) *is/) { $arch_mul=$1; } print FPW ("xx $arch_mul $file\n"); $start=3; } $arch_cnt++; } } }#if($skip_line == 0) }#while }#get_hier_vhdl sub get_hier_verilog { open(FPR, $_[0]) || die("open fail $_[0]\n"); my $remark_on=0; my $split_an=""; my $split_on=0; my @split_st=""; my $tmp=0; my $line=""; while(eof(FPR) != 1) { $line=; chomp($line); $line =~ s/\t/ /g; $line =~ s/\r//g; if($line =~ /^ *\/\//) {#comment $tmp=$1; } elsif($line =~ /timescale/) { $tmp=$1; } elsif($line =~ /endmodule/) { $tmp=$1; } elsif($line =~ /^ *$/) { $tmp=$1; } else { #remove remark my @line_r = split(/\/\//, $line); $line=$line_r[0]; #remove remark of type /*...*/ if($line =~ /(.*)\/\*.*\*\/(.*)/) { $line=$1 . $2; } elsif($line =~ /(.*)\/\*/) { $line=$1;#discard the remark part $remark_on=1; push(@a, $line); } elsif($remark_on == 1) { if($line =~ /\*\/(.*)/) { $line=$1;#discard the remark part $remark_on=0; } } if($remark_on == 0) { #At this point we look for any kind of statement, which ends with a ;. #Check for multiple ; lines. if( $line =~ /;.*;/ ) { @split_st=split(/;/, $line); $split_on=1; } # if($split_on == 0) { push(@a, $line); if( $line =~ /;/ ) { &parse_statement($_[1], $_[2]); @a=""; } } else { $split_on=0; foreach $split_an ( @split_st ) { $split_an=$split_an . ";"; push(@a, $split_an); &parse_statement($_[1], $_[2]); @a=""; } } } } }#while close(FPR); }#get_hier_verilog sub parse_statement { my $j; my $min; my @ixa=(); my $buf; my $defparam_flg; foreach $j ( @a ) { $buf=$buf . $j . " "; } #component with a paramater &rm_double_p($buf); #can not cope with nested (..(..)..) if( $buf =~ /([^ ]*) *# *\(.*\) *([^ ]*) *\( *\. *[^ ].*\).*\) *;/ ) { $_[0]=$_[0] . " " . $1 . ";" . $2; } #component without a paramater elsif( $buf =~ /([^ ]*) *([^ ]*) *\( *\. *[^ ].*\).*\) *;/ ) { $_[0]=$_[0] . " " . $1 . ";" . $2; } elsif($buf =~ /module *([a-zA-Z].*)/) {#module name my $module=$1; ##my @am=""; $module =~ s/ //g; ##if($module =~ /[^#]\(/) {@am=split(/\(/, $module);} ##elsif($module =~ /;/) {@am=split(/;/ , $module);} ##elsif($module =~ /#/) {@am=split(/#/ , $module);} ##else { die("can't handle module from module\n$module\n");} @ixa=(); $j=index($module, '#'); push(@ixa, $j); $j=index($module, '('); push(@ixa, $j); $j=index($module, ';'); push(@ixa, $j); $min=-1; foreach $j ( @ixa ) { if($j != -1) { if($min == -1) {$min=$j;} else { $min=($j<$min)?$j:$min; } } } $module=substr($module, 0, $min); #check for : more than one module in a file if( length($_[0]) > 0 ) {$_[1]=1; $_[0]=$_[0] . " ";} $_[0] =$_[0] . $module . "::"; #$_[0] =$_[0] . $am[0] . "::"; } $buf=""; }#sub parse_statement sub rm_double_p { my $buf=$_[0]; my @a_a=(); my @a_b=(); my $off=0; my $flg=0; my $Na=0; my $Nb=0; my $i=0; my $cnt=20; while($flg == 0) { $off = index($buf, '(', $off); if( $off != -1 ) { push(@a_a, $off); $Na++; $off++; } else {$flg = 1; } }#while if( $Na > 1 ) {#need more than two ( to operate $off=0; $flg=0; while($flg == 0) { $off = index($buf, ')', $off); if( $off != -1 ) { push(@a_b, $off); $Nb++; $off++; } else {$flg = 1; } }#while if($Na == $Nb) {#must be balanced with ( and ) for($i=1; $i<$Na-1; $i++) { if($a_a[$i] < $a_b[$i-1]) { &sub_char($buf, $a_a[$i], $a_b[$i-1]); } }#for } } } sub sub_char { my $new_b=""; $new_b=substr($_[0], 0, $_[1]); $new_b=$new_b . "_"; $new_b=$new_b . substr($_[0], $_[1]+1, $_[2]-$_[1]-1); $new_b=$new_b . "_"; $new_b=$new_b . substr($_[0], $_[2]+1); $_[0]=$new_b; }