From a71380843c51ee9fdc518c757e75e405f67fc8e3 Mon Sep 17 00:00:00 2001 From: HADES hadaq Date: Fri, 18 Oct 2013 13:16:08 +0200 Subject: [PATCH] added few more files --- control/gui/daq/10_Start_DAQ | 2 +- hmon/start.sh | 6 +- utils/cts_oscilloscope | 2 + utils/mdc_calibration_masks.pl | 24 + utils/mdc_threshold_analyze.pl | 239 +++++++++ utils/mdc_threshold_scan.pl | 546 +++++++++++++++++++++ utils/mdc_threshold_scan2.pl | 588 +++++++++++++++++++++++ utils/mdc_threshold_scan_orig_trbnetd.pl | 538 +++++++++++++++++++++ utils/mdc_threshold_scan_whole_mdc.pl | 17 + 9 files changed, 1960 insertions(+), 2 deletions(-) create mode 100755 utils/cts_oscilloscope create mode 100755 utils/mdc_calibration_masks.pl create mode 100755 utils/mdc_threshold_analyze.pl create mode 100755 utils/mdc_threshold_scan.pl create mode 100755 utils/mdc_threshold_scan2.pl create mode 100755 utils/mdc_threshold_scan_orig_trbnetd.pl create mode 100755 utils/mdc_threshold_scan_whole_mdc.pl diff --git a/control/gui/daq/10_Start_DAQ b/control/gui/daq/10_Start_DAQ index 16d4681..4d716ac 100755 --- a/control/gui/daq/10_Start_DAQ +++ b/control/gui/daq/10_Start_DAQ @@ -8,7 +8,7 @@ if [ $myvar == "256" ]; then exit; fi 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 \" Connected to lxhadesdaq...\" echo \" Starting DAQ with default settings...\" cd /home/hadaq/trbsoft/daq/main/ diff --git a/hmon/start.sh b/hmon/start.sh index d0e7cf5..48d3797 100755 --- a/hmon/start.sh +++ b/hmon/start.sh @@ -1,5 +1,5 @@ #!/bin/bash -↓ + #Mount RAM file system #mount -t tmpfs none /var/spool/ramdisk -o size=256m @@ -22,6 +22,10 @@ cd /home/hadaq/trbsoft/daq/tools/hmon/ # 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 diff --git a/utils/cts_oscilloscope b/utils/cts_oscilloscope new file mode 100755 index 0000000..66e319a --- /dev/null +++ b/utils/cts_oscilloscope @@ -0,0 +1,2 @@ +rdesktop hadvm04.gsi.de -g 1500x950 -k de -uscs -phadesctrl + diff --git a/utils/mdc_calibration_masks.pl b/utils/mdc_calibration_masks.pl new file mode 100755 index 0000000..58358b3 --- /dev/null +++ b/utils/mdc_calibration_masks.pl @@ -0,0 +1,24 @@ +#!/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); + } diff --git a/utils/mdc_threshold_analyze.pl b/utils/mdc_threshold_analyze.pl new file mode 100755 index 0000000..d6b462d --- /dev/null +++ b/utils/mdc_threshold_analyze.pl @@ -0,0 +1,239 @@ +#!/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 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 | --offset= + 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 + +"; + +} diff --git a/utils/mdc_threshold_scan.pl b/utils/mdc_threshold_scan.pl new file mode 100755 index 0000000..9be4c82 --- /dev/null +++ b/utils/mdc_threshold_scan.pl @@ -0,0 +1,546 @@ +#!/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=] [-p |--planes=] [-s |--sectors=] [-m |--mbos=] + +sub help { +print < |--reject= + sets the spike rejection value: + 0x10 => no spike rejection + 0x14 => 8 ns + 0x15 => 13 ns + 0x16 => 18 ns + 0x17 => 23 ns + +-p |--planes= +-s |--sectors= +-m |--mbos= + +optional: +-d|--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); +} + diff --git a/utils/mdc_threshold_scan2.pl b/utils/mdc_threshold_scan2.pl new file mode 100755 index 0000000..a68ba4c --- /dev/null +++ b/utils/mdc_threshold_scan2.pl @@ -0,0 +1,588 @@ +#!/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=] [-p |--planes=] [-s |--sectors=] [-m |--mbos=] + +sub help { +print < |--reject= + sets the spike rejection value: + 0x10 => no spike rejection + 0x14 => 8 ns + 0x15 => 13 ns + 0x16 => 18 ns + 0x17 => 23 ns + +-p |--planes= +-s |--sectors= +-m |--mbos= + +optional: +-d|--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); +} + diff --git a/utils/mdc_threshold_scan_orig_trbnetd.pl b/utils/mdc_threshold_scan_orig_trbnetd.pl new file mode 100755 index 0000000..da429c9 --- /dev/null +++ b/utils/mdc_threshold_scan_orig_trbnetd.pl @@ -0,0 +1,538 @@ +#!/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=] [-p |--planes=] [-s |--sectors=] [-m |--mbos=] + +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 |--reject= + sets the spike rejection value: + 0x10 => no spike rejection + 0x14 => 8 ns + 0x15 => 13 ns + 0x16 => 18 ns + 0x17 => 23 ns + +-p |--planes= +-s |--sectors= +-m |--mbos= + + + +optional: +-d|--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); +} diff --git a/utils/mdc_threshold_scan_whole_mdc.pl b/utils/mdc_threshold_scan_whole_mdc.pl new file mode 100755 index 0000000..4af91ac --- /dev/null +++ b/utils/mdc_threshold_scan_whole_mdc.pl @@ -0,0 +1,17 @@ +#!/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 -- 2.43.0