fatlo.fs (8174B) - raw
1 \ The "low" part of a FAT12/FAT16 implementation 2 3 \ This is a subset of a FAT12/FAT16 implementation. It is designed to be 4 \ embedded in the boot sequence and provide the means to continue bootstrapping 5 \ on. 6 7 \ Its goal is to provide a read-only access to FAT12/FAT16 volumes. The "write" 8 \ part is in fs/fat. This unit is more than strictly necessary to get through 9 \ the boot process, but it is organized thus so that we can leverage a maximum 10 \ of logic from this unit in fs/fat. All in all, "read and core stucture" is 11 \ here, "write" is in fs/fat. 12 13 \ Requires lib/drivelo.fs 14 \ See fs/fat.fs for complete implementation details. 15 16 $ffff const EOC 17 struct[ DirEntry 18 11 const NAMESZ 19 8 const EXTIDX 20 3 const EXTSZ 21 : :name[] ( self -- sa sl ) NAMESZ ; 22 11 sallot 23 sfieldb attr 24 14 sallot 25 sfieldw cluster 26 sfield filesize 27 : :lastentry? ( self -- f ) c@ not ; 28 : :valid? ( self -- f ) dup :lastentry? not swap c@ $e5 <> and ; 29 : :iterable? ( self -- f ) dup :valid? swap c@ '.' <> and ; 30 ]struct 31 32 \ Just a dummy entry so that we can reference the root directory as a "direntry" 33 create rootdirentry( DirEntry SZ allot0 34 \ directory entry of currently selected directory. If first byte is 0, this 35 \ means that we're on the root dir 36 create curdir( DirEntry SZ allot0 37 create fnbuf( DirEntry NAMESZ allot 38 here const )fnbuf 39 40 : fnbufclr fnbuf( DirEntry NAMESZ SPC fill ; 41 : fnbuf! ( name -- ) 42 fnbufclr dup S" ." s= over S" .." s= or if 43 c@+ ( a len ) fnbuf( swap move exit then 44 c@+ swap >r fnbuf( swap for ( dst ) \ V1=a 45 8b to@+ V1 dup '.' = if 46 2drop fnbuf( DirEntry EXTIDX + else upcase swap c!+ then ( dst+1 ) 47 dup )fnbuf = if break then next then drop rdrop ; 48 49 \ The FAT struct in this unit is split in 2. The first part contains code needed 50 \ by FATFile, and the second part contains the rest of the code for FAT. This 51 \ allows some of the FAT code to depend on code in FATFile. 52 extends Filesystem struct[ FAT 53 sfield bufcluster \ cluster number of current buf 54 sfield lastcursor 55 sfield fatwin \ FAT secwin 56 sfield dirwin \ DirEntry secwin 57 \ FAT header now 58 $0b sallot 59 sfieldb secszl 60 sfieldb secszh 61 : secsz bi secszh 8 lshift | secszl or ; 62 sfieldb secpercluster 63 sfieldw reservedseccnt 64 sfieldb FATcnt 65 sfieldb rootentcntl 66 sfieldb rootentcnth 67 : rootentcnt bi rootentcnth 8 lshift | rootentcntl or ; 68 sfieldb seccntl 69 sfieldb seccnth 70 : seccnt bi seccnth 8 lshift | seccntl or ; 71 1 sallot 72 sfieldw FATsz \ in sectors 73 $18 const HDRSZ 74 : :fatwin [compile] fatwin [compile] SectorWindow ; immediate 75 : :dirwin [compile] dirwin [compile] SectorWindow ; immediate 76 77 \ These words have the same sig: fat -- n 78 : :RootDirSectors bi rootentcnt 32 * | secsz /mod ( r q ) swap bool + ; 79 : :totsec bi FATcnt | FATsz * ; 80 : :FirstRootDirSecNum bi reservedseccnt | :totsec + ; 81 : :FirstDataSector bi :FirstRootDirSecNum | :RootDirSectors + ; 82 : :DataSec bi seccnt | :FirstDataSector - ; 83 : :CountOfClusters bi :DataSec | secpercluster / ; 84 : :ClusterSize bi secpercluster | secsz * ; 85 : :FAT12? :CountOfClusters 4085 < ; 86 87 : cl# ( n -- ) not if abort" cluster out of range" then ; 88 : :clustersec ( n self -- sec ) >r 89 dup << r@ secsz r@ FATsz * < cl# 90 2 - r@ secpercluster * r> :FirstDataSector + ; 91 92 : :readsector ( sec cnt self -- ) r! :dirwin :move 0 r> :dirwin :seek 2drop ; 93 94 : :FAT12@ ( cluster self -- entry ) >r 95 dup dup >> + ( cl offset ) dup r@ :fatwin :seek cl# c@ ( cl off lsb ) 96 swap 1+ r> :fatwin :seek cl# c@ 8 lshift or ( cl entry ) 97 swap 1 and if 4 rshift else $fff and then ; 98 : :FAT16' ( cluster self -- 'entry ) dip << | :fatwin :seek 2 >= cl# ; 99 : :FAT16@ ( cluster self -- entry ) :FAT16' w@ ; 100 : :FAT@ ( cluster self -- entry ) 101 over 2 < if 2drop EOC else dup :FAT12? if :FAT12@ else :FAT16@ then then ; 102 103 : :EOC? ( cluster self -- f ) :FAT12? if $ff8 else $fff8 then tuck and = ; 104 105 : :nextcluster? ( self -- f ) 106 bi+ bufcluster | :FAT@ swap 2dup :EOC? if 2drop 0 else ( cl self ) 107 2dup to bufcluster tuck :clustersec ( self sec ) 108 over secpercluster rot :readsector 1 then ; 109 110 :iterator :iterdirentry ( self -- ) 111 to j 0 to k begin 112 k j :dirwin :seek while to i yield DirEntry SZ to+ k repeat unyield ; 113 114 \ Find current fnbuf( in current dir buffer and return a dir entry. 115 : :findindir ( self -- direntry-or-0 ) 116 dup :iterdirentry 117 fnbuf( i DirEntry :name[] []= if i break then next 118 ( self ) dup :nextcluster? if :findindir else drop 0 then 119 else ( self i ) nip then ; 120 121 \ Read specified "direntry" in :buf( 122 : :readdir ( direntry self -- ) >r 123 DirEntry cluster ?dup if \ not root entry 124 dup r@ :clustersec r@ secpercluster else \ root entry 125 0 r@ :FirstRootDirSecNum r@ :RootDirSectors then ( cluster sec cnt ) 126 r@ :readsector ( cluster ) to r> bufcluster ; 127 128 \ Get DirEntry address from FS ID "id" 129 : :getdirentry ( id self -- direntry ) 130 over if dup :dirwin :fulldrv :dirwin :seek cl# else 2drop rootdirentry( then ; 131 132 \ Get ID for direntry 133 : :getid ( direntry self -- id ) 134 r! :dirwin :buf( - r@ :dirwin sec r> secsz * + ; 135 136 : child ( dirid name self -- id-or-0 ) >r 137 fnbuf! r@ :getdirentry r@ :readdir r@ :findindir 138 dup if r@ :getid then rdrop ; 139 ]struct 140 141 \ File cursor 142 extends File struct[ FATFile 143 sfield fat 144 sfield secwin 145 \ all zeroes = free cursor 146 \ b0 = used 147 \ b1 = buffer is dirty 148 sfield flags 149 \ current cluster in buf 0=nothing. the cluster is not actually read 150 \ until the first position of the cluster is needed. 151 sfield cluster 152 sfield clusteridx \ current cluster index, -1=nothing. 153 sfield entryoff 154 : :fat [compile] fat [compile] FAT ; immediate 155 : :secwin [compile] secwin [compile] SectorWindow ; immediate 156 : :free? ( self -- f ) flags not ; 157 : :hold ( self -- ) 1 swap to flags ; 158 : :release ( self -- ) 0 swap to flags ; 159 : :dirent ( self -- dirent ) bi entryoff | :fat :getdirentry ; 160 : :cluster0 ( self -- cl ) :dirent DirEntry cluster ; 161 162 alias _ioerr writebuf 163 alias drop flush 164 alias _ioerr resize 165 166 : _clpos ( self -- subpos clidx ) bi pos | :fat :ClusterSize /mod ; 167 \ Can't be called with pos >= size 168 : _place ( self -- ) 169 dup _clpos nip over clusteridx over = if 2drop else ( self clidx ) 170 swap r! :flush dup V1 to clusteridx \ ( clidx ) V1=self 171 V1 :cluster0 swap for ( cl ) V1 :fat :FAT@ next ( cl ) 172 V1 :fat :clustersec V1 :fat :ClusterSize r> :secwin :move then ; 173 174 : readbuf ( n self -- a? n ) 175 bi+ pos | size >= over :free? or if 2drop 0 else 176 r! size V1 pos - min >r \ V1=self V2=n 177 V1 _place V1 _clpos drop ( subpos ) 178 V1 :secwin :seek r> min dup r> to+ pos then ; 179 180 : close ( self -- ) dup :flush :release ; 181 : :open ( direntry self -- ) 182 r! :hold dup V1 :fat :getid ( dirent entryoff ) \ V1=self 183 r@ to entryoff DirEntry filesize r@ to size ( ) 184 0 to r@ putback 0 to r@ pos -1 to r> clusteridx ; 185 186 : :new ( fat -- hdl ) 187 dup FAT drv SectorWindow :new 188 over to' FAT lastcursor lladd drop ( fat secwin ) 189 File :new >r ,[ :[methods] ], -move, \ V1=hdl 190 ,[ IO :[methods] ], r@ IO :methods( swap move 191 swap ( fat ) , ( secwin ) , 0 ( flags ) , 0 ( cluster ) , 192 -1 ( clusteridx ) , 0 ( entryoff ) , r> ; 193 ]struct 194 195 struct+[ FAT 196 : :findfreecursor ( self -- hdl ) 197 dup lastcursor begin ( fat ll ) 198 ?dup while dup CELLSZ + FATFile :free? not while llnext repeat 199 nip CELLSZ + else FATFile :new then ; 200 201 : open ( id self -- hdl ) 202 tuck :getdirentry swap :findfreecursor ( dirent hdl ) 203 tuck FATFile :open ; 204 205 alias abort info 206 alias abort iter 207 alias abort newfile 208 alias abort newdir 209 alias abort remove 210 211 : :mountvolume ( drv -- fs ) 212 dup SectorWindow :new over SectorWindow :new rot 213 dup Filesystem :new >r ( fatwin dirwin drv ) \ V1=fs 214 ,[ :[methods] ], -move, 215 0 ( bufcluster ) , 0 ( lastcursor ) , rot ( fatwin ) , swap ( dirwin ) , 216 \ At this point, "here" points to the FAT-header-to-be. Read the first sector 217 \ directly in "here": we'll have the header right here! 218 ( drv ) dup 0 here rot Drive :sec@ ( drv ) 219 HDRSZ allot ( drv ) 220 \ Verify that the header makes sense 221 r@ secsz swap Drive secsz <> if 222 abort" Drive sector size not matching drive!" then ( ) 223 r> ( fs ) dup tri reservedseccnt | FATsz | :fatwin :move ; 224 ]struct