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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 16 alirezamon 
#!/usr/bin/perl -w -I ..
2 
###############################################################################
3 
#
4 
# File:         interface.pm
5 
#
6 
#
7 
###############################################################################
8 
use warnings;
9 
use strict;
10 
 
11 
 
12 
 
13 
package intfc_gen;
14 
 
15 48 alirezamon 
sub uniq {
16 
  my %seen;
17 
  return grep { !$seen{$_}++ } @_;
18 
}
19 
 
20 
 
21 16 alirezamon 
sub interface_generator {
22 
                my $class = "intfc_gen";
23 
                my $self;
24 
                $self->{file_name}=();
25 
                $self->{modules}={};
26 
                $self->{module_name}=();
27 
                $self->{type}=();
28 
                $self->{name}=();
29 
                bless($self,$class);
30 
                return $self;
31 
}
32 
 
33 
sub intfc_set_interface_file {
34 
        my ($self,$file)= @_;
35 
        if (defined $file){
36 
                #print "file name has been changed to $file\n";
37 
                $self->{file_name}=$file;
38 
                #delete old data
39 
                if(exists ($self->{modules})) {delete $self->{modules}; } ;
40 
                if(exists ($self->{module_name})) {delete $self->{module_name}; } ;
41 
                if(exists ($self->{ports})){ delete $self->{ports}};
42 
 
43 
 
44 
 
45 
                }
46 
}
47 
 
48 
sub intfc_get_interface_file {
49 
        my ($self)=@_;
50 
        my $file;
51 
        if (exists ($self->{file_name})){
52 
                $file=$self->{file_name};
53 
        }
54 
        return $file;
55 
}
56 
 
57 
sub intfc_add_module_list{
58 
                my ($self,@list)=@_;
59 
                $self->{modules}={};
60 
                foreach my $p(@list) {
61 
                        $self->{modules}{$p}={};
62 
 
63 
                }
64 
 
65 
}
66 
 
67 
 
68 
sub intfc_get_module_list{
69 
                my ($self)=@_;
70 
                my @modules;
71 
                if(exists($self->{modules})){
72 
                        @modules=keys %{$self->{modules}};
73 
                }
74 
                return @modules;
75 
}
76 
 
77 
sub intfc_set_module_name{
78 
        my ($self,$module)= @_;
79 
        $self->{module_name}=$module;
80 
        if(exists ($self->{ports})){ delete $self->{ports}};
81 
}
82 
 
83 
sub intfc_remove_ports{
84 
        my $self=shift;
85 
        if(exists ($self->{ports})){ delete $self->{ports}};
86 
}
87 
 
88 
 
89 
 
90 
sub intfc_get_module_name {
91 
        my ($self)=@_;
92 
        my $module;
93 
        if (exists ($self->{module_name})){
94 
                $module=$self->{module_name};
95 
        }
96 
        return $module;
97 
}
98 
 
99 
 
100 
sub intfc_add_port{
101 17 alirezamon 
        my ($self,$port_id,$type,$range,$name,$connect_type,$connect_range,$connect_name,$outport_type,$default_out)=@_;
102 16 alirezamon 
        $self->{ports}{$port_id}{name}=$name;
103 
        $self->{ports}{$port_id}{range}=$range;
104 
        $self->{ports}{$port_id}{type}=$type;
105 
        $self->{ports}{$port_id}{connect_name}=$connect_name;
106 
        $self->{ports}{$port_id}{connect_range}=$connect_range;
107 
        $self->{ports}{$port_id}{connect_type}=$connect_type;
108 17 alirezamon 
        $self->{ports}{$port_id}{outport_type}=$outport_type;
109 
        $self->{ports}{$port_id}{default_out}=$default_out;
110 16 alirezamon 
}
111 
 
112 
sub intfc_get_ports{
113 17 alirezamon 
        my ($self,$types_ref,$ranges_ref,$names_ref,$connect_types_ref,$connect_ranges_ref,$connect_name_ref,$outport_type_ref,$default_out_ref)=@_;
114 16 alirezamon 
        if(exists ($self->{ports})){
115 
                foreach my $id (sort keys %{$self->{ports}}){
116 
                                $types_ref->{$id}=$self->{ports}{$id}{type};
117 
                                $ranges_ref->{$id}=$self->{ports}{$id}{range};
118 
                                $names_ref->{$id}=$self->{ports}{$id}{name};
119 
                                $connect_types_ref->{$id}=$self->{ports}{$id}{connect_type};
120 
                                $connect_ranges_ref->{$id}=$self->{ports}{$id}{connect_range};
121 
                                $connect_name_ref->{$id}=$self->{ports}{$id}{connect_name};
122 
                                $outport_type_ref->{$id}=$self->{ports}{$id}{outport_type};
123 17 alirezamon 
                                $default_out_ref->{$id}=$self->{ports}{$id}{default_out};
124 16 alirezamon 
                }
125 
        }
126 
}
127 
 
