#!/usr/bin/perl


#****************************************************************************
#
#       pohpic
#
#       program to control POHPIC, the "parts on hand PIC production
#       programmer"
#
#****************************************************************************
#
#       Variables
#       (aka, Cast, in order of appearance)
#       $device
#       $readfile
#       $writefile
#       $codeprotect
#       $quiet
#       $verbose
#       $production
#       $overwrite
#
#****************************************************************************
#
#	subroutines
#
#****************************************************************************


use Getopt::Std;

# get the command line options
getopts('hd:r:w:c:qvpobXeE'); #returns in the $opt_... variables
			  # which are the command line options 
if ($opt_d ne ""){$device= uc $opt_d;}     # $device = (uppercase) device (eg 16C71)
if ($opt_r ne ""){$readfile=$opt_r;}      # $readfile = file to read PIC into
if ($opt_w ne ""){$writefile=$opt_w;}      # $writefile = file to program into PIC
if ($opt_c ne ""){$codeprotect=$opt_c;}    # $codeprotect = this must be the catchphrase
			#   if we actually want to code protect
$quiet=$opt_q;          # $quiet = be quiet
$verbose=$opt_v;        # $verbose = give lots of data
$production=$opt_p;     # $production = production verify if set
$overwrite=$opt_o;      # $overwrite old $readfile
$blankcheck=$opt_b;     # $blankcheck = check blankness of part
$remove_cp=$opt_X;	# $remove_cp = remove code protect and erase
$erase_program=$opt_e;	# $erase_program = erase program memory
$erase_data=$opt_E;	# $erase_data = erase data memory

if (!$quiet)
	{
	print "POHPIC V0.1a: Author Matt Bennett, http://www.hazmat.com/~mjb/contact/n"
	}

if ($opt_h)     
        {
        &printhelp;
        }
# for debugging verbose is default!
# as long as $quiet is not 1, it will be verbose

#if (!$quiet)
#	{
#	$verbose=1;
#	}

# $codeprotect must be set to "YES_REALLY_PROTECT" if we really want to 
# codeprotect

if ($codeprotect) 
	{
	if ($codeprotect eq "YES_REALLY_PROTECT")
		{
		$protect=1;
		}
	else
		{
		print "ERROR: You forgot the code protection catchphrase (-p YES_REALLY_PROTECT)\n";
		$gonnadie=1;
		}
	}

# look for what type of device we are using and set a paramters that
# are device dependent.

if (defined $device)
	{
	$_=$device;
	DEVICE_SWITCH:
		{
		if (/^16F84/)
			{
			$memory_type="FLASH";
			$maxsize=1024;
			$cp_mask="3FFF";
			last DEVICE_SWITCH;
			};
		if (/^16C71/)
	 		{
			$memory_type="EPROM";
			$maxsize=1024;
			$cp_mask="3FFF";
			last DEVICE_SWITCH;
			};
		if (/^FTEST/)
			{
			$memory_type="FLASH";
			$maxsize=20;
			$cp_mask="3FFF";
			last DEVICE_SWITCH;
			};
		if (/^ETEST/)
			{
			$memory_type="EPROM";
			$maxsize=20;
			$cp_mask="3FFF";
			last DEVICE_SWITCH;
			};
		print "ERROR: Invalid device type\n";
		$gonnadie = 1;
		}
	}
else
	{
	print "ERROR: No device specified (-d XXXXX)\n";
        $gonnadie = 1;
	}

# we must either read or write a file
if ($remove_cp|$erase_program|$erase_data)
	{
	if ($memory_type ne "FLASH")
		{
		print "ERROR: You may only use the options [-e|-E|-X] with a flash device\n";
		$gonnadie = 1;
		}
	}
elsif (((defined $readfile ) & (defined $writefile ))|((!defined $readfile) & (!defined $writefile )))
	{
	print "ERROR: You must choose to either read from the device (-r FILENAME),\n";
	print "       or write to the device (-w FILENAME).\n";
	$gonnadie = 1;
	}
if ($gonnadie) {exit;}

# print out the verbose information, all about what is happening.

