version 1.1, 1997/05/21 20:40:14
|
version 1.13, 2000/09/12 19:20:06
|
Line 1
|
Line 1
|
\ File specifiers 11jun93jaw |
\ File specifiers 11jun93jaw |
|
|
\ Copyright (C) 1995-1997 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 32
|
Line 32
|
?dup IF |
?dup IF |
r> drop EXIT |
r> drop EXIT |
THEN |
THEN |
#lf r> emit-file ; |
newline r> write-file ; |
|
|
\ include-file 07apr93py |
\ include-file 07apr93py |
|
|
: push-file ( -- ) r> |
: push-file ( -- ) r> |
sourceline# >r loadfile @ >r |
#fill-bytes @ >r |
blk @ >r tibstack @ >r >tib @ >r #tib @ >r |
loadline @ >r |
>tib @ tibstack @ = IF r@ tibstack +! THEN |
loadfile @ >r |
tibstack @ >tib ! >in @ >r >r ; |
blk @ >r |
|
tibstack @ >r |
|
>tib @ >r |
|
#tib @ >r |
|
>in @ >r >r |
|
>tib @ tibstack @ = IF #tib @ tibstack +! THEN |
|
tibstack @ >tib ! ; |
|
|
: pop-file ( throw-code -- throw-code ) |
: pop-file ( throw-code -- throw-code ) |
dup IF |
dup IF |
Line 53
|
Line 59
|
-1 cells +LOOP |
-1 cells +LOOP |
THEN |
THEN |
r> |
r> |
r> >in ! r> #tib ! r> >tib ! r> tibstack ! r> blk ! |
r> >in ! |
r> loadfile ! r> loadline ! >r ; |
r> #tib ! |
|
r> >tib ! |
|
r> tibstack ! |
|
r> blk ! |
|
r> loadfile ! |
|
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 fid -- j*x ) \ file |
: include-file1 ( i*x wfileid -- j*x ior1 ior2 ) |
push-file loadfile ! |
\G Interpret (process using the text interpreter) the contents of |
0 loadline ! blk off ['] read-loop catch |
\G the file @var{wfileid}. |
loadfile @ close-file swap 2dup or |
push-file loadfile ! |
pop-file drop throw throw ; |
0 loadline ! blk off ['] read-loop catch |
|
loadfile @ close-file swap 2dup or |
|
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 |
\ additional words only needed if there is file support |
|
|
|
Warnings off |
|
|
: ( ( 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 |
BEGIN |
BEGIN |
Line 84
|
Line 111
|
THEN |
THEN |
REPEAT ; immediate |
REPEAT ; immediate |
|
|
|
Warnings on |