git.rot13.org Git - x300-pci/blob - openocd-jtag-boundary-scan.pl

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5 use autodie;
   6 use Data::Dump qw(dump);
   7 use IO::Socket::INET;
   8 use Storable;
   9
  10 my $openocd_remote = shift @ARGV || 'picam:4444';
  11 my $bsdl_file = $ENV{BSDL} ||
  12         'EP4CE6E22.bsd';
  13 #       '_3128at100.bsd';
  14 #       '3064at44.bsd'; # XXX
  15 my $project_file = 'Altera/epm3064_dac/3064at44.qsf';
  16 $project_file = 'tb276/f32c.qsf';
  17
  18 my $BOUNDARY_LENGTH = -1;
  19 my $entity;
  20
  21 my $bit2pin;
  22 my $io2bit;
  23
  24 my $pin2io;
  25 my $parse;
  26 my $parse_in = 0;
  27 my $parse_regex = join('|', qw(
  28         PIN_MAP_STRING
  29         INSTRUCTION_OPCODE
  30 ));
  31
  32 $|=1; # flush stdout
  33
  34 my $have_gpio = `which gpio`;
  35 warn "# ", ! $have_gpio ? "DOESN'T " : '', "have rpi gpio\n";
  36 require 'gpio.pl' if $have_gpio;
  37
  38 open(my $bsdl, '<', $bsdl_file);
  39 while(<$bsdl>) {
  40         if ( m/($parse_regex)/ ) {
  41                 $parse_in = $1;
  42                 $parse->{$1} .= $_;
  43         } elsif ( $parse_in ) {
  44                 next if m/^\s*--/;
  45                 $parse->{$parse_in} .= $_;
  46                 $parse_in = 0 if m/;/;
  47         } elsif ( m/"(\d+)\s+\(BC_\d+,\s+(\S+),\s+(\S+)/ ) {
  48                 $bit2pin->{$1} = [ $2, $3 ];
  49                 push @{ $io2bit->{$2} }, $1;
  50         } elsif ( m/attribute\s+BOUNDARY_LENGTH\s+of\s+\S+\s*:\s*entity\s+is\s+(\d+);/ ) {
  51                 $BOUNDARY_LENGTH = $1;
  52                 warn "# BSDL $bsdl_file BOUNDARY_LENGTH = $BOUNDARY_LENGTH\n";
  53         } elsif ( ! $entity && m/^entity\s(\S+)\s+is/ ) {
  54                 $entity = $1;
  55                 warn "# entity = $entity\n";
  56         }
  57
  58 }
  59 close($bsdl);
  60
  61 warn "# bit2pin = ",dump($bit2pin);
  62 warn "# io2bit = ",dump($io2bit);
  63
  64 foreach my $chunk ( keys %$parse ) {
  65         $parse->{$chunk} =~ s/"\s*\&\s*"/ /gs; # concat lines back to single line
  66         $parse->{$chunk} =~ s/^.+?"//s; # strip upto first quote
  67         $parse->{$chunk} =~ s/"\s*;.*?$//s; # strip everything after closing
  68         $parse->{$chunk} =~ s/\s+/ /gs;
  69 }
  70
  71 warn "# parse = ",dump($parse);
  72
  73 my $pin_map = $parse->{PIN_MAP_STRING} || die "no PIN_MAP_STRING in ",dump($parse);
  74
  75 sub str_comma {
  76         my $t = shift;
  77         $t =~ s/\s*,\s*/ /gs;
  78         return $t;
  79 }
  80 warn "# pin_map = ",dump($pin_map);
  81 $pin_map =~ s/\(\s*([^\)]+?)\s*\)/str_comma($1)/gse;
  82 warn "# pin_map = ",dump($pin_map);
  83
  84 foreach my $map ( split(/\s*,\s*/, $pin_map) ) {
  85         warn "## $map\n";
  86         my ( $name, $pin ) = split(/\s*:\s*/, $map);
  87         $pin2io->[$_] = $name foreach split(/ /,$pin);
  88 }
  89
  90 warn "# pin2io = ",dump( $pin2io );
  91 #store \$pin2io, $bsdl_file . '.pin2io.storable';
  92 store \$pin2io, $entity . '.pin2io.storable';
  93
  94
  95 my $opcode;
  96 my $o = $parse->{INSTRUCTION_OPCODE} || die "no INSTRUCTION_OPCODE in ",dump($parse);
  97
  98 foreach ( split(/\)\s*,\s*/, $o) ) {
  99         s/\s+\(/ /g;
 100         s/\s*\)\s*$//g;
 101         warn "### [$_]\n";
 102         my ( $inst_opcode, $bin ) = split(/\s+/, $_);
 103         $opcode->{$inst_opcode} = sprintf "0x%02x", eval '0b' . $bin;
 104 }
 105 warn "# opcode = ",dump($opcode);
 106
 107 foreach (qw(SAMPLE EXTEST)) {
 108         die "missing INSTRUCTION_OPCODE $_ in ",dump($opcode) unless $opcode->{$_};
 109 }
 110
 111 my $pin_desc;
 112 foreach my $pin_file ( glob "pins/$entity*.tsv" ) {
 113         open(my $fh, '<', $pin_file);
 114         while(<$fh>) {
 115                 chomp;
 116                 my ($pin,$desc, $bcm) = split(/\t+/,$_,3);
 117                 $pin_desc->{$pin} = $desc;
 118                 gpio::add_bcm_desc( $bcm => $desc ) if $have_gpio;
 119         }
 120         close($fh);
 121         warn "# $pin_file ",dump($pin_desc);
 122 }
 123
 124 {
 125         open(my $fh, '<', $project_file);
 126         while(<$fh>) {
 127                 chomp;
 128                 s/[\r\n]+$//;
 129                 next if m/^\s*#/;
 130                 my ($set,$pin, $op, $desc) = split(/\s+/,$_,4);
 131                 if ( $set =~ m/set_location_assignment/i && $op =~ m/-to/i && $pin =~ s/^PIN_//ig ) {
 132                         $pin_desc->{$pin} = $desc; # overwrite pin description
 133                 } else {
 134                         warn "# ignored $_\n";
 135                 }
 136         }
 137         close($fh);
 138         warn "# $project_file ",dump($pin_desc);
 139 }
 140
 141 =for remove
 142 my @sort = sort {
 143         my $aa = $a; $aa =~ s/\D+//g;
 144         my $bb = $b; $bb =~ s/\D+//g;
 145         $aa <=> $bb } keys %$io2bit;
 146 warn "# sort = ",dump(@sort);
 147 =cut
 148
 149 sub bits {
 150         my $bits = shift;
 151         return $bits; # FIXME disable for now
 152         $bits =~ s/0/ /;
 153         $bits =~ s/^(.)0/$1 /;
 154         $bits =~ s/^1/I/;
 155         $bits =~ s/^(.)1/$1./;
 156         return $bits;
 157 }
 158
 159 my $last_bits = '';
 160 sub print_io {
 161         my $bits = shift;
 162         my $o_bits = $bits;
 163         $bits = reverse $bits; # make substr work as expected
 164         my $last_bits_r = reverse $last_bits;
 165
 166         print "pin off io___ ICO          | " x 4, $openocd_remote,"\n";
 167         foreach my $i ( 0 .. ($#$pin2io/4)-1 ) {
 168                 foreach my $j ( 0 .. 3 ) {
 169                         #my $pin = ($i*4) + $j + 1; # rows
 170                         my $pin = ($#$pin2io/4) * $j + $i + 1; # columns
 171                         my $io = $pin2io->[$pin];
 172                         my $o = $io2bit->{$io}->[0];
 173
 174                         if ( defined $o ) {
 175                                 my $l = $b = substr($bits, $o, 3);
 176                                 $l = substr($last_bits_r,$o,3) if $last_bits;
 177
 178                                 my $desc = $pin_desc->{$pin} || '';
 179                                 my $bits = bits($b);
 180                                 if ( $b ne $l ) {
 181                                         my @b = split(//, $bits);
 182                                         my @l = split(//, bits($l));
 183                                         $bits = '';
 184                                         foreach ( 0 .. $#b ) {
 185                                                 $bits .= $b[$_] eq $l[$_] ? $b[$_] : "\e[33;7;1m$b[$_]\e[0m";
 186                                         }
 187                                 }
 188
 189                                 $desc = ' ' . $desc if length($desc) < 10;
 190                                 $desc = substr($desc,0,10);
 191
 192                                 printf "%-3d %-3d %-5s %3s%-10s| ", $pin, $o, $io, $bits, $desc;
 193                         } else {
 194                                 printf "%-3d ... %-18s | ", $pin, $io;
 195                         }
 196                 }
 197                 print "\n";
 198         }
 199         print "\n";
 200         $last_bits = $o_bits;
 201 }
 202
 203 #foreach my $h (qw(0 1 2 e f 10 11 12 1e 1f 20 30 40 50 100 200 1000)) {
 204 #        printf "hex = %4s  binary = %16s\n", $h, hex2bin($h);
 205 #}
 206
 207 my $sock = IO::Socket::INET->new($openocd_remote);
 208
 209 sub hex2bin {
 210         my $h = shift;
 211         my $hlen = length($h);
 212         my $blen = $hlen * 4;
 213         return unpack("B$blen", pack("H$hlen", $h));
 214 }
 215
 216 sub bin2hex {
 217         my $b = shift;
 218         my $blen = length($b);
 219         my $hlen = $blen / 4;
 220         return unpack("H$hlen", pack("B$blen", $b));
 221 }
 222
 223
 224 my $tap;
 225 print $sock "jtag names\n"; # will fill-in $tap variable from openocd
 226
 227 my $BSR;
 228
 229 while(1) {
 230
 231 while (<$sock>) {
 232         warn "<< ",dump($_);
 233         chomp;
 234         s/[\r\x00]+//g;
 235         if ( /^\s*([A-F0-9]+)/ ) {
 236                 my $hex = $1;
 237                 my $bin = hex2bin($hex);
 238                 diff_bits($BSR, $bin);
 239                 $BSR = $bin;
 240                 print_io $bin if $bin ne $last_bits;
 241                 gpio::pins() if $have_gpio;
 242                 last;
 243         } elsif ( m/^(\w+\.tap)$/ && !$tap ) {
 244                 $tap = $1;
 245                 warn "# using TAP $tap";
 246
 247                 # first sample
 248                 print $sock "irscan $tap $opcode->{SAMPLE}\n"; # SAMPLE/PRELOAD
 249                 print $sock "drscan $tap $BOUNDARY_LENGTH 0\n";
 250
 251         } else {
 252                 warn "# in ",dump($_);
 253         }
 254 }
 255
 256 sub diff_bits {
 257         my ($old, $new) = @_;
 258         $old = reverse $old; # extra bits must be on the end
 259         $new = reverse $new;
 260         $old =~ s/(...)/$1 /g;
 261         $new =~ s/(...)/$1 /g;
 262         my @o = split(/ /, $old);
 263         my @n = split(/ /, $new);
 264         my $bsr_max_bit = $BOUNDARY_LENGTH / 3 - 1;
 265         foreach my $i ( 0 .. $bsr_max_bit ) {
 266                 if ( $o[$i] eq $n[$i] ) {
 267                         $o[$i]='.';
 268                 } else {
 269                         my $pin = $bit2pin->{ $i * 3 }->[0];
 270                         $o[$i] = " $pin@" . ( $i * 3 ) . ":" . $o[$i] . '>' . $n[$i];
 271                 }
 272         }
 273         my $diff = join('', @o[ 0 .. $bsr_max_bit ]);
 274         print "# diff_bits $diff\n";
 275 }
 276
 277 print "> ";
 278 my $cmd = <STDIN>;
 279 chomp $cmd;
 280 if ( $cmd =~ /(p|o)(\d+)=(\d+)/ ) {
 281         my ( $what, $p, $v ) = ( $1, $2, $3 );
 282
 283         my $old_bsr = reverse $BSR;
 284         my $b = $old_bsr;
 285
 286         if ( $what eq 'p' && length($v) == 1 ) {
 287
 288                 my $pin = $p;
 289                 my $io = $pin2io->[$pin];
 290                 my $bit = $io2bit->{$io}->[0];
 291
 292                 warn "# pin $pin = $v io=$io bit=$bit\n";
 293
 294                 $b =
 295                           substr($old_bsr,0,$bit+1) # leave input as-is
 296                         . ( $v eq 'Z' ? 1 : 0 )     # control
 297                         . ( $v & 1 )                # output
 298                         . substr($old_bsr,$bit+3)
 299                         ;
 300
 301
 302         } elsif ( $what eq 'o' && $p < $BOUNDARY_LENGTH ) {
 303                 my $o = $p;
 304                 #$b = substr($old_bsr,0,$o) . reverse $v . substr($old_bsr,$o+length($v));
 305                 $b = ( "0" x $o ) . reverse $v . ( "0" x ( length($old_bsr) - $o - length($v) ) );
 306 warn "XXX",length($old_bsr), " == ",length($b);
 307                 $old_bsr = "0" x length($old_bsr);
 308         } else {
 309                 print "IGNORED ",dump( $what, $p, $v );
 310         }
 311
 312         $b = reverse $b;
 313
 314         diff_bits( $BSR, $b );
 315
 316 #       print $sock "irscan $tap $opcode->{SAMPLE}\n"; # SAMPLE/PRELOAD
 317         print $sock "drscan $tap $BOUNDARY_LENGTH 0x", bin2hex($b), "\n";
 318         print $sock "irscan $tap $opcode->{EXTEST}\n"; # EXTEST
 319 #       print $sock "drscan $tap $BOUNDARY_LENGTH 0x", bin2hex($b), "\n";
 320
 321 } elsif ( $cmd =~ m/\?/ ) {
 322         $last_bits = '';
 323         print $sock "irscan $tap $opcode->{SAMPLE}\n"; # SAMPLE/PRELOAD
 324         print $sock "drscan $tap $BOUNDARY_LENGTH 0\n";
 325 } else {
 326         gpio::cmd( $cmd ) if $have_gpio;
 327         print $sock "irscan $tap $opcode->{SAMPLE}\n"; # SAMPLE/PRELOAD
 328         print $sock "drscan $tap $BOUNDARY_LENGTH 0\n";
 329 }
 330
 331
 332 }#while(1)