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