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/] [soc.pm] - Blame information for rev 48

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 16 alirezamon
#! /usr/bin/perl -w
2
use strict;
3
 
4
package soc;
5 48 alirezamon
use FindBin;
6
use lib $FindBin::Bin;
7 16 alirezamon
use ip;
8
 
9 48 alirezamon
sub uniq {
10
  my %seen;
11
  return grep { !$seen{$_}++ } @_;
12
}
13 16 alirezamon
 
14
sub soc_new {
15
    # be backwards compatible with non-OO call
16
    my $class = ("ARRAY" eq ref $_[0]) ? "soc" : shift;
17
    my $self;
18
 
19
    $self = {};
20
    $self->{modules}        = {};
21
    $self->{instance_order}=();
22
    $self->{hdl_files}=();
23 48 alirezamon
    $self->{hdl_files_ticked}=();
24 16 alirezamon
 
25
    bless($self,$class);
26
 
27
    return $self;
28
}
29
 
30
 
31
sub soc_add_instance{
32
        my ($self,$instance_id,$category,$module,$ip) = @_;
33
        if(exists ($self->{instances}{$instance_id})){
34
                return 0;
35
        }
36 24 alirezamon
        my $module_name=$ip->ip_get($category,$module,"module_name");
37 16 alirezamon
        #print "$module_name\n";
38
        $self->{instances}{$instance_id}={};
39
        $self->{instances}{$instance_id}{module}=$module;
40
        $self->{instances}{$instance_id}{module_name}=$module_name;
41
        $self->{instances}{$instance_id}{category}=$category;
42
        $self->{instances}{$instance_id}{instance_name}=$instance_id;
43
        my @sockets=$ip->ip_get_module_sockets_list($category,$module);
44
        foreach my $socket(@sockets){
45
                my ($type,$value,$connection_num)=$ip->ip_get_socket ($category,$module,$socket);
46
                soc_add_socket_to_instance($self,$instance_id,$socket,$type,$value,$connection_num);
47
                #add socket names
48
                my $int_num=($type eq 'num')? $value :1;
49
                for (my $i=0;$i<$int_num;$i++){
50
                        my $name=$ip->ip_get_socket_name($category,$module, $socket,$i);
51
                        $self->{instances}{$instance_id}{sockets}{$socket}{nums}{$i}{name}=$name;
52
                }
53
 
54
 
55
        }
56
        my @plugs=$ip->ip_get_module_plugs_list($category,$module);
57
        foreach my $plug(@plugs){
58
                my ($type,$value,$connection_num)=$ip->ip_get_plug ($category,$module,$plug);
59
                soc_add_plug_to_instance($self,$instance_id,$plug,$type,$value,$connection_num);
60 38 alirezamon
                #add plug names anf Default connection as IO
61 16 alirezamon
                my $int_num=($type eq 'num')? $value :1;
62
                for (my $i=0;$i<$int_num;$i++){
63
                        my $name=$ip->ip_get_plug_name($category,$module, $plug,$i);
64
                        $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$i}{name}=$name;
65
                        soc_add_instance_plug_conection($self,$instance_id,$plug,$i,"IO");
66
                        my ($addr , $width) =$ip->ip_get_wb_addr ($category,$module,$plug,$i);
67
                        if(defined $addr){
68
                                $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$i}{addr}=$addr;
69
                                $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$i}{width}=$width;
70
                        }
71
                }
72
        }
73 34 alirezamon
 
74
 
75
        $self->{instances}{$instance_id}{description_pdf}=$ip->ip_get($category,$module,'description_pdf');
76 16 alirezamon
 
77
        return 1;
78
}
79
 
80
sub soc_add_instance_order{
81
        my ($self,$instance_id)=@_;
82
        push (@{$self->{instance_order}},$instance_id);
83
        #print " @{$self->{instance_order}} \n";        
84
}
85
 
86
sub soc_remove_scolar_from_array{
87
        my ($array_ref,$item)=@_;
88 48 alirezamon
        my @array=@{$array_ref} if(defined $array_ref);
89 16 alirezamon
        my @new;
90
        foreach my $p (@array){
91
                if($p ne $item ){
92
                        push(@new,$p);
93
                }
94
        }
95
        return @new;
96
}
97
 
