#lang scheme/base
(require
scheme/pretty
"util.ss"
"pk2.ss"
"pk2script.ss"
"cmd.ss"
"icsp.ss")
(provide
pk2-stat
pk2-poll
pk2-reset
pk2-close
pk2-in
pk2-out
pk2-reset-programmer
pk2-on
pk2-off
pk2-fast
pk2-slow
)
(define (icsp-us-set! us)
(printf "pk2: clock ~s us\n" us)
(icsp-us us))
(define (pk2-fast) (icsp-us-set! 3)) (define (pk2-slow) (icsp-us-set! 15))
(define-syntax-rule (@ f . a)
(begin (display 'f) (newline) (f . a)))
(define (pk2-off)
(@ target-off))
(define (pk2-on)
(@ target-on))
(define (pk2-reset [secs .3])
(pk2-off) (sleep secs)
(pk2-on) (sleep secs)
(pk2-poll) (sleep secs) (pk2-poll)
)
(define (pk2-reset-programmer)
(display "Resetting PICkit2.\n")
(RESET)
(sleep 1))
(define (pk2-stat)
(pretty-print `(status ,@(status)))
(pretty-print `(voltages ,@(voltages)))
)
(define (icsp-poll max [disp 50])
(let loop ((n 1))
(if (> n max)
#f
(if (= 1 (icsp-recv-bit))
(begin
(when (> n disp)
(printf "\r \r"))
#t)
(begin
(when (> n disp)
(printf "\r~a " n))
(loop (add1 n)))))))
(define (pk2-poll [retries 1000])
(let ((there (icsp-poll retries)))
(if there
(begin
(icsp-recv-bit)
(icsp-send '(0 0) #:handshake #f)
(let ((reply
(icsp-recv-message)))
(if (equal? reply '(0 0))
there
(error 'pk2-poll "~a" reply))))
#f)))
(define in-buffer '())
(define out-buffer '())
(define (pk2-flush)
(unless (null? out-buffer)
(icsp-send-message (reverse out-buffer))
(set! out-buffer '())))
(define (pk2-in)
(if (null? in-buffer)
(begin
(pk2-flush)
(set! in-buffer (icsp-recv-message))
(pk2-in))
(let ((byte (pop! in-buffer)))
byte)))
(define (pk2-out byte)
(push! out-buffer byte))
(define (rpc . msg)
(pk2-out (length msg))
(for ((b msg))
(pk2-out b))
(let ((size (pk2-in)))
(printf "size = ~s\n" size)
(for ((n (in-range size)))
(printf "~s: ~s\n" n (pk2-in)))))