--- gforth/kernel/files.fs 2000/09/23 15:47:10 1.15 +++ gforth/kernel/files.fs 2006/12/31 13:39:18 1.24 @@ -1,6 +1,6 @@ \ File specifiers 11jun93jaw -\ Copyright (C) 1995,1996,1997,1998,2000 Free Software Foundation, Inc. +\ Copyright (C) 1995,1996,1997,1998,2000,2003,2006 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -36,6 +36,14 @@ \ include-file 07apr93py +has? new-input 0= [IF] +: loadfilename>r ( addr1 u1 -- R: addr2 u2 ) + r> loadfilename 2@ 2>r >r + loadfilename 2! ; + +: r>loadfilename ( R: addr u -- ) + r> 2r> loadfilename 2! >r ; + : push-file ( -- ) r> #fill-bytes @ >r loadline @ >r @@ -50,13 +58,7 @@ : pop-file ( throw-code -- throw-code ) dup IF - source >in @ sourceline# sourcefilename - error-stack dup @ dup 1+ - max-errors 1- min error-stack ! - 6 * cells + cell+ - 5 cells bounds swap DO - I ! - -1 cells +LOOP + input-error-data >error THEN r> r> >in ! @@ -84,15 +86,15 @@ include-file1 throw throw ; : include-file ( i*x wfileid -- j*x ) \ file - loadfilename# @ >r - 3 loadfilename# ! \ "\a file/" + s" *a file*" loadfilename>r include-file1 - r> loadfilename# ! + r>loadfilename throw throw ; +[THEN] \ additional words only needed if there is file support -Warnings off +Redefinitions-start : ( ( compilation 'ccc' -- ; run-time -- ) \ core,file paren loadfile @ 0= IF postpone ( EXIT THEN @@ -111,4 +113,4 @@ Warnings off THEN REPEAT ; immediate -Warnings on +Redefinitions-end