#! /usr/bin/perl -w
|
#! /usr/bin/perl -w
|
use strict;
|
use strict;
|
|
|
|
|
package mpsoc;
|
package mpsoc;
|
|
|
use ip_gen;
|
use ip_gen;
|
|
|
|
|
#use Clone 'clone';
|
#use Clone 'clone';
|
|
|
|
|
|
|
sub mpsoc_new {
|
sub mpsoc_new {
|
# be backwards compatible with non-OO call
|
# be backwards compatible with non-OO call
|
my $class = ("ARRAY" eq ref $_[0]) ? "mpsoc" : shift;
|
my $class = ("ARRAY" eq ref $_[0]) ? "mpsoc" : shift;
|
my $self;
|
my $self;
|
|
|
|
|
$self = {};
|
$self = {};
|
$self->{file_name} = (); # information on each file
|
$self->{file_name} = (); # information on each file
|
$self->{noc_param}= {};
|
$self->{noc_param}= {};
|
$self->{noc_indept_param}={};
|
$self->{noc_indept_param}={};
|
$self->{parameters_order}=[];
|
# $self->{parameters_order}=[];
|
|
|
$self->{setting}={};
|
$self->{setting}={};
|
$self->{socs}={};
|
$self->{socs}={};
|
mpsoc_initial_setting($self);
|
mpsoc_initial_setting($self);
|
|
|
|
|
bless($self,$class);
|
bless($self,$class);
|
|
|
|
|
return $self;
|
return $self;
|
}
|
}
|
|
|
sub mpsoc_initial_setting{
|
sub mpsoc_initial_setting{
|
my $self=shift;
|
my $self=shift;
|
$self->{setting}{show_noc_setting}=1;
|
$self->{setting}{show_noc_setting}=1;
|
$self->{setting}{show_adv_setting}=0;
|
$self->{setting}{show_adv_setting}=0;
|
$self->{setting}{show_tile_setting}=1;
|
$self->{setting}{show_tile_setting}=1;
|
$self->{setting}{soc_path}="lib/soc";
|
$self->{setting}{soc_path}="lib/soc";
|
}
|
}
|
|
|
sub mpsoc_set_setting{
|
|
my ($self,$name,$value)=@_;
|
|
$self->{setting}{$name}=$value;
|
|
|
|
}
|
|
|
|
sub mpsoc_get_setting{
|
|
my ($self,$name)=@_;
|
|
return $self->{setting}{$name};
|
|
|
|
}
|
|
|
|
|
|
sub mpsoc_set_mpsoc_name{
|
|
my ($self,$name)=@_;
|
|
if(defined $name){$self->{mpsoc_name}=$name;}
|
|
}
|
|
|
|
sub mpsoc_get_mpsoc_name{
|
|
my ($self)=@_;
|
|
my $name;
|
|
if(exists $self->{mpsoc_name}){ $name=$self->{mpsoc_name};}
|
|
return $name;
|
|
}
|
|
|
|
sub mpsoc_get_indept_params{
|
|
my $self=shift;
|
|
return $self->{noc_indept_param};
|
|
}
|
|
|
|
|
|
sub mpsoc_add_param{
|
|
my ($self,$param,$value)=@_;
|
|
$self->{noc_param}{$param}=$value;
|
|
|
|
}
|
|
|
|
sub mpsoc_get_param{
|
|
my ($self,$param)=@_;
|
|
return $self->{noc_param}{$param};
|
|
|
|
}
|
|
sub mpsoc_add_param_order{
|
|
my ($self,@param)=@_;
|
|
foreach my $p (@param){
|
|
push (@{$self->{parameters_order}},$p);
|
|
|
|
}
|
|
}
|
|
sub mpsoc_get_param_order{
|
|
my $self=shift;
|
|
return @{$self->{parameters_order}};
|
|
}
|
|
|
|
|
|
|
|
|
|
sub mpsoc_get_instance_info{
|
sub mpsoc_get_instance_info{
|
my ($self,$ip_num)=@_;
|
my ($self,$ip_num)=@_;
|
return $self->{ips}{$ip_num}{name}
|
return $self->{ips}{$ip_num}{name}
|
}
|
}
|
|
|
sub mpsoc_set_ip_inst_name{
|
sub mpsoc_set_ip_inst_name{
|
my ($self,$ip_num,$new_instance)=@_;
|
my ($self,$ip_num,$new_instance)=@_;
|
$self->{ips}{$ip_num}{name}=$new_instance;
|
$self->{ips}{$ip_num}{name}=$new_instance;
|
|
|
}
|
}
|
|
|
sub mpsoc_get_soc_list{
|
sub mpsoc_get_soc_list{
|
my $self=shift;
|
my $self=shift;
|
my @list;
|
my @list;
|
foreach my $p (sort keys %{$self->{socs}}){
|
foreach my $p (sort keys %{$self->{socs}}){
|
push(@list,$p);
|
push(@list,$p);
|
}
|
}
|
return @list;
|
return @list;
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
sub mpsoc_add_soc{
|
sub mpsoc_add_soc{
|
my ($self,$name,$soc)=@_;
|
my ($self,$name,$soc)=@_;
|
$self->{socs}{$name}{top}=$soc;
|
$self->{socs}{$name}{top}=$soc;
|
|
|
}
|
}
|
|
|
|
|
|
|
|
|
sub mpsoc_get_soc{
|
sub mpsoc_get_soc{
|
my ($self,$name)=@_;
|
my ($self,$name)=@_;
|
return $self->{socs}{$name}{top};
|
return $self->{socs}{$name}{top};
|
|
|
}
|
}
|
|
|
|
|
sub mpsoc_remove_soc{
|
sub mpsoc_remove_soc{
|
my ($self,$name)=@_;
|
my ($self,$name)=@_;
|
delete $self->{socs}{$name};
|
delete $self->{socs}{$name};
|
}
|
}
|
|
|
sub mpsoc_remove_all_soc{
|
sub mpsoc_remove_all_soc{
|
my ($self)=@_;
|
my ($self)=@_;
|
delete $self->{socs};
|
delete $self->{socs};
|
}
|
}
|
|
|
|
|
|
|
sub mpsoc_add_soc_tiles_num{
|
sub mpsoc_add_soc_tiles_num{
|
my ($self,$name,$nums) =@_;
|
my ($self,$name,$nums) =@_;
|
if(defined $nums){
|
if(defined $nums){
|
my @f=sort { $a <=> $b } @{$nums};
|
my @f=sort { $a <=> $b } @{$nums};
|
if( exists $self->{socs}{$name}){
|
if( exists $self->{socs}{$name}){
|
$self->{socs}{$name}{tile_nums}=\@f;
|
$self->{socs}{$name}{tile_nums}=\@f;
|
|
|
}
|
}
|
}else {
|
}else {
|
$self->{socs}{$name}{tile_nums}=undef;
|
$self->{socs}{$name}{tile_nums}=undef;
|
|
|
}
|
}
|
}
|
}
|
|
|
sub mpsoc_get_soc_tiles_num{
|
sub mpsoc_get_soc_tiles_num{
|
my ($self,$name) =@_;
|
my ($self,$name) =@_;
|
my @nums;
|
my @nums;
|
if( defined $self->{socs}{$name}{tile_nums}){
|
if( defined $self->{socs}{$name}{tile_nums}){
|
@nums = @{$self->{socs}{$name}{tile_nums}};
|
@nums = @{$self->{socs}{$name}{tile_nums}};
|
|
|
}
|
}
|
return @ nums;
|
return @ nums;
|
}
|
}
|
|
|
sub mpsoc_get_scolar_pos{
|
sub mpsoc_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 mpsoc_get_tile_soc_name{
|
sub mpsoc_get_tile_soc_name{
|
my ($self,$tile)=@_;
|
my ($self,$tile)=@_;
|
my @all_socs=mpsoc_get_soc_list($self);
|
my @all_socs=mpsoc_get_soc_list($self);
|
my $soc_num=0;
|
my $soc_num=0;
|
my $p;
|
my $p;
|
foreach $p( @all_socs){
|
foreach $p( @all_socs){
|
my @tiles=mpsoc_get_soc_tiles_num ($self,$p);
|
my @tiles=mpsoc_get_soc_tiles_num ($self,$p);
|
if ( grep( /^$tile$/, @tiles ) ){
|
if ( grep( /^$tile$/, @tiles ) ){
|
my $num =mpsoc_get_scolar_pos($tile,@tiles);
|
my $num =mpsoc_get_scolar_pos($tile,@tiles);
|
|
|
return ($p,$soc_num,$num);
|
return ($p,$soc_num,$num);
|
}
|
}
|
$soc_num++;
|
$soc_num++;
|
|
|
}
|
}
|
return ($p,$soc_num,undef);
|
return ($p,$soc_num,undef);
|
|
|
}
|
}
|
|
|
sub mpsoc_remove_scolar_from_array{
|
sub mpsoc_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 mpsoc_set_tile_free{
|
sub mpsoc_set_tile_free{
|
my ($self,$tile)=@_;
|
my ($self,$tile)=@_;
|
#
|
#
|
mpsoc_set_tile_param_setting($self, $tile, 'Default');
|
mpsoc_set_tile_param_setting($self, $tile, 'Default');
|
my @all_socs=mpsoc_get_soc_list($self);
|
my @all_socs=mpsoc_get_soc_list($self);
|
my $soc_num=0;
|
my $soc_num=0;
|
my $p;
|
my $p;
|
foreach $p( @all_socs){
|
foreach $p( @all_socs){
|
my @tiles=mpsoc_get_soc_tiles_num ($self,$p);
|
my @tiles=mpsoc_get_soc_tiles_num ($self,$p);
|
my @n=mpsoc_remove_scolar_from_array(\@tiles,$tile);
|
my @n=mpsoc_remove_scolar_from_array(\@tiles,$tile);
|
mpsoc_add_soc_tiles_num($self,$p,\@n);
|
mpsoc_add_soc_tiles_num($self,$p,\@n);
|
|
|
}
|
}
|
|
|
}
|
}
|
|
|
sub mpsoc_set_tile_soc_name{
|
sub mpsoc_set_tile_soc_name{
|
my ($self,$tile,$new_soc)=@_;
|
my ($self,$tile,$new_soc)=@_;
|
mpsoc_set_tile_free($self,$tile);
|
mpsoc_set_tile_free($self,$tile);
|
my @tiles=mpsoc_get_soc_tiles_num ($self,$new_soc);
|
my @tiles=mpsoc_get_soc_tiles_num ($self,$new_soc);
|
push(@tiles,$tile);
|
push(@tiles,$tile);
|
mpsoc_add_soc_tiles_num($self,$new_soc,\@tiles);
|
mpsoc_add_soc_tiles_num($self,$new_soc,\@tiles);
|
|
|
|
|
}
|
}
|
|
|
sub mpsoc_set_tile_param_setting{
|
sub mpsoc_set_tile_param_setting{
|
my ($self,$tile,$setting)=@_;
|
my ($self,$tile,$setting)=@_;
|
$self->{tile}{$tile}{param_setting}=$setting;
|
$self->{tile}{$tile}{param_setting}=$setting;
|
|
|
}
|
}
|
|
|
sub mpsoc_get_tile_param_setting{
|
sub mpsoc_get_tile_param_setting{
|
my ($self,$tile)=@_;
|
my ($self,$tile)=@_;
|
my $setting='Default';
|
my $setting='Default';
|
if(exists $self->{tile}{$tile}{param_setting}){
|
if(exists $self->{tile}{$tile}{param_setting}){
|
$setting=$self->{tile}{$tile}{param_setting};
|
$setting=$self->{tile}{$tile}{param_setting};
|
|
|
}
|
}
|
return $setting;
|
return $setting;
|
}
|
}
|
|
|
|
|
|
|
|
sub object_add_attribute{
|
|
my ($self,$attribute1,$attribute2,$value)=@_;
|
|
if(!defined $attribute2){$self->{$attribute1}=$value;}
|
|
else {$self->{$attribute1}{$attribute2}=$value;}
|
|
|
|
}
|
|
|
|
|
|
|
|
sub object_get_attribute{
|
|
my ($self,$attribute1,$attribute2)=@_;
|
|
if(!defined $attribute2) {return $self->{$attribute1};}
|
|
return $self->{$attribute1}{$attribute2};
|
|
|
|
|
|
}
|
|
|
|
|
|
sub object_add_attribute_order{
|
|
my ($self,$attribute,@param)=@_;
|
|
$self->{'parameters_order'}{$attribute}=[] if (!defined $self->{parameters_order}{$attribute});
|
|
foreach my $p (@param){
|
|
push (@{$self->{parameters_order}{$attribute}},$p);
|
|
|
|
}
|
|
}
|
|
sub object_get_attribute_order{
|
|
my ($self,$attribute)=@_;
|
|
return @{$self->{parameters_order}{$attribute}};
|
|
}
|
|
|
|
|
|
|
1
|
1
|
|
|
|
|
