first version for threshold settings for PADIWA, mt

diff --git a/thres/run_thresh_on_system.pl b/thres/run_thresh_on_system.pl
new file mode 100755 (executable)
index 0000000..35d4b79
--- /dev/null
+++ b/thres/run_thresh_on_system.pl
@@ -0,0 +1,126 @@
+#!/usr/bin/perl
+
+use warnings; 
+use strict;
+
+use Getopt::Long;
+use English;
+use Data::Dumper;
+
+use HADES::TrbNet;
+
+
+my $opt_help;
+my @opt_endpoints;
+my @opt_chains;
+my $opt_offset = 0;
+my $opt_verb;
+
+GetOptions ('h|help'        => \$opt_help,
+            'e|endpoints=s' => \@opt_endpoints,
+            'c|chains=s'    => \@opt_chains,
+            'o|offset=s'    => \$opt_offset,
+            'v|verb'        => \$opt_verb);
+
+
+my $endpoints = get_ranges(\@opt_endpoints);
+my $chains    = get_ranges(\@opt_chains);
+
+if( $opt_help ) {
+    &help();
+    exit(0);
+}
+
+
+#print Dumper $endpoints;
+#print Dumper $chains;
+
+
+my $command;
+
+my @pids=();
+my %pids;
+
+foreach my $endpoint (@$endpoints) {
+  foreach my $chain (@$chains) {
+    my $endpoint = sprintf("0x%04x", $endpoint);
+    $command = "./thresholds_automatic.pl -e $endpoint -o $opt_offset -c $chain";
+    #print "command: $command\n";
+    my $pid = fork();
+    if($pid==0) { #child
+      my $res = qx($command);
+      #print $res;
+      exit;
+    }
+    else {
+      push @pids, $pid;
+      $pids{$pid} = 1;
+    }
+    #print $res;
+  }
+}
+
+#print Dumper \%pids;
+
+foreach my $endpoint (@$endpoints) {
+  foreach my $chain (@$chains) {
+    my $pid = wait();
+    print "pid: $pid returned\n";
+    #last if $pid == -1;
+    delete $pids{$pid};
+    #print Dumper \%pids;
+  }
+}
+
+exit;
+
+
+sub get_ranges {
+    (my $ra_data) = @_;
+
+    my @array;
+    foreach my $str (@$ra_data) {
+        $str=~s/-/\.\./;
+        $str=~s/\.\.\./\.\./;
+        my @val = split(/\,/, $str);
+        #print Dumper \@val;
+        foreach my $c_val (@val) {
+            if($c_val =~ /\.\./) {
+                #print "range: $c_val\n";
+                (my $start, my $stop) = $c_val =~ /(\w+)\.\.(\w+)/;
+                $start = hex($start) if($start=~/0x/);
+                $stop = hex($stop) if($stop=~/0x/);
+                #print "start $start, stop $stop\n";
+                foreach ($start .. $stop) {
+                    push @array, $_;
+                }
+                #print Dumper \@array;
+            }
+            else {
+                $c_val = hex($c_val) if($c_val=~/0x/);
+                push @array, int($c_val);
+            }
+
+        }
+
+    }
+
+    return \@array;
+
+}
+
+
+sub help {
+
+print <<EOF;
+usage:
+run_threshold_on_system.pl |options]
+
+example:
+run_threshold_on_system.pl --endpoints=0x301-0x308,0x310..0x315,0x380 --chains=0..3
+will run for endpoints 0x301-0x308 and 0x310-0x315 and 0x380 for all chains (0..3)
+
+
+EOF
+
+}

diff --git a/thres/thresholds_automatic.pl b/thres/thresholds_automatic.pl
index e8cef4eaa31b4417df209192c63f89b2483a8d30..754e233b8cb78fdf4e12202d28919f53f021bce8 100755 (executable)
--- a/thres/thresholds_automatic.pl
+++ b/thres/thresholds_automatic.pl
@@ -227,21 +227,25 @@ sub send_command {
   (my $endpoint, my $command) = @_;
 
   my $rh_res = trb_register_write($endpoint,0xd400, $command);
-  send_command_error() if (!defined $rh_res);
+  send_command_error($endpoint) if (!defined $rh_res);
 
   $rh_res = trb_register_write($endpoint,0xd411, 0x1);
-  send_command_error() if (!defined $rh_res);
+  send_command_error($endpoint) if (!defined $rh_res);
 
   $rh_res = trb_register_read($endpoint,0xd412);
   #print Dumper $rh_res;
-  send_command_error() if (!defined $rh_res);
+  send_command_error($endpoint) if (!defined $rh_res);
   return $rh_res;
 
 }
 
 sub send_command_error {
   my $res = trb_strerror();
-  print "error output: $res\n";
+  my $s= sprintf "error output for access to endpoint 0x%04x: $res\n", $endpoint;
+  print $s;
+  $s=~s/\n/, /g;
+  $logger->error($s);
+  $logger_data->error($s);
   exit();
 }