[openfirmware] r1641 - in forth: kernel lib
svn at openfirmware.info
svn at openfirmware.info
Tue Dec 29 01:26:19 CET 2009
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
More information about the openfirmware
mailing list