#!/usr/bin/perl -w

# MegasquirtAvr 2003
# speedy firmware-upload 
# Michael Kristensen mik at caffrey.dk and Marcell Gal cell at x-dsl.hu

if (@ARGV < 1) {
    usage();
}

sub usage
{
    print "usage:\n";
    print "\tperl bin/prog.pl vems.hex [flagword] [speedword] [:port]\n";
    print "\n[flagword] (case sensitive)\n";
    print "\tw : write flash (otherwise only verify). This implies 'E'\n";
    print "\td : dump config to mcd.txt and tables to mct.txt\n";
    print "\tp : issue mst..msp..  stimout command for testing\n";
    print "\tt : talk to msavr (application) first, issuing the menucommand to drive it to bootloader\n";
    print "\tE : exit bootloader at the end (try to start msavr app.)\n";
    print "\ts : save serial configuration file (you can attach it to problem-question if you have problems)\n";
    print "\n[speedword]\n";
    print "\t19200, 38400, 57600, 115200\n\n";
	print "[:port]\n";
	print "\t:COM1, :/dev/ttyS0 (alternatively env.variable set COM_PORT=COM3)\n\n";

    undef $ob if defined $ob;
    exit;
}

use vars qw( $OS_win $ob $port );

$maxerr = 5;
$bootl_speed = 19200;
$timeout = 200;

BEGIN {
$OS_win = ($^O eq "MSWin32") ? 1 : 0;
if ($OS_win) {
  eval "use Win32::SerialPort";
  die "$@\n" if ($@);
} else {
  eval "use Device::SerialPort";
  die "$@\n" if ($@);
}
} # BEGIN


# Install like this: perl -MCPAN -e 'install Device::SerialPort'
# If you are running Windows 95 or later, you want the Win32::SerialPort
# module instead of this one. It has a compatible user interface.


# example ihex:
# http://www.termsys.demon.co.uk/pdf/ihex.pdf
# :02 0000 02 1000 EC
# :10 F800 00 0C9446FC0C9463FC0C9463FC0C9463FC 19
# :10F810000C9463FC0C9463FC0C9463FC0C9463FCEC
# :10F820000C9463FC0C9463FC0C9463FC0C9463FCDC
# ...
# :10FEC000DF80EE80FD800C811B81AA81B981CE0F7D
# :10FED000D11D0FB6F894DEBF0FBECDBFED01089562
# :04FFFC000C9400FC65
# :040000031000F800F1
# :00000001FF

# datarecord: ":llaaaattdddddd...dddddcc"
#             - ll -> length of databytes (ddd...ddd), 2 Hex-digits
#             - aaaa -> startadress of EPROM where databytes of this record will be programmed
#             - tt -> type of record: data is 00
#             - ddd...ddd -> ll-sized sequence of bytes programmed at adress aaaa
#             - cc -> checksum plus llaaaattddd...ddd must be zero.
# endrecord: ":00000001FF"

# Types:
# 00 data
# 01 EOF
# 02 Extended Segment address
# 03 start segment address
# 04 extended linear address (not relevant)
# 05 start linear address (not relevant)

$he = '[a-fA-F0-9]';
$offset = 0;

################      app_init         #########################
	process_param();
# check if the hex file is there
	open HEXF, "<$hexfile" or die "ERROR, could not open '$hexfile' for reading: $!";

	if( !defined $port ){
		# another chance, to define via environment variable
		if (defined $ENV{COM_PORT} ) {
			$port = $ENV{COM_PORT};
		}
	}

	if($OS_win){
		$port = 'COM1' if !defined $port;
		$ob = Win32::SerialPort->new ($port);
	} else {
		$port = '/dev/ttyS0' if !defined $port;
		$ob = Device::SerialPort->new ($port);
	}

################################################################

$minidx = 0xffffff00;

