Global labels, improved Apple II hotswap support

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]

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

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

game/tiles.json

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

link/gsplus.fnl

@@ -9,14 +9,14 @@
 
 (local debug-port 8769)
 (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]
   (-> 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]
+ (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) {

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")))
 })