128 
sub intfc_ckeck_ports_available{
129 
        my ($self)=@_;
130 
        my $result;
131 
        if(exists ($self->{ports})){$result=1;}
132 
        return $result;
133 
 
134 
}
135 
 
136 
sub intfc_remove_port{
137 
                my ($self,$port_id)=@_;
138 
                if(exists ($self->{ports}{$port_id})){
139 
                        delete $self->{ports}{$port_id};
140 
                }
141 
}
142 
 
143 
 
144 
sub intfc_get_ports_type{
145 
        my ($self)=@_;
146 
        my %ports_type;
147 
        if(exists ($self->{ports})){
148 
                foreach my $p (sort keys %{$self->{ports}}){
149 
                        $ports_type{$p}= $self->{ports}{$p}{type};
150 
 
151 
                }
152 
        }
153 
        return %ports_type;
154 
}
155 
 
156 
 
157 
 
158 
sub intfc_set_interface_name{
159 
        my ($self,$name)=@_;
160 
        $self->{name}=$name;
161 
}
162 
 
163 
sub intfc_get_interface_name {
164 
        my ($self)=@_;
165 
        my $name;
166 
        if(exists ($self->{name})){
167 
                $name=$self->{name};
168 
        }
169 
        return $name;
170 
}
171 
 
172 
 
173 
 
174 
 
175 
sub intfc_set_interface_type {
176 
        my ($self,$intfc_type)=@_;
177 
        $self->{type}=$intfc_type;
178 
}
179 
 
180 
 
181 
sub intfc_get_interface_type {
182 
        my ($self)=@_;
183 
        my $type;
184 
        if(exists ($self->{type})){
185 
                $type=$self->{type};
186 
        }
187 
        return $type;
188 
}
189 
 
190 
 
191 
sub intfc_set_connection_num {
192 
        my ($self,$connection_num)=@_;
193 
        $self->{connection_num}=$connection_num;
194 
}
195 
 
196 
 
197 
sub intfc_get_connection_num {
198 
        my ($self)=@_;
199 
        my $connection_num;
200 
        if(exists ($self->{connection_num})){
201 
                $connection_num=$self->{connection_num};
202 
        }
203 
        return $connection_num;
204 
}
205 
 
206 
 
207 
 
208 
 
209 
 
210 
sub intfc_set_description{
211 
        my  ($self,$description)=@_;
212 
        $self->{description}=$description;
213 
}
214 
 
215 
 
216 
 
217 
sub intfc_get_description{
218 
my ($self)=@_;
219 
        my $des;
220 
        if(exists ($self->{description})){
221 
                $des=$self->{description};
222 
        }
223 
        return $des;
224 
}
225 
 
226 
 
227 
 
228 25 alirezamon 
 
229 
sub object_add_attribute{
230 
        my ($self,$attribute1,$attribute2,$value)=@_;
231 
        if(!defined $attribute2){$self->{$attribute1}=$value;}
232 
        else {$self->{$attribute1}{$attribute2}=$value;}
233 
 
234 
}
235 
 
236 
sub object_get_attribute{
237 
        my ($self,$attribute1,$attribute2)=@_;
238 
        if(!defined $attribute2) {return $self->{$attribute1};}
239 
        return $self->{$attribute1}{$attribute2};
240 
 
241 
 
242 
}
243 
 
244 
sub object_add_attribute_order{
245 
        my ($self,$attribute,@param)=@_;
246 48 alirezamon 
        my $r = $self->{'parameters_order'}{$attribute};
247 
        my @a;
248 
        @a = @{$r} if(defined $r);
249 
        push (@a,@param);
250 
        @a=uniq(@a);
251 
        $self->{'parameters_order'}{$attribute} =\@a;
252 25 alirezamon 
}
253 
 
254 
sub object_get_attribute_order{
255 
        my ($self,$attribute)=@_;
256 
        return @{$self->{parameters_order}{$attribute}};
257 
}
258 
 
259 
 
260 
 
261 
 
262 
 
263 16 alirezamon 
1

powered by: WebSVN 2.1.0

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