~vdupras/duskos

3eaeea42fcd2fcb7655c1aac70bdd73d2ca45f6c — Virgil Dupras 1 year, 2 months ago a9d0ce1
fs/fat: use SectorWindow

Quite a big refactoring. I had to change the way tests run under PC because the
init code is now so tight that RSP comes corrupting it during tests.
M fs/fs/fat.fs => fs/fs/fat.fs +25 -34
@@ 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 ;


M fs/fs/fatlo.fs => fs/fs/fatlo.fs +28 -39
@@ 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

M fs/lib/drivelo.fs => fs/lib/drivelo.fs +1 -1
@@ 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

M fs/xcomp/i386/pc/build.fs => fs/xcomp/i386/pc/build.fs +3 -2
@@ 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

M fs/xcomp/i386/pc/glue.fs => fs/xcomp/i386/pc/glue.fs +2 -0
@@ 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,

M fs/xcomp/i386/pc/inittest.fs => fs/xcomp/i386/pc/inittest.fs +2 -2
@@ 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