Subversion Repositories an-fpga-implementation-of-low-latency-noc-based-mpsoc

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