diff -r 7ccc679ac5db -r 2d41fac09084 lib/Quancom/Test/Server.pm --- a/lib/Quancom/Test/Server.pm Mon Jan 05 21:44:56 2009 +0100 +++ b/lib/Quancom/Test/Server.pm Tue Jan 06 02:01:26 2009 +0100 @@ -28,7 +28,13 @@ use IO::Socket; use IO::Select; -my $STX = "\x02"; +my $STX = "\x02"; +my %ERROR = ( + checksum => pack("ac", "E", 0), + character => pack("ac", "E", 1), + command => pack("ac", "E", 2), + width => pack("ac", "E", 3), +); sub new { my $class = ref $_ ? ref shift : shift; @@ -75,7 +81,7 @@ sub show { my $self = shift; - printf STDERR "%0v8b\n", join "", @{ $self->{outputs} }; + printf STDERR "%0v8b\n", join "", reverse @{ $self->{outputs} }; } sub DESTROY { @@ -117,6 +123,7 @@ chomp $l; $l = $self->_process($l); $c->print($l . "\r"); + $self->show; } } return; @@ -126,6 +133,7 @@ while (<>) { chomp; print $self->_process($_), "\n"; + $self->show; } } @@ -140,7 +148,7 @@ warn "got: $line($1)\n" if $self->{debug}; - return pack("ac", "E", 1) # checksum error + return $ERROR{checksum} if $1 ne ".." and hex($1) != unpack("%8C*", "$STX$line"); my ($jid, $cmd, $width, $addr, $data) = ( @@ -155,32 +163,45 @@ # some transformations for more easy use $addr = hex($addr); - $width = - $width eq "B" ? 1 - : $width eq "W" ? 2 - : $width eq "L" ? 3 - : $width eq "X" ? 4 + $width = $width eq "B" + ? 1 # 8 bit + : $width eq "W" ? 2 # 16 bit + : $width eq "L" ? 4 # 32 bit + : $width eq "X" ? 8 # 64 bit : 0; + my @data = reverse ($data =~ /(..)/g); # msb + my $offset = $addr - 0x100; + if ($cmd eq "W") { - my @data = $data =~ /(..)/g; - return pack("ac", "E", 3) # width error - if @data != $width; - - my $offset = $addr - 0x100; + return $ERROR{width} if @data != $width; @{ $self->{outputs} }[ $offset .. $offset + $width - 1 ] = map { pack "C", hex($_) } @data; - $self->show; - - $retval = "O$jid"; - } - else { - warn "command \"$cmd\" not supported\n"; - $retval = pack("ac", "E", 2); + return _with_checksum("O$jid"); } - return $retval . sprintf("%02x", unpack("%8C*", $retval)); + if ($cmd =~ /^[SC]$/) { + # currently restricted to 4 byte (32bit) + return $ERROR{command} if $width != 4; + return $ERROR{width} if @data != 4; + foreach (@{ $self->{outputs} }[ $offset .. $offset + $width - 1 ]) { + if ($cmd eq "S") { + $_ |= pack("C", hex(shift @data)); + } + else { + $_ &= ~pack("C", hex(shift @data)); + } + } + return _with_checksum("O$jid"); + } + + warn "command \"$cmd\" not supported\n"; + return $ERROR{command}; +} + +sub _with_checksum { + $_[0] . sprintf("%02x", unpack("%8C*", $_[0])); } 1; @@ -215,3 +236,21 @@ will be removed afterwards) =back + +=head1 BUGS + +Not all commands/registers are implemented. Currently the following +operations are supported: + +=over + +=item B + +Setting of outputs 0x100 .. 0x107 + +=item B and B + +Bit-Set/Clear operations (works only on address 0x100 and 0x104) since +it always expects 32 bit! + +=back