From 9a27af1b52988700a08aa9ec839e5242dc2c9537 Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Wed, 14 Oct 2020 23:40:01 -0400 Subject: [PATCH] First vaguely working hot code reload, allow programs to depend on each other, draw coloured tiles in editor --- asm/asm.fnl | 41 +++++++++------------- asm/vm.fnl | 3 ++ editor/tiledraw.fnl | 59 ++++++++++++++++++++++++++++++++ editor/tileedit.fnl | 38 ++++++++++++-------- game/init.fnl | 28 +++++++++------ game/{tile.fnl => tiles.fnl} | 0 game/tiles.json | 2 +- link/{machine.fnl => gsplus.fnl} | 51 ++++++++++++++++++--------- link/init.fnl | 10 ++++++ link/serial.fnl | 1 + wrap.fnl | 24 +++++++------ 11 files changed, 180 insertions(+), 77 deletions(-) create mode 100644 editor/tiledraw.fnl rename game/{tile.fnl => tiles.fnl} (100%) rename link/{machine.fnl => gsplus.fnl} (70%) create mode 100644 link/init.fnl diff --git a/asm/asm.fnl b/asm/asm.fnl index 23a38a0..596390f 100644 --- a/asm/asm.fnl +++ b/asm/asm.fnl @@ -92,17 +92,6 @@ {:parent parent :block block :is-zp? (fn [self name] (self.parent:is-zp? name)) - :lookup-pdat - (fn [self name] - (local ipdat (. self.block.symbols name)) - (if - (and ipdat (> ipdat (length self.block.pdats))) - nil - - ipdat (. self.block.pdats ipdat) - - (self.parent:lookup-pdat name))) - :lookup-addr (fn [self name] (local ipdat (. self.block.symbols name)) @@ -115,7 +104,7 @@ (self.parent:lookup-addr name)))}) -(fn program [] +(fn program [prg-base] ; dat - anything that takes up space in the assembled output (op, dw, db, etc) ; takes the form [:op args] ; pdat - a parsed dat; takes the form {:type type :addr addr ...} @@ -214,15 +203,16 @@ (each [_ pdat (ipairs block.pdats)] (process-pdat pdat :patch nil block-env))) - (fn pdat-processor.block.allocate [block addr] + (fn pdat-processor.block.allocate [block addr base-org] (var size 0) - (set block.addr addr) + (local baseaddr (if base-org (+ base-org.addr base-org.size) addr)) + (set block.addr baseaddr) (each [_ pdat (ipairs block.pdats)] - (set pdat.addr (+ addr size)) + (set pdat.addr (+ baseaddr size)) (process-pdat pdat :allocate nil pdat.addr) (local pdatsize (process-pdat pdat :size pdat.size)) (set pdat.size pdatsize) - (set pdat.addr (+ addr size)) + (set pdat.addr (+ baseaddr size)) (set size (+ size pdatsize))) (set block.size size)) @@ -244,6 +234,7 @@ : dat-parser : pdat-processor : new-block + : prg-base :parse-dats (fn [self block dats] (parse-dats block dats)) :dbg (fn [self ...] @@ -273,15 +264,16 @@ :is-zp? (fn [self name] (local org (. self.symbol-to-org name)) - (if org - (< org 0x100) + (if org (< org 0x100) + self.prg-base (self.prg-base:is-zp? name) (< (self:parse-addr name) 0x100))) :env-lookup (fn [self name lookup ...] (local org (. self.symbol-to-org name)) - (and org (: (make-env (. self.org-to-block org) self) lookup name ...))) + (if org (: (make-env (. self.org-to-block org) self) lookup name ...) + self.prg-base (self.prg-base:env-lookup name lookup ...) + nil)) ; :lookup-symbol (fn [self addr]) TODO - :lookup-pdat (fn [self name] (self:env-lookup name :lookup-pdat)) :lookup-addr (fn [self name] ; (print "looking up" name "in" self) @@ -289,13 +281,13 @@ :pass (fn [self passname] (each [org block (pairs self.org-to-block)] - (: self passname org block))) + (: self passname org block (if self.prg-base (. self.prg-base.org-to-block org) nil)))) :gather-symbols (fn [self org block] (each [_ name (ipairs (process-pdat block :symbols []))] (tset self.symbol-to-org name org))) :patch (fn [self org block] (process-pdat block :patch nil self)) - :allocate (fn [self org block] (process-pdat block :allocate nil org)) + :allocate (fn [self org block base-org] (process-pdat block :allocate nil org base-org)) :generate (fn [self org block] (process-pdat block :generate nil self)) :debug-pass (fn [self org block] (self:dbg org block)) :assemble @@ -310,9 +302,10 @@ (set self.dbgfile nil)) self) :upload - (fn [self machine] + (fn [self machine only-self] + (when (and (not only-self) self.prg-base) (self.prg-base:upload machine)) (each [org block (pairs self.org-to-block)] - (machine:write org block.bytes))) + (machine:write block.addr block.bytes))) }) {:new program} diff --git a/asm/vm.fnl b/asm/vm.fnl index 267468d..cb6aa7d 100644 --- a/asm/vm.fnl +++ b/asm/vm.fnl @@ -285,6 +285,9 @@ (fn vm.until [self ...] [:block :start [:vm ...] [:ref :bz] [:ref :start]]) + (fn vm.forever [self ...] + [:block :start [:vm ...] [:vm :jmp :start]]) + (fn vm.for [self ...] [:vm :>r (vm:while [:rtop] :r> :dec :>r ...) :rdrop]) diff --git a/editor/tiledraw.fnl b/editor/tiledraw.fnl new file mode 100644 index 0000000..67f4ad5 --- /dev/null +++ b/editor/tiledraw.fnl @@ -0,0 +1,59 @@ +(fn pal-from-bit [bit] + (if bit + (values [20 207 253] [255 106 60]) + (values [255 68 253] [20 245 60]))) + +(fn pal-from-byte [byte] + (pal-from-bit (not= 0 (bit.band byte 0x80)))) + +(fn putpixel [x y color] + (when color + (love.graphics.setColor (/ (. color 1) 255) (/ (. color 2) 255) (/ (. color 3) 255)) + (love.graphics.points (+ x 0.5) (+ y 0.5)))) + +(fn tile-to-sprite [tile] + (local canvas (love.graphics.newCanvas 14 16)) + (canvas:setFilter :nearest :nearest) + (local scissor [(love.graphics.getScissor)]) + (love.graphics.setScissor) + (love.graphics.setCanvas canvas) + (love.graphics.clear 0 0 0) + (for [y 0 15] + (local byte1 (string.byte (tile:sub (+ y 1) (+ y 1)))) + (local byte2 (string.byte (tile:sub (+ y 17) (+ y 17)))) + (local pal1 [(pal-from-byte byte1)]) + (local pal2 [(pal-from-byte byte2)]) + (var prevstate :off) + (var state :off) + (for [x 0 13] + (local byte (if (< x 7) byte1 byte2)) + (local bitx (if (< x 7) x (- x 7))) + (local bit (not= 0 (bit.band byte (bit.lshift 1 bitx)))) + (local prevpal (if (< x 8) pal1 pal2)) + (local pal (if (< x 7) pal1 pal2)) + (local prevart (. prevpal (+ 1 (% x 2)))) + (local art (. pal (+ 1 (% x 2)))) + (set prevstate state) + (set state + (match [prevstate bit] + [:off false] :off + [:off true] :rising + [:rising false] :falling + [:rising true] :on + [:falling false] :off + [:falling true] :rising + [:on true] :on + [:on false] :falling)) + (local white [255 255 255]) + (local (prevcolor color) + (match [prevstate state] + [_ :on] (values white white) + [:off :rising] (values nil art) + [:falling :rising] (values prevart art))) + (putpixel (- x 1) y prevcolor) + (putpixel x y color))) + (love.graphics.setCanvas) + (love.graphics.setScissor (table.unpack scissor)) + canvas) + +{: tile-to-sprite : pal-from-bit : pal-from-byte} diff --git a/editor/tileedit.fnl b/editor/tileedit.fnl index ac7cbf7..7d309ef 100644 --- a/editor/tileedit.fnl +++ b/editor/tileedit.fnl @@ -2,13 +2,14 @@ (local command (require :core.command)) (local style (require :core.style)) (local View (require :core.view)) -(local tile (require :game.tile)) +(local tiles (require :game.tiles)) +(local tiledraw (require :editor.tiledraw)) (local lume (require :lib.lume)) (local TileView (View:extend)) (local pixel-size 24) - +(local sprite-scale 4) (local xy-to-ibit []) (for [x 0 15] (tset xy-to-ibit x [])) (for [y 0 15] @@ -43,10 +44,7 @@ (tile:sub (+ ibyte 2)))) (fn draw-bit-color [bit x y] - (local (bgcolor color) - (if bit - (values [20 207 253] [255 106 60]) - (values [255 68 253] [20 245 60]))) + (local (bgcolor color) (tiledraw.pal-from-bit bit)) (renderer.draw_rect x y pixel-size pixel-size bgcolor) (renderer.draw_rect (+ x 3) (+ y 3) (- pixel-size 6) (- pixel-size 6) color)) @@ -63,30 +61,40 @@ (fn TileView.new [self] (self.super.new self) - (set self.tiles (tile.loadtiles)) - (set self.itile 1)) + (set self.tiles (tiles.loadtiles)) + (set self.itile 1) + (set self.tilesprites [])) (fn TileView.tile [self] (or (. self.tiles self.itile) (string.rep "\0" 32))) -(fn TileView.update-tile [self newtile] (tset self.tiles self.itile newtile)) +(fn TileView.update-tile [self newtile] + (tset self.tiles self.itile newtile) + (tset self.tilesprites self.itile nil)) (fn TileView.set-bit [self ibyte ibit bit-set] (set self.ibyte ibyte) (set self.ibit ibit) (set self.bit-set bit-set) (self:update-tile (set-tile-bit (self:tile) ibyte ibit bit-set)) true) - -(fn TileView.save [self] (tile.savetiles self.tiles)) +(fn TileView.save [self] (tiles.savetiles self.tiles)) (fn TileView.select-rel [self ditile] (local itile (+ self.itile ditile)) (when (>= itile 1) (set self.itile itile))) +(fn TileView.tilesprite [self itile] + (when (and (= nil (. self.tilesprites itile)) (not= nil (. self.tiles itile))) + (tset self.tilesprites itile (tiledraw.tile-to-sprite (. self.tiles itile)))) + (. self.tilesprites itile)) + (fn TileView.draw [self] (self:draw_background style.background) (local (x y) (values (+ self.position.x 10) (+ self.position.y 10))) - (local ybelow (draw-tile (self:tile) x y)) - (local (byte bit) (map-bit (- (love.mouse.getX) x) (- (love.mouse.getY) y))) - (when (and byte bit) - (renderer.draw_text style.font (: "%d, %d" :format byte bit) x ybelow style.text))) + (draw-tile (self:tile) x y) + (love.graphics.setColor 1 1 1 1) + (var tilex (+ self.position.x 10)) + (var tiley (+ self.position.y (* 18 (+ pixel-size 1)))) + (each [itile _ (ipairs self.tiles)] + (love.graphics.draw (self:tilesprite itile) tilex tiley 0 sprite-scale sprite-scale) + (set tilex (+ tilex (* 16 sprite-scale))))) (fn TileView.selected-bit [self mx my] (local (x y) (values (+ self.position.x 10) (+ self.position.y 10))) diff --git a/game/init.fnl b/game/init.fnl index fbca100..c823f1f 100644 --- a/game/init.fnl +++ b/game/init.fnl @@ -1,8 +1,9 @@ -(local lume (require "lib.lume")) -(local asm (require "asm.asm")) -(local VM (require "asm.vm")) -(local tile (require :game.tile)) -(local {: lo : hi} (require "lib.util")) +(local lume (require :lib.lume)) +(local asm (require :asm.asm)) +(local VM (require :asm.vm)) +(local tile (require :game.tiles)) +(local link (require :link)) +(local {: lo : hi} (require :lib.util)) (local prg (asm.new)) ; (prg:debug-to "test.dbg") @@ -10,6 +11,7 @@ (local tiles (prg:org 0x6100)) (local vm (VM.new prg)) (local code1 vm.code) +(link.machine:stub code1 :next) (local mon { :hexout :0xfdda @@ -146,17 +148,21 @@ [:sta vm.TOP :x]) (tile.appendtiles (tile.loadtiles) tiles) -; (tiles:append :blanktile [:bytes "\0\0\0\0\0\0\0\0\0\255\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"]) -; (tiles:append :testtile [:bytes "12345678901234567890123456789012"]) -; (tiles:append :stripetile [:bytes "zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz"]) + +; thought: +; hotswap-safe debug stub at root of call stack +; but REPL debug stub should be very available as a task ; 19x11 means full map is 209 bytes -(: (prg:org 0x6800) :append :map [:bytes (string.rep "\0\032\064" 85)]) +(: (prg:org 0x6800) :append :map [:bytes (string.rep "\0\032\064\096\128\160\192\224\001\033\065\097\129\161\193" 17)]) (code1:append :main [:jsr :reset] [:jsr :interpret] - [:vm :hires; :mixed - :cleargfx :drawmap + [:vm :hires ; :mixed + :cleargfx + (vm:forever + :debug-stub :drawmap + ) ; 0x0000 :tile>screen 0 :lookup-tile :drawtile :quit]) diff --git a/game/tile.fnl b/game/tiles.fnl similarity index 100% rename from game/tile.fnl rename to game/tiles.fnl diff --git a/game/tiles.json b/game/tiles.json index fc58e6c..fda96e4 100644 --- a/game/tiles.json +++ b/game/tiles.json @@ -1 +1 @@ -["000000020A0820202A2020080A02000000010141511105045404051151410100","808080C0C0C0E0C0D0C8C04040404080808083858585828A9282820A08081980","007C0C0C0C0C7C007C7E7EAA88888800001F181818181F001F0F979590909000"] \ No newline at end of file +["000000020A0820404A4020080A02000000010141511005025302051051410100","00000000020A0820404A4020080A020000000101415110050253020510514101","808080C0C0C0E0C0D0C8C04040404080808083858585828A9282820A08081980","8080C0A0A0A0C0C0D0C8C0501010188080808183838782828A8A920202020380","8080E0B0B0B098C0D0D0C840404060808080878D8D8D99828A8A920202020780","8080C0E0E0E0B0C0D0C8C040404060808080838787878D828A92820202020780","007C0C0C0C0C7C007C7E7EAA88888800001F181818181F001F0F979590909000","007C2C0C0C2C7C007C7E7EAA88888800001F18191C191F001F0F979590909000","D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA","D5D5D5D5D5F5F5FDDDD5D5D5D5D5D5D5AAAAAAAAAEAEBFBFBFABAAAAAAAAAAAA","F7F7DDDDF7F7DDDDF7F7DDDDF7F7DDDDEEEEBBBBEEEEBBBBEEEEBBBBEEEEBBBB","F787A5B1B3B3B1B1B3B3B1B1B3B381DDEEE8B2A6E6E6A6A6E6E6A6A6E6E6A0BB","F78785818383818183838181838381DDEEE8B0A0E0E0A0A0E0E0A0A0E0E0A0BB","F7F7CDCDCFCF8981A3A3A5A5878FDDDDEEECA4A4E4E0A0A1E5E5A5A5E1E8BBBB","F7F7CDCDCFCF898123232525878FDDDDEEECA4A4E4E0A0216565252561E8BBBB"] \ No newline at end of file diff --git a/link/machine.fnl b/link/gsplus.fnl similarity index 70% rename from link/machine.fnl rename to link/gsplus.fnl index 2284506..9551361 100644 --- a/link/machine.fnl +++ b/link/gsplus.fnl @@ -1,7 +1,9 @@ -(local command (require "core.command")) -(local {: spawn : kill } (require "lib.spawn")) -(local socket (require "socket")) -(local json (require "lib.dkjson")) +(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") @@ -16,6 +18,11 @@ :b " b%02X" :psr " p%06X" }) +(fn get-cpu-reg [response] + (-> response + (lume.filter #(= $1.type :cpu)) + (. 1 :data))) + (local machine {:boot (fn [self] @@ -52,9 +59,9 @@ (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")) + :continue (fn [self] (self:cmd "3")) :step (fn [self] (self:cmd-response "2")) - :getreg (fn [self] (self:cmd-response "4")) + :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")) @@ -77,16 +84,28 @@ (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)) + ; 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)) + :stub + (fn [self org post-debug-stub] + (org:append :debug-stub [:jmp post-debug-stub])) }) (command.add #(not machine.pid) { diff --git a/link/init.fnl b/link/init.fnl new file mode 100644 index 0000000..860b0cf --- /dev/null +++ b/link/init.fnl @@ -0,0 +1,10 @@ +(local link + {:switch + (fn [self name] + (set self.machine (require (.. "link." name))) + (set self.name name))}) + +(local serial (require :link.serial)) +(link:switch (if (and (pcall #(serial:connect)) (serial:connected?)) :serial :gsplus)) + +link diff --git a/link/serial.fnl b/link/serial.fnl index 029dfc3..0f86608 100644 --- a/link/serial.fnl +++ b/link/serial.fnl @@ -41,6 +41,7 @@ (set bytes-to-write (bytes-to-write:sub 11)) (set addrout (+ addrout 10)))) :monitor (fn [self] (self:cmd "CALL-151")) + :stub (fn [self org post-debug-stub]) ; todo }) (command.add #(not (machine:connected?)) { diff --git a/wrap.fnl b/wrap.fnl index 15e7b14..5e15a2d 100644 --- a/wrap.fnl +++ b/wrap.fnl @@ -2,26 +2,29 @@ (local util (require "lib.util")) (local lume (require "lib.lume")) (local imgui (require "imgui")) -(local serial (require "link.serial")) -(local gsplus (require "link.machine")) +(local link (require "link")) (local core (require "core")) (local command (require "core.command")) (local keymap (require "core.keymap")) (local translate (require "core.doc.translate")) -(var machine (if (and (pcall #(serial:connect)) (serial:connected?)) serial gsplus)) - -(command.add #(not= machine serial) { - "serial:switch-machine" #(set machine serial) +(command.add #(not= link.name :serial) { + "serial:switch-machine" #(link:switch :serial) }) -(command.add #(not= machine gsplus) { - "gsplus:switch-machine" #(set machine gsplus) +(command.add #(not= link.name :gsplus) { + "gsplus:switch-machine" #(link.switch :gsplus) }) -(command.add #(machine:connected?) { +(command.add #(link.machine:connected?) { "honeylisp:upload" (fn [] (local p (util.reload "game")) - (p:upload machine) + (p:upload link.machine) (core.log (string.format "%x" (p:lookup-addr p.start-symbol)))) + "honeylisp:reload" (fn [] + (local p-before (require :game)) + (local p (util.reload :game)) + (if (link.machine:do p-before #(p:upload $1)) + (core.log "Reloaded!") + (core.log "Reload failed"))) }) (command.add (fn [] true) { "honeylisp:rebuild" #(util.reload "game") @@ -64,6 +67,7 @@ "alt+e" "fennel:eval" "alt+r" "lume:hotswap" "alt+a" "honeylisp:address" + "alt+l" "honeylisp:reload" }) (fn love.load [])