udp message queue to make write wait for confirmation

link/nrepl.fnl

@@ -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 :/))

link/udpdebug.fnl

@@ -1,6 +1,6 @@
 (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)
+   (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))
-     (self.connection:send 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)]
+   (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)
-                                #(coroutine.resume coro $3))
-       (coroutine.yield))))
+                                   data) #nil)))
  :launch (fn [self prg] (self:jump (prg:lookup-addr prg.start-symbol)))
 }

ssc/iigs/u2-debug.fnl

@@ -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)))))
 

ssc/iigs/uthernet2.fnl

@@ -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
-
   ))