#!/usr/bin/perl -w -I ..
|
#!/usr/bin/perl -w -I ..
|
###############################################################################
|
###############################################################################
|
#
|
#
|
# File: interface.pm
|
# File: interface.pm
|
#
|
#
|
#
|
#
|
###############################################################################
|
###############################################################################
|
use warnings;
|
use warnings;
|
use strict;
|
use strict;
|
|
|
|
|
package ip_gen;
|
package ip_gen;
|
#use Clone 'clone';
|
#use Clone 'clone';
|
|
|
|
|
|
|
sub ip_gen_new {
|
sub ip_gen_new {
|
# be backwards compatible with non-OO call
|
# be backwards compatible with non-OO call
|
my $class = ("ARRAY" eq ref $_[0]) ? "ip_gen" : shift;
|
my $class = ("ARRAY" eq ref $_[0]) ? "ip_gen" : shift;
|
my $self;
|
my $self;
|
|
|
|
|
$self = {};
|
$self = {};
|
$self->{file_name} = ();
|
$self->{file_name} = ();
|
$self->{parameters_order}=[];
|
$self->{parameters_order}=[];
|
$self->{ports_order}=[];
|
$self->{ports_order}=[];
|
$self->{hdl_files}=[];
|
$self->{hdl_files}=[];
|
|
|
|
|
|
|
bless($self,$class);
|
bless($self,$class);
|
|
|
|
|
return $self;
|
return $self;
|
}
|
}
|
|
|
|
|
|
|
sub ipgen_set_module_list{
|
sub ipgen_set_module_list{
|
my ($self,@list)=@_;
|
my ($self,@list)=@_;
|
$self->{modules}={};
|
$self->{modules}={};
|
foreach my $p(@list) {
|
foreach my $p(@list) {
|
$self->{modules}{$p}={};
|
$self->{modules}{$p}={};
|
}
|
}
|
|
|
}
|
}
|
|
|
|
|
|
|
sub ipgen_get_module_list{
|
sub ipgen_get_module_list{
|
my ($self)=@_;
|
my ($self)=@_;
|
my @modules;
|
my @modules;
|
if(exists($self->{modules})){
|
if(exists($self->{modules})){
|
@modules=keys %{$self->{modules}};
|
@modules=keys %{$self->{modules}};
|
}
|
}
|
return @modules;
|
return @modules;
|
}
|
}
|
|
|
|
|
|
|
sub ipgen_add_parameter{
|
sub ipgen_add_parameter{
|
my ($self,$parameter,$deafult,$type,$content,$info,$global_param,$redefine)=@_;
|
my ($self,$parameter,$default,$type,$content,$info,$global_param,$redefine)=@_;
|
$self->{parameters}{$parameter}{deafult}=$deafult;
|
$self->{parameters}{$parameter}{"default"}=$default;
|
$self->{parameters}{$parameter}{type}=$type;
|
$self->{parameters}{$parameter}{type}=$type;
|
$self->{parameters}{$parameter}{content}=$content;
|
$self->{parameters}{$parameter}{content}=$content;
|
$self->{parameters}{$parameter}{info}=$info;
|
$self->{parameters}{$parameter}{info}=$info;
|
$self->{parameters}{$parameter}{global_param}=$global_param;
|
$self->{parameters}{$parameter}{global_param}=$global_param;
|
$self->{parameters}{$parameter}{redefine_param}=$redefine;
|
$self->{parameters}{$parameter}{redefine_param}=$redefine;
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
sub ipgen_push_parameters_order{
|
sub ipgen_push_parameters_order{
|
my ($self,$param)=@_;
|
my ($self,$param)=@_;
|
if(defined $param){
|
if(defined $param){
|
push(@{$self->{parameters_order}},$param);
|
push(@{$self->{parameters_order}},$param);
|
}
|
}
|
|
|
}
|
}
|
|
|
sub ipgen_remove_parameters_order{
|
sub ipgen_remove_parameters_order{
|
my ($self,$param)=@_;
|
my ($self,$param)=@_;
|
my @r=@{$self->{parameters_order}};
|
my @r=@{$self->{parameters_order}};
|
my @n;
|
my @n;
|
foreach my $p(@r){
|
foreach my $p(@r){
|
if( $p ne $param) {push(@n,$p)};
|
if( $p ne $param) {push(@n,$p)};
|
|
|
}
|
}
|
$self->{parameters_order}=\@n;
|
$self->{parameters_order}=\@n;
|
|
|
}
|
}
|
|
|
|
|
sub ipgen_add_ports_order{
|
sub ipgen_add_ports_order{
|
my ($self,@ports_order) =@_;
|
my ($self,@ports_order) =@_;
|
$self->{ports_order}=\@ports_order;
|
$self->{ports_order}=\@ports_order;
|
}
|
}
|
|
|
|
|
|
|
sub ipgen_get_ports_order{
|
sub ipgen_get_ports_order{
|
my $self =shift;
|
my $self =shift;
|
my @order=(defined $self->{ports_order})? @{$self->{ports_order}} : undef;
|
my @order=(defined $self->{ports_order})? @{$self->{ports_order}} : undef;
|
return @order;
|
return @order;
|
}
|
}
|
|
|
|
|
|
|
|
|
sub ipgen_remove_parameter{
|
sub ipgen_remove_parameter{
|
my ($self,$parameter)=@_;
|
my ($self,$parameter)=@_;
|
if(exists ( $self->{parameters}{$parameter})){
|
if(exists ( $self->{parameters}{$parameter})){
|
delete $self->{parameters}{$parameter};
|
delete $self->{parameters}{$parameter};
|
}
|
}
|
}
|
}
|
|
|
sub ipgen_get_parameter_detail{
|
sub ipgen_get_parameter_detail{
|
my ($self,$parameter)=@_;
|
my ($self,$parameter)=@_;
|
my ($deafult,$type,$content,$info,$global_param,$redefine);
|
my ($default,$type,$content,$info,$global_param,$redefine);
|
if(exists ($self->{parameters}{$parameter})){
|
if(exists ($self->{parameters}{$parameter})){
|
$deafult =$self->{parameters}{$parameter}{deafult};
|
$default =$self->{parameters}{$parameter}{"default"};
|
$type =$self->{parameters}{$parameter}{type};
|
$type =$self->{parameters}{$parameter}{type};
|
$content =$self->{parameters}{$parameter}{content};
|
$content =$self->{parameters}{$parameter}{content};
|
$info =$self->{parameters}{$parameter}{info};
|
$info =$self->{parameters}{$parameter}{info};
|
$global_param =$self->{parameters}{$parameter}{global_param};
|
$global_param =$self->{parameters}{$parameter}{global_param};
|
$redefine =$self->{parameters}{$parameter}{redefine_param};
|
$redefine =$self->{parameters}{$parameter}{redefine_param};
|
|
|
}
|
}
|
return ($deafult,$type,$content,$info,$global_param,$redefine);
|
return ($default,$type,$content,$info,$global_param,$redefine);
|
}
|
}
|
|
|
sub ipgen_get_all_parameters_list{
|
sub ipgen_get_all_parameters_list{
|
my ($self)=@_;
|
my ($self)=@_;
|
my @parameters;
|
my @parameters;
|
if(exists ($self->{parameters})){
|
if(exists ($self->{parameters})){
|
foreach my $p ( keys %{$self->{parameters}}){
|
foreach my $p ( keys %{$self->{parameters}}){
|
push(@parameters,$p);
|
push(@parameters,$p);
|
}
|
}
|
}
|
}
|
return @parameters;
|
return @parameters;
|
}
|
}
|
|
|
sub ipgen_remove_all_parameters{
|
sub ipgen_remove_all_parameters{
|
my ($self)=@_;
|
my ($self)=@_;
|
if (exists ($self->{parameters})){
|
if (exists ($self->{parameters})){
|
delete $self->{parameters};
|
delete $self->{parameters};
|
}
|
}
|
}
|
}
|
|
|
|
|
|
|
sub ipgen_add_port{
|
sub ipgen_add_port{
|
my($self,$port,$range,$type,$intfc_name,$intfc_port)=@_;
|
my($self,$port,$range,$type,$intfc_name,$intfc_port)=@_;
|
$self->{ports}{$port}{range}=$range;
|
$self->{ports}{$port}{range}=$range;
|
$self->{ports}{$port}{type}=$type;
|
$self->{ports}{$port}{type}=$type;
|
$self->{ports}{$port}{intfc_name}=$intfc_name;
|
$self->{ports}{$port}{intfc_name}=$intfc_name;
|
$self->{ports}{$port}{intfc_port}=$intfc_port;
|
$self->{ports}{$port}{intfc_port}=$intfc_port;
|
}
|
}
|
|
|
sub ipgen_get_port{
|
sub ipgen_get_port{
|
my($self,$port)=@_;
|
my($self,$port)=@_;
|
my($range,$type,$intfc_name,$intfc_port);
|
my($range,$type,$intfc_name,$intfc_port);
|
if(exists ($self->{ports}{$port})){
|
if(exists ($self->{ports}{$port})){
|
$range=$self->{ports}{$port}{range};
|
$range=$self->{ports}{$port}{range};
|
$type=$self->{ports}{$port}{type};
|
$type=$self->{ports}{$port}{type};
|
$intfc_name=$self->{ports}{$port}{intfc_name};
|
$intfc_name=$self->{ports}{$port}{intfc_name};
|
$intfc_port=$self->{ports}{$port}{intfc_port};
|
$intfc_port=$self->{ports}{$port}{intfc_port};
|
}
|
}
|
return ($range,$type,$intfc_name,$intfc_port);
|
return ($range,$type,$intfc_name,$intfc_port);
|
}
|
}
|
|
|
|
|
sub ipgen_list_ports{
|
sub ipgen_list_ports{
|
my($self)=@_;
|
my($self)=@_;
|
my @ports;
|
my @ports;
|
foreach my $p (keys %{$self->{ports}}){
|
foreach my $p (keys %{$self->{ports}}){
|
push (@ports,$p);
|
push (@ports,$p);
|
}
|
}
|
return @ports;
|
return @ports;
|
}
|
}
|
|
|
|
|
|
|
sub ipgen_remove_all_ports{
|
sub ipgen_remove_all_ports{
|
my $self=shift;
|
my $self=shift;
|
if (exists ($self->{ports})){
|
if (exists ($self->{ports})){
|
delete $self->{ports};
|
delete $self->{ports};
|
}
|
}
|
|
|
}
|
}
|
|
|
sub ipgen_add_soket{
|
sub ipgen_add_soket{
|
my ($self,$socket,$type,$value,$connection_num)=@_;
|
my ($self,$socket,$type,$value,$connection_num)=@_;
|
$self->{sockets}{$socket}{type}=$type;
|
$self->{sockets}{$socket}{type}=$type;
|
if(defined $value) {
|
if(defined $value) {
|
$self->{sockets}{$socket}{value}=$value;
|
$self->{sockets}{$socket}{value}=$value;
|
|
|
}
|
}
|
if(defined $connection_num) {$self->{sockets}{$socket}{connection_num}=$connection_num;}
|
if(defined $connection_num) {$self->{sockets}{$socket}{connection_num}=$connection_num;}
|
if($type eq 'num'){
|
if($type eq 'num'){
|
if($value == 1) {ipgen_set_socket_name($self,$socket,0,$socket);}
|
if($value == 1) {ipgen_set_socket_name($self,$socket,0,$socket);}
|
else{
|
else{
|
for (my $i=0; $i<$value; $i++){
|
for (my $i=0; $i<$value; $i++){
|
my $name="$socket\_$i";
|
my $name="$socket\_$i";
|
ipgen_set_socket_name($self,$socket,$i,$name);
|
ipgen_set_socket_name($self,$socket,$i,$name);
|
}
|
}
|
|
|
}
|
}
|
|
|
}
|
}
|
else{ipgen_set_socket_name($self,$socket,0,$socket);}
|
else{ipgen_set_socket_name($self,$socket,0,$socket);}
|
|
|
#print "\$self->{sockets}{$socket}{type}=$type;\n"
|
#print "\$self->{sockets}{$socket}{type}=$type;\n"
|
}
|
}
|
|
|
sub ipgen_add_plug{
|
sub ipgen_add_plug{
|
my ($self,$plug,$type,$value)=@_;
|
my ($self,$plug,$type,$value)=@_;
|
$self->{plugs}{$plug}{type}=$type;
|
$self->{plugs}{$plug}{type}=$type;
|
if(defined $value){$self->{plugs}{$plug}{value}=$value};
|
if(defined $value){$self->{plugs}{$plug}{value}=$value};
|
if($type eq 'num'){
|
if($type eq 'num'){
|
if($value == 1) {ipgen_set_plug_name($self,$plug,0,$plug);}
|
if($value == 1) {ipgen_set_plug_name($self,$plug,0,$plug);}
|
else{
|
else{
|
for (my $i=0; $i<$value; $i++){
|
for (my $i=0; $i<$value; $i++){
|
my $name="$plug\_$i";
|
my $name="$plug\_$i";
|
ipgen_set_plug_name($self,$plug,$i,$name);
|
ipgen_set_plug_name($self,$plug,$i,$name);
|
}
|
}
|
|
|
}
|
}
|
|
|
}
|
}
|
else{ipgen_set_plug_name($self,$plug,0,$plug);}
|
else{ipgen_set_plug_name($self,$plug,0,$plug);}
|
|
|
}
|
}
|
|
|
sub ipgen_list_sokets{
|
sub ipgen_list_sokets{
|
my ($self)=@_;
|
my ($self)=@_;
|
my @sokets;
|
my @sokets;
|
|
|
if(exists ($self->{sockets})){
|
if(exists ($self->{sockets})){
|
foreach my $p(keys %{$self->{sockets}}){
|
foreach my $p(keys %{$self->{sockets}}){
|
push (@sokets,$p);
|
push (@sokets,$p);
|
}
|
}
|
}
|
}
|
return @sokets;
|
return @sokets;
|
}
|
}
|
|
|
|
|
sub ipgen_list_plugs{
|
sub ipgen_list_plugs{
|
my ($self)=@_;
|
my ($self)=@_;
|
my @plugs;
|
my @plugs;
|
if(exists ($self->{plugs})){
|
if(exists ($self->{plugs})){
|
foreach my $p(keys %{$self->{plugs}}){
|
foreach my $p(keys %{$self->{plugs}}){
|
push (@plugs,$p);
|
push (@plugs,$p);
|
}
|
}
|
}
|
}
|
return @plugs;
|
return @plugs;
|
}
|
}
|
|
|
|
|
|
|
sub ipgen_get_socket{
|
sub ipgen_get_socket{
|
my ($self,$socket)=@_;
|
my ($self,$socket)=@_;
|
my ($type,$value,$connection_num);
|
my ($type,$value,$connection_num);
|
if(exists ($self->{sockets}{$socket})){
|
if(exists ($self->{sockets}{$socket})){
|
$type =$self->{sockets}{$socket}{type};
|
$type =$self->{sockets}{$socket}{type};
|
$value =$self->{sockets}{$socket}{value};
|
$value =$self->{sockets}{$socket}{value};
|
$connection_num= $self->{sockets}{$socket}{connection_num};
|
$connection_num= $self->{sockets}{$socket}{connection_num};
|
#print "$type,$value\n"
|
#print "$type,$value\n"
|
}
|
}
|
return ($type,$value,$connection_num);
|
return ($type,$value,$connection_num);
|
}
|
}
|
|
|
sub ipgen_get_plug{
|
sub ipgen_get_plug{
|
my ($self,$plug)=@_;
|
my ($self,$plug)=@_;
|
my ($type,$value,$connection_num);
|
my ($type,$value,$connection_num);
|
if(exists ($self->{plugs}{$plug})){
|
if(exists ($self->{plugs}{$plug})){
|
$type =$self->{plugs}{$plug}{type};
|
$type =$self->{plugs}{$plug}{type};
|
$value =$self->{plugs}{$plug}{value};
|
$value =$self->{plugs}{$plug}{value};
|
$connection_num=$self->{plugs}{$plug}{connection_num};
|
$connection_num=$self->{plugs}{$plug}{connection_num};
|
}
|
}
|
return ($type,$value,$connection_num);
|
return ($type,$value,$connection_num);
|
}
|
}
|
|
|
sub ipgen_remove_socket{
|
sub ipgen_remove_socket{
|
my ($self,$socket)=@_;
|
my ($self,$socket)=@_;
|
if(exists ($self->{sockets}{$socket})) {
|
if(exists ($self->{sockets}{$socket})) {
|
delete $self->{sockets}{$socket};
|
delete $self->{sockets}{$socket};
|
}
|
}
|
}
|
}
|
|
|
sub ipgen_remove_plug{
|
sub ipgen_remove_plug{
|
my ($self,$plug)=@_;
|
my ($self,$plug)=@_;
|
if(exists ($self->{plugs}{$plug})) {
|
if(exists ($self->{plugs}{$plug})) {
|
delete $self->{plugs}{$plug};
|
delete $self->{plugs}{$plug};
|
}
|
}
|
}
|
}
|
|
|
|
|
|
|
sub ipgen_set_port_intfc_name{
|
sub ipgen_set_port_intfc_name{
|
my ($self,$port,$intfc_name)=@_;
|
my ($self,$port,$intfc_name)=@_;
|
if(exists ($self->{ports}{$port})){
|
if(exists ($self->{ports}{$port})){
|
$self->{ports}{$port}{intfc_name}=$intfc_name;
|
$self->{ports}{$port}{intfc_name}=$intfc_name;
|
}
|
}
|
|
|
}
|
}
|
|
|
sub ipgen_get_port_intfc_name{
|
sub ipgen_get_port_intfc_name{
|
my ($self,$port)=@_;
|
my ($self,$port)=@_;
|
my $intfc_name;
|
my $intfc_name;
|
if(exists ($self->{ports}{$port}{intfc_name})){
|
if(exists ($self->{ports}{$port}{intfc_name})){
|
$intfc_name=$self->{ports}{$port}{intfc_name};
|
$intfc_name=$self->{ports}{$port}{intfc_name};
|
}
|
}
|
return ($intfc_name);
|
return ($intfc_name);
|
}
|
}
|
|
|
sub ipgen_set_port_intfc_port{
|
sub ipgen_set_port_intfc_port{
|
my ($self,$port,$intfc_port)=@_;
|
my ($self,$port,$intfc_port)=@_;
|
if(exists ($self->{ports}{$port})){
|
if(exists ($self->{ports}{$port})){
|
$self->{ports}{$port}{intfc_port}=$intfc_port;
|
$self->{ports}{$port}{intfc_port}=$intfc_port;
|
}
|
}
|
|
|
}
|
}
|
|
|
sub ipgen_get_port_intfc_port{
|
sub ipgen_get_port_intfc_port{
|
my ($self,$port)=@_;
|
my ($self,$port)=@_;
|
my $intfc_port;
|
my $intfc_port;
|
if(exists ($self->{ports}{$port}{intfc_port})){
|
if(exists ($self->{ports}{$port}{intfc_port})){
|
$intfc_port=$self->{ports}{$port}{intfc_port};
|
$intfc_port=$self->{ports}{$port}{intfc_port};
|
}
|
}
|
return ($intfc_port);
|
return ($intfc_port);
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub ipgen_save_wb_addr{
|
sub ipgen_save_wb_addr{
|
my ($self,$plug,$num,$addr,$width)=@_;
|
my ($self,$plug,$num,$addr,$width)=@_;
|
$self->{plugs}{$plug}{$num}{addr}=$addr;
|
$self->{plugs}{$plug}{$num}{addr}=$addr;
|
$self->{plugs}{$plug}{$num}{width}=$width;
|
$self->{plugs}{$plug}{$num}{width}=$width;
|
|
|
}
|
}
|
|
|
sub ipgen_get_wb_addr{
|
sub ipgen_get_wb_addr{
|
my ($self,$plug,$num)=@_;
|
my ($self,$plug,$num)=@_;
|
my($addr,$width);
|
my($addr,$width);
|
if(exists ($self->{plugs}{$plug}{$num})){
|
if(exists ($self->{plugs}{$plug}{$num})){
|
$addr= $self->{plugs}{$plug}{$num}{addr};
|
$addr= $self->{plugs}{$plug}{$num}{addr};
|
$width=$self->{plugs}{$plug}{$num}{width};
|
$width=$self->{plugs}{$plug}{$num}{width};
|
}
|
}
|
return ($addr,$width);
|
return ($addr,$width);
|
}
|
}
|
|
|
sub ipgen_set_plug_name{
|
sub ipgen_set_plug_name{
|
my ($self,$plug,$num,$name)=@_;
|
my ($self,$plug,$num,$name)=@_;
|
if(exists ($self->{plugs}{$plug})){
|
if(exists ($self->{plugs}{$plug})){
|
$self->{plugs}{$plug}{$num}{name}=$name;
|
$self->{plugs}{$plug}{$num}{name}=$name;
|
|
|
}
|
}
|
|
|
}
|
}
|
|
|
|
|
sub ipgen_get_plug_name{
|
sub ipgen_get_plug_name{
|
my ($self,$plug,$num)=@_;
|
my ($self,$plug,$num)=@_;
|
my $name;
|
my $name;
|
if(exists ($self->{plugs}{$plug}{$num}{name})){
|
if(exists ($self->{plugs}{$plug}{$num}{name})){
|
$name=$self->{plugs}{$plug}{$num}{name};
|
$name=$self->{plugs}{$plug}{$num}{name};
|
|
|
}
|
}
|
return $name;
|
return $name;
|
}
|
}
|
|
|
sub ipgen_set_socket_name {
|
sub ipgen_set_socket_name {
|
my ($self,$socket,$num,$name)= @_;
|
my ($self,$socket,$num,$name)= @_;
|
if(exists ($self->{sockets}{$socket})){
|
if(exists ($self->{sockets}{$socket})){
|
$self->{sockets}{$socket}{$num}{name}=$name;
|
$self->{sockets}{$socket}{$num}{name}=$name;
|
|
|
}
|
}
|
|
|
}
|
}
|
|
|
sub ipgen_get_socket_name{
|
sub ipgen_get_socket_name{
|
my ($self,$socket,$num)=@_;
|
my ($self,$socket,$num)=@_;
|
my $name;
|
my $name;
|
if(exists ($self->{sockets}{$socket}{$num}{name})){
|
if(exists ($self->{sockets}{$socket}{$num}{name})){
|
$name=$self->{sockets}{$socket}{$num}{name};
|
$name=$self->{sockets}{$socket}{$num}{name};
|
|
|
}
|
}
|
return $name;
|
return $name;
|
|
|
}
|
}
|
|
|
|
|
|
|
sub ipgen_add_unused_intfc_port{
|
sub ipgen_add_unused_intfc_port{
|
my ($self,$intfc_name,$port)=@_;
|
my ($self,$intfc_name,$port)=@_;
|
push(@{$self->{unused}{$intfc_name}},$port);
|
push(@{$self->{unused}{$intfc_name}},$port);
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
#add,read,remove object fileds
|
#add,read,remove object fileds
|
|
|
sub ipgen_add{
|
sub ipgen_add{
|
my ($self,$filed_name,$filed_data)=@_;
|
my ($self,$filed_name,$filed_data)=@_;
|
$self->{$filed_name}=$filed_data;
|
$self->{$filed_name}=$filed_data;
|
}
|
}
|
|
|
sub ipgen_remove{
|
sub ipgen_remove{
|
my ($self,$filed_name)=@_;
|
my ($self,$filed_name)=@_;
|
$self->{$filed_name}=undef;
|
$self->{$filed_name}=undef;
|
}
|
}
|
|
|
sub ipgen_get{
|
sub ipgen_get{
|
my ($self,$filed_name)=@_;
|
my ($self,$filed_name)=@_;
|
return $self->{$filed_name}
|
return $self->{$filed_name}
|
}
|
}
|
|
|
sub ipgen_get_list{
|
sub ipgen_get_list{
|
my ($self,$list_name)=@_;
|
my ($self,$list_name)=@_;
|
my @l;
|
my @l;
|
if ( defined $self->{$list_name} ){
|
if ( defined $self->{$list_name} ){
|
@l=@{$self->{$list_name}};
|
@l=@{$self->{$list_name}};
|
}
|
}
|
|
|
return @l;
|
return @l;
|
}
|
}
|
|
|
|
|
|
|
|
|
######################################
|
######################################
|
|
|
|
|
|
|
|
|
sub top_gen_new {
|
sub top_gen_new {
|
# be backwards compatible with non-OO call
|
# be backwards compatible with non-OO call
|
my $class = shift;
|
my $class = shift;
|
my $self;
|
my $self;
|
|
|
|
|
$self = {};
|
$self = {};
|
$self->{instance_ids}={};
|
$self->{instance_ids}={};
|
bless($self,$class);
|
bless($self,$class);
|
|
|
|
|
return $self;
|
return $self;
|
}
|
}
|
|
|
sub top_add_def_to_instance {
|
sub top_add_def_to_instance {
|
my ($self,$inst,$def,$value )=@_;
|
my ($self,$inst,$def,$value )=@_;
|
$self->{instance_ids}{$inst}{$def}=$value;
|
$self->{instance_ids}{$inst}{$def}=$value;
|
}
|
}
|
|
|
sub top_get_def_of_instance {
|
sub top_get_def_of_instance {
|
my ($self,$inst,$def)=@_;
|
my ($self,$inst,$def)=@_;
|
my $val;
|
my $val;
|
$val=$self->{instance_ids}{$inst}{$def} if(exists $self->{instance_ids}{$inst}{$def}) ;
|
$val=$self->{instance_ids}{$inst}{$def} if(exists $self->{instance_ids}{$inst}{$def}) ;
|
return $val;
|
return $val;
|
}
|
}
|
|
|
|
|
sub top_add_port{
|
sub top_add_port{
|
my($self,$inst,$port,$range,$type,$intfc_name,$intfc_port)=@_;
|
my($self,$inst,$port,$range,$type,$intfc_name,$intfc_port)=@_;
|
|
|
#all ports
|
#all ports
|
$self->{ports}{$port}{range}=$range;
|
$self->{ports}{$port}{range}=$range;
|
$self->{ports}{$port}{type}=$type;
|
$self->{ports}{$port}{type}=$type;
|
$self->{ports}{$port}{intfc_name}=$intfc_name;
|
$self->{ports}{$port}{intfc_name}=$intfc_name;
|
$self->{ports}{$port}{intfc_port}=$intfc_port;
|
$self->{ports}{$port}{intfc_port}=$intfc_port;
|
$self->{ports}{$port}{instance_name}=$inst;
|
$self->{ports}{$port}{instance_name}=$inst;
|
|
|
|
|
#based on instance name
|
#based on instance name
|
$self->{instance_ids}{$inst}{ports}{$port}{range}=$range;
|
$self->{instance_ids}{$inst}{ports}{$port}{range}=$range;
|
$self->{instance_ids}{$inst}{ports}{$port}{type}=$type;
|
$self->{instance_ids}{$inst}{ports}{$port}{type}=$type;
|
$self->{instance_ids}{$inst}{ports}{$port}{intfc_name}=$intfc_name;
|
$self->{instance_ids}{$inst}{ports}{$port}{intfc_name}=$intfc_name;
|
$self->{instance_ids}{$inst}{ports}{$port}{intfc_port}=$intfc_port;
|
$self->{instance_ids}{$inst}{ports}{$port}{intfc_port}=$intfc_port;
|
|
|
#based on interface name
|
#based on interface name
|
$self->{interface}{$intfc_name}{ports}{$port}{range}=$range;
|
$self->{interface}{$intfc_name}{ports}{$port}{range}=$range;
|
$self->{interface}{$intfc_name}{ports}{$port}{type}=$type;
|
$self->{interface}{$intfc_name}{ports}{$port}{type}=$type;
|
$self->{interface}{$intfc_name}{ports}{$port}{instance_name}=$inst;
|
$self->{interface}{$intfc_name}{ports}{$port}{instance_name}=$inst;
|
$self->{interface}{$intfc_name}{ports}{$port}{intfc_port}=$intfc_port;
|
$self->{interface}{$intfc_name}{ports}{$port}{intfc_port}=$intfc_port;
|
}
|
}
|
|
|
|
|
|
|
|
|
sub top_get_port{
|
sub top_get_port{
|
my($self,$port)=@_;
|
my($self,$port)=@_;
|
my($inst,$range,$type,$intfc_name,$intfc_port);
|
my($inst,$range,$type,$intfc_name,$intfc_port);
|
$inst =$self->{ports}{$port}{instance_name};
|
$inst =$self->{ports}{$port}{instance_name};
|
$range =$self->{ports}{$port}{range};
|
$range =$self->{ports}{$port}{range};
|
$type =$self->{ports}{$port}{type};
|
$type =$self->{ports}{$port}{type};
|
$intfc_name =$self->{ports}{$port}{intfc_name};
|
$intfc_name =$self->{ports}{$port}{intfc_name};
|
$intfc_port =$self->{ports}{$port}{intfc_port};
|
$intfc_port =$self->{ports}{$port}{intfc_port};
|
return ($inst,$range,$type,$intfc_name,$intfc_port);
|
return ($inst,$range,$type,$intfc_name,$intfc_port);
|
}
|
}
|
|
|
sub top_get_port_list{
|
sub top_get_port_list{
|
my$self=shift;
|
my$self=shift;
|
my @l;
|
my @l;
|
if(exists $self->{ports}){
|
if(exists $self->{ports}){
|
@l= sort keys %{$self->{ports}};
|
@l= sort keys %{$self->{ports}};
|
}
|
}
|
return @l;
|
return @l;
|
}
|
}
|
|
|
|
|
|
|
sub top_add_parameter{
|
sub top_add_parameter{
|
my ($self,$inst,$parameter,$deafult,$type,$content,$info,$global_param,$redefine)=@_;
|
my ($self,$inst,$parameter,$default,$type,$content,$info,$global_param,$redefine)=@_;
|
$self->{instance_ids}{$inst}{parameters}{$parameter}{deafult}=$deafult;
|
$self->{instance_ids}{$inst}{parameters}{$parameter}{"default"}=$default;
|
$self->{instance_ids}{$inst}{parameters}{$parameter}{type}=$type;
|
$self->{instance_ids}{$inst}{parameters}{$parameter}{type}=$type;
|
$self->{instance_ids}{$inst}{parameters}{$parameter}{content}=$content;
|
$self->{instance_ids}{$inst}{parameters}{$parameter}{content}=$content;
|
$self->{instance_ids}{$inst}{parameters}{$parameter}{info}=$info;
|
$self->{instance_ids}{$inst}{parameters}{$parameter}{info}=$info;
|
$self->{instance_ids}{$inst}{parameters}{$parameter}{global_param}=$global_param;
|
$self->{instance_ids}{$inst}{parameters}{$parameter}{global_param}=$global_param;
|
$self->{instance_ids}{$inst}{parameters}{$parameter}{redefine_param}=$redefine;
|
$self->{instance_ids}{$inst}{parameters}{$parameter}{redefine_param}=$redefine;
|
}
|
}
|
|
|
sub top_get_parameter{
|
sub top_get_parameter{
|
my ($self,$inst,$parameter)=@_;
|
my ($self,$inst,$parameter)=@_;
|
my ($deafult,$type,$content,$info,$global_param,$redefine);
|
my ($default,$type,$content,$info,$global_param,$redefine);
|
$deafult=$self->{instance_ids}{$inst}{parameters}{$parameter}{deafult};
|
$default=$self->{instance_ids}{$inst}{parameters}{$parameter}{"default"};
|
$type=$self->{instance_ids}{$inst}{parameters}{$parameter}{type};
|
$type=$self->{instance_ids}{$inst}{parameters}{$parameter}{type};
|
$content=$self->{instance_ids}{$inst}{parameters}{$parameter}{content};
|
$content=$self->{instance_ids}{$inst}{parameters}{$parameter}{content};
|
$info=$self->{instance_ids}{$inst}{parameters}{$parameter}{info};
|
$info=$self->{instance_ids}{$inst}{parameters}{$parameter}{info};
|
$global_param=$self->{instance_ids}{$inst}{parameters}{$parameter}{global_param};
|
$global_param=$self->{instance_ids}{$inst}{parameters}{$parameter}{global_param};
|
$redefine=$self->{instance_ids}{$inst}{parameters}{$parameter}{redefine_param};
|
$redefine=$self->{instance_ids}{$inst}{parameters}{$parameter}{redefine_param};
|
return ($deafult,$type,$content,$info,$global_param,$redefine);
|
return ($default,$type,$content,$info,$global_param,$redefine);
|
}
|
}
|
|
|
sub top_get_parameter_list{
|
sub top_get_parameter_list{
|
my($self,$inst)=@_;
|
my($self,$inst)=@_;
|
my @l;
|
my @l;
|
if(exists $self->{instance_ids}{$inst}{parameters}){
|
if(exists $self->{instance_ids}{$inst}{parameters}){
|
@l= sort keys %{$self->{instance_ids}{$inst}{parameters}};
|
@l= sort keys %{$self->{instance_ids}{$inst}{parameters}};
|
}
|
}
|
return @l;
|
return @l;
|
}
|
}
|
|
|
sub top_add_default_soc_param{
|
sub top_add_default_soc_param{
|
my ($self,$param_ref)=@_;
|
my ($self,$param_ref)=@_;
|
my %l=%{$param_ref};
|
my %l=%{$param_ref};
|
foreach my $p (sort keys %l){
|
foreach my $p (sort keys %l){
|
$self->{parameters}{$p}=$l{$p};
|
$self->{parameters}{$p}=$l{$p};
|
#print"$self->{parameters}{$p}=$l{$p};\n";
|
#print"$self->{parameters}{$p}=$l{$p};\n";
|
}
|
}
|
}
|
}
|
|
|
sub top_get_default_soc_param{
|
sub top_get_default_soc_param{
|
my $self=shift;
|
my $self=shift;
|
my %l;
|
my %l;
|
if(exists $self->{parameters}){
|
if(exists $self->{parameters}){
|
%l=%{$self->{parameters}};
|
%l=%{$self->{parameters}};
|
}
|
}
|
return %l;
|
return %l;
|
}
|
}
|
|
|
|
|
sub top_get_all_instances{
|
sub top_get_all_instances{
|
my ($self)=shift;
|
my ($self)=shift;
|
my @r= keys %{$self->{instance_ids}};
|
my @r= keys %{$self->{instance_ids}};
|
return @r;
|
return @r;
|
|
|
}
|
}
|
|
|
|
|
sub top_get_intfc_list{
|
sub top_get_intfc_list{
|
my ($self)=shift;
|
my ($self)=shift;
|
my @intfcs;
|
my @intfcs;
|
if(exists $self->{interface}){
|
if(exists $self->{interface}){
|
@intfcs= sort keys %{$self->{interface}};
|
@intfcs= sort keys %{$self->{interface}};
|
}
|
}
|
|
|
return @intfcs;
|
return @intfcs;
|
}
|
}
|
|
|
|
|
sub top_get_intfc_ports_list{
|
sub top_get_intfc_ports_list{
|
my($self,$intfc_name)=@_;
|
my($self,$intfc_name)=@_;
|
my @ports;
|
my @ports;
|
if( exists $self->{interface}{$intfc_name}{ports}){
|
if( exists $self->{interface}{$intfc_name}{ports}){
|
@ports= sort keys %{$self->{interface}{$intfc_name}{ports}};
|
@ports= sort keys %{$self->{interface}{$intfc_name}{ports}};
|
}
|
}
|
return @ports;
|
return @ports;
|
}
|
}
|
|
|
|
|
sub top_add_custom_soc_param{
|
sub top_add_custom_soc_param{
|
my ($self,$param_ref,$tile)=@_;
|
my ($self,$param_ref,$tile)=@_;
|
my %l=%{$param_ref};
|
my %l=%{$param_ref};
|
foreach my $p (sort keys %l){
|
foreach my $p (sort keys %l){
|
$self->{tiles}{$tile}{parameters}{$p}=$l{$p};
|
$self->{tiles}{$tile}{parameters}{$p}=$l{$p};
|
#print"$self->{parameters}{$p}=$l{$p};\n";
|
#print"$self->{parameters}{$p}=$l{$p};\n";
|
}
|
}
|
}
|
}
|
|
|
sub top_get_custom_soc_param{
|
sub top_get_custom_soc_param{
|
my ($self,$tile)=@_;
|
my ($self,$tile)=@_;
|
my %l;
|
my %l;
|
if(exists $self->{tiles}{$tile}{parameters}){#get custom param
|
if(exists $self->{tiles}{$tile}{parameters}){#get custom param
|
%l=%{$self->{tiles}{$tile}{parameters}};
|
%l=%{$self->{tiles}{$tile}{parameters}};
|
}elsif (exists $self->{parameters}){#get default param
|
}elsif (exists $self->{parameters}){#get default param
|
%l=%{$self->{parameters}};
|
%l=%{$self->{parameters}};
|
}
|
}
|
return %l;
|
return %l;
|
|
|
}
|
}
|
|
|
|
|
|
|
sub object_add_attribute{
|
sub object_add_attribute{
|
my ($self,$attribute1,$attribute2,$value)=@_;
|
my ($self,$attribute1,$attribute2,$value)=@_;
|
if(!defined $attribute2){$self->{$attribute1}=$value;}
|
if(!defined $attribute2){$self->{$attribute1}=$value;}
|
else {$self->{$attribute1}{$attribute2}=$value;}
|
else {$self->{$attribute1}{$attribute2}=$value;}
|
|
|
}
|
}
|
|
|
sub object_get_attribute{
|
sub object_get_attribute{
|
my ($self,$attribute1,$attribute2)=@_;
|
my ($self,$attribute1,$attribute2)=@_;
|
if(!defined $attribute2) {return $self->{$attribute1};}
|
if(!defined $attribute2) {return $self->{$attribute1};}
|
return $self->{$attribute1}{$attribute2};
|
return $self->{$attribute1}{$attribute2};
|
|
|
|
|
}
|
}
|
|
|
sub object_add_attribute_order{
|
sub object_add_attribute_order{
|
my ($self,$attribute,@param)=@_;
|
my ($self,$attribute,@param)=@_;
|
$self->{'parameters_order'}{$attribute}=[] if (!defined $self->{parameters_order}{$attribute});
|
$self->{'parameters_order'}{$attribute}=[] if (!defined $self->{parameters_order}{$attribute});
|
foreach my $p (@param){
|
foreach my $p (@param){
|
push (@{$self->{parameters_order}{$attribute}},$p);
|
push (@{$self->{parameters_order}{$attribute}},$p);
|
|
|
}
|
}
|
}
|
}
|
|
|
sub object_get_attribute_order{
|
sub object_get_attribute_order{
|
my ($self,$attribute)=@_;
|
my ($self,$attribute)=@_;
|
return @{$self->{parameters_order}{$attribute}};
|
return @{$self->{parameters_order}{$attribute}};
|
}
|
}
|
|
|
|
|
|
|
1
|
1
|
|
|
