\\              *** ANS-Forth Files ***                14mar92py                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \ ANS Forth File interface                             29may94py                                                                memory also dos also                                                                                                            \ Module file                                                                                                                   1 capacity 2- +thru                                                                                                             environment                                                     true to file                                                    true to file-ext                                                                                                                \ Module;                                                                                                                       toss toss forth                                                                                                                 \ File primitives                                      26may95py                                                                \ $20 constant #files                                           \ Create files  #files 0 [DO] file, [LOOP]                                                                                      0 constant r/o  1 constant w/o  2 constant r/w                  : bin ; immediate                                               | : !fid  ( addr count -- fid )  NewMP dup >r assign r> ;                                                                       : source-id ( -- 0 / -1 / fid )                                   >tib @ @ @ dup IF drop blk @ IF loadfile @ ELSE -1 THEN THEN ;                                                                : ior ( n -- ior )  dup 0< IF  $400 -  ELSE  drop 0  THEN ;                                                                                                                                                                                                     \ File operations                                      12may97py                                                                : open-file ( addr count x1 -- fid ior )  drop !fid               dup 0< IF  0 swap EXIT  THEN                                    isfile push  dup isfile !  ['] open catch                       dup 0= IF  drop 0 over filehandle @ 0 fseek ior  THEN ;                                                                       : close-file  ( fid -- ior )  isfile push  isfile !               ['] close! catch  isfile@ unlink-file                           isfile@ DisposHandle ;                                        : create-file ( addr count x1 -- x2 ior ) drop !fid  dup >r       dup filename 0 fcreate dup 0< IF  rdrop ior EXIT  THEN          >r 0 r@ 2 fseek r>  r@ filehandle !  1 r@ fileopen# w!          dup 0>=  IF  r> filesize ! 0  ELSE  rdrop ior  THEN ;         : delete-file ( addr count -- ior )                               !fid >r r@ filename fdelete ior  r> DisposHandle ;            \ File operations                                      26may95py                                                                : file-position  ( fileid -- ud ior ) >r 0 r>                     filehandle @ 1 fseek dup 0< IF  >r 0. r> ior EXIT  THEN  0. ; : reposition-file ( ud fileid -- ior ) nip                        filehandle @ 0 fseek ior ;                                                                                                    : file-size ( fileid -- ud ior ) filesize @ 0 0 ;                                                                               : include-file ( fileid -- )                                      isfile push isfile ! #load close isfile@ DisposHandle ;       : included ( c-addr u -- ) r/o open-file throw include-file ;                                                                   : load-file ( u fileid -- ) isfile push isfile ! load ;                                                                                                                                         \ File operations                                      28jun97py: read-file ( c-addr u1 fileid -- u2 ior )                        filehandle @ fread dup ior >r dup 0< IF 0 nip THEN r> ;       : read-line ( c-addr u1 fileid -- u2 flag ior )                   fpos push loadfile push dup >r loadfile !                       r@ file-position                                                dup IF  >r 2drop 2drop 0 true r> rdrop EXIT  THEN  2drop        r@ filesize @ over = IF drop 2drop 0 0 0 rdrop EXIT  THEN       fpos ! ['] readline catch >r true r>                            dup 0= IF  drop fpos @ 0 r> reposition-file  THEN ;                                                                           : write-file ( c-addr u1 fileid -- ior )                          filehandle @ fwrite ior ;                                     | Create crlf #cr c, #lf c,                                     : write-line ( c-addr u1 fileid -- ior ) dup >r                   write-file  dup 0= IF drop crlf 2 r> write-file THEN ;        \ File extensions                                      26may95py                                                                \ ' isfile alias block-fid                                      \ ' (block  alias file-block  ( u fileid -- a-addr )            \ ' (buffer alias file-buffer ( u fileid -- a-addr )                                                                            : flush-file ( fid -- ior ) isfile push isfile !                  ['] close! catch dup 0= IF drop ['] open catch THEN ;         : resize-file ( ud fileid -- ior )  2 pick over filesize !        dup >r reposition-file dup IF  rdrop EXIT  THEN                 drop -1 0 r> write-file ;                                     : file-status ( c-addr u - x ior )  !fid                          dup >r filename $1F fsfirst dta swap ior r> DisposHandle ;    : rename-file ( addr1 u1 addr2 u2 -- ior )                        !fid >r !fid dup filename r@ filename frename ior               swap DisposHandle r> DisposHandle ;