udp message queue to make write wait for confirmation
This commit is contained in:
parent
9ec998e128
commit
2df2abe543
BIN
UdpDebug.dsk
BIN
UdpDebug.dsk
Binary file not shown.
|
@ -72,7 +72,6 @@
|
||||||
(tset self.active-requests msg-id nil))
|
(tset self.active-requests msg-id nil))
|
||||||
:handle
|
:handle
|
||||||
(fn [self response]
|
(fn [self response]
|
||||||
(pp response)
|
|
||||||
(local handlers (self:merge-handlers response))
|
(local handlers (self:merge-handlers response))
|
||||||
(each [prop handler (pairs handlers)]
|
(each [prop handler (pairs handlers)]
|
||||||
(local idiv (prop:find :/))
|
(local idiv (prop:find :/))
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
(local core (require :core))
|
(local core (require :core))
|
||||||
(local socket (require :socket))
|
(local socket (require :socket))
|
||||||
(local {: int16-to-bytes : int32-to-bytes : lo} (require :lib.util))
|
(local {: int16-to-bytes : int32-to-bytes : lo : in-coro} (require :lib.util))
|
||||||
|
|
||||||
(local config {
|
(local config {
|
||||||
:host "172.24.1.6"
|
:host "172.24.1.6"
|
||||||
|
@ -20,6 +20,8 @@
|
||||||
}
|
}
|
||||||
:pending {}
|
:pending {}
|
||||||
:msgid 0
|
:msgid 0
|
||||||
|
:waiting false
|
||||||
|
:queue []
|
||||||
:connect
|
:connect
|
||||||
(fn [self ?port ?host]
|
(fn [self ?port ?host]
|
||||||
(when (not self.connection)
|
(when (not self.connection)
|
||||||
|
@ -41,11 +43,14 @@
|
||||||
self.msgid)
|
self.msgid)
|
||||||
:send
|
:send
|
||||||
(fn [self cmd ?data ?callback]
|
(fn [self cmd ?data ?callback]
|
||||||
(let [msgid (self:next-msgid)
|
(self:enqueue
|
||||||
msg (.. (string.char msgid cmd) (or ?data ""))]
|
#(let [msgid (self:next-msgid)
|
||||||
(print "sending" msgid cmd (length msg))
|
msg (.. (string.char msgid cmd) (or ?data ""))]
|
||||||
(when ?callback (tset self.pending msgid ?callback))
|
(print "sending" msgid cmd (length msg))
|
||||||
(self.connection:send msg)))
|
(when ?callback
|
||||||
|
(tset self.pending msgid ?callback)
|
||||||
|
(set self.waiting true))
|
||||||
|
(self.connection:send msg))))
|
||||||
:receive
|
:receive
|
||||||
(fn [self]
|
(fn [self]
|
||||||
(when self.connection
|
(when self.connection
|
||||||
|
@ -57,24 +62,33 @@
|
||||||
(print "recieved" msgid cmd)
|
(print "recieved" msgid cmd)
|
||||||
(when pendingfn
|
(when pendingfn
|
||||||
(tset self.pending msgid nil)
|
(tset self.pending msgid nil)
|
||||||
(pendingfn self cmd (data:sub 3))))))))
|
(pendingfn self cmd (data:sub 3)))
|
||||||
|
(set self.waiting false)))
|
||||||
|
(when (and (not self.waiting) (> (length self.queue) 0))
|
||||||
|
(let [f (. self.queue 1)]
|
||||||
|
(table.remove self.queue 1)
|
||||||
|
(f))))))
|
||||||
|
:enqueue (fn [self f] (table.insert self.queue f))
|
||||||
:jump (fn [self addr] (self:send self.cmd.jmp (int32-to-bytes addr)))
|
:jump (fn [self addr] (self:send self.cmd.jmp (int32-to-bytes addr)))
|
||||||
; todo: break up into multiple calls
|
:coro-send
|
||||||
|
(fn [self cmd ?data]
|
||||||
|
(let [coro (coroutine.running)]
|
||||||
|
(self:send cmd ?data #(coroutine.resume coro $2 $3))
|
||||||
|
(coroutine.yield)))
|
||||||
:read
|
:read
|
||||||
(fn [self addr len]
|
(fn [self addr len]
|
||||||
(let [coro (coroutine.running)]
|
(if (> len 1450)
|
||||||
(self:send self.cmd.read (.. (int32-to-bytes addr)
|
(let [first (self:read addr 1450)
|
||||||
(int16-to-bytes len))
|
rest (self:read (+ addr 1450) (- len 1450))]
|
||||||
#(coroutine.resume coro $3))
|
(.. first rest))
|
||||||
(coroutine.yield)))
|
|
||||||
|
(let [(cmd data) (self:coro-send self.cmd.read (.. (int32-to-bytes addr)
|
||||||
|
(int16-to-bytes len)))] data)))
|
||||||
:write
|
:write
|
||||||
(fn [self addr data]
|
(fn [self addr data]
|
||||||
(if (> (length data) 1400) (do (self:write addr (data:sub 1 1400)) (self:write (+ addr 1400) (data:sub 1401)))
|
(if (> (length data) 1450) (do (self:write addr (data:sub 1 1400)) (self:write (+ addr 1400) (data:sub 1401)))
|
||||||
(let [coro (coroutine.running)]
|
(self:send self.cmd.write (.. (int32-to-bytes addr)
|
||||||
(self:send self.cmd.write (.. (int32-to-bytes addr)
|
(int16-to-bytes (length data))
|
||||||
(int16-to-bytes (length data))
|
data) #nil)))
|
||||||
data)
|
|
||||||
#(coroutine.resume coro $3))
|
|
||||||
(coroutine.yield))))
|
|
||||||
:launch (fn [self prg] (self:jump (prg:lookup-addr prg.start-symbol)))
|
:launch (fn [self prg] (self:jump (prg:lookup-addr prg.start-symbol)))
|
||||||
}
|
}
|
||||||
|
|
|
@ -48,38 +48,38 @@
|
||||||
(let (addr (long-at (ref u2-debug-buffer))
|
(let (addr (long-at (ref u2-debug-buffer))
|
||||||
size (word-at (+ (ref u2-debug-buffer) 4)))
|
size (word-at (+ (ref u2-debug-buffer) 4)))
|
||||||
(memcpy (+ (far-ref u2-debug-buffer) 6) addr size)
|
(memcpy (+ (far-ref u2-debug-buffer) 6) addr size)
|
||||||
(u2-tx-begin)
|
(u2-tx-begin 2)
|
||||||
(u2-write msgid)
|
(u2-write msgid)
|
||||||
(u2-write [response.ack])
|
(u2-write [response.ack])
|
||||||
(u2-tx-complete 2)))
|
(u2-tx-complete)))
|
||||||
|
|
||||||
(fn u2-debug-server-cmd-read (msgid)
|
(fn u2-debug-server-cmd-read (msgid)
|
||||||
(let (addr (long-at (ref u2-debug-buffer))
|
(let (addr (long-at (ref u2-debug-buffer))
|
||||||
size (word-at (+ (ref u2-debug-buffer) 4)))
|
size (word-at (+ (ref u2-debug-buffer) 4)))
|
||||||
(u2-tx-begin)
|
(u2-tx-begin (+ size 2))
|
||||||
(u2-write msgid)
|
(u2-write msgid)
|
||||||
(u2-write [response.data])
|
(u2-write [response.data])
|
||||||
(u2-write-farbuf addr size)
|
(u2-write-farbuf addr size)
|
||||||
(u2-tx-complete (+ size 2))))
|
(u2-tx-complete)))
|
||||||
|
|
||||||
(fn u2-debug-server-cmd-jmp () (asm (jmp ((u2-debug-buffer)))))
|
(fn u2-debug-server-cmd-jmp () (asm (jmp ((u2-debug-buffer)))))
|
||||||
|
|
||||||
(global word u2-debug-server-paused 0)
|
(global word u2-debug-server-paused 0)
|
||||||
(fn u2-debug-server-cmd-pause (msgid)
|
(fn u2-debug-server-cmd-pause (msgid)
|
||||||
(set! u2-debug-server-paused (not u2-debug-server-paused))
|
(set! u2-debug-server-paused (not u2-debug-server-paused))
|
||||||
(u2-tx-begin)
|
(u2-tx-begin 3)
|
||||||
(u2-write msgid)
|
(u2-write msgid)
|
||||||
(u2-write [response.ack])
|
(u2-write [response.ack])
|
||||||
(u2-write u2-debug-server-paused)
|
(u2-write u2-debug-server-paused)
|
||||||
(u2-tx-complete 3)
|
(u2-tx-complete)
|
||||||
(while u2-debug-server-paused
|
(while u2-debug-server-paused
|
||||||
(u2-debug-server-poll)))
|
(u2-debug-server-poll)))
|
||||||
|
|
||||||
(fn u2-debug-server-cmd-ping (msgid)
|
(fn u2-debug-server-cmd-ping (msgid)
|
||||||
(u2-tx-begin)
|
(u2-tx-begin 2)
|
||||||
(u2-write msgid)
|
(u2-write msgid)
|
||||||
(u2-write [response.ack])
|
(u2-write [response.ack])
|
||||||
(u2-tx-complete 2))
|
(u2-tx-complete))
|
||||||
|
|
||||||
(fn u2-debug-server-cmd (msgid cmd)
|
(fn u2-debug-server-cmd (msgid cmd)
|
||||||
(if (= cmd [cmd.write]) (u2-debug-server-cmd-write msgid)
|
(if (= cmd [cmd.write]) (u2-debug-server-cmd-write msgid)
|
||||||
|
@ -97,7 +97,7 @@
|
||||||
(u2-read-buf (ref u2-debug-buffer) (- size 2))
|
(u2-read-buf (ref u2-debug-buffer) (- size 2))
|
||||||
(u2-rx-complete)
|
(u2-rx-complete)
|
||||||
(when (not u2-debug-server-connected)
|
(when (not u2-debug-server-connected)
|
||||||
(u2-set-tx-dest u2-udp-recv-ip 6502)
|
(u2-set-tx-dest u2-udp-recv-ip u2-udp-recv-port)
|
||||||
(set! u2-debug-server-connected true))
|
(set! u2-debug-server-connected true))
|
||||||
(u2-debug-server-cmd msgid cmd)))))
|
(u2-debug-server-cmd msgid cmd)))))
|
||||||
|
|
||||||
|
|
|
@ -130,17 +130,20 @@
|
||||||
(u2-write-word (byteswap (hiword ip)))
|
(u2-write-word (byteswap (hiword ip)))
|
||||||
(u2-write-word port))
|
(u2-write-word port))
|
||||||
|
|
||||||
(fn u2-tx-begin ()
|
(global word u2-udp-send-size 0)
|
||||||
|
(fn u2-tx-begin (size)
|
||||||
|
(set! u2-udp-send-size size)
|
||||||
|
(let (freesize 0) (while (< freesize size)
|
||||||
|
(u2-addr! 0x0420) (set! freesize (u2-read-word))))
|
||||||
(u2-addr! 0x0424)
|
(u2-addr! 0x0424)
|
||||||
(let (txwr (u2-rxtx-ptr (u2-read-word) 0x4000))
|
(let (txwr (u2-rxtx-ptr (u2-read-word) 0x4000))
|
||||||
(u2-addr! txwr)))
|
(u2-addr! txwr)))
|
||||||
|
|
||||||
(fn u2-tx-complete (size)
|
(fn u2-tx-complete ()
|
||||||
(u2-addr! 0x0424)
|
(u2-addr! 0x0424)
|
||||||
(let (txwr (u2-rxtx-ptr (u2-read-word) 0x4000))
|
(let (txwr (u2-read-word))
|
||||||
(u2-addr! 0x0424)
|
(u2-addr! 0x0424)
|
||||||
(u2-write-word (+ txwr size))
|
(u2-write-word (+ txwr u2-udp-send-size))
|
||||||
(u2-addr! 0x0401)
|
(u2-addr! 0x0401)
|
||||||
(u2-write 0x20))) ; SEND command
|
(u2-write 0x20))) ; SEND command
|
||||||
|
|
||||||
))
|
))
|
||||||
|
|
Loading…
Reference in a new issue