--- 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<R>
+
+Reading the outputs 0x100 .. 0x107.
+
=back