# srec.tcl - Copyright (c) 2008 Pat Thoyts <[email protected]>
 #
 #        Parse a Motorola S-record file and write a binary image
 
 namespace eval ::srecord {}
 
 # s-record checksum (2-complement 8 bit sum)
 proc ::srecord::cksum {data {seed 0}} {
     set t $seed
     binary scan $data c* bytes
     foreach byte $bytes { incr t [expr {$byte & 0xff}] }
     return [expr {(~$t) & 0xff}]
 }
 
 # decode one s-record. Returns a list of type, address, binary data
 proc ::srecord::decode_line {line} {
     set type [string range $line 0 1]
     switch -exact -- $type {
         S0 {set addrlen 4}
         S1 {set addrlen 4}
         S2 {set addrlen 6}
         S3 {set addrlen 8}
         S5 {set addrlen 4}
         S7 {set addrlen 8}
         S8 {set addrlen 6}
         S9 {set addrlen 4}
         default {
             return -code error "invalid data format: \"$type\" invalid type"
         }
     }
     if {[scan [string range $line 2 3] %02x count] != 1} {
         return -code error "invalid data format: count field incorrect"
     }
     if {[scan [string range $line 4 end] %0${addrlen}x addr] != 1} {
         return -code error "invalid data format: address field incorrect"
     }
     if {[scan [string range $line end-1 end] %02x cksum] != 1} {
         return -code error "invalid data format: checksum field incorrect"
     }
     set data [binary format H* [string range $line 2 end-2]]
     if {$count != [string length $data]} {
         return -code error "invalid data format: line count incorrect"
     }
     if {[cksum $data] != $cksum} {
         return -code error "invalid checksum: data corruption detected"
     }
 
     return [list $type $addr [string range $data [expr {$addrlen/2 + 1}] end]]
 }
 
 # Decode an entire file - the result is a block of binary data.
 # NB: we only handle S0 and S3 records
 proc ::srecord::decode_image {filename imagevar {progresscmd {}}} {
     upvar $imagevar image
     set size [file size $filename]
     set f [open $filename r]
     fconfigure $f -buffering line -translation auto
     set done 0
     while {[gets $f line] > 0} {
         foreach {type addr data} [decode_line $line] break
         switch -exact -- $type {
             S0 {
                 # module information
                 set mname [string range $data 0 19]
                 foreach {mver mrev} {0 0} break
                 scan [string range $data 20 21] %02x mver
                 scan [string range $data 22 23] %02x mrev
                 set mdesc [string range $data 24 end]
                 #puts [list $mname $mver $mrev $mdesc]
             }
             S3 {
                 set a0 [expr {$addr}]
                 set aend [expr {$a0 + [string length $data] - 1}]
                 set image [string replace $image $addr $aend $data]
             }
             default {
                 return -code error "unhandled record type \"$type\""
             }
         }
         incr done [string length $line]
         if {$progresscmd ne {}} {
             uplevel #0 [list $progresscmd] [expr {($done * 100) / $size}]
         }
     }
     close $f
     return
 }
 
 proc ::srecord::decode_file {filename size {progresscmd {}}} {
     # create a zero-filled binary object of the right size
     set image [binary format @[expr {$size}]]
     # decode the s-record file into the binary object
     decode_image $filename $size image $progresscmd
     return $image
 }
 
 package provide srecord 1.0.0

 # Test the srecord package by converting a file into a binary image
 # The output is to stdout or a named file or to inputfile.bin if no name.
 #
 # usage: srec flash.srec flash.bin
 
 package require srecord
 
 proc Main {filename {binfile {}}} {
     if {$binfile eq {}} {
         set binfile [file rootname $filename].bin
     }
     set data [::srecord::decode_file $filename 0x40000]
     if {$binfile eq "-"} {
         set oldenc [fconfigure stdout -encoding]
         set oldtrn [fconfigure stdout -translation]
         set oldeof [fconfigure stdout -eofchar]
         fconfigure stdout -encoding binary -translation binary -eofchar {}
         puts -nonewline stdout $data
         fconfigure stdout -encoding $oldenc -translation $oldtrn -eofchar $oldeof
     } else {
         set f [open $binfile w]
         fconfigure $f -encoding binary -translation binary -eofchar {}
         puts -nonewline $f $data
         close $f
     }
     return 0
 }
 
 if {!$tcl_interactive} {
     set r [catch [linsert $argv 0 Main] err]
     if {$r} {puts $::errorInfo} elseif {$err ne ""} {puts $err}
     exit $r
 }