From df9d9e2066b6193e9ba3e64f619e8f93395ad713 Mon Sep 17 00:00:00 2001
From: Michael Traxler <M.Traxler@gsi.de>
Date: Thu, 13 May 2021 13:42:20 +0200
Subject: [PATCH] added, mt

---
 thresholds/set_fixed_threshold.pl | 139 ++++++++++++++++++++++++++++++
 1 file changed, 139 insertions(+)
 create mode 100755 thresholds/set_fixed_threshold.pl

diff --git a/thresholds/set_fixed_threshold.pl b/thresholds/set_fixed_threshold.pl
new file mode 100755
index 0000000..1ab1d8b
--- /dev/null
+++ b/thresholds/set_fixed_threshold.pl
@@ -0,0 +1,139 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Data::Dumper;
+use Dmon;
+use Getopt::Long;
+use HADES::TrbNet;
+use POSIX qw(strftime);
+
+# use Time::HiRes qw(usleep nanosleep);
+my $offset = 0;
+my $help;
+my $mode="padiwa";
+my ($chain, $endpoint, $value);
+
+my $result = GetOptions (
+                         "h|help" => \$help,
+                         "c|chain=i" => \$chain,
+                         "e|endpoint=s" => \$endpoint,
+                         "v|value=s" => \$value,
+                         "m|mode=s" => \$mode,
+    );
+
+if($help) {
+  usage();
+  exit;
+}
+
+if (!defined $endpoint || !defined $value || !defined $chain) {
+  print Dumper ($chain, $endpoint, $value);
+  print "parameter missing!\n\n";
+  usage();
+  exit;
+}
+
+if($value =~ /^0x/) {
+    $value = hex($value);
+  }
+
+if($endpoint =~ /^0x/) {
+    $endpoint = hex($endpoint);
+  }
+
+if($chain =~ /^0x/) {
+    $chain= hex($chain);
+  }
+
+trb_init_ports() or die trb_strerror();
+
+
+foreach my $channel (0..15) {
+  write_threshold($mode, $endpoint, $chain, $channel, $value);
+}
+
+exit;
+
+
+sub write_threshold {
+  (my $mode, my $endpoint, my $chain, my $current_channel, my $thresh) = @_;
+
+  my $fixed_bits;
+  my $shift_bits;
+  my $channel_shift=16;
+
+  if($mode eq "padiwa") {
+      $fixed_bits = 0x00800000;
+      $shift_bits = 0;
+  }
+  elsif ($mode eq "cbmrich") {
+      $fixed_bits = 0x00300000;
+      $shift_bits = 4;
+    }
+  elsif ($mode eq "dirich2") {
+    $fixed_bits = 0x8 << 20;
+    $shift_bits = 0;
+    $channel_shift = 24;
+    }
+
+
+  my $command= $fixed_bits | ( ($current_channel&0xf) << $channel_shift) | ($thresh << $shift_bits);
+
+  if ($mode eq "dirich2") {
+    if ($current_channel<16) {
+      Dmon::PadiwaSendCmd($command,$endpoint, 0);
+    } else {
+      Dmon::PadiwaSendCmd($command,$endpoint, 1);
+    }
+  } elsif ($mode eq "padiwa") {
+    Dmon::PadiwaSendCmd($command,$endpoint, $chain);
+  }
+
+  #Dmon::PadiwaSendCmd($command, $endpoint, $chain);
+  #send_command($endpoint, $chain, $command);
+}
+
+
+sub send_command {
+  (my $endpoint, my $chain, my $command) = @_;
+
+  
+  my $ra_atomic = [$command,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1<<$chain,0x10001];
+  my $rh_res = trb_register_write_mem($endpoint, 0xd400, 0, $ra_atomic, scalar @{$ra_atomic});
+  send_command_error($endpoint) if (!defined $rh_res);
+
+  $rh_res = trb_register_read($endpoint,0xd412);
+  #print Dumper $rh_res;
+  send_command_error($endpoint) if (!defined $rh_res);
+  return $rh_res;
+
+}
+
+sub send_command_error {
+    my $endpoint = @_;
+    my $res = trb_strerror();
+    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();
+}
+
+
+sub usage {
+
+  print <<EOF;
+usage: set_fixed_threshold.pl [--help] <--endpoint=<in hex or decimal>] <--chain=<0..3>> <--value<=0..0xffff or decimal>>
+
+write a fixed value to the 16 channels of one padiwa.
+
+example:
+
+write_thresholds.pl --endpoint=0x1200 --chain=1 --value=0x5000
+
+
+EOF
+
+}
-- 
2.43.0