if (!$quiet)
	{
	print "Device: $device\n";
	print "Memory size: $maxsize words\n";
	if ($remove_cp+$erase_program+$erase_data)
		{
		if ($remove_cp)
			{
			print "Removing code protection\n";
			}
		if ($erase_program)
			{
			print "Erasing program memory\n";
			}
		if ($erase_data)
			{
			print "Erasing data memory\n";
			}
		}
	print "Code Protection: ";
	if (!$protect) 
		{
		print "OFF\n";
		}
	else
		{
		print "ON\n";
		}
	if ($readfile)
		{
		print "Reading from device into file: $readfile\n";
		}
	elsif ($writefile)
		{
		print "Writing to device from file: $writefile\n";
		}
	elsif (!($erase_data|$erase_program|$remove_cp))
		{
		die "Some weird read/write error.\n";
		}       
	print "Production verify: ";
	if ($production)
		{
		print "ON\n";
		}
	else
		{
		print "OFF\n";
		}
	print "Blank Check: ";
	if ($blankcheck)
		{
		print "ON\n";
		}
	else
		{
		print "OFF\n";
		}
	#sleep(10);
	}

open SEROUT, ">/dev/cua0" ||die "ERROR: Can't open /dev/cua0 for write\n";    #
open SERIN, "/dev/cua0" ||die "ERROR: Can't open /dev/cua0 for read\n";      #

# if $readfile is defined and has a value read from the pic
if ($remove_cp+$erase_program+$erase_data)
	{
	if ($remove_cp)
		{
		&removeerase("remove_code_protection",$memory_type)||killmenow("ERROR: Remove code protect failed\n");
		print "Code protection removed\n";
		}
	if ($erase_program)
        	{
        	&removeerase("erase_program",$memory_type)||killmenow("ERROR: Remove code protect failed\n");
		print "Program memory erased\n";
        	}
	if ($erase_data)
        	{
        	&removeerase("erase_data",$memory_type)||killmenow("ERROR: Remove code protect failed\n");
		print "Data memory erased\n";
        	}
	}
	
if ($readfile ne "")
	{
#	$readpic=1;
	if (!$overwrite & -e $readfile)
		{
		die "ERROR: file $readfile exists\n";
		}
	open PICOUT, ">".$readfile || die "ERROR: Could not open $readfile\n";
	&resetPOHPIC;                   # reset programmer
	&startPOHPIC($memory_type);     # start the programmer

	for ($count=0; $count < $maxsize; $count++)
		{
		$alldata{$address}=&readdata;
		if ($verbose) {printf ("address (%s) data (%s)\n",&print4hex($address),&print4hex($alldata{$address}));}	
		&incadd;
		}
	&resetPOHPIC;                   # reset programmer
	&startPOHPIC($memory_type);     # start the programmer
	&goto_config;
	for ($count=0; $count < 8; $count++)
		{
		$alldata{$address}=&readdata;
		if ($verbose) {printf ("address (%s) data (%s)\n",&print4hex($address),&print4hex($alldata{$address}));}
		&incadd;
		}


	if (defined $production )
		{	
		print "Performing production verification for program area\n";
		&verify_prog("5",$memory_type)|| killmenow( "ERROR: 5V program area verify failed\n");
		print "PASSED: 5V\n";
		&verify_prog("l",$memory_type)|| killmenow ("ERROR: V low program area verify failed\n");
		print "PASSED: V low\n";
		&verify_prog("h",$memory_type)|| killmenow ("ERROR: V high program area verify failed\n");
		print "PASSED: V high\n";
		print "Performing production verification for configuration area\n";
		&pverify_conf($memory_type) || killmenow (" configuration area verify failed\n");
		}

	&inhx8mout(*alldata);
	&resetPOHPIC;
	exit;

	}

# otherwise, write to the pic

