First vaguely working hot code reload, allow programs to depend on each other, draw coloured tiles in editor

This commit is contained in:
Jeremy Penner 2020-10-14 23:40:01 -04:00
parent 6bf3aa2b91
commit 9a27af1b52
11 changed files with 180 additions and 77 deletions

View file

@ -92,17 +92,6 @@
{:parent parent {:parent parent
:block block :block block
:is-zp? (fn [self name] (self.parent:is-zp? name)) :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 :lookup-addr
(fn [self name] (fn [self name]
(local ipdat (. self.block.symbols name)) (local ipdat (. self.block.symbols name))
@ -115,7 +104,7 @@
(self.parent:lookup-addr name)))}) (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) ; dat - anything that takes up space in the assembled output (op, dw, db, etc)
; takes the form [:op args] ; takes the form [:op args]
; pdat - a parsed dat; takes the form {:type type :addr addr ...} ; pdat - a parsed dat; takes the form {:type type :addr addr ...}
@ -214,15 +203,16 @@
(each [_ pdat (ipairs block.pdats)] (each [_ pdat (ipairs block.pdats)]
(process-pdat pdat :patch nil block-env))) (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) (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)] (each [_ pdat (ipairs block.pdats)]
(set pdat.addr (+ addr size)) (set pdat.addr (+ baseaddr size))
(process-pdat pdat :allocate nil pdat.addr) (process-pdat pdat :allocate nil pdat.addr)
(local pdatsize (process-pdat pdat :size pdat.size)) (local pdatsize (process-pdat pdat :size pdat.size))
(set pdat.size pdatsize) (set pdat.size pdatsize)
(set pdat.addr (+ addr size)) (set pdat.addr (+ baseaddr size))
(set size (+ size pdatsize))) (set size (+ size pdatsize)))
(set block.size size)) (set block.size size))
@ -244,6 +234,7 @@
: dat-parser : dat-parser
: pdat-processor : pdat-processor
: new-block : new-block
: prg-base
:parse-dats (fn [self block dats] (parse-dats block dats)) :parse-dats (fn [self block dats] (parse-dats block dats))
:dbg :dbg
(fn [self ...] (fn [self ...]
@ -273,15 +264,16 @@
:is-zp? :is-zp?
(fn [self name] (fn [self name]
(local org (. self.symbol-to-org name)) (local org (. self.symbol-to-org name))
(if org (if org (< org 0x100)
(< org 0x100) self.prg-base (self.prg-base:is-zp? name)
(< (self:parse-addr name) 0x100))) (< (self:parse-addr name) 0x100)))
:env-lookup :env-lookup
(fn [self name lookup ...] (fn [self name lookup ...]
(local org (. self.symbol-to-org name)) (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-symbol (fn [self addr]) TODO
:lookup-pdat (fn [self name] (self:env-lookup name :lookup-pdat))
:lookup-addr :lookup-addr
(fn [self name] (fn [self name]
; (print "looking up" name "in" self) ; (print "looking up" name "in" self)
@ -289,13 +281,13 @@
:pass :pass
(fn [self passname] (fn [self passname]
(each [org block (pairs self.org-to-block)] (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 :gather-symbols
(fn [self org block] (fn [self org block]
(each [_ name (ipairs (process-pdat block :symbols []))] (each [_ name (ipairs (process-pdat block :symbols []))]
(tset self.symbol-to-org name org))) (tset self.symbol-to-org name org)))
:patch (fn [self org block] (process-pdat block :patch nil self)) :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)) :generate (fn [self org block] (process-pdat block :generate nil self))
:debug-pass (fn [self org block] (self:dbg org block)) :debug-pass (fn [self org block] (self:dbg org block))
:assemble :assemble
@ -310,9 +302,10 @@
(set self.dbgfile nil)) (set self.dbgfile nil))
self) self)
:upload :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)] (each [org block (pairs self.org-to-block)]
(machine:write org block.bytes))) (machine:write block.addr block.bytes)))
}) })
{:new program} {:new program}

View file

