OpenCores
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 48

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

Line No. Rev Author Line
1 43 alirezamon 
use strict;
2 
use warnings;
3 
 
4 
use String::Similarity;
5 48 alirezamon 
use Proc::Background;
6 
use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep  clock_gettime clock_getres clock_nanosleep clock stat );
7 43 alirezamon 
 
8 48 alirezamon 
use List::MoreUtils qw(uniq);
9 
use POSIX qw(ceil floor);
10 
 
11 
use Cwd 'abs_path';
12 
use Term::ANSIColor qw(:constants);
13 
use IPC::Run qw(start pump finish timeout pumpable);
14 43 alirezamon 
 
15 48 alirezamon 
 
16 
sub log2{
17 
        my $num=shift;
18 
        my $log=($num <=1) ? 1: 0;
19 
        while( (1<< $log)  < $num) {
20 
                                $log++;
21 
        }
22 
        return  $log;
23 
}
24 
 
25 43 alirezamon 
sub find_the_most_similar_position{
26 
        my ($item ,@list)=@_;
27 
        my $most_similar_pos=0;
28 
        my $lastsim=0;
29 
        my $i=0;
30 
        # convert item to lowercase
31 
        $item = lc $item;
32 
        foreach my $p(@list){
33 
                my $similarity= similarity $item, $p;
34 
                if ($similarity > $lastsim){
35 
                        $lastsim=$similarity;
36 
                        $most_similar_pos=$i;
37 
                }
38 
                $i++;
39 
        }
40 
        return $most_similar_pos;
41 
}
42 
 
43 48 alirezamon 
sub is_integer {
44 
   defined $_[0] && $_[0] =~ /^[+-]?\d+$/;
45 
}
46 43 alirezamon 
 
47 
 
48 
####################
49 48 alirezamon 
#        verilog file
50 43 alirezamon 
##################
51 
 
52 
 
53 
sub read_verilog_file{
54 
        my @files            = @_;
55 
        my %cmd_line_defines = ();
56 
        my $quiet            = 1;
57 
        my @inc_dirs         = ();
58 
        my @lib_dirs         = ();
59 
        my @lib_exts         = ();
60 
        my $vdb = rvp->read_verilog(\@files,[],\%cmd_line_defines,
61 
                          $quiet,\@inc_dirs,\@lib_dirs,\@lib_exts);
62 
 
63 
        my @problems = $vdb->get_problems();
64 
        if (@problems) {
65 
            foreach my $problem ($vdb->get_problems()) {
66 48 alirezamon 
                print STDERR "$problem.\n" unless ( $problem =~ /smartflit_chanel_t/);
67 43 alirezamon 
            }
68 
            # die "Warnings parsing files!";
69 
        }
70 
        return $vdb;
71 
}
72 
 
73 
 
74 48 alirezamon 
sub verilog_file_get_ports_list{
75 
        my ($vdb,$top_module)=@_;
76 
        my @ports;
77 
 
78 
        foreach my $sig (sort $vdb->get_modules_signals($top_module)) {
79 
        my ($line,$a_line,$i_line,$type,$file,$posedge,$negedge,
80 
         $type2,$s_file,$s_line,$range,$a_file,$i_file,$dims) =
81 
           $vdb->get_module_signal($top_module,$sig);
82 43 alirezamon 
 
83 48 alirezamon 
                if($type eq "input" or $type eq "inout" or $type eq "output" ){
84 
                        push(@ports, $sig);
85 
 
86 
                }
87 
        }
88 
        return @ports;
89 
}
90 43 alirezamon 
 
91 48 alirezamon 
 
92 
 
93 
sub get_ports_type{
94 
        my ($vdb,$top_module)=@_;
95 
        my %ports;
96 
 
97 
        foreach my $sig (sort $vdb->get_modules_signals($top_module)) {
98 
        my ($line,$a_line,$i_line,$type,$file,$posedge,$negedge,
99 
         $type2,$s_file,$s_line,$range,$a_file,$i_file,$dims) =
100 
           $vdb->get_module_signal($top_module,$sig);
101 
 
102 
                if($type eq "input" or $type eq "inout" or $type eq "output" ){
103 
                        $ports{$sig}=$type;
104 
 
105 
                }
106 
        }
107 
        return %ports;
108 
}
109 
 
110 
 
111 
 
112 
sub get_ports_rang{
113 
        my ($vdb,$top_module)=@_;
114 
        my %ports;
115 
 
116 
        foreach my $sig (sort $vdb->get_modules_signals($top_module)) {
117 
        my ($line,$a_line,$i_line,$type,$file,$posedge,$negedge,
118 
         $type2,$s_file,$s_line,$range,$a_file,$i_file,$dims) =
119 
           $vdb->get_module_signal($top_module,$sig);
120 
 
121 
                if($type eq "input" or $type eq "inout" or $type eq "output" ){
122 
 
123 
 
124 
 
125 
                        $ports{$sig}=remove_all_white_spaces($range);
126 
 
127 
                }
128 
        }
129 
        return %ports;
130 
}
131 
 
132 
 
133 
 
134 
 
135 
sub get_param_list_in_order {
136 
   my $ref =shift;
137 
   return undef if (!defined $ref);
138 
   my %param=%{$ref};
139 
   my @array = sort keys %param;
140 
   my $l= scalar @array;
141 
   SCAN: {
142 
   foreach my $i (0..($l-2)) {
143 
      my $str1=$array[$i];
144 
      foreach my $j ($i+1..($l-1)) {
145 
      my $str2=$array[$j];
146 
        if ($param{$str1} =~ /\b$str2\b/ ) {
147 
 
148 
        my $tmp = $array[$i];
149 
        $array[$i] =$array[$j];
150 
        $array[$j]=$tmp;
151 
 
152 
        redo SCAN;
153 
      }
154 
    }
155 
    }
156 
  }
157 
 
158 
  return @array;
159 
}
160 
 