while($l = <HEXF>) {
    chomp $l;

#    if ($l =~ /^:/) {
#	if (($len,$adr,$type,$data,$chk) = $l =~ /^:($he{2})($he{4})($he{2})($he*)($he{2})/) {
	if (($len,$adr,$type,$data) = $l =~ /^:($he{2})($he{4})($he{2})($he*)$he{2}/) {
#	    print "$len $adr $type $data $chk\n";
#	    $chk++; # get rid of that warning

	    if (length($data) != 2*hex($len)) {
		print "length-field and actual length of data doesn't match\n";
		print "$l\n";
		undef $ob if defined $ob;
		exit;
	    }

# plenty of possiblities for optimizations

	    # prepare data for calculating the checksum
	    $l =~ /^:(.+)$/; # remove ':'
	    $chk_data = $1;
#	    print "$chk_data\n";

	    # calculate checksum
	    $chk_sum = 0;
	    for ($i=0; $i<(2*hex($len)+10); $i+=2) {
		$v = substr($chk_data, $i, 2);
#		print "$v\n";
		$chk_sum += hex($v);
	    }

	    $chk_sum %= 256;
	    if ($chk_sum != 0) {
	      print "Checksum error\n";
	      print "$l\n";
	      undef $ob if defined $ob;
	      exit;
	    }
	    # checksum correct

	    $tt{$type}++; # count the different numbers of types, debug only
	    if ($type eq "00") { # data
		
		my $baseaddr = hex($adr) + $offset;
		$minidx = $baseaddr if($baseaddr < $minidx);	# update minimum
		# place it in a datastructure; byte oriented, beware!

		for ($i=0; $i<hex($len); $i++) {
		    $v = substr($data, 2*$i, 2);
		    my $a = $baseaddr + $i;
		    $flash[$a] = hex($v);
#		    print "$a, $v\n";
		}
	    } elsif ($type eq "01") { # EOF
		# stop reading the hex file
		last;
	    } elsif ($type eq "02") { # Extended Segment address
		$offset = hex($data) * 16;
	    } elsif ($type eq "03") { # Start segment address
		print "type 3 isn't supported\n";
		# is it necessary?
	    } else {
		print "sorry, don't know what to with type ". hex($type) . "\n";
	    }

	} else {
	  print "can't parse this line: '$l'\n";
	}
#    } else {
#	print "found a strange line: '$l'\n";
#    }
}

foreach $n (keys %tt) {
    print "ihex type $n found $tt{$n} times\n";
}
print "ihex file read and found OK\n";

#the instruction placed at address 0, NOTE. decimal values!!!
#print "$flash[1] $flash[0]\n";
#printf("%02x %02x\n", $flash[1], $flash[0]);

serial_init();


###############################################################

sub serial_init
{
# found on http://members.aol.com/Bbirthisel/alpha.html
# should work on multiple platforms
$confok=0;

$Configuration_File_Name = 'etc/serial.cfg';

# did we succeed?
die "Can't open serial port $port: $^E\n" unless ($ob);

# save the state of the comm port for later
$old_baud = $ob->baudrate;
$old_parity = $ob->parity;
$old_data = $ob->databits;
$old_stop = $ob->stopbits;
$old_hshake = $ob->handshake;

# try using saved configuration
if ($confok){
    print "trying to use config: $Configuration_File_Name\n";
    $ob->restart($Configuration_File_Name) || warn "Can't read $Configuration_File_Name: $!\n";
}

$ob->baudrate($bootl_speed);
$ob->parity('none');
$ob->databits(8);
$ob->stopbits(1);
$ob->handshake('none');
$ob->binary(T);

# without this communication returned too few bytes sometimes
$ob->read_interval(100) if ($OS_win);

$ob->write_settings || undef $ob;

# you need this initially to make your configfile:
$ob->save($Configuration_File_Name) if defined $saveconf;

$tmout = $timeout;
# ok, now port is configured
} # serial_init
##############################################################################
##############################################################################

