version 1.9, 2000/08/17 12:46:58
|
version 1.26, 2007/12/31 19:02:25
|
Line 1
|
Line 1
|
\ File specifiers 11jun93jaw |
\ File specifiers 11jun93jaw |
|
|
\ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1996,1997,1998,2000,2003,2006,2007 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
\ Gforth is free software; you can redistribute it and/or |
\ Gforth is free software; you can redistribute it and/or |
\ modify it under the terms of the GNU General Public License |
\ modify it under the terms of the GNU General Public License |
\ as published by the Free Software Foundation; either version 2 |
\ as published by the Free Software Foundation, either version 3 |
\ of the License, or (at your option) any later version. |
\ of the License, or (at your option) any later version. |
|
|
\ This program is distributed in the hope that it will be useful, |
\ This program is distributed in the hope that it will be useful, |
Line 15
|
Line 15
|
\ GNU General Public License for more details. |
\ GNU General Public License for more details. |
|
|
\ You should have received a copy of the GNU General Public License |
\ You should have received a copy of the GNU General Public License |
\ along with this program; if not, write to the Free Software |
\ along with this program. If not, see http://www.gnu.org/licenses/. |
\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
|
|
|
4 Constant w/o ( -- fam ) \ file w-o |
4 Constant w/o ( -- fam ) \ file w-o |
2 Constant r/w ( -- fam ) \ file r-w |
2 Constant r/w ( -- fam ) \ file r-w |
Line 36
|
Line 35
|
|
|
\ include-file 07apr93py |
\ 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> |
: push-file ( -- ) r> |
loadline @ >r |
#fill-bytes @ >r |
loadfile @ >r |
loadline @ >r |
blk @ >r |
loadfile @ >r |
tibstack @ >r |
blk @ >r |
>tib @ >r |
tibstack @ >r |
#tib @ >r |
>tib @ >r |
>in @ >r >r |
#tib @ >r |
|
>in @ >r >r |
>tib @ tibstack @ = IF #tib @ tibstack +! THEN |
>tib @ tibstack @ = IF #tib @ tibstack +! THEN |
tibstack @ >tib ! ; |
tibstack @ >tib ! ; |
|
|
: pop-file ( throw-code -- throw-code ) |
: pop-file ( throw-code -- throw-code ) |
dup IF |
dup IF |
source >in @ sourceline# sourcefilename |
input-error-data >error |
error-stack dup @ dup 1+ |
|
max-errors 1- min error-stack ! |
|
6 * cells + cell+ |
|
5 cells bounds swap DO |
|
I ! |
|
-1 cells +LOOP |
|
THEN |
THEN |
r> |
r> |
r> >in ! |
r> >in ! |
r> #tib ! |
r> #tib ! |
r> >tib ! |
r> >tib ! |
r> tibstack ! |
r> tibstack ! |
r> blk ! |
r> blk ! |
r> loadfile ! |
r> loadfile ! |
r> loadline ! >r ; |
r> loadline ! |
|
r> #fill-bytes ! >r ; |
|
|
: read-loop ( i*x -- j*x ) |
: read-loop ( i*x -- j*x ) |
BEGIN refill WHILE interpret REPEAT ; |
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 Interpret (process using the text interpreter) the contents of |
\G the file @var{wfileid}. |
\G the file @var{wfileid}. |
push-file loadfile ! |
push-file loadfile ! |
0 loadline ! blk off ['] read-loop catch |
0 loadline ! blk off ['] read-loop catch |
loadfile @ close-file swap 2dup or |
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 |
|
s" *a file*" loadfilename>r |
|
include-file1 |
|
r>loadfilename |
|
throw throw ; |
|
[THEN] |
|
|
\ additional words only needed if there is file support |
\ additional words only needed if there is file support |
|
|
Warnings off |
Redefinitions-start |
|
|
: ( ( compilation 'ccc<close-paren>' -- ; run-time -- ) \ core,file paren |
: ( ( compilation 'ccc<close-paren>' -- ; run-time -- ) \ core,file paren |
loadfile @ 0= IF postpone ( EXIT THEN |
loadfile @ 0= IF postpone ( EXIT THEN |
Line 98 Warnings off
|
Line 112 Warnings off
|
THEN |
THEN |
REPEAT ; immediate |
REPEAT ; immediate |
|
|
Warnings on |
Redefinitions-end |