--- gforth/stuff.fs	2006/01/28 18:46:15	1.49
+++ gforth/stuff.fs	2007/12/31 17:34:58	1.56
@@ -1,6 +1,6 @@
 \ 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,2007 Free Software Foundation, Inc.
 
 \ This file is part of Gforth.
 
@@ -301,8 +301,9 @@ AUser CSP
 [then]
 
 : f.s ( -- ) \ gforth f-dot-s
-    \G Display the number of items on the floating-point stack,
-    \G followed by a list of the items; TOS is the right-most item.
+\G Display the number of items on the floating-point stack, followed
+\G by a list of the items (but not more than specified by
+\G @code{maxdepth-.s}; TOS is the right-most item.
     ." <" fdepth 0 .r ." > " fdepth 0 max maxdepth-.s @ min dup 0 
     ?DO  dup i - 1- floats fp@ + f@ 16 5 11 f.rdp space LOOP  drop ; 
 
@@ -337,10 +338,10 @@ interpret/compile: what's ( interpretati
 
 environment-wordlist >order
 
-16 address-unit-bits / 1 max constant /w ( -- u ) \ gforth
+16 address-unit-bits / 1 max constant /w ( -- u ) \ gforth slash-w
 \G address units for a 16-bit value
     
-32 address-unit-bits / 1 max constant /l ( -- u ) \ gforth
+32 address-unit-bits / 1 max constant /l ( -- u ) \ gforth slash-l
 \G address units for a 32-bit value
 
 previous
@@ -350,4 +351,40 @@ previous
 ' uw@ alias w@ ( addr -- u )
 ' ul@ alias l@ ( addr -- u )
 \ ' sw@ alias <w@ ( addr -- n )
-[then]
\ No newline at end of file
+[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 ;
+