Delete dead code
This commit is contained in:
parent
7853a9c0cf
commit
ca54a0d248
|
@ -21,7 +21,7 @@ Honeylisp comprises:
|
||||||
* Actual hardware integration
|
* Actual hardware integration
|
||||||
* Supports uploading to the Apple II via the cassette port or a serial card
|
* Supports uploading to the Apple II via the cassette port or a serial card
|
||||||
* TODO: Live interactive eval and hot code reload
|
* TODO: Live interactive eval and hot code reload
|
||||||
|
|
||||||
The main goal of the project is to support the creation of a game called Neut
|
The main goal of the project is to support the creation of a game called Neut
|
||||||
Tower by its developer, but it is potentially generally interesting and useful
|
Tower by its developer, but it is potentially generally interesting and useful
|
||||||
to others. Its design is focussed on the molding of the tool to your individual
|
to others. Its design is focussed on the molding of the tool to your individual
|
||||||
|
|
163
lib/stream.fnl
163
lib/stream.fnl
|
@ -1,163 +0,0 @@
|
||||||
(var make-stream nil)
|
|
||||||
(fn stream [table]
|
|
||||||
(make-stream
|
|
||||||
{:table (or table [])
|
|
||||||
:i 0
|
|
||||||
:n (length (or table []))
|
|
||||||
:step 1
|
|
||||||
:next
|
|
||||||
(fn [self]
|
|
||||||
(when (~= self.i self.n)
|
|
||||||
(set self.i (+ self.i self.step))
|
|
||||||
true))
|
|
||||||
:curr (fn [self] (. self.table self.i))
|
|
||||||
:reverse
|
|
||||||
(fn [self]
|
|
||||||
(local prev-i self.i)
|
|
||||||
(set self.i (+ self.n self.step))
|
|
||||||
(set self.n (+ prev-i self.step))
|
|
||||||
(set self.step (* self.step -1))
|
|
||||||
self)}))
|
|
||||||
|
|
||||||
(fn kvstream [table]
|
|
||||||
(make-stream
|
|
||||||
{:table (or table {})
|
|
||||||
:curr-key nil
|
|
||||||
:curr-val :start
|
|
||||||
:curr (fn [self] (values self.curr-key self.curr-val))
|
|
||||||
:keys (fn [self] (self:map (fn [k v] k)))
|
|
||||||
:values (fn [self] (self:map (fn [k v] v)))
|
|
||||||
:next
|
|
||||||
(fn [self]
|
|
||||||
(when self.curr-val
|
|
||||||
(set (self.curr-key self.curr-val) (next self.table self.curr-key)))
|
|
||||||
(~= self.curr-key nil))}))
|
|
||||||
|
|
||||||
(fn one [...]
|
|
||||||
(make-stream
|
|
||||||
{:vals [...]
|
|
||||||
:advanced false
|
|
||||||
:curr (fn [self] (unpack self.vals))
|
|
||||||
:next
|
|
||||||
(fn [self]
|
|
||||||
(if self.advanced
|
|
||||||
false
|
|
||||||
(do
|
|
||||||
(set self.advanced true)
|
|
||||||
true)))}))
|
|
||||||
|
|
||||||
(fn iter [self]
|
|
||||||
(values
|
|
||||||
(fn [self _]
|
|
||||||
(when (self:next)
|
|
||||||
(self:curr)))
|
|
||||||
self
|
|
||||||
nil))
|
|
||||||
|
|
||||||
(fn first [self]
|
|
||||||
(if (self:next) (self:curr) nil))
|
|
||||||
|
|
||||||
(fn map [stream f]
|
|
||||||
(make-stream
|
|
||||||
{: stream : f
|
|
||||||
:curr (fn [self] (self.f (self.stream:curr)))
|
|
||||||
:next (fn [self] (self.stream:next))
|
|
||||||
:reverse
|
|
||||||
(fn [self]
|
|
||||||
(set self.stream (self.stream:reverse))
|
|
||||||
self)}))
|
|
||||||
|
|
||||||
(fn filter [stream f]
|
|
||||||
(make-stream
|
|
||||||
{: stream : f :curr-val nil
|
|
||||||
:curr (fn [self] self.curr-val)
|
|
||||||
:next
|
|
||||||
(fn [self]
|
|
||||||
(set self.curr-val nil)
|
|
||||||
(var has-more (self.stream:next))
|
|
||||||
(while has-more
|
|
||||||
(let [curr (self.stream:curr)
|
|
||||||
include? (self.f curr)]
|
|
||||||
(when include?
|
|
||||||
(set self.curr-val curr))
|
|
||||||
(set has-more (if include? false (self.stream:next)))))
|
|
||||||
self.curr-val)}))
|
|
||||||
|
|
||||||
(fn reduce [stream f init]
|
|
||||||
(var val init)
|
|
||||||
(each [v (stream:iter)]
|
|
||||||
(set val (f val v)))
|
|
||||||
val)
|
|
||||||
|
|
||||||
(fn flatten [stream]
|
|
||||||
(make-stream
|
|
||||||
{: stream
|
|
||||||
:curr-stream nil
|
|
||||||
:curr (fn [self] (self.curr-stream:curr))
|
|
||||||
:next
|
|
||||||
(fn [self]
|
|
||||||
(var reached-next
|
|
||||||
(if self.curr-stream (self.curr-stream:next) false))
|
|
||||||
(while (not reached-next)
|
|
||||||
(set self.curr-stream
|
|
||||||
(if (self.stream:next) (self.stream:curr) nil))
|
|
||||||
(set reached-next
|
|
||||||
(if self.curr-stream (self.curr-stream:next) true)))
|
|
||||||
(~= self.curr-stream nil))}))
|
|
||||||
|
|
||||||
(fn concat [s ...]
|
|
||||||
(: (stream [s ...]) :flatten))
|
|
||||||
|
|
||||||
(fn skip [stream n]
|
|
||||||
(make-stream
|
|
||||||
{: stream
|
|
||||||
: n
|
|
||||||
:curr (fn [self] (self.stream:curr))
|
|
||||||
:next
|
|
||||||
(fn [self]
|
|
||||||
(for [_ 1 self.n]
|
|
||||||
(self.stream:next))
|
|
||||||
(set self.n 0)
|
|
||||||
(self.stream:next))}))
|
|
||||||
|
|
||||||
(fn take [stream n]
|
|
||||||
(make-stream
|
|
||||||
{: stream
|
|
||||||
: next
|
|
||||||
:curr (fn [self] (self.stream:curr))
|
|
||||||
:next
|
|
||||||
(fn [self]
|
|
||||||
(if (> self.n 0)
|
|
||||||
(do
|
|
||||||
(set self.n (- self.n 1))
|
|
||||||
(self.stream:next))
|
|
||||||
false))}))
|
|
||||||
|
|
||||||
(fn tolist [stream]
|
|
||||||
(let [l []]
|
|
||||||
(each [v (stream:iter)]
|
|
||||||
(table.insert l v))
|
|
||||||
l))
|
|
||||||
|
|
||||||
(fn tomap [stream]
|
|
||||||
(let [m {}]
|
|
||||||
(each [k v (stream:iter)]
|
|
||||||
(tset m k v))
|
|
||||||
m))
|
|
||||||
|
|
||||||
(set make-stream
|
|
||||||
(fn [stream]
|
|
||||||
(set stream.iter iter)
|
|
||||||
(set stream.map map)
|
|
||||||
(set stream.filter filter)
|
|
||||||
(set stream.first first)
|
|
||||||
(set stream.reduce reduce)
|
|
||||||
(set stream.flatten flatten)
|
|
||||||
(set stream.concat concat)
|
|
||||||
(set stream.skip skip)
|
|
||||||
(set stream.take take)
|
|
||||||
(set stream.tolist tolist)
|
|
||||||
(set stream.tomap tomap)
|
|
||||||
stream))
|
|
||||||
|
|
||||||
{: stream : kvstream : one}
|
|
132
link/gsplus.fnl
132
link/gsplus.fnl
|
@ -1,132 +0,0 @@
|
||||||
(local command (require :core.command))
|
|
||||||
(local {: spawn : kill } (require :lib.spawn))
|
|
||||||
(local socket (require :socket))
|
|
||||||
(local json (require :lib.dkjson))
|
|
||||||
(local asm (require :asm.asm))
|
|
||||||
(local lume (require :lib.lume))
|
|
||||||
|
|
||||||
(local gsplus-path "/home/jeremy/src/gsplus/result/bin/GSplus")
|
|
||||||
|
|
||||||
(local debug-port 8769)
|
|
||||||
(local reg-write-format {
|
|
||||||
:PC " k%06X"
|
|
||||||
:A " a%04X"
|
|
||||||
:X " x%04X"
|
|
||||||
:Y " y%04X"
|
|
||||||
:S " s%04X"
|
|
||||||
:D " d%04X"
|
|
||||||
:B " b%02X"
|
|
||||||
:PSR " p%06X"
|
|
||||||
})
|
|
||||||
(fn get-cpu-reg [response]
|
|
||||||
(-> response
|
|
||||||
(lume.filter #(= $1.type :cpu))
|
|
||||||
(. 1 :data)))
|
|
||||||
|
|
||||||
(local machine
|
|
||||||
{:boot
|
|
||||||
(fn [self]
|
|
||||||
(when (not self.pid)
|
|
||||||
(set self.pid (spawn [:nixGL gsplus-path :-debugport (tostring debug-port)]))))
|
|
||||||
:run
|
|
||||||
(fn [self]
|
|
||||||
(self:boot)
|
|
||||||
(while (not self.socket) (self:connect))
|
|
||||||
(self:hello))
|
|
||||||
: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)))
|
|
||||||
:connected? (fn [self] self.socket)
|
|
||||||
:running? (fn [self] self.pid)
|
|
||||||
: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 "3"))
|
|
||||||
:step (fn [self] (self:cmd-response "2"))
|
|
||||||
:getreg (fn [self] (get-cpu-reg (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)
|
|
||||||
; wait for breakpoint to be hit
|
|
||||||
(var bp-response (self:response))
|
|
||||||
(self:delete-bp fulladdr)
|
|
||||||
(when (not bp-response)
|
|
||||||
; attempt to consume extra response in case the breakpoint was actually hit while sending the message to delete the breakpoint
|
|
||||||
(set bp-response (self:response)))
|
|
||||||
(when bp-response
|
|
||||||
(local reg (get-cpu-reg bp-response))
|
|
||||||
(local pc (tonumber reg.PC 16))
|
|
||||||
(local curr-k (tonumber reg.K 16))
|
|
||||||
(and (= pc addr) (= curr-k (or k 0)))))
|
|
||||||
|
|
||||||
:jump (fn [self addr] (self:setreg {:PC addr}))
|
|
||||||
:do
|
|
||||||
(fn [self prg f]
|
|
||||||
(when (self:stop-at (prg:lookup-addr :debug-stub))
|
|
||||||
(f self)
|
|
||||||
(self:continue)
|
|
||||||
true))
|
|
||||||
:hotswap
|
|
||||||
(fn [self prg-old prg-new]
|
|
||||||
(self:do prg-old
|
|
||||||
(fn []
|
|
||||||
(prg-new:upload self)
|
|
||||||
; on-hotswap may move around in memory; we can handle this
|
|
||||||
(self:jump (prg-new:lookup-addr :on-hotswap)))))
|
|
||||||
:stub
|
|
||||||
(fn [self org post-check-jump ...]
|
|
||||||
(org:append :debug-stub [:jmp post-check-jump] :on-hotswap ...))
|
|
||||||
})
|
|
||||||
|
|
||||||
(command.add (fn [] machine.socket) {
|
|
||||||
"gsplus:hello" #(machine:hello)
|
|
||||||
"gsplus:dump-cpu-state" #(pp (machine:getreg))
|
|
||||||
"gsplus:step" #(pp (machine:step))
|
|
||||||
"gsplus:continue" #(pp (machine:continue))
|
|
||||||
})
|
|
||||||
|
|
||||||
machine
|
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
(fn [self name]
|
(fn [self name]
|
||||||
(set self.machine (require (.. "link." name)))
|
(set self.machine (require (.. "link." name)))
|
||||||
(set self.name name))
|
(set self.name name))
|
||||||
:types [:serial :gsplus :tape :mame]})
|
:types [:serial :tape :mame]})
|
||||||
|
|
||||||
(local serial (require :link.serial))
|
(local serial (require :link.serial))
|
||||||
(link:switch (if (and (pcall #(serial:connect)) (serial:connected?)) :serial :mame))
|
(link:switch (if (and (pcall #(serial:connect)) (serial:connected?)) :serial :mame))
|
||||||
|
|
Loading…
Reference in a new issue