Created a bootable disk image!!

asm/asm.fnl

@@ -91,16 +91,19 @@
 (fn make-env [block parent]
   {:parent parent
    :block block
-   :is-zp? (fn [self name] (self.parent:is-zp? name))
+   ; todo: support local self-reference if org is set to zp
+   :is-zp? (fn [self name] (if (. self.block.symbols name) false (self.parent:is-zp? name)))
    :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)))
+       (and ipdat (= (type ipdat) :number) (> ipdat (length self.block.pdats)))
        (+ self.block.addr self.block.size)
 
+       (and ipdat (= (type ipdat) :function)) (ipdat self)
+
        ipdat (. self.block.pdats ipdat :addr)
 
        ipdat-global (: (make-env (. self.block.pdats ipdat-global) block) :lookup-addr name)
@@ -151,6 +154,10 @@
   (fn dat-parser.export [label block]
     (tset block.globals (. label 2) true)
     nil)
+  (fn dat-parser.computed [label block]
+    (tset block.symbols (. label 2) (. label 3))
+    nil)
+
   (fn dat-parser.align [pad] {:type :pad :align (. pad 2)})
 
   (local pdat-processor {
@@ -182,7 +189,6 @@
     (let [misalignment (% pad.addr pad.align)]
       (if (= misalignment 0) 0
         (- pad.align misalignment))))
-
   (fn pdat-processor.op.bytes [op env]
     (local bytegen (. opcodes op.opcode))
   ;   (pp op)

asm/prodos.fnl

@@ -270,11 +270,11 @@
   (let [iblock (next (self:parse-bitmap))] iblock))
 
 (fn Prodos.add-file-data [self bytes]
-  (assert (< (length bytes) 0xffff))
+  (assert (< (length bytes) 0xffff) (.. "Tried to add files containing " (length bytes) " bytes"))
   (if (> (length bytes) 512)
       (let [index []]
         (for [offset 1 (length bytes) 512]
-          (local iblock (self:add-file-data (bytes:gsub offset (+ offset 511))))
+          (local iblock (self:add-file-data (bytes:sub offset (+ offset 511))))
           (table.insert index iblock))
         (local iblock-index (self:find-next-free-block))
         (self:set-index iblock-index index)

game/disk.fnl

@@ -1,19 +1,58 @@
 (local asm (require :asm.asm))
 (local Prodos (require :asm.prodos))
-(local {: basic} (require :asm.tape))
+(local util (require :lib.util))
+(local {: lo : hi} util)
 
-(local prg (basic (asm.new)))
-(local org (prg:org 0x801))
+(fn org-loader [org]
+  (local srclabel (.. :loader- org.addr))
+  ; this will always copy full pages, because it simplifies the code and we don't actually care if a little extra
+  ; garbage is tacked on to the end.
+  ; We copy the pages in reverse order, because this allows us to safely move from 0x2000 to higher memory, and we
+  ; never want to overlap with 0x2000 from lower memory, so either direction is safe
+  (local dstpage-first (hi org.addr))
+  (local dstpage-last (hi (+ org.addr (length org.bytes) -1)))
+  (print srclabel dstpage-first dstpage-last)
+  [:block
+    [:computed :srchi #(+ ($1:lookup-addr :ld-src) 2)]
+    [:computed :dsthi #(+ ($1:lookup-addr :st-dst) 2)]
+    [:computed :src-last #(+ ($1:lookup-addr srclabel) (* (- dstpage-last dstpage-first) 0x100))]
+    [:computed :dst-last #(+ org.addr (* (- dstpage-last dstpage-first) 0x100))]
+    [:ldx 0]
+  :ld-src [:lda :src-last :x]
+  :st-dst [:sta :dst-last :x]
+    [:inx]
+    [:bne :ld-src]
 
-(org:append [:basic
-  [10 :print "\"HELLO FROM A GENERATED DISK IMAGE!\""]
-  [20 :goto :10]])
+    [:lda :dsthi]
+    [:cmp dstpage-first]
+    [:beq :done]
+    [:dec :srchi]
+    [:dec :dsthi]
+    [:bne :ld-src]
+  :done])
 
+(fn prg-loader [org game]
+  (local blocks [])
+  (each [_ block (pairs game.org-to-block)]
+    (table.insert blocks block))
+  (table.sort blocks #(< $1.addr $2.addr))
+  (each [_ block (ipairs blocks)]
+    (org:append (org-loader block)))
+  (org:append [:jmp game.start-symbol])
+  (each [_ block (ipairs blocks)]
+    (org:append (.. :loader- block.addr) [:bytes block.bytes])))
+
+(local game (util.reload :game))
+(local prg (asm.new game))
+(local org (prg:org 0x2000))
+
+(org:append :loader-main)
+(set prg.start-symbol :loader-main)
+(prg-loader org game)
 (prg:assemble)
 
 (local disk (Prodos "ProDOS_Blank.dsk"))
-(disk:validate-entries)
-(disk:add-file "STARTUP" Prodos.file-type.BAS 0x801 org.block.bytes)
+(disk:add-file "NEUT.SYSTEM" Prodos.file-type.SYS 0x2000 org.block.bytes)
 (disk:update-volume-header {:name "NEUT.TOWER"})
 (disk:write "NeutTower.dsk")