view release on metacpan or  search on metacpan

bin/avr-updi  view on Meta::CPAN

   $RESET_REQUIRED++;
}

# IO formats
package main::Fileformat {
   use base 'IO::Handle';
   sub open_out {
      my $class = shift;
      my $fh;
      if( $_[0] eq "-" ) {
         $fh = IO::Handle->new_from_fd( STDOUT->fileno, "w" );
      }
      else {
         open $fh, ">", $_[0] or die "Cannot write $_[0] - $!\n";
      }
      return bless $fh, $class;
   }
   sub open_in {
      my $class = shift;
      my $fh;
      if( $_[0] eq "-" ) {
         $fh = IO::Handle->new_from_fd( STDIN->fileno, "r" );
      }
      else {
         open $fh, "<", $_[0] or die "Cannot read $_[0] - $!\n";
      }
      return bless $fh, $class;
   }
}

package main::Fileformat::Binary {
   use base 'main::Fileformat';
   sub output {
      my $self = shift;
      my ( $bytes ) = @_;
      $self->print( $bytes );
   }
   sub input {
      my $self = shift;
      local $/;
      return scalar <$self>;
   }
   sub input_chunks {
      my $self = shift;
      return [ 0, $self->input ];
   }
}

package main::Fileformat::IntelHex {
   use base 'main::Fileformat';

   # Because this file format was invented for Intel x86 in the 16-bit era,
   # we have to account for its crazy 16bit offset + 16bit segment == 20bit
   # linear addressing madness.

   sub print_record {
      my $self = shift;
      my ( $addr, $type, $data ) = @_;
      my $clen = length $data;
      my $cksum = $clen + ( $addr & 0xFF ) + ( $addr >> 8 ) + $type;
      my $encdata = "";
      ( $encdata .= sprintf "%02X", ord $_), ( $cksum += ord $_ )
         for split //, $data;
      $self->printf( ":%02X%04X%02X%s%02X\n",
         $clen, $addr, $type, $encdata, ( -$cksum ) & 0xFF );
   }
   sub output_chunk {
      my $self = shift;
      my ( $addr, $bytes ) = @_;

      my $segaddr = 0;

      foreach my $data ( $bytes =~ m/(.{1,16})/gs ) {
         my $hiaddr = $addr & 0xFFFF0000;
         if( $segaddr << 4 != $hiaddr ) {
            $segaddr = $hiaddr >> 4;
            $self->print_record( 0, 0x02, pack "S>", $segaddr );
         }
         $self->print_record( $addr & 0xFFFF, 0x00, $data );
         $addr += length $data;
      }
   }
   sub output {
      my $self = shift;
      my ( $bytes ) = @_;

      my $addr = 0;
      my $chunk = "";

      foreach my $data ( $bytes =~ m/(.{1,16})/gs ) {
         if( $data !~ m/[^\xff]/ ) {
            # data contains only 0xFF bytes.

            if( length $chunk ) {
               # Write the current chunk then reset it

               my $chunkaddr = $addr;
               $addr += length $chunk;

               $chunk =~ s/\xFF+$//;
               $self->output_chunk( $chunkaddr, $chunk );

               $chunk = "";
            }

            $addr += length $data;
         }
         else {
            $chunk .= $data;
         }
      }

      if( length $chunk ) {
         $self->output_chunk( $addr, $chunk );
      }

      $self->print_record( 0, 0x01, "" );
   }

   sub input {
      my $self = shift;

      my $bytes = "";
      foreach my $chunk ( $self->input_chunks ) {
         my ( $addr, $chunkbytes ) = @$chunk;