if(defined $talk2ms){
# say init string to avr (maybe it listens)
# TODO: 9600 baud (or change megasquirtavr standard speed to 19200 ??)
# avoid 'm' character, it's destrcutive

    $ob->baudrate(9600); # msavr speed
    $ob->read_const_time(500);

	msp();
	if ( dumpmct() ){
		exit 0;
	}

    my $initstr = "Mancb". avrcommspeed() . "cb"; # for 19200 ff would work too
    print "saying $initstr at 9600\n";
    comm_send($initstr); # tell msavr to enter bootloader
# tell msavr to enter bootloader
    $b = comm_recv(6);

    if ($b =~ /Hello>/) {
        print "AVR said hello\n";
    } else {
        print "No hello from AVR\n";
    }

    sleep(1); # Let the LCD do the printing before trying to talk with it again
    $ob->lookclear();
    $ob->baudrate($bootl_speed); # bootloader speed
    $ob->read_const_time($timeout);
} # talk2ms

###############################################x

# communicate with bootloader here

bootl_sync();

print "we say S\n";
$ob->lookclear();
comm_send('S');
my $t=srl_wait(7);
if($t !~ /AVR/){
	print "Sorry, device does not reply AVR... to S, instead:$t\n";
	undef $ob if defined $ob;
	exit -2;
};

#$ob->transmit_char(ord('v'));
#syswrite SRL, $sendarr, 1, 0;

print "we say v\n";
comm_send('v');
srl_wait(2);

print "we say V\n";
comm_send('V');
srl_wait(2);

$errcnt = 0;

if(defined $write2){
print "we are writing too, not only verify! Now say e\n";
comm_send('e');
$tmout = 4000;
srl_wait(1);
$tmout = $timeout; # set it back

#$ob->transmit_char(ord('e'));
#&send(ord('e'));
#syswrite SRL, $sendarr, 1, 0;
#print SRL 'e';
#srl_wait();

# do we want 'A' command every time ? Does not take much time.
# what if hex contains gaps ?

for($addrB = $minidx; defined $flash[$addrB]; $addrB += 256){
	# last if $addrB > 0xC100; # stop sooner at debug
	print "\nuploading chunk $addrB:";
	address_tell($addrB) if address_tell($addrB); # trying twice if problem
	comm_send("Dkk");
	pad_ff_ckksum($addrB);
	sendblock();
	if(srl_wait()){ # oops, some problem
		if(!defined $err{$addrB} || $err{$addrB}<2 ){	# go back at error, but not infinite times
			$err{$addrB} ++;
			$addrB -= 256 ;
		} else {
			print "WARNING, serious error, not going back\n";
			$errcnt++;
			if($errcnt > $maxerr){
				print "too many errors, bailing out\n";
				undef $ob if defined $ob;
				exit -3;
			}
		}
	}
}

print "\nTOTAL serious errors during write: $errcnt\n";
} # writemode
{
	$errcnt=0;
	print "VERIFYING...\n";
	$addrB = $minidx;
	do{
		address_tell($addrB) if address_tell($addrB); # trying twice if problem
		$ob->lookclear();
		comm_send("Dll");
		pad_ff_ckksum($addrB);
		if($e=cksum_err()){
			$errcnt++;
			print "error at page $addrB\n$e";
			if($errcnt > $maxerr){
				print "too many errors, bailing out\n";
				last; # we still want the exitbootif()
			}
		}
		$addrB += 256;
	} while(defined $flash[$addrB]);
}
print "Verified($minidx $addrB)\nTOTAL serious errors at verify: $errcnt\n";
if ($errcnt == 0) {
    print "SUCCESS\n";
} else {
    print "FAILURE\n";
}

exitbootif();

