Global labels, improved Apple II hotswap support
This commit is contained in:
parent
9a27af1b52
commit
750fffe015
15
asm/asm.fnl
15
asm/asm.fnl
|
@ -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]
|
||||||
|
|
12
asm/vm.fnl
12
asm/vm.fnl
|
@ -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])
|
||||||
|
|
||||||
|
|
|
@ -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])
|
||||||
|
|
|
@ -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"]
|
||||||
|
|
|
@ -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) {
|
||||||
|
|
2
wrap.fnl
2
wrap.fnl
|
@ -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")))
|
||||||
})
|
})
|
||||||
|
|
Loading…
Reference in a new issue