dump pin states using bsd file

diff --git a/openocd-jtag-boundary-scan.pl b/openocd-jtag-boundary-scan.pl
new file mode 100755 (executable)
index 0000000..b104942
--- /dev/null
+++ b/openocd-jtag-boundary-scan.pl
@@ -0,0 +1,123 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+use autodie;
+use Data::Dump qw(dump);
+use IO::Socket::INET;
+
+my $bit2pin;
+my $io2bit;
+
+my $pin2io;
+my $in_pin_map = 0;
+my $pin_map = '';
+
+
+open(my $bsdl, '<', '_3128at100.bsd');
+while(<$bsdl>) {
+       if ( m/PIN_MAP_STRING/ ) {
+               $pin_map .= $_;
+               $in_pin_map = 1;
+       } elsif ( $in_pin_map ) {
+               next if m/^\s*--/;
+               $pin_map .= $_;
+               $in_pin_map = 0 if m/;/;
+       } elsif ( m/"(\d+)\s+\(BC_\d+,\s+(\S+),\s+(\S+)/ ) {
+               $bit2pin->{$1} = [ $2, $3 ];
+               push @{ $io2bit->{$2} }, $1;
+       }
+}
+close($bsdl);
+
+warn "# bit2pin = ",dump($bit2pin);
+warn "# io2bit = ",dump($io2bit);
+
+$pin_map =~ s/"\s*\&\s*"/ /gs;
+$pin_map =~ s/^.*?:=\s*"//;
+$pin_map =~ s/"\s*;\s*$//s;
+
+sub str_comma {
+       my $t = shift;
+       $t =~ s/\s*,\s*/ /gs;
+       return $t;
+}
+warn "# pin_map = ",dump($pin_map);
+$pin_map =~ s/\(\s*([^\)]+?)\s*\)/str_comma($1)/gse;
+warn "# pin_map = ",dump($pin_map);
+
+foreach my $map ( split(/\s*,\s*/, $pin_map) ) {
+       warn "## $map\n";
+       my ( $name, $pin ) = split(/\s*:\s*/, $map);
+       $pin2io->[$_] = $name foreach split(/ /,$pin);  
+}
+
+warn "# pin2io = ",dump( $pin2io );
+
+my @sort = sort {
+       my $aa = $a; $aa =~ s/\D+//g;
+       my $bb = $b; $bb =~ s/\D+//g;
+       $aa <=> $bb } keys %$io2bit;
+warn "# sort = ",dump(@sort);
+
+sub print_io {
+       my $bits = shift;
+       my $i = 0;
+#      foreach my $io ( @sort ) {
+       print "pin off io___ I C O | " x 4, "\n";
+       foreach my $i ( 0 .. ($#$pin2io/4)-1 ) {
+               foreach my $j ( 0 .. 3 ) {
+                       #my $pin = ($i*4) + $j + 1; # rows
+                       my $pin = ($#$pin2io/4) * $j + $i + 1; # columns
+                       my $io = $pin2io->[$pin];
+                       my $o = $io2bit->{$io}->[0];
+                       if ( defined $o ) {
+                               printf "%-3d %-3d %-5s %d %d %d | ", $pin, $o, $io, split(//, substr($bits, $o, 3));
+                       } else {
+                               printf "%-3d ... %-5s       | ", $pin, $io;
+                       }
+               }
+               print "\n";
+       }
+       print "\n";
+}
+
+#foreach my $h (qw(0 1 2 e f 10 11 12 1e 1f 20 30 40 50 100 200 1000)) {
+#        printf "hex = %4s  binary = %16s\n", $h, hex2bin($h);
+#}
+
+my $sock = IO::Socket::INET->new('picam:4444');
+
+sub hex2bin {
+        my $h = shift;
+        my $hlen = length($h);
+        my $blen = $hlen * 4;
+        return unpack("B$blen", pack("H$hlen", $h));
+}
+
+my $cmd;
+
+while(1) {
+
+print $sock "irscan x300.tap 0x55\n";
+print $sock "drscan x300.tap 288 0\n";
+
+print $sock $cmd if $cmd;
+
+while (<$sock>) {
+       warn "<< ",dump($_);
+       chomp;
+       s/[\r\x00]+//g;
+       if ( /^\s*([A-F0-9]+)/ ) {
+               my $hex = $1;
+               my $bin = hex2bin($hex);
+               print_io $bin;
+               last;
+       } else {
+               warn "# in ",dump($_);
+       }
+}
+
+print "[press enter]\n";
+<STDIN>;
+}