URL https://opencores.org/ocsvn/an-fpga-implementation-of-low-latency-noc-based-mpsoc/an-fpga-implementation-of-low-latency-noc-based-mpsoc/trunk

Subversion Repositories an-fpga-implementation-of-low-latency-noc-based-mpsoc

[/] [an-fpga-implementation-of-low-latency-noc-based-mpsoc/] [trunk/] [mpsoc/] [perl_gui/] [lib/] [perl/] [common.pl] - Blame information for rev 43

Go to most recent revision | Details | Compare with Previous | View Log


use strict;
use warnings;
 
use String::Similarity;
 
 
sub find_the_most_similar_position{
        my ($item ,@list)=@_;
        my $most_similar_pos=0;
        my $lastsim=0;
        my $i=0;
        # convert item to lowercase
        $item = lc $item;
        foreach my $p(@list){
                my $similarity= similarity $item, $p;
                if ($similarity > $lastsim){
                        $lastsim=$similarity;
                        $most_similar_pos=$i;
                }
                $i++;
        }
        return $most_similar_pos;
}
 
 
 
####################
#        file
##################
 
 
sub read_verilog_file{
        my @files            = @_;
        my %cmd_line_defines = ();
        my $quiet            = 1;
        my @inc_dirs         = ();
        my @lib_dirs         = ();
        my @lib_exts         = ();
        my $vdb = rvp->read_verilog(\@files,[],\%cmd_line_defines,
                          $quiet,\@inc_dirs,\@lib_dirs,\@lib_exts);
 
        my @problems = $vdb->get_problems();
        if (@problems) {
            foreach my $problem ($vdb->get_problems()) {
                print STDERR "$problem.\n";
            }
            # die "Warnings parsing files!";
        }
 
        return $vdb;
}
 
 
 
 
sub append_text_to_file {
        my  ($file_path,$text)=@_;
        open(my $fd, ">>$file_path") or die "could not open $file_path: $!";
        print $fd $text;
        close $fd;
}
 
 
 
 
sub save_file {
        my  ($file_path,$text)=@_;
        open my $fd, ">$file_path" or die "could not open $file_path: $!";
        print $fd $text;
        close $fd;
}
 
sub load_file {
        my $file_path=shift;
        my $str;
        if (-f "$file_path") {
 
                $str = do {
                        local $/ = undef;
                        open my $fh, "<", $file_path
                        or die "could not open $file_path: $!";
                        <$fh>;
                };
 
        }
        return $str;
}
 
sub merg_files {
        my  ($source_file_path,$dest_file_path)=@_;
        local $/=undef;
        open FILE, $source_file_path or die "Couldn't open file: $!";
        my $string = <FILE>;
        close FILE;
         append_text_to_file ($dest_file_path,$string);
}
 
 
 
sub copy_file_and_folders{
        my ($file_ref,$project_dir,$target_dir)=@_;
 
        foreach my $f(@{$file_ref}){
                my $name= basename($f);
 
                my $n="$project_dir$f";
                if (-f "$n") { #copy file
                        copy ("$n","$target_dir/$name");
                }elsif(-f "$f" ){
                        copy ("$f","$target_dir/$name");
                }elsif (-d "$n") {#copy folder
                        dircopy ("$n","$target_dir/$name");
                }elsif(-d "$f" ){
                        dircopy ("$f","$target_dir/$name");
 
                }
        }
 
}
 
 
sub remove_file_and_folders{
        my ($file_ref,$project_dir)=@_;
 
        foreach my $f(@{$file_ref}){
                my $name= basename($f);
                my $n="$project_dir$f";
                if (-f "$n") { #copy file
                        unlink ("$n");
                }elsif(-f "$f" ){
                        unlink ("$f");
                }elsif (-d "$n") {#copy folder
                        rmtree ("$n");
                }elsif(-d "$f" ){
                        rmtree ("$f");
                }
        }
 
}
 
sub read_file_cntent {
        my ($f,$project_dir)=@_;
        my $n="$project_dir$f";
        my $str;
        if (-f "$n") {
 
                $str = do {
                        local $/ = undef;
                        open my $fh, "<", $n
                        or die "could not open $n: $!";
                        <$fh>;
                };
 
        }elsif(-f "$f" ){
                $str = do {
                        local $/ = undef;
                        open my $fh, "<", $f
                        or die "could not open $f: $!";
                        <$fh>;
                };
 
 
        }
        return $str;
 
}
 
 
sub check_file_has_string {
    my ($file,$string)=@_;
    my $r;
    open(FILE,$file);
    if (grep{/$string/} <FILE>){
       $r= 1; #print "word  found\n";
    }else{
       $r= 0; #print "word not found\n";
    }
    close FILE;
    return $r;
}
 
##############
#  clone_obj
#############
 
