diff --git a/ProDOS_2_4_2.dsk b/ProDOS_2_4_2.dsk new file mode 100644 index 0000000..25215fb Binary files /dev/null and b/ProDOS_2_4_2.dsk differ diff --git a/asm/asm.fnl b/asm/asm.fnl index 93216cf..39949d3 100644 --- a/asm/asm.fnl +++ b/asm/asm.fnl @@ -7,10 +7,10 @@ (let [ops {:php 0x08 :plp 0x28 :pha 0x48 :pla 0x68 :dey 0x88 :tay 0xa8 :iny 0xc8 :inx 0xe8 :clc 0x18 :sec 0x38 :cli 0x58 :sei 0x78 :tya 0x98 :clv 0xb8 :cld 0xd8 :sed 0xf8 - :txa 0x8a :txs 0x9a :tax 0xaa :tsx 0xba :dex 0xca :nop 0xea :brk 0x00 :rti 0x40 - :rts 0x60}] + :txa 0x8a :txs 0x9a :tax 0xaa :tsx 0xba :dex 0xca :nop 0xea :rti 0x40 :rts 0x60}] (each [opcode byte (pairs ops)] (tset opcodes opcode (fn [mode] (if mode nil byte))))) +(set opcodes.brk (fn [mode] (if (or (= mode :imm) (= mode nil)) 0x00 nil))) ; branch ops (let [ops {:bpl 0x10 :bmi 0x30 :bvc 0x50 :bvs 0x70 :bcc 0x90 :bcs 0xb0 :bne 0xd0 :beq 0xf0}] diff --git a/asm/prodos.fnl b/asm/prodos.fnl new file mode 100644 index 0000000..709cab6 --- /dev/null +++ b/asm/prodos.fnl @@ -0,0 +1,336 @@ +(local Object (require :core.object)) +(local Prodos (Object:extend)) +(local {: bytes-to-uint8 : bytes-to-uint16 : bytes-to-uint24 + : int8-to-bytes : int16-to-bytes : int24-to-bytes + : splice : lo : hi} (require :lib.util)) + +(local prodos-mli :0xbf00) +(fn Prodos.install-words [vm] + (fn prodos-call [cmd param-addr crash-on-fail] + [:block + [:jsr prodos-mli] + [:db cmd] + [:ref param-addr] + (when crash-on-fail + [:block + [:beq :success] + [:brk 0] + :success])]) + (vm.code:append :currently-open-file [:db 0]) + (vm:def :open ; filename buffer -- + [:block + [:lda vm.ST1 :x] [:sta :open-param-filename] + [:lda vm.ST1H :x] [:sta :open-param-filename-hi] + [:lda vm.TOP :x] [:sta :open-param-buffer] + [:lda vm.TOPH :x] [:sta :open-param-buffer-hi] + (prodos-call 0xc8 :open-params true) + [:lda :open-param-refnum] + [:sta :currently-open-file] + (vm:drop) (vm:drop)]) + (vm.code:append + :open-params [:db 3] + :open-param-filename [:db 0] + :open-param-filename-hi [:db 0] + :open-param-buffer [:db 0] + :open-param-buffer-hi [:db 0] + :open-param-refnum [:db 0]) + + (vm:def + [:block + :flush [:export :flush] ; -- + [:lda 0xcd] + [:bne :prodos-flush-close] + :close [:export :close] ; -- + [:lda 0xcc] + :prodos-flush-close + [:sta :fc-cmd] + [:lda :currently-open-file] + [:sta :fc-param-refnum] + [:jsr prodos-mli] + :fc-cmd [:db 0] [:ref :fc-params] + [:beq :success] + [:brk 0] + :success]) + (vm.code:append + :fc-params [:db 1] + :fc-param-refnum [:db 0]) + + (vm:def + [:block + :write [:export :write] ; count buffer -- count + [:lda 0xcb] + [:bne :prodos-read-write] + :read [:export :read] ; count buffer -- count + [:lda 0xca] + :prodos-read-write + [:sta :rw-cmd] + [:lda :currently-open-file] + [:sta :rw-param-refnum] + [:lda vm.TOP :x] [:sta :rw-param-buffer] + [:lda vm.TOPH :x] [:sta :rw-param-buffer-hi] + [:lda vm.ST1 :x] [:sta :rw-param-count] + [:lda vm.ST1H :x] [:sta :rw-param-count-hi] + [:jsr prodos-mli] + :rw-cmd [:db 0] [:ref :rw-params] + [:beq :success] + [:cmp 0x4c] + [:beq :success] + [:brk 0] + :success + [:lda :rw-param-count-out] [:sta vm.ST1 :x] + [:lda :rw-param-count-out-hi] [:sta vm.ST1H :x] + (vm:drop)]) + (vm.code:append + :rw-params [:db 4] + :rw-param-refnum [:db 0] + :rw-param-buffer [:db 0] + :rw-param-buffer-hi [:db 0] + :rw-param-count [:db 0] + :rw-param-count-hi [:db 0] + :rw-param-count-out [:db 0] + :rw-param-count-out-hi [:db 0]) + + ; this does not handle files bigger than 64kb; I don't want or need to implement 24-bit numbers + (vm:def :seek ; position -- + [:lda :currently-open-file] + [:sta :seek-param-refnum] + [:lda vm.TOP :x] [:sta :seek-param-position] + [:lda vm.TOPH :x] [:sta :seek-param-position-hi] + (prodos-call 0xce :seek-params true) + (vm:drop)) + (vm.code:append + :seek-params [:db 2] + :seek-param-refnum [:db 0] + :seek-param-position [:db 0] + :seek-param-position-hi [:dw 0])) + +(fn Prodos.new [self filename] + (local f (io.open filename :r)) + (set self.bytes (f:read "*a")) + (f:close) + (assert (= (length self.bytes) 143360)) + (self:parse-structure)) + +(fn Prodos.write [self filename] + (local f (io.open filename :w)) + (f:write self.bytes) + (f:close)) + +(fn Prodos.sector-offset [self itrack isector] + (+ (* itrack 0x1000) (* isector 0x100))) +(fn Prodos.sector [self itrack isector] + (local offset (self:sector-offset itrack isector)) + (self.bytes:sub (+ offset 1) (+ offset 0x100))) + +(fn Prodos.set-sector [self itrack isector bytes] + (assert (<= (length bytes) 256)) + (set self.bytes (splice self.bytes (+ (* itrack 0x1000) (* isector 0x100)) bytes))) + +(local prodos-to-dos [0 14 13 12 11 10 9 8 7 6 5 4 3 2 1 15]) +(fn Prodos.block-sectors [self index] + (local track (math.floor (/ index 8))) + (local iprodos (* (% index 8) 2)) + (local isector1 (. prodos-to-dos (+ 1 iprodos))) + (local isector2 (. prodos-to-dos (+ 2 iprodos))) + (values track isector1 isector2)) + +(fn Prodos.block [self index] + (local (track isector1 isector2) (self:block-sectors index)) + (.. (self:sector track isector1) (self:sector track isector2))) + +(fn Prodos.set-block [self index bytes] + (local (track isector1 isector2) (self:block-sectors index)) + (self:set-sector track isector1 (bytes:sub 1 256)) + (self:set-sector track isector2 (bytes:sub 257 512)) + (local bitmap (self:parse-bitmap)) + (when (. bitmap index) + (tset bitmap index nil) + (self:set-bitmap bitmap))) + +(fn Prodos.parse-entry [self bytes] + (local type_namelen (bytes-to-uint8 bytes 0)) + (local entry-type (bit.rshift (bit.band type_namelen 0xf0) 4)) + (local namelen (bit.band type_namelen 0x0f)) + (local name (bytes:sub 2 (+ 1 namelen))) + (if (= entry-type 0x0f) + {: entry-type : name + :version (bytes-to-uint8 bytes 0x1c) + :min-version (bytes-to-uint8 bytes 0x1d) + :access (bytes-to-uint8 bytes 0x1e) + :entry-length (bytes-to-uint8 bytes 0x1f) + :entries-per-block (bytes-to-uint8 bytes 0x20) + :file-count (bytes-to-uint16 bytes 0x21) + :bitmap-pointer (bytes-to-uint16 bytes 0x23) + :total-blocks (bytes-to-uint16 bytes 0x25)} + {: entry-type : name + :file-type (bytes-to-uint8 bytes 0x10) + :key-pointer (bytes-to-uint16 bytes 0x11) + :blocks-used (bytes-to-uint16 bytes 0x13) + :eof (bytes-to-uint24 bytes 0x15) + :version (bytes-to-uint8 bytes 0x1c) + :min-version (bytes-to-uint8 bytes 0x1d) + :access (bytes-to-uint8 bytes 0x1e) + :aux-type (bytes-to-uint16 bytes 0x1f) + :header-pointer (bytes-to-uint16 bytes 0x25)})) + +(fn Prodos.parse-directory [self iblock] + (local bytes (self:block iblock)) + (local prev-block (bytes-to-uint16 bytes 0x00)) + (local next-block (bytes-to-uint16 bytes 0x02)) + (local entries []) + (for [offset 0x04 0x1ff 0x27] + (when (>= (length bytes) (+ offset 0x27)) + (local entry (self:parse-entry (bytes:sub (+ offset 1) (+ offset 0x27)))) + (set entry.entry-offset offset) + (table.insert entries entry))) + {: prev-block : next-block : entries}) + +(set Prodos.storage-type { + :deleted 0 + :seedling 1 + :sapling 2 + :tree 3 + :dir 13 + :subdir-header 14 + :volume-header 15 +}) + +(set Prodos.file-type { + :none 0x00 + :BAD 0x01 + :TXT 0x04 + :BIN 0x06 + :DIR 0x0F + :ADB 0x19 + :AWP 0x1a + :ASP 0x1b + :PAS 0xef + :CMD 0xf0 + :BAS 0xfc + :VAR 0xfd + :REL 0xfe + :SYS 0xff +}) + +(fn Prodos.parse-structure [self] + (set self.files {}) + (set self.next-free nil) + (set self.root nil) + (var iblock 2) + (while (~= iblock 0) + (local dir (self:parse-directory iblock)) + (each [ientry entry (ipairs dir.entries)] + (match entry.entry-type + self.storage-type.volume-header (set self.root entry) + self.storage-type.deleted (set self.next-free {: entry : iblock : ientry}) + _ (tset self.files entry.name {: entry : iblock : ientry}))) + (set iblock dir.next-block)) + self) + +(fn Prodos.parse-index [self iblock] + (local block (self:block iblock)) + (local index []) + (for [i 1 256] + (local lo (block:sub i i)) + (local hi (block:sub (+ i 256) (+ i 256))) + (table.insert index (bytes-to-uint16 (.. lo hi))))) + +(fn Prodos.set-index [self iblock index] + (var block "") + (for [i 1 256] (set block (.. block (string.char (lo (or (. index i) 0)))))) + (for [i 1 256] (set block (.. block (string.char (hi (or (. index i) 0)))))) + (self:set-block iblock block)) + +(fn bit-in-bytes [bytes ibit] + (local ibyte (math.floor (/ ibit 8))) + (local byte (string.byte (bytes:sub (+ ibyte 1) (+ ibyte 1)))) + (local mask (bit.lshift 1 (% ibit 8))) + (values byte mask ibyte)) + +(fn Prodos.parse-bitmap [self] + (local block (self:block self.root.bitmap-pointer)) + (local bitmap {}) + (for [ibit 0 280] + (local (byte mask) (bit-in-bytes block ibit)) + (when (~= (bit.band byte mask) 0) + (tset bitmap ibit true))) + bitmap) + +(fn Prodos.set-bitmap [self bitmap] + (var block (string.rep "\0" 512)) + (each [ibit f (pairs bitmap)] + (when (= f true) + (local (byte mask ibyte) (bit-in-bytes block ibit)) + (set block (splice block ibyte (string.char (bit.bor byte mask)))))) + (self:set-block self.root.bitmap-pointer block)) + +(fn Prodos.find-next-free-block [self] + (next (self:parse-bitmap))) + +(fn Prodos.add-file-data [self bytes] + (assert (< (length bytes) 0xffff)) + (if (> (length bytes) 512) + (let [index []] + (for [offset 1 (length bytes) 512] + (local iblock (self:add-file-data (bytes:gsub offset (+ offset 511)))) + (table.insert index iblock)) + (local iblock-index (self:find-next-free-block)) + (self:set-index iblock-index index) + (values iblock-index self.storage-type.sapling (+ (length index) 1))) + + (let [iblock-index (self:find-next-free-block)] + (self:set-block iblock-index bytes) + (values iblock-index self.storage-type.seedling 1)))) + +(fn Prodos.generate-file-entry [self iblock-parent filename type aux bytes] + (local (iblock storage-type block-count) (self:add-file-data bytes)) + (.. + (int8-to-bytes (bit.bor (bit.lshift storage-type 4) (length filename))) + filename + (string.rep "\0" (- 15 (length filename))) + (int8-to-bytes type) + (int16-to-bytes iblock) + (int16-to-bytes block-count) + (int24-to-bytes (length bytes)) + "\0\0\0\0" ; created date + (int8-to-bytes 36) ; version + (int8-to-bytes 0) ; min-version + (int8-to-bytes 0x01) ; access (read-only, locked) + (int16-to-bytes aux) ; aux-type - generally load address + "\0\0\0\0" ; last modified date + (int16-to-bytes iblock-parent))) + +(fn Prodos.generate-volume-header [self ?overrides] + (local overrides (or ?overrides {})) + (local name (or overrides.name self.root.name)) + (.. + (int8-to-bytes (bit.bor (bit.lshift self.storage-type.volume-header 4) (length name))) + name + (string.rep "\0" (- 15 (length name))) + "\0\0\0\0\0\0\0\0" ; reserved + "\0\0\0\0" ; created date + (int8-to-bytes 36) ; version + (int8-to-bytes 0) ; min-version + (int8-to-bytes 0x01) ; access (read-only, locked) + (int8-to-bytes 0x27) + (int8-to-bytes 0x0d) + (int16-to-bytes (or overrides.file-count self.root.file-count)) + (int16-to-bytes (or overrides.bitmap-pointer self.root.bitmap-pointer)) + (int16-to-bytes 280))) + +(fn Prodos.update-volume-header [self ?overrides] + (local block (-> (self:block 2) (splice 4 (self:generate-volume-header ?overrides)))) + (self:set-block 2 block) + (self:parse-structure)) + +(fn Prodos.add-file [self filename type aux bytes] + (assert self.next-free) + (local iblock self.next-free.iblock) + (var block (self:block iblock)) + (local file-entry (self:generate-file-entry iblock filename type aux bytes)) + (print (length file-entry) file-entry) + (set block (splice block self.next-free.entry.entry-offset file-entry)) + (self:set-block iblock block) + (self:update-volume-header {:file-count (+ self.root.file-count 1)})) + +Prodos diff --git a/editor/tileedit.fnl b/editor/tileedit.fnl index 4db9a6a..06596a4 100644 --- a/editor/tileedit.fnl +++ b/editor/tileedit.fnl @@ -33,10 +33,7 @@ (bit.bor (if is-set orval 0)))) (fn set-tile-bit [tile ibyte ibit is-set] - (.. - (tile:sub 1 ibyte) - (string.char (set-bit tile ibyte ibit is-set)) - (tile:sub (+ ibyte 2)))) + (util.splice tile ibyte (string.char (set-bit tile ibyte ibit is-set)))) (fn draw-bit-color [bit x y] (local (bgcolor color) (tiledraw.pal-from-bit bit)) diff --git a/game/bosskey.fnl b/game/bosskey.fnl index 7888076..bad5bfa 100644 --- a/game/bosskey.fnl +++ b/game/bosskey.fnl @@ -47,17 +47,12 @@ (cells 16 ["TOTAL" style.inverse] "TOO MANY" ["* MAGIC *" style.flashing] "ALL@ONCE") (cells 17) (cells 18) (cells 19) (cells 20)]) -(fn splice [bytes offset str] - (.. (bytes:sub 1 offset) - str - (bytes:sub (+ (length str) offset 1)))) - (fn bytes-from-lines [lines] (var bytes (string.rep (astr " ") 0x400)) (each [y line (ipairs lines)] (local offset (+ (* (math.floor (/ (- y 1) 8)) 0x28) (* (% (- y 1) 8) 0x80))) - (set bytes (splice bytes offset line))) + (set bytes (util.splice bytes offset line))) bytes) (textorg:append [:bytes (bytes-from-lines (generate-boss-screen-lines))]) diff --git a/game/disk.fnl b/game/disk.fnl new file mode 100644 index 0000000..48f03bf --- /dev/null +++ b/game/disk.fnl @@ -0,0 +1,19 @@ +(local asm (require :asm.asm)) +(local Prodos (require :asm.prodos)) +(local {: basic} (require :asm.tape)) + +(local prg (basic (asm.new))) +(local org (prg:org 0x801)) + +(org:append [:basic + [10 :print "\"HELLO FROM A GENERATED DISK IMAGE!\""] + [20 :goto :10]]) + +(prg:assemble) + +(local disk (Prodos "ProDOS_2_4_2.dsk")) +(disk:add-file "STARTUP" Prodos.file-type.BAS 0x801 org.block.bytes) +(disk:update-volume-header {:name "NEUT.TOWER"}) +(pp disk) +(disk:write "Test.dsk") + diff --git a/lib/util.fnl b/lib/util.fnl index e8ef93b..dc071ad 100644 --- a/lib/util.fnl +++ b/lib/util.fnl @@ -13,6 +13,21 @@ (string.char (lo i))) (fn int16-to-bytes [i] (string.char (lo i) (hi i))) +(fn int24-to-bytes [i] + (string.char (lo i) (hi i) (bit.band (bit.rshift i 16) 0xff))) +(fn bytes-to-uint8 [b ?offset] + (string.byte b (+ 1 (or ?offset 0)) (+ 1 (or ?offset 0)))) +(fn bytes-to-uint16 [b ?offset] + (local (lo hi) (string.byte b (+ 1 (or ?offset 0)) (+ 2 (or ?offset 0)))) + (bit.bor lo (bit.lshift hi 8))) +(fn bytes-to-uint24 [b ?offset] + (local (lo mid hi) (string.byte b (+ 1 (or ?offset 0)) (+ 3 (or ?offset 0)))) + (bit.bor lo (bit.lshift mid 8) (bit.lshift hi 16))) + +(fn splice [bytes offset str] + (.. (bytes:sub 1 offset) + str + (bytes:sub (+ (length str) offset 1)))) (fn reload [modname] (tset package.loaded modname nil) @@ -61,5 +76,8 @@ (fn in-coro [f ...] (-> (coroutine.create f) (coroutine.resume ...))) -{: lo : hi : int8-to-bytes : int16-to-bytes : reload : hotswap : swappable :require swappable-require : readjson : writejson : waitfor : in-coro} +{: int8-to-bytes : int16-to-bytes : int24-to-bytes : bytes-to-uint8 : bytes-to-uint16 : bytes-to-uint24 + : splice : lo : hi + : reload : hotswap : swappable :require swappable-require + : readjson : writejson : waitfor : in-coro} diff --git a/link/serial.fnl b/link/serial.fnl index 0f86608..c06a7c7 100644 --- a/link/serial.fnl +++ b/link/serial.fnl @@ -41,7 +41,7 @@ (set bytes-to-write (bytes-to-write:sub 11)) (set addrout (+ addrout 10)))) :monitor (fn [self] (self:cmd "CALL-151")) - :stub (fn [self org post-debug-stub]) ; todo +; :stub (fn [self org post-debug-stub]) ; todo }) (command.add #(not (machine:connected?)) { diff --git a/todo.txt b/todo.txt index 3a8ddc2..20bae15 100644 --- a/todo.txt +++ b/todo.txt @@ -1,3 +1,40 @@ +FLOPPY DISK IDEAS: +* I am not going to write my own DOS +* I will use ProDOS - BOOTI-compatible, modern +* ProDOS 2.4.2 - https://prodos8.com/ +* Generate file(s) to be injected into a blank bootable ProDOS disk image + +thinking: +neut.tower contains all code / data +loader.system contains a small program that maps offsets of 512-byte blocks to memory addresses +- is loaded to 0x2000 & will be wiped by gfx? No, PRODOS is loaded at $2000 and moved +- no, XXX.SYSTEM is loaded to 0x2000 as well +- Alternately, we could write one program that batch-loads the whole game into $2000 and moves it to where it belongs? +- How big is the game with all levels? Could we load the whole thing into consecutive memory starting at $4000? + - (I don't think this would work on 32kb tape-loaded machines...) +- With ProDOS I can assume 64kb +prodos claims: +$bf00-$ffff - ProDOS +$9600-$bf00 - BASIC.SYSTEM - don't care? +$0100-$0800 - "other use or reserved" +$3A-$3F - used by disk routines, unsafe +$40-$4F - used by ProDOS but preserved, safe to use + +system bitmap: marks pages of memory as "not valid to allocate a file buffer" +- loader will have to protect memory that it will be moving game code to? + +https://prodos8.com/docs/techref/calls-to-the-mli/ +the existence of SET_BUF should mean we can load directly to the memory +we care about? orr I guess 512 bytes is housekeeping stuff (index block) + +16kb version - $0000-$4000 - no we need at least 32kb +there's basically only 5kb of code space for an hgr game? +$0000-$03ff 0kb-1kb - zp, stack, input buffer, DOS +$0400-$07ff 1kb-2kb - text page 1 +$0800-$0bff 2kb-3kb - text page 2 +$0c00-$1fff 3kb-8kb - free space +$2000-$4000 8kb-16kb - hgr gfx page 1 + Game: * level loading * Title screen