98
sub soc_get_scolar_pos{
99
        my ($item,@list)=@_;
100
        my $pos;
101
        my $i=0;
102
        foreach my $c (@list)
103
        {
104
                if(  $c eq $item) {$pos=$i}
105
                $i++;
106
        }
107
        return $pos;
108
}
109
 
110
sub soc_remove_from_instance_order{
111
        my ($self,$instance_id)=@_;
112
        my @a=soc_remove_scolar_from_array($self->{instance_order},$instance_id);
113
        $self->{instance_order}=\@a;
114
        #print " @{$self->{instance_order}} \n";        
115
}
116
 
117
sub soc_get_instance_order{
118
        my $self=shift;
119
        my @order;
120
        @order = @{$self->{instance_order}} if (defined $self->{instance_order});
121
        return @order;
122
}
123
 
124
sub soc_increase_instance_order{
125
        my ($self,$item)=@_;
126
        my @order;
127
        if (defined $self->{instance_order}){
128
                @order = @{$self->{instance_order}};
129
                my $pos=soc_get_scolar_pos($item,@order);
130
                if(defined $order[$pos+1] ){
131
                        $order[$pos]=$order[$pos+1];
132
                        $order[$pos+1]=$item;
133
                        $self->{instance_order}=\@order;
134
                }
135
        }
136
}
137
 
138
sub soc_decrease_instance_order{
139
        my ($self,$item)=@_;
140
        my @order;
141
        if (defined $self->{instance_order}){
142
                @order = @{$self->{instance_order}};
143
                my $pos=soc_get_scolar_pos($item,@order);
144
                if($pos !=0 ){
145
                        $order[$pos]=$order[$pos-1];
146
                        $order[$pos-1]=$item;
147
                        $self->{instance_order}=\@order;
148
                }
149
        }
150
}
151
 
152
sub soc_get_module_name{
153
        my ($self,$instance_id)=@_;
154
        my $module_name;
155
        if(exists ($self->{instances}{$instance_id}{module_name})){
156
                $module_name= $self->{instances}{$instance_id}{module_name};
157
        }
158
        return $module_name;
159
}
160
 
161
 
162 34 alirezamon
sub soc_get_description_pdf{
163
        my ($self,$instance_id)=@_;
164
        return $self->{instances}{$instance_id}{description_pdf};
165
}
166
 
167 16 alirezamon
sub soc_get_plug_name {
168
        my ($self,$instance_id,$plug,$num)=@_;
169
        my $name;
170
        if(exists($self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{name})){
171
                $name=$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{name};
172
        }
173
        return $name;
174
}
175
 
176
sub soc_get_plug_addr {
177
        my ($self,$instance_id,$plug,$num)=@_;
178
        my ($addr , $width);
179
        if(exists($self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{addr})){
180
                $addr=  $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{addr};
181
                $width= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{width};
182
        }
183
        return ($addr , $width);
184
}
185
 
186
 
187
sub soc_get_socket_name {
188
        my ($self,$instance_id,$socket,$num)=@_;
189
        my $name;
190
        if(exists($self->{instances}{$instance_id}{sockets}{$socket}{nums}{$num})){
191
                $name=$self->{instances}{$instance_id}{sockets}{$socket}{nums}{$num}{name};
192
        }
193
        return $name;
194
}
195
 
196
sub soc_remove_instance{
197
        my ($self,$instance_id)=@_;
198
        if ( exists( $self->{instances}{$instance_id} )) {
199
             delete( $self->{instances}{$instance_id} );
200
        }
201
 
202
 
203
}
204
 
205
 
206
sub soc_add_socket_to_instance{
207
        my ($self,$instance_id,$socket,$type,$value,$connection_num)=@_;
208
        if ( exists( $self->{instances}{$instance_id} )){
209
                $self->{instances}{$instance_id}{sockets}{$socket}{type}=$type;
210
                $self->{instances}{$instance_id}{sockets}{$socket}{value}=$value;
211
                $self->{instances}{$instance_id}{sockets}{$socket}{connection_num}=$connection_num;
212
 
213
        }
214
}
215
 
216
sub soc_get_socket_of_instance{
217
        my ($self,$instance_id,$socket)=@_;
218
        my ($type,$value,$connection_num);
219
        if ( exists( $self->{instances}{$instance_id} )){
220
                $type=$self->{instances}{$instance_id}{sockets}{$socket}{type};
221
                $value=$self->{instances}{$instance_id}{sockets}{$socket}{value};
222
                $connection_num=$self->{instances}{$instance_id}{sockets}{$socket}{connection_num};
223
        }
224
        return ($type,$value,$connection_num);
225
}
226
 
