arch/nios2nommu/scripts/PTF/SystemPTF.pm

   1 package SystemPTF;
   2
   3 use strict;
   4
   5 use PTF::PTFParser;
   6 use PTF::PTFSection;
   7 use PTF::SystemPTF::CPU;
   8 use PTF::SystemPTF::Board;
   9 use PTF::SystemPTF::Module;
  10
  11 # Fields:
  12
  13 my %module_order;
  14
  15 sub new {
  16         my $invocant = shift;
  17         my $class = ref($invocant) || $invocant;
  18         my $self = {
  19                 filename => "",
  20                 @_,
  21         };
  22
  23         my $parser = PTFParser->new;
  24         $self->{root} = $parser->readPTF($self->{filename});
  25
  26         # if the specified PTF file could not be read properly, return undef;
  27         $self->{root} or return;
  28
  29         # if the specified PTF file is not a SYSTEM, return undef.
  30         if ($self->{root}->type ne 'SYSTEM') {
  31                 return;
  32         }
  33
  34         # initialize the modulemap
  35         my @modules = $self->{root}->getSections ("MODULE");
  36         my $index = 0;
  37         foreach my $module (@modules) {
  38                 # if the module is not enabled then do not add
  39                 my $SBI = $module->getSection ('SYSTEM_BUILDER_INFO', '');
  40                 if ($SBI->getAssignment ('Is_Enabled') eq "1") {
  41                         $self->{modules}->{$module->name} = $module;
  42                         $module_order{$module->name} = $index;
  43                         $index += 1;
  44                 }
  45         }
  46
  47         bless ($self, $class);
  48         return $self;
  49 }
  50
  51 sub getName {
  52         my ($self) = @_;
  53         return $self->{root}->name;
  54 }
  55
  56 sub getCPUList {
  57         my ($self, @classes) = @_;
  58         my @cpulist = ();
  59
  60         foreach my $module_name (keys (%{$self->{modules}})) {
  61                 my $module = $self->{modules}->{$module_name};
  62                 my $module_class = $module->getAssignment ('class');
  63                 foreach my $class (@classes) {
  64                         if ($module_class eq $class) {
  65                                 push @cpulist, $module->name;
  66                         }
  67                 }
  68         }
  69
  70         return @cpulist;
  71 }
  72
  73 sub getCPU {
  74         my ($self, $name) = @_;
  75
  76         my $cpu = CPU->new (ptf => $self->{modules}->{$name});
  77 }
  78
  79 sub getModule {
  80         my ($self, $name) = @_;
  81
  82         my $module = Module->new (ptf => $self->{modules}->{$name});
  83 }
  84
  85 sub getSlaveModules {
  86         my ($self, $master, $type) = @_;
  87
  88         # create %connected set with just the master
  89         # value of hash key is inconsequential
  90         my %connected;
  91         $connected{$master} = ( );
  92
  93         # create %pool set with all modules
  94         # value of hash key is inconsequential
  95         my %pool;
  96         @pool{keys (%{$self->{modules}})} = ( );
  97
  98         my $dirty = 1;
  99         while ($dirty) {
 100                 # %pool = difference (%pool, %connected)
 101                 delete @pool{ keys %connected };
 102
 103                 $dirty = 0;
 104
 105                 foreach my $name (keys %pool) {
 106                         my $mod = $self->getModule ($name);
 107                         my %mod_masters;
 108                         @mod_masters{ $mod->getMasters ($type) } = ( );
 109
 110                         # if intersection (%masters, %connected) is not empty
 111                         delete @mod_masters{
 112                                 grep ( ! exists $connected{ $_ },
 113                                         keys %mod_masters) };
 114
 115                         if (scalar(keys(%mod_masters)) > 0) {
 116                                 $connected{$name} = ( );
 117                                 $dirty = 1;
 118                         }
 119                 }
 120         }
 121
 122         delete $connected{$master};
 123
 124         return sort module_comparison keys (%connected);
 125 }
 126
 127 sub getClockFreq () {
 128         my ($self) = @_;
 129
 130         my $wsa = $self->{root}->getSection ('WIZARD_SCRIPT_ARGUMENTS', '');
 131         $wsa or return;
 132
 133         my $result = $wsa->getAssignment ('clock_freq');
 134         return $result;
 135 }
 136
 137 # This is not really a class method... more of a helper function really...
 138 sub module_comparison {
 139         if ($module_order{$a} > $module_order{$b}) {
 140                 return 1;
 141         } elsif ($module_order{$a} < $module_order{$b}) {
 142                 return -1;
 143         } else {
 144                 return 0;
 145         }
 146 }
 147
 148
 149 1;