9 files changed, 59 insertions(+), 46 deletions(-)

M fs/comp/c/lib.fs
M fs/doc/lib/file.txt
M fs/doc/sys/file.txt
M fs/fs/fat.fs
M fs/fs/fatlo.fs
M fs/sys/file.fs
M fs/sys/io.fs
M fs/xcomp/bootlo.fs
M posix/vm.c

@@ 142,7 142,7 @@ calias 0-9? int isdigit(char c);
     uint pos;
     uint size;
     void *_seek;
-    void *_truncate;
+    void *_resize;
 };
 
 \ Quick sort implementation using Hoare's partitioning

@@ 9,9 9,25 @@ The lib/file unit adds extra utilities on top of sys/file.
 MemFile is a structure that extends File and provides read/write/seek
 capabilities to a memory buffer. It extends File with those words:
 
+Fields:
+
+bufptr Pointer to in-memory buffer.
+bufsz  Size of in-memory buffer.
+
+Words:
+
 :new ( sz -- hdl )
   Allocate a new buffer of size "sz" and return it.
 
+:buf( ( hdl -- a )
+  Pointer to in-memory buffer.
+
+:)buf ( hdl -- a )
+  Upper limit (exclusive) of in-memory buffer.
+
+:ptr ( hdl -- a )
+  Pointer to the equivalent of the current position in in-memory buffer.
+
 ## DriveFile
 
 DriveFile is a structure allowing direct access to a Drive through the

@@ 90,27 90,20 @@ Fields:
 
 pos    Current position, in byte offset from beginning of the file.
 size   Size in bytes of the file.
-bufptr Pointer to in-memory buffer.
-bufsz  Size of in-memory buffer.
 
 Methods:
 
 :seek ( pos hdl -- )
   Place the handle at offset "pos" (in bytes).
 
-:truncate ( hdl -- )
-  Reduce the size of the file to the value of "pos".
+:resize ( sz hdl -- )
+  Grow or truncate the file so that it is "sz" bytes in size.
 
 Words:
 
-:buf( ( hdl -- a )
-  Pointer to in-memory buffer.
-
-:)buf ( hdl -- a )
-  Upper limit (exclusive) of in-memory buffer.
-
-:ptr ( hdl -- a )
-  Pointer to the equivalent of the current position in in-memory buffer.
+:truncate ( hdl -- )
+  Truncate the file to current position, inclusively. That is, a read operation
+  directly following a :truncate will always be EOF.
 
 ## FSInfo API
 

