The disk boots!

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))

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")