MAME hot reload support!

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

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
+  (self:eval-input
-    {: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)))))"}
+          (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})})}))
+    (bencode.encode {: addr : bytes})))
-(fn Machine.reboot [self] (self:eval "(: (manager:machine) :hard_reset)"))
+(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 "<no result?>"))
+  (or result "<no result>"))
-(fn Machine.dbgcmd [self cmd]
+(fn Machine.dbgcmd [self cmd ?handlers]
-  (self:eval (.. "(-> (manager:machine) (: :debugger) (: :command \"" cmd "\"))")))
+  (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
-
-

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

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]

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))