#!/usr/bin/perl -w # $Id: progM01,v 1.22 2003/09/28 08:06:53 tomj Exp $ # Copyright Tom Jennings 2003 # tomj@wps.com, http://wps.com # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License as # published by the Free Software Foundation; either version 2 of # the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public # License along with this program; if not, write to the Free # Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, # MA 02111-1307, USA. # DESCRIPTION: # This program is a companion to the WPS Model A1 Programmer and # Model 01a Control Engine. A serial interface is required on the # host machine. In turn, the A1 Adapter could be used with any # compatible Microchip Inc PIC in-circuit-programming circuit. # * The WPS Model 01a Control Engine is a general purpose # control engine built around a PIC16F628A (or pin-compatible # chip, below) controller, with the onboard circuitry necessary # to support "in-circuit" programming; there's no need to keep # swapping the PIC chip from your board to the programmer. See # http://wps.com/products/Model-01. # * The Model A1 Programmer is itself a PIC16F628A plus as few # as possible components to talk to the host server running # the progM01 program and to the target PIC on the Model # 01a. The code and schematics are available for free at # http://wps.com/products/Model-A1. # Only "high voltage" programming mode is supported, which # is the one you want, believe me (RTFM). # This is a "command line" program. See the USAGE section for # command line options. # SUPPORTED PIC CHIPS: # PIC16F627A # PIC16F628A # PIC16F648A # Or anything with compatible programming pins and requirements, # HOWEVER, note that this program uses device ID data read from # the chip to index a table here, for other chips you'll have # to expand the table. # TECHNICAL INFO: # The input to progM01 is an Intel hex file, produced by # most PIC compilers and assemblers. (Intel Hex 8-bit Merged, aka # INHX8M, to be exact.) # Communication with the A1 Programmer is via serial interface. All of # the chip-specific timing is done in the A1 Programmer; this # program only has to output correctly formatted data, and does no # system-specific timing, therefore it should be portable to any # system with a serial port. Additionally, most of the commands # issued by this program are ASCII printable characters. # Each command output is acknowledged with an ACK character, # generally "_". This program issues the correct command byte # and data, then waits for the ACK character. This guarentees that # we're not overrunning the Model A1 Adapter. At 115,200 baud the # lost time is minimal. (ACK is slightly slower than hardware handshake # but vastly simpler to implement, and more reliable; I had # problems CTS handshake on my system (RedHat linux 9, 2.4.20 # kernel, pcmcia serial) it occasionally output a character with CTS # low, ruining the protocol.) # This version is written for redhat linux but it should port to # MSDOS/Windows easily enough, as long as you can make it talk # to the serial port. Non-blocking I/O is preferred but blocking # will do in a pinch (all you'll lose is soft failure if the # A1 Adapter isn't connected to the serial port.) # The operating system must provide access to the following serial # port signals: # RxD, TxD Receive and transmit data (no duh) # To support the default, high-speed hardware-handshake mode. # PIC PROGRAMMING COMMANDS # The Microchip-defined programming codes and sequence are produced # in this program, and transmitted to the target PIC via the Model # A1 Programmer Adapter via the serial port, and generates the # control signals necessary to write the codes into the target # PIC in-circuit. # PIC programming commands are one or three bytes. A few return # data to the host. # Some commands has a minimum execution time (eg. program and erase). # The A1 Adapter takes care of this; this host software doesn't # need to worry about it. # The detailed PIC programming sequence is defined in the Microchip # documentation. ############################################################# # # Serial port specification. my $devname= "/dev/ttyS0"; # umm, it's name my $speed= 115200; # default bit rate # # ############################################################# my $ackchar= "_"; # Model A1's ACK character # PIC memory space, in programming mode, device-specific. # These constants apply to the supported chips listed above, only. my %PICIDs= ( # Device ID => prog RAM part number "0x1040" => "1023 127 PIC16F627A", "0x1060" => "2047 127 PIC16F628A", "0x1100" => "4095 255 PIC16F648A", ); # PIC device IDs are formatted thusly: # Device Dev Rev ID, hex # PIC16F627A 01 0000 010 x xxxx 0x1040 # PIC16F628A 01 0000 011 x xxxx 0x1060 # PIC16F648A 01 0001 000 x xxxx 0x1100 $DEVIDMASK= 0x3fe0; # clear revision bits my $MAXADDR= 0x3fff; # highest address, 14-bit PC my $UNREADABLE= 0x3fff; # value returned for missing PIC my $PEND; # end of program memory (from %space), my $DEND; # end of EE data memory (from %space), my $UMEM= 0x2000; # start of user memory, my $UEND= 0x2003; # last user memory, my $CMEM= 0x2000; # start of config space, my $CEND= 0x2007; # end of config space, # PIC commands, offset by 32, or ASCII space. This makes all of the # commands printable and typable by humans (and passable by even # shitty operating systems). # PIC type my $LOADCONF= " "; # 0 B load config my $LOADPROG= '"'; # 2 B load program memory my $LOADDATA= '#'; # 3 B load data memory my $READPROG= '$'; # 4 C read program memory my $READDATA= '%'; # 5 C read data memory my $INCREMENT= "&"; # 6 A increment address my $PROGRAM= "("; # 8 A program cycle start my $BULKPROG= ")"; # 9 A bulk erase program memory my $BULKDATA= "+"; # 11 A bulk erase data memory # Programmer commands. my $VERSION= "A"; # 0 C returns programmer version my $IDLEMODE= "B"; # 1 A set target to idle mode my $PROGMODE= "C"; # 2 A set target to program mode my $SDELAY= "D"; # 3 B set short and long delays my $NOOP= "E"; # 4 A guarenteed to be ignored my $ACKON= "F"; # 5 A use ACK mode my $ACKOFF= "G"; # 6 A use hardware handshake # type A: one byte command. # type B: three byte command. # type C: three byte command, read two bytes from PIC. my $PC= 0; # target PIC PC my @DATA= (); # program & data loaded into/read from target my $errors= 0; # global error accumulator, my $devid; # device ID read from the PIC my $config; # configuration register from PIC my $verbose= 0; # increase chattiness when non-zero # Very dumb but entirely readable command line options. getopt() # is great but all the flag vars are annoying. The hash version # isn't much better. use vars qw/$opt_h/; use vars qw/$opt_p $opt_e $opt_r $opt_m $opt_a/; use vars qw/$opt_c $opt_z $opt_t $opt_b $opt_v/; use Getopt::Std; getopts ("p:ermaczt:b:v"); &usage if $opt_h; # Bail on stupid combinations. my $foo= 0; # tally up COMMANDS, foreach ($opt_p, $opt_e, $opt_r, $opt_m, $opt_a) { ++$foo if defined $_; } &usage if $foo != 1; &usage if defined $opt_c # check for bad OPTIONS and not defined $opt_p; # -c with -p only print STDERR "$0: -h for usage\n"; $verbose= $opt_v; # make this global # Open the serial device to talk to the Model A1. $devname= $opt_t if defined $opt_t; # optional name $speed= $opt_b if defined $opt_b; # and speed &serinit ($devname, $speed); # open and init, &leave () if $errors; # can't continue. # Make sure the adapter and target exist before continuing. # adapter_exists() should be done with ACKmode off, since we # gobble up all the text, and ACKmode returns characters as # ACKs to commands. (Likely no one will ever use ACKmode, but # there it is.) &adapter_exists ($opt_a); # make sure adapter present, &leave() if $errors; # Here we read the device ID from the chip (error if we can't). # From the device ID we can tell the dimensions of the chip. ($devid, $config)= &target_exists; # read device ID stuff, &leave () if $errors; # then, there's that... &select_target_device ($devid); # select PIC device, &leave () if $errors; # then, there's that... &leave () if $opt_a; # # Perform the advertised functions. Only one of these is true. &write_program ($opt_p, $opt_c) if $opt_p; # program PIC, &target_reset() if $opt_r; # reset target PIC, &bulk_erase() if $opt_e; # bulk erase, &read_program( )if $opt_m; # dump PIC to console, &leave; # I was just leaving! ############################################################# # # &leave (optional_returncode); # # Closes the serial device, prints a message if there were # errors. If a return code is specified we exit with # that, else we return 0 if OK else error. sub leave { my $e= shift; # optional return value close (DEV); print STDERR "FAILURE: not complete, due to $errors errors!\n" if $errors; exit ($e) if defined $e; exit ($errors ? 2 : 0); } ############################################################# # # &select_target_device ($devid); # # Given the device ID read from the chip, set up the bulk # characteristics; program, RAM size, etc. Sets $errors if a # problem is found. sub select_target_device { my $id= shift; my $msg1= "Target PIC missing or damaged (bad DeviceID=0x%04x)"; my $msg2= "Unknown PIC type! Microchip Inc. DeviceID=0x%04x rev=02%02x\n"; my $rev; $rev= $id & ~$DEVIDMASK; # extract revision, $id &= $DEVIDMASK; # and device ID, my $ids= sprintf ("0x%04x", $id); # make it text! if (exists $PICIDs{$ids}) { # extract data for this chip, ($PEND, $DEND, $foo)= split (/ /, $PICIDs{$ids}); print STDERR "Target device: $foo revision $rev\n"; } elsif (($id == 0) or ($id == $UNREADABLE)) { &error ($msg1, $id); # can't read it, } else { &error ($msg1, $id, $rev); # don't know what it is. } } ############################################################# # # &adapter_exists ($verbosity); # # Issue a VERSION command; we better get something back. The A1 # outputs test followed by CR, LF. We read all text up to the # LF. This is different from all other A1 Adapter commands. sub adapter_exists { my $v= shift; &typeA ($NOOP); # in case MA1 is expecting &typeA ($NOOP); # args from prev. command, # Note that the "version" command outputs a variable length string # preceeding the ack char, so we don't use &typeA( ) here, we do # it ourselves. &docmd ($VERSION); # output the version command, my $foo= &serin (100, $ackchar); # read result, if (defined $foo) { $foo =~ tr/\r\n//d; # delete CR and LF chop $foo; # clip ackchar, print STDERR "Hello, programmer says: \"$foo\".\n" if $v; } else { &error ("Cannot detect presence of Programmer Adapter!"); } } ############################################################# # # &target_reset; # # Resets the target; IDLEMODE bounces Vdd off then on # and leaves the A1 Adapter inert (as far as the target is # concerned). sub target_reset { &typeA ($IDLEMODE); print STDERR "Target PIC reset.\n" if $verbose; } ############################################################# # # ($id, $config)= &target_exists; # # Check for the presence of the target PIC by trying to read it's # device ID and configuration register. sub target_exists { my ($devid, $config); &typeA ($PROGMODE); # enter PROGRAM mode, &typeB ($LOADCONF, $CMEM); # load config data, foreach (1..6) { &typeA ($INCREMENT); } # go to PC=2006, $devid= &typeC ($READPROG); # read Device ID, &typeA ($INCREMENT); # now PC=0x2007, $config= &typeC ($READPROG); # read config reg, &typeA ($IDLEMODE); # back to normal, # &display_config_reg ($verbose, $config); return ($devid, $config); } ############################################################# # # &bulk_erase(); # # Bulk-erase the PIC. It's slightly tricky; what gets erased # depends on the CP/CPD bits and the value of the PC. In short, # we erase everything (UID, config, program) here. sub bulk_erase { print STDERR "Erasing, " if $verbose; &typeA ($PROGMODE); # enter program mode, &typeB ($LOADCONF, $CMEM); # set PC=0x2000 foreach (1..7) { &typeA ($INCREMENT); } # increment to 0x2007, &typeA ($BULKPROG); # erase everything # my $foo= &typeC ($READPROG); # read config register, &typeA ($IDLEMODE); # normalize target, } ############################################################# # # &write_program (filename, verify); # # This writes the contents of the Hex file to the PIC. It does # PROGRAM, UID, CONFIGURATION then DATA memory, in that order. # # If verify is true, it makes a full verify pass, in addition to # the per-address read after write. sub write_program { my $file= shift; # file progrma stored in, my $verf= shift; # do a verify pass my $top; # Load the file and check it. @DATA= &read_hex_file ($file); # try to read file, &leave if $errors; # bad, very bad, &leave if &check_bad_data (@DATA); # check details # Since programming is relatively slow, determine the highest # program location we need to write. For small programs this could # save a lot of time. for ($top= my $i= 0; $i <= $PEND; ++$i) {# check all of user space, $top= $i if defined $DATA[$i]; # remember highest, } # Bulk-erase, then write everything we loaded from the file. &bulk_erase; # erase first, &leave if $errors; # not very good at all, print STDERR sprintf ("\rAddress 0x%04x writing", 0) if $verbose; &typeA ($PROGMODE); # enter program mode, &progloop ("wr", 0, $top); # program memory, &confloop ("wr"); # then config memory, &typeA ($IDLEMODE); # leave program mode, # Verify pass, optional, and skipped if known errors. return if not $verf; print STDERR "\nVerify pass skipped due to errors.\n" if $errors and $verbose; return if $errors; print STDERR sprintf ("\rAddress 0x%04x verifying", 0) if $verbose; &typeA ($PROGMODE); # enter program mode, &progloop ("r", 0, $top); # verify program memory, &confloop ("r"); # verify config memory, &typeA ($IDLEMODE); # leave program mode, } # Local routine. # Check the data just loaded from the disk file; make sure # there is nothing in reserved areas, and that the configuration # register is OK. Returns true if error. sub check_bad_data { my @DATA= @_; my $msg1= "File contains data in forbidden address 0x%04x!"; my $msg2= "Configuration register setting(s) are incompatible " . "with the WPS Model 01a Control Engine"; foreach (0x2004, 0x2005, 0x2006) { # reserved locations &error ($msg1, $_) if defined $DATA[$_]; } # &error ($msg2) # if &display_config_reg ($verbose, $DATA[0x2007]); return ($errors); } ############################################################# # # &confloop (what); # # This routine writes into the config memory range. The # algorithm is slightly different than for program memory. # We can assume that the 'reserved' locations have no # data to write, hence won't get written here. See # read_hex_file() or whatever it's called. # # "What" is a string; w=write, r=read. Either or both. sub confloop { my $what= shift; my $msg1= "Address 0x%04x: wrote 0x%04x but read back 0x%04x\n"; my $msg2= "\r Configuration register written.\n"; print STDERR "PROGRAM-CONFIG WORKS AS LONG AS THERE'S NO UID DATA\n"; &typeB ($LOADCONF, $MAXADDR); # required, sets PC=0x2000 for ($PC= $CMEM; $PC <= $CEND; ++$PC) { # all of it, it's small my $w= $DATA[$PC]; # see what was in the hex file, if (defined $w) { # if anything, if ($what =~ /w/) { # write it, if told to, &typeB ($LOADPROG, $w); &typeA ($PROGRAM); } if ($what =~ /r/) { # read it back and compare, my $d= &typeC ($READPROG); &error ($msg1, $PC, $w, $d) # oops if not defined($d) or $d != $w; } } &typeA ($INCREMENT); # next... } print STDERR sprintf ($msg2) if $verbose; } ############################################################# # # &progloop (what, start, end); # # This routine does writing and verifying of program memory # ONLY. It requires that the global array @DATA contain the image # of PIC memory contents. # # "What" is a string; w=write, r=read. Either or both. # # Start and end are the lowest and highest addresses # to read/write. sub progloop { my ($what, $start, $end)= @_; my $msg1= "\rAddress 0x%04x: wrote 0x%04x but read back 0x%04x\n"; my $msg2= "\rAddresses 0x%04x through 0x%04x OK\n"; my $w; my $last; for ($PC= $last= $start; $PC <= $end; ++$PC) { print STDERR sprintf ("\rAddress 0x%04x ", $PC) if ($PC % 16 == 0) and $verbose; # show progress... $w= $DATA[$PC]; # w= word for this address, if (defined $w) { if ($what =~ /w/) { # if we're writing, $last= $PC; # remember last addr used, &typeB ($LOADPROG, $w);# write the word, &typeA ($PROGRAM);# burn, baby, burn! } if ($what =~ /r/) { # if we're reading, $last= $PC; $d= &typeC ($READPROG);# read memory, &error ($msg1, $PC, $w, $d) if not defined($d) or $d != $w; } } &typeA ($INCREMENT); # increment PIC PC, } print STDERR sprintf ($msg2, $start, $last) if $verbose; } ############################################################# # # &read_program; # # Reads the contents of the target PIC and displays it in # hex. We make the rash assumption that when we find an # empty memory location that there is nothing past it. # Strictly speaking, this doesn't have to be true. sub read_program { &typeA ($PROGMODE); # reset and enter PROGRAM MODE, &typeB ($LOADPROG, 0); # set starting address, for ($PC= 0; $PC <= $PEND; ++$PC) { $d= &typeC ($READPROG); # read memory, last if $d == $UNREADABLE; # stop if unused memory, print STDERR sprintf ("%04x: %04x\n", $PC, $d); &typeA ($INCREMENT); # increment PIC PC, } &typeB ($LOADCONF, $MAXADDR); # set starting address, for ($PC= $CMEM; $PC <= $CEND; ++$PC) { $d= &typeC ($READPROG); # read memory, print STDERR sprintf ("%04x: %04x\n", $PC, $d); &typeA ($INCREMENT); # increment PIC PC, } &typeA ($IDLEMODE); } ############################################################# # # $warning= &display_config_reg (verbose, word); # # Expands the values of the 14-bit copy of the config # register. Returns true if an incompatible config reg # setting is chosen. # # This is really ugly. It needs a re-think. sub display_config_reg { my $display= shift; my $r= shift; my $f= $r & 0x13; # FOSC bits if ($display) { print STDOUT sprintf ("Configuration word 0x%04x:", $r); if ($r == $UNREADABLE) { print STDOUT " erased\n"; return 0; } print STDOUT "\n"; print STDOUT " CP: ", $r & 0x2000 ? "OFF" : "ON ", " # Code Protect\n"; print STDOUT " CPD: ", $r & 0x0100 ? "OFF" : "ON ", " # Code Protect Data\n"; print STDOUT " LVP: ", $r & 0x0080 ? "ON " : "OFF*", " # Low-Voltage Program\n"; print STDOUT " BOREN: ", $r & 0x0040 ? "ON " : "OFF", " # Brown-Out Reset\n"; print STDOUT " MCLRE: ", $r & 0x0020 ? "ON " : "OFF", " # MCLR pin\n"; print STDOUT " PWRTE: ", $r & 0x0010 ? "OFF" : "ON*", " # Power-Up Timer\n"; print STDOUT " WDTE: ", $r & 0x0004 ? "ON " : "OFF", " # WatchDog Timer\n"; print STDOUT " Osc.: "; print STDOUT "RC, CLKOUT pin\n" if $f == 0x13; print STDOUT "RC, RA6 pin\n" if $f == 0x12; print STDOUT "INTOSC, CLKOUT pin\n" if $f == 0x11; print STDOUT "INTOSC, RA6 pin\n" if $f == 0x10; print STDOUT "EXTCLK\n" if $f == 0x03; print STDOUT "HS\n" if $f == 0x02; print STDOUT "XT\n" if $f == 0x01; print STDOUT "LP\n" if $f == 0x00; } # Return true if LVP or MCLRE are not as we need them, or if # a funny clock mode is chosen. $r &= (0x80 | 0x20); # LVP and MCLRE, return $r != 0x20; # LVP=0, MCLRE=1 } ############################################################# # # Command issuing routines. # # &typeA (cmd); # &typeB (cmd, word); # $v= &typeC (cmd); # # A and B types simply send the command (A, B), and args (B), and wait # for ACK. Type C issues the command and attempts to read # two characters from the MA1 from which it assembles the return # value; there is no explicit acknowledge, since it's implicit in # the return characters. sub typeA { my $cmd= shift; &docmd ($cmd); # send command, &doack(); # get acknowledge. } sub typeB { my $cmd= shift; my $arg= shift; $arg= int $arg << 1; # create arg as per spec my $b1= $arg & 0xff; # we issue it as two my $b2= ($arg >> 8) & 0xff; # consecutive chars, &docmd ($cmd, chr $b1, chr $b2); # send command, LS, MS bytes &doack(); } # Local routine to write out commands and check returns from serout. sub docmd { my $e= &serout (@_); # write out data, &error ("SOME WEIRD ERROR WRITING TO PROGRAMMER ADAPTER!") if not defined $e; # oops &error ("WRITE TO PROGRAMMER ADAPTER FAILED!") if not $e; # didn't write all chars. } # Local routine to wait for an ACK character, if required, and # complain if it fails. sub doack { my $c= &serin (1); # get the ack char, &error ("SOME WEIRD ERROR WAITING FOR COMMAND ACKNOWLEDGE " . "FROM PROGRAMMER ADAPTER!") if not defined $c; return 1 if $c eq $ackchar; # OK, normal case. my $n= ord $c; # magically it's a number, my $zz= sprintf ("GOT %02d INSTEAD OF ACKNOWLEDGE ($ackchar)" . " FROM PROGRAMMER ADAPTER!", $n); &error ($zz); return 0; } sub typeC { my $cmd= shift; &docmd ($cmd); # issue command, my $b1= &serin(1); # read LS byte, my $b2= &serin(1); # read MS byte, if (not defined $b1 or not defined $b2) { &error ("FAILED TO READ RESULT VALUE FROM COMMAND"); return $UNREADABLE; } $b1= unpack "C", $b1; $b2= unpack "C", $b2; my $v= ($b2 << 7) | ($b1 >> 1); # assemble 14-bit word, &doack(); return $v; } # # ############################################################# ############################################################# # # @DATA= &read_hex_file (filename); # # Read Intel 8-bit merged hex file (INHX8M), with binary data # returned in an array. Data not specified in the file remains undef. # An empty array is an error. If other errors are detected, # $errors is set. # # INHX8M file format is exactly the same as plain old Intel hex, # but interpreted differently. The data model behind plain hex # is a linear array of 8-bit bytes, but INHX8M assumes a linear # array of byte-addressable 16-bit words addressed Little Endian. # Eg. within a given record, the even addressed byte is the LS # byte of the stored word, and the odd addressed byte is the MS # byte of the word. (If the target machine has say 14-bit words, # as the PIC16Fxxx chips do, then the payload data will be 14-bit # data encoded as two hex-encoded bytes (four characters); an INHX8M # record containing a single 14-bit word consisting of all ones, # loaded at word address 0x0040, would look like: # # : 00 0080 FF 3F ... # # 0080 is the byte address for the word to be stored; FF the LS byte, # 3F the MS byte. # # : nn aaaa tt dd dd dd ... cc # nn payload (dd) byte count # aaaa byte address # tt type # dd data bytes (intel hex) LS, MS bytes in taget word (INHX8M) # cc checksum of all characters in record except : and cc. # # types: # 00 data # 01 termination record (one, must be last) # 02 segment address # 04 extended address (upper 16 bits) # # Sample interpretation of INHX8M: # # :10 0000 00 03 1E 08 00 86 01 5F 30 8C 00 0D 30 84 00 80 01 E3 # 1e03 0008 0186 305f 008c 300d 0084 0180 # # :10000000031E080086015F308C000D3084008001E3 # :10001000840A8C0B07282C282120840007398406A9 # :100020000310840C840C840C041A841704128A01B3 # :10003000820701340234043408341034203440344C # ... # :0403A00064000800ED # :084000007F007F007F007F00BC # :04400E00FD3F010071 # :00000001FF sub read_hex_file { my $fn= shift; my $inhx8m= 1; # 1 == INHX8M format, else Intel Hex my @L; my @DATA; # where we build the binary data, my $addroff; # extended address, my $lineno; # input file line number, my $count; # recd byte count, my $addr; # recd address, my $type; # recd type, my $msg1= "file %s line %s: not an Intel Hex record!"; my $msg2= "file %s line %s: address=0x%04x out of range for this chip!"; my $msg3= "file %s line %s: unsupported record type %d!"; my $msg4= "file %s line %s: Checksum failure!"; return &error ("File \"$fn\" not found!") # obviously, if not open (F, "<$fn"); # we need an input file. $lineno= 0; $addroff= 0; # address NOT "extended", foreach () { ++$lineno; $_ =~ tr/:0-9A-F//cd; # delete crap, next if not $_; # ignore empty line @L= split (//, $_); # decompose line, my $r= shift @L; # get recd indicator, if ($r ne ":") { &error ($msg1, $fn, $lineno); last; # not a hex record, } ($count, @L)= &dehex (2, @L); # make byte count from 1st two, ($addr, @L)= &dehex (4, @L); # make addr from next 4, ($type, @L)= &dehex (2, @L); # then record type, if ($type == 1) { # termination record, last; } elsif ($type == 4) { # extended address, $addroff= $addr << 16; # set "upper 16 bits", next; } elsif ($type != 0) { # if not data record, &error ($msg3, $fn, $lineno, $type); --$errors; # uncount error, next; # skip this record, # last; # unsupported recd type, } # The checksum at the end of the record includes all of the # data BYTES (bytes) in the record, eg. the count through last # data byte inclusive. my $checksum= $count + $type + ($addr & 255) + ($addr >> 8); # The rest of the record is pairs of data characters and the # two-character checksum. For INHX8M the target word address is # half the record address, and each word is two record bytes, # in Little Endian order. if ($inhx8m) { # fixup $count /= 2; # word not byte count, $addr /= 2; # word not byte address, } # The data address must be in range, either program memory or # config memory. unless (($addr + $count < $PEND) or (($addr >= $CMEM) and ($addr <= $CEND))) { &error ($msg2, $fn, $lineno, $addr + $count); # addr out of range last; } while ($count--) { # (count may be 0) (my $d, @L)= &dehex (2, @L); # data byte, $checksum += $d; # build the checksum, $DATA[$addr + $addroff]= $d; # store in array, if ($inhx8m) { # if INHX8M, ($d, @L)= &dehex (2, @L); # merge in upper $checksum += $d; $DATA[$addr] += $d << 8; # byte } ++$addr; # next address... } # Compare the record checksum vs. the one we made. ($d, @L)= &dehex (2, @L); # get checksum, $checksum &= 255; # make ours a byte, if ((($checksum + $d) & 255) != 0) { &error ($msg4, $fn, $lineno); @DATA= (); last; # checksum failure, } last if $type == 1; # end of file. } close F; return @DATA; # $errors if error. } # # ($n, @LIST)= &dehex ($chars, @LIST); # # Given a list of hexadecimal characters, take ($chars) from # the top of the list, convert to a number, return the # numeric value and the shortened list. sub dehex { my $chars= shift; # char count, my @L= @_; # the rest of the list, my $n= 0; while ($chars--) { $n <<= 4; # shift over hex digit's worth, $n += hex $L[0]; # add new hex digit, shift @L; # eat the character. } return ($n, @L); } ############################################################# # # &error ("sprintf format", args ...); # # Complain loudly, count errors. sub error { my $fmt= shift; # @_ used; see sprintf() my $ERRORMAX= 24; if (++$errors < $ERRORMAX or defined $opt_z) { print STDERR "ERROR: ", sprintf ($fmt, @_), "\n"; } elsif ($errors == $ERRORMAX) { print STDERR "...plus many more not listed (-z to see 'em all)\n"; } } ############################################################# # # serinit (devname, bit rate); # # Initialize the serial device for read/write, leave it open # as the global glob DEV. For linux, this is all POSIX compliant, # except for the crtscts setting for stty. # # See: # man perlfunc, functions open, sysopen # man perlopentut # man perlfaq8 sub serinit { # Open the device in non-blocking, raw mode first. use Fcntl; # O_ definitions, sysopen (DEV, "$devname", O_RDWR|O_NDELAY|O_BINARY) or error ("Can't open serial device $devname"); # Tell Perl to autoflush. my $foo = select (DEV); $| = 1; select ($foo); # set autoflush # Finally, set the bit rate and enable control signals. Note that # crtscts is non-POSIX. my $e= "/bin/stty -F $devname $speed raw cs8 clocal"; print STDERR "Executing: $e\n" if $verbose; qx"$e"; } ############################################################# # # serout (list); # # Output character(s) to the serial device. # # This returns the number of characters written. sub serout { my $n; # chars written per iteration, my $t; # end time, my $count; # how much we need to write # Loop until all characters are written, or we timeout. For the # old WPS method, we output one character per iteration, otherwise # we write as fast as the hardware will take it -- which might be # only one per iteration, but at least it won't have all the awful # sleeps in it. for ($t= time + 2, $count= scalar @_; $count and (time < $t); ) { $n= syswrite (DEV, join ('', @_), scalar @_); # FIXME # qx/usleep 100000/; # FIXME # Now account for what just took place. if (not defined $n) { print STDERR "ERROR DURING SERIAL WRITE\n"; return undef; } splice (@_, 0, $n - 1, $n) # drop written chars, if $n; # if any were, $count -= $n; # ... } return $count == 0; } ############################################################# # # $c= &serin ($count, $eol); # # Read up to $count characters from the serial port. It returns # when $count is reached, or we timeout waiting for characters. # If $eol is defined, stop reading when we see that character. # (It's only for the version string, which is LF terminated.) # We can afford one-second granularity, so generic and portable # time-of-day works fine. Note that we wait for a delta > 1; # resolution is 1 second, so the first time() could be made 1 uS # before the second rolls over. sub serin { my $count= shift; my $eol= shift; my $c; # chars to return else undef my $n; # chars read per call, my $t; # end time my $to; # timeout waiting $t= time + 2; # end time, $c= undef; # assume the worst, while ($count && (time < $t)) { $n= sysread (DEV, my $foo, $count); if ($n) { $c= "" if not defined $c; $c .= $foo; # more read, $count -= $n; # adjust count, last if defined $eol and $c =~ /$eol/; } } print STDERR "SERIAL READ TIMEOUT\n" if not defined $c; return $c; } # Usage. sub usage { print STDOUT << "ENDHELP"; $0 version $VERSION $0 is part of the World Power Systems Model A1 Programmer Adapter, used to burn and read code into a Model 01a Control Engine card. $0 {command} {options} COMMANDS -- one of these is required -p file Program PIC with contents of file (erases first). -e Bulk-erase PIC, only. -r Reset the target device. -m Read contents of PIC to stdout. -a Test for presence of A1 Programmer and target PIC, only. OPTIONS -c Make additional verify pass after -p programming. -z List all errors, even if they run off the screen. -t device Output to device (default $devname). -b nnn Bit rate when -t used (default $speed). -v Verbosity in all things, including config register. -h This usage. Some combinations of options are foolish; which those might be is left as an exercise to the reader. There will be a test in the morning. ENDHELP exit 0; }