From 750fffe0157935a768ff5cc368fed1d92e4e5595 Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Thu, 15 Oct 2020 19:02:32 -0400 Subject: [PATCH] Global labels, improved Apple II hotswap support --- asm/asm.fnl | 15 ++++++++++++--- asm/vm.fnl | 12 +++++++++++- game/init.fnl | 3 +-- game/tiles.json | 2 +- link/gsplus.fnl | 27 +++++++++++++++++---------- wrap.fnl | 2 +- 6 files changed, 43 insertions(+), 18 deletions(-) diff --git a/asm/asm.fnl b/asm/asm.fnl index 596390f..f214da6 100644 --- a/asm/asm.fnl +++ b/asm/asm.fnl @@ -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") - (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) 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] diff --git a/asm/vm.fnl b/asm/vm.fnl index cb6aa7d..993de03 100644 --- a/asm/vm.fnl +++ b/asm/vm.fnl @@ -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 @@ -287,7 +297,7 @@ (fn vm.forever [self ...] [:block :start [:vm ...] [:vm :jmp :start]]) - + (fn vm.for [self ...] [:vm :>r (vm:while [:rtop] :r> :dec :>r ...) :rdrop]) diff --git a/game/init.fnl b/game/init.fnl index c823f1f..6b62e41 100644 --- a/game/init.fnl +++ b/game/init.fnl @@ -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]) diff --git a/game/tiles.json b/game/tiles.json index fda96e4..ff8cc4c 100644 --- a/game/tiles.json +++ b/game/tiles.json @@ -1 +1 @@ -["000000020A0820404A4020080A02000000010141511005025302051051410100","00000000020A0820404A4020080A020000000101415110050253020510514101","808080C0C0C0E0C0D0C8C04040404080808083858585828A9282820A08081980","8080C0A0A0A0C0C0D0C8C0501010188080808183838782828A8A920202020380","8080E0B0B0B098C0D0D0C840404060808080878D8D8D99828A8A920202020780","8080C0E0E0E0B0C0D0C8C040404060808080838787878D828A92820202020780","007C0C0C0C0C7C007C7E7EAA88888800001F181818181F001F0F979590909000","007C2C0C0C2C7C007C7E7EAA88888800001F18191C191F001F0F979590909000","D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA","D5D5D5D5D5F5F5FDDDD5D5D5D5D5D5D5AAAAAAAAAEAEBFBFBFABAAAAAAAAAAAA","F7F7DDDDF7F7DDDDF7F7DDDDF7F7DDDDEEEEBBBBEEEEBBBBEEEEBBBBEEEEBBBB","F787A5B1B3B3B1B1B3B3B1B1B3B381DDEEE8B2A6E6E6A6A6E6E6A6A6E6E6A0BB","F78785818383818183838181838381DDEEE8B0A0E0E0A0A0E0E0A0A0E0E0A0BB","F7F7CDCDCFCF8981A3A3A5A5878FDDDDEEECA4A4E4E0A0A1E5E5A5A5E1E8BBBB","F7F7CDCDCFCF898123232525878FDDDDEEECA4A4E4E0A0216565252561E8BBBB"] \ No newline at end of file +["000000020A0820404A4020080A02000000010141511005025302051051410100","00000000020A0820404A4020080A020000000101415110050253020510514101","808080C0C0C0E0C0D0C8C04040404080808083858585828A9282820A08081980","8080C0A0A0A0C0C0D0C8C0501010188080808183838782828A8A920202020380","8080E0B0B0B098C0D0D0C840404060808080878D8D8D99828A8A920202020780","8080C0E0E0E0B0C0D0C8C040404060808080838787878D828A92820202020780","0000000000000000000000000000000000000000000000000000000000000000","007C0C0C0C0C7C007C7E7EAA88888800001F181818181F001F0F979590909000","007C2C0C0C2C7C007C7E7EAA88888800001F18191C191F001F0F979590909000","D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA","D5D5D5D5D5F5F5FDDDD5D5D5D5D5D5D5AAAAAAAAAEAEBFBFBFABAAAAAAAAAAAA","F7F7DDDDF7F7DDDDF7F7DDDDF7F7DDDDEEEEBBBBEEEEBBBBEEEEBBBBEEEEBBBB","F787A5B1B3B3B1B1B3B3B1B1B3B381DDEEE8B2A6E6E6A6A6E6E6A6A6E6E6A0BB","F78785818383818183838181838381DDEEE8B0A0E0E0A0A0E0E0A0A0E0E0A0BB","F7F7CDCDCFCF8981A3A3A5A5878FDDDDEEECA4A4E4E0A0A1E5E5A5A5E1E8BBBB","F7F7CDCDCFCF898123232525878FDDDDEEECA4A4E4E0A0216565252561E8BBBB"] diff --git a/link/gsplus.fnl b/link/gsplus.fnl index 9551361..668fb35 100644 --- a/link/gsplus.fnl +++ b/link/gsplus.fnl @@ -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) { diff --git a/wrap.fnl b/wrap.fnl index 5e15a2d..999aee0 100644 --- a/wrap.fnl +++ b/wrap.fnl @@ -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"))) })