--- gforth/extend.fs 2000/10/29 20:27:02 1.46 +++ gforth/extend.fs 2005/06/28 06:45:07 1.56 @@ -1,6 +1,6 @@ \ EXTEND.FS CORE-EXT Word not fully tested! 12may93jaw -\ Copyright (C) 1995,1998,2000 Free Software Foundation, Inc. +\ Copyright (C) 1995,1998,2000,2003 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -25,7 +25,7 @@ decimal \ .( 12may93jaw -: .( ( compilation,interpretation "ccc" -- ) \ core-ext dot-paren +: .( ( compilation&interpretation "ccc" -- ) \ core-ext dot-paren \G Compilation and interpretation semantics: Parse a string @i{ccc} \G delimited by a @code{)} (right parenthesis). Display the \G string. This is often used to display progress information during @@ -36,10 +36,12 @@ decimal \ !! 2value +[ifundef] 2literal : 2Literal ( compilation w1 w2 -- ; run-time -- w1 w2 ) \ double two-literal \G Compile appropriate code such that, at run-time, cell pair @i{w1, w2} are \G placed on the stack. Interpretation semantics are undefined. swap postpone Literal postpone Literal ; immediate restrict +[then] ' drop alias d>s ( d -- n ) \ double d_to_s @@ -73,11 +75,6 @@ decimal \ C" 17may93jaw -: (c") "lit ; - -: CLiteral - postpone (c") here over char+ allot place align ; immediate restrict - : C" ( compilation "ccc" -- ; run-time -- c-addr ) \ core-ext c-quote \G Compilation: parse a string @i{ccc} delimited by a @code{"} \G (double quote). At run-time, return @i{c-addr} which @@ -123,7 +120,7 @@ decimal begin dup r@ >= while - over 2r@ swap -text 0= if + 2dup 2r@ string-prefix? if 2swap 2drop 2r> 2drop true exit endif 1 /string @@ -241,7 +238,9 @@ variable span ( -- c-addr ) \ core-ext REPEAT drop \ remember udp - udp @ , ; + udp @ , + \ remember dyncode-ptr + here ['] noop , compile-prim1 finish-code ; : marker! ( mark -- ) \ reset included files count; resize will happen on next add-included-file @@ -268,6 +267,9 @@ variable span ( -- c-addr ) \ core-ext REPEAT drop \ restore udp and dp +[IFDEF] forget-dyncode + dup cell+ @ forget-dyncode drop +[THEN] @ udp ! dp ! \ clean up vocabulary stack 0 vp @ 0