##############################################################################
sub bootl_sync
{
# now send a p and keep receiving until we get a S
print "we say p\n";
comm_send('p');
for ($i=0; $i<$maxerr; $i++) {
    $r = srl_wait(1);
    if ($r eq "S") {
	print "AVR in sync\n";
	last;
    }
}
if ($r ne "S") {
    print "didn't get reply from AVR, out of sync\n";
    undef $ob if defined $ob;
    exit -5;
}

}
##############################################################################

# sub serial_destroy

# restore state of comm port
$ob->baudrate($old_baud);
$ob->parity($old_parity);
$ob->databits($old_data);
$ob->stopbits($old_stop);
$ob->handshake($old_hshake);

undef $ob if defined $ob;

#################################
sub process_param
{

#print "number of args:$#ARGV\n";
my $w;
	# number of args was checked earlier
	$hexfile = shift @ARGV;
	
	while($w = shift @ARGV) {
	if( $w =~ /^\d+$/){
		$bootl_speed = $w;
		print "serial bootloader speed set to $w\n";
		next;
	} elsif ($w =~ /^:(\S+)$/){
		$port = $1;
	} else { # flagword
		if($w =~ /w/){
			$write2 = 1 ;
			$exitboot = 1; # needed to write marker word
		}
		$talk2ms = 1 if $w =~ /t/;
		$exitboot = 1 if $w =~ /E/;
		$saveconf = 1 if $w =~ /s/;
		$dumpmct = 1 if $w =~ /d/;
		$msp = 1 if $w =~ /p/;
		$bootl_forced = 1 if $w =~ /f/;	# undocumented: even with running trigger

		$w =~ tr/wtEsfdp//d; # strip the good flags
		if ($w ne "") {
		    print "\nUnknown flag '$w'\n\n";
		    usage();
		}

	}
	} # while
}
##############
sub exitbootif
{
	return if ! defined $exitboot;
	print "we say E\n";
	comm_send('E');
	srl_wait(1);
}
##############
sub avrcommspeed
{
return 'fe' if defined $bootl_forced;
# calculates the number that should be written into the
# register of a 16MHz atmega
return sprintf("%02x", int(1000000/$bootl_speed - 0.5))

}
###############x
# returns 1 if there is an error
sub cksum_err
{
	my $st = srl_wait(4);
#	print "comparing:" . ord(substr($st,0,1)) ." to ". int($sendarr[$a256 + 0]). " \n";
	
	my $s1 = ord(substr($st,0,1)) 
	.','. ord(substr($st,1,1))
	.','. ord(substr($st,2,1))
	.','. ord(substr($st,3,1));
	
	my $s2 = int($sendarr[$a256 + 0])
	.','.int($sendarr[$a256 + 1])
	.','.int($sendarr[$a256 + 2])
	.','.int($sendarr[$a256 + 3]);
	return $s1. "\n" . $s2 if($s1 ne $s2); # problem
	return undef;

}
#######################
sub comm_send
{
    my $str = shift;
    my $offset = 0;
    my $count_out = 0;
    my $left = length($str);

    while ($left != 0) {
    	$count_out = $ob->write(substr($str, $offset, $left));
	if (!$count_out) {
		$count_out = 0;
	}
	$left -= $count_out;
	$offset += $count_out;
    }
    return length($str);
}

#######################
sub comm_recv
{
    my $b = shift;
    ($count_in, $string_in) = $ob->read($b);
    if( (!defined $count_in ) || ($count_in != $b) ){
    	warn "read unsuccessful b=$b count_in=$count_in\n";
    }
    return ($count_in, $string_in);
}

sub flush
{
	my $b = shift;
	$ob->read_const_time($tmout);
	($count_in, $string_in) = $ob->read($b);
	return ($count_in, $string_in);
}

#######################
# tell the bootloader what address we are at
sub address_tell
{
my $address_B = shift;
my $chunk = $address_B / 2; # we must tell the word address (not byte)
$chunk %= 65536;

my $str= 'A' . chr($chunk / 256) . chr($chunk % 256);
comm_send($str);
$ob->read_const_time($tmout);
return srl_wait(1);
}