elsif ($writefile ne "")
	{
	# check to see if the file we are going to write to the pic exists, and if it does,
	# open it, otherwise, give an error.

	if (-e $writefile)
		{
		open PICIN, $writefile || die "ERROR: Could not open $writefile\n";
		&readinhx8m; # read the datafile- leave the data in $alldata
		}
	else
		{
		die "ERROR: file $writefile does not exist\n";
		}
	
	# check to see if the datafile has code protection turned on.

	$configword = $alldata{hex(2007)};
	
	$lowbyte = $configword%256; # right shift configword
	
	# check to see if the code protection bit is enabled

	if (!($lowbyte & 16))
		{
		if (!$protect)  # if the command line parameter is not set, I will not code
				# protect a device.
			{
			print "The hex file read will code protect, but the code protect\n";
			die   "is not enabled.  Terminating.\n";
			}
		}
	# open the serial port.  One for reading, one for writing.

	#system("mode com2: baud=96 parity=n data=8 stop=1 to=on xon=off odsr=off octs=off dtr=off rts=off idsr=off > NUL");
	#open( SERIN, "+>COM2" ) or die "Can't open COM2: $!";

	# make sure I/O to serial port is unbuffered

	use FileHandle;
	select((select(SERIN), $| = 1)[0]);
	select((select(SEROUT), $| = 1)[0]);

	&resetPOHPIC;                   # reset programmer
	&startPOHPIC($memory_type);     # start the programmer

	
	# blank check
	if ($blankcheck)
		{
		print "Checking part to be sure it is blank...\n";
		&resetPOHPIC;                   # reset programmer
		&startPOHPIC($memory_type);     # start the programmer
		&blankcheck;
		print " OK\n";
		}

	# program data area

	&resetPOHPIC;                   # reset programmer
	&startPOHPIC($memory_type);     # start the programmer

	for ($count=0; $count < $maxsize; $count++)
		{
		if ( defined $alldata{$address}) # do we have data at this address?
			{
			if ($verbose)
				{
				printf ("programming: address (%s) data (%s)",&print4hex($address),&print4hex($alldata{$address}));
				}
			&program($alldata{$address});
			# if the programming was succesful, it will increment for us.
			}
		else
			{
			# no data, so just increment to the next
			&incadd;
			}
		}

	# check for a production verify, and act appropriately

	if (defined $production )
		{
		print "Performing production verification for program area\n";
		&verify_prog("5",$memory_type)|| die "5V program area verify failed\n";
		print "PASSED: 5V\n";
		&verify_prog("l",$memory_type)|| die "V low program area verify failed\n";
		print "PASSED: V low\n";
		&verify_prog("h",$memory_type)|| die "V high program area verify failed\n";
		print "PASSED: V high\n";
		}

	# program the configuration area

	&resetPOHPIC;                   # reset programmer
	&startPOHPIC($memory_type);     # start the programmer

	&goto_config;

	for ($count=0; $count < 8; $count++)
		{
		if ($alldata{$address})
			{
			if ($verbose)
				{
				printf ("programming: address (%s) data (%s)",&print4hex($address),&print4hex($alldata{$address}));
				}
			&program($alldata{$address});  
			}
		else
			{
			&incadd;
			}
		}

	# check for a production verify, and act appropriately

	if (defined $production )
		{
		print "Performing production verification for configuration area\n";
		&pverify_conf($memory_type) || die "configuration area verify failed\n";
		}

	&resetPOHPIC; #reset programmer
	}

# readfile and writefile are not defined.  I should never ever get this far

close SERIN;
close SEROUT;
exit;

#****************************************************************************
#****************************************************************************
#
#	subroutines
#
#****************************************************************************
#****************************************************************************

#****************************************************************************
#
#       printhelp
#               print out the help file and die.  Never return from this
#               subroutine
#               parameters: 
#               returns: 
#               call depth: 
#               calls:
#               uses:
#
#
#****************************************************************************   

sub printhelp

{
print << "END_USAGE";
Usage:

   Parameters:
      -h  -- What you are seeing right now.
      -d DEVICE -- program device type DEVICE
      -r FILENAME -- read contents of PIC into FILENAME, fails if FILENAME
		     exists, unless -o flag is included
      -o -- overwrite FILENAME if FILENAME as specified in -r exists
      -w FILENAME -- write contents of FILENAME into PIC
      -c YES_REALLY_PROTECT -- really write the code protection, if 
			       FILENAME specifies it
      -p -- perform production level verify
      -q -- be quiet
      -v -- be verbose (default)
      -b -- verify part is blank before programming
      -e -- erase program memory (flash device only)
      -E -- erase data memory (flash device only)
      -x -- remove code protect and erase data (flash device only)

END_USAGE
exit;
}

