(local core (require :core)) (local socket (require :socket)) (local {: int16-to-bytes : int32-to-bytes : bytes-to-uint16 : bytes-to-uint32 : lo : in-coro} (require :lib.util)) (local Ssc (require :ssc)) (import-macros {:sss ! : compile} :ssc.macros) (local config { :host "172.24.1.6" :port 6502 }) {:cmd { :write 0 :read 1 :eval 2 :pause 3 :ping 4 } :response { :ack 0 :data 1 } :pending {} :msgid 0 :waiting false :queue [] :connect (fn [self ?port ?host] (when (not self.connection) (local [port host] [(or ?port config.port) (or ?host config.host)]) (set self.connection (assert (socket.udp))) (assert (self.connection:setpeername host port)) (self.connection:settimeout 0) (core.add_thread #(while (self:connected?) (self:receive) (coroutine.yield)) self.connection))) :connected? (fn [self] (not= self.connection nil)) :disconnect (fn [self] (when self.connection (self.connection:close) (set self.connection nil) (set self.pending {}) (set self.queue []) (set self.waiting false))) :next-msgid (fn [self] (set self.msgid (lo (+ self.msgid 1))) self.msgid) :send (fn [self cmd ?data ?callback] (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 (let [data (self.connection:receive)] (when data (let [msgid (string.byte (data:sub 1 1)) cmd (string.byte (data:sub 2 2)) pendingfn (. self.pending msgid)] (print "recieved" msgid cmd) (when pendingfn (tset self.pending msgid nil) (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)) :eval (fn [self c {: parent : org : ignore-result}] (let [parent (or parent (require :ssc.iigs.u2-debug)) ssc (Ssc {: parent}) org (or org (parent.prg:lookup-addr :u2-debug-buffer))] (compile ssc (org [org]) (fn do-the-thing () [c])) (ssc:assemble) (if (not ignore-result) (let [(_ data) (self:coro-send self.cmd.eval (. ssc.prg.org-to-block org :bytes))] {:word (bytes-to-uint16 data) :long (bytes-to-uint32 data 2)}) (self:send self.cmd.eval (. ssc.prg.org-to-block org :bytes))))) :jump (fn [self addr] (self:eval (! (asm (jsl [(tostring addr)]))) {:ignore-result true})) :coro-send (fn [self cmd ?data] (let [coro (coroutine.running)] (self:send cmd ?data #(coroutine.resume coro $2 $3)) (coroutine.yield))) :handle-ack (fn [self cmd] (assert (= cmd self.response.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)))) }