Delete dead code

This commit is contained in:
Jeremy Penner 2020-11-19 23:35:39 -05:00
parent 7853a9c0cf
commit ca54a0d248
4 changed files with 2 additions and 297 deletions

View file

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

View file

@ -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}

View file

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

View file

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