--- gforth/stuff.fs 2011/10/06 20:04:35 1.68 +++ gforth/stuff.fs 2012/12/31 15:25:18 1.73 @@ -1,6 +1,6 @@ \ miscelleneous words -\ Copyright (C) 1996,1997,1998,2000,2003,2004,2005,2006,2007,2008,2009,2010 Free Software Foundation, Inc. +\ Copyright (C) 1996,1997,1998,2000,2003,2004,2005,2006,2007,2008,2009,2010,2011,2012 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -17,7 +17,16 @@ \ You should have received a copy of the GNU General Public License \ along with this program. If not, see http://www.gnu.org/licenses/. -require glocals.fs +: save-mem-dict ( addr1 u -- addr2 u ) + here swap dup allot ( addr1 addr2 u ) + 2dup 2>r move 2r> ; + +' usable-dictionary-end @ dodefer: = [if] + require glocals.fs +[else] + require glocals-1.60.fs +[then] + ' require alias needs ( ... "name" -- ... ) \ gforth \G An alias for @code{require}; exists on other systems (e.g., Win32Forth). @@ -136,6 +145,12 @@ AUser CSP \ ]] ... [[ +: [[ ( -- ) \ 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 : compile-literal ( n -- ) postpone literal ; @@ -148,12 +163,6 @@ 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 [ifdef] run-prelude run-prelude [then] @@ -463,3 +472,24 @@ previous \G the counted string. OBSOLESCENT: the counted string has a \G trailing space that is not included in its length. sword here place bl here count + c! here ; + +\ quotations + +:noname false :noname ; +:noname locals-wordlist last @ lastcfa @ + postpone AHEAD + locals-list @ locals-list off + postpone SCOPE + true :noname ; +interpret/compile: [: ( compile-time: -- quotation-sys ) \ gforth bracket-colon +\G Starts a quotation + +: ;] ( compile-time: quotation-sys -- ; run-time: -- xt ) \ gforth semi-bracket + \g ends a quotation + POSTPONE ; >r IF + ] postpone ENDSCOPE + locals-list ! + postpone THEN + lastcfa ! last ! to locals-wordlist + r> postpone ALiteral + ELSE r> THEN ( xt ) ; immediate