6 files changed, 61 insertions(+), 78 deletions(-)

M fs/fs/fat.fs
M fs/fs/fatlo.fs
M fs/lib/drivelo.fs
M fs/xcomp/i386/pc/build.fs
M fs/xcomp/i386/pc/glue.fs
M fs/xcomp/i386/pc/inittest.fs

@@ 18,6 18,7 @@
 \ File and directory IDs in FAT are the offset, on disk, of their corresponding
 \ DirEntry.
 
+?f<< /lib/drivelo.fs
 ?f<< /fs/fatlo.fs
 ?f<< /lib/str.fs
 


@@ 61,32 62,24 @@ here FatOpts SZ allot structbind FatOpts fatopts
 struct+[ FAT
 $e5 const DIRFREE
 
-: writesector ( sec self -- ) >r dup
-  r@ :buf( r@ :drv :sec! ( sec )
-  0 r@ to bufseccnt r> to bufsec ;
-
-: writecursector ( self -- ) bi bufsec | writesector ;
-
+: writecursector ( self -- ) dup :dirwin :dirty! :dirwin :flush ;
+: _flush ( self -- ) dup :fatwin :dirty! :fatwin :flush ;
 : FAT12! ( entry cluster self -- ) >r
-  dup r@ :FAT12' ( entry cl a ) dup w@ ( entry cl a n )
-  rot 1 and if ( entry a n )
-    $f and rot 4 lshift or ( a n )
-  else ( entry a n )
-    $f000 and rot $fff and or then ( a n )
-  over w! ( a ) r@ :)buf 1- = if \ end-of-sector cross-over!
-    r@ writecursector
-    r@ bufsec 1+ 0 r@ :readsector
-    r@ :)buf c@ r@ :buf( c! then
-  rdrop ;
-: FAT16! ( entry cluster self -- ) :FAT16' w! ;
-: FAT! ( entry cluster self -- ) >r
-  r@ :FAT12? if r@ FAT12! else r@ FAT16! then r> writecursector ;
+  dup dup >> + swap 1 and if ( e off )
+    tuck r@ :fatwin :seek cl# dup c@ ( off e a n )
+    $f and rot 4 lshift or dup rot c! ( off e ) r@ :fatwin :dirty!
+    8 rshift swap 1+ r@ :fatwin :seek cl# c!
+  else ( e off )
+    2dup r@ :fatwin :seek cl# c! ( e off ) r@ :fatwin :dirty!
+    1+ r@ :fatwin :seek cl# tuck c@ ( a e n )
+    $f0 and swap 8 rshift $f and or ( a e ) swap c! then r> _flush ;
+: FAT16! ( entry cluster self -- ) r! :FAT16' w! r> _flush ;
+: FAT! ( entry cluster self -- ) dup :FAT12? if FAT12! else FAT16! then ;
 
 : zerocluster ( cluster self -- )
-  dup :buf( over secsz 0 fill ( cluster self )
-  tuck :FirstSectorOfCluster ( self sec )
-  over secpercluster for ( self sec )
-    2dup swap writesector ( self sec ) 1+ next 2drop ;
+  r! :FirstSectorOfCluster V1 secpercluster V1 :dirwin :move \ V1=self
+  0 V1 :dirwin :seek 0 fill V1 secpercluster for
+    V1 :dirwin sec i + V1 :dirwin :buf( V1 :drv :sec! next rdrop ;
 
 \ find a free cluster in the FAT
 : findfreecluster ( self -- cluster )


@@ 108,9 101,9 @@ $e5 const DIRFREE
 
 \ try to find in current buffer
 : _findinsec ( self -- a-or-0 ) >r
-  r@ :buf( begin ( a )
+  r@ :dirwin :buf( begin ( a )
     dup c@ dup DIRFREE = swap not or if ( free! ) rdrop exit then
-    DirEntry SZ + dup r@ :)buf >= until rdrop drop 0 ;
+    DirEntry SZ + dup r@ :dirwin :)buf >= until rdrop drop 0 ;
 
 \ find free dir entry in current buffer
 : findfreedirentry ( self -- direntry )


@@ 120,7 113,7 @@ $e5 const DIRFREE
   repeat \ nothing found, we have to extend the chain
     ( self ) dup >r allocatecluster0 ( newcl )
     r@ bufcluster r@ FAT! ( newcl )
-    r@ :nextsector? drop ( has to work ) r> :buf(
+    r@ :nextsector? drop ( has to work ) r> :dirwin :buf(
   else ( self a ) nip then ;
 
 : _newentry ( dirid name self -- direntry ) >r


@@ 141,7 134,7 @@ $e5 const DIRFREE
   _self :getid ( id ) _self bufcluster to _parentcl
   \ Cluster allocated, now let's initialize it with "." and ".."
   _cluster _self :FirstSectorOfCluster 1 _self :readsector
-  _self :buf( dup DirEntry NAMESZ SPC fill '.' over c! _makedir ( id buf )
+  _self :dirwin :buf( dup DirEntry NAMESZ SPC fill '.' over c! _makedir ( id buf )
   _cluster over to DirEntry cluster ( id buf ) DirEntry SZ +
   dup DirEntry NAMESZ SPC fill '.' over c!+ '.' swap c! ( id buf )
   _makedir ( id buf ) _parentcl swap to DirEntry cluster


@@ 152,14 145,14 @@ $e5 const DIRFREE
 : writesectors ( sec u buf self -- ) to self
   rot >r swap for ( buf ) \ V1=sec
     V1 over self :drv :sec! to1+ V1 self :drv secsz + next ( buf )
-  -1 self to bufsec drop rdrop ;
+  drop rdrop ;
 
 : writecluster ( cluster src self -- ) >r
   over 2 - $fff6 > if abort" cluster out of range!" then
   swap r@ :FirstSectorOfCluster ( dst sec )
   swap r@ secpercluster swap r> writesectors ;
 
-: fatflush ( self -- ) >r
+: fatflush ( hdl -- ) >r
   r@ FATFile :dirty? not if rdrop exit then ( )
   \ save buffer
   r@ FATFile cluster r@ FATFile :buf( r@ FATFile fat writecluster ( )


@@ 207,16 200,14 @@ $e5 const DIRFREE
   r@ :getdirentry ( dirent ) DIRFREE swap c! r> writecursector ;
 
 \ This approach to iteration is inefficient, but simple. I keep it as-is for now
-\ because I'm planning on replacing the whole of fs/fat.fs with elm-chan's FAT
-\ implementation at some point.
 : _next ( entry self -- entry-or-0 ) >r \ V1=self
-  DirEntry SZ + dup V1 :)buf = if
-    drop V1 :nextsector? if V1 :buf( else rootdirentry( then then ( entry )
+  DirEntry SZ + dup V1 :dirwin :)buf = if
+    drop V1 :nextsector? if V1 :dirwin :buf( else rootdirentry( then then ( entry )
   dup DirEntry :lastentry? if drop 0 else
     dup DirEntry :iterable? not if V1 _next then then ( entry ) rdrop ;
 
 : fatiter ( dirid previd self -- id-or-0 ) >r >r ( dirid ) \ V1=self V2=previd
-  V1 :getdirentry V1 :readdir V1 :buf( DirEntry SZ - V2 if begin ( entry )
+  V1 :getdirentry V1 :readdir V1 :dirwin :buf( DirEntry SZ - V2 if begin ( entry )
       V1 _next dup while dup V1 :getid V2 <> while repeat then then ( entry-or-0 )
   dup if V1 _next dup if V1 :getid then then 2rdrop ;
 

@@ 10,6 10,7 @@
 \ of logic from this unit in fs/fat. All in all, "read and core stucture" is
 \ here, "write" is in fs/fat.
 
+\ Requires lib/drivelo.fs
 \ See fs/fat.fs for complete implementation details.
 
 $ffff const EOC


@@ 49,10 50,10 @@ here const )fnbuf
 \ by FATFile, and the second part contains the rest of the code for FAT. This
 \ allows some of the FAT code to depend on code in FATFile.
 extends Filesystem struct[ FAT
-sfield bufsec \ sector number of current buf
-sfield bufseccnt \ number of sectors ahead for sequential read
 sfield bufcluster \ cluster number of current buf
 sfield lastcursor
+sfield fatwin \ FAT secwin
+sfield dirwin \ DirEntry secwin
 
 SZ &+ :hdr(
 SZ $0b + &+w@ secsz          \ in bytes


@@ 63,9 64,8 @@ SZ $11 + &+w@ rootentcnt     \ count of 32b entries
 SZ $13 + &+w@ seccnt
 SZ $16 + &+w@ FATsz          \ in sectors
 $18 const HDRSZ
-\ buffer for reading FAT tables and dir entries. one sector in length.
-SZ HDRSZ + &+ :buf(
-: :)buf bi :buf( | secsz + ;
+: :fatwin [compile] fatwin [compile] SectorWindow ; immediate
+: :dirwin [compile] dirwin [compile] SectorWindow ; immediate
 
 \ These words have the same sig: fat -- n
 : :RootDirSectors bi rootentcnt 32 * | secsz /mod ( r q ) swap bool + ;


@@ 81,24 81,14 @@ SZ HDRSZ + &+ :buf(
   dup << r@ secsz r@ FATsz * >= if abort" cluster out of range" then
   1- 1- r@ secpercluster * r> :FirstDataSector + ;
 
-\ Read specified sector into buffer if it's not already there.
-\ "cnt" is the total number of sectors ahead of "sec" that are available for a
-\ sequential read, *including this sector*. For example, "2" means that we're
-\ going to read one extra sector after this one.
-: :readsector ( sec cnt self -- ) >r
-  1 max 1- to r@ bufseccnt dup r@ bufsec = if rdrop drop else
-    dup to r@ bufsec ( sec ) r@ :buf( r> :drv :sec@ then ;
-
-: :sec+( ( off sec self -- a ) tuck 1 swap :readsector :buf( + ;
-: :FAT12' ( cluster self -- 'entry ) >r
-  dup >> + ( offset ) r@ secsz /mod r@ reservedseccnt + ( secoff sec )
-  over 1+ r@ secsz = if \ end-of-sector cross-over!
-    dup 1+ 1 r@ :readsector r@ :buf( c@ r@ :)buf c! then
-  r> :sec+( ;
-: :FAT12@ ( cluster self -- entry )
-  over swap :FAT12' w@ swap 1 and if 4 rshift else $fff and then ;
-: :FAT16' ( cluster self -- 'entry ) >r
-  << ( offset ) r@ secsz /mod r@ reservedseccnt + ( secoff sec ) r> :sec+( ;
+: :readsector ( sec cnt self -- ) r! :dirwin :move 0 r> :dirwin :seek 2drop ;
+
+: cl# ( n -- ) not if abort" cluster out of range" then ;
+: :FAT12@ ( cluster self -- entry ) >r
+  dup dup >> + ( cl offset ) dup r@ :fatwin :seek cl# c@ ( cl off lsb )
+  swap 1+ r> :fatwin :seek cl# c@ 8 lshift or ( cl entry )
+  swap 1 and if 4 rshift else $fff and then ;
+: :FAT16' ( cluster self -- 'entry ) dip << | :fatwin :seek 2 >= cl# ;
 : :FAT16@ ( cluster self -- entry ) :FAT16' w@ ;
 : :FAT@ ( cluster self -- entry )
   over 2 < if 2drop EOC else dup :FAT12? if :FAT12@ else :FAT16@ then then ;


@@ 107,9 97,7 @@ SZ HDRSZ + &+ :buf(
 
 \ Read next sector if a sequential read is available, else return false.
 : :nextsector? ( self -- f )
-  dup bufseccnt if \ still on a sector streak
-    bi+ bufsec 1+ | bufseccnt 1- rot :readsector 1
-  else \ out of sector, try next cluster
+  dup :dirwin :next if 2drop 1 else ( self ) \ try next cluster
     bi+ bufcluster | :FAT@ swap 2dup :EOC? if 2drop 0 else ( cl self )
       2dup to bufcluster tuck :FirstSectorOfCluster ( self sec )
       over secpercluster rot :readsector 1 then then ;


@@ 117,8 105,8 @@ SZ HDRSZ + &+ :buf(
 \ Find current fnbuf( in current dir buffer and return a dir entry.
 : :findindir ( self -- direntry-or-0 ) >r
   begin
-    r@ :buf( begin ( a )
-      dup r@ :)buf < while ( a )
+    r@ :dirwin :buf( begin ( a )
+      dup r@ :dirwin :)buf < while ( a )
       fnbuf( over DirEntry :name[] []= not while ( a ) DirEntry SZ + repeat
       ( success ) else ( not found ) drop 0 then ( a )
     ?dup not while r@ :nextsector? while


@@ 134,11 122,12 @@ SZ HDRSZ + &+ :buf(
 \ Get DirEntry address from FS ID "id"
 : :getdirentry ( id self -- direntry )
   over if
-    r! secsz /mod ( offset sec ) 1 r@ :readsector ( off ) r> :buf( +
+    r! secsz /mod ( offset sec ) 1 r@ :readsector ( off ) r> :dirwin :buf( +
   else 2drop rootdirentry( then ;
 
 \ Get ID for direntry
-: :getid ( direntry self -- id ) r! :buf( - r@ bufsec r> secsz * + ;
+: :getid ( direntry self -- id )
+  r! :dirwin :buf( - r@ :dirwin sec r> secsz * + ;
 
 \ read multiple sectors in buf
 : :readsectors ( sec u buf self -- ) >r \ V1=self


@@ 228,21 217,21 @@ struct+[ FAT
     V1 :getdirentry
     V1 FATFile :findfreecursor ( dirent hdl ) r! FATFile :hold \ V2=hdl
     \ write the rest
-    dup V1 :buf( - V1 bufsec V1 secsz * + ( dirent doffset )
+    dup V1 :getid ( dirent entryoff )
     r@ to FATFile entryoff DirEntry filesize r@ to FATFile size ( ) r> rdrop ;
 
   : :mountvolume ( drv -- fs )
-    0 align4 here >r dup , ( drv R:fs ) 0 ( flags ) ,
-    ['] :child , ['] abort , ['] :fatopen , ['] abort , ['] abort , ['] abort ,
-    ['] abort ,
-    0 ( bufsec ) , 0 ( bufseccnt ) , 0 ( bufcluster ) , 0 ( lastcursor ) ,
+    dup SectorWindow :new over SectorWindow :new rot
+    here >r ( fatwin dirwin rot ) \ V1=fs
+    dup , 0 ( flags ) , ['] :child , ['] abort , ['] :fatopen , ['] abort ,
+    ['] abort , ['] abort , ['] abort ,
+    0 ( bufcluster ) , 0 ( lastcursor ) , rot ( fatwin ) , swap ( dirwin ) ,
     \ At this point, "here" points to the FAT-header-to-be. Read the first sector
     \ directly in "here": we'll have the header right here!
     ( drv ) dup 0 here rot Drive :sec@ ( drv )
     HDRSZ allot ( drv )
     \ Verify that the header makes sense
-    r@ secsz swap Drive secsz over <> if
-      abort" Drive sector size not matching drive!" then ( secsz )
-    \ Allocate buffer. 1+ is for the extra byte for FAT12 cross-sector exception
-    1+ allot r> ( fs ) ;
+    r@ secsz swap Drive secsz <> if
+      abort" Drive sector size not matching drive!" then ( )
+    r> ( fs ) dup tri reservedseccnt | FATsz | :fatwin :move ;
 ]struct

@@ 21,7 21,7 @@ struct[ SectorWindow
       r@ fsec + r@ :load ( off )
       bi r@ :buf( + | r> :drv secsz -^ ( a n )
     else rdrop 2drop 0 then ;
-  : :next bi+ sec 1+ | :drv secsz * :seek ;
+  : :next bi+ sec 1+ | :drv secsz * swap :seek ;
   : :new ( drv -- secwin )
     here >r dup , 0 , 1 , -1 , 0 , Drive secsz allot r> ;
 ]struct

@@ 17,8 17,8 @@ org value kernel
   to fatopts clustercnt ( drv )
   16 to fatopts rootentsec
   \ 59 sectors is the maximum that fits between $500 and $7c00. We're quite
-  \ tight on that front...
-  59 to fatopts rsvdsec
+  \ tight on that front... +1 for the MBR
+  60 to fatopts rsvdsec
   1 to fatopts secperclus
   \ By default, we generate a FAT for a hard disk.
   $3f to fatopts secpertrk


@@ 60,6 60,7 @@ org value kernel
   kernel kernellen V1 IO :write
   S" /xcomp/bootlo.fs" V1 spitfile
   S" /drv/pc/int13h.fs" V1 spitfile
+  S" /lib/drivelo.fs" V1 spitfile
   S" /fs/fatlo.fs" V1 spitfile
   S" /xcomp/i386/pc/glue.fs" V1 spitfile
   S" /xcomp/boothi.fs" V1 spitfile

@@ 2,4 2,6 @@
 INT13hDrive FAT :mountvolume ( fs ) to bootfs
 0 S" drv" bootfs Filesystem :child S" pc" bootfs Filesystem :child
   S" int13h.fs" bootfs Filesystem :child floaded,
+0 S" lib" bootfs Filesystem :child
+  S" drivelo.fs" bootfs Filesystem :child floaded,
 0 S" fs" bootfs Filesystem :child S" fatlo.fs" bootfs Filesystem :child floaded,

@@ 6,5 6,5 @@ f<< sys/scratch.fs
 f<< lib/fmt.fs
 f<< lib/diag.fs
 ' bye ' abort realias
-f<< tests/all.fs
-: init bye ;
+f<< /tests/all.fs
+bye