From 4a2548e214e8a56613373fae35aa34908041b2d0 Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Mon, 9 Nov 2020 22:58:57 -0500 Subject: [PATCH] MAME hot reload support! --- link/init.fnl | 2 +- link/mame.fnl | 92 +++++++++++++++++++++++++++++++++++------- link/nrepl-session.fnl | 12 +++++- link/nrepl.fnl | 3 -- wrap.fnl | 1 + 5 files changed, 90 insertions(+), 20 deletions(-) diff --git a/link/init.fnl b/link/init.fnl index 1d3f9e3..3ee003d 100644 --- a/link/init.fnl +++ b/link/init.fnl @@ -6,6 +6,6 @@ :types [:serial :gsplus :tape :mame]}) (local serial (require :link.serial)) -(link:switch (if (and (pcall #(serial:connect)) (serial:connected?)) :serial :gsplus)) +(link:switch (if (and (pcall #(serial:connect)) (serial:connected?)) :serial :mame)) link diff --git a/link/mame.fnl b/link/mame.fnl index 1746252..99d7b25 100644 --- a/link/mame.fnl +++ b/link/mame.fnl @@ -10,7 +10,8 @@ (local Machine (Session:extend)) (fn Machine.new [self] - (Machine.super.new self {:out (fn []) :value (fn [])})) + (Machine.super.new self {:out (fn []) :value (fn [])}) + (set self.breakpoints {})) (fn Machine.boot [self] (when (not self.pid) (set self.pid (start-mame :apple2p)))) @@ -31,34 +32,95 @@ #(if (nrepl:connected?) true (do (pcall #(nrepl:connect)) false)))) (self:init-session)))) +(fn Machine.init-session [self] + (Machine.super.init-session self) + (set self.monitor (Session {:out (fn []) :value (fn [])})) + (self.monitor:init-session) + (self.monitor:eval + "(global periodic-jobs {}) + (emu.register_periodic (fn [] + (local dead-ids []) + (each [id coro (pairs periodic-jobs)] + (coroutine.resume coro) + (when (= (coroutine.status coro) :dead) + (table.insert dead-ids id))) + (each [_ id (ipairs dead-ids)] + (tset periodic-jobs id nil)))) + (global run-periodic-job (fn [id f] + (tset periodic-jobs id (coroutine.running)) + (f) + (tset periodic-jobs id nil)))") + (self:start-cpu-monitor) + (self:done-msg)) +(fn Machine.start-cpu-monitor [self ?last-addr] + (self.monitor:eval-input + "(let [?last-addr (tonumber (io.read))] + (run-periodic-job :cpu-monitor (fn [] + (var last-addr ?last-addr) + (while (let [state (-> (manager:machine) (: :debugger) (. :execution_state)) + addr (-> (manager:machine) (. :devices ::maincpu :state :PC :value))] + (not (and (= state :stop) (not= addr ?last-addr)))) + (when (= :run (-> (manager:machine) (: :debugger) (. :execution_state))) + (set last-addr nil)) + (coroutine.yield)))) + (-> (manager:machine) (. :devices ::maincpu :state :PC :value)))" + (tostring ?last-addr) + {:value (fn [nrepl output response] + (self:on-cpu-paused (tonumber output)) + (self:start-cpu-monitor (tonumber output)))})) +(fn Machine.on-cpu-paused [self addr] + (local action (-?> self.breakpoints (. addr) (. :action))) + (when action (action))) (fn Machine.disconnect [self] + (self:shutdown-session) + (self.monitor:shutdown-session) (when (nrepl:connected?) (nrepl:disconnect)) - (set self.session nil)) + (set self.breakpoints {})) + (fn Machine.write [self addr bytes] - (self:send - {:op :eval - :code + (self:eval-input "(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)")) + (mem:write_u8 (+ addr i -1) (string.byte (bytes:sub i i)))))" + (bencode.encode {: addr : bytes}))) +(fn Machine.launch [self prg] + (self:eval (string.format "(emu.keypost \"CALL-151\n%xG\n\")" (prg:lookup-addr prg.start-symbol)))) +(fn Machine.reboot [self] (self:eval "(: (manager:machine) :soft_reset)")) (fn Machine.coro-eval [self code] (var result nil) + (local append-to-result #(set result (.. (or result "") $2))) (self:eval code - (self:coro-handlers (coroutine.running) {:out #(set result $2)})) + (self:coro-handlers (coroutine.running) {:value append-to-result :out append-to-result})) (coroutine.yield) - (or result "")) -(fn Machine.dbgcmd [self cmd] - (self:eval (.. "(-> (manager:machine) (: :debugger) (: :command \"" cmd "\"))"))) + (or result "")) +(fn Machine.dbgcmd [self cmd ?handlers] + (self:eval (.. "(-> (manager:machine) (: :debugger) (: :command \"" cmd "\"))")) ?handlers) (fn Machine.continue [self] (self:dbgcmd :go)) (fn Machine.step [self] (self:dbgcmd :s)) -(fn Machine.stop-at [self addr]) +(fn Machine.set-bp [self addr ?action] + ; todo: handle setting the same breakpoint more than once? + (tset self.breakpoints addr {:action ?action}) + (self:eval (.. "(-> (manager:machine) (. :devices ::maincpu) (: :debug) (: :bpset " (tostring addr) "))") + {:value #(tset (. self.breakpoints addr) :id (tonumber $2))})) +(fn Machine.clear-bp [self addr] + (local bpid (-?> self.breakpoints (. addr) (. :id))) + (when bpid (self:dbgcmd (.. "bpclear " bpid))) + (tset self.breakpoints addr nil)) +(fn Machine.jump [self addr] + (self:eval (.. "(tset (-> (manager:machine) (. :devices ::maincpu :state :PC)) :value " (tostring addr) ")"))) +(fn Machine.stub [self org post-check-jump ...] + (org:append :debug-stub [:jmp post-check-jump] :on-hotswap ...)) +(fn Machine.hotswap [self prg-old prg-new] + (local addr (prg-old:lookup-addr :debug-stub)) + (self:set-bp addr + (fn [] (self:clear-bp addr) + (prg-new:upload self) + (self:jump (prg-new:lookup-addr :on-hotswap)) + (self:continue)))) + (Machine:new) Machine - - diff --git a/link/nrepl-session.fnl b/link/nrepl-session.fnl index 4972d64..94d7545 100644 --- a/link/nrepl-session.fnl +++ b/link/nrepl-session.fnl @@ -16,6 +16,11 @@ (self:done-msg)) (self:make-handlers))))) +(fn Session.shutdown-session [self] + (set self.queue []) + (set self.in-progress false) + (set self.sesion nil)) + (fn Session.cleanup-handlers [self] {:status/done #(self:done-msg) :status/interrupted #(self:done-msg)}) @@ -34,7 +39,7 @@ (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) @@ -58,4 +63,9 @@ (fn Session.eval [self code ?handlers] (self:send {:op :eval : code} ?handlers)) +(fn Session.eval-input [self code input ?handlers] + (self:send {:op :eval : code} + (lume.merge (or ?handlers {}) + {:status/need-input #(self:send-oob {:op :stdin :stdin input})}))) + Session diff --git a/link/nrepl.fnl b/link/nrepl.fnl index d7559b5..847fe7a 100644 --- a/link/nrepl.fnl +++ b/link/nrepl.fnl @@ -51,7 +51,6 @@ (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)) @@ -78,11 +77,9 @@ (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] diff --git a/wrap.fnl b/wrap.fnl index da15362..9e3a221 100644 --- a/wrap.fnl +++ b/wrap.fnl @@ -12,6 +12,7 @@ "honeylisp:upload" (fn [] (local p (util.reload "game")) (p:upload link.machine) + (when link.machine.launch (link.machine:launch p)) (core.log (string.format "%x" (p:lookup-addr p.start-symbol)))) "honeylisp:reload" (fn [] (local p-before (require :game))