sub clone_obj{
        my ($self,$clone)=@_;
 
        foreach my $p (keys %$self){
                delete ($self->{$p});
        }
        foreach my $p (keys %$clone){
                $self->{$p}= $clone->{$p};
                my $ref= ref ($clone->{$p});
                if( $ref eq 'HASH' ){
 
                        foreach my $q (keys %{$clone->{$p}}){
                                $self->{$p}{$q}= $clone->{$p}{$q};
                                my $ref= ref ($self->{$p}{$q});
                                if( $ref eq 'HASH' ){
 
                                        foreach my $z (keys %{$clone->{$p}{$q}}){
                                                $self->{$p}{$q}{$z}= $clone->{$p}{$q}{$z};
                                                my $ref= ref ($self->{$p}{$q}{$z});
                                                if( $ref eq 'HASH' ){
 
                                                        foreach my $w (keys %{$clone->{$p}{$q}{$z}}){
                                                                $self->{$p}{$q}{$z}{$w}= $clone->{$p}{$q}{$z}{$w};
                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w});
                                                                if( $ref eq 'HASH' ){
 
 
                                                                        foreach my $m (keys %{$clone->{$p}{$q}{$z}{$w}}){
                                                                                $self->{$p}{$q}{$z}{$w}{$m}= $clone->{$p}{$q}{$z}{$w}{$m};
                                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m});
                                                                                if( $ref eq 'HASH' ){
 
                                                                                        foreach my $n (keys %{$clone->{$p}{$q}{$z}{$w}{$m}}){
                                                                                                $self->{$p}{$q}{$z}{$w}{$m}{$n}= $clone->{$p}{$q}{$z}{$w}{$m}{$n};
                                                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m}{$n});
                                                                                                if( $ref eq 'HASH' ){
 
                                                                                                        foreach my $l (keys %{$clone->{$p}{$q}{$z}{$w}{$m}{$n}}){
                                                                                                                $self->{$p}{$q}{$z}{$w}{$m}{$n}{$l}= $clone->{$p}{$q}{$z}{$w}{$m}{$n}{$l};
                                                                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m}{$n}{$l});
                                                                                                                if( $ref eq 'HASH' ){
                                                                                                                }
                                                                                                        }
 
                                                                                                }#if                                                                                                            
                                                                                        }#n
                                                                                }#if
                                                                        }#m                                                     
                                                                }#if
                                                        }#w
                                                }#if
                                        }#z
                                }#if
                        }#q
                }#if    
        }#p
}#sub   
 
 
sub get_project_dir{ #mpsoc directory address
        my $dir = Cwd::getcwd();
        my $project_dir   = abs_path("$dir/../../");
        return $project_dir;
}
 
 
sub remove_project_dir_from_addr{
        my $file=shift;
        my $project_dir   = get_project_dir();
        $file =~ s/$project_dir//;
        return $file;
}
 
sub add_project_dir_to_addr{
        my $file=shift;
        my $project_dir   = get_project_dir();
        return $file if(-f $file );
        return "$project_dir/$file";
 
}
 
sub get_full_path_addr{
        my $file=shift;
        my $dir = Cwd::getcwd();
        my $full_path = "$dir/$file";
        return $full_path  if -f ($full_path );
        return $file;
}
 