227
 
228
 
229
 
230
 
231
sub soc_add_plug_to_instance{
232
        my ($self,$instance_id,$plug,$type,$value,$connection_num)=@_;
233
        if ( exists( $self->{instances}{$instance_id} )){
234
                $self->{instances}{$instance_id}{plugs}{$plug}{type}=$type;
235
                $self->{instances}{$instance_id}{plugs}{$plug}{value}=$value;
236
                $self->{instances}{$instance_id}{plugs}{$plug}{connection_num}=$connection_num;
237
 
238
        }
239
}
240
 
241
sub soc_get_plug_of_instance{
242
        my ($self,$instance_id,$plug)=@_;
243
        my ($type,$value,$connection_num);
244
        if ( exists( $self->{instances}{$instance_id} )){
245
                $type=$self->{instances}{$instance_id}{plugs}{$plug}{type};
246
                $value=$self->{instances}{$instance_id}{plugs}{$plug}{value};
247
                $connection_num=$self->{instances}{$instance_id}{plugs}{$plug}{connection_num};
248
        }
249
        return ($type,$value,$connection_num);
250
}
251
 
252
 
253
 
254
 
255
 
256
 
257
 
258
 
259 25 alirezamon
 
260
 
261 16 alirezamon
sub soc_add_instance_plug_conection{
262
 
263
        my ($self,$instance_id,$plug,$plug_num,$id,$socket,$num)=@_;
264
        if(exists ($self->{instances}{$instance_id}{plugs}{$plug})){
265
                $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_id}=$id;
266
                $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_socket}=$socket;
267
                $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_socket_num}=$num;
268
        }
269
 
270
}
271
 
272
sub soc_get_module_plug_conection{
273
        my ($self,$instance_id,$plug,$plug_num)=@_;
274
        my ($id,$socket,$num);
275
        if(exists($self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num})){
276
                $id =   $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_id};
277
                $socket=        $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_socket};
278
                $num=   $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_socket_num};
279
        }
280
        return  ($id,$socket,$num);
281
}
282
 
283
sub soc_get_all_plugs_of_an_instance{
284
        my ($self,$instance_id)=@_;
285
        my @list;
286
 
287
        if(exists ($self->{instances}{$instance_id}{plugs})){
288
                foreach my $p (sort keys %{$self->{instances}{$instance_id}{plugs}}){
289
                push (@list,$p);
290
 
291
                }
292
        }
293
        return @list;
294
 
295 34 alirezamon
}
296 16 alirezamon
 
297 34 alirezamon
sub soc_get_all_sockets_of_an_instance{
298
        my ($self,$instance_id)=@_;
299
        my @list;
300
 
301
        if(exists ($self->{instances}{$instance_id}{sockets})){
302
                foreach my $p (sort keys %{$self->{instances}{$instance_id}{sockets}}){
303
                push (@list,$p);
304
 
305
                }
306
        }
307
        return @list;
308
 
309
}
310 16 alirezamon
 
311 34 alirezamon
 
312 16 alirezamon
##############################################
313
sub soc_get_modules_plug_connected_to_socket{
314
        my ($self,$id,$socket,$socket_num)=@_;
315
        my %plugs;
316
        my %plug_nums;
317
        my @instances=soc_get_all_instances($self);
318
        foreach my $instance_id (@instances){
319
                        my @plugs=soc_get_all_plugs_of_an_instance($self,$instance_id);
320
                        foreach my $plug (@plugs){
321
                                foreach my $plug_num (keys %{$self->{instances}{$instance_id}{plugs}{$plug}{nums}}){
322
                                        my $id_ =       $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_id};
323
                                        my $socket_=    $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_socket};
324
                                        my $socket_num_=        $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_socket_num};
325
                                        #print "if($id_ eq $id && $socket_ eq $socket &&  $socket_num_ eq $socket_num )\n";
326
                                        if($id_ eq $id && $socket_ eq $socket &&  $socket_num_ eq $socket_num ) {
327
                                                $plugs{$instance_id}=$plug;
328
                                                $plug_nums{$instance_id}=$plug_num;
329
 
330
                                        }
331
                                }
332
                        }
333
 
334
        }
335
 
336
 
337
 
338
        return (\%plugs, \%plug_nums);
339
 
340
}
341
 