#****************************************************************************
#
#       readinhx8m
#       Read the INHX8M format file, PICIN, returns the data
#       in the associative array "alldata", with the address
#       as the key.
#       parameters: none explicit, but file pointed to by
#       the handle PICIN must exist and be open                
#       returns: data from file in associative array "alldata"
#       calls: only builtin
#       variables:      
#       $line - current line of file
#       $firstchar - first character of line, should be ":"
#       $sum -                                
#       $quantity - number of words to read in
#
#
#****************************************************************************

sub readinhx8m
{
$line=1;
while (!eof(PICIN))
	{
	read (PICIN, $firstchar, 1 ); # the first character of every line
					# should be ":"
	if ( $firstchar eq ':' ) 
		{
		read (PICIN, $quantity, 2); # read the  quantity from the 
					# command line
		$sum = hex($quantity);  # convert the hex to a number,
					# start the checksum
		$quantity = hex($quantity) / 2; # $quantity is the number
					# of hex bytes, but we are looking
					# for 2 byte words, so divide it
					# by 2
		read (PICIN, $haddress, 4); # read the address of the first
					# piece of data 
		$addy = hex($haddress); # convert hex address to an integer               
		$sum += int($addy/256)+$addy%256; # compute
					# the checksum 
		$iaddress = $addy/2; # the address is for bytes,
					# but again, we are looking for
					# words, so divide it by 2
		read (PICIN, $theend, 2); # if there is a 01 here, there
		$sum += hex($theend);   # is data to be read
		if ( $theend ne '01' )
			{ # read the specified number of bytes
			for ($count=1; $count <= $quantity; $count++)
				{ # the data is reversed, so we have 
				# to switch the order of the bytes before
				# we convert it to a number
				read (PICIN, $lowbyte , 2);
				$sum += hex($lowbyte);
				read (PICIN, $highbyte , 2);
				$sum += hex($highbyte);
				$data = hex ( $highbyte . $lowbyte );
				# go through a bunch of machinations to print
				# out a neatly laid out set of hex digits
				# (with the letters uppercase)
				$alldata{$iaddress}=$data;
				$iaddress++; # increment the address
				}
			read (PICIN, $checksum, 2); # read the checksum
			$sum += hex($checksum); # convert the hex into a 
						# (decimal) number, add it
						# to the sum
			$modsum = $sum%256; # the checksum is $sum mod 256
			if ($sum == 256) {$sum=0} # for some reason I gotta
						# do this
			if ($modsum == 0) # the mod of the checksum has got 
				{         # to equal 0
				#print "line: $line checksum OK!\n";
				}
			else
				{
				die "Bad checksum, line: $line, $modsum\n";
				}
			$line++; #increment the line
			}
		}
	}
close(PICIN); # We're done, close the file
}


#****************************************************************************
#
#       resetPOHPIC
#       reset the programmer, and make sure it is reset
#       parameters: 
#       returns: 
#       calls:
#       variables:
#
#
#
#****************************************************************************

sub resetPOHPIC
	{
#	print "Reset POHPIC\n";
	syswrite (SEROUT, "\r",1); # send a return
	&readuntil(">");        # wait until we see the prompt
	&printstring ("q\r");   # send a q, return to make sure we are reset
	@lines = split(/\r/,&readuntil(">")); # break up the individual lines
	$rts=0;                 # make sure the rts (ready to send) flag is 0                 
	foreach $lineread (@lines) # check all the lines
		{ # one of the lines has to say "Ready to start", or we 
		# have a failure
		if ($lineread eq "Ready to start")
			{
			$rts=1;
			}
		}
	if ($rts)
		{
		#print "ready to start!\n";
		}
	else
		{
		die "not ready to start!";
		}
#	print "Done resetPOHPIC\n";
	}

#****************************************************************************
#
#       readuntil
#       read until we get a certain character
#       parameters: character to read until 
#       returns: 
#       calls:
#       variables:
#
#
#
#****************************************************************************

