#!/usr/bin/perl

use warnings;
use strict;
use autodie;
use Data::Dump qw(dump);
use IO::Socket::INET;
use Storable;

my $openocd_remote = shift @ARGV || 'picam:4444';

my $bit2pin;
my $io2bit;

my $pin2io;
my $in_pin_map = 0;
my $pin_map = '';

$|=1; # flush stdout

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 );
store \$pin2io, '/dev/shm/pin2io.storable';

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, $openocd_remote,"\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($openocd_remote);

sub hex2bin {
        my $h = shift;
        my $hlen = length($h);
        my $blen = $hlen * 4;
        return unpack("B$blen", pack("H$hlen", $h));
}

sub bin2hex {
        my $b = shift;
        my $blen = length($b);
        my $hlen = $blen / 4;
        return unpack("H$hlen", pack("B$blen", $b));
}

#my $cmd;

my $BSR;

# first sample
print $sock "irscan x300.tap 0x55\n"; # SAMPLE/PRELOAD
print $sock "drscan x300.tap 288 0\n";

while(1) {

while (<$sock>) {
	warn "<< ",dump($_);
	chomp;
	s/[\r\x00]+//g;
	if ( /^\s*([A-F0-9]+)/ ) {
		my $hex = $1;
		my $bin = hex2bin($hex);
		diff_bits($BSR, $bin);
		$BSR = $bin;
		print_io $bin;
		last;
	} else {
		warn "# in ",dump($_);
	}
}

sub diff_bits {
	my ($old, $new) = @_;
	$old =~ s/(...)/$1 /g;
	$new =~ s/(...)/$1 /g;
	my @o = split(/ /, $old);
	my @n = split(/ /, $new);
	foreach my $i ( 0 .. $#o ) {
		if ( $o[$i] eq $n[$i] ) {
			$o[$i]='.';
		} else {
			$o[$i].='>'.$n[$i];
		}
	}
	return join('', @o);
}

print "[press enter]\n";
my $cmd = <STDIN>;
chomp $cmd;
if ( $cmd =~ /(\d+)=(\d)/ ) {
	my ( $pin, $v ) = ( $1, $2 );
	warn "# pin $pin = $v\n";

	my $io = $pin2io->[$pin];
	my $bit = $io2bit->{$io}->[0];

	my $b = substr($BSR,0,$bit+1)
		. ( substr($BSR,$bit+1,1) ^ 1 )
		. ( $v & 1 )
		. substr($BSR,$bit+3)
		;

	print diff_bits( $BSR, $b ), $/;

	print $sock "irscan x300.tap 0x55\n"; # SAMPLE/PRELOAD
	print $sock "drscan x300.tap 288 0x", bin2hex($b), "\n";
	print $sock "irscan x300.tap 0x00\n"; # EXTEST
	print $sock "drscan x300.tap 288 0x", bin2hex($b), "\n";
} else {
	print $sock "irscan x300.tap 0x55\n"; # SAMPLE/PRELOAD
	print $sock "drscan x300.tap 288 0\n";
}


}#while(1)
