SpindleyQ/honeylisp
1
1
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

hot code reload works on hardware!!

Browse source
This commit is contained in:
Jeremy Penner 2021-10-10 22:15:11 -04:00
parent e8665e7c0a
commit fe00a91064
4 changed files with 84 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

BIN
UdpDebug.dsk
View file

Binary file not shown.

75
link/udpdebug.fnl
View file

@ -15,7 +15,6 @@
:eval 2
:pause 3
:ping 4
:read-dp 5
}
:response {
:ack 0
@ -92,23 +91,63 @@
(let [coro (coroutine.running)]
(self:send cmd ?data #(coroutine.resume coro $2 $3))
(coroutine.yield)))
:read
(fn [self addr len]
(if (> len 1450)
(let [first (self:read addr 1450)
rest (self:read (+ addr 1450) (- len 1450))]
(.. first rest))
(let [(cmd data) (self:coro-send self.cmd.read (.. (int32-to-bytes addr)
(int16-to-bytes len)))] data)))
:handle-ack (fn [self cmd] (assert (= cmd self.response.ack)))
:write
(fn [self addr data]
(if (> (length data) 1450) (do (self:write addr (data:sub 1 1400)) (self:write (+ addr 1400) (data:sub 1401)))
(self:send self.cmd.write (.. (int32-to-bytes addr)
(int16-to-bytes (length data))
data) self.handle-ack)))
:pause (fn [self] (self:send self.cmd.write (int16-to-bytes 0xffff) self.handle-ack))
:resume (fn [self] (self:send self.cmd.write (int16-to-bytes 0) self.handle-ack))
:split-batches (fn [self blocks max-size]
; just make sure it's legal, not optimal - no need to solve an NP-hard bin-packing problem
(fn add-to-batch [batches iblock size]
(let [batch (. batches (length batches))
block (. blocks iblock)]
(if (= block nil) batches
; must be split into multiple batches
(> block.len max-size)
(do (for [i 0 (- block.len 1) max-size]
(when (and (= i 0) (= (length batch) 0)) (table.remove batches))
(table.insert batches [{:addr (+ block.addr i)
:data (when block.data (block.data:sub (+ i 1) (+ i max-size)))
:len (math.min (- block.len i) max-size)
:offset 1
:append-to-addr block.addr}]))
(add-to-batch batches (+ iblock 1) (if (= (% block.len max-size) 0) max-size (% block.len max-size))))
; we have run off the end of the current batch
(> (+ size block.len) max-size)
(do (table.insert batches [])
(add-to-batch batches iblock 0))
; there is enough space to fit into the current batch
(do (set block.offset (+ size 1))
(table.insert batch block)
(add-to-batch batches (+ iblock 1) (+ size block.len))))))
(add-to-batch [[]] 1 0))
:read-batch (fn [self addr-to-len]
(let [blocks (icollect [addr len (pairs addr-to-len)] {: addr : len})
result {}]
(each [_ batch (ipairs (self:split-batches blocks 1450))]
(let [msg (.. (int16-to-bytes (length batch))
(table.concat (icollect [_ {: addr : len} (ipairs batch)] (.. (int32-to-bytes addr) (int16-to-bytes len)))))
(response data) (self:coro-send self.cmd.read msg)]
(assert (= response self.response.data))
(each [_ {: addr : len : offset : append-to-addr} (ipairs batch)]
(let [read-data (data:sub offset (+ offset len -1))]
(if append-to-addr (tset result append-to-addr (.. (. result append-to-addr) read-data))
(tset result addr read-data))))))
result))
:read (fn [self addr len] (. (self:read-batch {addr len}) addr))
:write-batch (fn [self addr-to-data]
(let [blocks (icollect [addr data (pairs addr-to-data)] {: addr :len (+ (length data) 6) : data})]
(each [_ batch (ipairs (self:split-batches blocks 1450))]
(print "writing batch of size" (length batch))
(let [msg (.. (int16-to-bytes (length batch))
(table.concat (icollect [_ {: addr : data} (ipairs batch)] (.. (int32-to-bytes addr) (int16-to-bytes (length data)) data))))]
(self:send self.cmd.write msg self.handle-ack)))))
:write (fn [self addr data] (self:write-batch {addr data}))
:pause (fn [self] (self:send self.cmd.pause (int16-to-bytes 0xffff) self.handle-ack))
:resume (fn [self] (self:send self.cmd.pause (int16-to-bytes 0) self.handle-ack))
:launch (fn [self prg] (self:jump (prg:lookup-addr prg.start-symbol)))
:hotswap
(fn [self prg-old prg-new]
(in-coro (fn []
(self:pause)
(local hotswap (prg-old:read-hotswap self prg-new))
(prg-new:upload self)
(prg-new:write-hotswap self hotswap)
(self:resume))))
}

