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