diff --git a/ProDOS_2_4_2.dsk b/ProDOS_2_4_2.dsk index 25215fb..6530d52 100644 Binary files a/ProDOS_2_4_2.dsk and b/ProDOS_2_4_2.dsk differ diff --git a/ProDOS_Blank.dsk b/ProDOS_Blank.dsk new file mode 100644 index 0000000..25215fb Binary files /dev/null and b/ProDOS_Blank.dsk differ diff --git a/Test.dsk b/Test.dsk new file mode 100644 index 0000000..4d67b11 Binary files /dev/null and b/Test.dsk differ diff --git a/asm/prodos.fnl b/asm/prodos.fnl index 709cab6..142a95d 100644 --- a/asm/prodos.fnl +++ b/asm/prodos.fnl @@ -3,6 +3,7 @@ (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 lume (require :lib.lume)) (local prodos-mli :0xbf00) (fn Prodos.install-words [vm] @@ -233,7 +234,8 @@ (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))))) + (table.insert index (bytes-to-uint16 (.. lo hi)))) + index) (fn Prodos.set-index [self iblock index] (var block "") @@ -250,10 +252,10 @@ (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)) + (for [iblock 0 279] + (local (byte mask) (bit-in-bytes block iblock)) (when (~= (bit.band byte mask) 0) - (tset bitmap ibit true))) + (tset bitmap iblock true))) bitmap) (fn Prodos.set-bitmap [self bitmap] @@ -265,7 +267,7 @@ (self:set-block self.root.bitmap-pointer block)) (fn Prodos.find-next-free-block [self] - (next (self:parse-bitmap))) + (let [iblock (next (self:parse-bitmap))] iblock)) (fn Prodos.add-file-data [self bytes] (assert (< (length bytes) 0xffff)) @@ -300,6 +302,26 @@ "\0\0\0\0" ; last modified date (int16-to-bytes iblock-parent))) +(fn Prodos.blocks-from-entry [self entry] + (match entry.entry-type + self.storage-type.seedling [entry.key-pointer] + self.storage-type.sapling + (let [block-count (- entry.blocks-used 1) + index (self:parse-index entry.key-pointer)] + (lume.slice index 1 block-count)) + _ [])) + +(fn Prodos.validate-entry [self entry] + (local bitmap (self:parse-bitmap)) + (local blocks (self:blocks-from-entry entry)) + (each [_ iblock (ipairs blocks)] + (when (. bitmap iblock) + (print (.. iblock " is used by " entry.name " but marked free")) + (self:set-block iblock (self:block iblock))))) + +(fn Prodos.validate-entries [self] + (each [_ file (pairs self.files)] (self:validate-entry file.entry))) + (fn Prodos.generate-volume-header [self ?overrides] (local overrides (or ?overrides {})) (local name (or overrides.name self.root.name)) diff --git a/game/disk.fnl b/game/disk.fnl index 48f03bf..5013964 100644 --- a/game/disk.fnl +++ b/game/disk.fnl @@ -11,9 +11,10 @@ (prg:assemble) -(local disk (Prodos "ProDOS_2_4_2.dsk")) +(local disk (Prodos "ProDOS_Blank.dsk")) +(disk:validate-entries) (disk:add-file "STARTUP" Prodos.file-type.BAS 0x801 org.block.bytes) (disk:update-volume-header {:name "NEUT.TOWER"}) -(pp disk) +; (pp disk) (disk:write "Test.dsk")