191 lines
7.3 KiB
Fennel
191 lines
7.3 KiB
Fennel
(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 :apple2gs))))
|
|
(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]
|
|
(var bytes nil)
|
|
(self:coro-eval
|
|
"(let [bencode (require :bencode)
|
|
{: addr : len} (bencode.decode (io.read))
|
|
mem (. manager.machine.devices ::maincpu :spaces :program)]
|
|
(var bytes \"\")
|
|
(for [i 1 len]
|
|
(set bytes (.. bytes (string.char (mem:read_u8 (+ addr i -1))))))
|
|
(io.write bytes))"
|
|
(lume.merge
|
|
(self:input-handler (bencode.encode {: addr : len}))
|
|
{:out #(set bytes $2)}))
|
|
bytes)
|
|
(fn Machine.read-batch [self addr-to-len]
|
|
(var addr-to-bytes nil)
|
|
(self:coro-eval
|
|
"(let [bencode (require :bencode)
|
|
addr-to-len (bencode.decode (io.read))
|
|
mem (. manager.machine.devices ::maincpu :spaces :program)
|
|
addr-to-bytes {}]
|
|
(each [addr len (pairs addr-to-len)]
|
|
(var bytes \"\")
|
|
(for [i 1 len]
|
|
(set bytes (.. bytes (string.char (mem:read_u8 (+ addr i -1))))))
|
|
(tset addr-to-bytes addr bytes))
|
|
(io.write (bencode.encode addr-to-bytes)))"
|
|
(lume.merge
|
|
(self:input-handler (bencode.encode addr-to-len))
|
|
{:out #(set addr-to-bytes (bencode.decode $2))}))
|
|
addr-to-bytes)
|
|
(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.write-batch [self addr-to-bytes]
|
|
(self:eval-input
|
|
"(let [bencode (require :bencode)
|
|
addr-to-bytes (bencode.decode (io.read))
|
|
mem (. manager.machine.devices ::maincpu :spaces :program)]
|
|
(each [addr bytes (pairs addr-to-bytes)]
|
|
(for [i 1 (bytes:len)]
|
|
(mem:write_u8 (+ addr i -1) (string.byte (bytes:sub i i))))))"
|
|
(bencode.encode addr-to-bytes)))
|
|
(fn Machine.launch [self prg]
|
|
(self:eval "(manager.machine:soft_reset)")
|
|
(self:eval (string.format "(emu.keypost \"\n\nCALL-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)
|
|
(lume.merge {:value append-to-result :out append-to-result}
|
|
(or ?handlers {}))))
|
|
(coroutine.yield)
|
|
(or result "<no 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))
|
|
(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
|