161 
sub gen_verilator_makefile{
162 
        my ($top_ref,$target_dir) =@_;
163 
        my %tops = %{$top_ref};
164 
        my $p='';
165 
        my $q='';
166 
        my $h='';
167 
        my $l;
168 
        my $lib_num=0;
169 
        my $all_lib="";
170 
        foreach my $top (sort keys %tops) {
171 
                $p = "$p ${top}__ALL.a ";
172 
                $q = $q."lib$lib_num:\n\t\$(MAKE) -f ${top}.mk\n";
173 
                $h = "$h ${top}.h ";
174 
                $l = $top;
175 
                $all_lib=$all_lib." lib$lib_num";
176 
                $lib_num++;
177 
        }
178 
 
179 
 
180 
        my $make= "
181 
 
182 
default: sim
183 
 
184 
 
185 
 
186 
include $l.mk
187 
 
188 
lib: $all_lib
189 
 
190 
$q
191 
 
192 
 
193 
#######################################################################
194 
# Compile flags
195 
 
196 
CPPFLAGS += -DVL_DEBUG=1
197 
ifeq (\$(CFG_WITH_CCWARN),yes)  # Local... Else don't burden users
198 
CPPFLAGS += -DVL_THREADED=1
199 
CPPFLAGS += -W -Werror -Wall
200 
endif
201 
 
202 
#######################################################################
203 
# Linking final exe -- presumes have a sim_main.cpp
204 
 
205 
 
206 
sim:    testbench.o \$(VK_GLOBAL_OBJS) $p
207 
        \$(LINK) \$(LDFLAGS) -g \$^ \$(LOADLIBES) \$(LDLIBS) -o testbench \$(LIBS) -Wall -O3 -lpthread 2>&1 | c++filt
208 
 
209 
testbench.o: testbench.cpp $h
210 
 
211 
clean:
212 
        rm *.o *.a testbench
213 
";
214 
 
215 
save_file ($target_dir,$make);
216 
 
217 
}
218 
 
219 
 
220 
####################
221 
#        file
222 
##################
223 
 
224 
 
225 43 alirezamon 
sub append_text_to_file {
226 
        my  ($file_path,$text)=@_;
227 
        open(my $fd, ">>$file_path") or die "could not open $file_path: $!";
228 
        print $fd $text;
229 
        close $fd;
230 
}
231 
 
232 
 
233 
 
234 
 
235 
sub save_file {
236 
        my  ($file_path,$text)=@_;
237 
        open my $fd, ">$file_path" or die "could not open $file_path: $!";
238 
        print $fd $text;
239 
        close $fd;
240 
}
241 
 
242 
sub load_file {
243 
        my $file_path=shift;
244 
        my $str;
245 
        if (-f "$file_path") {
246 
 
247 
                $str = do {
248 
                        local $/ = undef;
249 
                        open my $fh, "<", $file_path
250 
                        or die "could not open $file_path: $!";
251 
                        <$fh>;
252 
                };
253 
 
254 
        }
255 
        return $str;
256 
}
257 
 
258 
sub merg_files {
259 
        my  ($source_file_path,$dest_file_path)=@_;
260 
        local $/=undef;
261 
        open FILE, $source_file_path or die "Couldn't open file: $!";
262 
        my $string = <FILE>;
263 
        close FILE;
264 
         append_text_to_file ($dest_file_path,$string);
265 
}
266 
 
267 
 
268 
 
269 
sub copy_file_and_folders{
270 
        my ($file_ref,$project_dir,$target_dir)=@_;
271 
 
272 
        foreach my $f(@{$file_ref}){
273 
                my $name= basename($f);
274 
 
275 
                my $n="$project_dir$f";
276 
                if (-f "$n") { #copy file
277 
                        copy ("$n","$target_dir/$name");
278 
                }elsif(-f "$f" ){
279 
                        copy ("$f","$target_dir/$name");
280 
                }elsif (-d "$n") {#copy folder
281 
                        dircopy ("$n","$target_dir/$name");
282 
                }elsif(-d "$f" ){
283 
                        dircopy ("$f","$target_dir/$name");
284 
 
285 
                }
286 
        }
287 
 
288 
}
289 
 
290 
 
291 
sub remove_file_and_folders{
292 
        my ($file_ref,$project_dir)=@_;
293 
 
294 
        foreach my $f(@{$file_ref}){
295 
                my $name= basename($f);
296 
                my $n="$project_dir$f";
297 
                if (-f "$n") { #copy file
298 
                        unlink ("$n");
299 
                }elsif(-f "$f" ){
300 
                        unlink ("$f");
301 
                }elsif (-d "$n") {#copy folder
302 
                        rmtree ("$n");
303 
                }elsif(-d "$f" ){
304 
                        rmtree ("$f");
305 
                }
306 
        }
307 
 
308 
}
309 
 
310 
sub read_file_cntent {
311 
        my ($f,$project_dir)=@_;
312 
        my $n="$project_dir$f";
313 
        my $str;
314 
        if (-f "$n") {
315 
 
316 
                $str = do {
317 
                        local $/ = undef;
318 
                        open my $fh, "<", $n
319 
                        or die "could not open $n: $!";
320 
                        <$fh>;
321 
                };
322 
 
323 
        }elsif(-f "$f" ){
324 
                $str = do {
325 
                        local $/ = undef;
326 
                        open my $fh, "<", $f
327 
                        or die "could not open $f: $!";
328 
                        <$fh>;
329 
                };
330 
 
331 
 
332 
        }
333 
        return $str;
334 
 
335 
}
336 
 
337 
 
338 
sub check_file_has_string {
339 
    my ($file,$string)=@_;
340 
    my $r;
341 
    open(FILE,$file);
342 
    if (grep{/$string/} <FILE>){
343 
       $r= 1; #print "word  found\n";
344 
    }else{
345 
       $r= 0; #print "word not found\n";
346 
    }
347 
    close FILE;
348 
    return $r;
349 
}
350 
 
351 48 alirezamon 
#return lines containig pattern in a givn file
352 
sub unix_grep {
353 
        my ($file,$pattern)=@_;
354 
    open(FILE,$file);
355 
    my @arr = <FILE>;
356 
    my @lines = grep /$pattern/, @arr;
357 
        return @lines;
358 
}
359 
 
360 
 
361 
sub count_file_line_num {
362 
    my ($file)=@_;
363 
    open(FILE,$file);
364 
    my $n=0;
365 
    while (my $line = <FILE>) {
366 
           $n++;
367 
        }
368 
    close FILE;
369 
    return $n;
370 
}
371 
 
