SpindleyQ/honeylisp
1
1
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Global labels, improved Apple II hotswap support

Browse source
This commit is contained in:
Jeremy Penner 2020-10-15 19:02:32 -04:00
parent 9a27af1b52
commit 750fffe015
6 changed files with 43 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
asm/asm.fnl
View file

@ -95,6 +95,7 @@
:lookup-addr
(fn [self name]
(local ipdat (. self.block.symbols name))
(local ipdat-global (. self.block.globals name))
; (print "looking up" name "in" self)
(if
(and ipdat (> ipdat (length self.block.pdats)))
@ -102,6 +103,8 @@
ipdat (. self.block.pdats ipdat :addr)
ipdat-global (: (make-env (. self.block.pdats ipdat-global) block) :lookup-addr name)
(self.parent:lookup-addr name)))})
(fn program [prg-base]
@ -109,12 +112,15 @@
; takes the form [:op args]
; pdat - a parsed dat; takes the form {:type type :addr addr ...}
(local dat-parser {})
(fn new-block [] {:type :block :pdats [] :symbols {}})
(fn new-block [] {:type :block :pdats [] :symbols {} :globals {}})
(fn parse-dats [block dats]
(each [_ dat (ipairs dats)]
(if (= (type dat) "string")
(do
(tset block.symbols dat (+ (length block.pdats) 1))
(when (= (dat:sub 1 2) "G-")
(tset block.globals dat true)))
(let [opcode (. dat 1)
parser (. dat-parser opcode)
pdat
@ -122,7 +128,10 @@
parser (parser dat block)
(. opcodes opcode) (dat-parser.op dat)
(error (.. "Unrecognized opcode " (fv opcode))))]
(table.insert block.pdats pdat))))
(table.insert block.pdats pdat)
(when (and pdat pdat.globals)
(each [name _ (pairs pdat.globals)]
(tset block.globals name (length block.pdats)))))))
block)
(fn dat-parser.op [op]

10
asm/vm.fnl
View file

@ -1,5 +1,6 @@
(local lume (require "lib.lume"))
(local {: lo : hi} (require "lib.util"))
(local link (require :link))
(fn inc16-stk [l h]
[:block
@ -91,6 +92,15 @@
:asm
(fn [self ...]
[:block [:vm :native] [:block ...] [:jsr :interpret]])
:hotswap-sync
(fn [self]
(link.machine:stub code1 :next
[:lda #(lo ($1:lookup-addr :G-POST-HOTSWAP-RESET))]
[:sta self.IP]
[:lda #(hi ($1:lookup-addr :G-POST-HOTSWAP-RESET))]
[:sta self.IPH]
[:jmp :next])
[:vm :debug-stub [:block :G-POST-HOTSWAP-RESET]])
})
(code1:append :next

3
game/init.fnl
View file

@ -11,7 +11,6 @@
(local tiles (prg:org 0x6100))
(local vm (VM.new prg))
(local code1 vm.code)
(link.machine:stub code1 :next)
(local mon {
:hexout :0xfdda
@ -161,7 +160,7 @@
[:vm :hires ; :mixed
:cleargfx
(vm:forever
:debug-stub :drawmap
(vm:hotswap-sync) :drawmap
)
; 0x0000 :tile>screen 0 :lookup-tile :drawtile
:quit])

2
game/tiles.json
View file

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

27
link/gsplus.fnl
View file

@ -9,14 +9,14 @@
(local debug-port 8769)
(local reg-write-format {
:ip " k%06X"
:a " a%04X"
:x " x%04X"
:y " y%04X"
:s " s%04X"
:d " d%04X"
:b " b%02X"
:psr " p%06X"
: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
@ -103,9 +103,16 @@
(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-debug-stub]
(org:append :debug-stub [:jmp post-debug-stub]))
(fn [self org post-check-jump ...]
(org:append :debug-stub [:jmp post-check-jump] :on-hotswap ...))
})
(command.add #(not machine.pid) {

2
wrap.fnl
View file

@ -22,7 +22,7 @@
"honeylisp:reload" (fn []
(local p-before (require :game))
(local p (util.reload :game))
(if (link.machine:do p-before #(p:upload $1))
(if (link.machine:hotswap p-before p)
(core.log "Reloaded!")
(core.log "Reload failed")))
})