Global labels, improved Apple II hotswap support

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

View file

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

View file

@ -1,5 +1,6 @@
(local lume (require "lib.lume")) (local lume (require "lib.lume"))
(local {: lo : hi} (require "lib.util")) (local {: lo : hi} (require "lib.util"))
(local link (require :link))
(fn inc16-stk [l h] (fn inc16-stk [l h]
[:block [:block
@ -91,6 +92,15 @@
:asm :asm
(fn [self ...] (fn [self ...]
[:block [:vm :native] [:block ...] [:jsr :interpret]]) [: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 (code1:append :next
@ -287,7 +297,7 @@
(fn vm.forever [self ...] (fn vm.forever [self ...]
[:block :start [:vm ...] [:vm :jmp :start]]) [: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])

View file

@ -11,7 +11,6 @@
(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
@ -161,7 +160,7 @@
[:vm :hires ; :mixed [:vm :hires ; :mixed
:cleargfx :cleargfx
(vm:forever (vm:forever
:debug-stub :drawmap (vm:hotswap-sync) :drawmap
) )
; 0x0000 :tile>screen 0 :lookup-tile :drawtile ; 0x0000 :tile>screen 0 :lookup-tile :drawtile
:quit]) :quit])

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"]

View file

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

View file

@ -22,7 +22,7 @@
"honeylisp:reload" (fn [] "honeylisp:reload" (fn []
(local p-before (require :game)) (local p-before (require :game))
(local p (util.reload :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 "Reloaded!")
(core.log "Reload failed"))) (core.log "Reload failed")))
}) })