Adds slow-control of TWIN_PEAKS_CFD1 over SPI. MReyes

TWIN_PEAKS_CFD1 has a slightly different SPI 'frame structure' than the PADIWA does, so the modification is trivial. I decided to pack this in a separate file and not in the spi_slave.pl file in order to avoid packing specialized functionality in the latter.

diff --git a/tools/twinpeaks.pl b/tools/twinpeaks.pl
new file mode 100755 (executable)
index 0000000..fd223d0
--- /dev/null
+++ b/tools/twinpeaks.pl
@@ -0,0 +1,188 @@
+#!/usr/bin/perl -w
+
+#use lib '/home/hadaq/trbsoft/daqtools/perllibs/';
+use warnings;
+use FileHandle;
+use Time::HiRes qw( usleep );
+use Data::Dumper;
+use HADES::TrbNet;
+use Date::Format;
+use Getopt::Long;
+use lib '../perllibs/';
+use Dmon;
+
+if (!defined $ENV{'DAQOPSERVER'}) {
+  die "DAQOPSERVER not set in environment";
+}
+
+if (!defined &trb_init_ports()) {
+  die("can not connect to trbnet-daemon on the $ENV{'DAQOPSERVER'}");
+}
+
+my $help;
+
+my $endpoint;
+my $rchain;
+my $channel;
+my $execute="";
+my $register;
+my $data;
+my $fastcheck = 0;
+my $threshold;
+
+my $READ  = 0x0<<20; # bits to set for a read command
+my $WRITE = 0x8<<20; # bits to set for a write command
+my $REGNR = 24; # number of bits to shift for the register number
+
+my $severe = 0;
+
+my $result = GetOptions (
+                         "h|help"           => \$help,
+                         "c|chain=s"        => \$rchain,
+                         "n|channel=i"      => \$channel,
+                         "e|endpoint=s"     => \$endpoint,
+                         "x|execute=s"      => \$execute,
+                         "r|register=s"     => \$register,
+                         "d|data=s"         => \$data,
+                         "threshold:s"      => \$threshold
+                        );
+
+sub conv_input_string_to_number {
+  (my $val, my $par_name, my $format) = @_;
+
+  #print $val . "\n";
+  return if (! defined $val);
+  if (defined $format and $format eq "hex") {
+    if ($val !~ /^0x/) {
+      print "wrong format for input value \"$par_name\" with \"$val\", should be 0x0 - 0xffff, use hex notation with 0x\n";
+      usage();
+      exit;
+    }
+  }
+
+  if ($val) {
+    if ($val =~ /^0x/) {
+      $val =~ s/^0x//;
+      $val = hex($val);
+    } else {
+      die "wrong number format for parameter \"$par_name\": \"$val\"" unless $val =~ /^\d+$/;
+      $val = int($val);
+    }
+  }
+  return $val;
+}
+
+
+sub usage {
+  print <<EOF;
+usage: twinpeaks.pl  <--endpoint|e=0xYYYY> <--chain|c=N> [--register=number] [--data=number]
+
+examples: twinpeaks.pl –endpoint=0xf860 -x threshold --chain=0 --register=0x23 --channel=7 --data=0x1 # Activates the LE (Leading Edge) discriminator of the first half
+                                                                                                        of the inputs on the TWIN_PEAKS_CFD1 (SPI chain 0 connects to
+                                                                                                        the first FPGA on the board, which controls the settings of
+                                                                                                        the first eight inputs)
+
+commands:
+ threshold                    Set the thresholds of the TWIN_PEAKS front-end electronic
+EOF
+
+  exit;
+}
+
+if ($help || !defined $endpoint || !defined $rchain) {
+  usage();
+}
+
+$endpoint       = &conv_input_string_to_number($endpoint,       "endpoint", "hex");
+#$chain          = &conv_input_string_to_number($chain,          "chain");
+$register       = &conv_input_string_to_number($register,       "register")       if (defined $register);
+$channel        = &conv_input_string_to_number($channel,        "channel")        if (defined $channel);
+$data           = &conv_input_string_to_number($data,           "data")           if (defined $data);
+$threshold      = &conv_input_string_to_number($threshold,      "threshold")      if (defined $threshold);
+
+my $sendcmd_executed_once = 0;
+
+#print "execute: $execute\n";
+#exit;
+
+my $chain = 0;
+
+my @qchain = (eval $rchain);
+foreach my $dchain (@qchain) {
+    $chain = $dchain;
+    #printf("*** %i \n", $chain);
+
+sub sendcmd16 {
+  my @cmd = @_;
+  my $c = [@cmd,1<<$chain,16+0x80];
+  #   print Dumper $c;
+  trb_register_write_mem($endpoint,0xd400,0,$c,scalar @{$c});
+  usleep(1000);
+}
+
+
+sub sendcmd {
+  my ($cmd) = @_;
+  $sendcmd_executed_once = 1;
+  #printf("endpoint: 0x%x, chain: 0x%x, cmd: 0x%x\n", $endpoint, $chain, $cmd);
+  return Dmon::PadiwaSendCmd($cmd,$endpoint,$chain);
+}
+
+
+sub check_std_io {
+  (my $command, my $register) = @_;
+
+  if ($execute eq $command) {
+    if(!defined $data) {
+      my $b = sendcmd($register<<$REGNR | $READ);
+      foreach my $e (sort keys %$b) {
+        printf("endpoint: 0x%04x  chain: %d  $command: 0x%04x\n",$e,$chain,$b->{$e}&0xffff);
+      }
+    }
+    else {
+      my $b = sendcmd($register<<$REGNR | $WRITE | ($data & 0xffff));
+    }
+  }
+}
+
+check_std_io("inputenable",          0x20);
+check_std_io("inputstatus",          0x21);
+check_std_io("led",                  0x22);
+check_std_io("monitor",              0x23);
+check_std_io("invert",               0x24);
+check_std_io("stretch",              0x25);
+check_std_io("compensation",         0x26);
+check_std_io("dischargedisable",     0x27);
+check_std_io("dischargeoverride",    0x28);
+check_std_io("dischargehighz",       0x29);
+check_std_io("dischargedelayinvert", 0x2a);
+check_std_io("dischargedelayselect", 0x2b);
+
+
+
+if ($execute eq "threshold" | defined($threshold)) {
+  die "the command threshold needs an --channel option." if (!defined $channel);
+  if (!defined $register && !defined $threshold) {
+    print "for the command threshold an option --register|r or --threshold is missing.\n";
+    exit;
+  }
+  if (!defined($register)) {$register=$threshold;}
+  if (!defined $data) {
+    print "for the command threshold an option --data|d is missing.\n";
+    exit;
+  }
+  my $b = sendcmd($register<<$REGNR | $WRITE | ($channel & 0xf)<<16 | ($data & 0xffff) );
+}
+
+
+###############################################################################
+
+}
+
+if ($sendcmd_executed_once == 0) {
+  print "no command was executed. Given command \"$execute\" seems to be unknown. use \"-h\" for help.\n";
+  # no command found
+  #usage();
+  exit;
+}
+