version 1.53, 2006/12/31 13:39:14
|
version 1.55, 2007/02/23 22:33:21
|
Line 355 previous
|
Line 355 previous
|
|
|
\ safe output redirection |
\ safe output redirection |
|
|
: to-outfile-id ( file-id -- ) |
: outfile-execute ( ... xt file-id -- ... ) \ gforth |
to outfile-id ; |
\G execute @i{xt} with the output of @code{type} etc. redirected to |
|
\G @i{file-id}. |
|
outfile-id { oldfid } try |
|
to outfile-id execute 0 |
|
restore |
|
oldfid to outfile-id |
|
endtry |
|
throw ; |
|
|
|
: infile-execute ( ... xt file-id -- ... ) \ gforth |
|
\G execute @i{xt} with the input of @code{key} etc. redirected to |
|
\G @i{file-id}. |
|
infile-id { oldfid } try |
|
to infile-id execute 0 |
|
restore |
|
oldfid to infile-id |
|
endtry |
|
throw ; |
|
|
|
\ safe BASE wrapper |
|
|
|
: base-execute ( i*x xt u -- j*x ) \ gforth |
|
\G execute @i{xt} with the content of @code{BASE} being @i{u}, and |
|
\G restoring the original @code{BASE} afterwards. |
|
base @ { oldbase } \ use local, because TRY blocks the return stack |
|
try |
|
base ! execute 0 |
|
restore |
|
oldbase base ! |
|
endtry |
|
throw ; |
|
|
: >outfile ( file-id -- r:old-file-id ) |
|
]] outfile-id >r try to-outfile-id [[ ; immediate compile-only |
|
|
|
: outfile< ( r:old-file-id -- ) |
|
0 ]] literal recover endtry r> to-outfile-id throw [[ |
|
; immediate compile-only |
|
|
|
: to-infile-id ( file-id -- ) |
|
to infile-id ; |
|
|
|
: >infile ( file-id -- r:old-file-id ) |
|
]] infile-id >r try to-infile-id [[ ; immediate compile-only |
|
|
|
: infile< ( r:old-file-id -- ) |
|
0 ]] literal recover endtry r> to-infile-id throw [[ |
|
; immediate compile-only |
|