Created a bootable disk image!!

This commit is contained in:
Jeremy Penner 2021-01-10 14:52:05 -05:00
parent 3d69a3a1f9
commit dc4bd72d16
4 changed files with 58 additions and 13 deletions

BIN
NeutTower.dsk Normal file

Binary file not shown.

View file

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

View file

@ -270,11 +270,11 @@
(let [iblock (next (self:parse-bitmap))] iblock)) (let [iblock (next (self:parse-bitmap))] iblock))
(fn Prodos.add-file-data [self bytes] (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) (if (> (length bytes) 512)
(let [index []] (let [index []]
(for [offset 1 (length bytes) 512] (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)) (table.insert index iblock))
(local iblock-index (self:find-next-free-block)) (local iblock-index (self:find-next-free-block))
(self:set-index iblock-index index) (self:set-index iblock-index index)

View file

@ -1,19 +1,58 @@
(local asm (require :asm.asm)) (local asm (require :asm.asm))
(local Prodos (require :asm.prodos)) (local Prodos (require :asm.prodos))
(local {: basic} (require :asm.tape)) (local util (require :lib.util))
(local {: lo : hi} util)
(local prg (basic (asm.new))) (fn org-loader [org]
(local org (prg:org 0x801)) (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 [:lda :dsthi]
[10 :print "\"HELLO FROM A GENERATED DISK IMAGE!\""] [:cmp dstpage-first]
[20 :goto :10]]) [: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) (prg:assemble)
(local disk (Prodos "ProDOS_Blank.dsk")) (local disk (Prodos "ProDOS_Blank.dsk"))
(disk:validate-entries) (disk:add-file "NEUT.SYSTEM" Prodos.file-type.SYS 0x2000 org.block.bytes)
(disk:add-file "STARTUP" Prodos.file-type.BAS 0x801 org.block.bytes)
(disk:update-volume-header {:name "NEUT.TOWER"}) (disk:update-volume-header {:name "NEUT.TOWER"})
(disk:write "NeutTower.dsk") (disk:write "NeutTower.dsk")