sub regen_object {
        my $path=shift;
        $path = get_full_path_addr($path);
        my $pp= eval { do $path };
        my $r= ($@ || !defined $pp);
        return ($pp,$r,$@);
}
 
 
################
#       general
#################
 
 
 
 
sub  trim { my $s = shift;  $s=~s/[\n]//gs; return $s };
 
sub remove_all_white_spaces($)
{
  my $string = shift;
  $string =~ s/\s+//g;
  return $string;
}
 
 
 
 
sub get_scolar_pos{
        my ($item,@list)=@_;
        my $pos;
        my $i=0;
        foreach my $c (@list)
        {
                if(  $c eq $item) {$pos=$i}
                $i++;
        }
        return $pos;
}
 
sub remove_scolar_from_array{
        my ($array_ref,$item)=@_;
        my @array=@{$array_ref};
        my @new;
        foreach my $p (@array){
                if($p ne $item ){
                        push(@new,$p);
                }
        }
        return @new;
}
 
sub replace_in_array{
        my ($array_ref,$item1,$item2)=@_;
        my @array=@{$array_ref};
        my @new;
        foreach my $p (@array){
                if($p eq $item1 ){
                        push(@new,$item2);
                }else{
                        push(@new,$p);
                }
        }
        return @new;
}
 
 
 
# return an array of common elemnts between two input arays 
sub get_common_array{
        my ($a_ref,$b_ref)=@_;
        my @A=@{$a_ref};
        my @B=@{$b_ref};
        my @C;
        foreach my $p (@A){
                if( grep (/^\Q$p\E$/,@B)){push(@C,$p)};
        }
        return  @C;
}
 
#a-b
sub get_diff_array{
        my ($a_ref,$b_ref)=@_;
        my @A=@{$a_ref};
        my @B=@{$b_ref};
        my @C;
        foreach my $p (@A){
                if( !grep  (/^\Q$p\E$/,@B)){push(@C,$p)};
        }
        return  @C;
 
}
 
 
 
sub compress_nums{
        my      @nums=@_;
        my @f=sort { $a <=> $b } @nums;
        my $s;
        my $ls;
        my $range=0;
        my $x;
 
 
        foreach my $p (@f){
                if(!defined $x) {
                        $s="$p";
                        $ls=$p;
 
                }
                else{
                        if($p-$x>1){ #gap exist
                                if( $range){
                                        $s=($x-$ls>1 )? "$s:$x,$p": "$s,$x,$p";
                                        $ls=$p;
                                        $range=0;
                                }else{
                                $s= "$s,$p";
                                $ls=$p;
 
                                }
 
                        }else {$range=1;}
 
 
 
                }
 
                $x=$p
        }
        if($range==1){ $s= ($x-$ls>1 )? "$s:$x":  "$s,$x";}
        #update $s($ls,$hs);
 
        return $s;
 
}
 
 
 
sub metric_conversion{
        my $size=shift;
        my $size_text=  $size==0  ? 'Error':
                        $size<(1 << 10)? $size:
                        $size<(1 << 20)? join (' ', ($size>>10,"K")) :
                        $size<(1 << 30)? join (' ', ($size>>20,"M")) :
                                         join (' ', ($size>>30,"G")) ;
return $size_text;
}
 
 
 
 
 
######
#  state
#####
sub set_gui_status{
        my ($object,$status,$timeout)=@_;
        $object->object_add_attribute('gui_status','status',$status);
        $object->object_add_attribute('gui_status','timeout',$timeout);
}
 
 
sub get_gui_status{
        my ($object)=@_;
        my $status= $object->object_get_attribute('gui_status','status');
        my $timeout=$object->object_get_attribute('gui_status','timeout');
        return ($status,$timeout);
}
 
 
 
 
###########
#  color
#########
 
 
 
sub get_color {
        my $num=shift;
 
        my @colors=(
        0x6495ED,#Cornflower Blue
        0xFAEBD7,#Antiquewhite
        0xC71585,#Violet Red
        0xC0C0C0,#silver
        0xADD8E6,#Lightblue     
        0x6A5ACD,#Slate Blue
        0x00CED1,#Dark Turquoise
        0x008080,#Teal
        0x2E8B57,#SeaGreen
        0xFFB6C1,#Light Pink
        0x008000,#Green
        0xFF0000,#red
        0x808080,#Gray
        0x808000,#Olive
        0xFF69B4,#Hot Pink
        0xFFD700,#Gold
        0xDAA520,#Goldenrod
        0xFFA500,#Orange
        0x32CD32,#LimeGreen
        0x0000FF,#Blue
        0xFF8C00,#DarkOrange
        0xA0522D,#Sienna
        0xFF6347,#Tomato
        0x0000CD,#Medium Blue
        0xFF4500,#OrangeRed
        0xDC143C,#Crimson       
        0x9932CC,#Dark Orchid
        0x800000,#marron
        0x800080,#Purple
        0x4B0082,#Indigo
        0xFFFFFF,#white 
        0x000000 #Black         
                );
 
        my $color=      ($num< scalar (@colors))? $colors[$num]: 0xFFFFFF;
        my $red=        ($color & 0xFF0000) >> 8;
        my $green=      ($color & 0x00FF00);
        my $blue=       ($color & 0x0000FF) << 8;
 
        return ($red,$green,$blue);
 
}
 
 
sub get_color_hex_string {
        my $num=shift;
 
        my @colors=(
        "6495ED",#Cornflower Blue
        "FAEBD7",#Antiquewhite
        "C71585",#Violet Red
        "C0C0C0",#silver
        "ADD8E6",#Lightblue     
        "6A5ACD",#Slate Blue
        "00CED1",#Dark Turquoise
        "008080",#Teal
        "2E8B57",#SeaGreen
        "FFB6C1",#Light Pink
        "008000",#Green
        "FF0000",#red
        "808080",#Gray
        "808000",#Olive
        "FF69B4",#Hot Pink
        "FFD700",#Gold
        "DAA520",#Goldenrod
        "FFA500",#Orange
        "32CD32",#LimeGreen
        "0000FF",#Blue
        "FF8C00",#DarkOrange
        "A0522D",#Sienna
        "FF6347",#Tomato
        "0000CD",#Medium Blue
        "FF4500",#OrangeRed
        "DC143C",#Crimson       
        "9932CC",#Dark Orchid
        "800000",#marron
        "800080",#Purple
        "4B0082",#Indigo
        "FFFFFF",#white 
        "000000" #Black         
                );
 
        my $color=      ($num< scalar (@colors))? $colors[$num]: "FFFFFF";
        return $color;
 
}
 
 
 
 
 
sub check_verilog_identifier_syntax {
        my $in=shift;
        my $error=0;
        my $message='';
# an Identifiers must begin with an alphabetic character or the underscore character
        if ($in =~ /^[0-9\$]/){
                return 'an Identifier must begin with an alphabetic character or the underscore character';
        }
 
 
#       Identifiers may contain alphabetic characters, numeric characters, the underscore, and the dollar sign (a-z A-Z 0-9 _ $ )
        if ($in =~ /[^a-zA-Z0-9_\$]+/){
                 print "use of illegal character after\n" ;
                 my @w= split /([^a-zA-Z0-9_\$]+)/, $in;
                 return "Contain illegal character of \"$w[1]\". Identifiers may contain alphabetic characters, numeric characters, the underscore, and the dollar sign (a-z A-Z 0-9 _ \$ )\n";
 
        }
 
 
# check Verilog reserved words
        my @keys =                      ("always","and","assign","automatic","begin","buf","bufif0","bufif1","case","casex","casez","cell","cmos","config","deassign","default","defparam","design","disable","edge","else","end","endcase","endconfig","endfunction","endgenerate","endmodule","endprimitive","endspecify","endtable","endtask","event","for","force","forever","fork","function","generate","genvar","highz0","highz1","if","ifnone","incdir","include","initial","inout","input","instance","integer","join","large","liblist","library","localparam","macromodule","medium","module","nand","negedge","nmos","nor","noshowcancelled","not","notif0","notif1","or","output","parameter","pmos","posedge","primitive","pull0","pull1","pulldown","pullup","pulsestyle_onevent","pulsestyle_ondetect","remos","real","realtime","reg","release","repeat","rnmos","rpmos","rtran","rtranif0","rtranif1","scalared","showcancelled","signed","small","specify","specparam","strong0","strong1","supply0","supply1","table","task","time","tran","tranif0","tranif1","tri","tri0","tri1","triand","trior","trireg","unsigned","use","vectored","wait","wand","weak0","weak1","while","wire","wor","xnor","xor");
        if( grep (/^$in$/,@keys)){
                return  "$in is a Verlig reserved word.";
        }
        return undef;
 
}
 
 
sub capture_number_after {
        my ($after,$text)=@_;
        my @q =split  (/$after/,$text);
        #my $d=$q[1];
        my @d = split (/[^0-9. ]/,$q[1]);
        return $d[0];
 
}
 
sub capture_string_between {
        my ($start,$text,$end)=@_;
        my @q =split  (/$start/,$text);
        my @d = split (/$end/,$q[1]);
        return $d[0];
}
 
 
sub make_undef_as_string {
        foreach my $p  (@_){
                $$p= 'undef' if (! defined $$p);
 
        }
}
 
sub powi{ # x^y
        my ($x,$y)=@_; # compute x to the y
        my $r=1;
        for (my $i = 0; $i < $y; ++$i ) {
        $r *= $x;
        }
  return $r;
}
 
sub sum_powi{ # x^(y-1) + x^(y-2) + ...+ 1;
        my ($x,$y)=@_; # compute x to the y
        my $r = 0;
    for (my $i = 0; $i < $y; $i++){
        $r += powi( $x, $i );
    }
        return $r;
}
 
 
 
 
1
 

Browse

Tools

Subversion Repositories an-fpga-implementation-of-low-latency-noc-based-mpsoc

[/] [an-fpga-implementation-of-low-latency-noc-based-mpsoc/] [trunk/] [mpsoc/] [perl_gui/] [lib/] [perl/] [common.pl] - Blame information for rev 43

Line No.	Rev	Author	Line
1	43	alirezamon	`use strict;`
2			`use warnings;`
3
4			`use String::Similarity;`
5
6
7			`sub find_the_most_similar_position{`
8			`my ($item ,@list)=@_;`
9			`my $most_similar_pos=0;`
10			`my $lastsim=0;`
11			`my $i=0;`
12			`# convert item to lowercase`
13			`$item = lc $item;`
14			`foreach my $p(@list){`
15			`my $similarity= similarity $item, $p;`
16			`if ($similarity > $lastsim){`
17			`$lastsim=$similarity;`
18			`$most_similar_pos=$i;`
19			`}`
20			`$i++;`
21			`}`
22			`return $most_similar_pos;`
23			`}`
24
25
26
27			`####################`
28			`# file`
29			`##################`
30
31
32			`sub read_verilog_file{`
33			`my @files = @_;`
34			`my %cmd_line_defines = ();`
35			`my $quiet = 1;`
36			`my @inc_dirs = ();`
37			`my @lib_dirs = ();`
38			`my @lib_exts = ();`
39			`my $vdb = rvp->read_verilog(\@files,[],\%cmd_line_defines,`
40			`$quiet,\@inc_dirs,\@lib_dirs,\@lib_exts);`
41
42			`my @problems = $vdb->get_problems();`
43			`if (@problems) {`
44			`foreach my $problem ($vdb->get_problems()) {`
45			`print STDERR "$problem.\n";`
46			`}`
47			`# die "Warnings parsing files!";`
48			`}`
49
50			`return $vdb;`
51			`}`
52
53
54
55
56			`sub append_text_to_file {`
57			`my ($file_path,$text)=@_;`
58			`open(my $fd, ">>$file_path") or die "could not open $file_path: $!";`
59			`print $fd $text;`
60			`close $fd;`
61			`}`
62
63
64
65
66			`sub save_file {`
67			`my ($file_path,$text)=@_;`
68			`open my $fd, ">$file_path" or die "could not open $file_path: $!";`
69			`print $fd $text;`
70			`close $fd;`
71			`}`
72
73			`sub load_file {`
74			`my $file_path=shift;`
75			`my $str;`
76			`if (-f "$file_path") {`
77
78			`$str = do {`
79			`local $/ = undef;`
80			`open my $fh, "<", $file_path`
81			`or die "could not open $file_path: $!";`
82			`<$fh>;`
83			`};`
84
85			`}`
86			`return $str;`
87			`}`
88
89			`sub merg_files {`
90			`my ($source_file_path,$dest_file_path)=@_;`
91			`local $/=undef;`
92			`open FILE, $source_file_path or die "Couldn't open file: $!";`
93			`my $string = <FILE>;`
94			`close FILE;`
95			`append_text_to_file ($dest_file_path,$string);`
96			`}`
97
98
99
100			`sub copy_file_and_folders{`
101			`my ($file_ref,$project_dir,$target_dir)=@_;`
102
103			`foreach my $f(@{$file_ref}){`
104			`my $name= basename($f);`
105
106			`my $n="$project_dir$f";`
107			`if (-f "$n") { #copy file`
108			`copy ("$n","$target_dir/$name");`
109			`}elsif(-f "$f" ){`
110			`copy ("$f","$target_dir/$name");`
111			`}elsif (-d "$n") {#copy folder`
112			`dircopy ("$n","$target_dir/$name");`
113			`}elsif(-d "$f" ){`
114			`dircopy ("$f","$target_dir/$name");`
115
116			`}`
117			`}`
118
119			`}`
120
121
122			`sub remove_file_and_folders{`
123			`my ($file_ref,$project_dir)=@_;`
124
125			`foreach my $f(@{$file_ref}){`
126			`my $name= basename($f);`
127			`my $n="$project_dir$f";`
128			`if (-f "$n") { #copy file`
129			`unlink ("$n");`
130			`}elsif(-f "$f" ){`
131			`unlink ("$f");`
132			`}elsif (-d "$n") {#copy folder`
133			`rmtree ("$n");`
134			`}elsif(-d "$f" ){`
135			`rmtree ("$f");`
136			`}`
137			`}`
138
139			`}`
140
141			`sub read_file_cntent {`
142			`my ($f,$project_dir)=@_;`
143			`my $n="$project_dir$f";`
144			`my $str;`
145			`if (-f "$n") {`
146
147			`$str = do {`
148			`local $/ = undef;`
149			`open my $fh, "<", $n`
150			`or die "could not open $n: $!";`
151			`<$fh>;`
152			`};`
153
154			`}elsif(-f "$f" ){`
155			`$str = do {`
156			`local $/ = undef;`
157			`open my $fh, "<", $f`
158			`or die "could not open $f: $!";`
159			`<$fh>;`
160			`};`
161
162
163			`}`
164			`return $str;`
165
166			`}`
167
168
169			`sub check_file_has_string {`
170			`my ($file,$string)=@_;`
171			`my $r;`
172			`open(FILE,$file);`
173			`if (grep{/$string/} <FILE>){`
174			`$r= 1; #print "word found\n";`
175			`}else{`
176			`$r= 0; #print "word not found\n";`
177			`}`
178			`close FILE;`
179			`return $r;`
180			`}`
181
182			`##############`
183			`# clone_obj`
184			`#############`
185
186			`sub clone_obj{`
187			`my ($self,$clone)=@_;`
188
189			`foreach my $p (keys %$self){`
190			`delete ($self->{$p});`
191			`}`
192			`foreach my $p (keys %$clone){`
193			`$self->{$p}= $clone->{$p};`
194			`my $ref= ref ($clone->{$p});`
195			`if( $ref eq 'HASH' ){`
196
197			`foreach my $q (keys %{$clone->{$p}}){`
198			`$self->{$p}{$q}= $clone->{$p}{$q};`
199			`my $ref= ref ($self->{$p}{$q});`
200			`if( $ref eq 'HASH' ){`
201
202			`foreach my $z (keys %{$clone->{$p}{$q}}){`
203			`$self->{$p}{$q}{$z}= $clone->{$p}{$q}{$z};`
204			`my $ref= ref ($self->{$p}{$q}{$z});`
205			`if( $ref eq 'HASH' ){`
206
207			`foreach my $w (keys %{$clone->{$p}{$q}{$z}}){`
208			`$self->{$p}{$q}{$z}{$w}= $clone->{$p}{$q}{$z}{$w};`
209			`my $ref= ref ($self->{$p}{$q}{$z}{$w});`
210			`if( $ref eq 'HASH' ){`
211
212
213			`foreach my $m (keys %{$clone->{$p}{$q}{$z}{$w}}){`
214			`$self->{$p}{$q}{$z}{$w}{$m}= $clone->{$p}{$q}{$z}{$w}{$m};`
215			`my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m});`
216			`if( $ref eq 'HASH' ){`
217
218			`foreach my $n (keys %{$clone->{$p}{$q}{$z}{$w}{$m}}){`
219			`$self->{$p}{$q}{$z}{$w}{$m}{$n}= $clone->{$p}{$q}{$z}{$w}{$m}{$n};`
220			`my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m}{$n});`
221			`if( $ref eq 'HASH' ){`
222
223			`foreach my $l (keys %{$clone->{$p}{$q}{$z}{$w}{$m}{$n}}){`
224			`$self->{$p}{$q}{$z}{$w}{$m}{$n}{$l}= $clone->{$p}{$q}{$z}{$w}{$m}{$n}{$l};`
225			`my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m}{$n}{$l});`
226			`if( $ref eq 'HASH' ){`
227			`}`
228			`}`
229
230			`}#if`
231			`}#n`
232			`}#if`
233			`}#m`
234			`}#if`
235			`}#w`
236			`}#if`
237			`}#z`
238			`}#if`
239			`}#q`
240			`}#if`
241			`}#p`
242			`}#sub`
243
244
245			`sub get_project_dir{ #mpsoc directory address`
246			`my $dir = Cwd::getcwd();`
247			`my $project_dir = abs_path("$dir/../../");`
248			`return $project_dir;`
249			`}`
250
251
252			`sub remove_project_dir_from_addr{`
253			`my $file=shift;`
254			`my $project_dir = get_project_dir();`
255			`$file =~ s/$project_dir//;`
256			`return $file;`
257			`}`
258
259			`sub add_project_dir_to_addr{`
260			`my $file=shift;`
261			`my $project_dir = get_project_dir();`
262			`return $file if(-f $file );`
263			`return "$project_dir/$file";`
264
265			`}`
266
267			`sub get_full_path_addr{`
268			`my $file=shift;`
269			`my $dir = Cwd::getcwd();`
270			`my $full_path = "$dir/$file";`
271			`return $full_path if -f ($full_path );`
272			`return $file;`
273			`}`
274
275			`sub regen_object {`
276			`my $path=shift;`
277			`$path = get_full_path_addr($path);`
278			`my $pp= eval { do $path };`
279			`my $r= ($@ \|\| !defined $pp);`
280			`return ($pp,$r,$@);`
281			`}`
282
283
284			`################`
285			`# general`
286			`#################`
287
288
289
290
291			`sub trim { my $s = shift; $s=~s/[\n]//gs; return $s };`
292
293			`sub remove_all_white_spaces($)`
294			`{`
295			`my $string = shift;`
296			`$string =~ s/\s+//g;`
297			`return $string;`
298			`}`
299
300
301
302
303			`sub get_scolar_pos{`
304			`my ($item,@list)=@_;`
305			`my $pos;`
306			`my $i=0;`
307			`foreach my $c (@list)`
308			`{`
309			`if( $c eq $item) {$pos=$i}`
310			`$i++;`
311			`}`
312			`return $pos;`
313			`}`
314
315			`sub remove_scolar_from_array{`
316			`my ($array_ref,$item)=@_;`
317			`my @array=@{$array_ref};`
318			`my @new;`
319			`foreach my $p (@array){`
320			`if($p ne $item ){`
321			`push(@new,$p);`
322			`}`
323			`}`
324			`return @new;`
325			`}`
326
327			`sub replace_in_array{`
328			`my ($array_ref,$item1,$item2)=@_;`
329			`my @array=@{$array_ref};`
330			`my @new;`
331			`foreach my $p (@array){`
332			`if($p eq $item1 ){`
333			`push(@new,$item2);`
334			`}else{`
335			`push(@new,$p);`
336			`}`
337			`}`
338			`return @new;`
339			`}`
340
341
342
343			`# return an array of common elemnts between two input arays`
344			`sub get_common_array{`
345			`my ($a_ref,$b_ref)=@_;`
346			`my @A=@{$a_ref};`
347			`my @B=@{$b_ref};`
348			`my @C;`
349			`foreach my $p (@A){`
350			`if( grep (/^\Q$p\E$/,@B)){push(@C,$p)};`
351			`}`
352			`return @C;`
353			`}`
354
355			`#a-b`
356			`sub get_diff_array{`
357			`my ($a_ref,$b_ref)=@_;`
358			`my @A=@{$a_ref};`
359			`my @B=@{$b_ref};`
360			`my @C;`
361			`foreach my $p (@A){`
362			`if( !grep (/^\Q$p\E$/,@B)){push(@C,$p)};`
363			`}`
364			`return @C;`
365
366			`}`
367
368
369
370			`sub compress_nums{`
371			`my @nums=@_;`
372			`my @f=sort { $a <=> $b } @nums;`
373			`my $s;`
374			`my $ls;`
375			`my $range=0;`
376			`my $x;`
377
378
379			`foreach my $p (@f){`
380			`if(!defined $x) {`
381			`$s="$p";`
382			`$ls=$p;`
383
384			`}`
385			`else{`
386			`if($p-$x>1){ #gap exist`
387			`if( $range){`
388			`$s=($x-$ls>1 )? "$s:$x,$p": "$s,$x,$p";`
389			`$ls=$p;`
390			`$range=0;`
391			`}else{`
392			`$s= "$s,$p";`
393			`$ls=$p;`
394
395			`}`
396
397			`}else {$range=1;}`
398
399
400
401			`}`
402
403			`$x=$p`
404			`}`
405			`if($range==1){ $s= ($x-$ls>1 )? "$s:$x": "$s,$x";}`
406			`#update $s($ls,$hs);`
407
408			`return $s;`
409
410			`}`
411
412
413
414			`sub metric_conversion{`
415			`my $size=shift;`
416			`my $size_text= $size==0 ? 'Error':`
417			`$size<(1 << 10)? $size:`
418			`$size<(1 << 20)? join (' ', ($size>>10,"K")) :`
419			`$size<(1 << 30)? join (' ', ($size>>20,"M")) :`
420			`join (' ', ($size>>30,"G")) ;`
421			`return $size_text;`
422			`}`
423
424
425
426
427
428			`######`
429			`# state`
430			`#####`
431			`sub set_gui_status{`
432			`my ($object,$status,$timeout)=@_;`
433			`$object->object_add_attribute('gui_status','status',$status);`
434			`$object->object_add_attribute('gui_status','timeout',$timeout);`
435			`}`
436
437
438			`sub get_gui_status{`
439			`my ($object)=@_;`
440			`my $status= $object->object_get_attribute('gui_status','status');`
441			`my $timeout=$object->object_get_attribute('gui_status','timeout');`
442			`return ($status,$timeout);`
443			`}`
444
445
446
447
448			`###########`
449			`# color`
450			`#########`
451
452
453
454			`sub get_color {`
455			`my $num=shift;`
456
457			`my @colors=(`
458			`0x6495ED,#Cornflower Blue`
459			`0xFAEBD7,#Antiquewhite`
460			`0xC71585,#Violet Red`
461			`0xC0C0C0,#silver`
462			`0xADD8E6,#Lightblue`
463			`0x6A5ACD,#Slate Blue`
464			`0x00CED1,#Dark Turquoise`
465			`0x008080,#Teal`
466			`0x2E8B57,#SeaGreen`
467			`0xFFB6C1,#Light Pink`
468			`0x008000,#Green`
469			`0xFF0000,#red`
470			`0x808080,#Gray`
471			`0x808000,#Olive`
472			`0xFF69B4,#Hot Pink`
473			`0xFFD700,#Gold`
474			`0xDAA520,#Goldenrod`
475			`0xFFA500,#Orange`
476			`0x32CD32,#LimeGreen`
477			`0x0000FF,#Blue`
478			`0xFF8C00,#DarkOrange`
479			`0xA0522D,#Sienna`
480			`0xFF6347,#Tomato`
481			`0x0000CD,#Medium Blue`
482			`0xFF4500,#OrangeRed`
483			`0xDC143C,#Crimson`
484			`0x9932CC,#Dark Orchid`
485			`0x800000,#marron`
486			`0x800080,#Purple`
487			`0x4B0082,#Indigo`
488			`0xFFFFFF,#white`
489			`0x000000 #Black`
490			`);`
491
492			`my $color= ($num< scalar (@colors))? $colors[$num]: 0xFFFFFF;`
493			`my $red= ($color & 0xFF0000) >> 8;`
494			`my $green= ($color & 0x00FF00);`
495			`my $blue= ($color & 0x0000FF) << 8;`
496
497			`return ($red,$green,$blue);`
498
499			`}`
500
501
502			`sub get_color_hex_string {`
503			`my $num=shift;`
504
505			`my @colors=(`
506			`"6495ED",#Cornflower Blue`
507			`"FAEBD7",#Antiquewhite`
508			`"C71585",#Violet Red`
509			`"C0C0C0",#silver`
510			`"ADD8E6",#Lightblue`
511			`"6A5ACD",#Slate Blue`
512			`"00CED1",#Dark Turquoise`
513			`"008080",#Teal`
514			`"2E8B57",#SeaGreen`
515			`"FFB6C1",#Light Pink`
516			`"008000",#Green`
517			`"FF0000",#red`
518			`"808080",#Gray`
519			`"808000",#Olive`
520			`"FF69B4",#Hot Pink`
521			`"FFD700",#Gold`
522			`"DAA520",#Goldenrod`
523			`"FFA500",#Orange`
524			`"32CD32",#LimeGreen`
525			`"0000FF",#Blue`
526			`"FF8C00",#DarkOrange`
527			`"A0522D",#Sienna`
528			`"FF6347",#Tomato`
529			`"0000CD",#Medium Blue`
530			`"FF4500",#OrangeRed`
531			`"DC143C",#Crimson`
532			`"9932CC",#Dark Orchid`
533			`"800000",#marron`
534			`"800080",#Purple`
535			`"4B0082",#Indigo`
536			`"FFFFFF",#white`
537			`"000000" #Black`
538			`);`
539
540			`my $color= ($num< scalar (@colors))? $colors[$num]: "FFFFFF";`
541			`return $color;`
542
543			`}`
544
545
546
547
548
549			`sub check_verilog_identifier_syntax {`
550			`my $in=shift;`
551			`my $error=0;`
552			`my $message='';`
553			`# an Identifiers must begin with an alphabetic character or the underscore character`
554			`if ($in =~ /^[0-9\$]/){`
555			`return 'an Identifier must begin with an alphabetic character or the underscore character';`
556			`}`
557
558
559			`# Identifiers may contain alphabetic characters, numeric characters, the underscore, and the dollar sign (a-z A-Z 0-9 _ $ )`
560			`if ($in =~ /[^a-zA-Z0-9_\$]+/){`
561			`print "use of illegal character after\n" ;`
562			`my @w= split /([^a-zA-Z0-9_\$]+)/, $in;`
563			`return "Contain illegal character of \"$w[1]\". Identifiers may contain alphabetic characters, numeric characters, the underscore, and the dollar sign (a-z A-Z 0-9 _ \$ )\n";`
564
565			`}`
566
567
568			`# check Verilog reserved words`
569			my @keys = ("always","and","assign","automatic","begin","buf","bufif0","bufif1","case","casex","casez","cell","cmos","config","deassign","default","defparam","design","disable","edge","else","end","endcase","endconfig","endfunction","endgenerate","endmodule","endprimitive","endspecify","endtable","endtask","event","for","force","forever","fork","function","generate","genvar","highz0","highz1","if","ifnone","incdir","include","initial","inout","input","instance","integer","join","large","liblist","library","localparam","macromodule","medium","module","nand","negedge","nmos","nor","noshowcancelled","not","notif0","notif1","or","output","parameter","pmos","posedge","primitive","pull0","pull1","pulldown","pullup","pulsestyle_onevent","pulsestyle_ondetect","remos","real","realtime","reg","release","repeat","rnmos","rpmos","rtran","rtranif0","rtranif1","scalared","showcancelled","signed","small","specify","specparam","strong0","strong1","supply0","supply1","table","task","time","tran","tranif0","tranif1","tri","tri0","tri1","triand","trior","trireg","unsigned","use","vectored","wait","wand","weak0","weak1","while","wire","wor","xnor","xor");
570			`if( grep (/^$in$/,@keys)){`
571			`return "$in is a Verlig reserved word.";`
572			`}`
573			`return undef;`
574
575			`}`
576
577
578			`sub capture_number_after {`
579			`my ($after,$text)=@_;`
580			`my @q =split (/$after/,$text);`
581			`#my $d=$q[1];`
582			`my @d = split (/[^0-9. ]/,$q[1]);`
583			`return $d[0];`
584
585			`}`
586
587			`sub capture_string_between {`
588			`my ($start,$text,$end)=@_;`
589			`my @q =split (/$start/,$text);`
590			`my @d = split (/$end/,$q[1]);`
591			`return $d[0];`
592			`}`
593
594
595			`sub make_undef_as_string {`
596			`foreach my $p (@_){`
597			`$$p= 'undef' if (! defined $$p);`
598
599			`}`
600			`}`
601
602			`sub powi{ # x^y`
603			`my ($x,$y)=@_; # compute x to the y`
604			`my $r=1;`
605			`for (my $i = 0; $i < $y; ++$i ) {`
606			`$r *= $x;`
607			`}`
608			`return $r;`
609			`}`
610
611			`sub sum_powi{ # x^(y-1) + x^(y-2) + ...+ 1;`
612			`my ($x,$y)=@_; # compute x to the y`
613			`my $r = 0;`
614			`for (my $i = 0; $i < $y; $i++){`
615			`$r += powi( $x, $i );`
616			`}`
617			`return $r;`
618			`}`
619
620
621
622
623			`1`
624