lib/Quancom/Test/Server.pm
changeset 19 6acf8ea44e0a
parent 17 ecc10b50b7a6
--- 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