First vaguely working hot code reload, allow programs to depend on each other, draw coloured tiles in editor
This commit is contained in:
parent
6bf3aa2b91
commit
9a27af1b52
41
asm/asm.fnl
41
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}
|
||||
|
|
|
|||
|
|
@ -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])
|
||||
|
||||
|
|
|
|||
59
editor/tiledraw.fnl
Normal file
59
editor/tiledraw.fnl
Normal 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}
|
||||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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])
|
||||
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
["000000020A0820202A2020080A02000000010141511105045404051151410100","808080C0C0C0E0C0D0C8C04040404080808083858585828A9282820A08081980","007C0C0C0C0C7C007C7E7EAA88888800001F181818181F001F0F979590909000"]
|
||||
["000000020A0820404A4020080A02000000010141511005025302051051410100","00000000020A0820404A4020080A020000000101415110050253020510514101","808080C0C0C0E0C0D0C8C04040404080808083858585828A9282820A08081980","8080C0A0A0A0C0C0D0C8C0501010188080808183838782828A8A920202020380","8080E0B0B0B098C0D0D0C840404060808080878D8D8D99828A8A920202020780","8080C0E0E0E0B0C0D0C8C040404060808080838787878D828A92820202020780","007C0C0C0C0C7C007C7E7EAA88888800001F181818181F001F0F979590909000","007C2C0C0C2C7C007C7E7EAA88888800001F18191C191F001F0F979590909000","D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA","D5D5D5D5D5F5F5FDDDD5D5D5D5D5D5D5AAAAAAAAAEAEBFBFBFABAAAAAAAAAAAA","F7F7DDDDF7F7DDDDF7F7DDDDF7F7DDDDEEEEBBBBEEEEBBBBEEEEBBBBEEEEBBBB","F787A5B1B3B3B1B1B3B3B1B1B3B381DDEEE8B2A6E6E6A6A6E6E6A6A6E6E6A0BB","F78785818383818183838181838381DDEEE8B0A0E0E0A0A0E0E0A0A0E0E0A0BB","F7F7CDCDCFCF8981A3A3A5A5878FDDDDEEECA4A4E4E0A0A1E5E5A5A5E1E8BBBB","F7F7CDCDCFCF898123232525878FDDDDEEECA4A4E4E0A0216565252561E8BBBB"]
|
||||
|
|
@ -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) {
|
||||
10
link/init.fnl
Normal file
10
link/init.fnl
Normal 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
|
||||
|
|
@ -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?)) {
|
||||
|
|
|
|||
24
wrap.fnl
24
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 [])
|
||||
|
|
|
|||
Loading…
Reference in a new issue