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

udp message queue to make write wait for confirmation

Browse source
This commit is contained in:
Jeremy Penner 2021-09-30 22:25:04 -04:00
parent 9ec998e128
commit 2df2abe543
5 changed files with 53 additions and 37 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

BIN
UdpDebug.dsk
View file

Binary file not shown.

1
link/nrepl.fnl
View file

@ -72,7 +72,6 @@
(tset self.active-requests msg-id nil))
:handle
(fn [self response]
(pp response)
(local handlers (self:merge-handlers response))
(each [prop handler (pairs handlers)]
(local idiv (prop:find :/))

56
link/udpdebug.fnl
View file

@ -1,6 +1,6 @@
(local core (require :core))
(local core (require :core))
(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 {
:host "172.24.1.6"
@ -20,6 +20,8 @@
}
:pending {}
:msgid 0
:waiting false
:queue []
:connect
(fn [self ?port ?host]
(when (not self.connection)
@ -41,11 +43,14 @@
self.msgid)
:send
(fn [self cmd ?data ?callback]
(let [msgid (self:next-msgid)
msg (.. (string.char msgid cmd) (or ?data ""))]
(print "sending" msgid cmd (length msg))
(when ?callback (tset self.pending msgid ?callback))
(self.connection:send msg)))
(self:enqueue
#(let [msgid (self:next-msgid)
msg (.. (string.char msgid cmd) (or ?data ""))]
(print "sending" msgid cmd (length msg))
(when ?callback
(tset self.pending msgid ?callback)
(set self.waiting true))
(self.connection:send msg))))
:receive
(fn [self]
(when self.connection
@ -57,24 +62,33 @@
(print "recieved" msgid cmd)
(when pendingfn
(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)))
; 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
(fn [self addr len]
(let [coro (coroutine.running)]
(self:send self.cmd.read (.. (int32-to-bytes addr)
(int16-to-bytes len))
#(coroutine.resume coro $3))
(coroutine.yield)))
(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)))
:write
(fn [self addr data]
(if (> (length data) 1400) (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)
(int16-to-bytes (length data))
data)
#(coroutine.resume coro $3))
(coroutine.yield))))
(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) #nil)))
:launch (fn [self prg] (self:jump (prg:lookup-addr prg.start-symbol)))
}

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

@ -48,38 +48,38 @@
(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)
(u2-tx-begin)
(u2-tx-begin 2)
(u2-write msgid)
(u2-write [response.ack])
(u2-tx-complete 2)))
(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)
(u2-tx-begin (+ size 2))
(u2-write msgid)
(u2-write [response.data])
(u2-write-farbuf addr size)
(u2-tx-complete (+ size 2))))
(u2-tx-complete)))
(fn u2-debug-server-cmd-jmp () (asm (jmp ((u2-debug-buffer)))))
(global word u2-debug-server-paused 0)
(fn u2-debug-server-cmd-pause (msgid)
(set! u2-debug-server-paused (not u2-debug-server-paused))
(u2-tx-begin)
(u2-tx-begin 3)
(u2-write msgid)
(u2-write [response.ack])
(u2-write u2-debug-server-paused)
(u2-tx-complete 3)
(u2-tx-complete)
(while u2-debug-server-paused
(u2-debug-server-poll)))
(fn u2-debug-server-cmd-ping (msgid)
(u2-tx-begin)
(u2-tx-begin 2)
(u2-write msgid)
(u2-write [response.ack])
(u2-tx-complete 2))
(u2-tx-complete))
(fn u2-debug-server-cmd (msgid cmd)
(if (= cmd [cmd.write]) (u2-debug-server-cmd-write msgid)
@ -97,7 +97,7 @@
(u2-read-buf (ref u2-debug-buffer) (- size 2))
(u2-rx-complete)
(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))
(u2-debug-server-cmd msgid cmd)))))

15
ssc/iigs/uthernet2.fnl
View file

@ -130,17 +130,20 @@
(u2-write-word (byteswap (hiword ip)))
(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)
(let (txwr (u2-rxtx-ptr (u2-read-word) 0x4000))
(u2-addr! txwr)))
(fn u2-tx-complete (size)
(fn u2-tx-complete ()
(u2-addr! 0x0424)
(let (txwr (u2-rxtx-ptr (u2-read-word) 0x4000))
(let (txwr (u2-read-word))
(u2-addr! 0x0424)
(u2-write-word (+ txwr size))
(u2-write-word (+ txwr u2-udp-send-size))
(u2-addr! 0x0401)
(u2-write 0x20))) ; SEND command
(u2-write 0x20))) ; SEND command
))