honeylisp/machine.fnl

115 lines
3.3 KiB
Plaintext
Raw Normal View History

(local command (require "core.command"))
(local {: spawn : kill } (require "spawn"))
(local socket (require "socket"))
(local json (require "dkjson"))
(local gsplus-path "/home/jeremy/src/gsplus/result/bin/GSplus")
(local debug-port 8769)
(local reg-write-format {
:ip " k%06X"
:a " a%04X"
:x " x%04X"
:y " y%04X"
:s " s%04X"
:d " d%04X"
:b " b%02X"
:psr " p%06X"
})
(local machine
{:boot
(fn [self]
(when (not self.pid)
(set self.pid (spawn [:nixGL gsplus-path :-debugport (tostring debug-port)]))))
:die
(fn [self]
(self:disconnect)
(when self.pid
(kill (- self.pid) 1)
(set self.pid nil)))
:connect
(fn [self]
(when (not self.socket)
(set self.socket (socket.connect :localhost debug-port))
(if self.socket
(self.socket:settimeout 1)
(love.timer.sleep 0.25))))
:disconnect
(fn [self]
(when self.socket
(self.socket:close)
(set self.socket nil)))
:cmd (fn [self cmd] (self.socket:send (.. cmd "\n")))
:response
(fn [self]
(var bytes "")
(var done false)
(while (not done)
(local (line err) (self.socket:receive))
(set done (or (= line "") (= line nil)))
(when line (set bytes (.. bytes line))))
(json.decode bytes))
:cmd-response (fn [self cmd] (self:cmd cmd) (self:response))
:hello (fn [self] (self:cmd-response "1"))
:continue (fn [self] (self:cmd-response "3"))
:step (fn [self] (self:cmd-response "2"))
:getreg (fn [self] (self:cmd-response "4"))
:set-bp (fn [self addr] (self:cmd-response (.. "8" (string.format "%06X" addr))))
:delete-bp (fn [self addr] (self:cmd-response (.. "9" (string.format "%06X" addr))))
:get-bp (fn [self] (self:cmd-response "A"))
:write
(fn [self addr bytes]
(var bytes-to-write bytes)
(var addrout addr)
(while (> (length bytes-to-write) 0)
(local bytesout (bytes-to-write:sub 1 50))
(self:cmd-response (.. "7" (string.format "%06X" addrout) (bytesout:tohex)))
(set bytes-to-write (bytes-to-write:sub 51))
(set addrout (+ addrout 50))))
:setreg
(fn [self regvals]
(var bytes "5")
(each [reg val (pairs regvals)]
(set bytes (.. bytes (string.format (. reg-write-format reg) val))))
(self:cmd-response bytes))
:stop-at
(fn [self addr k]
(local fulladdr (bit.bor addr (bit.lshift (or k 0) 16)))
(self:set-bp fulladdr)
(var retries 5)
(while (> retries 0)
(local reg (. (self:getreg) 1 :data))
(local pc (reg.PC:fromhex))
(local curr-k (reg.K:fromhex))
(print (curr-k:tohex) (pc:tohex))
(if (and (= pc addr) (= curr-k (or k 0)))
(set retries 0)
(do (love.timer.sleep 1) (set retries (- retries 1)))))
(self:delete-bp fulladdr))
})
(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