File Coverage

blib/lib/Device/BusPirate/Chip/AVR_HVSP.pm
Criterion Covered Total %
statement 33 246 13.4
branch 0 42 0.0
condition 0 24 0.0
subroutine 11 85 12.9
pod 15 19 78.9
total 59 416 14.1


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2014 -- leonerd@leonerd.org.uk
5              
6             package Device::BusPirate::Chip::AVR_HVSP;
7              
8 1     1   749 use strict;
  1         1  
  1         42  
9 1     1   5 use warnings;
  1         2  
  1         35  
10 1     1   15 use base qw( Device::BusPirate::Chip );
  1         1  
  1         697  
11              
12             our $VERSION = '0.03';
13              
14 1     1   423 use Carp;
  1         2  
  1         78  
15              
16 1     1   661 use Future::Utils qw( repeat );
  1         2187  
  1         91  
17 1     1   571 use Struct::Dumb qw( readonly_struct );
  1         1058  
  1         8  
18              
19 1     1   62 use constant CHIP => "AVR_HVSP";
  1         2  
  1         72  
20 1     1   5 use constant MODE => "BB";
  1         1  
  1         1453  
21              
22             readonly_struct PartInfo => [qw( signature flash_words flash_pagesize eeprom_words eeprom_pagesize has_efuse )];
23             readonly_struct MemoryInfo => [qw( wordsize pagesize words can_write )];
24              
25             =head1 NAME
26              
27             C - high-voltage serial programming for F chips
28              
29             =head1 DESCRIPTION
30              
31             This L subclass allows interaction with an F
32             microcontroller of the F family in high-voltage serial programming
33             (HVSP) mode. It is particularly useful for configuring fuses or working with a
34             chip with the C fuse programmed, because in such cases a regular ISP
35             programmer cannot be used.
36              
37             =head2 CONNECTIONS
38              
39             To use this module, make the following connections between the F
40             (with colours of common cable types), and the F chip (with example pin
41             numbers for some common devices):
42              
43             Bus Pirate | Sparkfun | Seeed |:| ATtiny | tiny84 | tiny85
44             -----------+----------+----------+-+--------+--------+-------
45             MISO | brown | black |:| SDO | 9 | 7
46             CS | red | white |:| SII | 8 | 6
47             MOSI | orange | grey |:| SDI | 7 | 5
48             CLK | yellow | purple |:| SCI | 2 | 2
49             AUX | green | blue |:| +12V supply - see below
50             | | |:| RESET | 4 | 1
51             +5V | grey | orange |:| Vcc | 1 | 8
52             GND | black | brown |:| GND | 14 | 4
53              
54             The C line from the F will need to be able to control a +12V
55             supply to the C pin of the F chip. It should be active-high,
56             and can be achieved by a two-stage NPN-then-PNP transistor arrangement.
57              
58             Additionally, the C pin and the C to C pins of 14-pin devices
59             will need a pull-down to ground of around 100Ohm to 1kOhm.
60              
61             =cut
62              
63             =head1 METHODS
64              
65             The following methods documented with a trailing call to C<< ->get >> return
66             L instances.
67              
68             =cut
69              
70             # TODO: This needs to be migrated to Device::BusPirate itself
71             sub _enter_mutex
72             {
73 0     0     my $self = shift;
74 0           my ( $code ) = @_;
75              
76 0   0       my $oldmtx = $self->{mutex} // $self->pirate->_new_future->done( $self );
77 0           $self->{mutex} = my $newmtx = $self->pirate->_new_future;
78              
79             $oldmtx->then( $code )
80             ->then_with_f( sub {
81 0     0     my $f = shift;
82 0           $newmtx->done( $self );
83 0           $f
84 0           });
85             }
86              
87             my $SDI = "mosi";
88             my $SII = "cs";
89             my $SCI = "clk";
90             my $SDO = "miso";
91              
92             sub mount
93             {
94 0     0 1   my $self = shift;
95 0           my ( $mode ) = @_;
96              
97             $self->SUPER::mount( $mode )
98             ->then( sub {
99 0     0     $mode->configure(
100             open_drain => 0,
101             );
102             })
103             ->then( sub {
104 0     0     $mode->write(
105             $SDI => 0,
106             $SII => 0,
107             $SCI => 0,
108             );
109             })
110             ->then( sub {
111             # Set input
112 0     0     $mode->read_miso;
113 0           });
114             }
115              
116             =head2 $chip->start->get
117              
118             Powers up the device, reads and checks the signature, ensuring it is a
119             recognised chip.
120              
121             This method leaves the chip powered up with +5V on Vcc and +12V on RESET. Use
122             the C, C or C methods to turn these off if it is
123             not required again immediately.
124              
125             =cut
126              
127             my %PARTS;
128             {
129             local $_;
130             while( ) {
131             my ( $name, $data ) = m/^(\S+)\s*=\s*(.*?)\s*$/ or next;
132             $PARTS{$name} = PartInfo( split /\s+/, $data );
133             }
134             }
135              
136             sub start
137             {
138 0     0 1   my $self = shift;
139              
140             $self->all_power(1)->then( sub {
141 0     0     $self->read_signature;
142             })->then( sub {
143 0     0     my ( $sig ) = @_;
144 0           $sig = uc unpack "H*", $sig;
145              
146 0           my $partinfo;
147             my $part;
148             ( $partinfo = $PARTS{$_} )->signature eq $sig and $part = $_, last
149 0   0       for keys %PARTS;
150              
151 0 0         defined $part or return Future->fail( "Unrecognised signature $sig" );
152              
153 0           $self->{part} = $part;
154 0           $self->{partinfo} = $partinfo;
155              
156             # ARRAYref so we keep this nice order
157 0 0         $self->{memories} = [
158             # ws ps nw wr
159             signature => MemoryInfo( 8, 3, 3, 0 ),
160             calibration => MemoryInfo( 8, 1, 1, 0 ),
161             lock => MemoryInfo( 8, 1, 1, 1 ),
162             lfuse => MemoryInfo( 8, 1, 1, 1 ),
163             hfuse => MemoryInfo( 8, 1, 1, 1 ),
164             ( $partinfo->has_efuse ?
165             ( efuse => MemoryInfo( 8, 1, 1, 1 ) ) :
166             () ),
167             flash => MemoryInfo( 16, $partinfo->flash_pagesize, $partinfo->flash_words, 1 ),
168             eeprom => MemoryInfo( 8, $partinfo->eeprom_pagesize, $partinfo->eeprom_words, 1 ),
169             ];
170              
171 0           return Future->done( $self );
172 0           });
173             }
174              
175             =head2 $chip->stop->get
176              
177             Shut down power to the device.
178              
179             =cut
180              
181             sub stop
182             {
183 0     0 1   my $self = shift;
184              
185 0           Future->needs_all(
186             $self->power(0),
187             $self->aux(0),
188             );
189             }
190              
191             =head2 $chip->power( $on )->get
192              
193             Controls +5V to the Vcc pin of the F chip.
194              
195             =cut
196              
197             # inherited
198              
199             =head2 $chip->hv_power( $on )->get
200              
201             Controls +12V to the RESET pin of the F chip.
202              
203             =cut
204              
205             *hv_power = __PACKAGE__->can( 'aux' );
206              
207             =head2 $chip->all_power( $on )->get
208              
209             Controls both +5V and +12V supplies at once. The +12V supply is turned on last
210             but off first, ensuring the correct HVSP-RESET sequence is applied to the
211             chip.
212              
213             =cut
214              
215             sub all_power
216             {
217 0     0 1   my $self = shift;
218 0           my ( $on ) = @_;
219              
220             # Allow power to settle before turning on +12V on AUX
221             # Normal serial line overheads should allow enough time here
222              
223             $on
224 0     0     ? $self->power(1)->then( sub { $self->hv_power(1) } )
225 0 0   0     : $self->hv_power(0)->then( sub { $self->power(0) } );
  0            
226             }
227              
228             =head2 $name = $chip->partname
229              
230             Returns the name of the chip whose signature was detected by the C
231             method.
232              
233             =cut
234              
235             sub partname
236             {
237 0     0 1   my $self = shift;
238 0           return $self->{part};
239             }
240              
241             =head2 $memory = $avr->memory_info( $name )
242              
243             Returns a memory info structure giving details about the named memory for the
244             attached part. The following memory names are recognised:
245              
246             signature calibration lock lfuse hfuse efuse flash eeprom
247              
248             (Note that the F has no C memory).
249              
250             The structure will respond to the following methods:
251              
252             =over 4
253              
254             =item * wordsize
255              
256             Returns number of bits per word. This will be 8 for the byte-oriented
257             memories, but 16 for the main program flash.
258              
259             =item * pagesize
260              
261             Returns the number of words per page; the smallest amount that can be
262             written in one go.
263              
264             =item * words
265              
266             Returns the total number of words that are available.
267              
268             =item * can_write
269              
270             Returns true if the memory type can be written (in general; this does not take
271             into account the lock bits that might futher restrict a particular chip).
272              
273             =back
274              
275             =cut
276              
277             sub memory_info
278             {
279 0     0 1   my $self = shift;
280 0           my ( $name ) = @_;
281              
282 0           my $memories = $self->{memories};
283             $memories->[$_*2] eq $name and return $memories->[$_*2 + 1]
284 0   0       for 0 .. $#$memories/2;
285              
286 0           die "$self->{part} does not have a $name memory";
287             }
288              
289             =head2 %memories = $avr->memory_infos
290              
291             Returns a key/value list of all the known device memories.
292              
293             =cut
294              
295             sub memory_infos
296             {
297 0     0 1   my $self = shift;
298 0           return @{ $self->{memories} };
  0            
299             }
300              
301             =head2 $fuseinfo = $avr->fuseinfo
302              
303             Returns a L instance containing
304             information on the fuses in the attached device type.
305              
306             =cut
307              
308             sub fuseinfo
309             {
310 0     0 1   my $self = shift;
311              
312 0           require Device::BusPirate::Chip::AVR_HVSP::FuseInfo;
313 0           return Device::BusPirate::Chip::AVR_HVSP::FuseInfo->for_part( $self->partname );
314             }
315              
316             sub _transfer
317             {
318 0     0     my $self = shift;
319              
320 0           my ( $sdi, $sii ) = @_;
321              
322 0           my $sdo = 0;
323 0           my $mode = $self->mode;
324              
325             # A "byte" transfer consists of 11 clock transitions; idle low. Each bit is
326             # clocked in from SDO on the falling edge of clocks 0 to 7, but clocked out
327             # of SDI and SII on clocks 1 to 8.
328             # We'll therefore toggle the clock 11 times; on each of the first 8 clocks
329             # we raise it, then simultaneously lower it, writing out the next out bits
330             # and reading in the input.
331             # Serial transfer is MSB first in both directions
332             #
333             # We cheat massively here and rely on pipeline ordering of the actual
334             # ->write calls, by writing all 22 of the underlying bytes to the Bus
335             # Pirate serial port, then waiting on all 22 bytes to come back.
336              
337 0 0         Future->needs_all( map {
338             my $mask = $_ < 8 ? (1 << 7-$_) : 0;
339              
340             Future->needs_all(
341             $mode->write( $SCI => 1 ),
342              
343             $mode->writeread(
344             $SDI => ( $sdi & $mask ),
345             $SII => ( $sii & $mask ),
346             $SCI => 0
347             )->on_done( sub {
348 0 0   0     $sdo |= $mask if shift->{$SDO};
349             })
350 0           )
351             } 0 .. 10 )
352 0     0     ->then( sub { Future->done( $sdo ) } );
  0            
353             }
354              
355             sub _await_SDO_high
356             {
357 0     0     my $self = shift;
358              
359 0           my $mode = $self->mode;
360              
361 0           my $count = 50;
362             repeat {
363 0 0   0     $count-- or return Future->fail( "Timeout waiting for device to ACK" );
364              
365 0           $mode->${\"read_$SDO"}
  0            
366 0 0   0     } until => sub { $_[0]->failure or $_[0]->get };
  0            
367             }
368              
369             # The AVR datasheet on HVSP does not name any of these operations, only
370             # giving them bit patterns. We'll use the names invented by RikusW. See also
371             # https://sites.google.com/site/megau2s/
372              
373             use constant {
374             # SII values
375 1         803 HVSP_CMD => 0x4C, # Command
376             HVSP_LLA => 0x0C, # Load Lo Address
377             HVSP_LHA => 0x1C, # Load Hi Address
378             HVSP_LLB => 0x2C, # Load Lo Byte
379             HVSP_LHB => 0x3C, # Load Hi Byte
380             HVSP_WLB => 0x64, # Write Lo Byte = WRL = WFU0
381             HVSP_WHB => 0x74, # Write Hi Byte = WRH = WFU1
382             HVSP_WFU2 => 0x66, # Write Extended Fuse
383             HVSP_RLB => 0x68, # Read Lo Byte
384             HVSP_RHB => 0x78, # Read Hi Byte
385             HVSP_RSIG => 0x68, # Read Signature
386             HVSP_RFU0 => 0x68, # Read Low Fuse
387             HVSP_RFU1 => 0x7A, # Read High Fuse
388             HVSP_RFU2 => 0x6A, # Read Extended Fuse
389             HVSP_REEP => 0x68, # Read EEPROM
390             HVSP_ROSC => 0x78, # Read Oscillator calibration
391             HVSP_RLCK => 0x78, # Read Lock
392             HVSP_PLH => 0x7D, # Program (?) Hi
393             HVSP_PLL => 0x6D, # Program (?) Lo
394             HVSP_ORM => 0x0C, # OR mask for SII to pulse actual read/write operation
395              
396             # HVSP_CMD Commands
397             CMD_CE => 0x80, # Chip Erase
398             CMD_WFUSE => 0x40, # Write Fuse
399             CMD_WLOCK => 0x20, # Write Lock
400             CMD_WFLASH => 0x10, # Write FLASH
401             CMD_WEEP => 0x11, # Write EEPROM
402             CMD_RSIG => 0x08, # Read Signature
403             CMD_RFUSE => 0x04, # Read Fuse
404             CMD_RFLASH => 0x02, # Read FLASH
405             CMD_REEP => 0x03, # Read EEPROM
406             CMD_ROSC => 0x08, # Read Oscillator calibration
407             CMD_RLOCK => 0x04, # Read Lock
408 1     1   8 };
  1         1  
