xterm -geometry 80x24 -bg orange -fg black -e bash --login -c '
ssh -X hadaq@lxhadesdaq "
- source /home/hadaq/.bashrc
+ source /home/hadaq/.bash_profile
echo \" <Startup> Connected to lxhadesdaq...\"
echo \" <Startup> Starting DAQ with default settings...\"
cd /home/hadaq/trbsoft/daq/main/
#!/bin/bash
-↓
+
#Mount RAM file system
#mount -t tmpfs none /var/spool/ramdisk -o size=256m
# cd ../
export DAQOPSERVER=hadesp31
+mkdir `pwd`/archive
+mkdir `pwd`/qa
+mkdir `pwd`/logs
+mkdir `pwd`/vertex
sshfs -o allow_other hades-qa@lxhadeb06:/home/hades-qa/online/apr12/vertex/vertex_jpg `pwd`/vertex
sshfs -o allow_other hades-qa@lxhadeb06:/home/hades-qa/online/apr12/pics `pwd`/qa
--- /dev/null
+rdesktop hadvm04.gsi.de -g 1500x950 -k de -uscs -phadesctrl
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use warnings;
+use strict;
+
+use HADES::TrbNet;
+
+trb_init_ports() or die trb_strerror();
+
+my $mask = 0x55;
+
+while(1) {
+ for (my $i = 0; $i<8;$i++) {
+ trb_register_write(0xfffd,$i*2+0xa021,$mask);
+ }
+ for (my $i = 0; $i<12;$i++) {
+ trb_register_write(0xfffd,$i*2+0xa091,$mask);
+ }
+ trb_register_write(0xfffd,0x20,0x200);
+
+ $mask = (~$mask) & 0xff;
+
+ sleep(60);
+ }
--- /dev/null
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+use FileHandle;
+use Data::Dumper;
+use IO::Socket;
+use Getopt::Long;
+use Log::Log4perl qw(get_logger);
+
+
+my $opt_help;
+my $opt_verb;
+my $opt_offset = 0;
+my $opt_load;
+
+
+GetOptions ('h|help' => \$opt_help,
+ 'o|offset=s' => \$opt_offset,
+ 'l|load' => \$opt_load,
+ 'v|verb' => \$opt_verb);
+
+
+# 0 => short , 1=> long motherboard
+
+
+if(!defined $ARGV[0] || $ARGV[0] eq "" || $opt_help) {
+ usage();
+ exit;
+}
+
+my $neg_sign = $opt_offset =~/^\-/;
+$opt_offset =~ s/\-//;
+
+my $str = $opt_offset;
+
+$str =~ s/0x//;
+#print "str: $str\n";
+die ("option offset is not a number, decimal nor hex") if($str=~/[[:^xdigit:]]/);
+
+
+$opt_offset = hex($opt_offset) if ($opt_offset=~/0x/);
+#print "off: $opt_offset\n";
+
+die ("option offset is not a valid number, decimal nor hex") if($opt_offset =~ /\D/);
+
+$opt_offset = int($opt_offset);
+
+$opt_offset = -1*$opt_offset if($neg_sign);
+
+print "used offset: $opt_offset\n";
+
+my $ra_mbo_nr_to_length = [
+ [0,1,1,0,0,0,1,1,0,0,1,0,1,0,undef, undef],
+ [0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1],
+ [1,0,0,0,0,1,1,0,0,0,0,1,0,1,1,0],
+ [0,0,0,1,1,0,0,0,0,1,1,0,0,1,1,0]
+];
+
+
+
+my $ra_tdc_to_data_words_registers = [
+{ dbo => 0, offset => 0xC088 },
+{ dbo => 1, offset => 0xC090 },
+{ dbo => 0, offset => 0xC098 },
+{ dbo => 1, offset => 0xC0A0 },
+{ dbo => 2, offset => 0xC0A8 },
+{ dbo => 3, offset => 0xC0B0 },
+{ dbo => 2, offset => 0xC0B8 },
+{ dbo => 3, offset => 0xC0C0 },
+{ dbo => 4, offset => 0xC0C8 },
+{ dbo => 5, offset => 0xC0D0 },
+{ dbo => 4, offset => 0xC0D8 },
+{ dbo => 5, offset => 0xC0E0 },
+ ];
+
+#print Dumper $ra_tdc_to_data_words_registers;
+## main
+
+Log::Log4perl->init(".logger_mdc_threshold.conf");
+
+
+
+open my $fh, "<$ARGV[0]" || die ("can not open input file \"$ARGV[0]\"\n");
+my @f = <$fh>;
+close($fh);
+
+
+my $logger = get_logger("mdc_threshold_analyze");
+
+my $head_comment = "#\n#\n# file generated by mdc_mdcthreshold_analyze, " . qx(date);
+$logger->info($head_comment);
+
+
+open my $header, "data/threshold_template.db";
+foreach (<$header>) {
+ chomp;
+ $logger->info($_);
+}
+close($header);
+
+#2012/01/05 12:17:24 mbo: 0x2030, tdc: 00, channel: 01, thresh: 0x2e num_hits: 6
+
+my $rh_data = {};
+my $rh_mbo_dbo_thres = {};
+
+foreach my $cur_ln (@f) {
+ my @s = split / /, $cur_ln;
+ map {s/,//} @s;
+ #print @s;
+ my $mbo = hex($s[3]);
+ my $tdc = $s[5];
+ #$tdc =~s/^0*//;
+ $tdc = int($tdc);
+ my $cha = int($s[7]);
+ my $thr = hex($s[9]);
+ my $nhits = int($s[11]);
+
+ #print $thr . "\n";
+ my $r = $rh_data;
+
+ my $new_thresh = $thr + $opt_offset;
+ $new_thresh = 0x10 if($new_thresh <=0x10);
+
+ $r->{$mbo}->{$tdc}->{$cha}->{thresh} = $new_thresh;
+ $r->{$mbo}->{$tdc}->{$cha}->{nhits} = $nhits;
+
+}
+
+#print Dumper $rh_data;
+
+foreach my $mbo (sort {$a <=> $b} keys %$rh_data) {
+
+ my $mbo_threshold_set;
+
+ foreach my $tdc (sort {$a <=> $b} keys %{$rh_data->{$mbo}}) {
+ foreach my $cha (sort {$a <=> $b} keys %{$rh_data->{$mbo}->{$tdc}}) {
+ my $dbo = $ra_tdc_to_data_words_registers->[$tdc]->{dbo};
+ my $thr = $rh_data->{$mbo}->{$tdc}->{$cha}->{thresh};
+
+ $rh_mbo_dbo_thres->{$mbo}->{$dbo} = [0xfff,0x1] if(!defined $rh_mbo_dbo_thres->{$mbo}->{$dbo});
+
+ #printf "thr: $thr, value in dbo: %d\n", $rh_mbo_dbo_thres->{$mbo}->{$dbo}->[1];
+ # find maximum
+ if ($rh_mbo_dbo_thres->{$mbo}->{$dbo}->[1] <= $thr) {
+ $rh_mbo_dbo_thres->{$mbo}->{$dbo}->[1] = $thr;
+ }
+
+ # find minimum
+ if ($rh_mbo_dbo_thres->{$mbo}->{$dbo}->[0] >= $thr) {
+ $rh_mbo_dbo_thres->{$mbo}->{$dbo}->[0] = $thr;
+ }
+
+ }
+
+ }
+
+ foreach my $dbo (sort {$a <=> $b} keys %{$rh_mbo_dbo_thres->{$mbo}}) {
+ my $str = sprintf "mbo: 0x%4.4x, dbo: %d, thresh: 0x%2.2x, min_thresh_dbo: 0x%2.2x",
+ $mbo, $dbo,
+ $rh_mbo_dbo_thres->{$mbo}->{$dbo}->[1],
+ $rh_mbo_dbo_thres->{$mbo}->{$dbo}->[0];
+ print $str . "\n";
+
+ $mbo_threshold_set->{$dbo} = $rh_mbo_dbo_thres->{$mbo}->{$dbo}->[1];
+
+ }
+
+ #print "mbo: $mbo\n";
+ my $hex_mbo = sprintf "0x%4.4x", $mbo;
+ #print "hexmbo: $hex_mbo\n";
+ (my $plane, my $sector, my $mbonr) = $hex_mbo =~ /0x\w(\w)(\w)(\w)/;
+ $mbonr = hex($mbonr);
+ my $mbo_len = $ra_mbo_nr_to_length->[$plane]->[$mbonr];
+ die ("could not determine mbo_length for mbo: $hex_mbo") if(!defined $mbo_len);
+
+ my $daq;
+
+ my @thresh_array;
+
+ my $end_of_loop = $mbo_len ? 5 : 3;
+ foreach (0..$end_of_loop) {
+ if(!defined $mbo_threshold_set->{$_}) {
+ printf "threshold for mbo: %x, dbo: %d is missing in file analyzed, is set to 0xff\n",
+ $mbo, $_;
+ $mbo_threshold_set->{$_} = 0xff;
+ }
+ push @thresh_array, $mbo_threshold_set->{$_};
+ }
+
+
+ if($mbo_len == 1) {
+ $daq = sprintf "0x%4.4x %d 0x%2.2x 0x%2.2x 0x%2.2x 0x%2.2x 0x%2.2x 0x%2.2x",
+ $mbo, $mbo_len+1, @thresh_array;
+ }
+ else {
+ $daq = sprintf "0x%4.4x %d 0x%2.2x 0x%2.2x 0x%2.2x 0x%2.2x",
+ $mbo, $mbo_len+1, @thresh_array;
+ }
+ #print $daq . "\n";
+ $logger->info($daq);
+
+}
+
+if($opt_load) {
+
+ print "directly loading generated threshold to mdc....\n";
+ my $c = "loadmdcdbfile.pl data/mdc_threshold_daq.db";
+ system($c);
+}
+
+
+
+exit;
+
+sub usage {
+ print "
+mdc_threshold_analyze.pl [options] <filename>
+
+filename: filename of the output of mdc_threshold_scan.pl,
+ normally this is data/mdc_threshold_result
+
+The output of this analyis will be a list of thresholds to stdout
+and a file
+data/mdc_thresholds_daq.db
+(the filename is defined in .logger_mdc_threshold.conf)
+which will contain the same information, but ready to be used by the HADES-DAQ.
+
+options:
+
+-o <value> | --offset=<value>
+ sets the value of the offset which will be added to each threshold, after determining the max
+
+-l|--load
+ if given, the thresholds generated will be directly loaded to the MDC-motherboards
+
+";
+
+}
--- /dev/null
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+use FileHandle;
+use Data::Dumper;
+use IO::Socket;
+use Getopt::Long;
+use English;
+
+use HADES::TrbNet;
+
+use Log::Log4perl qw(get_logger);
+
+# please edit: the stuff which has to be scanned. Self explaining, counting from 0.
+my $planes = [0..0];
+my $sectors = [3];
+my $mbos = [0x0..0xf];
+
+# threshold in number of datawords; now we use 20kHz trigger rate for the scan
+my $LIMIT_NUM_OF_DATAWORDS = 20;
+my $NOMINAL_NUM_TRIGGERS = 20E3;
+my $MEASUREMENT_TIME = 0.1; # nominal measuremnet time
+my $MAX_REASONABLE_THRESHOLD = 0x60;
+
+my $MAX_REASONABLE_DIFF_IN_TRIGGERS = 3000; # if the CTS delivers garbage: retry
+
+## => results in maximal 10 per mil occupancy
+
+# don't edit below if you are not knowing what you do...
+
+my $opt_help;
+my @opt_planes;
+my @opt_mbos;
+my @opt_sectors;
+my $opt_verb;
+my $opt_reject;
+my $opt_datawords;
+my $opt_non_mod_mbo;
+my $opt_spike_scan;
+my $opt_max_reasonable_threshold;
+
+GetOptions ('h|help' => \$opt_help,
+ 'p|planes=s' => \@opt_planes,
+ 's|sectors=s' => \@opt_sectors,
+ 'm|mbos=s' => \@opt_mbos,
+ 'r|rejection=s' => \$opt_reject,
+ 'd|datawords=i' => \$opt_datawords,
+ 'n|non_mod_mbo' => \$opt_non_mod_mbo,
+ 'sps|spike_scan' => \$opt_spike_scan,
+ 'mrt|max_reasonable_threshold=s' => \$opt_max_reasonable_threshold,
+ 'v|verb' => \$opt_verb);
+
+
+#print Dumper \@opt_sectors;
+
+$planes = get_ranges(\@opt_planes);
+$sectors = get_ranges(\@opt_sectors);
+$mbos = get_ranges(\@opt_mbos);
+
+#print Dumper $planes;
+#print Dumper $sectors;
+#print Dumper $mbos;
+
+if( $opt_help ) {
+ &help();
+ exit(0);
+}
+
+
+if(!$opt_reject) {
+ print "error: the -r|--rejection option is mandatory.\n";
+ &help();
+ exit(0);
+}
+
+my @allowed_reject = qw('0x10' '0x15' '0x16' '0x17');
+
+if (!grep (/$opt_reject/, @allowed_reject) ) {
+ my $str = join ",", @allowed_reject;
+ print "error: allowed rejection values are only: $str\n";
+ #&help();
+ exit();
+}
+
+
+if( $ARGV[0] || !$opt_reject || $opt_help || !@$planes || !@$sectors || !@$mbos) {
+ &help();
+ exit(0);
+}
+
+
+print "the following list of planes, sectors and mbos will be used in the given order:\n";
+print "planes: ", join(",", @$planes) ."\n";
+print "sectors: ", join(",", @$sectors) ."\n";
+print "mbos: ", join(",", @$mbos) ."\n";
+print "rejection value: $opt_reject\n";
+print "non_mod_mbo option is"; print defined $opt_non_mod_mbo ? " " : " not "; print "set\n";
+print "spike_scan is "; print defined $opt_spike_scan ? "" : "not"; print " set\n";
+
+
+
+$LIMIT_NUM_OF_DATAWORDS = $opt_datawords if ($opt_datawords && $opt_datawords>=1);
+print "datawords limit: $LIMIT_NUM_OF_DATAWORDS\n";
+
+
+$MAX_REASONABLE_THRESHOLD = hex($opt_max_reasonable_threshold) if ($opt_max_reasonable_threshold);
+printf "maximum reasonable threshold for automatic spike scan: 0x%x\n", $MAX_REASONABLE_THRESHOLD;
+
+print "\n";
+
+
+my @spike_reject_values = (0x10, 0x15, 0x16, 0x17);
+
+# 0 => short , 1=> long motherboard
+
+my $ra_mbo_nr_to_length = [
+ [0,1,1,0,0,0,1,1,0,0,1,0,1,0,undef, undef],
+ [0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1],
+ [1,0,0,0,0,1,1,0,0,0,0,1,0,1,1,0],
+ [0,0,0,1,1,0,0,0,0,1,1,0,0,1,1,0]
+];
+
+
+#print Dumper $ra_mbo_nr_to_length;
+
+
+# addresess for short and long mbos
+my $ra_dbo_number_to_address = [
+ [ 0xa049, 0xa0cd],
+ [ 0xa04b, 0xa0cf],
+ [ 0xa04d, 0xa0d1],
+ [ 0xa04f, 0xa0d3],
+ [ undef, 0xa0d5],
+ [ undef, 0xa0d7]
+
+ ];
+
+my $ra_tdc_regs = [
+
+[0xA001, 0xA061],
+[0xA011, 0xA079],
+[0xA021, 0xA091],
+[0xA031, 0xA0A9],
+[0xA049, 0xA0CD],
+
+];
+
+#print Dumper $ra_dbo_number_to_address;
+
+
+my $ra_tdc_to_data_words_registers = [
+{ dbo => 0, offset => 0xC088 },
+{ dbo => 1, offset => 0xC090 },
+{ dbo => 0, offset => 0xC098 },
+{ dbo => 1, offset => 0xC0A0 },
+{ dbo => 2, offset => 0xC0A8 },
+{ dbo => 3, offset => 0xC0B0 },
+{ dbo => 2, offset => 0xC0B8 },
+{ dbo => 3, offset => 0xC0C0 },
+{ dbo => 4, offset => 0xC0C8 },
+{ dbo => 5, offset => 0xC0D0 },
+{ dbo => 4, offset => 0xC0D8 },
+{ dbo => 5, offset => 0xC0E0 },
+ ];
+
+#print Dumper $ra_tdc_to_data_words_registers;
+
+
+my $rh_dbo_to_offset;
+my $tdc_num = 0;
+
+
+## main
+
+Log::Log4perl->init(".logger_mdc_threshold.conf");
+
+my $logger = get_logger("mdc_threshold_debug.log");
+my $logger_data = get_logger("mdc_threshold_data");
+
+my $connect_status = &trb_init_ports();
+
+if(!defined $connect_status) {
+ die ("Connection closed by foreign host.")
+}
+
+
+foreach my $cur_tdc (@$ra_tdc_to_data_words_registers) {
+ my $dbo = $cur_tdc->{'dbo'};
+ my $offset = $cur_tdc->{'offset'};
+# if (! defined $rh_dbo_to_offset->{$dbo}) {
+# $rh_dbo_to_offset->{$dbo} = [];
+# }
+ push @{$rh_dbo_to_offset->{$dbo}->{ra_offsets}}, $offset;
+ push @{$rh_dbo_to_offset->{$dbo}->{ra_tdcs}}, $tdc_num;
+ $tdc_num++;
+
+}
+
+#print Dumper $rh_dbo_to_offset;
+
+# should be 10kHz
+#my $set_pulser_10kHz_command = q|trbcmd w 0x0003 0xa0e3 0x4e20|;
+
+# 20kHz, delay 0x2710
+trb_register_write( 0x0003, 0xa0e3, 0x2710);
+
+$opt_reject = hex($opt_reject);
+
+$opt_reject = 0x10 if($opt_spike_scan);
+
+foreach my $cur_plane (@$planes) {
+ foreach my $cur_sector (@$sectors) {
+ MBO_LOOP: foreach my $cur_mbo (@$mbos) {
+ print "$PID: currently scanning: plane $cur_plane, sector: $cur_sector, mbo: $cur_mbo\n";
+
+ my $mbo_len = $ra_mbo_nr_to_length->[$cur_plane]->[$cur_mbo];
+ next MBO_LOOP if (!defined $mbo_len);
+
+ my $mbo_address = 0x2000 + 0x0100*$cur_plane + 0x0010*$cur_sector +
+ $cur_mbo;
+
+ # 8 or 12 TDCs on the MBO
+ my $num_of_tdc_on_mbo = $mbo_len ? 11 : 7;
+
+ my $str= "plane: $cur_plane , sector: $cur_sector, mbo: " .
+ sprintf ("%2.2d", $cur_mbo) . ", length: $mbo_len, " .
+ sprintf ("mbo_address 0x%x , ", $mbo_address) .
+ "num_tdcs $num_of_tdc_on_mbo";
+
+ $logger->info($str);
+
+ foreach my $cur_tdc (0..$num_of_tdc_on_mbo) {
+
+ # set required spike rejection
+ my $spike_address = $ra_tdc_regs->[0]->[$mbo_len];
+ $spike_address += 2*$cur_tdc;
+ trb_register_write( $mbo_address, $spike_address, $opt_reject);
+
+ foreach my $cur_channel (0..7) {
+
+ my $dbo_number = $ra_tdc_to_data_words_registers->[$cur_tdc]->{dbo};
+ my $real_dbo_number = $dbo_number;
+ my $data_words_register = $ra_tdc_to_data_words_registers->
+ [$cur_tdc]->{offset} + $cur_channel;
+
+ my $threshold_address = $ra_dbo_number_to_address->[$dbo_number]->
+ [$mbo_len];
+
+ # deal with the non_patched mbos
+ if ($opt_non_mod_mbo) {
+ #print "mod mbo\n";
+ $real_dbo_number -= 2 if ($dbo_number >=4);
+ $threshold_address = $ra_dbo_number_to_address->[$real_dbo_number]->
+ [$mbo_len];
+
+ # patch squared
+ #foreach my $i (0..5) {
+ #$threshold_address = $ra_dbo_number_to_address->[$i]->[$mbo_len];
+ #trb_register_write($mbo_address, $threshold_address, 0x10);
+ #}
+ #trb_register_write($mbo_address, 0x20, 0x200);
+
+ }
+
+ my $str = sprintf(" tdc_num: %2.2d, ", $cur_tdc) .
+ "channel: $cur_channel, dbo_num: $dbo_number, real_dbo: $real_dbo_number";
+ $logger->info($str);
+ $str = sprintf("data_words_reg = 0x%x, threshold_address = 0x%x \n",
+ $data_words_register, $threshold_address);
+ $logger->info($str);
+ #print $str . "\n";
+
+ # input mask register is in line 3
+ my $tdc_mask_address = $ra_tdc_regs->[3]->[$mbo_len];
+ $tdc_mask_address += 2 * $cur_tdc;
+ my $mask = 1<<$cur_channel;
+ $mask = 0xff;
+ trb_register_write($mbo_address, $tdc_mask_address, $mask);
+ trb_register_write($mbo_address, 0x20, 0x200);
+
+ my $current_threshold = 0xa0;
+ my $number_of_datawords=0;
+ my $diff_of_datawords = 0;
+ my $thres_step_size = 0x40;
+ my $last_fulfilling_threshold = $current_threshold;
+ my $last_fulfilling_hits = 0;
+
+ #print "start loop\n";
+ # while ($number_of_datawords < $LIMIT_NUM_OF_DATAWORDS) {
+ my $number_of_iterations = 0;
+ my $MAX_ITERATIONS = 10;
+ my $cur_spike_rejection = $opt_reject;
+ my $last_used_spike_rejection = $opt_reject;
+ if (!$opt_spike_scan) {
+ unshift (@spike_reject_values, $cur_spike_rejection);
+ }
+
+ SPIKE_REJECT_LOOP: foreach $cur_spike_rejection (@spike_reject_values) {
+ $last_used_spike_rejection = $cur_spike_rejection;
+ if ($opt_spike_scan) {
+ trb_register_write ($mbo_address, $spike_address, $cur_spike_rejection);
+ }
+
+ THRESHOLD_LOOP: while ($number_of_iterations <= $MAX_ITERATIONS) {
+
+ my $command_read_data_words;
+ my $command;
+ my $res;
+ my $rh_res;
+ my $old_num_triggers;
+ my $cur_num_triggers;
+
+ my $cur_num_data_words;
+ my $old_num_data_words;
+
+ #printf "thre add: %x thr: %x dwr: %x\n", $threshold_address, $current_threshold , $data_words_register;
+ trb_register_write($mbo_address, $threshold_address,
+ $current_threshold);
+ trb_register_write($mbo_address, 0x20, 0x200);
+
+ # read data words
+ $rh_res = trb_register_read( $mbo_address, $data_words_register);
+ $res = $rh_res->{$mbo_address};
+ $cur_num_data_words = $res;
+ if (!defined $res) {
+ printf "motherboard not reachable: mbo: %04x, ".
+ "address: 0x4x , please fix it\n",
+ $mbo_address, $data_words_register;
+ next MBO_LOOP;
+ }
+ $old_num_data_words = $cur_num_data_words;
+
+ # read number of triggers
+ $old_num_triggers = get_trigger_number();
+
+ select(undef, undef, undef, $MEASUREMENT_TIME);
+
+ $rh_res = trb_register_read( $mbo_address, $data_words_register);
+ $res = $rh_res->{$mbo_address};
+ if (!defined $res) {
+ print "no result from trb_register_read\n";
+ next MBO_LOOP;
+ }
+ if ($res) {
+ $cur_num_data_words = $res;
+ } else {
+ $res = 0;
+ }
+
+
+ # read number of triggers
+ $cur_num_triggers = get_trigger_number();
+
+ my $diff_nr_triggers = $cur_num_triggers - $old_num_triggers;
+ $diff_nr_triggers += 0xffff if($diff_nr_triggers < 0);
+
+ # in case of a wrong trigger number by the CTS
+ if($diff_nr_triggers > $MAX_REASONABLE_DIFF_IN_TRIGGERS) {
+ next THRESHOLD_LOOP;
+ }
+
+
+ $diff_of_datawords = $cur_num_data_words - $old_num_data_words;
+ $diff_of_datawords += 0xffffffff if($diff_of_datawords < 0);
+ my $str = sprintf " diff in data words = %4d, diff triggers = %4.1d, at " .
+ "threshold: 0x%.2x, spike: 0x%.2x, iter: %.2d\n",
+ $diff_of_datawords , $diff_nr_triggers, $current_threshold,
+ $cur_spike_rejection, $number_of_iterations;
+ ;
+ $logger->info($str);
+
+ if ($diff_of_datawords < $LIMIT_NUM_OF_DATAWORDS * ($diff_nr_triggers) /
+ ($NOMINAL_NUM_TRIGGERS*$MEASUREMENT_TIME) ) {
+ $last_fulfilling_threshold = $current_threshold;
+ $last_fulfilling_hits = $diff_of_datawords;
+ $current_threshold = int($current_threshold - $thres_step_size);
+ $current_threshold = 0x10 if($current_threshold <=0x10);
+
+ } else {
+ $current_threshold = int($current_threshold + $thres_step_size);
+ $current_threshold = 0xff if($current_threshold >= 0xff);
+ }
+ $thres_step_size = int ($thres_step_size/1.5);
+ $thres_step_size = 4 if ($thres_step_size<2);
+
+ $number_of_iterations++;
+
+ } # end of loop over one channel THRESHOLD_LOOP
+
+ if ($opt_spike_scan) {
+ if ($last_fulfilling_threshold > $MAX_REASONABLE_THRESHOLD) {
+ $MAX_ITERATIONS += 10;
+ next SPIKE_REJECT_LOOP;
+ }
+ else {
+ last SPIKE_REJECT_LOOP;
+ }
+ } else {
+ last SPIKE_REJECT_LOOP;
+ }
+
+ } # end of loop over all SPIKE_REJECTIONS
+
+ my $thr_res = sprintf "mbo: 0x%x, tdc: %2.2d, channel: %2.2d, thresh: 0x%.2x, " .
+ "num_hits: %.2d, spike: 0x%.2x\n",
+ $mbo_address, $cur_tdc, $cur_channel, $last_fulfilling_threshold,
+ $last_fulfilling_hits, $last_used_spike_rejection;
+ $logger->info($thr_res);
+ $logger_data->info($thr_res);
+
+ # cancel signals after a channel is finished...
+ trb_register_write($mbo_address, $threshold_address, 0xff);
+ trb_register_write($mbo_address, 0x20, 0x200);
+
+ } # end of loop over all channels of one TDC
+
+ } # end of loop over all tdcs
+
+ } #MBO loop
+ } # loop over sectors
+} # loop over planes
+
+
+exit;
+
+
+#end of main
+
+sub get_trigger_number {
+
+ my $cur_num_triggers = 0;
+ my $exit_counter = 0;
+
+ while ($cur_num_triggers == 0) {
+ #my $rh_res = trb_register_read( 0x3, 0xa000);
+ #my $res = $rh_res->{0x3};
+ my $rh_res = trb_register_read( 0x2, 0x1);
+ my $res = $rh_res->{0x2};
+
+ if(!defined $res) {
+ printf "number of triggers in CTS not reachable please fix it\n";
+ exit;
+ }
+
+ $cur_num_triggers = $res & 0xffff;
+ $exit_counter++;
+ last if ($exit_counter > 9 );
+ }
+
+ return $cur_num_triggers;
+}
+
+
+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;
+
+}
+
+
+
+
+#mdc_threshold_scan.pl <-s|--spike> [-d|--datawords=<number_of_datawords>] [-p <plane_range>|--planes=<plane_range>] [-s <sectors_range>|--sectors=<sector_range>] [-m <mbo_range>|--mbos=<mbo_range>]
+
+sub help {
+print <<EOF;
+usage:
+mdc_threshold_scan.pl |options]
+
+example:
+mdc_threshold_scan.pl --reject=0x17 --datawords=10 --planes=0,2 -p 4 --sectors=0-5 --mbos=0xe..0xf
+will run for planes 0,2,4; for sectors 0-5; for mbos 14 and 15
+
+for the chamber in the tent:
+mdc_threshold_scan.pl --planes=0 --sectors=3 --mbos=0-0xf --rejection=0x17
+
+options:
+
+mandatory:
+-r <value> |--reject=<value>
+ sets the spike rejection value:
+ 0x10 => no spike rejection
+ 0x14 => 8 ns
+ 0x15 => 13 ns
+ 0x16 => 18 ns
+ 0x17 => 23 ns
+
+-p <plane_range>|--planes=<plane_range>
+-s <sectors_range>|--sectors=<sector_range>
+-m <mbo_range>|--mbos=<mbo_range>
+
+optional:
+-d|--datawords=<number_of_datawords>
+ sets the number of data words which is the limit for the threshold to be set
+ default is 20
+
+-n|--non_mod_mbo
+ if set, the scan assumes that the long mbo is not modified, so the last two DACs
+ on the MBO can not be used. Should not be on for normal mbos.
+
+-sps|--spike_scan
+ if set, the scan will "smartly" increase the spike-rejection factor, only if the
+ found threshold is above a limit.
+
+The results of the scan are stored in a file, by default in
+data/mdc_threshold_results
+
+can be changed in the file: .logger_mdc_threshold.conf in the current directory.
+
+To analyze the file, please call
+./mdc_threshold_analyze.pl
+
+EOF
+
+exit(0);
+}
+
--- /dev/null
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+use FileHandle;
+use Data::Dumper;
+use IO::Socket;
+use Getopt::Long;
+use English;
+
+use HADES::TrbNet;
+
+use Log::Log4perl qw(get_logger);
+
+# please edit: the stuff which has to be scanned. Self explaining, counting from 0.
+my $planes = [0..0];
+my $sectors = [3];
+my $mbos = [0x0..0xf];
+
+# threshold in number of datawords; now we use 20kHz trigger rate for the scan
+my $LIMIT_NUM_OF_DATAWORDS = 10;
+my $NOMINAL_NUM_TRIGGERS = 20E3;
+my $MEASUREMENT_TIME = 0.1; # nominal measuremnet time
+my $MAX_REASONABLE_THRESHOLD = 0x60;
+
+my $MAX_REASONABLE_DIFF_IN_TRIGGERS = 3000; # if the CTS delivers garbage: retry
+
+## => results in maximal 10 per mil occupancy
+
+# don't edit below if you are not knowing what you do...
+
+my $opt_help;
+my @opt_planes;
+my @opt_mbos;
+my @opt_sectors;
+my $opt_verb;
+my $opt_reject;
+my $opt_datawords;
+my $opt_non_mod_mbo;
+my $opt_spike_scan;
+my $opt_max_reasonable_threshold;
+
+GetOptions ('h|help' => \$opt_help,
+ 'p|planes=s' => \@opt_planes,
+ 's|sectors=s' => \@opt_sectors,
+ 'm|mbos=s' => \@opt_mbos,
+ 'r|rejection=s' => \$opt_reject,
+ 'd|datawords=i' => \$opt_datawords,
+ 'n|non_mod_mbo' => \$opt_non_mod_mbo,
+ 'sps|spike_scan' => \$opt_spike_scan,
+ 'mrt|max_reasonable_threshold=s' => \$opt_max_reasonable_threshold,
+ 'v|verb' => \$opt_verb);
+
+
+#print Dumper \@opt_sectors;
+
+$planes = get_ranges(\@opt_planes);
+$sectors = get_ranges(\@opt_sectors);
+$mbos = get_ranges(\@opt_mbos);
+
+#print Dumper $planes;
+#print Dumper $sectors;
+#print Dumper $mbos;
+
+if( $opt_help ) {
+ &help();
+ exit(0);
+}
+
+
+if(!$opt_reject) {
+ print "error: the -r|--rejection option is mandatory.\n";
+ &help();
+ exit(0);
+}
+
+my @allowed_reject = qw('0x10' '0x15' '0x16' '0x17');
+
+if (!grep (/$opt_reject/, @allowed_reject) ) {
+ my $str = join ",", @allowed_reject;
+ print "error: allowed rejection values are only: $str\n";
+ #&help();
+ exit();
+}
+
+
+if( $ARGV[0] || !$opt_reject || $opt_help || !@$planes || !@$sectors || !@$mbos) {
+ &help();
+ exit(0);
+}
+
+
+print "the following list of planes, sectors and mbos will be used in the given order:\n";
+print "planes: ", join(",", @$planes) ."\n";
+print "sectors: ", join(",", @$sectors) ."\n";
+print "mbos: ", join(",", @$mbos) ."\n";
+print "rejection value: $opt_reject\n";
+print "non_mod_mbo option is"; print defined $opt_non_mod_mbo ? " " : " not "; print "set\n";
+print "spike_scan is "; print defined $opt_spike_scan ? "" : "not"; print " set\n";
+
+
+
+$LIMIT_NUM_OF_DATAWORDS = $opt_datawords if ($opt_datawords && $opt_datawords>=1);
+print "datawords limit: $LIMIT_NUM_OF_DATAWORDS\n";
+
+
+$MAX_REASONABLE_THRESHOLD = hex($opt_max_reasonable_threshold) if ($opt_max_reasonable_threshold);
+printf "maximum reasonable threshold for automatic spike scan: 0x%x\n", $MAX_REASONABLE_THRESHOLD;
+
+print "\n";
+
+
+my @spike_reject_values = (0x10, 0x15, 0x16, 0x17);
+
+# 0 => short , 1=> long motherboard
+
+my $ra_mbo_nr_to_length = [
+ [0,1,1,0,0,0,1,1,0,0,1,0,1,0,undef, undef],
+ [0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1],
+ [1,0,0,0,0,1,1,0,0,0,0,1,0,1,1,0],
+ [0,0,0,1,1,0,0,0,0,1,1,0,0,1,1,0]
+];
+
+
+#print Dumper $ra_mbo_nr_to_length;
+
+
+# addresess for short and long mbos
+my $ra_dbo_number_to_address = [
+ [ 0xa049, 0xa0cd],
+ [ 0xa04b, 0xa0cf],
+ [ 0xa04d, 0xa0d1],
+ [ 0xa04f, 0xa0d3],
+ [ undef, 0xa0d5],
+ [ undef, 0xa0d7]
+
+ ];
+
+my $ra_tdc_regs = [
+
+[0xA001, 0xA061],
+[0xA011, 0xA079],
+[0xA021, 0xA091],
+[0xA031, 0xA0A9],
+[0xA049, 0xA0CD],
+
+];
+
+#print Dumper $ra_dbo_number_to_address;
+
+
+my $ra_tdc_to_data_words_registers = [
+{ dbo => 0, offset => 0xC088 },
+{ dbo => 1, offset => 0xC090 },
+{ dbo => 0, offset => 0xC098 },
+{ dbo => 1, offset => 0xC0A0 },
+{ dbo => 2, offset => 0xC0A8 },
+{ dbo => 3, offset => 0xC0B0 },
+{ dbo => 2, offset => 0xC0B8 },
+{ dbo => 3, offset => 0xC0C0 },
+{ dbo => 4, offset => 0xC0C8 },
+{ dbo => 5, offset => 0xC0D0 },
+{ dbo => 4, offset => 0xC0D8 },
+{ dbo => 5, offset => 0xC0E0 },
+ ];
+
+#print Dumper $ra_tdc_to_data_words_registers;
+
+
+my $rh_dbo_to_offset;
+my $tdc_num = 0;
+
+
+## main
+
+Log::Log4perl->init(".logger_mdc_threshold.conf");
+
+my $logger = get_logger("mdc_threshold_debug.log");
+my $logger_data = get_logger("mdc_threshold_data");
+
+my $connect_status = &trb_init_ports();
+
+if(!defined $connect_status) {
+ die ("Connection closed by foreign host.")
+}
+
+
+foreach my $cur_tdc (@$ra_tdc_to_data_words_registers) {
+ my $dbo = $cur_tdc->{'dbo'};
+ my $offset = $cur_tdc->{'offset'};
+# if (! defined $rh_dbo_to_offset->{$dbo}) {
+# $rh_dbo_to_offset->{$dbo} = [];
+# }
+ push @{$rh_dbo_to_offset->{$dbo}->{ra_offsets}}, $offset;
+ push @{$rh_dbo_to_offset->{$dbo}->{ra_tdcs}}, $tdc_num;
+ $tdc_num++;
+
+}
+
+#print Dumper $rh_dbo_to_offset;
+
+# should be 10kHz
+#my $set_pulser_10kHz_command = q|trbcmd w 0x0003 0xa0e3 0x4e20|;
+
+# 20kHz, delay 0x2710
+trb_register_write( 0x0003, 0xa0e3, 0x2710);
+
+$opt_reject = hex($opt_reject);
+
+$opt_reject = 0x10 if($opt_spike_scan);
+
+
+# generate MDC-structure in memory
+
+my $rh_mdc;
+
+foreach my $cur_plane (@$planes) {
+ foreach my $cur_sector (@$sectors) {
+ MBO_LOOP: foreach my $cur_mbo (@$mbos) {
+ my $mbo_len = $ra_mbo_nr_to_length->[$cur_plane]->[$cur_mbo];
+ next MBO_LOOP if (!defined $mbo_len);
+ my $mbo_addr = 0x2000 + 0x0100 * $cur_plane + 0x0010 * $cur_sector + $cur_mbo;
+
+
+ my $num_of_tdc_on_mbo = $mbo_len ? 11 : 7;
+ $rh_mdc->{$mbo_addr}->{last_tdc} = $num_of_tdc_on_mbo;
+
+ foreach my $cur_tdc (0..$num_of_tdc_on_mbo) {
+
+ my $spike_address = $ra_tdc_regs->[0]->[$mbo_len];
+ $spike_address += 2*$cur_tdc;
+ $rh_mdc->{$mbo_addr}->{tdc}->{$cur_tdc}->{spike_address} = $spike_address;
+
+ my $tdc_mask_address = $ra_tdc_regs->[3]->[$mbo_len];
+ $tdc_mask_address += 2 * $cur_tdc;
+ $rh_mdc->{$mbo_addr}->{tdc}->{$cur_tdc}->{mask_address} = $tdc_mask_address;
+
+ my $dbo_number = $ra_tdc_to_data_words_registers->[$cur_tdc]->{dbo};
+
+ my $threshold_address = $ra_dbo_number_to_address->[$dbo_number]->
+ [$mbo_len];
+ $rh_mdc->{$mbo_addr}->{tdc}->{$cur_tdc}->{threshold_address} = $threshold_address;
+
+
+ my $data_words_register_offset = $ra_tdc_to_data_words_registers->
+ [$cur_tdc]->{offset}; # + $cur_channel;
+ $rh_mdc->{$mbo_addr}->{tdc}->{$cur_tdc}->{data_words_register_offset} = $data_words_register_offset;
+
+
+ $rh_mdc->{$mbo_addr}->{tdc}->{$cur_tdc}->{threshold} = [ (0x98) x 8 ];
+ $rh_mdc->{$mbo_addr}->{tdc}->{$cur_tdc}->{data_words_old} = [ (0) x 8 ];
+ $rh_mdc->{$mbo_addr}->{tdc}->{$cur_tdc}->{data_words_new} = [ (0) x 8 ];
+ $rh_mdc->{$mbo_addr}->{tdc}->{$cur_tdc}->{last_ok_thr} = [ (0xff) x 8 ];
+ $rh_mdc->{$mbo_addr}->{tdc}->{$cur_tdc}->{thresh_step_size} = [ (0x40) x 8 ];
+ }
+ }
+ }
+}
+
+#print Dumper $rh_mdc;
+
+
+foreach my $cur_tdc (0..11) {
+ foreach my $cur_channel (0..7) {
+
+ my $number_of_iterations;
+ for my $cur_iteration (1..10) {
+
+ # loop to set thresholds
+ foreach my $cur_mbo (keys %$rh_mdc) {
+
+ next if (!defined $rh_mdc->{$cur_mbo}->{last_tdc} || $cur_tdc > $rh_mdc->{$cur_mbo}->{last_tdc});
+
+ #printf "mbo: 0x%.4x, tdc: $cur_tdc, chan: $cur_channel\n", $cur_mbo;
+
+ if ($cur_channel == 0 && $cur_iteration == 0) {
+ #printf "spike address: %x, mask_address: %x\n", $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{spike_address}, $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{mask_address};
+ trb_register_write($cur_mbo, $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{spike_address}, $opt_reject);
+ trb_register_write($cur_mbo, $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{mask_address}, 0xff);
+ }
+
+
+ # write thresholds
+ my $thr_addr = $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{threshold_address};
+ #print Dumper $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{threshold}->[$cur_channel] ;
+ trb_register_write ($cur_mbo, $thr_addr,
+ $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{threshold}->[$cur_channel] );
+
+ my $data_word_reg = $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{data_words_register_offset}
+ + $cur_channel;
+ #my $data_words = read_mbo_reg ($cur_mbo, $data_word_reg);
+ #my $data_words;
+ #print Dumper $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{data_words_old};
+ #exit;
+ #$rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{data_words_old}->[$cur_channel] = $data_words;
+
+
+ }
+
+ my $data_word_reg = $ra_tdc_to_data_words_registers->[$cur_tdc]->{offset} + $cur_channel;
+
+
+ #$rh_mdc->{0x2001}->{tdc}->{$cur_tdc}->{data_words_register_offset}
+ # + $cur_channel;
+
+ my $rh_data_words = trb_register_read (0xfffd, $data_word_reg);
+ foreach my $dw_mbo (keys %$rh_data_words) {
+ $rh_mdc->{$dw_mbo}->{tdc}->{$cur_tdc}->{data_words_old}->[$cur_channel] = $rh_data_words->{$dw_mbo};
+ #printf "mbo: %x, dw: %d\n", $dw_mbo, $rh_data_words->{$dw_mbo};
+ #print Dumper [keys %$rh_data_words];
+ }
+
+ #printf "tdc: $cur_tdc, chan: $cur_channel, data_words_old for 0x230b, tdc 0: chan: $cur_channel: dw: %d\n",
+ #$rh_mdc->{0x230b}->{tdc}->{0}->{data_words_old}->[0];
+
+ #foreach (keys %$rh_mdc) {
+ # printf "oep: %x\n", $_;
+ # print Dumper $rh_mdc->{$_}->{tdc}->{0}->{data_words_old};
+ #}
+
+ trb_register_write(0xfffd, 0x20, 0x200);
+ select(undef, undef, undef, $MEASUREMENT_TIME);
+ #select(undef, undef, undef, 10);
+
+
+ #my $data_word_reg = $rh_mdc->{0x2000}->{tdc}->{$cur_tdc}->{data_words_register_offset}
+ # + $cur_channel;
+ $rh_data_words = trb_register_read (0xfffd, $data_word_reg);
+
+ foreach my $dw_mbo (keys %$rh_data_words) {
+ $rh_mdc->{$dw_mbo}->{tdc}->{$cur_tdc}->{data_words_new}->[$cur_channel] = $rh_data_words->{$dw_mbo};
+ }
+
+
+
+ foreach my $cur_mbo (keys %$rh_mdc) {
+
+ my $last_thr_ok;
+
+ next if (!defined $rh_mdc->{$cur_mbo}->{last_tdc} || $cur_tdc > $rh_mdc->{$cur_mbo}->{last_tdc});
+
+ #if (!exists $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{last_ok_thr}->[$cur_channel] ) {
+ # $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{last_ok_thr}->[$cur_channel] = 0xff;
+ #}
+ $last_thr_ok = $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{last_ok_thr}->[$cur_channel];
+
+ my $new = $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{data_words_new}->[$cur_channel];
+ my $old = $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{data_words_old}->[$cur_channel];
+ my $diff_of_datawords = $new - $old;
+ $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{data_words_diff}->[$cur_channel] = $diff_of_datawords;
+
+ my $current_threshold = $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{threshold}->[$cur_channel];
+
+ next if (!defined $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{thresh_step_size}->[$cur_channel]);
+ my $thresh_step_size = $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{thresh_step_size}->[$cur_channel];
+
+ #printf ("dw-diff: %d\n", $new - $old) if ($cur_mbo == 0x230b);
+ #printf "oep: %x\n", $cur_mbo;
+ #print Dumper $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{data_words_diff};
+
+
+ my $last_fulfilling_hits;;
+ my $diff_nr_triggers = 2000;
+
+ $diff_of_datawords += 0xffffffff if($diff_of_datawords < 0);
+ if ($diff_of_datawords < $LIMIT_NUM_OF_DATAWORDS * ($diff_nr_triggers) /
+ ($NOMINAL_NUM_TRIGGERS*$MEASUREMENT_TIME) ) {
+ $last_thr_ok = $current_threshold;
+ $last_fulfilling_hits = $diff_of_datawords;
+ $current_threshold = int($current_threshold - $thresh_step_size);
+ $current_threshold = 0x10 if($current_threshold <=0x10);
+
+ } else {
+ $current_threshold = int($current_threshold + $thresh_step_size);
+ $current_threshold = 0xff if($current_threshold >= 0xff);
+ }
+
+ $thresh_step_size = int ($thresh_step_size/1.5);
+ $thresh_step_size = 4 if ($thresh_step_size<2);
+
+ # save the step size
+ $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{thresh_step_size}->[$cur_channel] = $thresh_step_size;
+ $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{threshold}->[$cur_channel] = $current_threshold;
+ $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{last_ok_thr}->[$cur_channel] = $last_thr_ok;
+
+ if(defined $last_fulfilling_hits) {
+ $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{last_fulfilling_hits}->[$cur_channel] =
+ $last_fulfilling_hits;
+ }
+
+# my $tmp_mbo = 0x2001;
+# if ($cur_mbo == $tmp_mbo) {
+ my $str = sprintf ("mbo: 0x%x, tdc: %1d, chan: %2d, iteration: %2d, diff: %4d, cur_thres: 0x%2x, step_size: %2d\n", $cur_mbo, $cur_tdc, $cur_channel, $cur_iteration, $diff_of_datawords, $current_threshold, $thresh_step_size);
+ $logger->info($str);
+# }
+
+ $number_of_iterations++;
+
+ }
+
+
+ } # 10 times iteration
+
+
+ } # over all channels
+
+ foreach my $cur_mbo (keys %$rh_mdc) {
+ # turn off after scan.s
+ my $thr_addr = $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{threshold_address};
+ next if(!defined $thr_addr);
+ trb_register_write ($cur_mbo, $thr_addr, 0xff);
+ }
+
+
+} # over all tdcs
+
+foreach my $cur_tdc (0..11) {
+ foreach my $cur_channel (0..7) {
+ # loop to set thresholds
+ foreach my $cur_mbo (sort { $a <=> $b } keys %$rh_mdc) {
+
+ next if (!defined $rh_mdc->{$cur_mbo}->{last_tdc} || $cur_tdc > $rh_mdc->{$cur_mbo}->{last_tdc});
+
+ my $current_threshold = $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{threshold}->[$cur_channel];
+ next if(!defined $current_threshold);
+ my $last_hits= $rh_mdc->{$cur_mbo}->{tdc}->{$cur_tdc}->{last_fulfilling_hits}->[$cur_channel];
+
+ my $str = sprintf ("mbo: 0x%x, tdc: %.2d, channel: %.2d, thresh: 0x%.2x, num_hits: %.2d, spike: 0x%.2x",
+ $cur_mbo, $cur_tdc, $cur_channel, $current_threshold, $last_hits, $opt_reject);
+ $logger_data->info($str);
+
+ }
+ }
+}
+
+
+#print Dumper $rh_mdc;
+
+
+
+sub read_mbo_reg {
+ my ($mbo, $reg ) = @_;
+
+ my $ret_val;
+
+ my $rh_res = trb_register_read( $mbo, $reg);
+ my $res = $rh_res->{$mbo};
+ if (!defined $res) {
+ print "no result from trb_register_read\n";
+ die;
+ }
+ if ($res) {
+ $ret_val = $res;
+ } else {
+ $ret_val = 0;
+ }
+
+return $ret_val;
+}
+
+
+
+exit;
+
+
+
+exit;
+
+
+#end of main
+
+sub get_trigger_number {
+
+ my $cur_num_triggers = 0;
+ my $exit_counter = 0;
+
+ while ($cur_num_triggers == 0) {
+ #my $rh_res = trb_register_read( 0x3, 0xa000);
+ #my $res = $rh_res->{0x3};
+ my $rh_res = trb_register_read( 0x2, 0x1);
+ my $res = $rh_res->{0x2};
+
+ if(!defined $res) {
+ printf "number of triggers in CTS not reachable please fix it\n";
+ exit;
+ }
+
+ $cur_num_triggers = $res & 0xffff;
+ $exit_counter++;
+ last if ($exit_counter > 9 );
+ }
+
+ return $cur_num_triggers;
+}
+
+
+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;
+
+}
+
+
+
+
+#mdc_threshold_scan.pl <-s|--spike> [-d|--datawords=<number_of_datawords>] [-p <plane_range>|--planes=<plane_range>] [-s <sectors_range>|--sectors=<sector_range>] [-m <mbo_range>|--mbos=<mbo_range>]
+
+sub help {
+print <<EOF;
+usage:
+mdc_threshold_scan.pl |options]
+
+example:
+mdc_threshold_scan.pl --reject=0x17 --datawords=10 --planes=0,2 -p 4 --sectors=0-5 --mbos=0xe..0xf
+will run for planes 0,2,4; for sectors 0-5; for mbos 14 and 15
+
+for the chamber in the tent:
+mdc_threshold_scan.pl --planes=0 --sectors=3 --mbos=0-0xf --rejection=0x17
+
+options:
+
+mandatory:
+-r <value> |--reject=<value>
+ sets the spike rejection value:
+ 0x10 => no spike rejection
+ 0x14 => 8 ns
+ 0x15 => 13 ns
+ 0x16 => 18 ns
+ 0x17 => 23 ns
+
+-p <plane_range>|--planes=<plane_range>
+-s <sectors_range>|--sectors=<sector_range>
+-m <mbo_range>|--mbos=<mbo_range>
+
+optional:
+-d|--datawords=<number_of_datawords>
+ sets the number of data words which is the limit for the threshold to be set
+ default is 20
+
+-n|--non_mod_mbo
+ if set, the scan assumes that the long mbo is not modified, so the last two DACs
+ on the MBO can not be used. Should not be on for normal mbos.
+
+-sps|--spike_scan
+ if set, the scan will "smartly" increase the spike-rejection factor, only if the
+ found threshold is above a limit.
+
+The results of the scan are stored in a file, by default in
+data/mdc_threshold_results
+
+can be changed in the file: .logger_mdc_threshold.conf in the current directory.
+
+To analyze the file, please call
+./mdc_threshold_analyze.pl
+
+EOF
+
+exit(0);
+}
+
--- /dev/null
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+use FileHandle;
+use Data::Dumper;
+use IO::Socket;
+use Getopt::Long;
+
+use Log::Log4perl qw(get_logger);
+
+# please edit: the stuff which has to be scanned. Self explaining, counting from 0.
+my $planes = [0..0];
+my $sectors = [3];
+my $mbos = [0x0..0xf];
+
+# threshold in number of datawords; now we use 20kHz trigger rate for the scan
+my $LIMIT_NUM_OF_DATAWORDS = 20;
+
+
+# don't edit below if you are not knowing what you do...
+
+my $opt_help;
+my @opt_planes;
+my @opt_mbos;
+my @opt_sectors;
+my $opt_verb;
+my $opt_reject;
+my $opt_datawords;
+
+GetOptions ('h|help' => \$opt_help,
+ 'p|planes=s' => \@opt_planes,
+ 's|sectors=s' => \@opt_sectors,
+ 'm|mbos=s' => \@opt_mbos,
+ 'r|rejection=s' => \$opt_reject,
+ 'd|datawords=i' => \$opt_datawords,
+ 'v|verb' => \$opt_verb);
+
+
+#print Dumper \@opt_sectors;
+
+$planes = get_ranges(\@opt_planes);
+$sectors = get_ranges(\@opt_sectors);
+$mbos = get_ranges(\@opt_mbos);
+
+#print Dumper $planes;
+#print Dumper $sectors;
+#print Dumper $mbos;
+
+if( $opt_help ) {
+ &help();
+ exit(0);
+}
+
+
+if(!$opt_reject) {
+ print "error: the -r|--rejection option is mandatory.\n";
+ #&help();
+ exit(0);
+}
+
+my @allowed_reject = qw('0x10' '0x15' '0x16' '0x17');
+
+if (!grep (/$opt_reject/, @allowed_reject) ) {
+ my $str = join ",", @allowed_reject;
+ print "error: allowed rejection values are only: $str\n";
+ #&help();
+ exit();
+}
+
+
+if( $ARGV[0] || !$opt_reject || $opt_help || !@$planes || !@$sectors || !@$mbos) {
+ &help();
+ exit(0);
+}
+
+
+print "the following list of planes, sectors and mbos will be used in the given order:\n";
+print "planes: ", join(",", @$planes) ."\n";
+print "sectors: ", join(",", @$sectors) ."\n";
+print "mbos: ", join(",", @$mbos) ."\n";
+print "rejection value: $opt_reject\n";
+
+$LIMIT_NUM_OF_DATAWORDS = $opt_datawords if ($opt_datawords && $opt_datawords>=1);
+print "datawords limit: $LIMIT_NUM_OF_DATAWORDS\n";
+print "\n";
+
+# 0 => short , 1=> long motherboard
+
+my $ra_mbo_nr_to_length = [
+ [0,1,1,0,0,0,1,1,0,0,1,0,1,0,undef, undef],
+ [0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1],
+ [1,0,0,0,0,1,1,0,0,0,0,1,0,1,1,0],
+ [0,0,0,1,1,0,0,0,0,1,1,0,0,1,1,0]
+];
+
+
+#print Dumper $ra_mbo_nr_to_length;
+
+
+# addresess for short and long mbos
+my $ra_dbo_number_to_address = [
+ [ 0xa049, 0xa0cd],
+ [ 0xa04b, 0xa0cf],
+ [ 0xa04d, 0xa0d1],
+ [ 0xa04f, 0xa0d3],
+ [ undef, 0xa0d5],
+ [ undef, 0xa0d7]
+
+ ];
+
+my $ra_tdc_regs = [
+
+[0xA001, 0xA061],
+[0xA011, 0xA079],
+[0xA021, 0xA091],
+[0xA031, 0xA0A9],
+[0xA049, 0xA0CD],
+
+];
+
+#print Dumper $ra_dbo_number_to_address;
+
+
+my $ra_tdc_to_data_words_registers = [
+{ dbo => 0, offset => 0xC088 },
+{ dbo => 1, offset => 0xC090 },
+{ dbo => 0, offset => 0xC098 },
+{ dbo => 1, offset => 0xC0A0 },
+{ dbo => 2, offset => 0xC0A8 },
+{ dbo => 3, offset => 0xC0B0 },
+{ dbo => 2, offset => 0xC0B8 },
+{ dbo => 3, offset => 0xC0C0 },
+{ dbo => 4, offset => 0xC0C8 },
+{ dbo => 5, offset => 0xC0D0 },
+{ dbo => 4, offset => 0xC0D8 },
+{ dbo => 5, offset => 0xC0E0 },
+ ];
+
+#print Dumper $ra_tdc_to_data_words_registers;
+
+
+my $rh_dbo_to_offset;
+my $tdc_num = 0;
+
+
+sub remote_command {
+ my ($fh, $command) = @_;
+ my $cur_ln;
+ my @res;
+
+ #print Dumper $fh;
+ #remove trbcmd
+ $command =~s/trbcmd //;
+ #print "command to execute: $command \n";
+ my $pres = print $fh "$command\r\nx";
+
+ if(!$pres) {
+ die("error writing to trbcmd daemon. Please kill old/restart it with 'trbcmd -b tcp'\n");
+ }
+
+ if(eof($fh)) {
+ print "connection was closed by trbnet daemon.\n";
+ push @res, "Connection closed by foreign host.";
+ return \@res;
+ }
+
+ while ($cur_ln=<$fh>) {
+ next if ($cur_ln =~/^\s*$/);
+ last if ($cur_ln =~/----------------------------/);
+ chomp $cur_ln;
+ $cur_ln.="\n";
+ push @res, $cur_ln;
+ #print $cur_ln;
+
+ }
+ #if(!@res) {
+ #print "error: no result from trbcmd server for command: $command\n";
+ #}
+
+ return \@res;
+}
+
+
+## main
+
+Log::Log4perl->init(".logger_mdc_threshold.conf");
+
+my $logger = get_logger("mdc_threshold_debug.log");
+my $logger_data = get_logger("mdc_threshold_data");
+
+#restart_tdbcmd();
+
+my $remote = open_trbcmd_socket();
+
+my $cmd = q|trbcmd i 0xffff|;
+my $res = &remote_command($remote, $cmd);
+$res = &remote_command($remote, $cmd);
+#print "result of trbcmd daemon test\n";
+#print Dumper $res;
+
+if(!$res || $res->[0] eq "Connection closed by foreign host.") {
+ my $str = "trbcmd daemon did not send back data, so either the trbnet is down (DAQ-crash)
+or the trbcmd daemon is crazy (after a DAQ restart). I try a restart of the trbcmd daemon.
+If this problem persists, please check the trbnet status.";
+
+ $logger->error($str);
+ print $str . "\n";
+ &restart_trbcmd();
+ open_trbcmd_socket();
+}
+
+
+$remote = &open_trbcmd_socket();
+
+#print $remote "\n\r";
+#my $rem_res = &remote_command($remote, "r 0x2111 0");
+#print $rem_res->[0] . "\n";
+#exit;
+
+foreach my $cur_tdc (@$ra_tdc_to_data_words_registers) {
+ my $dbo = $cur_tdc->{'dbo'};
+ my $offset = $cur_tdc->{'offset'};
+# if (! defined $rh_dbo_to_offset->{$dbo}) {
+# $rh_dbo_to_offset->{$dbo} = [];
+# }
+ push @{$rh_dbo_to_offset->{$dbo}->{ra_offsets}}, $offset;
+ push @{$rh_dbo_to_offset->{$dbo}->{ra_tdcs}}, $tdc_num;
+ $tdc_num++;
+
+}
+
+#print Dumper $rh_dbo_to_offset;
+
+
+my $stop_trigger_command = q|trbcmd clearbit 0x0003 0xa0c0 0x400|;
+my $start_trigger_command = q|trbcmd setbit 0x0003 0xa0c0 0x400|;
+
+# should be 10kHz
+#my $set_pulser_10kHz_command = q|trbcmd w 0x0003 0xa0e3 0x4e20|;
+# 20kHz
+my $set_pulser_command = q|trbcmd w 0x0003 0xa0e3 0x2710|;
+
+#qx($set_pulser_10khz_command);
+&remote_command($remote, "$set_pulser_command");
+
+
+
+foreach my $cur_plane (@$planes) {
+ foreach my $cur_sector (@$sectors) {
+ foreach my $cur_mbo (@$mbos) {
+ print "currently scanning: plane $cur_plane, sector: $cur_sector, mbo: $cur_mbo\n";
+
+ my $mbo_len = $ra_mbo_nr_to_length->[$cur_plane]->[$cur_mbo];
+ if (defined $mbo_len) {
+
+ my $mbo_address = 0x2000 + 0x0100*$cur_plane + 0x0010*$cur_sector + $cur_mbo;
+
+ # 8 or 12 TDCs on the MBO
+ my $num_of_tdc_on_mbo = $mbo_len ? 11 : 7;
+
+ my $str= "plane: $cur_plane , sector: $cur_sector, mbo: " .
+ sprintf ("%2.2d", $cur_mbo) .
+ ", length: $mbo_len, " .
+ sprintf ("mbo_address 0x%x , ", $mbo_address) .
+ "num_tdcs $num_of_tdc_on_mbo";
+
+ $logger->info($str);
+
+ foreach my $cur_tdc (0..$num_of_tdc_on_mbo) {
+
+ # turn off spike rejection
+ my $spike_address = $ra_tdc_regs->[0]->[$mbo_len];
+ $spike_address += 2*$cur_tdc;
+ my $spike_command;
+ $spike_command = sprintf "trbcmd w 0x%x 0x%x $opt_reject",
+ $mbo_address, $spike_address;
+ my $res = &remote_command($remote, $spike_command);
+ print @$res;
+ #exit;
+
+ foreach my $cur_channel (0..7) {
+ my $dbo_number = $ra_tdc_to_data_words_registers->[$cur_tdc]->{dbo};
+ my $data_words_register = $ra_tdc_to_data_words_registers->[$cur_tdc]->{offset} + $cur_channel;
+
+ my $threshold_address = $ra_dbo_number_to_address->[$dbo_number]->[$mbo_len];
+
+ my $str = sprintf (" tdc_num: %2.2d, ", $cur_tdc) .
+ "channel: $cur_channel, dbo_num: $dbo_number, ";
+ $logger->info($str);
+ $str = sprintf ("data_words_reg = 0x%x, threshold_address = 0x%x \n",
+ $data_words_register, $threshold_address);
+ $logger->info($str);
+ #print $str . "\n";
+
+ # input mask register is in line 3
+ my $tdc_mask_address = $ra_tdc_regs->[3]->[$mbo_len];
+ $tdc_mask_address += 2 * $cur_tdc;
+ my $mask = 1<<$cur_channel;
+
+ $mask = 0xff;
+ my $tdc_mask_command;
+ $tdc_mask_command = sprintf "trbcmd w 0x%x 0x%x 0x%x",
+ $mbo_address, $tdc_mask_address, $mask;
+ #print "exec: $tdc_mask_command\n";
+ my $res = &remote_command($remote, $tdc_mask_command);
+ #print "result of command: \n";
+ print @$res;
+
+
+ my $current_threshold = 0xa0;
+ my $number_of_datawords=0;
+ my $diff_of_datawords = 0;
+ my $thres_step_size = 0x40;
+ my $last_fulfilling_threshold = $current_threshold;
+ my $last_fulfilling_hits = 0;
+
+ #print "start loop\n";
+# while ($number_of_datawords < $LIMIT_NUM_OF_DATAWORDS) {
+ my $number_of_iterations = 0;
+ while ($number_of_iterations <=10) {
+
+ my $command_read_data_words;
+ my $command;
+ my $res;
+
+
+ $command = sprintf "trbcmd w 0x%x 0x%x 0x%x",
+ $mbo_address, $threshold_address, $current_threshold;
+ $res = &remote_command($remote, $command);
+ print @$res;
+
+ $command = sprintf "trbcmd w 0x%x 0x20 0x200", $mbo_address;
+ $res = &remote_command($remote, $command);
+ print @$res;
+
+
+ $command_read_data_words = sprintf "trbcmd r 0x%x 0x%x",
+ $mbo_address, $data_words_register;
+ $res = &remote_command($remote, $command_read_data_words);
+ #print @$res;
+
+ if($res->[0] =~/WARNING/ || $res->[0] =~/ERROR/) {
+ die("motherboard not reachable, please fix it");
+ }
+
+ my $cur_num_data_words;
+ my $old_num_data_words;
+
+
+ ($cur_num_data_words) = $res->[0] =~/\w+\s+(\w+)/;
+ #print " current num_datawords: $cur_num_data_words\n";
+ $old_num_data_words = $cur_num_data_words;
+
+
+ #print " sleep 1\n";
+ select(undef, undef, undef, 0.1);
+ #sleep 1;
+
+ $res = &remote_command($remote, $command_read_data_words);
+ if(!defined $res) {
+ print "no result from trbcmd. Command sent: $command_read_data_words, communication problem?\n";
+ }
+ #print $res;
+ ($cur_num_data_words) = $res->[0] =~/\w+\s+(\w+)/;
+
+ #print " current num_datawords: $cur_num_data_words\n";
+
+ $diff_of_datawords = hex($cur_num_data_words) - hex($old_num_data_words);
+ my $str = sprintf " diff in data words = %4.1d at threshold: 0x%.2x\n",
+ $diff_of_datawords , $current_threshold;
+ $logger->info($str);
+ #print $str;
+
+ if ($diff_of_datawords < $LIMIT_NUM_OF_DATAWORDS) {
+ $last_fulfilling_threshold = $current_threshold;
+ $last_fulfilling_hits = $diff_of_datawords;
+ $current_threshold = int($current_threshold - $thres_step_size);
+ $current_threshold = 0x10 if($current_threshold <=0x10);
+
+ }
+ else {
+ $current_threshold = int($current_threshold + $thres_step_size);
+ $current_threshold = 0xff if($current_threshold >= 0xff);
+ }
+ $thres_step_size = int ($thres_step_size/1.5);
+ $thres_step_size = 4 if ($thres_step_size<2);
+
+ $number_of_iterations++;
+
+ } # end of while 1
+
+ my $thr_res = sprintf "mbo: 0x%x, tdc: %2.2d, channel: %2.2d, thresh: 0x%.2x, num_hits: %.1d\n", $mbo_address, $cur_tdc, $cur_channel, $last_fulfilling_threshold, $last_fulfilling_hits;
+ $logger->info($thr_res);
+ $logger_data->info($thr_res);
+ #print $thr_res;
+
+ #printf " last fulfilling threshold: 0x%x\n", $last_fulfilling_threshold;
+
+
+
+
+ } # end of loop over all channels of one TDC
+
+ # turn on spike rejection
+
+ #$spike_command = sprintf "trbcmd w 0x%x 0x%x 0x15",
+ # $mbo_address, $spike_address;
+ #print " command: $spike_command\n";
+ #$res = &remote_command($remote, $spike_command);
+ #print @$res;
+
+
+
+ } # end of loop over all tdcs
+ } #end if defined $mbo_len
+
+ }
+ }
+}
+
+
+exit;
+
+
+#end of main
+
+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 restart_trbcmd {
+
+ #trbcmd -b tcp doesn't survive a restart of the DAQ, so it also
+ #has to be restarted.
+ my $trbcmd_restart = q|pgrep -f -n "trbcmd -b tcp"|;
+ my $tres = qx($trbcmd_restart);
+ #print $tres;
+ chomp $tres;
+ $trbcmd_restart = qq|kill $tres; trbcmd -b tcp|;
+ $tres = qx($trbcmd_restart);
+
+}
+
+
+
+sub open_trbcmd_socket {
+ my $remote = IO::Socket::INET->new(
+ Proto => "tcp",
+ PeerAddr => "localhost",
+ PeerPort => "55555",
+ ) || die "can't connect to trbcm daemon on port 55555 on localhost";
+
+ return $remote;
+}
+
+
+#mdc_threshold_scan.pl <-s|--spike> [-d|--datawords=<number_of_datawords>] [-p <plane_range>|--planes=<plane_range>] [-s <sectors_range>|--sectors=<sector_range>] [-m <mbo_range>|--mbos=<mbo_range>]
+
+sub help {
+print "usage:
+mdc_threshold_scan.pl |options]
+
+example:
+
+mdc_threshold_scan.pl --reject=0x17 --datawords=10 --planes=0,2 -p 4 --sectors=0-5 --mbos=0xe..0xf
+
+will run for planes 0,2,4; for sectors 0-5; for mbos 14 and 15
+
+for the chamber in the tent:
+
+mdc_threshold_scan.pl --planes=0 --sectors=3 --mbos=0-0xf --rejection=0x17
+
+
+options:
+
+mandatory:
+-r <value> |--reject=<value>
+ sets the spike rejection value:
+ 0x10 => no spike rejection
+ 0x14 => 8 ns
+ 0x15 => 13 ns
+ 0x16 => 18 ns
+ 0x17 => 23 ns
+
+-p <plane_range>|--planes=<plane_range>
+-s <sectors_range>|--sectors=<sector_range>
+-m <mbo_range>|--mbos=<mbo_range>
+
+
+
+optional:
+-d|--datawords=<number_of_datawords>
+ sets the number of data words which is the limit for the threshold to be set
+ default is 20
+
+The results of the scan are stored in a file, by default in
+data/mdc_threshold_results
+
+can be changed in the file: .logger_mdc_threshold.conf in the current directory.
+
+To analyze the file, please call
+./mdc_threshold_analyze.pl
+";
+
+exit(0);
+}
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+my $spike = "0x10";
+
+foreach my $p (0..3) {
+ foreach my $s (0..5) {
+ #my $c = "./mdc_threshold_scan.pl --planes=$p --sector=$s --mbos=0-0xf --rejection=$spike &";
+ my $c = "./mdc_threshold_scan.pl --planes=$p --sector=$s --mbos=0-0xf --rejection=$spike --spike_scan --max_reasonable_threshold=0x60 &";
+ system($c);
+ }
+}
+
+
+#./mdc_threshold_scan2.pl --planes=0 --sector=3 --mbos=0-0xf --rejection=0x17
jspc29 / hadesdaq.git / commitdiff