372 
sub set_path_env{
373 
        my $project_dir   = get_project_dir(); #mpsoc dir addr
374 
        my $paths_file= "$project_dir/mpsoc/perl_gui/lib/Paths";
375 
        #print "$paths_file\n";
376 
        my $paths= do $paths_file;
377 
        my $pronoc_work =object_get_attribute($paths,"PATH","PRONOC_WORK");
378 
        my $quartus = object_get_attribute($paths,"PATH","QUARTUS_BIN");
379 
        my $vivado  = object_get_attribute($paths,"PATH","VIVADO_BIN");
380 
        my $sdk     = object_get_attribute($paths,"PATH","SDK_BIN");
381 
 
382 
        my $modelsim = object_get_attribute($paths,"PATH","MODELSIM_BIN");
383 
        $ENV{'PRONOC_WORK'}= $pronoc_work if( defined $pronoc_work);
384 
        $ENV{'QUARTUS_BIN'}= $quartus if( defined $quartus);
385 
        $ENV{'VIVADO_BIN'}= $vivado if( defined $vivado);
386 
        $ENV{'SDK_BIN'}= $vivado if( defined $sdk);
387 
        $ENV{'MODELSIM_BIN'}= $modelsim if( defined $modelsim);
388 
 
389 
        if( defined $pronoc_work){if(-d $pronoc_work ){
390 
                        mkpath("$pronoc_work/emulate",1,01777) unless -d "$pronoc_work/emulate";
391 
                        mkpath("$pronoc_work/simulate",1,01777) unless -d "$pronoc_work/simulate";
392 
                        mkpath("$pronoc_work/tmp",1,01777) unless -d "$pronoc_work/tmp";
393 
        }}
394 
 
395 
        #add quartus_bin to PATH linux environment if it does not exist in PATH
396 
        my $add;
397 
        if( defined $quartus){
398 
                my @q =split  (/:/,$ENV{'PATH'});
399 
                my $p=get_scolar_pos ($quartus,@q);
400 
                $ENV{'PATH'}= $ENV{'PATH'}.":$quartus" unless ( defined $p);
401 
                $add=(defined $add)? $add.":$quartus" : $quartus unless ( defined $p);
402 
 
403 
        }
404 
 
405 
        if( defined $vivado){
406 
                my @q =split  (/:/,$ENV{'PATH'});
407 
                my $p=get_scolar_pos ($vivado,@q);
408 
                $ENV{'PATH'}= $ENV{'PATH'}.":$vivado" unless ( defined $p);
409 
                $add=(defined $add)? $add.":$vivado" : $vivado unless ( defined $p);
410 
 
411 
        }
412 
 
413 
        if( defined $sdk){
414 
                my @q =split  (/:/,$ENV{'PATH'});
415 
                my $p=get_scolar_pos ($sdk,@q);
416 
                $ENV{'PATH'}= $ENV{'PATH'}.":$sdk" unless ( defined $p);
417 
                $add=(defined $add)? $add.":$sdk" : $sdk unless ( defined $p);
418 
 
419 
        }
420 
        if(defined $add){
421 
                print GREEN, "Info: $add has been added to linux PATH envirement.\n",RESET,"\n";
422 
 
423 
        }
424 
 
425 
 
426 
}
427 
 
428 
 
429 
 
430 
sub source_file {
431 
    my $file = shift;
432 
    open my $fh, "<", $file   or return  "could not open $file: $!";
433 
 
434 
    while (<$fh>) {
435 
        chomp;
436 
        #FIXME: this regex isn't quite good enough
437 
        next unless my ($var, $value) = /\s*(\w+)=([^#]+)/;
438 
        $ENV{$var} = $value;
439 
    }
440 
    return undef;
441 
}
442 
 
443 
 
444 43 alirezamon 
##############
445 
#  clone_obj
446 
#############
447 
 
448 
sub clone_obj{
449 
        my ($self,$clone)=@_;
450 
 
451 
        foreach my $p (keys %$self){
452 
                delete ($self->{$p});
453 
        }
454 
        foreach my $p (keys %$clone){
455 
                $self->{$p}= $clone->{$p};
456 
                my $ref= ref ($clone->{$p});
457 
                if( $ref eq 'HASH' ){
458 
 
459 
                        foreach my $q (keys %{$clone->{$p}}){
460 
                                $self->{$p}{$q}= $clone->{$p}{$q};
461 
                                my $ref= ref ($self->{$p}{$q});
462 
                                if( $ref eq 'HASH' ){
463 
 
464 
                                        foreach my $z (keys %{$clone->{$p}{$q}}){
465 
                                                $self->{$p}{$q}{$z}= $clone->{$p}{$q}{$z};
466 
                                                my $ref= ref ($self->{$p}{$q}{$z});
467 
                                                if( $ref eq 'HASH' ){
468 
 
469 
                                                        foreach my $w (keys %{$clone->{$p}{$q}{$z}}){
470 
                                                                $self->{$p}{$q}{$z}{$w}= $clone->{$p}{$q}{$z}{$w};
471 
                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w});
472 
                                                                if( $ref eq 'HASH' ){
473 
 
474 
 
475 
                                                                        foreach my $m (keys %{$clone->{$p}{$q}{$z}{$w}}){
476 
                                                                                $self->{$p}{$q}{$z}{$w}{$m}= $clone->{$p}{$q}{$z}{$w}{$m};
477 
                                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m});
478 
                                                                                if( $ref eq 'HASH' ){
479 
 
480 
                                                                                        foreach my $n (keys %{$clone->{$p}{$q}{$z}{$w}{$m}}){
481 
                                                                                                $self->{$p}{$q}{$z}{$w}{$m}{$n}= $clone->{$p}{$q}{$z}{$w}{$m}{$n};
482 
                                                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m}{$n});
483 
                                                                                                if( $ref eq 'HASH' ){
484 
 
485 
                                                                                                        foreach my $l (keys %{$clone->{$p}{$q}{$z}{$w}{$m}{$n}}){
486 
                                                                                                                $self->{$p}{$q}{$z}{$w}{$m}{$n}{$l}= $clone->{$p}{$q}{$z}{$w}{$m}{$n}{$l};
487 
                                                                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m}{$n}{$l});
488 
                                                                                                                if( $ref eq 'HASH' ){
489 
                                                                                                                }
490 
                                                                                                        }
491 
 
492 
                                                                                                }#if
493 
                                                                                        }#n
494 
                                                                                }#if
495 
                                                                        }#m
496 
                                                                }#if
497 
                                                        }#w
498 
                                                }#if