sub readuntil
	{
	local ($inchar, $in);
	$untilwhat = $_[0];
#	print "readuntil: trying to match $untilwhat ... ";
	sysread (SERIN, $inchar, 1);
#	print "I just read:$in.\n";
	$in=$inchar;
	while ($inchar ne $untilwhat)
		{
		sysread (SERIN, $inchar, 1);
		#print "... $inchar";
		$in=$in.$inchar; # append the last character read to $in
		}
	#print "matched.\n";
	$in;    # return the characters read until $untilwhat
	}

#****************************************************************************
#
#       printstring
#       send a string out the serial port, character by character, making
#       sure the characters echoed are the same as the characters sent out
#       parameters: string to print out
#       returns: 
#       calls:
#       variables:
#
#
#
#****************************************************************************

sub printstring
	{
	local($offset, $out, $in, $inchar );
	#print "printstring\n";
	$offset=0; # set offset to 0
	$out = $_[0];
	$in = "";       
	while (substr($out,$offset,1) ne "")
		{
		syswrite (SEROUT, substr($out,$offset,1),1);
		#print substr($out,$offset,1);
		sysread (SERIN, $inchar, 1 );
		if (substr($out,$offset,1) eq $inchar)
			{
			#print "they match!\n"
			}
		else
			{
			print "Error: data read from serial port is not data written\n";
			}
		#print "read\n";
		$in=$in . $inchar;
		$offset++;
		}
	$in;
	}

#****************************************************************************
#
#       startPOHPIC
#
#               parameters: 
#               returns: 
#               call depth: 
#               calls:
#               uses:
#
#
#
#
#****************************************************************************

sub startPOHPIC # turn on programming
	{
	local ($outcommand, $inlines);
	if ($_[0] eq "FLASH")
		{
		$outcommand = "f\r";
		}
	elsif ($_[0] eq "EPROM")
		{
		$outcommand = "s\r";
		}
	else
		{
		die "startPOHPIC received invalid memory type\n";
		}
	&printstring($outcommand);
	$inlines=readuntil(">");
	$_=$inlines;
	if (!/Ready to program/)
		{
		die "not ready to program!";
		}
	$address=0;
	}

#****************************************************************************
#
#       readdata
#               parameters: 
#               returns: 
#               call depth: 
#               calls:
#               uses:
#
#
#
#
#****************************************************************************

sub readdata
	{
	local ($_, $inlines, $data, $newaddress);
	&printstring("r\r");
	$inlines=&readuntil(">");
	$_=$inlines;
	/A([0-9A-F]{4})/;
	$newaddress=hex($1);
	if ($address != $newaddress)
		{
		die "Address does not match in readdata\n";
		}
	/D([0-9A-F]{4})/;
	$address=$newaddress;
	$data=hex($1);
	}

#****************************************************************************
#
#       set_voltage
#               parameters: 
#               returns: 
#               call depth: 
#               calls:
#               uses:
#
#
#
#****************************************************************************

sub set_voltage
	{
	local ($_, $inlines);
	$voltage_command = $_[0];
	&printstring($voltage_command."\r");
	$inlines=&readuntil(">");
	$_=$inlines;
	if (/Error/)
		{
		die "Error setting voltage\n";
		}
	sleep 2; # sleep at most 2 seconds to make sure voltage settles after
		 # change.
	}

#****************************************************************************
#
#       verify_prog
#               parameters: 
#               returns: 
#               call depth: 
#               calls:
#               uses:
#
#
#
#****************************************************************************

sub verify_prog
# call with voltage (l, h, 5), eprom or flash return = 1 verified good

	{
	$voltage_command = $_[0];
	$mem_type = $_[1];
	&resetPOHPIC;
	&startPOHPIC($mem_type);
	&set_voltage($voltage_command);
	$good = 1;
	for ($addr_count=0; $addr_count < $maxsize; $addr_count++)
		{
		if ($verbose)
			{
			printf "Verifying: %s ...",&print4hex($addr_count);
			}
		$data = &readdata;
		if ( defined $alldata{$addr_count} )
			{
			if ( $data != $alldata{$addr_count} )
				{ #verify failure
				$good = 0;
				$addr_count = $maxsize;
				}
			}
		elsif ( $data != hex("3FFF"))
			{ #verify failure for blank location
			$good = 0;
			$addr_count = $maxsize;
			}
		&incadd;
		if ($verbose) 
			{
			if ($good)
				{
				print "ok.\n";
				}
			else	
				{
				print "failed.\n";
				}
			}
		}
	$good;
	}

	
