[openfirmware] r1640 - in forth: kernel lib

[svn at openfirmware.info]

Author: wmb
Date: 2009-12-29 00:41:31 +0100 (Tue, 29 Dec 2009)
New Revision: 1640

Modified:
   forth/kernel/kernel.fth
   forth/lib/tofile.fth
Log:
OLPC trac 9932 - fixed to-file so it works inside scripts.


Modified: forth/kernel/kernel.fth
===================================================================
--- forth/kernel/kernel.fth	2009-12-28 23:34:14 UTC (rev 1639)
+++ forth/kernel/kernel.fth	2009-12-28 23:41:31 UTC (rev 1640)
@@ -1062,6 +1062,7 @@
 
 defer ?permitted  ' noop is ?permitted
 
+defer end-line  ' noop is end-line
 defer interpret
 : (interpret  (s -- )
    begin
@@ -1072,6 +1073,7 @@
       $compile
    repeat
    2drop
+   end-line
 ;
 ' (interpret  is interpret
 

Modified: forth/lib/tofile.fth
===================================================================
--- forth/lib/tofile.fth	2009-12-28 23:34:14 UTC (rev 1639)
+++ forth/lib/tofile.fth	2009-12-28 23:41:31 UTC (rev 1640)
@@ -14,7 +14,7 @@
 \ keep a stack of output streams.
 
 only forth also hidden also definitions
-variable old-status  ' noop old-status token!
+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!
@@ -25,7 +25,7 @@
 
 forth definitions
 : save-output  ( -- )
-   ['] status behavior  old-status token!
+   ['] end-line behavior  old-end-line token!
    ['] (emit  behavior  old-(emit  token!
    ['] (type  behavior  old-(type  token!
    ['] cr     behavior  old-cr     token!
@@ -38,7 +38,7 @@
    saved-output-valid @  if
       old-(emit  token@ is (emit
       old-(type  token@ is (type
-      old-status token@ is status
+      old-end-line token@ is end-line
       old-cr     token@ is cr
       old-exit?  token@ is exit?
       old-#out  @ #out  !
@@ -56,7 +56,7 @@
 forth definitions
 : file-output  ( -- )
    save-output
-   ['] undo-file-output is status
+   ['] undo-file-output is end-line
    ['] file-(emit       is (emit
    ['] file-(type       is (type
    ['] file-cr          is cr