--- gforth/stuff.fs 2007/12/31 17:34:58 1.56 +++ gforth/stuff.fs 2009/11/28 21:19:34 1.63 @@ -1,12 +1,12 @@ \ miscelleneous words -\ Copyright (C) 1996,1997,1998,2000,2003,2004,2005,2006,2007 Free Software Foundation, Inc. +\ Copyright (C) 1996,1997,1998,2000,2003,2004,2005,2006,2007,2008 Free Software Foundation, Inc. \ This file is part of Gforth. \ Gforth is free software; you can redistribute it and/or \ modify it under the terms of the GNU General Public License -\ as published by the Free Software Foundation; either version 2 +\ as published by the Free Software Foundation, either version 3 \ of the License, or (at your option) any later version. \ This program is distributed in the hope that it will be useful, @@ -15,8 +15,7 @@ \ GNU General Public License for more details. \ You should have received a copy of the GNU General Public License -\ along with this program; if not, write to the Free Software -\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. +\ along with this program. If not, see http://www.gnu.org/licenses/. require glocals.fs @@ -149,14 +148,16 @@ AUser CSP : compile-compile-2literal ( n1 n2 -- ) compile-2literal postpone compile-2literal ; -: [[ ( -- ) +: [[ ( -- ) \ gforth left-bracket-bracket \G switch from postpone state to compile state \ this is only a marker; it is never really interpreted compile-only-error ; immediate [ifdef] compiler1 : postponer1 ( c-addr u -- ... xt ) - 2dup find-name dup if ( c-addr u nt ) + 2dup find-name + [ifdef] run-prelude run-prelude [then] + dup if ( c-addr u nt ) nip nip name>comp 2dup [comp'] [[ d= if 2drop ['] compiler1 is parser1 ['] noop @@ -177,10 +178,32 @@ AUser CSP THEN then ; -: ]] ( -- ) - \ switch into postpone state +: ]] ( -- ) \ gforth right-bracket-bracket + \G switch into postpone state ['] postponer1 is parser1 state on ; immediate restrict +: postpone-literal postpone literal ; +: postpone-2literal postpone 2literal ; +: postpone-fliteral postpone fliteral ; +: postpone-sliteral postpone sliteral ; + +: ]]L ( postponing: x -- ; compiling: -- x ) \ gforth right-bracket-bracket-l +\G Shortcut for @code{]] literal}. + ]] postpone-literal ]] [[ ; immediate + +: ]]2L ( postponing: x1 x2 -- ; compiling: -- x1 x2 ) \ gforth right-bracket-bracket-two-l +\G Shortcut for @code{]] 2literal}. + ]] postpone-2literal ]] [[ ; immediate + +: ]]FL ( postponing: r -- ; compiling: -- r ) \ gforth right-bracket-bracket-f-l +\G Shortcut for @code{]] fliteral}. + ]] postpone-fliteral ]] [[ ; immediate + +: ]]SL ( postponing: addr1 u -- ; compiling: -- addr2 u ) \ gforth right-bracket-bracket-s-l +\G Shortcut for @code{]] sliteral}; if the string already has been +\G allocated permanently, you can use @code{]]2L} instead. + ]] postpone-sliteral ]] [[ ; immediate + [then] \ f.rdp @@ -388,3 +411,15 @@ previous endtry throw ; +\ th + +: th ( addr1 u -- addr2 ) + cells + ; + +\ \\\ - skip to end of file + +: \\\ ( -- ) \ gforth + \G skip remaining source file + source-id dup 0> IF + >r r@ file-size throw r> reposition-file throw + BEGIN refill 0= UNTIL postpone \ THEN ; immediate