diff --git a/NeutTower.dsk b/NeutTower.dsk new file mode 100644 index 0000000..e5f9a4d Binary files /dev/null and b/NeutTower.dsk differ diff --git a/asm/asm.fnl b/asm/asm.fnl index de6ad14..51b8760 100644 --- a/asm/asm.fnl +++ b/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) diff --git a/asm/prodos.fnl b/asm/prodos.fnl index 27b1351..a02c3d6 100644 --- a/asm/prodos.fnl +++ b/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) diff --git a/game/disk.fnl b/game/disk.fnl index 6f18b04..1b5fe58 100644 --- a/game/disk.fnl +++ b/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")