# HG changeset patch # User Heiko Schlittermann # Date 1231277619 -3600 # Node ID 6acf8ea44e0a386a090f4f9a0c806c0426007e52 # Parent a6bc8818d069e8c96734143979ac4a3399737f3f set() works. Testserver: implented "R" now. diff -r a6bc8818d069 -r 6acf8ea44e0a examples/client --- a/examples/client Tue Jan 06 15:07:03 2009 +0100 +++ b/examples/client Tue Jan 06 22:33:39 2009 +0100 @@ -12,9 +12,11 @@ my $q = new Quancom $ARGV[0]; my $r; + $q->set(1, 8 => 1)->ok or die $q->last_result->error_message; + $q->set(2, 64 => 1)->ok or die $q->last_result->error_message; # reset - $q->full_reset->ok or die $q->last_result->error_message; + $q->full_reset->ok or warn "err: " . $q->last_result->error_message . "\n"; # does not work #$q->cmd("RB 0007")->ok or die $q->last_result->error_message; diff -r a6bc8818d069 -r 6acf8ea44e0a lib/Quancom.pm --- a/lib/Quancom.pm Tue Jan 06 15:07:03 2009 +0100 +++ b/lib/Quancom.pm Tue Jan 06 22:33:39 2009 +0100 @@ -81,9 +81,28 @@ $self->cmd("WB 0007 00"); } +sub set { + my $self = shift; + my $value = pop @_ ? 1 : 0; + my @bits = map { $_ - 1 } @_; + my @groups = map { 0 } 0 .. 7; + + # input is a list of bits to set and the value (0/1) + # we'll map it to SX 0100 xx.xx.xx.xx xx.xx.xx.xx + foreach (@bits) { + my $group = int($_ / 8); + my $bit = $_ % 8; + $groups[$group] |= (1 << $bit); + } + $_ = "SX 0100 " . join "", map { sprintf "%02x ", $_ } reverse @groups; + $self->cmd($_); +} + sub set_timeout { my $self = shift; - my $to = shift; + my $to = shift; + + carp "setting timeouts does not work!"; # timeout 3 (2.8s) # [__--.-___] @@ -134,6 +153,7 @@ local $/ = "\r"; # CR is the delimiter local $_ = $self->{socket}->getline; + # chomp; warn "<<$_>>\n"; return $self->{last_result} = new Quancom::Result($_); } diff -r a6bc8818d069 -r 6acf8ea44e0a lib/Quancom/Result.pm --- a/lib/Quancom/Result.pm Tue Jan 06 15:07:03 2009 +0100 +++ b/lib/Quancom/Result.pm Tue Jan 06 22:33:39 2009 +0100 @@ -59,11 +59,13 @@ sub error_message { my $self = shift; + my $e = @_ ? shift : $self->{error_code}; return undef if !@_ and $self->{ok}; + return "unknown error" if not defined $e or $e > 3; return +("checksum error", "character error", "invalid command", - "invalid width")[ defined $_[0] ? $_[0] : $self->{error_code} ]; + "invalid width")[$e]; } 1; diff -r a6bc8818d069 -r 6acf8ea44e0a lib/Quancom/Test/Server.pm --- a/lib/Quancom/Test/Server.pm Tue Jan 06 15:07:03 2009 +0100 +++ b/lib/Quancom/Test/Server.pm Tue Jan 06 22:33:39 2009 +0100 @@ -34,6 +34,7 @@ character => "E1", command => "E2", width => "E3", + internal => "E4", # non offical ); sub new { @@ -123,7 +124,7 @@ chomp $l; $l = $self->_process($l); $c->print($l . "\r"); - $self->show; + $self->show; } } return; @@ -133,7 +134,7 @@ while (<>) { chomp; print $self->_process($_), "\n"; - $self->show; + $self->show; } } @@ -170,9 +171,14 @@ : $width eq "X" ? 8 # 64 bit : 0; - my @data = reverse ($data =~ /(..)/g); # msb + my @data = reverse($data =~ /(..)/g); # msb my $offset = $addr - 0x100; + if ($addr < 0x100) { + carp "writing to registers <= 0x100 not supported\n"; + return $ERROR{internal}; + } + if ($cmd eq "W") { return $ERROR{width} if @data != $width; @@ -182,20 +188,27 @@ } if ($cmd =~ /^[SC]$/) { - # currently restricted to 4 byte (32bit) - return $ERROR{command} if $width != 4; - return $ERROR{width} if @data != 4; + + # currently restricted to 4 and 8 byte (32 and 64bit) + return $ERROR{command} if not($width == 4 or $width == 8); + return $ERROR{width} if not(@data == 4 or @data == 8); foreach (@{ $self->{outputs} }[ $offset .. $offset + $width - 1 ]) { if ($cmd eq "S") { $_ |= pack("C", hex(shift @data)); } - else { - $_ &= ~pack("C", hex(shift @data)); - } + else { + $_ &= ~pack("C", hex(shift @data)); + } } return _with_checksum("O$jid"); } + if ($cmd eq "R") { + my @o = + map { sprintf "%02X", unpack "C", $_ } reverse @{ $self->{outputs} }; + return _with_checksum("D$jid" . join "", @o); + } + warn "command \"$cmd\" not supported\n"; return $ERROR{command}; } @@ -253,4 +266,8 @@ Bit-Set/Clear operations (works only on address 0x100 and 0x104) since it always expects 32 bit! +=item B + +Reading the outputs 0x100 .. 0x107. + =back