########################
sub sendblock
{
		my $str = '';
		my $i = 0;
		do{
			$str .= chr($sendarr[$i]);
			$i++;
		} while($i < 260);
		
		comm_send($str);
}
#################################################
# what's the reply???
sub srl_wait
{
	my $realcharcnt = shift;
	if (defined($realcharcnt)) {
	    $charcnt = $realcharcnt;
	} else {
	    $charcnt = 1;
	}
# TODO: if no reply comes within 2 sec, we should start saying 'v' -s or sg.
# finally report the problem (or let the user ctrl-c)
	# $ob->read($in_);
	$ob->read_const_time($tmout);
	my ($cnt, $in_) = comm_recv($charcnt);
	#sysread (SRL, $in_, 1, 0) or die "cannot readback from SRL $!";
	
	if(defined $in_){
#		print "got back $cnt:$in_ :".ord(substr($in_, 0, 1));
#		print ' '.ord(substr($in_, 1, 1)) if(length($in_) > 1);
#		print "\n";
	} else {
		print "nothing\n";
	}
	
	return $in_ if defined($realcharcnt) && ($realcharcnt > 0);
	return undef if $in_ eq "\r";	# success 
	return 1;					# error
}

##############################################
# returns 256 + 4 bytes in global $sendarr[..] array
# from the 256 bytes data starting from the $flash[$_[0]] 
# (even if $flash ends earlier)

sub pad_ff_ckksum
{
	my $addr_offs = shift; # addr. in bytes

	my $ck1 = $addr_offs / 2; # addressW in firmware
	my $ck2 = $ck1;
	my $dataw;
	
	my $i = 0;
	do{
		$dataw = pad_ff($addr_offs, $i); # byteorder? the avr will tell :-)
		$i++;
		$dataw += pad_ff($addr_offs, $i) * 256;
		$ck1 += $dataw;
		$ck2 ^= $dataw;
		
		$i++;
	} while ($i <= 255);
	
	# pushing the checksum
	$ck1 %= 65536;
	$ck2 %= 65536;
	$a256 = 256;
	$sendarr[$a256 + 0] = $ck1 / 256;
	$sendarr[$a256 + 1] = $ck1 % 256;
	$sendarr[$a256 + 2] = $ck2 / 256;
	$sendarr[$a256 + 3] = $ck2 % 256;
}

# helper function for the above
sub pad_ff
{
	my $a = shift;
	my $o = shift;
	$a += $o;
	my $v = 255;	# padding with 0xFF
	$v = $flash[$a] if(defined $flash[$a]);
	$sendarr[$o] = $v;
	return $v;
}

# ==========================
sub msp
{
	if( !defined $msp) { return undef; };

	# multitooth 64-1 type signal for testing:
	comm_send( "Manmstbemsp02" );

	return 1;
}

# ==================
sub dumpmct
{
	if( !defined $dumpmct) { return undef; };

	# dump_something( "Manmctmdv", "mct.txt" );	# does mdv cause harm ?
	dump_something( "Manmll", "mll0.txt" );	# LCD content
	dump_something( "Manmct", "mct.txt" );
	dump_something( "Manmcd", "mcd.txt" );
	dump_something( "Manmll", "mll.txt" );	# LCD content

	return 1;
}

sub dump_something
{
	my $readblocksize=2048;
	my ( $cmd, $filename) = @_;
	print STDERR "dumping $cmd to $filename\n";

	comm_send( $cmd );
	#	sleep(1);
	my ($cnt, $str);
	open( MCT, ">$filename" );

	$morechances=2;
	do {
		($cnt, $str) = comm_recv( $readblocksize );
		print MCT $str;
		# print STDERR "read: $str\n";
	} while ( $cnt == $readblocksize || ($cnt == 0 && --$morechances>0) );

	close MCT;
}


