1  #!/usr/bin/env -S guile --r7rs -e "main" -s
  2  !#
  3  
  4  (import (srfi 1)
  5          (srfi 26)
  6          (rnrs bytevectors)
  7          (rnrs bytevectors gnu)
  8          (ice-9 format)
  9          (ice-9 binary-ports))
 10  
 11  ;;; Print message and exit
 12  (define (abort . fmt)
 13    (apply format (cons (current-error-port) fmt))
 14    (newline (current-error-port))
 15    (exit 1))
 16  
 17  ;;; Read word in big endian
 18  (define (read-word-be n port)
 19    (let ((data (get-bytevector-n port n)))
 20      (if (or (eof-object? data)
 21              (not (= (bytevector-length data) n)))
 22          (abort "Unexpected end of file. Abort.")
 23          (bytevector-uint-ref data 0 (endianness big) n))))
 24  
 25  ;;; Read configuration to bytevector
 26  (define (read-configuration file)
 27    (call-with-input-file file
 28      (lambda (port)
 29        ;; check header
 30        (let* ((golden #vu8(#x00 #x09 #x0f #xf0 #x0f #xf0 #x0f #xf0 #x0f #xf0 #x00 #x00 #x01))
 31               (header (get-bytevector-n port (bytevector-length golden))))
 32          (when (or (not (equal? header golden)))
 33            (abort "This file is not a bitstream. Abort.")))
 34  
 35        ;; find configuration block
 36        (let next-block ()
 37          (let ((type (get-u8 port)))
 38            (cond
 39             ((eof-object? type) (abort ("Configuration block not found.")))
 40             ;; return configuration data
 41             ((= type #x65) (get-bytevector-n port (read-word-be 4 port)))
 42             ;; skip block
 43             (else
 44              (get-bytevector-n port (read-word-be 2 port))
 45              (next-block))))))
 46  
 47      #:binary #t))
 48  
 49  ;;; Calculate Intel HEX checksum
 50  (define (checksum data)
 51    (logand
 52     #xff
 53     (+ 1 (lognot
 54           (apply + (bytevector->u8-list data))))))
 55  
 56  ;;; Return byte n of the number x
 57  (define (byte-ref x n)
 58    (bit-extract x (* n 8) (* (+ 1 n) 8)))
 59  
 60  ;;; Print byte. Use manual conversion for speedup
 61  (define (print-byte b)
 62    (define (print-nibble x)
 63      (display (cond
 64                ((= x 0) "0")
 65                ((= x 1) "1")
 66                ((= x 2) "2")
 67                ((= x 3) "3")
 68                ((= x 4) "4")
 69                ((= x 5) "5")
 70                ((= x 6) "6")
 71                ((= x 7) "7")
 72                ((= x 8) "8")
 73                ((= x 9) "9")
 74                ((= x 10) "A")
 75                ((= x 11) "B")
 76                ((= x 12) "C")
 77                ((= x 13) "D")
 78                ((= x 14) "E")
 79                ((= x 15) "F"))))
 80    (print-nibble (bit-extract b 4 8))
 81    (print-nibble (bit-extract b 0 4)))
 82  
 83  ;;; Print Intel HEX record
 84  (define (print-ihex-record data)
 85    (let ((crc (checksum data)))
 86      (display ":")
 87      (for-each print-byte (bytevector->u8-list data))
 88      (print-byte crc)
 89      (newline)))
 90  
 91  ;;; Print bytevector blob as Intel HEX
 92  (define (bytevector-print-as-ihex data)
 93    (let ((data-len (bytevector-length data)))
 94      (let print-rec ((address 0))
 95        ;; Extended Linear Address (high part of the address)
 96        (when (zero? (logand #xffff address ))
 97          (print-ihex-record
 98           (u8-list->bytevector
 99            `(#x02 #x00 #x00 #x04 ,(byte-ref address 3) ,(byte-ref address 2)))))
100  
101        ;; get piece of bytes
102        (let* ((len (- data-len address))
103               (len (if (< len 16) len 16))
104               (data (bytevector-slice data address len)))
105          (print-ihex-record
106           (u8-list->bytevector
107            (append
108             `(,len ,(byte-ref address 1) ,(byte-ref address 0) 0)
109             (bytevector->u8-list data))))
110  
111          (let ((address (+ address len)))
112            (when (< address data-len)
113              (print-rec address)))))
114      (display ":00000001FF")
115      (newline)))
116  
117  ;;; MAIN
118  (define (main args)
119    (if (null? (cdr args))
120        (format (current-error-port) "Usage: ~a <bitstream.bit> [> bitstream.mcs]\n" (first args))
121        (let* ((bitfile (second args))
122               (conf (read-configuration bitfile)))
123          (format (current-error-port) "Length of bitstream: ~a bytes\n" (bytevector-length conf))
124          (bytevector-print-as-ihex conf))))