#! /usr/bin/perl -w
|
#! /usr/bin/perl -w
|
use strict;
|
use strict;
|
|
|
package soc;
|
package soc;
|
|
|
use ip;
|
use ip;
|
|
|
|
|
sub soc_new {
|
sub soc_new {
|
# be backwards compatible with non-OO call
|
# be backwards compatible with non-OO call
|
my $class = ("ARRAY" eq ref $_[0]) ? "soc" : shift;
|
my $class = ("ARRAY" eq ref $_[0]) ? "soc" : shift;
|
my $self;
|
my $self;
|
|
|
$self = {};
|
$self = {};
|
$self->{modules} = {};
|
$self->{modules} = {};
|
$self->{instance_order}=();
|
$self->{instance_order}=();
|
$self->{hdl_files}=();
|
$self->{hdl_files}=();
|
|
|
bless($self,$class);
|
bless($self,$class);
|
|
|
return $self;
|
return $self;
|
}
|
}
|
|
|
|
|
sub soc_add_instance{
|
sub soc_add_instance{
|
my ($self,$instance_id,$category,$module,$ip) = @_;
|
my ($self,$instance_id,$category,$module,$ip) = @_;
|
if(exists ($self->{instances}{$instance_id})){
|
if(exists ($self->{instances}{$instance_id})){
|
return 0;
|
return 0;
|
}
|
}
|
my $module_name=$ip->ip_get($category,$module,"module_name");
|
my $module_name=$ip->ip_get($category,$module,"module_name");
|
#print "$module_name\n";
|
#print "$module_name\n";
|
$self->{instances}{$instance_id}={};
|
$self->{instances}{$instance_id}={};
|
$self->{instances}{$instance_id}{module}=$module;
|
$self->{instances}{$instance_id}{module}=$module;
|
$self->{instances}{$instance_id}{module_name}=$module_name;
|
$self->{instances}{$instance_id}{module_name}=$module_name;
|
$self->{instances}{$instance_id}{category}=$category;
|
$self->{instances}{$instance_id}{category}=$category;
|
$self->{instances}{$instance_id}{instance_name}=$instance_id;
|
$self->{instances}{$instance_id}{instance_name}=$instance_id;
|
my @sockets=$ip->ip_get_module_sockets_list($category,$module);
|
my @sockets=$ip->ip_get_module_sockets_list($category,$module);
|
foreach my $socket(@sockets){
|
foreach my $socket(@sockets){
|
my ($type,$value,$connection_num)=$ip->ip_get_socket ($category,$module,$socket);
|
my ($type,$value,$connection_num)=$ip->ip_get_socket ($category,$module,$socket);
|
soc_add_socket_to_instance($self,$instance_id,$socket,$type,$value,$connection_num);
|
soc_add_socket_to_instance($self,$instance_id,$socket,$type,$value,$connection_num);
|
#add socket names
|
#add socket names
|
my $int_num=($type eq 'num')? $value :1;
|
my $int_num=($type eq 'num')? $value :1;
|
for (my $i=0;$i<$int_num;$i++){
|
for (my $i=0;$i<$int_num;$i++){
|
my $name=$ip->ip_get_socket_name($category,$module, $socket,$i);
|
my $name=$ip->ip_get_socket_name($category,$module, $socket,$i);
|
$self->{instances}{$instance_id}{sockets}{$socket}{nums}{$i}{name}=$name;
|
$self->{instances}{$instance_id}{sockets}{$socket}{nums}{$i}{name}=$name;
|
}
|
}
|
|
|
|
|
}
|
}
|
my @plugs=$ip->ip_get_module_plugs_list($category,$module);
|
my @plugs=$ip->ip_get_module_plugs_list($category,$module);
|
foreach my $plug(@plugs){
|
foreach my $plug(@plugs){
|
my ($type,$value,$connection_num)=$ip->ip_get_plug ($category,$module,$plug);
|
my ($type,$value,$connection_num)=$ip->ip_get_plug ($category,$module,$plug);
|
soc_add_plug_to_instance($self,$instance_id,$plug,$type,$value,$connection_num);
|
soc_add_plug_to_instance($self,$instance_id,$plug,$type,$value,$connection_num);
|
#add plug names anf deafult connection as IO
|
#add plug names anf Default connection as IO
|
my $int_num=($type eq 'num')? $value :1;
|
my $int_num=($type eq 'num')? $value :1;
|
for (my $i=0;$i<$int_num;$i++){
|
for (my $i=0;$i<$int_num;$i++){
|
my $name=$ip->ip_get_plug_name($category,$module, $plug,$i);
|
my $name=$ip->ip_get_plug_name($category,$module, $plug,$i);
|
$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$i}{name}=$name;
|
$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$i}{name}=$name;
|
soc_add_instance_plug_conection($self,$instance_id,$plug,$i,"IO");
|
soc_add_instance_plug_conection($self,$instance_id,$plug,$i,"IO");
|
my ($addr , $width) =$ip->ip_get_wb_addr ($category,$module,$plug,$i);
|
my ($addr , $width) =$ip->ip_get_wb_addr ($category,$module,$plug,$i);
|
if(defined $addr){
|
if(defined $addr){
|
$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$i}{addr}=$addr;
|
$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$i}{addr}=$addr;
|
$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$i}{width}=$width;
|
$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$i}{width}=$width;
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
|
|
$self->{instances}{$instance_id}{description_pdf}=$ip->ip_get($category,$module,'description_pdf');
|
$self->{instances}{$instance_id}{description_pdf}=$ip->ip_get($category,$module,'description_pdf');
|
|
|
return 1;
|
return 1;
|
}
|
}
|
|
|
sub soc_add_instance_order{
|
sub soc_add_instance_order{
|
my ($self,$instance_id)=@_;
|
my ($self,$instance_id)=@_;
|
push (@{$self->{instance_order}},$instance_id);
|
push (@{$self->{instance_order}},$instance_id);
|
#print " @{$self->{instance_order}} \n";
|
#print " @{$self->{instance_order}} \n";
|
}
|
}
|
|
|
sub soc_remove_scolar_from_array{
|
sub soc_remove_scolar_from_array{
|
my ($array_ref,$item)=@_;
|
my ($array_ref,$item)=@_;
|
my @array=@{$array_ref};
|
my @array=@{$array_ref};
|
my @new;
|
my @new;
|
foreach my $p (@array){
|
foreach my $p (@array){
|
if($p ne $item ){
|
if($p ne $item ){
|
push(@new,$p);
|
push(@new,$p);
|
}
|
}
|
}
|
}
|
return @new;
|
return @new;
|
}
|
}
|
|
|
sub soc_get_scolar_pos{
|
sub soc_get_scolar_pos{
|
my ($item,@list)=@_;
|
my ($item,@list)=@_;
|
my $pos;
|
my $pos;
|
my $i=0;
|
my $i=0;
|
foreach my $c (@list)
|
foreach my $c (@list)
|
{
|
{
|
if( $c eq $item) {$pos=$i}
|
if( $c eq $item) {$pos=$i}
|
$i++;
|
$i++;
|
}
|
}
|
return $pos;
|
return $pos;
|
}
|
}
|
|
|
sub soc_remove_from_instance_order{
|
sub soc_remove_from_instance_order{
|
my ($self,$instance_id)=@_;
|
my ($self,$instance_id)=@_;
|
my @a=soc_remove_scolar_from_array($self->{instance_order},$instance_id);
|
my @a=soc_remove_scolar_from_array($self->{instance_order},$instance_id);
|
$self->{instance_order}=\@a;
|
$self->{instance_order}=\@a;
|
#print " @{$self->{instance_order}} \n";
|
#print " @{$self->{instance_order}} \n";
|
}
|
}
|
|
|
sub soc_get_instance_order{
|
sub soc_get_instance_order{
|
my $self=shift;
|
my $self=shift;
|
my @order;
|
my @order;
|
@order = @{$self->{instance_order}} if (defined $self->{instance_order});
|
@order = @{$self->{instance_order}} if (defined $self->{instance_order});
|
return @order;
|
return @order;
|
}
|
}
|
|
|
sub soc_increase_instance_order{
|
sub soc_increase_instance_order{
|
my ($self,$item)=@_;
|
my ($self,$item)=@_;
|
my @order;
|
my @order;
|
if (defined $self->{instance_order}){
|
if (defined $self->{instance_order}){
|
@order = @{$self->{instance_order}};
|
@order = @{$self->{instance_order}};
|
my $pos=soc_get_scolar_pos($item,@order);
|
my $pos=soc_get_scolar_pos($item,@order);
|
if(defined $order[$pos+1] ){
|
if(defined $order[$pos+1] ){
|
$order[$pos]=$order[$pos+1];
|
$order[$pos]=$order[$pos+1];
|
$order[$pos+1]=$item;
|
$order[$pos+1]=$item;
|
$self->{instance_order}=\@order;
|
$self->{instance_order}=\@order;
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
sub soc_decrease_instance_order{
|
sub soc_decrease_instance_order{
|
my ($self,$item)=@_;
|
my ($self,$item)=@_;
|
my @order;
|
my @order;
|
if (defined $self->{instance_order}){
|
if (defined $self->{instance_order}){
|
@order = @{$self->{instance_order}};
|
@order = @{$self->{instance_order}};
|
my $pos=soc_get_scolar_pos($item,@order);
|
my $pos=soc_get_scolar_pos($item,@order);
|
if($pos !=0 ){
|
if($pos !=0 ){
|
$order[$pos]=$order[$pos-1];
|
$order[$pos]=$order[$pos-1];
|
$order[$pos-1]=$item;
|
$order[$pos-1]=$item;
|
$self->{instance_order}=\@order;
|
$self->{instance_order}=\@order;
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
sub soc_get_module_name{
|
sub soc_get_module_name{
|
my ($self,$instance_id)=@_;
|
my ($self,$instance_id)=@_;
|
my $module_name;
|
my $module_name;
|
if(exists ($self->{instances}{$instance_id}{module_name})){
|
if(exists ($self->{instances}{$instance_id}{module_name})){
|
$module_name= $self->{instances}{$instance_id}{module_name};
|
$module_name= $self->{instances}{$instance_id}{module_name};
|
}
|
}
|
return $module_name;
|
return $module_name;
|
}
|
}
|
|
|
|
|
sub soc_get_description_pdf{
|
sub soc_get_description_pdf{
|
my ($self,$instance_id)=@_;
|
my ($self,$instance_id)=@_;
|
return $self->{instances}{$instance_id}{description_pdf};
|
return $self->{instances}{$instance_id}{description_pdf};
|
}
|
}
|
|
|
sub soc_get_plug_name {
|
sub soc_get_plug_name {
|
my ($self,$instance_id,$plug,$num)=@_;
|
my ($self,$instance_id,$plug,$num)=@_;
|
my $name;
|
my $name;
|
if(exists($self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{name})){
|
if(exists($self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{name})){
|
$name=$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{name};
|
$name=$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{name};
|
}
|
}
|
return $name;
|
return $name;
|
}
|
}
|
|
|
sub soc_get_plug_addr {
|
sub soc_get_plug_addr {
|
my ($self,$instance_id,$plug,$num)=@_;
|
my ($self,$instance_id,$plug,$num)=@_;
|
my ($addr , $width);
|
my ($addr , $width);
|
if(exists($self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{addr})){
|
if(exists($self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{addr})){
|
$addr= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{addr};
|
$addr= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{addr};
|
$width= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{width};
|
$width= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{width};
|
}
|
}
|
return ($addr , $width);
|
return ($addr , $width);
|
}
|
}
|
|
|
|
|
sub soc_get_socket_name {
|
sub soc_get_socket_name {
|
my ($self,$instance_id,$socket,$num)=@_;
|
my ($self,$instance_id,$socket,$num)=@_;
|
my $name;
|
my $name;
|
if(exists($self->{instances}{$instance_id}{sockets}{$socket}{nums}{$num})){
|
if(exists($self->{instances}{$instance_id}{sockets}{$socket}{nums}{$num})){
|
$name=$self->{instances}{$instance_id}{sockets}{$socket}{nums}{$num}{name};
|
$name=$self->{instances}{$instance_id}{sockets}{$socket}{nums}{$num}{name};
|
}
|
}
|
return $name;
|
return $name;
|
}
|
}
|
|
|
sub soc_remove_instance{
|
sub soc_remove_instance{
|
my ($self,$instance_id)=@_;
|
my ($self,$instance_id)=@_;
|
if ( exists( $self->{instances}{$instance_id} )) {
|
if ( exists( $self->{instances}{$instance_id} )) {
|
delete( $self->{instances}{$instance_id} );
|
delete( $self->{instances}{$instance_id} );
|
}
|
}
|
|
|
|
|
}
|
}
|
|
|
|
|
sub soc_add_socket_to_instance{
|
sub soc_add_socket_to_instance{
|
my ($self,$instance_id,$socket,$type,$value,$connection_num)=@_;
|
my ($self,$instance_id,$socket,$type,$value,$connection_num)=@_;
|
if ( exists( $self->{instances}{$instance_id} )){
|
if ( exists( $self->{instances}{$instance_id} )){
|
$self->{instances}{$instance_id}{sockets}{$socket}{type}=$type;
|
$self->{instances}{$instance_id}{sockets}{$socket}{type}=$type;
|
$self->{instances}{$instance_id}{sockets}{$socket}{value}=$value;
|
$self->{instances}{$instance_id}{sockets}{$socket}{value}=$value;
|
$self->{instances}{$instance_id}{sockets}{$socket}{connection_num}=$connection_num;
|
$self->{instances}{$instance_id}{sockets}{$socket}{connection_num}=$connection_num;
|
|
|
}
|
}
|
}
|
}
|
|
|
sub soc_get_socket_of_instance{
|
sub soc_get_socket_of_instance{
|
my ($self,$instance_id,$socket)=@_;
|
my ($self,$instance_id,$socket)=@_;
|
my ($type,$value,$connection_num);
|
my ($type,$value,$connection_num);
|
if ( exists( $self->{instances}{$instance_id} )){
|
if ( exists( $self->{instances}{$instance_id} )){
|
$type=$self->{instances}{$instance_id}{sockets}{$socket}{type};
|
$type=$self->{instances}{$instance_id}{sockets}{$socket}{type};
|
$value=$self->{instances}{$instance_id}{sockets}{$socket}{value};
|
$value=$self->{instances}{$instance_id}{sockets}{$socket}{value};
|
$connection_num=$self->{instances}{$instance_id}{sockets}{$socket}{connection_num};
|
$connection_num=$self->{instances}{$instance_id}{sockets}{$socket}{connection_num};
|
}
|
}
|
return ($type,$value,$connection_num);
|
return ($type,$value,$connection_num);
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
sub soc_add_plug_to_instance{
|
sub soc_add_plug_to_instance{
|
my ($self,$instance_id,$plug,$type,$value,$connection_num)=@_;
|
my ($self,$instance_id,$plug,$type,$value,$connection_num)=@_;
|
if ( exists( $self->{instances}{$instance_id} )){
|
if ( exists( $self->{instances}{$instance_id} )){
|
$self->{instances}{$instance_id}{plugs}{$plug}{type}=$type;
|
$self->{instances}{$instance_id}{plugs}{$plug}{type}=$type;
|
$self->{instances}{$instance_id}{plugs}{$plug}{value}=$value;
|
$self->{instances}{$instance_id}{plugs}{$plug}{value}=$value;
|
$self->{instances}{$instance_id}{plugs}{$plug}{connection_num}=$connection_num;
|
$self->{instances}{$instance_id}{plugs}{$plug}{connection_num}=$connection_num;
|
|
|
}
|
}
|
}
|
}
|
|
|
sub soc_get_plug_of_instance{
|
sub soc_get_plug_of_instance{
|
my ($self,$instance_id,$plug)=@_;
|
my ($self,$instance_id,$plug)=@_;
|
my ($type,$value,$connection_num);
|
my ($type,$value,$connection_num);
|
if ( exists( $self->{instances}{$instance_id} )){
|
if ( exists( $self->{instances}{$instance_id} )){
|
$type=$self->{instances}{$instance_id}{plugs}{$plug}{type};
|
$type=$self->{instances}{$instance_id}{plugs}{$plug}{type};
|
$value=$self->{instances}{$instance_id}{plugs}{$plug}{value};
|
$value=$self->{instances}{$instance_id}{plugs}{$plug}{value};
|
$connection_num=$self->{instances}{$instance_id}{plugs}{$plug}{connection_num};
|
$connection_num=$self->{instances}{$instance_id}{plugs}{$plug}{connection_num};
|
}
|
}
|
return ($type,$value,$connection_num);
|
return ($type,$value,$connection_num);
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub soc_add_instance_plug_conection{
|
sub soc_add_instance_plug_conection{
|
|
|
my ($self,$instance_id,$plug,$plug_num,$id,$socket,$num)=@_;
|
my ($self,$instance_id,$plug,$plug_num,$id,$socket,$num)=@_;
|
if(exists ($self->{instances}{$instance_id}{plugs}{$plug})){
|
if(exists ($self->{instances}{$instance_id}{plugs}{$plug})){
|
$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_id}=$id;
|
$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_id}=$id;
|
$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_socket}=$socket;
|
$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_socket}=$socket;
|
$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_socket_num}=$num;
|
$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_socket_num}=$num;
|
}
|
}
|
|
|
}
|
}
|
|
|
sub soc_get_module_plug_conection{
|
sub soc_get_module_plug_conection{
|
my ($self,$instance_id,$plug,$plug_num)=@_;
|
my ($self,$instance_id,$plug,$plug_num)=@_;
|
my ($id,$socket,$num);
|
my ($id,$socket,$num);
|
if(exists($self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num})){
|
if(exists($self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num})){
|
$id = $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_id};
|
$id = $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_id};
|
$socket= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_socket};
|
$socket= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_socket};
|
$num= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_socket_num};
|
$num= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_socket_num};
|
}
|
}
|
return ($id,$socket,$num);
|
return ($id,$socket,$num);
|
}
|
}
|
|
|
sub soc_get_all_plugs_of_an_instance{
|
sub soc_get_all_plugs_of_an_instance{
|
my ($self,$instance_id)=@_;
|
my ($self,$instance_id)=@_;
|
my @list;
|
my @list;
|
|
|
if(exists ($self->{instances}{$instance_id}{plugs})){
|
if(exists ($self->{instances}{$instance_id}{plugs})){
|
foreach my $p (sort keys %{$self->{instances}{$instance_id}{plugs}}){
|
foreach my $p (sort keys %{$self->{instances}{$instance_id}{plugs}}){
|
push (@list,$p);
|
push (@list,$p);
|
|
|
}
|
}
|
}
|
}
|
return @list;
|
return @list;
|
|
|
}
|
}
|
|
|
sub soc_get_all_sockets_of_an_instance{
|
sub soc_get_all_sockets_of_an_instance{
|
my ($self,$instance_id)=@_;
|
my ($self,$instance_id)=@_;
|
my @list;
|
my @list;
|
|
|
if(exists ($self->{instances}{$instance_id}{sockets})){
|
if(exists ($self->{instances}{$instance_id}{sockets})){
|
foreach my $p (sort keys %{$self->{instances}{$instance_id}{sockets}}){
|
foreach my $p (sort keys %{$self->{instances}{$instance_id}{sockets}}){
|
push (@list,$p);
|
push (@list,$p);
|
|
|
}
|
}
|
}
|
}
|
return @list;
|
return @list;
|
|
|
}
|
}
|
|
|
|
|
##############################################
|
##############################################
|
sub soc_get_modules_plug_connected_to_socket{
|
sub soc_get_modules_plug_connected_to_socket{
|
my ($self,$id,$socket,$socket_num)=@_;
|
my ($self,$id,$socket,$socket_num)=@_;
|
my %plugs;
|
my %plugs;
|
my %plug_nums;
|
my %plug_nums;
|
my @instances=soc_get_all_instances($self);
|
my @instances=soc_get_all_instances($self);
|
foreach my $instance_id (@instances){
|
foreach my $instance_id (@instances){
|
my @plugs=soc_get_all_plugs_of_an_instance($self,$instance_id);
|
my @plugs=soc_get_all_plugs_of_an_instance($self,$instance_id);
|
foreach my $plug (@plugs){
|
foreach my $plug (@plugs){
|
foreach my $plug_num (keys %{$self->{instances}{$instance_id}{plugs}{$plug}{nums}}){
|
foreach my $plug_num (keys %{$self->{instances}{$instance_id}{plugs}{$plug}{nums}}){
|
my $id_ = $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_id};
|
my $id_ = $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_id};
|
my $socket_= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_socket};
|
my $socket_= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_socket};
|
my $socket_num_= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_socket_num};
|
my $socket_num_= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$plug_num}{connect_socket_num};
|
#print "if($id_ eq $id && $socket_ eq $socket && $socket_num_ eq $socket_num )\n";
|
#print "if($id_ eq $id && $socket_ eq $socket && $socket_num_ eq $socket_num )\n";
|
if($id_ eq $id && $socket_ eq $socket && $socket_num_ eq $socket_num ) {
|
if($id_ eq $id && $socket_ eq $socket && $socket_num_ eq $socket_num ) {
|
$plugs{$instance_id}=$plug;
|
$plugs{$instance_id}=$plug;
|
$plug_nums{$instance_id}=$plug_num;
|
$plug_nums{$instance_id}=$plug_num;
|
|
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
}
|
}
|
|
|
|
|
|
|
return (\%plugs, \%plug_nums);
|
return (\%plugs, \%plug_nums);
|
|
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub get_modules_have_this_socket{
|
sub get_modules_have_this_socket{
|
my ($self,$socket)=@_;
|
my ($self,$socket)=@_;
|
my %r;
|
my %r;
|
my @instances=soc_get_all_instances($self);
|
my @instances=soc_get_all_instances($self);
|
if(!defined $socket ){return %r;}
|
if(!defined $socket ){return %r;}
|
foreach my $p (@instances)
|
foreach my $p (@instances)
|
{
|
{
|
if(exists ($self->{instances}{$p}{sockets}{$socket})) {
|
if(exists ($self->{instances}{$p}{sockets}{$socket})) {
|
$r{$p}=$self->{instances}{$p}{sockets}{$socket}{value};
|
$r{$p}=$self->{instances}{$p}{sockets}{$socket}{value};
|
|
|
}
|
}
|
|
|
}
|
}
|
return %r;
|
return %r;
|
|
|
}
|
}
|
|
|
|
|
|
|
|
|
sub soc_get_all_instances{
|
sub soc_get_all_instances{
|
my ($self)=@_;
|
my ($self)=@_;
|
my @list;
|
my @list;
|
foreach my $p (sort keys %{$self->{instances}}){
|
foreach my $p (sort keys %{$self->{instances}}){
|
push (@list,$p);
|
push (@list,$p);
|
}
|
}
|
return @list;
|
return @list;
|
}
|
}
|
|
|
sub soc_get_all_instances_of_module{
|
sub soc_get_all_instances_of_module{
|
my ($self,$category,$module)=@_;
|
my ($self,$category,$module)=@_;
|
my @list;
|
my @list;
|
my @m_list;
|
my @m_list;
|
@list=soc_get_all_instances($self);
|
@list=soc_get_all_instances($self);
|
|
|
foreach my $p (@list){
|
foreach my $p (@list){
|
#printf "\$p=$p \& $self->{instances}{$p}{module}\n";
|
#printf "\$p=$p \& $self->{instances}{$p}{module}\n";
|
if(($self->{instances}{$p}{module} eq $module) &&
|
if(($self->{instances}{$p}{module} eq $module) &&
|
($self->{instances}{$p}{category} eq $category)){
|
($self->{instances}{$p}{category} eq $category)){
|
push(@m_list,$p);
|
push(@m_list,$p);
|
}
|
}
|
}
|
}
|
return @m_list;
|
return @m_list;
|
}
|
}
|
|
|
|
|
|
|
sub soc_add_instance_param{
|
sub soc_add_instance_param{
|
my ($self,$instance_id,$param_ref)=@_;
|
my ($self,$instance_id,$param_ref)=@_;
|
if(exists ($self->{instances}{$instance_id})){
|
if(exists ($self->{instances}{$instance_id})){
|
my %param=%$param_ref;
|
my %param=%$param_ref;
|
foreach my $p (sort keys %param){
|
foreach my $p (sort keys %param){
|
my $value = $param{$p};
|
my $value = $param{$p};
|
$self->{instances}{$instance_id}{parameters}{$p}{value}=$value;
|
$self->{instances}{$instance_id}{parameters}{$p}{value}=$value;
|
#print "lllllllll:$value\n";
|
#print "lllllllll:$value\n";
|
}
|
}
|
return 1;
|
return 1;
|
}
|
}
|
return 0;
|
return 0;
|
}
|
}
|
|
|
|
|
sub soc_add_instance_param_order{
|
sub soc_add_instance_param_order{
|
my ($self,$instance_id,$param_ref)=@_;
|
my ($self,$instance_id,$param_ref)=@_;
|
if(exists ($self->{instances}{$instance_id})){
|
if(exists ($self->{instances}{$instance_id})){
|
$self->{instances}{$instance_id}{parameters_order}=$param_ref;
|
$self->{instances}{$instance_id}{parameters_order}=$param_ref;
|
return 1;
|
return 1;
|
}
|
}
|
return 0;
|
return 0;
|
}
|
}
|
|
|
sub soc_get_instance_param_order{
|
sub soc_get_instance_param_order{
|
my ($self,$instance_id)=@_;
|
my ($self,$instance_id)=@_;
|
my @r;
|
my @r;
|
if(defined ($self->{instances}{$instance_id}{parameters_order}) ){
|
if(defined ($self->{instances}{$instance_id}{parameters_order}) ){
|
@r=@{$self->{instances}{$instance_id}{parameters_order}};
|
@r=@{$self->{instances}{$instance_id}{parameters_order}};
|
|
|
}
|
}
|
return @r;
|
return @r;
|
}
|
}
|
|
|
|
|
|
|
sub soc_get_module_param{
|
sub soc_get_module_param{
|
my ($self,$instance_id)=@_;
|
my ($self,$instance_id)=@_;
|
my %param;
|
my %param;
|
if(exists ($self->{instances}{$instance_id}{parameters}))
|
if(exists ($self->{instances}{$instance_id}{parameters}))
|
{
|
{
|
foreach my $p (sort keys %{$self->{instances}{$instance_id}{parameters}})
|
foreach my $p (sort keys %{$self->{instances}{$instance_id}{parameters}})
|
{
|
{
|
$param{$p}=$self->{instances}{$instance_id}{parameters}{$p}{value};
|
$param{$p}=$self->{instances}{$instance_id}{parameters}{$p}{value};
|
}
|
}
|
}
|
}
|
return %param;
|
return %param;
|
}
|
}
|
|
|
|
|
|
|
sub soc_get_module_param_value{
|
sub soc_get_module_param_value{
|
my ($self,$instance_id,$param)=@_;
|
my ($self,$instance_id,$param)=@_;
|
my $value;
|
my $value;
|
if(exists ($self->{instances}{$instance_id}{parameters}{$param})){
|
if(exists ($self->{instances}{$instance_id}{parameters}{$param})){
|
$value= $self->{instances}{$instance_id}{parameters}{$param}{value};
|
$value= $self->{instances}{$instance_id}{parameters}{$param}{value};
|
}
|
}
|
return $value;
|
return $value;
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
sub soc_get_all_instance_name{
|
sub soc_get_all_instance_name{
|
my ($self)=@_;
|
my ($self)=@_;
|
my @instance_names;
|
my @instance_names;
|
my @instances=$self->soc_get_all_instances();
|
my @instances=$self->soc_get_all_instances();
|
foreach my $instance_id (@instances){
|
foreach my $instance_id (@instances){
|
my $name= $self->{instances}{$instance_id}{instance_name};
|
my $name= $self->{instances}{$instance_id}{instance_name};
|
push(@instance_names,$name);
|
push(@instance_names,$name);
|
|
|
}
|
}
|
return @instance_names;
|
return @instance_names;
|
}
|
}
|
|
|
|
|
sub soc_set_instance_name{
|
sub soc_set_instance_name{
|
my ($self,$instance_id,$instance_name)=@_;
|
my ($self,$instance_id,$instance_name)=@_;
|
if ( exists( $self->{instances}{$instance_id} )){
|
if ( exists( $self->{instances}{$instance_id} )){
|
$self->{instances}{$instance_id}{instance_name}=$instance_name;
|
$self->{instances}{$instance_id}{instance_name}=$instance_name;
|
}
|
}
|
|
|
}
|
}
|
|
|
sub soc_get_instance_name{
|
sub soc_get_instance_name{
|
my ($self,$instance_id)=@_;
|
my ($self,$instance_id)=@_;
|
my $instance_name;
|
my $instance_name;
|
if ( exists( $self->{instances}{$instance_id} )){
|
if ( exists( $self->{instances}{$instance_id} )){
|
$instance_name=$self->{instances}{$instance_id}{instance_name};
|
$instance_name=$self->{instances}{$instance_id}{instance_name};
|
}
|
}
|
return $instance_name;
|
return $instance_name;
|
|
|
}
|
}
|
|
|
|
|
sub soc_get_instance_id{
|
sub soc_get_instance_id{
|
my ($self,$intance_name)=@_;
|
my ($self,$intance_name)=@_;
|
foreach my $id (sort keys %{$self->{instances}}){
|
foreach my $id (sort keys %{$self->{instances}}){
|
my $p=$self->{instances}{$id}{instance_name};
|
my $p=$self->{instances}{$id}{instance_name};
|
if ($p eq $intance_name) {return $id;}
|
if ($p eq $intance_name) {return $id;}
|
|
|
}
|
}
|
return;
|
return;
|
}
|
}
|
|
|
sub soc_get_module{
|
sub soc_get_module{
|
my ($self,$instance_id) = @_;
|
my ($self,$instance_id) = @_;
|
my $module;
|
my $module;
|
if ( exists( $self->{instances}{$instance_id} )){
|
if ( exists( $self->{instances}{$instance_id} )){
|
$module=$self->{instances}{$instance_id}{module};
|
$module=$self->{instances}{$instance_id}{module};
|
}
|
}
|
return $module;
|
return $module;
|
}
|
}
|
|
|
sub soc_get_category{
|
sub soc_get_category{
|
my ($self,$instance_id) = @_;
|
my ($self,$instance_id) = @_;
|
my $category;
|
my $category;
|
if ( exists( $self->{instances}{$instance_id} )){
|
if ( exists( $self->{instances}{$instance_id} )){
|
$category=$self->{instances}{$instance_id}{category};
|
$category=$self->{instances}{$instance_id}{category};
|
}
|
}
|
return $category;
|
return $category;
|
}
|
}
|
|
|
sub soc_add_plug_base_addr{
|
sub soc_add_plug_base_addr{
|
my($self,$instance_id,$plug,$num,$base,$end)=@_;
|
my($self,$instance_id,$plug,$num,$base,$end)=@_;
|
if(exists ($self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num})){
|
if(exists ($self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num})){
|
$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{base}=$base;
|
$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{base}=$base;
|
$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{end}=$end;
|
$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{end}=$end;
|
}
|
}
|
}
|
}
|
|
|
|
|
|
|
sub soc_list_base_addreses{
|
sub soc_list_base_addreses{
|
my ($self,$id) = @_;
|
my ($self,$id) = @_;
|
my %bases;
|
my %bases;
|
my @all_instances=soc_get_all_instances($self);
|
my @all_instances=soc_get_all_instances($self);
|
foreach my $instance_id (@all_instances){
|
foreach my $instance_id (@all_instances){
|
my @plugs=soc_get_all_plugs_of_an_instance($self,$instance_id);
|
my @plugs=soc_get_all_plugs_of_an_instance($self,$instance_id);
|
foreach my $plug (@plugs){
|
foreach my $plug (@plugs){
|
foreach my $num (sort keys %{$self->{instances}{$instance_id}{plugs}{$plug}{nums}}){
|
foreach my $num (sort keys %{$self->{instances}{$instance_id}{plugs}{$plug}{nums}}){
|
my $base=$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{base};
|
my $base=$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{base};
|
my $end=$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{end};
|
my $end=$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{end};
|
my $connect_id=$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{connect_id};
|
my $connect_id=$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{connect_id};
|
if(defined $base && ($connect_id eq $id)){
|
if(defined $base && ($connect_id eq $id)){
|
$bases{$end}=$base;
|
$bases{$end}=$base;
|
|
|
}
|
}
|
}
|
}
|
}
|
}
|
}
|
}
|
return %bases;
|
return %bases;
|
|
|
}
|
}
|
|
|
|
|
sub soc_list_plug_nums{
|
sub soc_list_plug_nums{
|
my ($self,$instance_id,$plug)=@_;
|
my ($self,$instance_id,$plug)=@_;
|
my @list;
|
my @list;
|
if(exists($self->{instances}{$instance_id}{plugs}{$plug})){
|
if(exists($self->{instances}{$instance_id}{plugs}{$plug})){
|
foreach my $num (sort keys %{$self->{instances}{$instance_id}{plugs}{$plug}{nums}}){
|
foreach my $num (sort keys %{$self->{instances}{$instance_id}{plugs}{$plug}{nums}}){
|
push (@list,$num);
|
push (@list,$num);
|
}
|
}
|
}
|
}
|
return @list;
|
return @list;
|
}
|
}
|
|
|
sub soc_list_socket_nums{
|
sub soc_list_socket_nums{
|
my ($self,$instance_id,$socket)=@_;
|
my ($self,$instance_id,$socket)=@_;
|
my @list;
|
my @list;
|
if(exists($self->{instances}{$instance_id}{sockets}{$socket})){
|
if(exists($self->{instances}{$instance_id}{sockets}{$socket})){
|
foreach my $num (sort keys %{$self->{instances}{$instance_id}{sockets}{$socket}{nums}}){
|
foreach my $num (sort keys %{$self->{instances}{$instance_id}{sockets}{$socket}{nums}}){
|
push (@list,$num);
|
push (@list,$num);
|
}
|
}
|
}
|
}
|
return @list;
|
return @list;
|
}
|
}
|
|
|
|
|
|
|
sub soc_get_plug{
|
sub soc_get_plug{
|
my ($self,$instance_id,$plug,$num) = @_;
|
my ($self,$instance_id,$plug,$num) = @_;
|
my ($addr,$base,$end,$name,$connect_id,$connect_socket,$connect_socket_num);
|
my ($addr,$base,$end,$name,$connect_id,$connect_socket,$connect_socket_num);
|
if(exists($self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num})){
|
if(exists($self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num})){
|
$addr= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{addr};
|
$addr= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{addr};
|
$base= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{base};
|
$base= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{base};
|
$end= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{end};
|
$end= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{end};
|
$name= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{name};
|
$name= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{name};
|
$connect_id= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{connect_id};
|
$connect_id= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{connect_id};
|
$connect_socket= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{connect_socket};
|
$connect_socket= $self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{connect_socket};
|
$connect_socket_num=$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{connect_socket_num};
|
$connect_socket_num=$self->{instances}{$instance_id}{plugs}{$plug}{nums}{$num}{connect_socket_num};
|
|
|
}
|
}
|
return ($addr,$base,$end,$name,$connect_id,$connect_socket,$connect_socket_num);
|
return ($addr,$base,$end,$name,$connect_id,$connect_socket,$connect_socket_num);
|
|
|
}
|
}
|
|
|
|
|
|
|
sub soc_add_top{
|
sub soc_add_top{
|
my ($self,$top_ip)=@_;
|
my ($self,$top_ip)=@_;
|
$self->{top_ip}=$top_ip;
|
$self->{top_ip}=$top_ip;
|
|
|
}
|
}
|
|
|
sub soc_get_top{
|
sub soc_get_top{
|
my $self=shift;
|
my $self=shift;
|
return $self->{top_ip};
|
return $self->{top_ip};
|
|
|
}
|
}
|
|
|
sub soc_get_hdl_files{
|
sub soc_get_hdl_files{
|
my ($self)=shift;
|
my ($self)=shift;
|
return @{$self->{hdl_files}};
|
return @{$self->{hdl_files}};
|
}
|
}
|
|
|
|
|
sub soc_add_hdl_files{
|
sub soc_add_hdl_files{
|
my ($self,@hdl_list)=@_;
|
my ($self,@hdl_list)=@_;
|
my @old=@{$self->{hdl_files}};
|
my @old=@{$self->{hdl_files}};
|
my @new=(@old,@hdl_list);
|
my @new=(@old,@hdl_list);
|
$self->{hdl_files}=\@new;
|
$self->{hdl_files}=\@new;
|
}
|
}
|
|
|
#a-b
|
#a-b
|
sub soc_get_diff_array{
|
sub soc_get_diff_array{
|
my ($a_ref,$b_ref)=@_;
|
my ($a_ref,$b_ref)=@_;
|
my @A=@{$a_ref};
|
my @A=@{$a_ref};
|
my @B=@{$b_ref};
|
my @B=@{$b_ref};
|
my @C;
|
my @C;
|
foreach my $p (@A){
|
foreach my $p (@A){
|
if( !grep (/^$p$/,@B)){push(@C,$p)};
|
if( !grep (/^$p$/,@B)){push(@C,$p)};
|
}
|
}
|
return @C;
|
return @C;
|
|
|
}
|
}
|
|
|
sub soc_remove_hdl_files{
|
sub soc_remove_hdl_files{
|
my ($self,@hdl_list)=@_;
|
my ($self,@hdl_list)=@_;
|
my @old=@{$self->{hdl_files}};
|
my @old=@{$self->{hdl_files}};
|
my @new=soc_get_diff_array(\@old,\@hdl_list);
|
my @new=soc_get_diff_array(\@old,\@hdl_list);
|
$self->{hdl_files}=\@new;
|
$self->{hdl_files}=\@new;
|
}
|
}
|
|
|
|
|
|
|
sub new_wires {
|
sub new_wires {
|
my $class = shift;
|
my $class = shift;
|
my $self;
|
my $self;
|
$self->{assigned_name}={};
|
$self->{assigned_name}={};
|
bless($self,$class);
|
bless($self,$class);
|
return $self;
|
return $self;
|
}
|
}
|
sub wire_add{
|
sub wire_add{
|
my ($self,$name,$filed,$data)=@_;
|
my ($self,$name,$filed,$data)=@_;
|
$self->{assigned_name}{$name}{$filed}=$data;
|
$self->{assigned_name}{$name}{$filed}=$data;
|
}
|
}
|
|
|
sub wire_get{
|
sub wire_get{
|
my ($self,$name,$filed)=@_;
|
my ($self,$name,$filed)=@_;
|
return $self->{assigned_name}{$name}{$filed};
|
return $self->{assigned_name}{$name}{$filed};
|
}
|
}
|
|
|
sub wires_list{
|
sub wires_list{
|
my($self)=shift;
|
my($self)=shift;
|
my @list= sort keys %{$self->{assigned_name}};
|
my @list= sort keys %{$self->{assigned_name}};
|
return @list;
|
return @list;
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
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}};
|
}
|
}
|
|
|
|
|
sub object_remove_attribute{
|
sub object_remove_attribute{
|
my ($self,$attribute1,$attribute2)=@_;
|
my ($self,$attribute1,$attribute2)=@_;
|
if(!defined $attribute2){
|
if(!defined $attribute2){
|
delete $self->{$attribute1} if ( exists( $self->{$attribute1}));
|
delete $self->{$attribute1} if ( exists( $self->{$attribute1}));
|
}
|
}
|
else {
|
else {
|
delete $self->{$attribute1}{$attribute2} if ( exists( $self->{$attribute1}{$attribute2})); ;
|
delete $self->{$attribute1}{$attribute2} if ( exists( $self->{$attribute1}{$attribute2})); ;
|
|
|
}
|
}
|
|
|
}
|
}
|
|
|
|
|
sub board_new {
|
sub board_new {
|
# be backwards compatible with non-OO call
|
# be backwards compatible with non-OO call
|
my $class = ("ARRAY" eq ref $_[0]) ? "soc" : shift;
|
my $class = ("ARRAY" eq ref $_[0]) ? "soc" : shift;
|
my $self;
|
my $self;
|
|
|
$self->{'Input'}{'*VCC'}{'*VCC'} = ['*undefine*'];
|
$self->{'Input'}{'*VCC'}{'*VCC'} = ['*undefine*'];
|
$self->{'Input'}{'*GND'}{'*GND'} = ['*undefine*'];
|
$self->{'Input'}{'*GND'}{'*GND'} = ['*undefine*'];
|
$self->{'Input'}{'*NOCONNECT'}{'*NOCONNECT'} = ['*undefine*'];
|
$self->{'Input'}{'*NOCONNECT'}{'*NOCONNECT'} = ['*undefine*'];
|
$self->{'Output'}{'*NOCONNECT'}{'*NOCONNECT'} = ['*undefine*'];
|
$self->{'Output'}{'*NOCONNECT'}{'*NOCONNECT'} = ['*undefine*'];
|
$self->{'Bidir'}{'*NOCONNECT'}{'*NOCONNECT'} = ['*undefine*'];
|
$self->{'Bidir'}{'*NOCONNECT'}{'*NOCONNECT'} = ['*undefine*'];
|
|
|
bless($self,$class);
|
bless($self,$class);
|
|
|
return $self;
|
return $self;
|
}
|
}
|
|
|
|
|
|
|
sub board_add_pin {
|
sub board_add_pin {
|
my ($self,$direction,$name)=@_;
|
my ($self,$direction,$name)=@_;
|
my ($intfc,$pin_name,$pin_num);
|
my ($intfc,$pin_name,$pin_num);
|
my @f= split('_',$name);
|
my @f= split('_',$name);
|
if(!defined $f[1]){ # There is no '_' in pin name
|
if(!defined $f[1]){ # There is no '_' in pin name
|
|
|
my @p= split(/\[/,$name);
|
my @p= split(/\[/,$name);
|
$intfc=$p[0];
|
$intfc=$p[0];
|
$pin_name=$p[0];
|
$pin_name=$p[0];
|
if(defined $p[1]){ #it is an array
|
if(defined $p[1]){ #it is an array
|
my @q= split(/\]/,$p[1]);
|
my @q= split(/\]/,$p[1]);
|
$pin_num=$q[0]; #save pin num
|
$pin_num=$q[0]; #save pin num
|
}else{
|
}else{
|
$pin_num='*undefine*';
|
$pin_num='*undefine*';
|
}
|
}
|
}
|
}
|
else{ # take the word before '_' as interface
|
else{ # take the word before '_' as interface
|
$intfc=$f[0];
|
$intfc=$f[0];
|
my @p= split(/\[/,$name);
|
my @p= split(/\[/,$name);
|
$pin_name=$p[0];
|
$pin_name=$p[0];
|
if(defined $p[1]){
|
if(defined $p[1]){
|
my @q= split(/\]/,$p[1]);
|
my @q= split(/\]/,$p[1]);
|
$pin_num=$q[0];
|
$pin_num=$q[0];
|
}else{
|
}else{
|
$pin_num='*undefine*';
|
$pin_num='*undefine*';
|
}
|
}
|
}
|
}
|
|
|
my @a;
|
my @a;
|
@a= @{$self->{$direction}{$intfc}{$pin_name}} if(exists $self->{$direction}{$intfc}{$pin_name});
|
@a= @{$self->{$direction}{$intfc}{$pin_name}} if(exists $self->{$direction}{$intfc}{$pin_name});
|
push (@a,$pin_num);
|
push (@a,$pin_num);
|
@{$self->{$direction}{$intfc}{$pin_name}}=@a;
|
@{$self->{$direction}{$intfc}{$pin_name}}=@a;
|
|
|
}
|
}
|
|
|
sub board_get_pin {
|
sub board_get_pin {
|
my ($self,$direction)=@_;
|
my ($self,$direction)=@_;
|
my %p=%{$self->{$direction}};
|
my %p=%{$self->{$direction}};
|
return %p;
|
return %p;
|
|
|
}
|
}
|
|
|
sub board_get_pin_range {
|
sub board_get_pin_range {
|
my ($self,$direction,$pin_name)=@_;
|
my ($self,$direction,$pin_name)=@_;
|
my @f= split('_',$pin_name);
|
my @f= split('_',$pin_name);
|
my $intfc = $f[0];
|
my $intfc = $f[0];
|
my $ref =$self->{$direction}{$intfc}{$pin_name};
|
my $ref =$self->{$direction}{$intfc}{$pin_name};
|
my @range;
|
my @range;
|
@range= @{$ref} if(defined $ref);
|
@range= @{$ref} if(defined $ref);
|
return @range;
|
return @range;
|
}
|
}
|
|
|
|
|
1
|
1
|
|
|