@@ 62,8 62,7 @@ here FatOpts SZ allot structbind FatOpts fatopts
 struct+[ FAT
 $e5 const DIRFREE
 
-: writecursector ( self -- ) dup :dirwin :dirty! :dirwin :flush ;
-: _flush ( self -- ) dup :fatwin :dirty! :fatwin :flush ;
+: dflush ( self -- ) dup :dirwin :dirty! :dirwin :flush ;
 : FAT12! ( entry cluster self -- ) >r
   dup dup >> + swap 1 and if ( e off )
     tuck r@ :fatwin :seek cl# dup c@ ( off e a n )


@@ 72,8 71,8 @@ $e5 const DIRFREE
   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 ;
+    $f0 and swap 8 rshift $f and or ( a e ) swap c! then r> :fatwin :dirty! ;
+: FAT16! ( entry cluster self -- ) r! :FAT16' w! r> :fatwin :dirty! ;
 : FAT! ( entry cluster self -- ) dup :FAT12? if FAT12! else FAT16! then ;
 
 : zerocluster ( cluster self -- )


@@ 105,6 104,7 @@ $e5 const DIRFREE
     ( self ) dup :nextcluster? if findfreedirentry else ( self )
       \ nothing found, we have to extend the chain
       r! allocatecluster0 ( newcl ) r@ bufcluster r@ FAT! ( newcl )
+      r@ :fatwin :flush
       r@ :nextcluster? cl# r> :dirwin :buf( then
     else ( self a ) nip then ;
 


@@ 114,14 114,14 @@ $e5 const DIRFREE
   fnbuf( over DirEntry NAMESZ move ( direntry ) ;
 
 :realias newfile ( dirid name self -- id ) >r
-  r@ _newentry ( dirent ) r@ writecursector r> :getid ;
+  r@ _newentry ( dirent ) r@ dflush r> :getid ;
 
 : _makedir ( dirent -- dirent ) $10 over to DirEntry attr ;
 
 :realias newdir ( dirid name self -- id )
   r! allocatecluster0 >r ( dirid name ) \ V1=self V2=cluster
-  V1 _newentry ( dirent ) _makedir ( dirent )
-  V2 over to DirEntry cluster V1 writecursector ( dirent )
+  V1 :fatwin :flush V1 _newentry ( dirent ) _makedir ( dirent )
+  V2 over to DirEntry cluster V1 dflush ( dirent )
   V1 :getid ( id ) V1 bufcluster >r \ V3=parentcl
   \ Cluster allocated, now let's initialize it with "." and ".."
   V2 V1 :clustersec 1 V1 :readsector


@@ 129,13 129,13 @@ $e5 const DIRFREE
   V2 over to DirEntry cluster ( id buf ) DirEntry SZ +
   dup DirEntry NAMESZ SPC fill '.' over c!+ '.' swap c! ( id buf )
   _makedir ( id buf ) V3 swap to DirEntry cluster
-  2rdrop r> writecursector ( id ) ;
+  2rdrop r> dflush ( id ) ;
 
 :realias info ( id self -- info ) FATInfo :read ;
 
 \ TODO: deallocate the chain before clearing the entry
 :realias remove ( id self -- )
-  tuck :getdirentry ( dirent ) DIRFREE swap c! writecursector ;
+  tuck :getdirentry ( dirent ) DIRFREE swap c! dflush ;
 
 \ Read next sector if a sequential read is available, else return false.
 : :nextsector? ( self -- f )


@@ 199,29 199,29 @@ struct+[ FATFile
   : _flush ( hdl -- ) :secwin :flush ;
   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
+  : _grow ( self -- )
+    r! :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 )
+    dup V1 :dirent to DirEntry cluster ( custer0 )
     V1 size V1 :fat :ClusterSize / ?dup if
-      for ( cluster ) V1 :fat FAT@+ next then ( cluster ) drop rdrop ;
+      for ( cluster ) V1 :fat FAT@+ next then ( cluster )
+    drop r> :fat :fatwin :flush ;
+
+  \ TODO: deallocate truncated FATs if appropriate
+  :realias resize ( sz self -- )
+    2dup size = if 2drop exit then >r \ V1=self
+    dup to@! r@ size > if r@ _grow then
+    r@ pos r@ size min to r@ pos
+    r@ size r@ :dirent to DirEntry filesize r> :fat dflush ;
 
   :realias writebuf ( buf n self -- n )
     dup :free? if _ioerr then
-    r! pos over + r@ _grow ( src n )
+    r! pos over + dup r@ size > if r@ resize else drop then ( src n )
     r@ _place r@ _clpos drop ( src n subpos )
     r@ :secwin :seek dup if ( src n a n )
       rot min r! move r> dup r@ to+ pos r> :secwin :dirty!
       else ( src n 0 ) nip nip rdrop then ;
-  \ TODO: deallocate truncated FATs if appropriate
-  :realias truncate ( self -- )
-    dup pos ( self pos )
-    2dup swap to size ( self pos )
-    over :dirent to DirEntry filesize ( self )
-    :fat writecursector ;
+
 ]struct

@@ 153,9 153,9 @@ extends File struct[ FATFile
   : :dirent ( self -- dirent ) bi entryoff | :fat :getdirentry ;
   : :cluster0 ( self -- cl ) :dirent DirEntry cluster ;
 
-  alias abort writebuf
+  alias _ioerr writebuf
   alias drop flush
-  alias abort truncate
+  alias _ioerr resize
 
   : _clpos ( self -- subpos clidx ) bi pos | :fat :ClusterSize /mod ;
   \ Can't be called with pos >= size

@@ 17,6 17,10 @@ struct+[ Filesystem
     >r 2dup r@ :child ?dup if rdrop nip nip else r> :newdir then ;
 ]struct
 
+struct+[ File
+  : :truncate ( hdl -- ) bi pos | :resize ;
+]struct
+
 struct[ Path
   sfield fs
   sfield id


@@ 80,9 84,9 @@ struct[ Path
     dup id _curpath CELLSZ + !  fs _curpath ! ;
   : :fload ( self -- ) bi fs | id fload ;
   : _copyfile ( dst src -- ) \ arguments are opened File
-    2dup IO :spit over File :truncate File :close File :close ;
+    2dup IO :spit File :close File :close ;
   : :copyfile ( dst self -- ) \ arguments are paths
-    :open >r :open r> _copyfile ;
+    :open >r :open r> 2dup File size swap File :resize _copyfile ;
   : :appendfile ( src self -- )
     :open dup File size over File :seek swap :open _copyfile ;
 

@@ 31,7 31,7 @@ struct+[ IO
     r> _buf( - 1- ( len ) _buf( c! _buf( ( str ) rdrop ;
   : :spit ( dst hdl -- )
     >r >r begin \ V1=hdl V2=dst
-      -1 V1 :readbuf ?dup while ( a n ) V2 :write repeat rdrop rdrop ;
+      -1 V1 :readbuf ?dup while ( a n ) V2 :write repeat 2rdrop ;
 ]struct
 
 : _consoleemit console :putc ;

@@ 453,13 453,13 @@ struct[ Filesystem
 extends IO struct[ File
   sfield pos
   sfield size
-  smethod :seek     ( n hdl -- )
-  smethod :truncate ( hdl -- )
+  smethod :seek   ( n hdl -- )
+  smethod :resize ( sz hdl -- )
   : :new ( -- hdl )
     IO :new 0 ( pos ) , 0 ( size ) , 2 nabort, ;
   : seek ( pos hdl -- ) to pos ;
-  alias drop truncate
-  : :[methods] '" seek" , '" truncate" , ;
+  alias 2drop resize
+  : :[methods] '" seek" , '" resize" , ;
 ]struct
 
 \ File loading

@@ 734,7 734,7 @@ static void FOPEN () {
 	dwrite(0); // pos
 	dwrite(filesize);
 	dwrite(find("_fseek")); // seek
-	dwrite(find("abort")); // truncate
+	dwrite(find("abort")); // resize
 	dwrite(fd);
 	dwrite(fdhi(fd));
 }