From: hadaq Date: Thu, 29 Mar 2012 19:30:31 +0000 (+0000) Subject: added functions trb_registertime_read and trb_registertime_read_mem, L.M. X-Git-Tag: v6.0~52 X-Git-Url: https://jspc29.x-matter.uni-frankfurt.de/git/?a=commitdiff_plain;h=b507df564f745d7e0b2f68ab764cc5f6982a0682;p=trbnettools.git added functions trb_registertime_read and trb_registertime_read_mem, L.M. --- diff --git a/libtrbnet_perl/MYMETA.yml b/libtrbnet_perl/MYMETA.yml new file mode 100644 index 0000000..fbd0d24 --- /dev/null +++ b/libtrbnet_perl/MYMETA.yml @@ -0,0 +1,22 @@ +--- +abstract: 'Perl extension for the libtrbnet library, also via RPC calls' +author: + - 'Hades DAQ ' +build_requires: + ExtUtils::MakeMaker: 0 +configure_requires: + ExtUtils::MakeMaker: 0 +distribution_type: module +dynamic_config: 0 +generated_by: 'ExtUtils::MakeMaker version 6.57_05' +license: unknown +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 +name: HADES-TrbNet +no_index: + directory: + - t + - inc +requires: {} +version: 0.01 diff --git a/libtrbnet_perl/TrbNet.xs b/libtrbnet_perl/TrbNet.xs index 49f9775..d3eac6d 100644 --- a/libtrbnet_perl/TrbNet.xs +++ b/libtrbnet_perl/TrbNet.xs @@ -65,6 +65,23 @@ trb_register_read_c(trb_address, reg_address) XPUSHs(sv_2mortal(newSVuv(buffer[i]))); } +void +trb_registertime_read_c(trb_address, reg_address) + U16 trb_address; + U16 reg_address; + INIT: + int status; + int i; + + PPCODE: + status = trb_registertime_read(trb_address, reg_address, (uint32_t*)buffer, BUFFER_SIZE); + if (status <= 0) { + XSRETURN_UNDEF; + } + for (i = 0 ; i < status; i++) { + XPUSHs(sv_2mortal(newSVuv(buffer[i]))); + } + void trb_register_read_mem_c(trb_address, reg_address, option, size) U16 trb_address; @@ -84,6 +101,25 @@ trb_register_read_mem_c(trb_address, reg_address, option, size) XPUSHs(sv_2mortal(newSVuv(buffer[i]))); } +void +trb_registertime_read_mem_c(trb_address, reg_address, option, size) + U16 trb_address; + U16 reg_address; + U16 option; + U16 size; + INIT: + int status; + int i; + + PPCODE: + status = trb_registertime_read_mem(trb_address, reg_address, option, size, (uint32_t*)buffer, BUFFER_SIZE); + if (status <= 0) { + XSRETURN_UNDEF; + } + for (i = 0 ; i < status; i++) { + XPUSHs(sv_2mortal(newSVuv(buffer[i]))); + } + void trb_register_write(trb_address, reg_address, value) U16 trb_address diff --git a/libtrbnet_perl/lib/HADES/TrbNet.pm b/libtrbnet_perl/lib/HADES/TrbNet.pm index 9118d17..51108cc 100644 --- a/libtrbnet_perl/lib/HADES/TrbNet.pm +++ b/libtrbnet_perl/lib/HADES/TrbNet.pm @@ -17,20 +17,24 @@ our @ISA = qw(Exporter); # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK # will save memory. our %EXPORT_TAGS = ( 'all' => [ qw( - trb_errno - trb_error - trb_strerror - trb_init_ports - trb_register_read - trb_register_read_c - trb_register_read_mem - trb_register_read_mem_c - trb_register_write - trb_read_uid - trb_read_uid_c - trb_nettrace - trb_nettrace_c -) ] ); + trb_errno + trb_error + trb_strerror + trb_init_ports + trb_register_read + trb_registertime_read + trb_register_read_c + trb_registertime_read_c + trb_register_read_mem + trb_registertime_read_mem + trb_register_read_mem_c + trb_registertime_read_mem_c + trb_register_write + trb_read_uid + trb_read_uid_c + trb_nettrace + trb_nettrace_c + ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); @@ -44,70 +48,113 @@ XSLoader::load('HADES::TrbNet', $VERSION); # Preloaded methods go her sub trb_register_read { - my ($trb_address, $register_address) = @_; - my @res = trb_register_read_c($trb_address, $register_address); - return if (! defined $res[0]); + my ($trb_address, $register_address) = @_; + my @res = trb_register_read_c($trb_address, $register_address); + return if (! defined $res[0]); + + my %hash; + %hash = @res; + return \%hash; +} + +sub trb_registertime_read { + my ($trb_address, $register_address) = @_; + my @res = trb_registertime_read_c($trb_address, $register_address); + return if (! defined $res[0]); + + my %hash; + my $len_array = scalar @res; + for (my $i = 0; ($i + 3) <= $len_array; $i += 3) { + my $trb_address = $res[$i] & 0xffff; + $hash{$trb_address}->{'value'} = $res[$i + 1]; + $hash{$trb_address}->{'time'} = $res[$i + 2]; + } - my %hash; - %hash = @res; - return \%hash; + return \%hash; } sub trb_register_read_mem { - my ($trb_address, $register_address, $option, $size) = @_; - my @res = trb_register_read_mem_c($trb_address, $register_address, - $option, $size); - return if (! defined $res[0]); - - my %hash; - my $k = 0; - my $len_array = scalar @res; - while ($k < $len_array) { - my $len = ($res[$k] >> 16) & 0xffff; - my $trb_address = $res[$k] & 0xffff; - my @array; - $k++; - - for (my $i = 0; $i < $len ; $i++, $k++) { - push (@array, $res[$k]); - } - $hash{$trb_address} = \@array; + my ($trb_address, $register_address, $option, $size) = @_; + my @res = trb_register_read_mem_c($trb_address, $register_address, + $option, $size); + return if (! defined $res[0]); + + my %hash; + my $k = 0; + my $len_array = scalar @res; + while ($k < $len_array) { + my $len = ($res[$k] >> 16) & 0xffff; + my $trb_address = $res[$k] & 0xffff; + my @array; + $k++; + + for (my $i = 0; $i < $len ; $i++, $k++) { + push (@array, $res[$k]); } + $hash{$trb_address} = \@array; + } - return \%hash; + return \%hash; } -sub trb_read_uid { - my ($trb_address) = @_; - my @res = trb_read_uid_c($trb_address); - return if (! defined $res[0]); - - my %hash; - for (my $k = 0; $k < scalar @res; $k += 4) { - my $uid = ($res[$k] << 32) | $res[$k + 1]; - my $endP = $res[$k + 2]; - my $sender = $res[$k + 3]; - - $hash{$uid}->{'trb_address'} = $sender; - $hash{$uid}->{'trb_endpoint'} = $endP; +sub trb_registertime_read_mem { + my ($trb_address, $register_address, $option, $size) = @_; + my @res = trb_registertime_read_mem_c($trb_address, $register_address, + $option, $size); + return if (! defined $res[0]); + + my %hash; + my $k = 0; + my $len_array = scalar @res; + while ($k < $len_array) { + my $len = ($res[$k] >> 16) & 0xffff; + my $trb_address = $res[$k] & 0xffff; + my @array_val; + my @array_time; + $k++; + + for (my $i = 0; ($i < $len) && (($k + 1) < $len_array); $i++, $k += 2) { + push (@array_val, $res[$k]); + push (@array_time, $res[$k + 1]); } + $hash{$trb_address}->{'value'} = \@array_val; + $hash{$trb_address}->{'time'} = \@array_time; + } - return \%hash; + return \%hash; } -sub trb_nettrace { - my ($trb_address) = @_; - my @res = trb_nettrace_c($trb_address); - return if (! defined $res[0]); +sub trb_read_uid { + my ($trb_address) = @_; + my @res = trb_read_uid_c($trb_address); + return if (! defined $res[0]); - my @array; - my $c = 0; - for (my $i = 0; $i < scalar @res; $i += 2) { - $array[$c]->{'address'} = $res[$i]; - $array[$c]->{'port'} = $res[$i + 1]; - $c++; - } - return \@array; + my %hash; + for (my $k = 0; $k < scalar @res; $k += 4) { + my $uid = ($res[$k] << 32) | $res[$k + 1]; + my $endP = $res[$k + 2]; + my $sender = $res[$k + 3]; + + $hash{$uid}->{'trb_address'} = $sender; + $hash{$uid}->{'trb_endpoint'} = $endP; + } + + return \%hash; +} + +sub trb_nettrace { + my ($trb_address) = @_; + my @res = trb_nettrace_c($trb_address); + return if (! defined $res[0]); + + my @array; + my $c = 0; + for (my $i = 0; $i < scalar @res; $i += 2) { + $array[$c]->{'address'} = $res[$i]; + $array[$c]->{'port'} = $res[$i + 1]; + $c++; + } + return \@array; } 1; diff --git a/libtrbnet_perl/test/test_readtime.pl b/libtrbnet_perl/test/test_readtime.pl new file mode 100755 index 0000000..016aef9 --- /dev/null +++ b/libtrbnet_perl/test/test_readtime.pl @@ -0,0 +1,24 @@ +#!/usr/bin/perl +use warnings; +use strict; +use Data::Dumper; + +use HADES::TrbNet; + +trb_init_ports() or die "Failed trb_init_ports: ", trb_strerror(); + +my $ref; + +$ref = trb_registertime_read(0xffff, 0x0) or die "trb_registertime_read: ", + trb_strerror(); + +print Dumper $ref; + +$ref = trb_registertime_read_mem(0x8001, 0x4031, 0, 5) or die "trb_registertime_read_mem: ", + trb_strerror(); + +print Dumper $ref; + + +exit; +