--- gforth/kernel/files.fs 1999/03/23 20:24:24 1.7 +++ gforth/kernel/files.fs 2000/09/12 19:20:06 1.13 @@ -18,11 +18,11 @@ \ along with this program; if not, write to the Free Software \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -4 Constant w/o ( -- ntype ) \ file w-o -2 Constant r/w ( -- ntype ) \ file r-w -0 Constant r/o ( -- ntype ) \ file r-o +4 Constant w/o ( -- fam ) \ file w-o +2 Constant r/w ( -- fam ) \ file r-w +0 Constant r/o ( -- fam ) \ file r-o -: bin ( ntype1 -- ntype2 ) \ file +: bin ( fam1 -- fam2 ) \ file 1 or ; \ BIN WRITE-LINE 11jun93jaw @@ -32,18 +32,19 @@ ?dup IF r> drop EXIT THEN - #lf r> emit-file ; + newline r> write-file ; \ include-file 07apr93py : push-file ( -- ) r> - loadline @ >r - loadfile @ >r - blk @ >r - tibstack @ >r - >tib @ >r - #tib @ >r - >in @ >r >r + #fill-bytes @ >r + loadline @ >r + loadfile @ >r + blk @ >r + tibstack @ >r + >tib @ >r + #tib @ >r + >in @ >r >r >tib @ tibstack @ = IF #tib @ tibstack +! THEN tibstack @ >tib ! ; @@ -58,25 +59,37 @@ -1 cells +LOOP THEN r> - r> >in ! - r> #tib ! - r> >tib ! - r> tibstack ! - r> blk ! - r> loadfile ! - r> loadline ! >r ; + r> >in ! + r> #tib ! + r> >tib ! + r> tibstack ! + r> blk ! + r> loadfile ! + r> loadline ! + r> #fill-bytes ! >r ; : read-loop ( i*x -- j*x ) BEGIN refill WHILE interpret REPEAT ; -: include-file ( i*x wfileid -- j*x ) \ file +: include-file1 ( i*x wfileid -- j*x ior1 ior2 ) \G Interpret (process using the text interpreter) the contents of \G the file @var{wfileid}. push-file loadfile ! 0 loadline ! blk off ['] read-loop catch loadfile @ close-file swap 2dup or - pop-file drop throw throw ; + pop-file drop ; + +: include-file2 ( i*x wfileid -- j*x ) + \ like include-file, but does not update loadfile# + include-file1 throw throw ; +: include-file ( i*x wfileid -- j*x ) \ file + loadfilename# @ >r + 3 loadfilename# ! \ "\a file/" + include-file1 + r> loadfilename# ! + throw throw ; + \ additional words only needed if there is file support Warnings off