From: hadaq Date: Fri, 3 Feb 2012 00:46:22 +0000 (+0000) Subject: cuurent but unstable X-Git-Tag: v6.0~75 X-Git-Url: https://jspc29.x-matter.uni-frankfurt.de/git/?a=commitdiff_plain;h=d4bc26d617a81c2063227f4201545ba01bf63d37;p=trbnettools.git cuurent but unstable --- diff --git a/libtrbnet_perl/Makefile.PL b/libtrbnet_perl/Makefile.PL index 8cc79ca..0969c91 100644 --- a/libtrbnet_perl/Makefile.PL +++ b/libtrbnet_perl/Makefile.PL @@ -10,6 +10,7 @@ WriteMakefile( ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/HADES/TrbNet.pm', # retrieve abstract from module AUTHOR => 'Hades DAQ ') : ()), + DESTDIR => '/home/hadaq/depp', INC => '-I../libtrbnet', DEFINE => '', LIBS => '-L../trbnetd -ltrbnet', diff --git a/libtrbnet_perl/TrbNet.xs b/libtrbnet_perl/TrbNet.xs index 4cb88b5..e131b52 100644 --- a/libtrbnet_perl/TrbNet.xs +++ b/libtrbnet_perl/TrbNet.xs @@ -2,32 +2,137 @@ #include #include #include +#include #include +#include + +static size_t BUFFER_SIZE = 4194304; +static U32 buffer[4194304]; /* file : TrbNet.xs */ MODULE = HADES::TrbNet PACKAGE = HADES::TrbNet PROTOTYPES: ENABLE + +SV* +trb_errnum() + CODE: + RETVAL = newSViv(trb_errno); + OUTPUT: + RETVAL + +void +trb_err() + CODE: + trb_error("trb_error"); + + +SV* +trb_errStr() + CODE: + RETVAL = newSVpv(trb_strerror(), 0); + OUTPUT: + RETVAL + int init_ports() - + INIT: + int status; + PPCODE: + status = init_ports(); + if (status < 0) { + XSRETURN_UNDEF; + } else { + XPUSHs(sv_2mortal(newSVuv(1))); + } + void -trb_uid(trb_address) +trb_rr(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); + if (status <= 0) { + XSRETURN_UNDEF; + + } + XPUSHs(sv_2mortal(newSVuv(buffer[1]))); + +void +trb_ra(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, BUFFER_SIZE); + if (status <= 0) { + XSRETURN_UNDEF; + } + for (i = 0 ; i < status; i++) { + XPUSHs(sv_2mortal(newSVuv(buffer[i]))); + } + +void +trb_wr(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) { + XSRETURN_UNDEF; + } + XPUSHs(sv_2mortal(newSVuv(buffer[1]))); + +void +trb_uid_c(trb_address) U16 trb_address INIT: - static U32 buf2[1024 * 4]; int status; int i; PPCODE: i = 0; - status = trb_read_uid(trb_address, (U32 *)&buf2, 1024 * 4); + status = trb_read_uid(trb_address, buffer, BUFFER_SIZE); if (status <= 0) { XSRETURN_UNDEF; - return; } for (i = 0 ; i < status; i++) { - XPUSHs(sv_2mortal(newSVnv(buf2[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 e3a9b06..e38c890 100644 --- a/libtrbnet_perl/lib/HADES/TrbNet.pm +++ b/libtrbnet_perl/lib/HADES/TrbNet.pm @@ -3,6 +3,7 @@ package HADES::TrbNet; use 5.010000; use strict; use warnings; +use Data::Dumper; require Exporter; @@ -16,14 +17,21 @@ 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 init_ports + trb_rr + trb_ra + trb_wr trb_uid + trb_hash ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw( - +trb_uid init_ports trb_err trb_errnum trb_hash ); our $VERSION = '0.01'; @@ -33,6 +41,41 @@ XSLoader::load('HADES::TrbNet', $VERSION); # Preloaded methods go here. + +sub trb_hash { + my ($trb_address, $register_address) = @_; + my @a = trb_ra($trb_address, $register_address); + my %h; + #print Dumper %h; + %h = @a; + return \%h; + +} + +sub trb_uid { + my ($trb_address) = @_; + my @res = trb_uid_c($trb_address); + + my $rh; + + 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]; + + $rh->{$uid}->{'trb_addr'} = $sender; + $rh->{$uid}->{'trb_endpoint_nr'} = $endP; + } + + #my %h; + #print Dumper %h; + #%h = @a; + return $rh; + +} + + + 1; __END__ # Below is stub documentation for your module. You'd better edit it! @@ -46,7 +89,7 @@ HADES::TrbNet - Perl extension for the libtrbnet library, also via RPC calls #!/usr/bin/perl use warnings; use strict; - use HADES::TrbNet qw(trb_rr trb_wr init_ports); + use HADES::TrbNet qw(trb_rr trb_wr init_ports trb_strerror); my $connect_status = &init_ports(); my @res; my $res; diff --git a/libtrbnet_perl/test/test.pl b/libtrbnet_perl/test/test.pl index 9456e28..939d6f4 100755 --- a/libtrbnet_perl/test/test.pl +++ b/libtrbnet_perl/test/test.pl @@ -4,16 +4,33 @@ use strict; use Data::Dumper; #use Data::HexDump; -use HADES::TrbNet qw(trb_uid init_ports); +use HADES::TrbNet; # qw(trb_uid init_ports trb_err trb_errnum trb_hash); -my $connect_status = init_ports(); +init_ports() or die "Failed init_ports: ", trb_errStr(); -my @res = trb_uid(0xffff); +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; + +#exit 0; -#print Dumper \@res; -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]; - printf "0x%04x 0x%016x 0x%02x\n", $sender, $uid , $endP; + +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'} ; } + + +#print Dumper $res; +exit; +