@ -285,6 +285,9 @@
(fn vm.until [self ...] (fn vm.until [self ...]
[:block :start [:vm ...] [:ref :bz] [:ref :start]]) [:block :start [:vm ...] [:ref :bz] [:ref :start]])
(fn vm.forever [self ...]
[:block :start [:vm ...] [:vm :jmp :start]])
(fn vm.for [self ...] (fn vm.for [self ...]
[:vm :>r (vm:while [:rtop] :r> :dec :>r ...) :rdrop]) [:vm :>r (vm:while [:rtop] :r> :dec :>r ...) :rdrop])

59
editor/tiledraw.fnl Normal file
View file

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

View file

@ -2,13 +2,14 @@
(local command (require :core.command)) (local command (require :core.command))
(local style (require :core.style)) (local style (require :core.style))
(local View (require :core.view)) (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 lume (require :lib.lume))
(local TileView (View:extend)) (local TileView (View:extend))
(local pixel-size 24) (local pixel-size 24)
(local sprite-scale 4)
(local xy-to-ibit []) (local xy-to-ibit [])
(for [x 0 15] (tset xy-to-ibit x [])) (for [x 0 15] (tset xy-to-ibit x []))
(for [y 0 15] (for [y 0 15]
@ -43,10 +44,7 @@
(tile:sub (+ ibyte 2)))) (tile:sub (+ ibyte 2))))
(fn draw-bit-color [bit x y] (fn draw-bit-color [bit x y]
(local (bgcolor color) (local (bgcolor color) (tiledraw.pal-from-bit bit))
(if bit
(values [20 207 253] [255 106 60])
(values [255 68 253] [20 245 60])))
(renderer.draw_rect x y pixel-size pixel-size bgcolor) (renderer.draw_rect x y pixel-size pixel-size bgcolor)
(renderer.draw_rect (+ x 3) (+ y 3) (- pixel-size 6) (- pixel-size 6) color)) (renderer.draw_rect (+ x 3) (+ y 3) (- pixel-size 6) (- pixel-size 6) color))
@ -63,30 +61,40 @@
(fn TileView.new [self] (fn TileView.new [self]
(self.super.new self) (self.super.new self)
(set self.tiles (tile.loadtiles)) (set self.tiles (tiles.loadtiles))
(set self.itile 1)) (set self.itile 1)
(set self.tilesprites []))
(fn TileView.tile [self] (or (. self.tiles self.itile) (string.rep "\0" 32))) (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] (fn TileView.set-bit [self ibyte ibit bit-set]
(set self.ibyte ibyte) (set self.ibyte ibyte)
(set self.ibit ibit) (set self.ibit ibit)
(set self.bit-set bit-set) (set self.bit-set bit-set)
(self:update-tile (set-tile-bit (self:tile) ibyte ibit bit-set)) (self:update-tile (set-tile-bit (self:tile) ibyte ibit bit-set))
true) true)
(fn TileView.save [self] (tiles.savetiles self.tiles))
(fn TileView.save [self] (tile.savetiles self.tiles))
(fn TileView.select-rel [self ditile] (fn TileView.select-rel [self ditile]
(local itile (+ self.itile ditile)) (local itile (+ self.itile ditile))
(when (>= itile 1) (set self.itile itile))) (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] (fn TileView.draw [self]
(self:draw_background style.background) (self:draw_background style.background)
(local (x y) (values (+ self.position.x 10) (+ self.position.y 10))) (local (x y) (values (+ self.position.x 10) (+ self.position.y 10)))
(local ybelow (draw-tile (self:tile) x y)) (draw-tile (self:tile) x y)
(local (byte bit) (map-bit (- (love.mouse.getX) x) (- (love.mouse.getY) y))) (love.graphics.setColor 1 1 1 1)
(when (and byte bit) (var tilex (+ self.position.x 10))
(renderer.draw_text style.font (: "%d, %d" :format byte bit) x ybelow style.text))) (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] (fn TileView.selected-bit [self mx my]
(local (x y) (values (+ self.position.x 10) (+ self.position.y 10))) (local (x y) (values (+ self.position.x 10) (+ self.position.y 10)))

View file

@ -1,8 +1,9 @@
(local lume (require "lib.lume")) (local lume (require :lib.lume))
(local asm (require "asm.asm")) (local asm (require :asm.asm))
(local VM (require "asm.vm")) (local VM (require :asm.vm))
(local tile (require :game.tile)) (local tile (require :game.tiles))
(local {: lo : hi} (require "lib.util")) (local link (require :link))
(local {: lo : hi} (require :lib.util))
(local prg (asm.new)) (local prg (asm.new))
; (prg:debug-to "test.dbg") ; (prg:debug-to "test.dbg")
@ -10,6 +11,7 @@
(local tiles (prg:org 0x6100)) (local tiles (prg:org 0x6100))
(local vm (VM.new prg)) (local vm (VM.new prg))
(local code1 vm.code) (local code1 vm.code)
(link.machine:stub code1 :next)
(local mon { (local mon {
:hexout :0xfdda :hexout :0xfdda
@ -146,17 +148,21 @@
[:sta vm.TOP :x]) [:sta vm.TOP :x])
(tile.appendtiles (tile.loadtiles) tiles) (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"]) ; thought:
; (tiles:append :stripetile [:bytes "zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz"]) ; 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 ; 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 (code1:append :main
[:jsr :reset] [:jsr :reset]
[:jsr :interpret] [:jsr :interpret]
[:vm :hires; :mixed [:vm :hires ; :mixed
:cleargfx :drawmap :cleargfx
(vm:forever
:debug-stub :drawmap
)
; 0x0000 :tile>screen 0 :lookup-tile :drawtile ; 0x0000 :tile>screen 0 :lookup-tile :drawtile
:quit]) :quit])

View file

@ -1 +1 @@
["000000020A0820202A2020080A02000000010141511105045404051151410100","808080C0C0C0E0C0D0C8C04040404080808083858585828A9282820A08081980","007C0C0C0C0C7C007C7E7EAA88888800001F181818181F001F0F979590909000"] ["000000020A0820404A4020080A02000000010141511005025302051051410100","00000000020A0820404A4020080A020000000101415110050253020510514101","808080C0C0C0E0C0D0C8C04040404080808083858585828A9282820A08081980","8080C0A0A0A0C0C0D0C8C0501010188080808183838782828A8A920202020380","8080E0B0B0B098C0D0D0C840404060808080878D8D8D99828A8A920202020780","8080C0E0E0E0B0C0D0C8C040404060808080838787878D828A92820202020780","007C0C0C0C0C7C007C7E7EAA88888800001F181818181F001F0F979590909000","007C2C0C0C2C7C007C7E7EAA88888800001F18191C191F001F0F979590909000","D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA","D5D5D5D5D5F5F5FDDDD5D5D5D5D5D5D5AAAAAAAAAEAEBFBFBFABAAAAAAAAAAAA","F7F7DDDDF7F7DDDDF7F7DDDDF7F7DDDDEEEEBBBBEEEEBBBBEEEEBBBBEEEEBBBB","F787A5B1B3B3B1B1B3B3B1B1B3B381DDEEE8B2A6E6E6A6A6E6E6A6A6E6E6A0BB","F78785818383818183838181838381DDEEE8B0A0E0E0A0A0E0E0A0A0E0E0A0BB","F7F7CDCDCFCF8981A3A3A5A5878FDDDDEEECA4A4E4E0A0A1E5E5A5A5E1E8BBBB","F7F7CDCDCFCF898123232525878FDDDDEEECA4A4E4E0A0216565252561E8BBBB"]

View file

@ -1,7 +1,9 @@
(local command (require "core.command")) (local command (require :core.command))
(local {: spawn : kill } (require "lib.spawn")) (local {: spawn : kill } (require :lib.spawn))
(local socket (require "socket")) (local socket (require :socket))
(local json (require "lib.dkjson")) (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 gsplus-path "/home/jeremy/src/gsplus/result/bin/GSplus")
@ -16,6 +18,11 @@
:b " b%02X" :b " b%02X"
:psr " p%06X" :psr " p%06X"
}) })
(fn get-cpu-reg [response]
(-> response
(lume.filter #(= $1.type :cpu))
(. 1 :data)))
(local machine (local machine
{:boot {:boot
(fn [self] (fn [self]
@ -52,9 +59,9 @@
(json.decode bytes)) (json.decode bytes))
:cmd-response (fn [self cmd] (self:cmd cmd) (self:response)) :cmd-response (fn [self cmd] (self:cmd cmd) (self:response))
:hello (fn [self] (self:cmd-response "1")) :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")) :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)))) :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)))) :delete-bp (fn [self addr] (self:cmd-response (.. "9" (string.format "%06X" addr))))
:get-bp (fn [self] (self:cmd-response "A")) :get-bp (fn [self] (self:cmd-response "A"))
@ -77,16 +84,28 @@
(fn [self addr k] (fn [self addr k]
(local fulladdr (bit.bor addr (bit.lshift (or k 0) 16))) (local fulladdr (bit.bor addr (bit.lshift (or k 0) 16)))
(self:set-bp fulladdr) (self:set-bp fulladdr)
(var retries 5) ; wait for breakpoint to be hit
(while (> retries 0) (var bp-response (self:response))
(local reg (. (self:getreg) 1 :data)) (self:delete-bp fulladdr)
(local pc (reg.PC:fromhex)) (when (not bp-response)
(local curr-k (reg.K:fromhex)) ; attempt to consume extra response in case the breakpoint was actually hit while sending the message to delete the breakpoint
(print (curr-k:tohex) (pc:tohex)) (set bp-response (self:response)))
(if (and (= pc addr) (= curr-k (or k 0))) (when bp-response
(set retries 0) (local reg (get-cpu-reg bp-response))
(do (love.timer.sleep 1) (set retries (- retries 1))))) (local pc (tonumber reg.PC 16))
(self:delete-bp fulladdr)) (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) { (command.add #(not machine.pid) {

10
link/init.fnl Normal file
View file

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

View file

@ -41,6 +41,7 @@
(set bytes-to-write (bytes-to-write:sub 11)) (set bytes-to-write (bytes-to-write:sub 11))
(set addrout (+ addrout 10)))) (set addrout (+ addrout 10))))
:monitor (fn [self] (self:cmd "CALL-151")) :monitor (fn [self] (self:cmd "CALL-151"))
:stub (fn [self org post-debug-stub]) ; todo
}) })
(command.add #(not (machine:connected?)) { (command.add #(not (machine:connected?)) {

View file

@ -2,26 +2,29 @@
(local util (require "lib.util")) (local util (require "lib.util"))
(local lume (require "lib.lume")) (local lume (require "lib.lume"))
(local imgui (require "imgui")) (local imgui (require "imgui"))
(local serial (require "link.serial")) (local link (require "link"))
(local gsplus (require "link.machine"))
(local core (require "core")) (local core (require "core"))
(local command (require "core.command")) (local command (require "core.command"))
(local keymap (require "core.keymap")) (local keymap (require "core.keymap"))
(local translate (require "core.doc.translate")) (local translate (require "core.doc.translate"))
(var machine (if (and (pcall #(serial:connect)) (serial:connected?)) serial gsplus)) (command.add #(not= link.name :serial) {
"serial:switch-machine" #(link:switch :serial)
(command.add #(not= machine serial) {
"serial:switch-machine" #(set machine serial)
}) })
(command.add #(not= machine gsplus) { (command.add #(not= link.name :gsplus) {
"gsplus:switch-machine" #(set machine gsplus) "gsplus:switch-machine" #(link.switch :gsplus)
}) })
(command.add #(machine:connected?) { (command.add #(link.machine:connected?) {
"honeylisp:upload" (fn [] "honeylisp:upload" (fn []
(local p (util.reload "game")) (local p (util.reload "game"))
(p:upload machine) (p:upload link.machine)
(core.log (string.format "%x" (p:lookup-addr p.start-symbol)))) (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) { (command.add (fn [] true) {
"honeylisp:rebuild" #(util.reload "game") "honeylisp:rebuild" #(util.reload "game")
@ -64,6 +67,7 @@
"alt+e" "fennel:eval" "alt+e" "fennel:eval"
"alt+r" "lume:hotswap" "alt+r" "lume:hotswap"
"alt+a" "honeylisp:address" "alt+a" "honeylisp:address"
"alt+l" "honeylisp:reload"
}) })
(fn love.load []) (fn love.load [])