#****************************************************************************
#
#       program
#       parameters: 
#       returns: 
#       calls:
#       variables:
#
#
#
#****************************************************************************

sub program

	{
	local($data, $programcmd, $inlines );
	$data = $_[0]; 		#data to be programmed
	$datahex=sprintf(&print4hex($data)); #put the data in a form the 
						# programmer can read
	$programcmd = "p" . $datahex . "\r"; #make the programming command
	&printstring($programcmd); # send it out to the programmer
	$inlines=&readuntil(">"); # get the response from the programmer
	$_=$inlines;
	/C([0-9A-F]{2})([0-9A-F]{2})/; # extract the number of programming
	if ($2 ne "FF")			# cycles, as long as it is not FF,
		{			# success
		if ($verbose)
			{
			if ($memory_type eq "EPROM")
				{
				printf (" %d cycles\n",hex($2));
				}
			else
				{
				print "\n";
				}
			}
		}
	else
		{	
		killmenow( "programming unsuccessful\n"); 
		}
	/A([0-9A-F]{4})/; # search the data for the address.  if it was
	$newaddress=hex($1); # was successful, the address should have
	if ($newaddress = $address + 1) #incremented by one. if not, die
		{
		$address = $newaddress;
		#printf ("increment to address (%s) successful\n",&print4hex($address));
		}
	else
		{
		die "Increment did not work: local and programmer reported addresses do not match\n";
		}
	} 

#****************************************************************************
#
#       print4hex
#	 takes numeric arguement and returns the 4 digit hex value, adding 
#	 leading zeros (255 returns 00FF)
#       parameters: value to be converted 
#       returns: hex of value to be converted
#       calls: only library functions
#       variables:
#	$_
#
#
#
#****************************************************************************


sub print4hex
	{
	local($_);
	$_=sprintf("%4.0X",$_[0]); #print the value into hex
	#print "--$_\--";
	s/ /0/g; # convert the spaces into 0s (zeros)
	#print "--$_\--";
	$_; # return the hex 
	}

#****************************************************************************
#
#       print2hex
#       parameters: 
#       returns: 
#       calls:
#       variables:
#
#
#
#****************************************************************************


sub print2hex
	{
	local($_);
	if ($_[0] > 255)
		{
		die "number too big for print2hex: $_[0]\n";
		}
	$_=sprintf("%2.0X",$_[0]);
	#print "--$_\--";
	s/ /0/g;
	#print "--$_\--";
	$_;
	}

#****************************************************************************
#
#       goto_config
#	place the programmer into the configuration area.
#       parameters: none
#       returns: new addresss in $address
#       calls: readuntil, printstring
#       variables:
#	$inlines- lines read from the programmer, used to verify address 
#		change
#	$newaddress- new address from programmer
#
#
#****************************************************************************

sub goto_config

	{
	local ($inlines, $newaddress);
	&printstring("c\r"); # send out the command to go to the config area
	$inlines=&readuntil(">"); # wait for the > prompt
	$_=$inlines;	# make sure the address is 0x2000, otherwise, fail
	/A([0-9A-F]{4})/;
	$newaddress=hex($1);
	if ($newaddress == 8192)
		{
		$address = 8192;
		#printf ("increment to address (%s) successful\n",&print4hex($address));
		}
	else
		{
		die "Goto Config did not work: local and programmer reported addresses do not match\n";
		}
	}
#****************************************************************************
#
#       verify_conf
#       parameters: memory type
#       returns: 1 if good, 0 if failure 
#       calls: &resetPOHPIC, &startPOHPIC, &goto_config, &set_voltage,
#		&readdata
#	variables:
#
#
#
#****************************************************************************

