fat.fs (9407B) - raw
1 \ FAT filesystem implementation 2 3 \ Because FAT is a bootable filesystem, this unit rests on the "fatlo" part, 4 \ which has been loaded at boot time (or simply prior to this unit, if the boot 5 \ filesystem wasn't FAT). 6 7 \ because it uses words from "fatlo" that aren't always prefixed with "fat", 8 \ it's better to have this until loaded early in init.fs to avoid name clashes. 9 10 \ For now, this FS only supports FAT16 and FAT12. 11 12 \ Like any filesystem in Dusk, path separator char is "/". 13 14 \ A "direntry" is the address of a DirEntry structure in memory. These 15 \ references are short-lived because they're an address in the FAT sector buffer 16 \ which is very very often being overwritten. 17 18 \ File and directory IDs in FAT are the offset, on disk, of their corresponding 19 \ DirEntry. 20 21 ?f<< /lib/drivelo.fs 22 ?f<< /fs/fatlo.fs 23 ?f<< /lib/fmt.fs 24 ?f<< /lib/str.fs 25 ?f<< /lib/endian.fs 26 27 extends FSInfo struct[ FATInfo 28 DirEntry NAMESZ 2 + const BUFSZ \ 1 for the '.' and 1 for len 29 create _buf BUFSZ allot 30 SPC c, \ always have a SPC suffix 31 create _struct _buf ( name ) , 0 ( size ) , 0 ( dir? ) , 32 create _rootname 6 c, ," (root)" 33 create _root _rootname , 0 , 1 , 34 : spcidx ( name -- idx ) SPC swap BUFSZ cidx not if BUFSZ then ; 35 : :read ( id fat -- info ) 36 over not if 2drop _root exit then 37 _buf BUFSZ SPC fill 38 FAT :getdirentry dup _buf 1+ DirEntry EXTIDX move ( dirent ) 39 _buf 1+ spcidx ( dirent namelen ) 40 over DirEntry EXTIDX + c@ SPC <> if ( dirent namelen ) 41 over DirEntry EXTIDX + swap _buf + 1+ '.' swap c!+ ( dir src dst ) 42 DirEntry EXTSZ move else drop then ( dirent ) 43 _buf 1+ spcidx ( dirent len ) _buf c! ( dirent ) 44 dup DirEntry filesize to _struct FSInfo size 45 ( dirent ) DirEntry attr $10 ( ATTR_DIRECTORY ) and bool 46 to _struct FSInfo dir? 47 _struct ; 48 ]struct 49 50 \ structure for passing arguments to newFAT 51 \ all these field must be set before calling newFAT 52 struct[ FatOpts 53 sfield secperclus 54 sfield rsvdsec 55 sfield rootentsec 56 sfield secpertrk 57 sfield numheads 58 sfield drvnum 59 ]struct 60 61 here# FatOpts SZ allot0 structbind FatOpts fatopts 62 63 : fatopts$ 64 16 to fatopts rootentsec 65 1 to fatopts rsvdsec 66 1 to fatopts secperclus 67 \ By default, we generate a FAT for a hard disk. 68 $3f to fatopts secpertrk 69 $10 to fatopts numheads 70 $80 to fatopts drvnum ; 71 72 struct+[ FAT 73 $e5 const DIRFREE 74 75 : dflush ( self -- ) dup :dirwin :dirty! :dirwin :flush ; 76 : FAT12! ( entry cluster self -- ) >r 77 dup dup >> + swap 1 and if ( e off ) 78 tuck r@ :fatwin :seek cl# dup c@ ( off e a n ) 79 $f and rot 4 lshift or dup rot c! ( off e ) r@ :fatwin :dirty! 80 8 rshift swap 1+ r@ :fatwin :seek cl# c! 81 else ( e off ) 82 2dup r@ :fatwin :seek cl# c! ( e off ) r@ :fatwin :dirty! 83 1+ r@ :fatwin :seek cl# tuck c@ ( a e n ) 84 $f0 and swap 8 rshift $f and or ( a e ) swap c! then r> :fatwin :dirty! ; 85 : FAT16! ( entry cluster self -- ) r! :FAT16' w! r> :fatwin :dirty! ; 86 : FAT! ( entry cluster self -- ) dup :FAT12? if FAT12! else FAT16! then ; 87 88 : zerocluster ( cluster self -- ) 89 r! :clustersec V1 secpercluster V1 :dirwin :move \ V1=self 90 0 V1 :dirwin :seek 0 fill V1 secpercluster for 91 V1 :dirwin sec i + V1 :dirwin :buf( V1 :drv :sec! next rdrop ; 92 93 \ find a free cluster in the FAT 94 : findfreecluster ( self -- cluster ) 95 1 begin ( self cl ) 1+ 2dup swap :FAT@ not until ( self cl ) nip ; 96 97 \ Find a free cluster, and mark it as EOC. 98 : allocatecluster ( self -- cluster ) 99 dup findfreecluster ( self cl ) tuck EOC swap rot FAT! ( cl ) ; 100 101 \ Allocate a free cluster and fill its contents with zeroes 102 : allocatecluster0 ( self -- cluster ) 103 dup allocatecluster tuck swap zerocluster ; 104 105 \ Get next FAT entry and if it's EOC, allocate a new one 106 : FAT@+ ( cluster self -- entry ) >r 107 dup r@ :FAT@ ( cl ncl ) dup r@ :EOC? if 108 drop r@ allocatecluster ( cl ncl ) tuck swap r@ FAT! ( cl ncl ) 109 else nip then rdrop ; 110 111 \ find free dir entry in current buffer 112 : findfreedirentry ( self -- direntry ) 113 dup :iterdirentry i c@ bi DIRFREE = | not or if i break then next 114 ( self ) dup :nextcluster? if findfreedirentry else ( self ) 115 \ nothing found, we have to extend the chain 116 r! allocatecluster0 ( newcl ) r@ bufcluster r@ FAT! ( newcl ) 117 r@ :fatwin :flush 118 r@ :nextcluster? cl# r> :dirwin :buf( then 119 else ( self a ) nip then ; 120 121 : _newentry ( dirid name self -- direntry ) >r 122 fnbuf! ( dirid ) r@ :getdirentry r@ :readdir ( ) 123 r> findfreedirentry dup DirEntry SZ 0 fill ( direntry ) 124 fnbuf( over DirEntry NAMESZ move ( direntry ) ; 125 126 :realias newfile ( dirid name self -- id ) >r 127 r@ _newentry ( dirent ) r@ dflush r> :getid ; 128 129 : _makedir ( dirent -- dirent ) $10 over to DirEntry attr ; 130 131 :realias newdir ( dirid name self -- id ) 132 r! allocatecluster0 >r ( dirid name ) \ V1=self V2=cluster 133 V1 :fatwin :flush V1 _newentry ( dirent ) _makedir ( dirent ) 134 V2 over to DirEntry cluster V1 dflush ( dirent ) 135 V1 :getid ( id ) V1 bufcluster >r \ V3=parentcl 136 \ Cluster allocated, now let's initialize it with "." and ".." 137 V2 V1 :clustersec 1 V1 :readsector 138 V1 :dirwin :buf( dup DirEntry NAMESZ SPC fill '.' over c! _makedir ( id buf ) 139 V2 over to DirEntry cluster ( id buf ) DirEntry SZ + 140 dup DirEntry NAMESZ SPC fill '.' over c!+ '.' swap c! ( id buf ) 141 _makedir ( id buf ) V3 swap to DirEntry cluster 142 2rdrop r> dflush ( id ) ; 143 144 :realias info ( id self -- info ) FATInfo :read ; 145 146 \ TODO: deallocate the chain before clearing the entry 147 :realias remove ( id self -- ) 148 tuck :getdirentry ( dirent ) DIRFREE swap c! dflush ; 149 150 \ Read next sector if a sequential read is available, else return false. 151 : :nextsector? ( self -- f ) 152 dup :dirwin :next if 2drop 1 else :nextcluster? then ; 153 154 \ This approach to iteration is inefficient, but simple. I keep it as-is for now 155 : _next ( entry self -- entry-or-0 ) >r \ V1=self 156 DirEntry SZ + dup V1 :dirwin :)buf = if 157 drop V1 :nextsector? if V1 :dirwin :buf( else rootdirentry( then then ( entry ) 158 dup DirEntry :lastentry? if drop 0 else 159 dup DirEntry :iterable? not if V1 _next then then ( entry ) rdrop ; 160 161 :realias iter ( dirid previd self -- id-or-0 ) >r >r \ V1=self V2=previd 162 V1 :getdirentry V1 :readdir V1 :dirwin :buf( DirEntry SZ - V2 if begin ( entry ) 163 V1 _next dup while dup V1 :getid V2 <> while repeat then then ( entry-or-0 ) 164 dup if V1 _next dup if V1 :getid then then 2rdrop ; 165 166 : :patchlo ( fs -- ) 1 swap to flags ; 167 : :mountvolume ( drv -- fs ) FAT :mountvolume dup :patchlo ; 168 169 create _FATTemplate 170 ( jmp ) $eb c, $3c c, $90 c, ( OEMName ) ," DuskFAT " ( BytsPerSec ) 0 c, 0 c, 171 ( SecPerClus ) 0 c, ( RsvdSecCnt ) 0 c, 0 c, ( NumFAT ) 1 c, 172 ( RootEntCnt ) 0 c, 2 c, ( TotSec16 ) 0 c, 0 c, ( Media ) $f0 c, 173 ( FATsz16 ) 0 c, 0 c, ( SecPerTrk ) $3f c, 0 c, ( NumHeads ) $0f c, 0 c, 174 ( HiddenSec ) 0 , ( TotSec32 ) 0 , ( DrvNum ) $80 c, ( Reserved1 ) 0 c, 175 ( BootSig ) $29 c, ( VolID ) 0 , ( VolLabel ) ," NONAME " 176 ( FilSysType ) ," FAT " 177 178 : newFAT ( drv -- ) 179 dup Drive secsz here# over 0 fill ( drv secsz ) 180 _FATTemplate here $3e move 181 here $0b + 16b le! ( drv ) 182 fatopts secpertrk here $18 + w! 183 fatopts numheads here $1a + w! 184 fatopts drvnum here $24 + c! 185 fatopts secperclus here $0d + c! 186 fatopts rsvdsec here $0e + w! 187 fatopts rootentsec DirEntry SZ * here $11 + 16b le! 188 dup Drive seccnt dup here over $ffff > if 189 $20 + ! else $13 + 16b le! then ( drv totsec ) 190 fatopts rsvdsec - fatopts rootentsec - fatopts secperclus / ( drv clusters ) 191 dup $ffff > if abort" FAT32 not supported" then 192 dup 4085 < r! if 341 else 256 then / 1+ ( drv fatseccnt ) \ V1=fat12? 193 r! here $16 + w! ( drv ) \ V2=fatseccnt 194 $aa55 here $1fe + w! 195 dup 0 here rot Drive :sec! ( drv ) 196 \ header done. Now, zero-out all FAT and root dir entries 197 here over Drive secsz 0 fill ( drv ) 198 fatopts rsvdsec 1+ ( drv sec ) 199 fatopts rootentsec r> ( fatseccnt ) + 1- for ( drv sec ) 200 2dup here rot Drive :sec! next ( drv sec ) drop 201 \ finally, initialize the first FAT sector 202 r> ( fat12? ) if $fffff0 else $fffffff0 then here ! 203 ( drv ) fatopts rsvdsec here rot Drive :sec! ; 204 ]struct 205 206 struct+[ FATFile 207 \ Warning: we *can't* use :realias below because we might be sourcing this 208 \ very file while being on fatlo, which means :flush will be called before 209 \ we're finished compiling it! Debugging this was mind-bending... 210 : _flush ( hdl -- ) :secwin :flush ; 211 current ' flush realias 212 213 : _grow ( self -- ) 214 r! :cluster0 ( cluster0 ) \ V1=self 215 \ special case: if :cluster0 is zero, we have an empty file. We need to 216 \ update its direntry to record the file's first cluster. 217 ?dup not if V1 :fat allocatecluster then ( cluster0 ) 218 dup V1 :dirent to DirEntry cluster ( custer0 ) 219 V1 size V1 :fat :ClusterSize / ?dup if 220 for ( cluster ) V1 :fat FAT@+ next then ( cluster ) 221 drop r> :fat :fatwin :flush ; 222 223 \ TODO: deallocate truncated FATs if appropriate 224 :realias resize ( sz self -- ) 225 2dup size = if 2drop exit then >r \ V1=self 226 dup to@! r@ size > if r@ _grow then 227 r@ pos r@ size min to r@ pos 228 r@ size r@ :dirent to DirEntry filesize r> :fat dflush ; 229 230 :realias writebuf ( buf n self -- n ) 231 dup :free? if _ioerr then 232 r! pos over + dup r@ size > if r@ resize else drop then ( src n ) 233 r@ _place r@ _clpos drop ( src n subpos ) 234 r@ :secwin :seek dup if ( src n a n ) 235 rot min r! move r> dup r@ to+ pos r> :secwin :dirty! 236 else ( src n 0 ) nip nip rdrop then ; 237 238 ]struct