diff --git a/editor/init.fnl b/editor/init.fnl index e42e51c..df125c1 100644 --- a/editor/init.fnl +++ b/editor/init.fnl @@ -39,3 +39,12 @@ "ctrl+v" "tileedit:paste" }) +(fn inline-eval [eval] + (let [ldoc core.active_view.doc + (aline acol bline bcol) (ldoc:get_selection) + inject #(ldoc:insert bline bcol (eval $1))] + (if (and (= aline bline) (= acol bcol)) + (inject (ldoc:get_text aline 1 aline 10000000)) + (inject (ldoc:get_text aline acol bline bcol))))) + +{: inline-eval} diff --git a/lib/bencode.lua b/lib/bencode.lua new file mode 100644 index 0000000..de81e9b --- /dev/null +++ b/lib/bencode.lua @@ -0,0 +1,89 @@ +-- Based on bencode.lua from the jeejah project by Phil Hagelberg +-- Distributed under the MIT license +-- https://gitlab.com/technomancy/jeejah/ + +local encode, decode + +local function decode_list(str, t, total_len) + -- print("list", str, lume.serialize(t)) + if #str == 0 then error("Incomplete") end + if(str:sub(1,1) == "e") then return t, total_len + 1 end + local value, v_len = decode(str) + table.insert(t, value) + total_len = total_len + v_len + return decode_list(str:sub(v_len + 1), t, total_len) +end + +local function decode_table(str, t, total_len) + -- print("table", str, lume.serialize(t)) + if #str == 0 then error("Incomplete") end + if(str:sub(1,1) == "e") then return t, total_len + 1 end + local key, k_len = decode(str) + local value, v_len = decode(str:sub(k_len+1)) + local end_pos = 1 + k_len + v_len + t[key] = value + total_len = total_len + k_len + v_len + return decode_table(str:sub(end_pos), t, total_len) +end + +function decode(str) + -- print("decoding", str) + if #str == 0 then + error("Incomplete") + elseif(str:sub(1,1) == "l") then + return decode_list(str:sub(2), {}, 1) + elseif(str:sub(1,1) == "d") then + return decode_table(str:sub(2), {}, 1) + elseif(str:sub(1,1) == "i") then + local iend = str:find("e") + if iend == nil then error("Incomplete") end + return(tonumber(str:sub(2, iend - 1))), iend + elseif(str:match("[0-9]+:")) then + local num_str = str:match("[0-9]+") + local beginning_of_string = #num_str + 2 + local str_len = tonumber(num_str) + local total_len = beginning_of_string + str_len - 1 + if #str < total_len then error("Incomplete") end + return str:sub(beginning_of_string, total_len), total_len + else + error("Could not parse "..str) + end +end + +local function encode_str(s) return #s .. ":" .. s end +local function encode_int(n) return "i" .. tostring(n) .. "e" end + +local function encode_table(t) + local s = "d" + for k,v in pairs(t) do s = s .. encode(k) .. encode(v) end + return s .. "e" +end + +local function encode_list(l) + local s = "l" + for _,x in ipairs(l) do s = s .. encode(x) end + return s .. "e" +end + +local function count(tbl) + local i = 0 + for _ in pairs(tbl) do i = i + 1 end + return i +end + +function encode(x) + local unpack = unpack or table.unpack + if(type(x) == "table" and select("#", unpack(x)) == count(x)) then + return encode_list(x) + elseif(type(x) == "table") then + return encode_table(x) + elseif(type(x) == "number" and math.floor(x) == x) then + return encode_int(x) + elseif(type(x) == "string") then + return encode_str(x) + else + error("Could not encode " .. type(x) .. ": " .. tostring(x)) + end +end + +return {decode=decode, encode=encode} diff --git a/lib/util.fnl b/lib/util.fnl index caf4038..e8ef93b 100644 --- a/lib/util.fnl +++ b/lib/util.fnl @@ -1,5 +1,6 @@ (local lume (require :lib.lume)) (local json (require :lib.dkjson)) +(local core (require :core)) (fn string.fromhex [str] (str:gsub ".." (fn [cc] (string.char (tonumber cc 16))))) @@ -48,5 +49,17 @@ (f:write (json.encode value)) (f:close)) -{: lo : hi : int8-to-bytes : int16-to-bytes : reload : hotswap : swappable :require swappable-require : readjson : writejson} +(fn waitfor [pred] + (local coro (coroutine.running)) + (core.add_thread + (fn [] + (while (not (pred)) + (coroutine.yield)) + (coroutine.resume coro)) + coro) + (coroutine.yield)) + +(fn in-coro [f ...] (-> (coroutine.create f) (coroutine.resume ...))) + +{: lo : hi : int8-to-bytes : int16-to-bytes : reload : hotswap : swappable :require swappable-require : readjson : writejson : waitfor : in-coro} diff --git a/link/command.fnl b/link/command.fnl new file mode 100644 index 0000000..6be27f2 --- /dev/null +++ b/link/command.fnl @@ -0,0 +1,43 @@ +(local util (require :lib.util)) +(local link (require :link)) +(local editor (require :editor)) +(local command (require :core.command)) +(local keymap (require :core.keymap)) + +(each [_ linktype (ipairs link.types)] + (command.add #(not= link.name linktype) { + (.. "link:switch-to-" linktype) #(link:switch linktype) + })) + +(command.add #(and link.machine.run (not (link.machine:running?))) { + "link:boot" #(link.machine:run) +}) +(command.add #(and link.machine.die (link.machine:running?)) { + "link:kill" #(link.machine:die) +}) +(command.add #(not (link.machine:connected?)) { + "link:connect" #(link.machine:connect) +}) +(command.add #(link.machine:connected?) { + "link:disconnect" #(link.machine:disconnect) +}) + +(let [connected-methods + {:reboot :reboot + :continue :continue + :step :step + :squelch :stop}] + (each [name method (pairs connected-methods)] + (command.add #(and (link.machine:connected?) (. link.machine method)) { + (.. "link:" name) #(: link.machine method) + }))) + +(command.add #(and (link.machine:connected?) link.machine.coro-eval) { + "link:eval" #(util.in-coro #(editor.inline-eval #(link.machine:coro-eval $1))) +}) + +(keymap.add { + "alt+m" "link:eval" +}) + +{} diff --git a/link/gsplus.fnl b/link/gsplus.fnl index 668fb35..e111928 100644 --- a/link/gsplus.fnl +++ b/link/gsplus.fnl @@ -28,6 +28,11 @@ (fn [self] (when (not self.pid) (set self.pid (spawn [:nixGL gsplus-path :-debugport (tostring debug-port)])))) + :run + (fn [self] + (self:boot) + (while (not self.socket) (self:connect)) + (self:hello)) :die (fn [self] (self:disconnect) @@ -47,6 +52,7 @@ (self.socket:close) (set self.socket nil))) :connected? (fn [self] self.socket) + :running? (fn [self] self.pid) :cmd (fn [self cmd] (self.socket:send (.. cmd "\n"))) :response (fn [self] @@ -115,27 +121,12 @@ (org:append :debug-stub [:jmp post-check-jump] :on-hotswap ...)) }) -(command.add #(not machine.pid) { - "gsplus:launch-gsplus" #(machine:boot) - "gsplus:boot" (fn [] - (machine:boot) - (while (not machine.socket) (machine:connect)) - (machine:hello) - ) -}) -(command.add (fn [] machine.pid) { - "gsplus:kill-gsplus" #(machine:die) -}) (command.add (fn [] machine.socket) { - "gsplus:disconnect" #(machine:disconnect) "gsplus:hello" #(machine:hello) "gsplus:dump-cpu-state" #(pp (machine:getreg)) "gsplus:step" #(pp (machine:step)) "gsplus:continue" #(pp (machine:continue)) }) -(command.add #(not machine.socket) { - "gsplus:connect" #(machine:connect) -}) machine diff --git a/link/init.fnl b/link/init.fnl index 086968a..1d3f9e3 100644 --- a/link/init.fnl +++ b/link/init.fnl @@ -3,7 +3,7 @@ (fn [self name] (set self.machine (require (.. "link." name))) (set self.name name)) - :types [:serial :gsplus :tape]}) + :types [:serial :gsplus :tape :mame]}) (local serial (require :link.serial)) (link:switch (if (and (pcall #(serial:connect)) (serial:connected?)) :serial :gsplus)) diff --git a/link/mame.fnl b/link/mame.fnl new file mode 100644 index 0000000..1746252 --- /dev/null +++ b/link/mame.fnl @@ -0,0 +1,64 @@ +(local util (require :lib.util)) +(local {: spawn : kill} (util.require :lib.spawn)) +(local nrepl (require :link.nrepl)) +(local Session (require :link.nrepl-session)) +(local bencode (require :lib.bencode)) +(local lume (require :lib.lume)) + +(fn start-mame [platform] + (spawn [:mame :-debug :-plugins :-pluginspath "/home/jeremy/src;/usr/share/mame/plugins" :-plugin :jeejah platform])) + +(local Machine (Session:extend)) +(fn Machine.new [self] + (Machine.super.new self {:out (fn []) :value (fn [])})) +(fn Machine.boot [self] + (when (not self.pid) + (set self.pid (start-mame :apple2p)))) +(fn Machine.run [self] + (self:boot) + (self:connect)) +(fn Machine.die [self] + (self:disconnect) + (when self.pid + (kill (- self.pid) 1) + (set self.pid nil))) +(fn Machine.running? [self] self.pid) +(fn Machine.connected? [self] self.session) +(fn Machine.connect [self] + (util.in-coro (fn [] + (when (not (nrepl:connected?)) + (util.waitfor + #(if (nrepl:connected?) true + (do (pcall #(nrepl:connect)) false)))) + (self:init-session)))) +(fn Machine.disconnect [self] + (when (nrepl:connected?) (nrepl:disconnect)) + (set self.session nil)) +(fn Machine.write [self addr bytes] + (self:send + {:op :eval + :code + "(let [bencode (require :bencode) + {: addr : bytes} (bencode.decode (io.read)) + mem (-> (manager:machine) (. :devices ::maincpu :spaces :program))] + (print :writing (bytes:len) :to addr) + (for [i 1 (bytes:len)] + (mem:write_u8 (+ addr i -1) (string.byte (bytes:sub i i)))))"} + {:status/need-input #(self:send-oob {:op :stdin :stdin (bencode.encode {: addr : bytes})})})) +(fn Machine.reboot [self] (self:eval "(: (manager:machine) :hard_reset)")) +(fn Machine.coro-eval [self code] + (var result nil) + (self:eval code + (self:coro-handlers (coroutine.running) {:out #(set result $2)})) + (coroutine.yield) + (or result "")) +(fn Machine.dbgcmd [self cmd] + (self:eval (.. "(-> (manager:machine) (: :debugger) (: :command \"" cmd "\"))"))) +(fn Machine.continue [self] (self:dbgcmd :go)) +(fn Machine.step [self] (self:dbgcmd :s)) +(fn Machine.stop-at [self addr]) +(Machine:new) + +Machine + + diff --git a/link/nrepl-session.fnl b/link/nrepl-session.fnl new file mode 100644 index 0000000..4972d64 --- /dev/null +++ b/link/nrepl-session.fnl @@ -0,0 +1,61 @@ +(local Object (require :core.object)) +(local nrepl (require :link.nrepl)) +(local lume (require :lib.lume)) + +(local Session (Object:extend)) + +(fn Session.new [self ?handlers] + (set self.queue []) + (set self.in-progress false) + (set self.handlers ?handlers)) + +(fn Session.init-session [self] + (when (nrepl:connected?) + (self:do #(nrepl:new-session + #(do (set self.session $2) + (self:done-msg)) + (self:make-handlers))))) + +(fn Session.cleanup-handlers [self] + {:status/done #(self:done-msg) + :status/interrupted #(self:done-msg)}) + +(fn Session.make-handlers [self] + (lume.merge + (or self.handlers {}) + (nrepl:chain-handlers [:status/done :status/interrupted] + (or self.handlers {}) + (self:cleanup-handlers)))) + +(fn Session.coro-handlers [self coro ?handlers] + (lume.merge + (or ?handlers {}) + (nrepl:chain-handlers [:status/done :status/interrupted] + (self:cleanup-handlers) + {:status/done #(coroutine.resume coro) + :status/interrupted #(coroutine.resume coro)}))) + +(fn Session.do [self f] + (if self.in-progress (table.insert self.queue f) + (do (set self.in-progress true) + (f)))) + +(fn Session.done-msg [self] + (if (> (length self.queue) 0) ((table.remove self.queue 1)) + (set self.in-progress false))) + +(fn Session.send [self message ?handlers] + (self:do #(nrepl:send message ?handlers self.session))) + +(fn Session.send-oob [self message ?handlers] + (local handlers + (lume.merge + (nrepl:chain-handlers [:status/done :status/interrupted] + (or self.handlers {})) + (or ?handlers {}))) + (nrepl:send message handlers self.session)) + +(fn Session.eval [self code ?handlers] + (self:send {:op :eval : code} ?handlers)) + +Session diff --git a/link/nrepl.fnl b/link/nrepl.fnl new file mode 100644 index 0000000..d7559b5 --- /dev/null +++ b/link/nrepl.fnl @@ -0,0 +1,114 @@ +(local core (require :core)) +(local socket (require :socket)) +(local bencode (require :lib.bencode)) +(local lume (require :lib.lume)) + +(fn contains? [tbl item] + (or (= tbl item) (lume.find tbl item))) + +(local nrepl + {:active-requests {} + :session-handlers {} + :default-handlers + {:out #(core.log $2) + :value #(core.log $2) + :ex #(core.err $2) + :status/interrupted #($1:done $3.id) + :status/done #($1:done $3.id)} + :merge-handlers + (fn [self message] + (lume.merge self.default-handlers + (or (. self.session-handlers message.session) {}) + (or (. self.active-requests message.id) {}))) + :chain-handlers + (fn [self keys ...] + (local new-handlers {}) + (each [_ key (ipairs keys)] + (each [_ handlers (ipairs [self.default-handlers ...])] + (local next-handler (. handlers key)) + (local prev-handler (. new-handlers key)) + (if (and next-handler prev-handler) + (tset new-handlers key + #(do (prev-handler $1 $2 $3) (next-handler $1 $2 $3))) + next-handler + (tset new-handlers key next-handler)))) + new-handlers) + :counter 1 + :input "" + :parse-input + (fn [self] + (match (pcall #(bencode.decode self.input)) + (true val len) + (do (set self.input (self.input:sub (+ len 1))) + val) + (false :Incomplete) nil + (false _) + (do (set self.input "") + nil))) + :receive + (fn [self] + (when self.connection + (local (data err part) (self.connection:receive "*a")) + (local response (or data part)) + (when (> (response:len) 0) + (print "Got some data") + (set self.input (.. self.input response))) + (match (self:parse-input) nil nil + input (self:handle input)) + (when (= err :closed) + (self:disconnect)))) + :send + (fn [self msg ?handlers ?session] + (when self.connection + (when (not msg.id) + (set msg.id self.counter) + (set self.counter (+ self.counter 1))) + (when (not msg.session) + (set msg.session (or ?session self.default-session))) + (when ?handlers + (tset self.active-requests msg.id ?handlers)) + (self.connection:send (bencode.encode msg)))) + :done + (fn [self msg-id] + (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 :/)) + (local key (if idiv (prop:sub 1 (- idiv 1)) prop)) + (print "checking" key (and idiv (prop:sub (+ idiv 1)))) + (when (and (. response key) + (or (= idiv nil) + (contains? (. response key) (prop:sub (+ idiv 1))))) + (print "handling") + (handler self (. response key) response)))) + :disconnect + (fn [self] + (when self.connection + (self.connection:close) + (set self.connection nil) + (set self.default-session nil) + (set self.active-requests {}) + (set self.session-handlers {}))) + :connect + (fn [self ?port ?host] + (when (not self.connection) + (local (port host) (values (or ?port 7888) (or ?host :localhost))) + (set self.connection (assert (socket.connect host port))) + (self.connection:settimeout 0) + (core.add_thread #(while true (self:receive) (coroutine.yield)) self) + (self:send {:op :clone} + {:new-session #(set self.default-session $2)}))) + :connected? + (fn [self] (not= self.default-session nil)) + :new-session + (fn [self callback ?handler] + (self:send {:op :clone} + {:new-session + (fn [self session message] + (tset self.session-handlers session ?handler) + (callback self session message))}))}) + +nrepl diff --git a/wrap.fnl b/wrap.fnl index 099c9b7..da15362 100644 --- a/wrap.fnl +++ b/wrap.fnl @@ -1,19 +1,13 @@ -(require "editor") -(local util (require "lib.util")) -(local lume (require "lib.lume")) -(local link (require "link")) -(local core (require "core")) -(local command (require "core.command")) -(local keymap (require "core.keymap")) -(local translate (require "core.doc.translate")) +(local editor (require :editor)) +(local util (require :lib.util)) +(local lume (require :lib.lume)) +(local link (require :link)) +(require :link.command) +(local core (require :core)) +(local command (require :core.command)) +(local keymap (require :core.keymap)) +(local translate (require :core.doc.translate)) -(each [_ linktype (ipairs link.types)] - (command.add #(not= link.name linktype) { - (.. "honeylisp:switch-to-" linktype) #(link:switch linktype) - })) -(command.add #(= link.name :tape) { - "honeylisp:squelch" #(link.machine:stop) -}) (command.add #(link.machine:connected?) { "honeylisp:upload" (fn [] (local p (util.reload "game")) @@ -39,14 +33,7 @@ (ldoc:get_text aline acol bline bcol)) (command.add "core.docview" { - "fennel:eval" (fn [] - (let [ldoc core.active_view.doc - (aline acol bline bcol) (ldoc:get_selection) - options {:env _G :compiler-env _G} - inject #(ldoc:insert bline bcol (fv (fennel.eval $1 options) {}))] - (if (and (= aline bline) (= acol bcol)) - (inject (ldoc:get_text aline 1 aline 10000000)) - (inject (ldoc:get_text aline acol bline bcol))))) + "fennel:eval" #(editor.inline-eval #(fv (fennel.eval $1 {:env _G :compiler-env _G}) {})) "lume:hotswap" (fn [] (local modname (-> core.active_view.doc.filename