34
ssc/iigs/u2-debug.fnl
View file

@ -45,21 +45,39 @@
(global word u2-debug-server-paused false)
(fn u2-debug-server-cmd-write (msgid)
(set! u2-debug-server-paused true)
(let (addr (long-at (ref u2-debug-buffer))
size (word-at (+ (ref u2-debug-buffer) 4)))
(memcpy (+ (far-ref u2-debug-buffer) 6) addr size)
(let (count (word-at (ref u2-debug-buffer)) index 2)
(printnum count) (out ": # of blocks to write")
(while (> count 0)
(let (addr (long-at (+ (ref u2-debug-buffer) index))
size (word-at (+ (ref u2-debug-buffer) index 4)))
(printnum (hiword addr)) (printnum (loword addr)) (printnum size) (out ": writing")
(memcpy (+ (far-ref u2-debug-buffer) index 6) addr size)
(set! index (+ index size 6))
(set! count (- count 1))))
(u2-tx-begin 2)
(u2-write msgid)
(u2-write [response.ack])
(u2-tx-complete)))
(fn u2-debug-server-cmd-read (msgid)
(let (addr (long-at (ref u2-debug-buffer))
size (word-at (+ (ref u2-debug-buffer) 4)))
(u2-tx-begin (+ size 2))
(let (index 6 totalsize 0 count (word-at (ref u2-debug-buffer)))
(printnum count) (out ": # of blocks to read")
(while (> count 0)
(let (size (word-at (+ (ref u2-debug-buffer) index)))
(set! totalsize (+ totalsize size))
(set! index (+ index 6))
(set! count (- count 1))))
(u2-tx-begin (+ totalsize 2))
(u2-write msgid)
(u2-write [response.data])
(u2-write-farbuf addr size)
(set! count (word-at (ref u2-debug-buffer)))
(set! index 2)
(while (> count 0)
(let (addr (long-at (+ (ref u2-debug-buffer) index))
size (word-at (+ (ref u2-debug-buffer) index 4)))
(u2-write-farbuf addr size)
(set! index (+ index 6))
(set! count (- count 1))))
(u2-tx-complete)))
(fn u2-debug-server-cmd-exec (msgid)
@ -101,7 +119,7 @@
(when size
(let (msgid (u2-read)
cmd (u2-read))
(printnum msgid) (printnum cmd) (out "Got message!")
(printnum msgid) (printnum cmd) (out ": Got message!")
(u2-read-buf (ref u2-debug-buffer) (- size 2))
(u2-rx-complete)
(u2-set-tx-dest u2-udp-recv-ip u2-udp-recv-port)

2
ssc/init.fnl
View file

@ -347,7 +347,7 @@
:long (lambda [self value] (values [:block (self:expr-word value) [:sta self.LONG_LO] [:lda 0] [:sta self.LONG_HI]] :long))
:byte-at (lambda [self ref] (self:compile-read-at ref :byte))
:word-at (lambda [self ref] (self:compile-read-at ref :word))
:long-at (lambda [self ref] (self:copmile-read-at ref :long))
:long-at (lambda [self ref] (self:compile-read-at ref :long))
:set! (lambda [self lhs value]
(if (and (= (type lhs) :string) (. self.setters lhs))
(self:compile-function-call (. self.setters lhs) [value])