499 
                                        }#z
500 
                                }#if
501 
                        }#q
502 
                }#if
503 
        }#p
504 
}#sub
505 
 
506 
 
507 
sub get_project_dir{ #mpsoc directory address
508 
        my $dir = Cwd::getcwd();
509 48 alirezamon 
        my @p=  split('/perl_gui',$dir);
510 
        @p=     split('/Integration_test',$p[0]);
511 
    my $d         = abs_path("$p[0]/../");
512 
 
513 
        return $d;
514 43 alirezamon 
}
515 
 
516 48 alirezamon 
sub cut_dir_path{
517 
        my ($dir,$folder_name) = @_;
518 
        my @p=  split (/\/$folder_name\//,$dir);
519 
        return $p[-1];
520 
}
521 43 alirezamon 
 
522 48 alirezamon 
 
523 43 alirezamon 
sub remove_project_dir_from_addr{
524 
        my $file=shift;
525 
        my $project_dir   = get_project_dir();
526 
        $file =~ s/$project_dir//;
527 
        return $file;
528 
}
529 
 
530 
sub add_project_dir_to_addr{
531 
        my $file=shift;
532 
        my $project_dir   = get_project_dir();
533 
        return $file if(-f $file );
534 
        return "$project_dir/$file";
535 
 
536 
}
537 
 
538 
sub get_full_path_addr{
539 
        my $file=shift;
540 
        my $dir = Cwd::getcwd();
541 
        my $full_path = "$dir/$file";
542 
        return $full_path  if -f ($full_path );
543 
        return $file;
544 
}
545 
 
546 
sub regen_object {
547 
        my $path=shift;
548 
        $path = get_full_path_addr($path);
549 
        my $pp= eval { do $path };
550 
        my $r= ($@ || !defined $pp);
551 
        return ($pp,$r,$@);
552 
}
553 
 
554 
 
555 
################
556 
#       general
557 
#################
558 
 
559 48 alirezamon 
sub remove_not_hex {
560 
        my $s=shift;
561 
        $s =~ s/[^0-9a-fA-F]//g;
562 
        return $s;
563 
}
564 43 alirezamon 
 
565 48 alirezamon 
sub remove_not_number {
566 
        my $s=shift;
567 
        $s =~ s/[^0-9]//g;
568 
        return $s;
569 
 
570 
}
571 43 alirezamon 
 
572 
sub  trim { my $s = shift;  $s=~s/[\n]//gs; return $s };
573 
 
574 
sub remove_all_white_spaces($)
575 
{
576 
  my $string = shift;
577 
  $string =~ s/\s+//g;
578 
  return $string;
579 
}
580 
 
581 
 
582 48 alirezamon 
sub check_scolar_exist_in_array{
583 
        my ($value,$ref)=@_;
584 
        my @array= @{$ref};
585 
        if ( grep( /^\Q$value\E$/, @array ) ) {
586 
          return 1;
587 
        }
588 
        return 0
589 
}
590 43 alirezamon 
 
591 48 alirezamon 
sub get_item_pos{#if not in return 0
592 
                my ($item,@list)=@_;
593 
                my $pos=0;
594 
                foreach my $p (@list){
595 
                                #print "$p eq $item\n";
596 
                                if ($p eq $item){return $pos;}
597 
                                $pos++;
598 
                }
599 
                return 0;
600 
 
601 
}
602 43 alirezamon 
 
603 
sub get_scolar_pos{
604 
        my ($item,@list)=@_;
605 
        my $pos;
606 
        my $i=0;
607 
        foreach my $c (@list)
608 
        {
609 
                if(  $c eq $item) {$pos=$i}
610 
                $i++;
611 
        }
612 
        return $pos;
613 48 alirezamon 
}
614 43 alirezamon 
 
615 48 alirezamon 
sub get_pos{
616 
        my ($item,@list)=@_;
617 
        my $pos=0;
618 
        foreach my $p (@list){
619 
                #print "$p eq $item\n";
620 
                if ($p eq $item){return $pos;}
621 
                $pos++;
622 
        }
623 
        return undef;
624 
}
625 
 
626 43 alirezamon 
sub remove_scolar_from_array{
627 
        my ($array_ref,$item)=@_;
628 
        my @array=@{$array_ref};
629 
        my @new;
630 
        foreach my $p (@array){
631 
                if($p ne $item ){
632 
                        push(@new,$p);
633 
                }
634 
        }
635 
        return @new;
636 
}
637 
 
638 
sub replace_in_array{
639 
        my ($array_ref,$item1,$item2)=@_;
640 
        my @array=@{$array_ref};
641 
        my @new;
642 
        foreach my $p (@array){
643 
                if($p eq $item1 ){
644 
                        push(@new,$item2);
645 
                }else{
646 
                        push(@new,$p);
647 
                }
648 
        }
649 
        return @new;
650 
}
651 
 
652 
 
653 
 
654 
# return an array of common elemnts between two input arays
655 
sub get_common_array{
656 
        my ($a_ref,$b_ref)=@_;
657 
        my @A=@{$a_ref};
658 
        my @B=@{$b_ref};
659 
        my @C;
660 
        foreach my $p (@A){
661 
                if( grep (/^\Q$p\E$/,@B)){push(@C,$p)};
662 
        }
663 
        return  @C;
664 
}
665 
 
666 
#a-b
667 
sub get_diff_array{
668 
        my ($a_ref,$b_ref)=@_;
669 
        my @A=@{$a_ref};
670 
        my @B=@{$b_ref};
671 
        my @C;
672 
        foreach my $p (@A){
673 
                if( !grep  (/^\Q$p\E$/,@B)){push(@C,$p)};
674 
        }
675 
        return  @C;
676 
 
677 
}
678 
 
679 
 
680 48 alirezamon 
sub return_not_unique_names_in_array{
681 
        my @array = @_;
682 
        my %seen;
683 
        my @r;
684 
        foreach my $value (@array) {
685 
                if (! $seen{$value}) {
686 
                $seen{$value} = 1;
687 
                }else{
688 
                        push(@r,$value);
689 
                }
690 
        }
691 
        return @r;
692 
}
693 43 alirezamon 
 
694 48 alirezamon 
 
695 43 alirezamon 
sub compress_nums{
696 
        my      @nums=@_;
697 
        my @f=sort { $a <=> $b } @nums;
698 
        my $s;
699 
        my $ls;
700 
        my $range=0;
701 
        my $x;
702 
 
703 
 
704 
        foreach my $p (@f){
705 
                if(!defined $x) {
706 
                        $s="$p";
707 
                        $ls=$p;
708 
 
709 
                }
710 
                else{
711 
                        if($p-$x>1){ #gap exist
712 
                                if( $range){
713 
                                        $s=($x-$ls>1 )? "$s:$x,$p": "$s,$x,$p";
714 
                                        $ls=$p;
715 
                                        $range=0;
716 
                                }else{
717 
                                $s= "$s,$p";
718 
                                $ls=$p;
719 
 
720 
                                }
721 
 
722 
                        }else {$range=1;}
723 
 
724 
 
725 
 
726 
                }
727 
 
728 
                $x=$p
729 
        }
730 
        if($range==1){ $s= ($x-$ls>1 )? "$s:$x":  "$s,$x";}
731 
        #update $s($ls,$hs);
732 
 
733 
        return $s;
734 
 
735 
}
736 
 
737 
 
738 
 
739 
sub metric_conversion{
740 
        my $size=shift;
741 48 alirezamon 
        my $size_text=  $size<=0  ? 'Error ':
742 43 alirezamon 
                        $size<(1 << 10)? $size:
743 
                        $size<(1 << 20)? join (' ', ($size>>10,"K")) :
744 
                        $size<(1 << 30)? join (' ', ($size>>20,"M")) :
745 
                                         join (' ', ($size>>30,"G")) ;
746 
return $size_text;
747 
}
748 
 
749 
 
750 
 
751 
 
752 
 
753 
######
754 
#  state
755 
#####
756 
sub set_gui_status{
757 
        my ($object,$status,$timeout)=@_;
758 
        $object->object_add_attribute('gui_status','status',$status);
759 
        $object->object_add_attribute('gui_status','timeout',$timeout);
760 
}
761 
 
762 
 
763 
sub get_gui_status{
764 
        my ($object)=@_;
765 
        my $status= $object->object_get_attribute('gui_status','status');
766 
        my $timeout=$object->object_get_attribute('gui_status','timeout');
767 
        return ($status,$timeout);
768 
}
769 
 
770 
 
771 
 
772 
 
773 
###########
774 
#  color
775 
#########
776 
 
777 
 
778 
 
779 
sub get_color {
780 
        my $num=shift;
781 
 
782 
        my @colors=(
783 
        0x6495ED,#Cornflower Blue
784 
        0xFAEBD7,#Antiquewhite
785 
        0xC71585,#Violet Red
786 
        0xC0C0C0,#silver
787 
        0xADD8E6,#Lightblue
788 
        0x6A5ACD,#Slate Blue
789 
        0x00CED1,#Dark Turquoise
790 
        0x008080,#Teal
791 
        0x2E8B57,#SeaGreen
792 
        0xFFB6C1,#Light Pink
793 
        0x008000,#Green
794 
        0xFF0000,#red
795 
        0x808080,#Gray
796 
        0x808000,#Olive
797 
        0xFF69B4,#Hot Pink
798 
        0xFFD700,#Gold
799 
        0xDAA520,#Goldenrod
800 
        0xFFA500,#Orange
801 
        0x32CD32,#LimeGreen
802 
        0x0000FF,#Blue
803 
        0xFF8C00,#DarkOrange
804 
        0xA0522D,#Sienna
805 
        0xFF6347,#Tomato
806 
        0x0000CD,#Medium Blue
807 
        0xFF4500,#OrangeRed
808 
        0xDC143C,#Crimson
809 
        0x9932CC,#Dark Orchid
810 
        0x800000,#marron
811 
        0x800080,#Purple
812 
        0x4B0082,#Indigo
813 
        0xFFFFFF,#white
814 
        0x000000 #Black
815 
                );
816 
 
817 
        my $color=      ($num< scalar (@colors))? $colors[$num]: 0xFFFFFF;
818 
        my $red=        ($color & 0xFF0000) >> 8;
819 
        my $green=      ($color & 0x00FF00);
820 
        my $blue=       ($color & 0x0000FF) << 8;
821 
 
822 
        return ($red,$green,$blue);
823 
 
824 
}
825 
 
826 
 
827 
sub get_color_hex_string {
828 
        my $num=shift;
829 
 
830 
        my @colors=(
831 
        "6495ED",#Cornflower Blue
832 
        "FAEBD7",#Antiquewhite
833 
        "C71585",#Violet Red
834 
        "C0C0C0",#silver
835 
        "ADD8E6",#Lightblue
836 
        "6A5ACD",#Slate Blue
837 
        "00CED1",#Dark Turquoise
838 
        "008080",#Teal
839 
        "2E8B57",#SeaGreen
840 
        "FFB6C1",#Light Pink
841 
        "008000",#Green
842 
        "FF0000",#red
843 
        "808080",#Gray
844 
        "808000",#Olive
845 
        "FF69B4",#Hot Pink
846 
        "FFD700",#Gold
847 
        "DAA520",#Goldenrod
848 
        "FFA500",#Orange
849 
        "32CD32",#LimeGreen
850 
        "0000FF",#Blue
851 
        "FF8C00",#DarkOrange
852 
        "A0522D",#Sienna
853 
        "FF6347",#Tomato
854 
        "0000CD",#Medium Blue
855 
        "FF4500",#OrangeRed
856 
        "DC143C",#Crimson
857 
        "9932CC",#Dark Orchid
858 
        "800000",#marron
859 
        "800080",#Purple
860 
        "4B0082",#Indigo
861 
        "FFFFFF",#white
862 
        "000000" #Black
863 
                );
864 
 
865 
        my $color=      ($num< scalar (@colors))? $colors[$num]: "FFFFFF";
866 
        return $color;
867 
 
868 
}
869 
 
870 
 
871 
 
872 
 
873 
 
874 
sub check_verilog_identifier_syntax {
875 
        my $in=shift;
876 
        my $error=0;
877 
        my $message='';
878 48 alirezamon 
#check if $in is defined
879 
        if(!defined $in){
880 
                return "Identifier is not defined! An Identifier must begin with an alphabetic character.\n";
881 
        }
882 
 
883 
        if(length $in ==0){
884 
                return "Identifier length is zero! An Identifier must begin with an alphabetic character.\n";
885 
        }
886 
 
887 43 alirezamon 
# an Identifiers must begin with an alphabetic character or the underscore character
888 
        if ($in =~ /^[0-9\$]/){
889 48 alirezamon 
                return "An Identifier must begin with an alphabetic character or the underscore character.\n";
890 43 alirezamon 
        }
891 
 
892 
 
893 
#       Identifiers may contain alphabetic characters, numeric characters, the underscore, and the dollar sign (a-z A-Z 0-9 _ $ )
894 
        if ($in =~ /[^a-zA-Z0-9_\$]+/){
895 48 alirezamon 
                 #print "use of illegal character after\n" ;
896 43 alirezamon 
                 my @w= split /([^a-zA-Z0-9_\$]+)/, $in;
897 48 alirezamon 
                 return "Contain illegal character of \"$w[1]\" after $w[0]. Identifiers may contain alphabetic characters, numeric characters, the underscore, and the dollar sign (a-z A-Z 0-9 _ \$ )\n";
898 43 alirezamon 
 
899 
        }
900 
 
901 
 
902 
# check Verilog reserved words
903 
        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");
904 
        if( grep (/^$in$/,@keys)){
905 48 alirezamon 
                return  "$in is a Verlig reserved word.\n";
906 43 alirezamon 
        }
907 
        return undef;
908 
 
909 
}
910 
 
911 
 
912 
sub capture_number_after {
913 
        my ($after,$text)=@_;
914 
        my @q =split  (/$after/,$text);
915 
        #my $d=$q[1];
916 
        my @d = split (/[^0-9. ]/,$q[1]);
917 
        return $d[0];
918 
 
919 
}
920 
 
921 
sub capture_string_between {
922 
        my ($start,$text,$end)=@_;
923 
        my @q =split  (/$start/,$text);
924 
        my @d = split (/$end/,$q[1]);
925 
        return $d[0];
926 
}
927 
 
928 48 alirezamon 
sub capture_cores_data {
929 
        my ($data,$text)=@_;
930 
        my %result;
931 
        my @q =split  (/End_point/,$text);
932 
        my $i=0;
933 
        foreach my $p (@q){
934 
                if ($i!=0){
935 
                        my @d = split (/[^0-9. ]/,$p);
936 
                        my $n=  $d[0];
937 
                        my $val = capture_number_after("$data",$p);
938 
                        $result{remove_all_white_spaces($n)}=remove_all_white_spaces($val);
939 
                }
940 
                $i++;
941 
        }
942 
        return %result;
943 
}
944 43 alirezamon 
 
945 
sub make_undef_as_string {
946 
        foreach my $p  (@_){
947 
                $$p= 'undef' if (! defined $$p);
948 
 
949 
        }
950 
}
951 
 
952 
sub powi{ # x^y
953 
        my ($x,$y)=@_; # compute x to the y
954 
        my $r=1;
955 
        for (my $i = 0; $i < $y; ++$i ) {
956 
        $r *= $x;
957 
        }
958 
  return $r;
959 
}
960 
 
961 
sub sum_powi{ # x^(y-1) + x^(y-2) + ...+ 1;
962 
        my ($x,$y)=@_; # compute x to the y
963 
        my $r = 0;
964 
    for (my $i = 0; $i < $y; $i++){
965 
        $r += powi( $x, $i );
966 
    }
967 
        return $r;
968 
}
969 48 alirezamon 
 
970 
 
971 
 
972 
 
973 
 
974 
#############
975 
# object
976 
############
977 
 
978 
sub object_add_attribute{
979 
        my ($self,$attribute1,$attribute2,$value)=@_;
980 
        if(!defined $attribute2){$self->{$attribute1}=$value;}
981 
        else {$self->{$attribute1}{$attribute2}=$value;}
982 
 
983 
}
984 
 
985 
 
986 
 
987 
sub object_get_attribute{
988 
        my ($self,$attribute1,$attribute2)=@_;
989 
        if(!defined $attribute2) {return $self->{$attribute1};}
990 
        return $self->{$attribute1}{$attribute2};
991 
}
992 
 
993 
 
994 
sub object_add_attribute_order{
995 
        my ($self,$attribute,@param)=@_;
996 
        my $r = $self->{'parameters_order'}{$attribute};
997 
        my @a;
998 
        @a = @{$r} if(defined $r);
999 
        push (@a,@param);
1000 
        @a=uniq(@a);
1001 
        $self->{'parameters_order'}{$attribute} =\@a;
1002 
}
1003 
 
1004 
sub object_remove_attribute_order{
1005 
        my ($self,$attribute,$param)=@_;
1006 
        my @r=@{$self->{parameters_order}{$attribute}};
1007 
        my @n;
1008 
        foreach my $p(@r){
1009 
                if( $p ne $param) {push(@n,$p)};
1010 
 
1011 
        }
1012 
        $self->{parameters_order}{$attribute}=\@n;
1013 
 
1014 
}
1015 
 
1016 
sub object_get_attribute_order{
1017 
        my ($self,$attribute)=@_;
1018 
        return unless(defined $self->{parameters_order}{$attribute});
1019 
        my @order=@{$self->{parameters_order}{$attribute}};
1020 
        return uniq(@order)
1021 
}
1022 
 
1023 
sub object_remove_attribute{
1024 
        my ($self,$attribute1,$attribute2)=@_;
1025 
        if(!defined $attribute2){
1026 
                delete $self->{$attribute1} if ( exists( $self->{$attribute1}));
1027 
        }
1028 
        else {
1029 
                delete $self->{$attribute1}{$attribute2} if ( exists( $self->{$attribute1}{$attribute2})); ;
1030 
        }
1031 
}
1032 
 
1033 
 
1034 
#############
1035 
#  graphviz
1036 
#############
1037 
 
1038 
 
1039 
sub generate_and_show_graph_using_graphviz {
1040 
        my ($self,$scrolled_win,$dotfile, $graph_name)=@_;
1041 43 alirezamon 
 
1042 
 
1043 48 alirezamon 
        #empty the scrolled win
1044 
        if(defined $scrolled_win){
1045 
                my @list = $scrolled_win->get_children();
1046 
                foreach my $l (@list){
1047 
                        $scrolled_win->remove($l);
1048 
                }
1049 
        }
1050 
 
1051 
        my $scale=$self->object_get_attribute($graph_name,"scale");
1052 
        $scale= 1 if (!defined $scale);
1053 
        my $diagram;
1054 
 
1055 
        my $cmd = "echo \'$dotfile\' | dot -Tpng";
1056 
        my ($stdout,$exit,$stderr)= run_cmd_in_back_ground_get_stdout ($cmd);
1057 
        if ( length( $stderr || '' ) !=0)  {
1058 
                message_dialog("$stderr\nHave you installed graphviz? If not run \n \t \"sudo apt-get install graphviz\" \n in terminal",'error');
1059 
        }
1060 
        $diagram =open_inline_image( $stdout,70*$scale,70*$scale,'percent');
1061 
        if(defined $scrolled_win){
1062 
                add_widget_to_scrolled_win($diagram,$scrolled_win);
1063 
                $scrolled_win->show_all();
1064 
        }
1065 
    my $save=$self->object_get_attribute("graph_save","enable");
1066 
        $save=0 if(!defined $save);
1067 
        if($save==1){
1068 
                my $file = $self->object_get_attribute("graph_save","name");
1069 
                my $ext  = $self->object_get_attribute("graph_save","extension");
1070 
                my $pixbuff= $diagram->get_pixbuf;
1071 
            $pixbuff->save ("$file.$ext", "$ext");
1072 
            $self->object_add_attribute("graph_save","enable",'0');
1073 
        }
1074 
 
1075 
 
1076 
}
1077 43 alirezamon 
 
1078 
 
1079 48 alirezamon 
###########
1080 
#       run_multiple_proc_in_background (@cmds)
1081 
#       run parallel application in background and return err, stdout
1082 
#       return for $ith application i start from 0
1083 
#               $pipes{$i}{"out"}= stdout;
1084 
#               $pipes{$i}{"err"}= stderr;
1085 
###########
1086 
 
1087 
sub run_multiple_proc_in_background
1088 
{
1089 
        my @cmds = @_;
1090 
        my %pipes;
1091 
    my $i=0;
1092 
        #open seprate pipe for each command
1093 
        foreach my $cmd (@cmds){
1094 
                #print "$cmd\n";
1095 
                my ($pipe,$in, $out, $err,$r);
1096 
                $pipes{$i}{"out"}=\$out;
1097 
                $pipes{$i}{"err"}=\$err;
1098 
        $pipes{$i}{"pipe"}=\$pipe;
1099 
                my @cat = split ('\s+', $cmd );
1100 
                my $cmd_name=$cat[0];
1101 
                #perevent pipe from crock
1102 
                if (!(-e $cmd_name)) {
1103 
                        $err= "file not found: $cmd_name";
1104 
                }elsif (!(-f $cmd_name)) {
1105 
                $err= "not a file: $cmd_name";
1106 
                }elsif (!(-x $cmd_name)) {
1107 
                        $err= "permission denied: $cmd_name";
1108 
                }
1109 
                if (defined  $err){
1110 
                        $i++;
1111 
                        next;
1112 
                }
1113 
 
1114 
                $pipe =start \@cat, \$in, \$out, \$err or $r=$?;
1115 
                if(defined $r){
1116 
                        #add_colored_info($tview," quartus_stp got an Error: $r\n",'red');
1117 
                        $err= "Pipe got an Error: $r\n";
1118 
                        $i++;
1119 
                        next;
1120 
                }
1121 
        $i++;
1122 
        }
1123 
 
1124 
        my $pumpble=0;
1125 
        my $cnt=0;
1126 
        do{
1127 
                $pumpble=0;
1128 
                for (my $i=0; $i< scalar @cmds; $i++){
1129 
                        my $pipe= ${$pipes{$i}{"pipe"}};
1130 
                        next if(!defined $pipe);
1131 
                        if (pumpable ($pipe)) {
1132 
                                pump $pipe;
1133 
                            $pumpble=1;
1134 
                            print "pump $i\n";
1135 
                        }
1136 
                }
1137 
                #if($cnt==100) {
1138 
                #               $cnt=0;
1139 
                                refresh_gui();
1140 
                #}
1141 
                #$cnt++
1142 
        }while($pumpble);
1143 
 
1144 
 
1145 
        for (my $i=0; $i< scalar @cmds; $i++){
1146 
                my $pipe= ${$pipes{$i}{"pipe"}};
1147 
                next if(!defined $pipe);
1148 
                finish $pipe;
1149 
        }
1150 
        return %pipes;
1151 
}
1152 
 
1153 
 
1154 
sub add_param_widget {
1155 
         my ($self,$name,$param, $default,$type,$content,$info, $table,$row,$column,$show,$attribut1,$ref_delay,$new_status,$loc)=@_;
1156 
         my $label;
1157 
         $label =gen_label_in_left(" $name") if(defined $name);
1158 
         my $widget;
1159 
         my $value=$self->object_get_attribute($attribut1,$param);
1160 
         if(! defined $value) {
1161 
                        $self->object_add_attribute($attribut1,$param,$default);
1162 
                        $self->object_add_attribute_order($attribut1,$param);
1163 
                        $value=$default;
1164 
         }
1165 
         if(! defined $new_status){
1166 
                $new_status='ref';
1167 
         }
1168 
         if (! defined $loc){
1169 
                 $loc = "vertical";
1170 
         }
1171 
         if ($type eq "Entry"){
1172 
                $widget=gen_entry($value);
1173 
                $widget-> signal_connect("changed" => sub{
1174 
                        my $new_param_value=$widget->get_text();
1175 
                        $self->object_add_attribute($attribut1,$param,$new_param_value);
1176 
                        set_gui_status($self,$new_status,$ref_delay) if(defined $ref_delay);
1177 
                });
1178 
         }
1179 
         elsif ($type eq "Combo-box"){
1180 
                 my @combo_list=split(/\s*,\s*/,$content);
1181 
                 my $pos=get_pos($value, @combo_list) if(defined $value);
1182 
                 if(!defined $pos){
1183 
                        $self->object_add_attribute($attribut1,$param,$default);
1184 
                        $pos=get_item_pos($default, @combo_list) if (defined $default);
1185 
 
1186 
                 }
1187 
                #print " my $pos=get_item_pos($value, @combo_list);\n";
1188 
                 $widget=gen_combo(\@combo_list, $pos);
1189 
                 $widget-> signal_connect("changed" => sub{
1190 
                 my $new_param_value=$widget->get_active_text();
1191 
                 $self->object_add_attribute($attribut1,$param,$new_param_value);
1192 
                 set_gui_status($self,$new_status,$ref_delay) if(defined $ref_delay);
1193 
                 });
1194 
 
1195 
         }
1196 
         elsif ($type eq "EntryCombo"){
1197 
                 my @combo_list;
1198 
                 @combo_list=split(/\s*,\s*/,$content) if(defined $content);
1199 
                 my $pos=get_pos($value, @combo_list) if(defined $value && defined $content);
1200 
                 $widget= gen_combo_entry (\@combo_list,$pos);
1201 
                 my $child = combo_entry_get_chiled($widget);
1202 
                 $child->signal_connect('changed' => sub {
1203 
                                my ($entry) = @_;
1204 
                                my $new_param_value=$entry->get_text();
1205 
                                $self->object_add_attribute($attribut1,$param,$new_param_value);
1206 
                                set_gui_status($self,$new_status,$ref_delay) if(defined $ref_delay);
1207 
                 });
1208 
         }
1209 43 alirezamon 
 
1210 48 alirezamon 
         elsif  ($type eq "Spin-button"){
1211 
                my ($min,$max,$step,$digit)=split(/\s*,\s*/,$content);
1212 
 
1213 
                $value=~ s/[^0-9.\-]//g;
1214 
                $min=~   s/[^0-9.\-]//g;
1215 
                $max=~   s/[^0-9.\-]//g;
1216 
                $step=~  s/[^0-9.\-]//g;
1217 
                $digit=~ s/[^0-9.\-]//g if (defined $digit);
1218 
                  #$max = $min if($max<$min);
1219 
                  $widget=gen_spin($min,$max,$step,$digit);
1220 
                  $widget->set_value($value);
1221 
                  $widget-> signal_connect("value_changed" => sub{
1222 
                  my $new_param_value=$widget->get_value();
1223 
                  $self->object_add_attribute($attribut1,$param,$new_param_value);
1224 
                  set_gui_status($self,$new_status,$ref_delay) if(defined $ref_delay);
1225 
              });
1226 
 
1227 
                 # $box=def_label_spin_help_box ($param,$info, $value,$min,$max,$step, 2);
1228 
         }
1229 
 
1230 
        elsif ( $type eq "Check-box"){
1231 
                $widget = def_hbox(FALSE,0);
1232 
                my @check;
1233 
                for (my $i=0;$i<$content;$i++){
1234 
                        $check[$i]= gen_checkbutton();
1235 
                }
1236 
                for (my $i=0;$i<$content;$i++){
1237 
                        $widget->pack_end(  $check[$i], FALSE, FALSE, 0);
1238 
 
1239 
                        my @chars = split("",$value);
1240 
                        #check if saved value match the size of check box
1241 
                        if($chars[0] ne $content ) {
1242 
                                $self->object_add_attribute($attribut1,$param,$default);
1243 
                                $value=$default;
1244 
                                @chars = split("",$value);
1245 
                        }
1246 
                        #set initial value
1247 
 
1248 
                        #print "\@chars=@chars\n";
1249 
                        for (my $i=0;$i<$content;$i++){
1250 
                                my $loc= (scalar @chars) -($i+1);
1251 
                                        if( $chars[$loc] eq '1') {$check[$i]->set_active(TRUE);}
1252 
                                        else {$check[$i]->set_active(FALSE);}
1253 
                        }
1254 
 
1255 
 
1256 
                        #get new value
1257 
                        $check[$i]-> signal_connect("toggled" => sub{
1258 
                                my $new_val="$content\'b";
1259 
 
1260 
                                for (my $i=$content-1; $i >= 0; $i--){
1261 
                                        if($check[$i]->get_active()) {$new_val="${new_val}1" ;}
1262 
                                        else {$new_val="${new_val}0" ;}
1263 
                                }
1264 
                                $self->object_add_attribute($attribut1,$param,$new_val);
1265 
                                #print "\$new_val=$new_val\n";
1266 
                                set_gui_status($self,$new_status,$ref_delay) if(defined $ref_delay);
1267 
                        });
1268 
                }
1269 
 
1270 
        }
1271 
        elsif ( $type eq "DIR_path"){
1272 
                        $widget =get_dir_in_object ($self,$attribut1,$param,$value,'ref',10,$default);
1273 
                        set_gui_status($self,$new_status,$ref_delay) if(defined $ref_delay);
1274 
        }
1275 
        elsif ( $type eq "FILE_path"){ # use $content as extention
1276 
                        $widget =get_file_name_object ($self,$attribut1,$param,$content,undef,$new_status,$ref_delay);
1277 
 
1278 
        }
1279 
        elsif ( $type eq 'Fixed'){
1280 
                 $self->object_add_attribute($attribut1,$param,$default);
1281 
                 $widget =gen_label_in_left("$default");
1282 
        }
1283 
        else {
1284 
                 $widget =gen_label_in_left("unsuported widget type!");
1285 
        }
1286 
 
1287 
        my $inf_bt= (defined $info)? gen_button_message ($info,"icons/help.png"):gen_label_in_left(" ");
1288 
        if($show==1){
1289 
                attach_widget_to_table ($table,$row,$label,$inf_bt,$widget,$column);
1290 
                if ($loc eq "vertical"){
1291 
                        #print "$loc\n";
1292 
                         $row ++;}
1293 
                else {
1294 
 
1295 
                        $column+=4;
1296 
                }
1297 
        }
1298 
    return ($row,$column,$widget);
1299 
}
1300 
 
1301 
 
1302 
 
1303 
1

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.