sub pverify_conf

	{
	local ($voltage_command, $mem_type, $good);

	$mem_type = $_[0];
	&resetPOHPIC;
	&startPOHPIC($mem_type);
	&goto_config;
	while ( $address != hex("2007") ) #go to configuration word
		{
		&incadd;
		}
	if ($verbose){print "Verifying 2007...\n";}
	$good = 1;
	if ( &readdata != $alldata{$address} )
		{
		$good=0;
		print " ERROR: 5V "; #configuration failure
		}
	else
		{
		print "PASSED: 5V\n";
		&set_voltage("l"); # I might need delays between these- so the 
				# voltage is sure to settle to the proper value
		if ( &readdata != $alldata{$address} )
			{
			$good=0;
			print "ERROR: V low "; #configuration failure
			}
		else
			{
			print "PASSED: V low\n";
			&set_voltage("h");
			if ( &readdata != $alldata{$address} )
				{
				$good=0;
				print "ERROR: V high "; #configuration failure
				}
				print "PASSED: V high\n";
			}
		}
	$good;
	}

#****************************************************************************
#
#       inhx8mout
#       parameters:
#       returns:  
#       calls:
#	variables:
#
#
#
#****************************************************************************

sub inhx8mout
	{
	#print "inhx8mout\n";

	local (*dataout) = @_;
#	$linecount=1;
	$newline=1;
	for ($outaddress=0; $outaddress < $maxsize; $outaddress++)
		{
		#print "--$outaddress $dataout{$outaddress}--\n";
		if ($dataout{$outaddress} != 16383) # = 0x3FFF
			{
			$_=&print4hex($dataout{$outaddress});
			/([0-9A-F]{2})([0-9A-F]{2})/;
			if ($newline)
				{
				$lineadd=$outaddress;
				$newline=0;
				$outcount=2;
				$outline=$2.$1;
				$outsum=hex($1)+hex($2);
				}
			else
				{
				$outline=$outline.$2.$1;
				$outcount+=2;
				$outsum+=hex($1)+hex($2);
				}
			}
		else
			{
			$printit=1;
			}
		#print "$outline\n";
		if (($outcount >=16)|($printit&!$newline)) # print out line
			{
			$_=&print4hex(2*$lineadd);
			/([0-9A-F]{2})([0-9A-F]{2})/;
			$checkout=256-(($outsum+$outcount+hex($2)+hex($1))%256);
			if ($checkout == 256) { $checkout=0 };
			#print "$outsum $outcount ", hex($2)," ", hex($1), " $checkout\n";
			printf (PICOUT ":%s%s00%s%s\n",&print2hex($outcount),$_,$outline,&print2hex($checkout));
			$newline=1;
			$outcount=0;
			}
		$printit=0;
		}
	if (!$newline)
		{
		$_=&print4hex($lineadd);
		/([0-9A-F]{2})([0-9A-F]{2})/;
		$checkout=256-(($outsum+$outcount+hex($2)+hex($1))%256);
		#print "last: $outsum $outcount ", hex($2)," ", hex($1), " $checkout\n";
		printf (PICOUT ":%s%s00%s%s\n",&print2hex($outcount),$_,$outline,&print2hex($checkout));
		$newline=1;
		}
	for ($count=0; $count < 8; $count++)
		{
			$outaddress=8192+$count;
			if ($dataout{$outaddress} != 16383) # = 0x3FFF
			{
			$_=&print4hex($dataout{$outaddress});
			/([0-9A-F]{2})([0-9A-F]{2})/;
			if ($newline)
				{
				$lineadd=$outaddress;
				$newline=0;
				$outcount=2;
				$outline=$2.$1;
				$outsum=hex($1)+hex($2);
				}
			else
				{
				$outline=$outline.$2.$1;
				$outcount+=2;
				$outsum+=hex($1)+hex($2);
				}
			}
		else
			{
			$printit=1;
			}
		#print "$outline\n";
		if (($outcount >=16)|($printit&!$newline)) # print out line
			{
			$_=&print4hex(2*$lineadd);
			/([0-9A-F]{2})([0-9A-F]{2})/;
			$checkout=256-(($outsum+$outcount+hex($2)+hex($1))%256);
			if ($checkout == 256) { $checkout=0 };
			#print "$outsum $outcount ", hex($2)," ", hex($1), " $checkout\n";
			printf (PICOUT ":%s%s00%s%s\n",&print2hex($outcount),$_,$outline,&print2hex($checkout));
			$newline=1;
			$outcount=0;
			}
		$printit=0;
		}
	if (!$newline)
		{
		$_=&print4hex($lineadd);
		/([0-9A-F]{2})([0-9A-F]{2})/;
		$checkout=256-(($outsum+$outcount+hex($2)+hex($1))%256);
		#print "last: $outsum $outcount ", hex($2)," ", hex($1), " $checkout\n";
		printf (PICOUT ":%s%s00%s%s\n",&print2hex($outcount),$_,$outline,&print2hex($checkout));
		}
	print PICOUT ":00000001FF\n";
	close (PICOUT);
	}

