diff --git a/UdpDebug.dsk b/UdpDebug.dsk index 3942ba0..ab7bb05 100644 Binary files a/UdpDebug.dsk and b/UdpDebug.dsk differ diff --git a/link/udpdebug.fnl b/link/udpdebug.fnl index d47de9f..e16d097 100644 --- a/link/udpdebug.fnl +++ b/link/udpdebug.fnl @@ -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)))) } diff --git a/ssc/iigs/u2-debug.fnl b/ssc/iigs/u2-debug.fnl index 1d38f19..2269295 100644 --- a/ssc/iigs/u2-debug.fnl +++ b/ssc/iigs/u2-debug.fnl @@ -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) diff --git a/ssc/init.fnl b/ssc/init.fnl index c8d1e09..ccddb4d 100644 --- a/ssc/init.fnl +++ b/ssc/init.fnl @@ -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])