common.scm

   1 (display "Loading flash iface client...")
   2 (newline)
   3
   4 (use-modules (srfi srfi-1) (ice-9 format) (ice-9 rw))
   5
   6 (define STX (string #\stx))
   7 (define RS (string #\rs))
   8 (define ETX  (string #\etx))
   9 (define SENDBUF-SIZE 2048)
  10
  11 (define (list-ref-with-default lst n def)
  12   (if (< n (length lst))
  13     (list-ref lst n)
  14     def)
  15   )
  16
  17 (define (string->u8vector s)
  18   (let ((result (make-u8vector (string-length s))))
  19     (array-map! result char->integer s)
  20     result)
  21   )
  22
  23 (define (u8vector->string v)
  24   (let ((result (make-string (u8vector-length v))))
  25     (array-map! result integer->char v)
  26     result)
  27   )
  28
  29 (define (create-command cmd . args)
  30   (let ((par (list-ref-with-default args 0 #f)))
  31     (string->u8vector
  32       (string-append STX cmd
  33                      (if (eq? par #f)
  34                        ""
  35                        (string-append RS par)
  36                        )
  37                      ETX
  38                      )
  39       )
  40     )
  41   )
  42
  43 (define (checksum data)
  44   (modulo (fold (lambda (c sum) (+ sum (char->integer c))) 0 (string->list data))
  45           256)
  46   )
  47
  48 (define (checksum-as-char data)
  49   (integer->char (checksum data))
  50   )
  51
  52 (define (addr-with-checksum addr)
  53   (let ((str-addr (format #f "~:@(~8,'0X~)" addr)))
  54     (format #f "~:@(~A~2,'0X~)" str-addr (checksum str-addr))
  55     )
  56   )
  57
  58 (define (create-addr-command addr)
  59   (create-command "ADDR" (addr-with-checksum addr))
  60   )
  61
  62 (define (create-jump-command addr)
  63   (create-command "JUMP" (addr-with-checksum addr))
  64   )
  65
  66 (define (create-bin-command block)
  67   (let ((block-size (string-length block)))
  68     (create-command "BIN"
  69                     (string-append (reduce-right
  70                                      string-append
  71                                      ""
  72                                      (map (lambda (fun) (string (integer->char (fun block-size 256)))) (list quotient remainder))
  73                                      )
  74                                    block
  75                                    (string (checksum-as-char block))
  76                                    )
  77                     )
  78     )
  79   )
  80
  81 (define (send-recv-command iface cmd)
  82   (begin
  83     (write-flash-iface iface cmd)
  84     (read-flash-iface iface)
  85     )
  86   )
  87
  88 (define (send-block iface block size addr)
  89   (begin
  90     (send-recv-command iface (create-addr-command addr))
  91     (send-recv-command iface (create-bin-command (substring/shared block 0 size)))
  92    )
  93 )
  94
  95 (define (do-send-data-from-port iface addr s sent)
  96   (let ((ret (read-string!/partial s)))
  97     (if (or (equal? ret 0) (equal? ret #f))
  98       sent
  99       (begin
 100         (send-block iface s ret addr)
 101         (do-send-data-from-port iface (+ addr ret) s (+ sent ret))
 102         )
 103       )
 104     )
 105   )
 106
 107 (define (send-data-from-port iface addr)
 108   (do-send-data-from-port iface addr (make-string SENDBUF-SIZE) 0)
 109   )
 110
 111 (define (send-loader-from-port iface addr jaddr)
 112   (begin
 113     (send-data-from-port iface addr)
 114     (send-recv-command iface (create-jump-command jaddr))
 115     )
 116   )
 117
 118 (define (send-loader-from-file iface fname addr jaddr)
 119   (with-input-from-file fname (lambda () (send-loader-from-port iface addr jaddr)))
 120   )
 121
 122 (display "Done.")
 123 (newline)