~vdupras/duskos

693a08ac9610a5e34e03592de960cba425596111 — Virgil Dupras 17 days ago 620a316
fs/fat: consolidate
2 files changed, 63 insertions(+), 68 deletions(-)

M fs/fs/fat.fs
M fs/fs/fatlo.fs
M fs/fs/fat.fs => fs/fs/fat.fs +45 -45
@@ 142,47 142,6 @@ $e5 const DIRFREE
  swap r@ :FirstSectorOfCluster ( dst sec )
  swap r@ secpercluster swap r> writesectors ;

: fatflush ( hdl -- ) >r
  r@ FATFile :dirty? not if rdrop exit then ( )
  \ save buffer
  r@ FATFile cluster r@ FATFile :buf( r@ FATFile fat writecluster ( )
  \ save size to direntry
  r@ FATFile :dirent r@ FATFile size swap to DirEntry filesize ( )
  r@ FATFile fat writecursector
  \ undirty the cursor
  r@ FATFile flags $fffffffd and to r> FATFile flags ;

0 structbind FATFile self
\ grow fcursor to newsz, if needed
: fatgrow ( newsz self -- ) ['] self rebind
  dup self size <= if drop exit then ( newsz )
  to self size self :cluster0 ( cluster0 )
  \ special case: if :cluster0 is zero, we have an empty file. We need to
  \ update its direntry to record the file's first cluster.
  ?dup not if self fat allocatecluster then ( cluster0 )
  self :dirent 2dup to DirEntry cluster ( custer0 dirent )
  self size swap to DirEntry filesize self fat writecursector ( cluster0 )
  self size self fat :ClusterSize / ?dup if
    for ( cluster ) self fat FAT@+ next then ( cluster ) drop ;

: fatwritebuf ( buf n self -- n )
  dup FATFile :free? if 2drop drop 0 exit then ( buf n self )
  dup >r File pos over + r@ fatgrow ( src n )
  \ TODO: this seek below doesn't seem right. The buffer should be at all times
  \ positioned properly w.r.t. pos.
  r@ File pos r@ FATFile :seek
  r@ FATFile flags 2 or ( dirty ) r@ to FATFile flags
  r@ FATFile :)buf r@ FATFile :ptr - ( src n nmax )
  min ( src n ) r@ FATFile :ptr swap ( src dst n )
  dup >r move r> ( n ) r@ File pos over + r> File :seek ;

\ TODO: deallocate truncated FATs if appropriate
: fattruncate ( self -- )
  dup FATFile pos ( self pos )
  2dup swap to FATFile size ( self pos )
  over FATFile :dirent to DirEntry filesize ( self )
  FATFile fat writecursector ;

: fatinfo ( id self -- info ) FATInfo :read ;

\ TODO: deallocate the chain before clearing the entry


@@ 208,10 167,6 @@ $e5 const DIRFREE
: :patchlo ( fs -- ) >r \ V1=fs
  ['] fatinfo r@ 12 + ! ['] fatiter r@ 20 + !
  ['] fatnewfile r@ 24 + !  ['] fatnewdir r@ 28 + ! ['] fatremove r@ 32 + !
  ['] fatwritebuf FATFile EmptyCursor 8 + !
  ['] fatflush FATFile EmptyCursor 12 + !
  ['] fatflush FATFile EmptyCursor 12 + !
  ['] fattruncate FATFile EmptyCursor 40 + !
  1 r> to flags ;
: :mountvolume ( drv -- fs ) FAT :mountvolume dup :patchlo ;



@@ 250,3 205,48 @@ create _FATTemplate
  $fffff0 here !
  ( drv ) fatopts rsvdsec here rot Drive :sec! 2rdrop ;
]struct

struct+[ FATFile
  : _flush ( hdl -- )
    r! :dirty? not if rdrop exit then ( )
    \ save buffer
    r@ cluster r@ :buf( r@ :fat writecluster ( )
    \ save size to direntry
    r@ :dirent r@ size swap to DirEntry filesize ( )
    r@ :fat writecursector
    \ undirty the cursor
    r@ flags $fffffffd and to r> flags ;
  current ' :flush realias

  \ grow fcursor to newsz, if needed
  : _grow ( newsz self -- )
    2dup size <= if 2drop exit then
    r! to size V1 :cluster0 ( cluster0 ) \ V1=self
    \ special case: if :cluster0 is zero, we have an empty file. We need to
    \ update its direntry to record the file's first cluster.
    ?dup not if V1 :fat allocatecluster then ( cluster0 )
    V1 :dirent 2dup to DirEntry cluster ( custer0 dirent )
    V1 size swap to DirEntry filesize V1 :fat writecursector ( cluster0 )
    V1 size V1 :fat :ClusterSize / ?dup if
      for ( cluster ) V1 :fat FAT@+ next then ( cluster ) drop rdrop ;

  : _writebuf ( buf n self -- n )
    dup :free? if 2drop drop 0 exit then ( buf n self )
    dup >r pos over + r@ _grow ( src n )
    \ TODO: this seek below doesn't seem right. The buffer should be at all times
    \ positioned properly w.r.t. pos.
    r@ pos r@ :seek
    r@ flags 2 or ( dirty ) r@ to flags
    r@ :)buf r@ :ptr - ( src n nmax )
    min ( src n ) r@ :ptr swap ( src dst n )
    dup >r move r> ( n ) r@ pos over + r> :seek ;
  current ' :writebuf realias

  \ TODO: deallocate truncated FATs if appropriate
  : _truncate ( self -- )
    dup pos ( self pos )
    2dup swap to size ( self pos )
    over :dirent to DirEntry filesize ( self )
    :fat writecursector ;
  current ' :truncate realias
]struct

M fs/fs/fatlo.fs => fs/fs/fatlo.fs +18 -23
@@ 162,51 162,46 @@ extends File struct[ FATFile
  : :dirent ( self -- dirent ) bi entryoff | :fat :getdirentry ;
  : :cluster0 ( self -- cl ) :dirent DirEntry cluster ;

  alias abort :writebuf
  alias drop :flush
  alias abort :truncate

  : _poscluster ( self -- idx ) bi pos | bufsz / ;
  : _inbounds? ( self -- f ) bi _poscluster | clusteridx = ;
  \ set self to pos. If new pos crosses cluster boundaries compared to current
  \ pos, flush current buffer and read a new sector from disk.
  : :fatseek ( pos self -- )
  : :seek ( pos self -- )
    dup :free? if 2drop exit then >r ( pos ) \ V1=self
    dup 0< if abort" can't seek to negative pos" then
    V1 to pos V1 _inbounds? not if
      V1 IO :flush V1 _poscluster dup V1 to clusteridx ( idx )
      V1 :flush V1 _poscluster dup V1 to clusteridx ( idx )
      V1 :cluster0 ( idx cl ) swap for ( cl ) V1 :fat :FAT@ next ( cl )
      dup V1 :buf( V1 :fat :readcluster ( cl ) V1 to cluster then rdrop ;

  : :fatreadbuf ( n self -- a? n )
  : :readbuf ( n self -- a? n )
    dup :free? if 2drop 0 exit then ( n self )
    bi+ size | pos - ( n self maxn )
    dup 1- 0< if ( EOF ) 2drop drop 0 exit then swap >r ( n maxn ) \ V1=self
    min ( n ) \ make sure that n doesn't go over size
    r@ pos r@ :fatseek ( n )
    r@ pos r@ :seek ( n )
    r@ :ptr r@ :)buf over - ( n a nmax )
    rot min ( a n ) dup r> to+ pos ( a n ) ;

  : :fatclose ( self -- ) dup :flush :release ;

  \ these words below are "static" words not called with "self" as an argument,
  \ but "fat".
  : :cursorsize ( fat -- sz ) FAT :ClusterSize SZ + ;
  : :close ( self -- ) dup :flush :release ;

  create EmptyCursor
    0 ( putback ) , ' :fatreadbuf , ' abort , ' drop , ' :fatclose ,
    0 ( pos ) , 0 ( size ) , 0 ( bufptr ) , 0 ( bufsz ) , ' :fatseek ,
    ' abort ( truncate ) , 0 ( fat ) , 0 ( flags ) , 0 ( cluster ) ,
  : :new ( fat -- hdl )
    0 align4 dup to' FAT lastcursor lladd ( fat newll ) drop here >r
    0 ( putback ) , ['] :readbuf , ['] :writebuf , ['] :flush , ['] :close ,
    0 ( pos ) , 0 ( size ) , 0 ( bufptr ) , dup FAT :ClusterSize ( bufsz ) ,
    ['] :seek , ['] :truncate , ( fat ) , 0 ( flags ) , 0 ( cluster ) ,
    -1 ( clusteridx ) , 0 ( entryoff ) ,

  : :createcursor ( fat -- hdl )
    0 align4 dup to' FAT lastcursor lladd ( fat newll )
    swap :cursorsize allot ( newll ) CELLSZ + ( hdl ) dup :release ;
    here r@ to bufptr r@ bufsz allot r> ;

  : :findfreecursor ( fat -- hdl )
    r! FAT lastcursor begin ( ll ) \ V1=fat
    dup FAT lastcursor begin ( fat ll )
      ?dup while dup CELLSZ + :free? not while llnext repeat
      CELLSZ + else r@ :createcursor then
    EmptyCursor over SZ move ( hdl )
    r@ FAT :ClusterSize over to bufsz
    dup SZ + over to bufptr
    r> over to fat ;
      nip CELLSZ + else :new then
    0 over to pos -1 over to clusteridx ;
]struct

struct+[ FAT