+++ /dev/null
-#!/usr/bin/perl -w
-use warnings;
-use FileHandle;
-use Time::HiRes qw( usleep );
-use Data::Dumper;
-use HADES::TrbNet;
-
-
-if(!$ARGV[0]) {
- print "usage: dac_program.pl <filename of configuration file> [offset]\n\n";
- print "The optional offset introduces an additional offset to the values read from the config file.\n";
- print "Example config file:\n";
- print "# Board Chain ChainLen DAC Channel Command Value\n";
- print " f300 1 1 0 0 3 0x3456\n";
- print " f300 1 1 0 1 3 12300\n";
- print " f300 1 1 0 2 3 0xa123\n";
- print "!Reference 2500\n";
- print " f300 1 1 0 3 3 1345 #=0x89ba\n";
- exit;
- }
-
-if (!defined &trb_init_ports()) {
- die("can not connect to trbnet-daemon on the $ENV{'DAQOPSERVER'}");
-}
-
-my $fh;
-open $fh, "$ARGV[0]" or die $!."\nFile '$ARGV[0]' not found.";
-
-my $offset = 0;
-if (defined $ARGV[1]) {
- $offset = $ARGV[1];
- }
-
-my $reference = 2**16;
-
-while (my $a = <$fh>) {
- next if($a=~/^\s*#/);
-
- $a=~s/#.*//;
- if(my ($ref) = $a =~ /^\s*!Reference\s+(\w+)/i) {
- $ref = hex(substr($ref,2)) if (substr($ref,0,2) eq "0x");
- $reference = $ref * 1.;
-# print $reference."\n";
- }
-
- if(my ($board,$chain,$chainlen,$dac,$chan,$cmd,$val) = $a =~ /^\s*(\w\w\w\w)\s+(\w+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\w)\s+(\w+)/) {
- $val = hex(substr($val,2)) if (substr($val,0,2) eq "0x");
- $chain = hex(substr($chain,2)) if (substr($chain,0,2) eq "0x");
- $cmd = hex($cmd);
- $board = hex($board);
-
- if ($val+$offset >= $reference || $val+$offset < 0) {
- printf(STDERR "Error, value %i with offset %i is higher or lower than reference %i\n",$val,$offset,$reference);
- next;
- }
-
- $o = $cmd << 20;
- $o |= $chan << 16;
- $o |= (($val*1.+$offset)/$reference*65536.) & 0xFFFF;
-
- my @values;
- foreach my $i (0..15) {
- $values[$i] = 0x00F00000;
- }
- $values[16] = $chain;
- $values[17] = $chainlen;
- $values[$chainlen-1-$dac] = $o;
-# print Dumper @values;
- trb_register_write_mem($board,0xd400,0,\@values,18) or die "trb_register_write_mem: ", trb_strerror();
- usleep(5*$chainlen);
- }
- }
--- /dev/null
+tools/dac_program.pl
\ No newline at end of file
+++ /dev/null
-#!/usr/bin/perl
-
-use warnings;
-use strict;
-
-use Data::Dumper;
-use HADES::TrbNet;
-
-my $fn1 = $ARGV[0];
-my $fn2 = $ARGV[1];
-
-&usage if (!$fn1 || !$fn2);
-
-# check input
-
-open my $fh1, "<", $fn1 or die "could not open $fn1: $!";
-open my $fh2, "<", $fn2 or die "could not open $fn2, $!";
-
-
-trb_init_ports() or die trb_strerror();
-
-my %trb;
-foreach my $cur_ln (<$fh1>) {
- next if($cur_ln =~ /^\s*#/ or $cur_ln =~ /^\s*$/);
- (my $serial_nr, my $uid) = $cur_ln =~ /(\d+)\s+(\w+)/;
- next if (!defined $serial_nr);
- $serial_nr = int($serial_nr);
- $trb{$serial_nr}->{'uid'} = $uid;
-}
-
-#print Dumper \%trb;
-
-foreach my $cur_ln (<$fh2>) {
- next if($cur_ln =~ /^\s*#/ or $cur_ln =~ /^\s*$/);
- (my $address, my $sernr1, my $sernr2) = $cur_ln =~ /(\w+)\s+(\d+)\s+(\d+)/;
- my $serial_nr = $sernr1*10 + $sernr2;
- next if (!defined $serial_nr);
- $trb{$serial_nr}->{'address'} = hex($address);
- $trb{$serial_nr}->{'endpoint_nr'} = $sernr2;
-}
-
-
-#print Dumper \%trb;
-
-
-foreach my $serial_nr (keys %trb) {
- next if(!$trb{$serial_nr}->{'address'} || !defined $trb{$serial_nr}->{'uid'});
- printf "0x%4.4x ", $trb{$serial_nr}->{'address'};
- print $trb{$serial_nr}->{'uid'} . " ";
- printf "0x%2.2x\n", $trb{$serial_nr}->{'endpoint_nr'};
-
- no warnings 'portable';
- my $uid = hex($trb{$serial_nr}->{'uid'});
- use warnings 'portable';
-
- my $ref = trb_set_address($uid, $trb{$serial_nr}->{'endpoint_nr'} , $trb{$serial_nr}->{'address'});
-
-}
-
-
-exit;
-
-sub usage {
- print <<EOF;
-usage:
-merge_serial_address.pl <serials.db> <address.db>
-
-EOF
-
-exit;
-}
--- /dev/null
+tools/merge_serial_address.pl
\ No newline at end of file
+++ /dev/null
-#!/usr/bin/perl -w
-use warnings;
-use FileHandle;
-use Time::HiRes qw( usleep );
-use Data::Dumper;
-use HADES::TrbNet;
-use Date::Format;
-
-if(!defined $ENV{'DAQOPSERVER'}) {
- die "DAQOPSERVER not set in environment";
-}
-
-if (!defined &trb_init_ports()) {
- die("can not connect to trbnet-daemon on the $ENV{'DAQOPSERVER'}");
-}
-
-
-if(!(defined $ARGV[0]) || !(defined $ARGV[1]) || !(defined $ARGV[2])) {
- print "usage: padiwa.pl \$FPGA \$chain \$command \$options\n\n";
- print "\t uid \t\t read unique ID, no options\n";
- print "\t time \t\t read compile time. no options\n";
- print "\t temp \t\t read temperature, no options\n";
- print "\t resettemp \t resets the 1-wire logic\n";
- print "\t dac \t\t set LTC-DAC value. options: \$channel, \$value\n";
- print "\t pwm \t\t set PWM value. options: \$channel, \$value\n";
- print "\t \t\t read PWM value. options: \$channel\n";
- print "\t disable \t set input diable. options: \$mask\n";
- print "\t \t\t read input disable. no options\n";
- print "\t input \t\t read input status. no options\n";
- print "\t invert \t set invert status. options: \$mask\n";
- print "\t \t\t read invert status. no options\n";
- print "\t led \t\t set led status. options: mask (5 bit, highest bit is override enable)\n";
- print "\t \t\t read LED status. no options\n";
- print "\t monitor \t set input for monitor output. options: mask (4 bit). \n\t\t\t 0x10: OR of all channels, 0x18: or of all channels, extended to 16ns\n";
- print "\t \t\t read monitor selection. no options\n";
- print "\t stretch \t set stretcher status.\n";
- print "\t \t\t read stretcher status. no options\n";
- print "\t ram \t\t writes the RAM content, options: 16 byte in hex notation, separated by space, no 0x.\n";
- print "\t \t\t read the RAM content (16 Byte)\n";
- print "\t flash \t\t execute flash command, options: \$command, \$page. See manual for commands.\n";
- print "\t enablecfg\t enable or disable access to configuration flash, options: 1/0\n";
- print "\t dumpcfg \t Dump content of configuration flash. Pipe output to file\n";
- print "\t writecfg \t Write content of configuration flash. options: \$filename\n";
-
- exit;
- }
-my $board, my $value, my $mask;
-
-($board) = $ARGV[0] =~ /^0?x?(\w+)/;
-$board = hex($board);
-
-my $chain = hex($ARGV[1]);
-
-if (defined $ARGV[3] && $ARGV[2] ne "writecfg") {
- ($mask) = $ARGV[3] =~ /^0?x?(\w+)/;
- $mask = hex($mask) if defined $mask;
- }
-
-if (defined $ARGV[4]) {
- ($value) = $ARGV[4] =~ /^0?x?(\w+)/;
- $value = hex($value);
- }
-
-
-sub sendcmd16 {
- my @cmd = @_;
- my $c = [@cmd,1<<$chain,16+0x80];
-# print Dumper $c;
- trb_register_write_mem($board,0xd400,0,$c,scalar @{$c});
- usleep(1000);
- }
-
-sub sendcmd {
- my ($cmd) = @_;
- my $c = [$cmd,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1<<$chain,1];
- trb_register_write_mem($board,0xd400,0,$c,scalar @{$c});
-# trb_register_write($board,0xd410,1<<$chain) or die "trb_register_write: ", trb_strerror();
-# trb_register_write($board,0xd411,1);
- usleep(1000);
- return trb_register_read($board,0xd412);
- }
-
-
-
-
-if($ARGV[2] eq "temp") {
- my $b = sendcmd(0x10040000);
- foreach my $e (sort keys %$b) {
- printf("0x%04x\t%d\t%2.1f\n",$e,$chain,($b->{$e}&0xfff)/16);
- }
- }
-
-if($ARGV[2] eq "resettemp") {
- sendcmd(0x10800001);
- usleep(100000);
- sendcmd(0x10800001);
- }
-
-
-
-if($ARGV[2] eq "uid") {
- my $ids;
- for(my $i = 0; $i <= 3; $i++) {
- my $b = sendcmd(0x10000000 + $i*0x10000);
- foreach my $e (sort keys %$b) {
- $ids->{$e}->{$i} = $b->{$e}&0xffff;
- }
- }
- foreach my $e (sort keys %$ids) {
- printf("0x%04x\t%d\t0x%04x%04x%04x%04x\n",$e,$chain,$ids->{$e}->{3},$ids->{$e}->{2},$ids->{$e}->{1},$ids->{$e}->{0});
- }
- }
-
-if($ARGV[2] eq "dac" && defined $ARGV[4]) {
- my $b = sendcmd(0x00300000+$ARGV[3]*0x10000+($value&0xffff));
- print "Wrote PWM settings.\n";
- }
-
-if($ARGV[2] eq "pwm" && defined $ARGV[4]) {
- my $b = sendcmd(0x00800000+$ARGV[3]*0x10000+($value&0xffff));
- print "Wrote PWM settings.\n";
- }
-
-if($ARGV[2] eq "pwm") {
- my $b = sendcmd(0x00000000+$ARGV[3]*0x10000);
- foreach my $e (sort keys %$b) {
- printf("0x%04x\t%d\t%d\t0x%04x\t%4.2f\n",$e,$chain,$ARGV[3],$b->{$e}&0xffff,($b->{$e}&0xffff)*3300/65536);
- }
- }
-
-
-if($ARGV[2] eq "disable" && defined $ARGV[3]) {
- my $b = sendcmd(0x20800000+($mask&0xffff));
- print "Wrote Input Disable settings.\n";
- }
-
-if($ARGV[2] eq "disable") {
- my $b = sendcmd(0x20000000);
- foreach my $e (sort keys %$b) {
- printf("0x%04x\t%d\t0x%04x\n",$e,$chain,$b->{$e}&0xffff);
- }
- }
-
-
-if($ARGV[2] eq "invert" && defined $ARGV[3]) {
- my $b = sendcmd(0x20840000+($mask&0xffff));
- print "Wrote Input Invert settings.\n";
- }
-
-if($ARGV[2] eq "invert") {
- my $b = sendcmd(0x20040000);
- foreach my $e (sort keys %$b) {
- printf("0x%04x\t%d\t0x%04x\n",$e,$chain,$b->{$e}&0xffff);
- }
- }
-
-
-if($ARGV[2] eq "stretch" && defined $ARGV[3]) {
- my $b = sendcmd(0x20850000+($mask&0xffff));
- print "Wrote Input Stretcher settings.\n";
- }
-
-if($ARGV[2] eq "stretch") {
- my $b = sendcmd(0x20050000);
- foreach my $e (sort keys %$b) {
- printf("0x%04x\t%d\t0x%04x\n",$e,$chain,$b->{$e}&0xffff);
- }
- }
-
-if($ARGV[2] eq "input") {
- my $b = sendcmd(0x20010000);
- foreach my $e (sort keys %$b) {
- printf("0x%04x\t%d\t0x%04x\n",$e,$chain,$b->{$e}&0xffff);
- }
- }
-
-if($ARGV[2] eq "led" && defined $ARGV[3]) {
- my $b = sendcmd(0x20820000+($mask&0xffff));
- print "Wrote LED settings.\n";
- }
-
-if($ARGV[2] eq "led") {
- my $b = sendcmd(0x20020000);
- foreach my $e (sort keys %$b) {
- printf("0x%04x\t%d\t0x%04x\n",$e,$chain,$b->{$e}&0x1f);
- }
- }
-
-
-if($ARGV[2] eq "monitor" && defined $ARGV[3]) {
- my $b = sendcmd(0x20830000+($mask&0x1f));
- print "Wrote monitor settings.\n";
- }
-
-if($ARGV[2] eq "monitor") {
- my $b = sendcmd(0x20030000);
- foreach my $e (sort keys %$b) {
- printf("0x%04x\t%d\t0x%04x\n",$e,$chain,$b->{$e}&0x1f);
- }
- }
-
-if($ARGV[2] eq "time") {
- my $ids;
- for(my $i = 0; $i <= 1; $i++) {
- my $b = sendcmd(0x21000000 + $i*0x10000);
- foreach my $e (sort keys %$b) {
- $ids->{$e}->{$i} = $b->{$e}&0xffff;
- }
- }
- foreach my $e (sort keys %$ids) {
- printf("0x%04x\t%d\t0x%04x%04x\t%s\n",$e,$chain,$ids->{$e}->{1},$ids->{$e}->{0},time2str('%Y-%m-%d %H:%M',($ids->{$e}->{1}*2**16+$ids->{$e}->{0})));
- }
- }
-
-if($ARGV[2] eq "ram" && defined $ARGV[18]) {
- my @a;
- for(my $i=0;$i<16;$i++) {
- push(@a,0x40800000+hex($ARGV[3+$i])+($i << 16));
- }
- sendcmd16(@a);
- printf("Wrote RAM\n");
- }
-
-if($ARGV[2] eq "ram") {
- for(my $i=0;$i<16;$i++) {
- my $b = sendcmd(0x40000000 + ($i << 16));
- foreach my $e (sort keys %$b) {
- printf(" %02x ",$b->{$e}&0xff);
- }
- }
- printf("\n");
- }
-
-if($ARGV[2] eq "flash" && defined $ARGV[4]) {
- my $c = 0x50800000+(($mask&0xe)<< 12)+($value&0x1fff);
- my $b = sendcmd($c);
- printf("Sent command\n");
- }
-
-if($ARGV[2] eq "dumpcfg") {
- for(my $p = 0; $p<5760; $p++) { #5758
- sendcmd(0x50800000 + $p);
- printf("0x%04x:\t",$p);
- for(my $i=0;$i<16;$i++) {
- my $b = sendcmd(0x40000000 + ($i << 16));
- foreach my $e (sort keys %$b) {
- printf(" %02x ",$b->{$e}&0xff);
- }
- }
- printf("\n");
- printf(STDERR "\r%d / 5760",$p) if(!($p%10));
- }
- }
-
-if($ARGV[2] eq "enablecfg" && defined $ARGV[3]) {
- my $c = 0x5C800000 + $ARGV[3];
- my $b = sendcmd($c);
- printf("Sent command.\n");
- }
-
-if($ARGV[2] eq "writecfg" && defined $ARGV[3]) {
- open(INF,$ARGV[3]) or die "Couldn't read file : $!\n";
- my $p = 0;
- while(my $s = <INF>) {
- my @t = split(' ',$s);
- my @a;
- for(my $i=0;$i<16;$i++) {
- push(@a,0x40800000 + (hex($t[$i+1]) & 0xff) + ($i << 16));
- }
- sendcmd16(@a);
- sendcmd(0x50804000 + $p);
- $p++;
- printf(STDERR "\r%d / 5760",$p) if(!($p%10));
- }
- }
\ No newline at end of file
--- /dev/null
+tools/padiwa.pl
\ No newline at end of file
--- /dev/null
+#!/usr/bin/perl -w
+use warnings;
+use FileHandle;
+use Time::HiRes qw( usleep );
+use Data::Dumper;
+use HADES::TrbNet;
+
+
+if(!$ARGV[0]) {
+ print "usage: dac_program.pl <filename of configuration file> [offset]\n\n";
+ print "The optional offset introduces an additional offset to the values read from the config file.\n";
+ print "Example config file:\n";
+ print "# Board Chain ChainLen DAC Channel Command Value\n";
+ print " f300 1 1 0 0 3 0x3456\n";
+ print " f300 1 1 0 1 3 12300\n";
+ print " f300 1 1 0 2 3 0xa123\n";
+ print "!Reference 2500\n";
+ print " f300 1 1 0 3 3 1345 #=0x89ba\n";
+ exit;
+ }
+
+if (!defined &trb_init_ports()) {
+ die("can not connect to trbnet-daemon on the $ENV{'DAQOPSERVER'}");
+}
+
+my $fh;
+open $fh, "$ARGV[0]" or die $!."\nFile '$ARGV[0]' not found.";
+
+my $offset = 0;
+if (defined $ARGV[1]) {
+ $offset = $ARGV[1];
+ }
+
+my $reference = 2**16;
+
+while (my $a = <$fh>) {
+ next if($a=~/^\s*#/);
+
+ $a=~s/#.*//;
+ if(my ($ref) = $a =~ /^\s*!Reference\s+(\w+)/i) {
+ $ref = hex(substr($ref,2)) if (substr($ref,0,2) eq "0x");
+ $reference = $ref * 1.;
+# print $reference."\n";
+ }
+
+ if(my ($board,$chain,$chainlen,$dac,$chan,$cmd,$val) = $a =~ /^\s*(\w\w\w\w)\s+(\w+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\w)\s+(\w+)/) {
+ $val = hex(substr($val,2)) if (substr($val,0,2) eq "0x");
+ $chain = hex(substr($chain,2)) if (substr($chain,0,2) eq "0x");
+ $cmd = hex($cmd);
+ $board = hex($board);
+
+ if ($val+$offset >= $reference || $val+$offset < 0) {
+ printf(STDERR "Error, value %i with offset %i is higher or lower than reference %i\n",$val,$offset,$reference);
+ next;
+ }
+
+ $o = $cmd << 20;
+ $o |= $chan << 16;
+ $o |= (($val*1.+$offset)/$reference*65536.) & 0xFFFF;
+
+ my @values;
+ foreach my $i (0..15) {
+ $values[$i] = 0x00F00000;
+ }
+ $values[16] = $chain;
+ $values[17] = $chainlen;
+ $values[$chainlen-1-$dac] = $o;
+# print Dumper @values;
+ trb_register_write_mem($board,0xd400,0,\@values,18) or die "trb_register_write_mem: ", trb_strerror();
+ usleep(5*$chainlen);
+ }
+ }
--- /dev/null
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use Data::Dumper;
+use HADES::TrbNet;
+
+my $fn1 = $ARGV[0];
+my $fn2 = $ARGV[1];
+
+&usage if (!$fn1 || !$fn2);
+
+# check input
+
+open my $fh1, "<", $fn1 or die "could not open $fn1: $!";
+open my $fh2, "<", $fn2 or die "could not open $fn2, $!";
+
+
+trb_init_ports() or die trb_strerror();
+
+my %trb;
+foreach my $cur_ln (<$fh1>) {
+ next if($cur_ln =~ /^\s*#/ or $cur_ln =~ /^\s*$/);
+ (my $serial_nr, my $uid) = $cur_ln =~ /(\d+)\s+(\w+)/;
+ next if (!defined $serial_nr);
+ $serial_nr = int($serial_nr);
+ $trb{$serial_nr}->{'uid'} = $uid;
+}
+
+#print Dumper \%trb;
+
+foreach my $cur_ln (<$fh2>) {
+ next if($cur_ln =~ /^\s*#/ or $cur_ln =~ /^\s*$/);
+ (my $address, my $sernr1, my $sernr2) = $cur_ln =~ /(\w+)\s+(\d+)\s+(\d+)/;
+ my $serial_nr = $sernr1*10 + $sernr2;
+ next if (!defined $serial_nr);
+ $trb{$serial_nr}->{'address'} = hex($address);
+ $trb{$serial_nr}->{'endpoint_nr'} = $sernr2;
+}
+
+
+#print Dumper \%trb;
+
+
+foreach my $serial_nr (keys %trb) {
+ next if(!$trb{$serial_nr}->{'address'} || !defined $trb{$serial_nr}->{'uid'});
+ printf "0x%4.4x ", $trb{$serial_nr}->{'address'};
+ print $trb{$serial_nr}->{'uid'} . " ";
+ printf "0x%2.2x\n", $trb{$serial_nr}->{'endpoint_nr'};
+
+ no warnings 'portable';
+ my $uid = hex($trb{$serial_nr}->{'uid'});
+ use warnings 'portable';
+
+ my $ref = trb_set_address($uid, $trb{$serial_nr}->{'endpoint_nr'} , $trb{$serial_nr}->{'address'});
+
+}
+
+
+exit;
+
+sub usage {
+ print <<EOF;
+usage:
+merge_serial_address.pl <serials.db> <address.db>
+
+EOF
+
+exit;
+}
--- /dev/null
+#!/usr/bin/perl -w
+use warnings;
+use FileHandle;
+use Time::HiRes qw( usleep );
+use Data::Dumper;
+use HADES::TrbNet;
+use Date::Format;
+
+if(!defined $ENV{'DAQOPSERVER'}) {
+ die "DAQOPSERVER not set in environment";
+}
+
+if (!defined &trb_init_ports()) {
+ die("can not connect to trbnet-daemon on the $ENV{'DAQOPSERVER'}");
+}
+
+
+if(!(defined $ARGV[0]) || !(defined $ARGV[1]) || !(defined $ARGV[2])) {
+ print "usage: padiwa.pl \$FPGA \$chain \$command \$options\n\n";
+ print "\t uid \t\t read unique ID, no options\n";
+ print "\t time \t\t read compile time. no options\n";
+ print "\t temp \t\t read temperature, no options\n";
+ print "\t resettemp \t resets the 1-wire logic\n";
+ print "\t dac \t\t set LTC-DAC value. options: \$channel, \$value\n";
+ print "\t pwm \t\t set PWM value. options: \$channel, \$value\n";
+ print "\t \t\t read PWM value. options: \$channel\n";
+ print "\t disable \t set input diable. options: \$mask\n";
+ print "\t \t\t read input disable. no options\n";
+ print "\t input \t\t read input status. no options\n";
+ print "\t invert \t set invert status. options: \$mask\n";
+ print "\t \t\t read invert status. no options\n";
+ print "\t led \t\t set led status. options: mask (5 bit, highest bit is override enable)\n";
+ print "\t \t\t read LED status. no options\n";
+ print "\t monitor \t set input for monitor output. options: mask (4 bit). \n\t\t\t 0x10: OR of all channels, 0x18: or of all channels, extended to 16ns\n";
+ print "\t \t\t read monitor selection. no options\n";
+ print "\t stretch \t set stretcher status.\n";
+ print "\t \t\t read stretcher status. no options\n";
+ print "\t ram \t\t writes the RAM content, options: 16 byte in hex notation, separated by space, no 0x.\n";
+ print "\t \t\t read the RAM content (16 Byte)\n";
+ print "\t flash \t\t execute flash command, options: \$command, \$page. See manual for commands.\n";
+ print "\t enablecfg\t enable or disable access to configuration flash, options: 1/0\n";
+ print "\t dumpcfg \t Dump content of configuration flash. Pipe output to file\n";
+ print "\t writecfg \t Write content of configuration flash. options: \$filename\n";
+
+ exit;
+ }
+my $board, my $value, my $mask;
+
+($board) = $ARGV[0] =~ /^0?x?(\w+)/;
+$board = hex($board);
+
+my $chain = hex($ARGV[1]);
+
+if (defined $ARGV[3] && $ARGV[2] ne "writecfg") {
+ ($mask) = $ARGV[3] =~ /^0?x?(\w+)/;
+ $mask = hex($mask) if defined $mask;
+ }
+
+if (defined $ARGV[4]) {
+ ($value) = $ARGV[4] =~ /^0?x?(\w+)/;
+ $value = hex($value);
+ }
+
+
+sub sendcmd16 {
+ my @cmd = @_;
+ my $c = [@cmd,1<<$chain,16+0x80];
+# print Dumper $c;
+ trb_register_write_mem($board,0xd400,0,$c,scalar @{$c});
+ usleep(1000);
+ }
+
+sub sendcmd {
+ my ($cmd) = @_;
+ my $c = [$cmd,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1<<$chain,1];
+ trb_register_write_mem($board,0xd400,0,$c,scalar @{$c});
+# trb_register_write($board,0xd410,1<<$chain) or die "trb_register_write: ", trb_strerror();
+# trb_register_write($board,0xd411,1);
+ usleep(1000);
+ return trb_register_read($board,0xd412);
+ }
+
+
+
+
+if($ARGV[2] eq "temp") {
+ my $b = sendcmd(0x10040000);
+ foreach my $e (sort keys %$b) {
+ printf("0x%04x\t%d\t%2.1f\n",$e,$chain,($b->{$e}&0xfff)/16);
+ }
+ }
+
+if($ARGV[2] eq "resettemp") {
+ sendcmd(0x10800001);
+ usleep(100000);
+ sendcmd(0x10800001);
+ }
+
+
+
+if($ARGV[2] eq "uid") {
+ my $ids;
+ for(my $i = 0; $i <= 3; $i++) {
+ my $b = sendcmd(0x10000000 + $i*0x10000);
+ foreach my $e (sort keys %$b) {
+ $ids->{$e}->{$i} = $b->{$e}&0xffff;
+ }
+ }
+ foreach my $e (sort keys %$ids) {
+ printf("0x%04x\t%d\t0x%04x%04x%04x%04x\n",$e,$chain,$ids->{$e}->{3},$ids->{$e}->{2},$ids->{$e}->{1},$ids->{$e}->{0});
+ }
+ }
+
+if($ARGV[2] eq "dac" && defined $ARGV[4]) {
+ my $b = sendcmd(0x00300000+$ARGV[3]*0x10000+($value&0xffff));
+ print "Wrote PWM settings.\n";
+ }
+
+if($ARGV[2] eq "pwm" && defined $ARGV[4]) {
+ my $b = sendcmd(0x00800000+$ARGV[3]*0x10000+($value&0xffff));
+ print "Wrote PWM settings.\n";
+ }
+
+if($ARGV[2] eq "pwm") {
+ my $b = sendcmd(0x00000000+$ARGV[3]*0x10000);
+ foreach my $e (sort keys %$b) {
+ printf("0x%04x\t%d\t%d\t0x%04x\t%4.2f\n",$e,$chain,$ARGV[3],$b->{$e}&0xffff,($b->{$e}&0xffff)*3300/65536);
+ }
+ }
+
+
+if($ARGV[2] eq "disable" && defined $ARGV[3]) {
+ my $b = sendcmd(0x20800000+($mask&0xffff));
+ print "Wrote Input Disable settings.\n";
+ }
+
+if($ARGV[2] eq "disable") {
+ my $b = sendcmd(0x20000000);
+ foreach my $e (sort keys %$b) {
+ printf("0x%04x\t%d\t0x%04x\n",$e,$chain,$b->{$e}&0xffff);
+ }
+ }
+
+
+if($ARGV[2] eq "invert" && defined $ARGV[3]) {
+ my $b = sendcmd(0x20840000+($mask&0xffff));
+ print "Wrote Input Invert settings.\n";
+ }
+
+if($ARGV[2] eq "invert") {
+ my $b = sendcmd(0x20040000);
+ foreach my $e (sort keys %$b) {
+ printf("0x%04x\t%d\t0x%04x\n",$e,$chain,$b->{$e}&0xffff);
+ }
+ }
+
+
+if($ARGV[2] eq "stretch" && defined $ARGV[3]) {
+ my $b = sendcmd(0x20850000+($mask&0xffff));
+ print "Wrote Input Stretcher settings.\n";
+ }
+
+if($ARGV[2] eq "stretch") {
+ my $b = sendcmd(0x20050000);
+ foreach my $e (sort keys %$b) {
+ printf("0x%04x\t%d\t0x%04x\n",$e,$chain,$b->{$e}&0xffff);
+ }
+ }
+
+if($ARGV[2] eq "input") {
+ my $b = sendcmd(0x20010000);
+ foreach my $e (sort keys %$b) {
+ printf("0x%04x\t%d\t0x%04x\n",$e,$chain,$b->{$e}&0xffff);
+ }
+ }
+
+if($ARGV[2] eq "led" && defined $ARGV[3]) {
+ my $b = sendcmd(0x20820000+($mask&0xffff));
+ print "Wrote LED settings.\n";
+ }
+
+if($ARGV[2] eq "led") {
+ my $b = sendcmd(0x20020000);
+ foreach my $e (sort keys %$b) {
+ printf("0x%04x\t%d\t0x%04x\n",$e,$chain,$b->{$e}&0x1f);
+ }
+ }
+
+
+if($ARGV[2] eq "monitor" && defined $ARGV[3]) {
+ my $b = sendcmd(0x20830000+($mask&0x1f));
+ print "Wrote monitor settings.\n";
+ }
+
+if($ARGV[2] eq "monitor") {
+ my $b = sendcmd(0x20030000);
+ foreach my $e (sort keys %$b) {
+ printf("0x%04x\t%d\t0x%04x\n",$e,$chain,$b->{$e}&0x1f);
+ }
+ }
+
+if($ARGV[2] eq "time") {
+ my $ids;
+ for(my $i = 0; $i <= 1; $i++) {
+ my $b = sendcmd(0x21000000 + $i*0x10000);
+ foreach my $e (sort keys %$b) {
+ $ids->{$e}->{$i} = $b->{$e}&0xffff;
+ }
+ }
+ foreach my $e (sort keys %$ids) {
+ printf("0x%04x\t%d\t0x%04x%04x\t%s\n",$e,$chain,$ids->{$e}->{1},$ids->{$e}->{0},time2str('%Y-%m-%d %H:%M',($ids->{$e}->{1}*2**16+$ids->{$e}->{0})));
+ }
+ }
+
+if($ARGV[2] eq "ram" && defined $ARGV[18]) {
+ my @a;
+ for(my $i=0;$i<16;$i++) {
+ push(@a,0x40800000+hex($ARGV[3+$i])+($i << 16));
+ }
+ sendcmd16(@a);
+ printf("Wrote RAM\n");
+ }
+
+if($ARGV[2] eq "ram") {
+ for(my $i=0;$i<16;$i++) {
+ my $b = sendcmd(0x40000000 + ($i << 16));
+ foreach my $e (sort keys %$b) {
+ printf(" %02x ",$b->{$e}&0xff);
+ }
+ }
+ printf("\n");
+ }
+
+if($ARGV[2] eq "flash" && defined $ARGV[4]) {
+ my $c = 0x50800000+(($mask&0xe)<< 12)+($value&0x1fff);
+ my $b = sendcmd($c);
+ printf("Sent command\n");
+ }
+
+if($ARGV[2] eq "dumpcfg") {
+ for(my $p = 0; $p<5760; $p++) { #5758
+ sendcmd(0x50800000 + $p);
+ printf("0x%04x:\t",$p);
+ for(my $i=0;$i<16;$i++) {
+ my $b = sendcmd(0x40000000 + ($i << 16));
+ foreach my $e (sort keys %$b) {
+ printf(" %02x ",$b->{$e}&0xff);
+ }
+ }
+ printf("\n");
+ printf(STDERR "\r%d / 5760",$p) if(!($p%10));
+ }
+ }
+
+if($ARGV[2] eq "enablecfg" && defined $ARGV[3]) {
+ my $c = 0x5C800000 + $ARGV[3];
+ my $b = sendcmd($c);
+ printf("Sent command.\n");
+ }
+
+if($ARGV[2] eq "writecfg" && defined $ARGV[3]) {
+ open(INF,$ARGV[3]) or die "Couldn't read file : $!\n";
+ my $p = 0;
+ while(my $s = <INF>) {
+ my @t = split(' ',$s);
+ my @a;
+ for(my $i=0;$i<16;$i++) {
+ push(@a,0x40800000 + (hex($t[$i+1]) & 0xff) + ($i << 16));
+ }
+ sendcmd16(@a);
+ sendcmd(0x50804000 + $p);
+ $p++;
+ printf(STDERR "\r%d / 5760",$p) if(!($p%10));
+ }
+ }
\ No newline at end of file
jspc29 / daqtools.git / commitdiff