#****************************************************************************
#
#       blankcheck
#	make sure the part is blank before programming
#       parameters:
#       returns:  
#       calls:
#	variables:
#
#
#
#****************************************************************************

sub blankcheck
	{
	for ($count=0; $count < $maxsize; $count++)
		{
		if ($verbose)
			{
			printf "Address: %s:",&print4hex($count);
			}
		if (&readdata ne hex("3FFF"))
			{
			die "Part not blank\n";
			}
		else
			{
			if ($verbose)
				{
				print "blank\n";
				}
			&incadd;
			}
		}
	&goto_config;
	for ($count=0; $count < 3; $count++)
		{
	        if ($verbose)
                        {
                        printf "Address: %s:",&print4hex($address);
                        } 
		if (&readdata ne hex("3FFF"))
			{
			die "Part not blank\n";
			}
		else
			{
                        if ($verbose)
                                {
                                print "blank\n";
                                }
			&incadd;
			}
		}
	&incadd;
	&incadd;
	&incadd;
	&incadd;
	
        if ($verbose)
                {
                printf "Address: %s:",&print4hex($address);
                }
	if (&readdata ne hex("3FFF"))
		{
		die "Part not blank\n";
		}
	else
		{
		if ($verbose)
			{
			print "blank\n";
			} 
		} 
	}

#****************************************************************************
#
#       incadd
#	increment the address
#       parameters: none
#       returns: new (incremented address in $address 
#       calls: printstring, readuntil
#	variables:
#	$_ - for searching
#	$newaddress - address read from programmer
#	$inlines - input lines from programmer
#
#****************************************************************************

sub incadd
	{
	local ($inlines, $newaddress);
	&printstring("i\r"); # send the increment command
	$inlines=&readuntil(">"); # keep reading until we get >
	$_=$inlines;
	/A([0-9A-F]{4})/; # search the lines we read for the reported address
	$newaddress=hex($1); # convert the address (hexadecimal string) to an integer
	if ($newaddress = $address + 1) # if it really incremented, success
		{
		$address++;
		#printf ("increment to address (%s) successful\n",&print4hex($address));
		}
	else                            # otherwise, failure, and indicate it
		{
		die "Increment did not work: local and programmer reported addresses do not match\n";
		}
	}

#****************************************************************************
#
#	killmenow
#	reset the programmer and die, printing a message
#       parameters: message to print
#       returns: it doesn't 
#       calls: resetPOHPIC
#	variables:
#
#****************************************************************************

sub killmenow

	{
	&resetPOHPIC;                   # reset programmer  
	close SERIN;
	close SEROUT; 
	die $_[0];
	}

#****************************************************************************
#
#       removeerase
#	remove code protection or erase memory (data or program)
#       parameters: which to erase, memory type
#       returns: o if failure, 1 if success 
#       calls: resetPOHPIC, startPOHPIC, printstring, readuntil
#	variables:
#	$_ - for searching
#	$command - command to send to programmer
#	$inlines - input lines from programmer
#	$good - success or not
#
#****************************************************************************

sub removeerase
	
	{
	local($command, $good);
        &resetPOHPIC;
        &startPOHPIC($_[1]);
	$_ = $_[0];
        RE_SWITCH:
                {
                if (/remove_code_protection/)
                        {
			$command = "X\r";
                        last RE_SWITCH;
                        };               
		if (/erase_program/)
			{
			$command = "e\r";
			last RE_SWITCH;
			}
		if (/erase_data/)
			{
			$command = "E\r";
			last RE_SWITCH;
			} 
		}
        &printstring($command); # send the command
        $inlines=&readuntil(">"); # keep reading until we get >
	$good = 1;
        $_=$inlines;         
	if (/error/i)
		{
		$good = 0;
		}
	&resetPOHPIC;
	$good;
	}