| \ miscelleneous words |
\ miscelleneous words |
| |
|
| \ Copyright (C) 1996,1997,1998,2000,2003,2004,2005 Free Software Foundation, Inc. |
\ Copyright (C) 1996,1997,1998,2000,2003,2004,2005,2006 Free Software Foundation, Inc. |
| |
|
| \ This file is part of Gforth. |
\ This file is part of Gforth. |
| |
|
| ' ul@ alias l@ ( addr -- u ) |
' ul@ alias l@ ( addr -- u ) |
| \ ' sw@ alias <w@ ( addr -- n ) |
\ ' sw@ alias <w@ ( addr -- n ) |
| [then] |
[then] |
| |
|
| |
\ safe output redirection |
| |
|
| |
: outfile-execute ( ... xt file-id -- ... ) \ gforth |
| |
\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 ; |
| |
|
