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/] [soc.pm] - Diff between revs 42 and 48

Show entire file | Details | Blame | View Log

Rev 42 Rev 48
Line 1... Line 1... 
#! /usr/bin/perl -w
 
#! /usr/bin/perl -w
 
use strict;
 
use strict;
 
 
 
 
 
package soc;
 
package soc;
 
 
 
use FindBin;
 
 
 
use lib $FindBin::Bin;
 
use ip;
 
use ip;
 
 
 
 
 
 
 
sub uniq {
 
 
 
  my %seen;
 
 
 
  return grep { !$seen{$_}++ } @_;
 
 
 
}
 
 
 
 
 
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}=();
 
 
 
    $self->{hdl_files_ticked}=();
 
 
 
 
 
    bless($self,$class);
 
    bless($self,$class);
 
 
 
 
 
    return $self;
 
    return $self;
 
}
 
}
Line 77... Line 83... 
        #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} if(defined $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);
 
                }
 
                }
Line 404... Line 410... 
                        return 1;
 
                        return 1;
 
                }
 
                }
 
                return 0;
 
                return 0;
 
}
 
}
 
 
 
 
 
 
 
sub soc_add_instance_param_type {
 
 
 
        my ($self,$instance_id,$param_ref)=@_;
 
 
 
                if(exists ($self->{instances}{$instance_id})){
 
 
 
                        my %param=%$param_ref;
 
 
 
                        foreach my $p (sort keys %param){
 
 
 
                                my $value = $param{$p};
 
 
 
                                $self->{instances}{$instance_id}{parameters_type}{$p}{value}=$value;
 
 
 
                        }
 
 
 
                        return 1;
 
 
 
                }
 
 
 
                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;
Line 433... Line 452... 
                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};
 
                                my $value =     $self->{instances}{$instance_id}{parameters}{$p}{value};
 
 
 
                                $param{$p}=$value if (defined $value);
 
                        }
 
                        }
 
                }
 
                }
 
                return %param;
 
                return %param;
 
}
 
}
 
 
 
 
 
 
 
 
 
 
 
sub soc_get_module_param_type{
 
 
 
                my ($self,$instance_id)=@_;
 
 
 
                my %param_type;
 
 
 
                if(exists ($self->{instances}{$instance_id}{parameters}))
 
 
 
                {
 
 
 
                        foreach my $p (sort keys %{$self->{instances}{$instance_id}{parameters}})
 
 
 
                        {
 
 
 
                                my $value = $self->{instances}{$instance_id}{parameters_type}{$p}{value};
 
 
 
                                $param_type{$p}=$value if (defined $value);
 
 
 
                        }
 
 
 
                }
 
 
 
                return %param_type;
 
 
 
}
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
sub soc_get_module_param_value{
 
sub soc_get_module_param_value{
 
                my ($self,$instance_id,$param)=@_;
 
                my ($self,$instance_id,$param)=@_;
 
 
 
                return undef if(!defined $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;
Line 607... Line 644... 
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_get_hdl_sim_files{
 
 
 
        my ($self)=shift;
 
 
 
        return @{$self->{hdl_files_ticked}};
 
 
 
}
 
 
 
 
 
 
 
 
 
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;
 
}
 
}
 
 
 
 
 
 
 
sub soc_add_hdl_sim_files{
 
 
 
        my ($self,@hdl_list)=@_;
 
 
 
        my @old=@{$self->{hdl_files_ticked}};
 
 
 
        my @new=(@old,@hdl_list);
 
 
 
        $self->{hdl_files_ticked}=\@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};
Line 636... Line 686... 
        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 soc_remove_hdl_sim_files{
 
 
 
        my ($self,@hdl_list)=@_;
 
 
 
        my @old=@{$self->{hdl_files_ticked}};
 
 
 
        my @new=soc_get_diff_array(\@old,\@hdl_list);
 
 
 
        $self->{hdl_files_ticked}=\@new;
 
 
 
}
 
 
 
 
 
 
 
 
 
 
 
 
 
sub new_wires {
 
sub new_wires {
 
                my $class = shift;
 
                my $class = shift;
 
                my $self;
 
                my $self;
 
                $self->{assigned_name}={};
 
                $self->{assigned_name}={};
Line 687... Line 745... 
 
 
 
 
}
 
}
 
 
 
 
 
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});
 
        my $r = $self->{'parameters_order'}{$attribute};
 
        foreach my $p (@param){
 
        my @a;
 
                push (@{$self->{parameters_order}{$attribute}},$p);
 
        @a = @{$r} if(defined $r);
 
 
 
        push (@a,@param);
 
        }
 
        @a=uniq(@a);
 
 
 
        $self->{'parameters_order'}{$attribute} =\@a;
 
}
 
}
 
 
 
 
 
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}};

powered by: WebSVN 2.1.0

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