92 lines
3.1 KiB
Fennel
92 lines
3.1 KiB
Fennel
(local asm (require :asm.asm))
|
|
(local VM (require :asm.vm))
|
|
(local Prodos (require :asm.prodos))
|
|
(local util (require :lib.util))
|
|
(local {: lo : hi} util)
|
|
|
|
(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)))
|
|
[: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]
|
|
|
|
[:lda :dsthi]
|
|
[:cmp dstpage-first]
|
|
[:beq :done]
|
|
[:dec :srchi]
|
|
[:dec :dsthi]
|
|
[:bne :ld-src]
|
|
:done])
|
|
|
|
(fn create-sys-loader [disk filename game]
|
|
(local blocks [])
|
|
(local prg (asm.new game))
|
|
(local org (prg:org 0x2000))
|
|
(org:append :loader-main)
|
|
(set prg.start-symbol :loader-main)
|
|
(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]))
|
|
(prg:assemble)
|
|
(disk:add-file (.. filename ".SYSTEM") Prodos.file-type.SYS 0x2000 org.block.bytes))
|
|
|
|
(fn create-loader [disk game]
|
|
(local boot (asm.new game))
|
|
(set boot.start-symbol :boot)
|
|
(local vm (VM.new boot {:org 0xc00}))
|
|
(disk.install-words vm)
|
|
(vm:def :hires
|
|
[:sta :0xc050]
|
|
[:sta :0xc057]
|
|
[:sta :0xc052]
|
|
[:sta :0xc054])
|
|
(vm:word :loadfile ; length addr filename --
|
|
0xbb00 :open :read :drop :close)
|
|
|
|
(disk:add-file "TITLE.SCREEN" Prodos.file-type.BIN 0x2000 (: (util.readjson "game/title.screen") :fromhex))
|
|
(vm.code:append
|
|
:boot
|
|
[:jsr :reset]
|
|
[:jsr :interpret]
|
|
[:vm :hires
|
|
0x2000 0x2000 (vm:pstr "TITLE.SCREEN") :loadfile])
|
|
(local files [])
|
|
(each [_ block (pairs game.org-to-block)]
|
|
(local filename (.. "STUFF." (length files)))
|
|
(table.insert files filename)
|
|
(disk:add-file filename Prodos.file-type.BIN block.addr block.bytes)
|
|
(vm.code:append [:vm (length block.bytes) block.addr :lit (.. :filename (length files)) :loadfile]))
|
|
(vm.code:append
|
|
[:vm :native]
|
|
[:jmp game.start-symbol])
|
|
(each [i filename (ipairs files)]
|
|
(vm.code:append (.. :filename i) (disk.str filename)))
|
|
(boot:assemble)
|
|
boot)
|
|
|
|
(local disk (Prodos "ProDOS_Blank.dsk"))
|
|
(local game (util.reload :game))
|
|
(local loader (create-loader disk game))
|
|
(create-sys-loader disk :NEUT loader)
|
|
(disk:update-volume-header {:name "NEUT.TOWER"})
|
|
(disk:write "NeutTower.dsk")
|
|
|