#lang scheme/base
(require
"pk2script.ss"
"util.ss"
"cmd.ss")
(provide
uart-read
uart-try-read
uart-write
uart-start
uart-stop
uart-out)
(require scheme/async-channel)
(define ->target (make-channel)) (define target-> (make-async-channel))
(define uart-verbose (make-parameter #f))
(define (baud rate)
(let ((bv (->int (- 65536 (/ (- (/ 1. rate) 3e-6) 1.67e-7)))))
(list (band bv #xFF)
(band (>>> bv 8) #xFF))))
(define uart-stop void)
(define (uart-out bit)
(EXECUTE_SCRIPT
(SET_ICSP_PINS (bior #b0010
(<<< (band bit 1) 2)))))
(define (uart-start [rate 9600])
(define (bytes->ms bytes)
(ceiling (* 1000 (/ (* 10 bytes) rate))))
(define from #f)
(define (from-target)
(let ((bufr (UPLOAD_DATA)))
(when (uart-verbose)
(unless (null? bufr) (printf "RX: ~a\n" bufr)))
(if (null? bufr)
(msleep (bytes->ms 1)) (for ((b bufr)) (async-channel-put target-> b)))
(from-target)))
(define to #f)
(define (to-target)
(let slurp ((l '()))
(let ((b (channel-try-get ->target)))
(if b
(slurp (cons b l)) (let ((bytes (reverse l)))
(unless (null? bytes)
(when (uart-verbose)
(printf "TX: ~a\n" bytes))
(void (apply DOWNLOAD_DATA bytes)))
(msleep (bytes->ms (length bytes))) (slurp (list (channel-get ->target)))))))) (define (stop)
(EXIT_UART_MODE)
(kill-thread from)
(kill-thread to)
(set! uart-stop void))
(define (start)
(uart-stop) (READ_STATUS) (apply ENTER_UART_MODE (baud rate))
(set! from (thread from-target))
(set! to (thread to-target))
(set! uart-stop stop))
(start))
(define (uart-read) (async-channel-get target->))
(define (uart-try-read) (async-channel-try-get target->))
(define (uart-write . bytes) (for ((b bytes)) (channel-put ->target b)))
(define (test-read)
(thread (lambda ()
(let loop ()
(display (uart-read))
(newline)
(loop)))))
(define (test-uart [rate 9600])
(target-on)
(uart-start rate)
(let loop ()
(display ".")
(uart-write #x55)
(sleep 1)
(loop)))