342
 
343
 
344
 
345
 
346
 
347
 
348
 
349
 
350
 
351
 
352
 
353
 
354
sub get_modules_have_this_socket{
355
        my ($self,$socket)=@_;
356
        my %r;
357
        my @instances=soc_get_all_instances($self);
358
        if(!defined $socket ){return %r;}
359
        foreach my $p (@instances)
360
        {
361
                        if(exists ($self->{instances}{$p}{sockets}{$socket})) {
362
                                $r{$p}=$self->{instances}{$p}{sockets}{$socket}{value};
363
 
364
                        }
365
 
366
        }
367
        return %r;
368
 
369
}
370
 
371
 
372
 
373
 
374
sub soc_get_all_instances{
375
        my ($self)=@_;
376
        my @list;
377
        foreach my $p (sort keys %{$self->{instances}}){
378
                push (@list,$p);
379
        }
380
        return @list;
381
}
382
 
383
sub soc_get_all_instances_of_module{
384
        my ($self,$category,$module)=@_;
385
        my @list;
386
        my @m_list;
387
        @list=soc_get_all_instances($self);
388
 
389
        foreach my $p (@list){
390
                #printf "\$p=$p  \& $self->{instances}{$p}{module}\n";
391
                if(($self->{instances}{$p}{module} eq $module) &&
392
                   ($self->{instances}{$p}{category} eq $category)){
393
                        push(@m_list,$p);
394
                }
395
        }
396
        return @m_list;
397
}
398
 
399
 
400
 
401
sub soc_add_instance_param{
402
                my ($self,$instance_id,$param_ref)=@_;
403
                if(exists ($self->{instances}{$instance_id})){
404
                        my %param=%$param_ref;
405
                        foreach my $p (sort keys %param){
406
                                my $value = $param{$p};
407
                                $self->{instances}{$instance_id}{parameters}{$p}{value}=$value;
408
                                #print "lllllllll:$value\n";
409
                        }
410
                        return 1;
411
                }
412
                return 0;
413 48 alirezamon
}
414 16 alirezamon
 
415 48 alirezamon
sub soc_add_instance_param_type {
416
        my ($self,$instance_id,$param_ref)=@_;
417
                if(exists ($self->{instances}{$instance_id})){
418
                        my %param=%$param_ref;
419
                        foreach my $p (sort keys %param){
420
                                my $value = $param{$p};
421
                                $self->{instances}{$instance_id}{parameters_type}{$p}{value}=$value;
422
                        }
423
                        return 1;
424
                }
425
                return 0;
426
}
427 16 alirezamon
 
428 48 alirezamon
 
429 16 alirezamon
sub soc_add_instance_param_order{
430
                my ($self,$instance_id,$param_ref)=@_;
431
                if(exists ($self->{instances}{$instance_id})){
432
                        $self->{instances}{$instance_id}{parameters_order}=$param_ref;
433
                        return 1;
434
                }
435
                return 0;
436
}
437
 
438
sub soc_get_instance_param_order{
439
                my ($self,$instance_id)=@_;
440
                my @r;
441
                if(defined ($self->{instances}{$instance_id}{parameters_order}) ){
442
                        @r=@{$self->{instances}{$instance_id}{parameters_order}};
443
 
444
                }
445
                return @r;
446
}
447
 
448
 
449
 
450
sub soc_get_module_param{
451
                my ($self,$instance_id)=@_;
452
                my %param;
453
                if(exists ($self->{instances}{$instance_id}{parameters}))
454
                {
455
                        foreach my $p (sort keys %{$self->{instances}{$instance_id}{parameters}})
456
                        {
457 48 alirezamon
                                my $value =     $self->{instances}{$instance_id}{parameters}{$p}{value};
458
                                $param{$p}=$value if (defined $value);
459 16 alirezamon
                        }
460
                }
461
                return %param;
462
}
463
 
464
 
465 48 alirezamon
sub soc_get_module_param_type{
466
                my ($self,$instance_id)=@_;
467
                my %param_type;
468
                if(exists ($self->{instances}{$instance_id}{parameters}))
469
                {
470
                        foreach my $p (sort keys %{$self->{instances}{$instance_id}{parameters}})
471
                        {
472
                                my $value = $self->{instances}{$instance_id}{parameters_type}{$p}{value};
473
                                $param_type{$p}=$value if (defined $value);
474
                        }
475
                }
476
                return %param_type;
477
}
478 16 alirezamon
 
