#!/usr/bin/perl -w -I ..
|
#!/usr/bin/perl -w -I ..
|
###############################################################################
|
###############################################################################
|
#
|
#
|
# File: emulator.pm
|
# File: emulator.pm
|
#
|
#
|
#
|
#
|
###############################################################################
|
###############################################################################
|
use warnings;
|
use warnings;
|
use strict;
|
use strict;
|
|
|
|
|
|
|
package emulator;
|
|
|
|
|
package emulator;
|
|
|
|
sub uniq {
|
|
my %seen;
|
|
return grep { !$seen{$_}++ } @_;
|
|
}
|
|
|
sub emulator_new {
|
sub emulator_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->{samples} = ();
|
$self->{samples} = ();
|
emulator_initial_setting($self);
|
emulator_initial_setting($self);
|
|
|
|
|
bless($self,$class);
|
bless($self,$class);
|
|
|
|
|
return $self;
|
return $self;
|
}
|
}
|
|
|
sub emulator_initial_setting{
|
sub emulator_initial_setting{
|
my $self=shift;
|
my $self=shift;
|
$self->{status}="ideal";
|
$self->{status}="ideal";
|
$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}=0;
|
$self->{setting}{show_tile_setting}=0;
|
$self->{setting}{soc_path}="lib/soc";
|
$self->{setting}{soc_path}="lib/soc";
|
|
|
}
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
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});
|
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)=@_;
|
my @array;
|
my @array;
|
@array = @{$self->{parameters_order}{$attribute}} if (defined $self->{parameters_order}{$attribute});
|
@array = @{$self->{parameters_order}{$attribute}} if (defined $self->{parameters_order}{$attribute});
|
return @array;
|
return uniq (@array);
|
}
|
}
|
|
|
|
|
sub object_delete_attribute_order{
|
sub object_delete_attribute_order{
|
my ($self,$attribute,@param)=@_;
|
my ($self,$attribute,@param)=@_;
|
my @array=object_get_attribute_order($self,$attribute);
|
my @array=object_get_attribute_order($self,$attribute);
|
foreach my $p (@param){
|
foreach my $p (@param){
|
@array=remove_scolar_from_array(\@array,$p);
|
@array=remove_scolar_from_array(\@array,$p);
|
|
|
}
|
}
|
$self->{'parameters_order'}{$attribute}=[];
|
$self->{'parameters_order'}{$attribute}=[];
|
object_add_attribute_order($self,$attribute,@array);
|
object_add_attribute_order($self,$attribute,@array);
|
}
|
}
|
|
|
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 remove_scolar_from_array{
|
sub 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;
|
}
|
}
|
|
|
|
|
|
|
1
|
1
|
|
|