409             # Some synonyms not found in the AVR ctrlstack software
410             use constant {
411 1         913 HVSP_WLCK => HVSP_WLB, # Write Lock
412             HVSP_WFU0 => HVSP_WLB, # Write Low Fuse
413             HVSP_WFU1 => HVSP_WHB, # Write High Fuse
414 1     1   4 };
  1         1  
415              
416             =head2 $avr->chip_erase->get
417              
418             Performs an entire chip erase. This will clear the flash and EEPROM memories,
419             before resetting the lock bits. It does not affect the fuses.
420              
421             =cut
422              
423             sub chip_erase
424             {
425 0     0 0   my $self = shift;
426              
427             $self->_transfer( CMD_CE, HVSP_CMD )
428 0     0     ->then( sub { $self->_transfer( 0, HVSP_WLB ) })
429 0     0     ->then( sub { $self->_transfer( 0, HVSP_WLB|HVSP_ORM ) })
430 0     0     ->then( sub { $self->_await_SDO_high });
  0            
431             }
432              
433             =head2 $bytes = $avr->read_signature->get
434              
435             Reads the three device signature bytes and returns them in as a single binary
436             string.
437              
438             =cut
439              
440             sub read_signature
441             {
442 0     0 0   my $self = shift;
443              
444             $self->_transfer( CMD_RSIG, HVSP_CMD )->then( sub {
445 0     0     my @sig;
446             repeat {
447 0           my $byte = shift;
448             $self->_transfer( $byte, HVSP_LLA )
449 0           ->then( sub { $self->_transfer( 0, HVSP_RSIG ) } )
450 0           ->then( sub { $self->_transfer( 0, HVSP_RSIG|HVSP_ORM ) } )
451 0           ->on_done( sub { $sig[$byte] = shift; } );
  0            
452             } foreach => [ 0 .. 2 ],
453 0           otherwise => sub { Future->done( pack "C*", @sig ) };
  0            
454             })
455 0           }
456              
457             =head2 $byte = $avr->read_calibration->get
458              
459             Reads the calibration byte.
460              
461             =cut
462              
463             sub read_calibration
464             {
465 0     0 0   my $self = shift;
466              
467             $self->_transfer( CMD_ROSC, HVSP_CMD )
468 0     0     ->then( sub { $self->_transfer( 0, HVSP_LLA ) } )
469 0     0     ->then( sub { $self->_transfer( 0, HVSP_ROSC ) } )
470 0     0     ->then( sub { $self->_transfer( 0, HVSP_ROSC|HVSP_ORM ) } )
471             ->then( sub {
472 0     0     Future->done( chr $_[0] )
473 0           });
474             }
475              
476             =head2 $byte = $avr->read_lock->get
477              
478             Reads the lock byte.
479              
480             =cut
481              
482             sub read_lock
483             {
484 0     0 0   my $self = shift;
485              
486             $self->_transfer( CMD_RLOCK, HVSP_CMD )
487 0     0     ->then( sub { $self->_transfer( 0, HVSP_RLCK ) } )
488 0     0     ->then( sub { $self->_transfer( 0, HVSP_RLCK|HVSP_ORM ) } )
489             ->then( sub {
490 0     0     my ( $byte ) = @_;
491 0           Future->done( chr( $byte & 3 ) );
492 0           });
493             }
494              
495             =head2 $avr->write_lock( $byte )->get
496              
497             Writes the lock byte.
498              
499             =cut
500              
501             sub write_lock
502             {
503 0     0 1   my $self = shift;
504 0           my ( $byte ) = @_;
505              
506             $self->_transfer( CMD_WLOCK, HVSP_CMD )
507 0     0     ->then( sub { $self->_transfer( ( ord $byte ) & 3, HVSP_LLB ) })
508 0     0     ->then( sub { $self->_transfer( 0, HVSP_WLCK ) })
509 0     0     ->then( sub { $self->_transfer( 0, HVSP_WLCK|HVSP_ORM ) })
510 0     0     ->then( sub { $self->_await_SDO_high });
  0            
511             }
512              
513             =head2 $int = $avr->read_fuse_byte( $fuse )->get
514              
515             Reads one of the fuse bytes C, C, C, returning an
516             integer.
517              
518             =cut
519              
520             my %SII_FOR_FUSE_READ = (
521             lfuse => HVSP_RFU0,
522             hfuse => HVSP_RFU1,
523             efuse => HVSP_RFU2,
524             );
525              
526             sub read_fuse_byte
527             {
528 0     0 1   my $self = shift;
529 0           my ( $fuse ) = @_;
530              
531 0 0         my $sii = $SII_FOR_FUSE_READ{$fuse} or croak "Unrecognised fuse type '$fuse'";
532              
533 0 0 0       $fuse eq "efuse" and !$self->{partinfo}->has_efuse and
534             croak "This part does not have an 'efuse'";
535              
536             $self->_transfer( CMD_RFUSE, HVSP_CMD )
537 0     0     ->then( sub { $self->_transfer( 0, $sii ) } )
538 0     0     ->then( sub { $self->_transfer( 0, $sii|HVSP_ORM ) } )
539 0           }
540              
541             =head2 $avr->write_fuse_byte( $fuse, $byte )->get
542              
543             Writes one of the fuse bytes C, C, C from an integer.
544              
545             =cut
546              
547             my %SII_FOR_FUSE_WRITE = (
548             lfuse => HVSP_WFU0,
549             hfuse => HVSP_WFU1,
550             efuse => HVSP_WFU2,
551             );
552              
553             sub write_fuse_byte
554             {
555 0     0 1   my $self = shift;
556 0           my ( $fuse, $byte ) = @_;
557              
558 0 0         my $sii = $SII_FOR_FUSE_WRITE{$fuse} or croak "Unrecognised fuse type '$fuse'";
559              
560 0 0 0       $fuse eq "efuse" and !$self->{partinfo}->has_efuse and
561             croak "This part does not have an 'efuse'";
562              
563             $self->_transfer( CMD_WFUSE, HVSP_CMD )
564 0     0     ->then( sub { $self->_transfer( $byte, HVSP_LLB ) })
565 0     0     ->then( sub { $self->_transfer( 0, $sii ) })
566 0     0     ->then( sub { $self->_transfer( 0, $sii|HVSP_ORM ) })
567 0     0     ->then( sub { $self->_await_SDO_high });
  0            
568             }
569              
570             =head2 $byte = $avr->read_lfuse->get
571              
572             =head2 $byte = $avr->read_hfuse->get
573              
574             =head2 $byte = $avr->read_efuse->get
575              
576             Convenient shortcuts to reading the low, high and extended fuses directly,
577             returning a byte.
578              
579             =head2 $avr->write_lfuse( $byte )->get
580              
581             =head2 $avr->write_hfuse( $byte )->get
582              
583             =head2 $avr->write_efuse( $byte )->get
584              
585             Convenient shortcuts for writing the low, high and extended fuses directly,
586             from a byte.
587              
588             =cut
589              
590             foreach my $fuse (qw( lfuse hfuse efuse )) {
591 1     1   5 no strict 'refs';
  1         0  
  1         1582  
592             *{"read_$fuse"} = sub {
593             shift->read_fuse_byte( $fuse )
594 0     0     ->then( sub { Future->done( chr $_[0] ) });
  0            
595             };
596             *{"write_$fuse"} = sub {
597 0     0     $_[0]->write_fuse_byte( $fuse, ord $_[1] );
598             };
599             }
600              
601             =head2 $bytes = $avr->read_flash( %args )->get
602              
603             Reads a range of the flash memory and returns it as a binary string.
604              
605             Takes the following optional arguments:
606              
607             =over 4
608              
609             =item start => INT
610              
611             =item stop => INT
612              
613             Address range to read. If omitted, reads the entire memory.
614              
615             =item bytes => INT
616              
617             Alternative to C; gives the nubmer of bytes (i.e. not words of flash)
618             to read.
619              
620             =back
621              
622             =cut
623              
624             sub read_flash
625             {
626 0     0 1   my $self = shift;
627 0           my %opts = @_;
628              
629 0 0         my $partinfo = $self->{partinfo} or croak "Cannot ->read_flash of an unrecognised part";
630              
631 0   0       my $start = $opts{start} // 0;
632 0 0 0       my $stop = $opts{stop} //
633             $opts{bytes} ? $start + ( $opts{bytes}/2 ) : $partinfo->flash_words;
634              
635 0           my $bytes = "";
636              
637             $self->_transfer( CMD_RFLASH, HVSP_CMD )->then( sub {
638 0     0     my $cur_ahi = -1;
639              
640             repeat {
641 0           my ( $addr ) = @_;
642 0           my $alo = $addr & 0xff;
643 0           my $ahi = $addr >> 8;
644              
645             $self->_transfer( $alo, HVSP_LLA )
646 0 0         ->then( sub { $cur_ahi == $ahi ? Future->done
647             : $self->_transfer( $cur_ahi = $ahi, HVSP_LHA ) })
648 0           ->then( sub { $self->_transfer( 0, HVSP_RLB ) })
649 0           ->then( sub { $self->_transfer( 0, HVSP_RLB|HVSP_ORM ) })
650 0           ->then( sub { $bytes .= chr $_[0];
651 0           $self->_transfer( 0, HVSP_RHB ) })
652 0           ->then( sub { $self->_transfer( 0, HVSP_RHB|HVSP_ORM ) })
653 0           ->then( sub { $bytes .= chr $_[0];
654 0           Future->done; });
  0            
655             } foreach => [ $start .. $stop - 1 ],
656 0           otherwise => sub { Future->done( $bytes ) };
  0            
657 0           });
658             }
659              
660             =head2 $avr->write_flash( $bytes )->get
661              
662             Writes the flash memory from the binary string.
663              
664             =cut
665              
666             sub write_flash
667             {
668 0     0 1   my $self = shift;
669 0           my ( $bytes ) = @_;
670              
671 0 0         my $partinfo = $self->{partinfo} or croak "Cannot ->write_flash of an unrecognised part";
672 0           my $nbytes_page = $partinfo->flash_pagesize * 2; # words are 2 bytes
673              
674 0 0         croak "Cannot write - too large" if length $bytes > $partinfo->flash_words * 2;
675              
676             $self->_transfer( CMD_WFLASH, HVSP_CMD )->then( sub {
677 0     0     my @chunks = $bytes =~ m/(.{1,$nbytes_page})/gs;
678 0           my $addr = 0;
679              
680             repeat {
681 0           my $thisaddr = $addr;
682 0           $addr += $partinfo->flash_pagesize;
683              
684 0           $self->_write_flash_page( $_[0], $thisaddr )
685 0           } foreach => \@chunks;
686             })
687 0     0     ->then( sub { $self->_transfer( 0, HVSP_CMD ) });
  0            
688             }
689              
690             sub _write_flash_page
691             {
692 0     0     my $self = shift;
693 0           my ( $bytes, $baseaddr ) = @_;
694              
695             (
696             repeat {
697 0     0     my $addr = $baseaddr + $_[0];
698 0           my $byte_lo = substr $bytes, $_[0]*2, 1;
699 0           my $byte_hi = substr $bytes, $_[0]*2 + 1, 1;
700              
701             # Datasheet disagrees with the byte value written in the final
702             # instruction. Datasheet says 6C even though the OR mask would yield
703             # the value 6E. It turns out emperically that either value works fine
704             # so for neatness of following other code patterns, we use 6E here.
705              
706             $self->_transfer( $addr & 0xff, HVSP_LLA )
707 0           ->then( sub { $self->_transfer( ord $byte_lo, HVSP_LLB ) })
708 0           ->then( sub { $self->_transfer( 0, HVSP_PLL ) })
709 0           ->then( sub { $self->_transfer( 0, HVSP_PLL|HVSP_ORM ) })
710 0           ->then( sub { $self->_transfer( ord $byte_hi, HVSP_LHB ) })
711 0           ->then( sub { $self->_transfer( 0, HVSP_PLH ) })
712 0           ->then( sub { $self->_transfer( 0, HVSP_PLH|HVSP_ORM ) })
713 0           } foreach => [ 0 .. length($bytes)/2 - 1 ]
714             )
715 0     0     ->then( sub { $self->_transfer( $baseaddr >> 8, HVSP_LHA ) })
716 0     0     ->then( sub { $self->_transfer( 0, HVSP_WLB ) })
717 0     0     ->then( sub { $self->_transfer( 0, HVSP_WLB|HVSP_ORM ) })
718 0     0     ->then( sub { $self->_await_SDO_high });
  0            
719             }
720              
721             =head2 $bytes = $avr->read_eeprom( %args )->get
722              
723             Reads a range of the EEPROM memory and returns it as a binary string.
724              
725             Takes the following optional arguments:
726              
727             =over 4
728              
729             =item start => INT
730              
731             =item stop => INT
732              
733             Address range to read. If omitted, reads the entire memory.
734              
735             =item bytes => INT
736              
737             Alternative to C; gives the nubmer of bytes to read.
738              
739             =back
740              
741             =cut
742              
743             sub read_eeprom
744             {
745 0     0 1   my $self = shift;
746 0           my %opts = @_;
747              
748 0 0         my $partinfo = $self->{partinfo} or croak "Cannot ->read_eeprom of an unrecognised part";
749              
750 0   0       my $start = $opts{start} // 0;
751 0 0 0       my $stop = $opts{stop} //
752             $opts{bytes} ? $start + $opts{bytes} : $partinfo->eeprom_words;
753              
754 0           my $bytes = "";
755              
756             $self->_transfer( CMD_REEP, HVSP_CMD )->then( sub {
757 0     0     my $cur_ahi = -1;
758              
759             repeat {
760 0           my ( $addr ) = @_;
761 0           my $alo = $addr & 0xff;
762 0           my $ahi = $addr >> 8;
763              
764             $self->_transfer( $alo, HVSP_LLA )
765 0 0         ->then( sub { $cur_ahi == $ahi ? Future->done
766             : $self->_transfer( $cur_ahi = $ahi, HVSP_LHA ) } )
767 0           ->then( sub { $self->_transfer( 0, HVSP_REEP ) } )
768 0           ->then( sub { $self->_transfer( 0, HVSP_REEP|HVSP_ORM ) } )
769 0           ->then( sub { $bytes .= chr $_[0];
770 0           Future->done; });
  0            
771             } foreach => [ $start .. $stop - 1 ],
772 0           otherwise => sub { Future->done( $bytes ) };
  0            
773 0           });
774             }
775              
776             =head2 $avr->write_eeprom( $bytes )->get
777              
778             Writes the EEPROM memory from the binary string.
779              
780             =cut
781              
782             sub write_eeprom
783             {
784 0     0 1   my $self = shift;
785 0           my ( $bytes ) = @_;
786              
787 0 0         my $partinfo = $self->{partinfo} or croak "Cannot ->write_eeprom of an unrecognised part";
788              
789 0 0         croak "Cannot write - too large" if length $bytes > $partinfo->eeprom_words;
790              
791 0           my $nwords_page = $partinfo->eeprom_pagesize;
792              
793             $self->_transfer( CMD_WEEP, HVSP_CMD )->then( sub {
794 0     0     my @chunks = $bytes =~ m/(.{1,$nwords_page})/gs;
795 0           my $addr = 0;
796              
797             repeat {
798 0           my $thisaddr = $addr;
799 0           $addr += $nwords_page;
800              
801 0           $self->_write_eeprom_page( $_[0], $thisaddr )
802 0           } foreach => \@chunks;
803             })
804 0     0     ->then( sub { $self->_transfer( 0, HVSP_CMD ) });
  0            
805             }
806              
807             sub _write_eeprom_page
808             {
809 0     0     my $self = shift;
810 0           my ( $bytes, $baseaddr ) = @_;
811              
812             (
813             repeat {
814 0     0     my $addr = $baseaddr + $_[0];
815 0           my $byte = substr $bytes, $_[0], 1;
816              
817             # Datasheet disagrees with the byte value written in the final
818             # instruction. Datasheet says 6C even though the OR mask would yield
819             # the value 6E. It turns out emperically that either value works fine
820             # so for neatness of following other code patterns, we use 6E here.
821              
822             $self->_transfer( $addr & 0xff, HVSP_LLA )
823 0           ->then( sub { $self->_transfer( $addr >> 8, HVSP_LHA ) })
824 0           ->then( sub { $self->_transfer( ord $byte, HVSP_LLB ) })
825 0           ->then( sub { $self->_transfer( 0, HVSP_PLL ) })
826 0           ->then( sub { $self->_transfer( 0, HVSP_PLL|HVSP_ORM ) })
827 0           } foreach => [ 0 .. length($bytes) - 1 ]
828             )
829 0     0     ->then( sub { $self->_transfer( 0, HVSP_WLB ) })
830 0     0     ->then( sub { $self->_transfer( 0, HVSP_WLB|HVSP_ORM ) })
831 0     0     ->then( sub { $self->_await_SDO_high });
  0            
832             }
833              
834             =head1 SEE ALSO
835              
836             =over 4
837              
838             =item *
839              
840             L -
841             High voltage serial programming for AVR chips with the Bus Pirate.
842              
843             =back
844              
845             =head1 AUTHOR
846              
847             Paul Evans
848              
849             =cut
850              
851             0x55AA;
852              
853             __DATA__