479 48 alirezamon
 
480
 
481
 
482 16 alirezamon
sub soc_get_module_param_value{
483
                my ($self,$instance_id,$param)=@_;
484 48 alirezamon
                return undef if(!defined $param);
485 16 alirezamon
                my $value;
486
                if(exists ($self->{instances}{$instance_id}{parameters}{$param})){
487
                        $value= $self->{instances}{$instance_id}{parameters}{$param}{value};
488
                }
489
                return $value;
490
}
491
 
492
 
493
 
494
 
495
 
496
sub soc_get_all_instance_name{
497
        my ($self)=@_;
498
        my @instance_names;
499
        my @instances=$self->soc_get_all_instances();
500
        foreach my $instance_id (@instances){
501
                        my $name= $self->{instances}{$instance_id}{instance_name};
502
                        push(@instance_names,$name);
503
 
504
        }
505
        return @instance_names;
506
}
507
 
508
 
509
sub soc_set_instance_name{
510
        my ($self,$instance_id,$instance_name)=@_;
511
        if ( exists( $self->{instances}{$instance_id} )){
512
                $self->{instances}{$instance_id}{instance_name}=$instance_name;
513
        }
514
 
515
}
516
 
517
sub soc_get_instance_name{
518
        my ($self,$instance_id)=@_;
519
        my $instance_name;
520
        if ( exists( $self->{instances}{$instance_id} )){
521
                 $instance_name=$self->{instances}{$instance_id}{instance_name};
522
        }
523
        return $instance_name;
524
 
525
}
526
 
527
 
528
sub soc_get_instance_id{
529
        my ($self,$intance_name)=@_;
530
        foreach my $id (sort keys %{$self->{instances}}){
531
                my $p=$self->{instances}{$id}{instance_name};
532
                if ($p eq $intance_name) {return $id;}
533
 
534
        }
535
        return;
536
}
537
 
538
sub soc_get_module{
539
        my ($self,$instance_id) = @_;
540
        my $module;
541
        if ( exists( $self->{instances}{$instance_id} )){
542
                $module=$self->{instances}{$instance_id}{module};
543
        }
544
        return $module;
545
}
546
 
547
sub soc_get_category{
548
        my ($self,$instance_id) = @_;
549
        my $category;
550
        if ( exists( $self->{instances}{$instance_id} )){
551
                $category=$self->{instances}{$instance_id}{category};
552
        }
553
        return $category;
554
}
555
 
556
sub soc_add_plug_base_addr{
557
        my($self,$instance_id,$plug,$num,$base,$end)=@_;
558
        if(exists ($self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num})){
559
                $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{base}=$base;
560
                $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{end}=$end;
561
        }
562
}
563
 
564
 
565
 
566
sub soc_list_base_addreses{
567
                my ($self,$id) = @_;
568
                my %bases;
569
                my @all_instances=soc_get_all_instances($self);
570
                foreach my $instance_id (@all_instances){
571
                        my @plugs=soc_get_all_plugs_of_an_instance($self,$instance_id);
572
                        foreach my $plug (@plugs){
573
                                foreach my $num (sort keys  %{$self->{instances}{$instance_id}{plugs}{$plug}{nums}}){
574
                                        my $base=$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{base};
575
                                        my $end=$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{end};
576
                                        my $connect_id=$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{connect_id};
577
                                        if(defined $base && ($connect_id eq $id)){
578
                                                $bases{$end}=$base;
579
 
580
                                        }
581
                                }
582
                        }
583
                }
584
                return %bases;
585
 
586
}
587
 
588
 
589
sub soc_list_plug_nums{
590
        my ($self,$instance_id,$plug)=@_;
591
        my @list;
592
        if(exists($self->{instances}{$instance_id}{plugs}{$plug})){
593
                foreach my $num (sort keys  %{$self->{instances}{$instance_id}{plugs}{$plug}{nums}}){
594
                        push (@list,$num);
595
                }
596
        }
597
        return @list;
598 34 alirezamon
}
599
 
600
sub soc_list_socket_nums{
601
        my ($self,$instance_id,$socket)=@_;
602
        my @list;
603
        if(exists($self->{instances}{$instance_id}{sockets}{$socket})){
604
                foreach my $num (sort keys  %{$self->{instances}{$instance_id}{sockets}{$socket}{nums}}){
605
                        push (@list,$num);
606
                }
607
        }
608
        return @list;
609 16 alirezamon
}
610 34 alirezamon
 
