#lang scheme/base
(require
(lib "match.ss")
"../tools.ss")
(provide (all-defined-out))
(define checksum
(let ((mask (make-mask 8)))
(lambda (lst)
(mask (* -1 (foldl + 0 lst))))))
(define (ihex-split-address address)
(split-nibble-list `(,address) 8 0))
(define (ihex-line-list type address bytes)
(let ((line
`(,(length bytes)
,@(ihex-split-address address)
,type
,@bytes)))
(append line `(,(checksum line)))))
(define (ihex-line-string lst)
(apply string-append
`(":" ,@(map byte->string lst) "\r\n")))
(define (ihex-line . args)
(ihex-line-string
(apply ihex-line-list args)))
(define (ihex-chunk bytes chunksize address)
(let next ((in (list->table bytes chunksize))
(out '())
(addr address))
(match in
(()
(apply string-append
`( ,(ihex-line 4 0 (ihex-split-address
(>>> address 16)))
,@(reverse out))))
((line . rest)
(next rest
(cons
(ihex-line 0 addr line)
out)
(+ addr chunksize))))))
(define (ihex-done)
(ihex-line 1 0 '()))
(define (chunks->ihex lst)
(append
(map
(match-lambda
((addr code)
(ihex-chunk code 16 addr)))
lst)
`(,(ihex-done))))
(define (write-ihex lst [port (current-output-port)])
(for-each
(lambda (x) (display x port))
(chunks->ihex lst)))