diff --git a/README.md b/README.md index 1c9ee09..e304572 100644 --- a/README.md +++ b/README.md @@ -21,7 +21,7 @@ Honeylisp comprises: * Actual hardware integration * Supports uploading to the Apple II via the cassette port or a serial card * TODO: Live interactive eval and hot code reload - + 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 to others. Its design is focussed on the molding of the tool to your individual diff --git a/lib/stream.fnl b/lib/stream.fnl deleted file mode 100644 index 493c079..0000000 --- a/lib/stream.fnl +++ /dev/null @@ -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} diff --git a/link/gsplus.fnl b/link/gsplus.fnl deleted file mode 100644 index e111928..0000000 --- a/link/gsplus.fnl +++ /dev/null @@ -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 - diff --git a/link/init.fnl b/link/init.fnl index 3ee003d..1655ade 100644 --- a/link/init.fnl +++ b/link/init.fnl @@ -3,7 +3,7 @@ (fn [self name] (set self.machine (require (.. "link." name))) (set self.name name)) - :types [:serial :gsplus :tape :mame]}) + :types [:serial :tape :mame]}) (local serial (require :link.serial)) (link:switch (if (and (pcall #(serial:connect)) (serial:connected?)) :serial :mame))