r1641 - in forth: kernel lib

Author: wmb
Date: 2009-12-29 01:26:19 +0100 (Tue, 29 Dec 2009)
New Revision: 1641

Modified:
   forth/kernel/kernel.fth
   forth/lib/tofile.fth
Log:
OLPC trac 9932 - better fix for to-file .

Modified: forth/kernel/kernel.fth
===================================================================
--- forth/kernel/kernel.fth	2009-12-28 23:41:31 UTC (rev 1640)
+++ forth/kernel/kernel.fth	2009-12-29 00:26:19 UTC (rev 1641)
@@ -1062,7 +1062,6 @@

defer ?permitted  ' noop is ?permitted

-defer end-line  ' noop is end-line
 defer interpret
 : (interpret  (s -- )
    begin
@@ -1073,7 +1072,6 @@
       $compile
    repeat
    2drop
-   end-line
 ;
 ' (interpret  is interpret

Modified: forth/lib/tofile.fth
===================================================================
--- forth/lib/tofile.fth	2009-12-28 23:41:31 UTC (rev 1640)
+++ forth/lib/tofile.fth	2009-12-29 00:26:19 UTC (rev 1641)
@@ -14,37 +14,29 @@
 \ keep a stack of output streams.

only forth also hidden also definitions
-variable old-end-line ' noop old-end-line token!
 variable old-(emit   ' noop old-(emit  token!
 variable old-(type   ' noop old-(type  token!
 variable old-cr      ' noop old-cr     token!
 variable old-exit?   ' noop old-exit?  token!
 variable old-#out    0      old-#out        !
 variable old-#line   0      old-#line       !
-variable saved-output-valid  saved-output-valid off

forth definitions
 : save-output  ( -- )
-   ['] end-line behavior  old-end-line token!
    ['] (emit  behavior  old-(emit  token!
    ['] (type  behavior  old-(type  token!
    ['] cr     behavior  old-cr     token!
    ['] exit?  behavior  old-exit?  token!
    #out  @  old-#out  !
    #line @  old-#line !
-   saved-output-valid on
 ;
 : unsave-output  ( -- )
-   saved-output-valid @  if
-      old-(emit  token@ is (emit
-      old-(type  token@ is (type
-      old-end-line token@ is end-line
-      old-cr     token@ is cr
-      old-exit?  token@ is exit?
-      old-#out  @ #out  !
-      old-#line @ #line !
-      saved-output-valid off
-   then
+   old-(emit  token@ is (emit
+   old-(type  token@ is (type
+   old-cr     token@ is cr
+   old-exit?  token@ is exit?
+   old-#out  @ #out  !
+   old-#line @ #line !
 ;
 hidden definitions
 : undo-file-output  ( -- )  unsave-output  ofd @ fclose  ;
@@ -55,20 +47,25 @@
 ;
 forth definitions
 : file-output  ( -- )
-   save-output
-   ['] undo-file-output is end-line
    ['] file-(emit       is (emit
    ['] file-(type       is (type
    ['] file-cr          is cr
    ['] false            is exit?
    #out off  #line off
 ;
+: evaluate-to-file  ( adr len -- ??? )
+   save-output  file-output  ( adr len )
+   ['] evaluate  catch   ( ??? error? )
+   undo-file-output
+   throw
+;
+: cmdline-to-file  ( -- )  0 parse  evaluate-to-file  ;

: to-file  \ filename  ( -- )
-   writing  file-output
+   writing  cmdline-to-file
 ;
 : append-to-file  \ filename  ( -- )
-   appending  file-output
+   appending  cmdline-to-file
 ;
 only forth also definitions