(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 current-pluginspath [] (local f (io.popen "mame -showconfig" :r)) (var pluginspath "") (each [line (f:lines)] (local path (line:match "pluginspath%s+(.*)")) (when path (set pluginspath path))) pluginspath) (local pluginspath (.. (current-pluginspath) ";" (love.filesystem.getWorkingDirectory) "/support/mame")) (fn start-mame [platform] (spawn [:mame :-debug :-plugins :-pluginspath pluginspath :-plugin :jeejah platform])) (local Machine (Session:extend)) (fn Machine.new [self] (Machine.super.new self {:out (fn []) :value (fn [])}) (set self.breakpoints {})) (fn Machine.boot [self] (when (not self.pid) (set self.pid (start-mame :apple2e)))) (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.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:continue) ; debug mame starts paused (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) (when self.monitor (self.monitor:shutdown-session)) (when (nrepl:connected?) (nrepl:disconnect)) (set self.breakpoints {})) (fn Machine.read [self addr len] (-> (self:coro-eval (.. "(let [bencode (require :bencode) addr " addr " len " len " mem (. manager.machine.devices ::maincpu :spaces :program)] (var bytes \"\") (print :reading len :from addr) (for [i 1 len] (set bytes (.. bytes (string.char (mem:read_u8 (+ addr i -1)))))) bytes)")) ; result is piped through fennelview; have to eval it to turn it back into bytes ; would be nice if io.write worked (fennel.eval))) (fn Machine.write [self addr bytes] (if (> (bytes:len) 0x1000) (do (self:write addr (bytes:sub 1 0x1000)) (self:write (+ addr 0x1000) (bytes:sub 0x1001))) (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)))))" (bencode.encode {: addr : bytes})))) (fn Machine.launch [self prg] (self:eval "(manager.machine:soft_reset)") (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:hard_reset)")) (fn Machine.coro-eval [self code ?handlers] (var result nil) (local append-to-result #(set result (.. (or result "") $2))) (self:eval code (self:coro-handlers (coroutine.running) {:value append-to-result :out append-to-result} ?handlers)) (coroutine.yield) (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.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 0x" (string.format "%x" 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 #(util.in-coro (fn [] (self:clear-bp addr) (local hotswap (prg-old:read-hotswap self)) (prg-new:upload self) (prg-new:write-hotswap self hotswap) (self:jump (prg-new:lookup-addr :on-hotswap)) (self:continue))))) (fn Machine.overlay [self prg-overlay] (self:step) (prg-overlay:upload self) (self:continue)) (Machine:new) Machine