611 16 alirezamon
 
612
 
613
sub soc_get_plug{
614
        my ($self,$instance_id,$plug,$num) = @_;
615
        my ($addr,$base,$end,$name,$connect_id,$connect_socket,$connect_socket_num);
616
        if(exists($self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num})){
617
                $addr=                          $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{addr};
618
                $base=                          $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{base};
619
                $end=                           $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{end};
620
                $name=                          $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{name};
621
                $connect_id=            $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{connect_id};
622
                $connect_socket=        $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{connect_socket};
623
                $connect_socket_num=$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{connect_socket_num};
624
 
625
        }
626
        return ($addr,$base,$end,$name,$connect_id,$connect_socket,$connect_socket_num);
627
 
628
}
629
 
630
 
631
 
632
sub soc_add_top{
633
        my ($self,$top_ip)=@_;
634
        $self->{top_ip}=$top_ip;
635
 
636
}
637
 
638
sub soc_get_top{
639
        my $self=shift;
640
        return $self->{top_ip};
641
 
642
}
643
 
644
sub soc_get_hdl_files{
645
        my ($self)=shift;
646
        return @{$self->{hdl_files}};
647
}
648
 
649 48 alirezamon
sub soc_get_hdl_sim_files{
650
        my ($self)=shift;
651
        return @{$self->{hdl_files_ticked}};
652
}
653 16 alirezamon
 
654 48 alirezamon
 
655 16 alirezamon
sub soc_add_hdl_files{
656
        my ($self,@hdl_list)=@_;
657
        my @old=@{$self->{hdl_files}};
658
        my @new=(@old,@hdl_list);
659
        $self->{hdl_files}=\@new;
660
}
661
 
662 48 alirezamon
sub soc_add_hdl_sim_files{
663
        my ($self,@hdl_list)=@_;
664
        my @old=@{$self->{hdl_files_ticked}};
665
        my @new=(@old,@hdl_list);
666
        $self->{hdl_files_ticked}=\@new;
667
}
668
 
669
 
670 16 alirezamon
#a-b
671
sub soc_get_diff_array{
672
        my ($a_ref,$b_ref)=@_;
673
        my @A=@{$a_ref};
674
        my @B=@{$b_ref};
675
        my @C;
676
        foreach my $p (@A){
677
                if( !grep (/^$p$/,@B)){push(@C,$p)};
678
        }
679
        return  @C;
680
 
681
}
682
 
683
sub soc_remove_hdl_files{
684
        my ($self,@hdl_list)=@_;
685
        my @old=@{$self->{hdl_files}};
686
        my @new=soc_get_diff_array(\@old,\@hdl_list);
687
        $self->{hdl_files}=\@new;
688
}
689
 
690
 
691 48 alirezamon
sub soc_remove_hdl_sim_files{
692
        my ($self,@hdl_list)=@_;
693
        my @old=@{$self->{hdl_files_ticked}};
694
        my @new=soc_get_diff_array(\@old,\@hdl_list);
695
        $self->{hdl_files_ticked}=\@new;
696
}
697 16 alirezamon
 
698 48 alirezamon
 
699
 
700 17 alirezamon
sub new_wires {
701
                my $class = shift;
702
                my $self;
703
                $self->{assigned_name}={};
704
                bless($self,$class);
705
                return $self;
706
}
707
sub wire_add{
708
        my ($self,$name,$filed,$data)=@_;
709
        $self->{assigned_name}{$name}{$filed}=$data;
710
}
711
 
712
sub wire_get{
713
        my ($self,$name,$filed)=@_;
714
        return  $self->{assigned_name}{$name}{$filed};
715
}
716
 
717
sub wires_list{
718
        my($self)=shift;
719 37 alirezamon
        my @list=       sort keys %{$self->{assigned_name}};
720 17 alirezamon
        return @list;
721
}
722
 
723
 
724 25 alirezamon
 
725
 
726
 
727
 
728
 
729
 
730
 
731
 
732
 
733
sub object_add_attribute{
734
        my ($self,$attribute1,$attribute2,$value)=@_;
735
        if(!defined $attribute2){$self->{$attribute1}=$value;}
736
        else {$self->{$attribute1}{$attribute2}=$value;}
737
 
738
}
739
 
