From 413df65f9692cba8118dfb2b07961a388d328cd9 Mon Sep 17 00:00:00 2001 From: hadaq Date: Wed, 8 Feb 2012 14:18:47 +0000 Subject: [PATCH] test --- libtrbnet_perl/TrbNet.xs | 61 ++++++++++-------------------- libtrbnet_perl/lib/HADES/TrbNet.pm | 39 ++++++++----------- libtrbnet_perl/test/test.pl | 32 +++++++--------- 3 files changed, 50 insertions(+), 82 deletions(-) diff --git a/libtrbnet_perl/TrbNet.xs b/libtrbnet_perl/TrbNet.xs index e131b52..2e29632 100644 --- a/libtrbnet_perl/TrbNet.xs +++ b/libtrbnet_perl/TrbNet.xs @@ -17,20 +17,20 @@ PROTOTYPES: ENABLE SV* -trb_errnum() +trb_errno() CODE: RETVAL = newSViv(trb_errno); OUTPUT: RETVAL void -trb_err() +trb_error() CODE: trb_error("trb_error"); SV* -trb_errStr() +trb_strerror() CODE: RETVAL = newSVpv(trb_strerror(), 0); OUTPUT: @@ -49,31 +49,34 @@ init_ports() } void -trb_rr(trb_address, reg_address) - U16 trb_address - U16 reg_address +trb_register_read_c(trb_address, reg_address) + U16 trb_address; + U16 reg_address; INIT: int status; int i; - + PPCODE: - status = trb_register_read(trb_address,reg_address, buffer, 2); + status = trb_register_read(trb_address, reg_address, buffer, BUFFER_SIZE); if (status <= 0) { XSRETURN_UNDEF; - } - XPUSHs(sv_2mortal(newSVuv(buffer[1]))); - + for (i = 0 ; i < status; i++) { + XPUSHs(sv_2mortal(newSVuv(buffer[i]))); + } + void -trb_ra(trb_address, reg_address) +trb_register_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_register_read(trb_address,reg_address, buffer, BUFFER_SIZE); + status = trb_register_read_mem(trb_address, reg_address, option, size, buffer, BUFFER_SIZE); if (status <= 0) { XSRETURN_UNDEF; } @@ -82,23 +85,22 @@ trb_ra(trb_address, reg_address) } void -trb_wr(trb_address, reg_address, value) +trb_register_write(trb_address, reg_address, value) U16 trb_address U16 reg_address U32 value INIT: int status; - int i; PPCODE: - status = trb_register_write(trb_address,reg_address, value); - if (i != -1) { + status = trb_register_write(trb_address, reg_address, value); + if (status != -1) { XSRETURN_UNDEF; } XPUSHs(sv_2mortal(newSVuv(buffer[1]))); void -trb_uid_c(trb_address) +trb_read_uid_c(trb_address) U16 trb_address INIT: int status; @@ -113,26 +115,3 @@ trb_uid_c(trb_address) for (i = 0 ; i < status; i++) { XPUSHs(sv_2mortal(newSVuv(buffer[i]))); } - - - -SV* -trb_hash_c() - INIT: - HV * rh; - CODE: - - - rh = (HV *)sv_2mortal((SV *)newHV()); - hv_store(rh, "newSVuv", 10, newSVuv(100), 0); - hv_store(rh, "duda", 10, newSVuv(200), 0); - hv_store(rh, "halloaa", 6, newSVnv(100), 0); - hv_store(rh, "dudads", 4, newSVnv(200), 0); - hv_store(rh, "hallosd", 6, newSVnv(100), 0); - hv_store(rh, "dudadsa", 4, newSVnv(200), 0); - hv_store(rh, "halloads", 6, newSVnv(100), 0); - hv_store(rh, "dudadwa", 4, newSVnv(200), 0); - - RETVAL = newRV((HV *)rh); - OUTPUT: - RETVAL diff --git a/libtrbnet_perl/lib/HADES/TrbNet.pm b/libtrbnet_perl/lib/HADES/TrbNet.pm index e38c890..7a238da 100644 --- a/libtrbnet_perl/lib/HADES/TrbNet.pm +++ b/libtrbnet_perl/lib/HADES/TrbNet.pm @@ -17,15 +17,17 @@ 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_errnum - trb_err - trb_errStr + trb_errno + trb_error + trb_strerror init_ports - trb_rr - trb_ra - trb_wr - trb_uid - trb_hash + 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 ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); @@ -41,21 +43,17 @@ XSLoader::load('HADES::TrbNet', $VERSION); # Preloaded methods go here. - -sub trb_hash { +sub trb_register_read { my ($trb_address, $register_address) = @_; - my @a = trb_ra($trb_address, $register_address); + my @a = trb_register_read_c($trb_address, $register_address); my %h; - #print Dumper %h; %h = @a; return \%h; - } -sub trb_uid { +sub trb_read_uid { my ($trb_address) = @_; - my @res = trb_uid_c($trb_address); - + my @res = trb_read_uid_c($trb_address); my $rh; for (my $k = 0; $k < scalar @res; $k += 4) { @@ -63,19 +61,14 @@ sub trb_uid { my $endP = $res[$k + 2]; my $sender = $res[$k + 3]; - $rh->{$uid}->{'trb_addr'} = $sender; - $rh->{$uid}->{'trb_endpoint_nr'} = $endP; + $rh->{$uid}->{'trb_address'} = $sender; + $rh->{$uid}->{'trb_endpoint'} = $endP; } - #my %h; - #print Dumper %h; - #%h = @a; return $rh; - } - 1; __END__ # Below is stub documentation for your module. You'd better edit it! diff --git a/libtrbnet_perl/test/test.pl b/libtrbnet_perl/test/test.pl index 939d6f4..687d27c 100755 --- a/libtrbnet_perl/test/test.pl +++ b/libtrbnet_perl/test/test.pl @@ -2,35 +2,31 @@ use warnings; use strict; use Data::Dumper; -#use Data::HexDump; -use HADES::TrbNet; # qw(trb_uid init_ports trb_err trb_errnum trb_hash); +use HADES::TrbNet qw(trb_read_uid init_ports trb_error trb_errno trb_strerror trb_register_read trb_read_uid); -init_ports() or die "Failed init_ports: ", trb_errStr(); +init_ports() or die "Failed init_ports: ", trb_strerror(); my @a = (); my $rh_hash; -foreach (1..1) { - $rh_hash = trb_hash(0xffff, 0x0); - push @a, $rh_hash; -} -#print Dumper $rh_hash; -foreach my $cur_key (keys %$rh_hash) { -# printf "addr: 0x%04x: 0x%08x\n", $cur_key, $rh_hash->{$cur_key}; -} -#print %$rh_hash; +# Read all UIDs +my $res = trb_read_uid(0xfffb); +foreach my $cur_key (sort {$a <=> $b } keys %$res) { + printf "uid: 0x%016x ==> addr: 0x%04x: endpoint: 0x%02x\n", $cur_key, + $res->{$cur_key}->{'trb_address'}, $res->{$cur_key}->{'trb_endpoint'} ; +} -#exit 0; +#print Dumper $res; +# Read ADCM's by mem +my $res = trb_register_read(0xfffb, 0xa000) or die "Failed register_raid: ", trb_strerror(); -my $res = trb_uid(0xfffb); foreach my $cur_key (sort {$a <=> $b } keys %$res) { - printf "uid: 0x%016x ==> addr: 0x%08x: endpoint: 0x%02x\n", $cur_key, - $res->{$cur_key}->{'trb_addr'}, $res->{$cur_key}->{'trb_endpoint_nr'} ; + printf "address: 0x%04x ==> value: 0x%08x\n", $cur_key, + $res->{$cur_key}; } - - #print Dumper $res; + exit; -- 2.43.0