740
sub object_get_attribute{
741
        my ($self,$attribute1,$attribute2)=@_;
742
        if(!defined $attribute2) {return $self->{$attribute1};}
743
        return $self->{$attribute1}{$attribute2};
744
 
745
 
746
}
747
 
748
sub object_add_attribute_order{
749
        my ($self,$attribute,@param)=@_;
750 48 alirezamon
        my $r = $self->{'parameters_order'}{$attribute};
751
        my @a;
752
        @a = @{$r} if(defined $r);
753
        push (@a,@param);
754
        @a=uniq(@a);
755
        $self->{'parameters_order'}{$attribute} =\@a;
756 25 alirezamon
}
757
 
758
sub object_get_attribute_order{
759
        my ($self,$attribute)=@_;
760
        return @{$self->{parameters_order}{$attribute}};
761
}
762
 
763
 
764 34 alirezamon
sub object_remove_attribute{
765
        my ($self,$attribute1,$attribute2)=@_;
766
        if(!defined $attribute2){
767
                delete $self->{$attribute1} if ( exists( $self->{$attribute1}));
768
        }
769
        else {
770
                delete $self->{$attribute1}{$attribute2} if ( exists( $self->{$attribute1}{$attribute2})); ;
771 25 alirezamon
 
772 34 alirezamon
        }
773 25 alirezamon
 
774 34 alirezamon
}
775 25 alirezamon
 
776
 
777 34 alirezamon
sub board_new {
778
    # be backwards compatible with non-OO call
779
    my $class = ("ARRAY" eq ref $_[0]) ? "soc" : shift;
780
    my $self;
781
 
782
    $self->{'Input'}{'*VCC'}{'*VCC'}   =  ['*undefine*'];
783
    $self->{'Input'}{'*GND'}{'*GND'}   =  ['*undefine*'];
784
    $self->{'Input'}{'*NOCONNECT'}{'*NOCONNECT'}    = ['*undefine*'];
785
    $self->{'Output'}{'*NOCONNECT'}{'*NOCONNECT'}   = ['*undefine*'];
786
    $self->{'Bidir'}{'*NOCONNECT'}{'*NOCONNECT'}    = ['*undefine*'];
787
 
788
    bless($self,$class);
789
 
790
    return $self;
791
}
792 25 alirezamon
 
793
 
794
 
795 34 alirezamon
sub board_add_pin {
796
        my ($self,$direction,$name)=@_;
797
        my ($intfc,$pin_name,$pin_num);
798
        my @f= split('_',$name);
799
        if(!defined $f[1]){ # There is no '_' in pin name
800
 
801
                my @p= split(/\[/,$name);
802
                $intfc=$p[0];
803
                $pin_name=$p[0];
804
                if(defined $p[1]){ #it is an array
805
                        my @q= split(/\]/,$p[1]);
806
                        $pin_num=$q[0]; #save pin num
807
                }else{
808
                        $pin_num='*undefine*';
809
                }
810
        }
811
        else{ # take the word before '_' as interface
812
                $intfc=$f[0];
813
                my @p= split(/\[/,$name);
814
                $pin_name=$p[0];
815
                if(defined $p[1]){
816
                        my @q= split(/\]/,$p[1]);
817
                        $pin_num=$q[0];
818
                }else{
819
                        $pin_num='*undefine*';
820
                }
821
        }
822
 
823
        my @a;
824
        @a=   @{$self->{$direction}{$intfc}{$pin_name}} if(exists $self->{$direction}{$intfc}{$pin_name});
825
        push (@a,$pin_num);
826
        @{$self->{$direction}{$intfc}{$pin_name}}=@a;
827 25 alirezamon
 
828 34 alirezamon
}
829 25 alirezamon
 
830 34 alirezamon
sub board_get_pin {
831
        my ($self,$direction)=@_;
832
        my %p=%{$self->{$direction}};
833
        return %p;
834
 
835
}
836
 
837
sub board_get_pin_range {
838
        my ($self,$direction,$pin_name)=@_;
839
        my @f= split('_',$pin_name);
840
        my $intfc = $f[0];
841
        my $ref =$self->{$direction}{$intfc}{$pin_name};
842
        my @range;
843
        @range= @{$ref} if(defined $ref);
844
        return @range;
845
}
846
 
847
 
848 42 alirezamon
 
849
 
850
 
851 16 alirezamon
1

powered by: WebSVN 2.1.0

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