--- gforth/extend.fs	2000/09/23 15:05:59	1.44
+++ gforth/extend.fs	2007/12/31 17:34:58	1.61
@@ -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,2005,2007 Free Software Foundation, Inc.
 
 \ This file is part of Gforth.
 
@@ -16,7 +16,7 @@
 
 \ 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
 
 
 \ May be cross-compiled
@@ -25,7 +25,7 @@ decimal
 
 \ .(                                                    12may93jaw
 
-: .(   ( compilation,interpretation "ccc<paren>" -- ) \ core-ext dot-paren
+: .(   ( compilation&interpretation "ccc<paren>" -- ) \ 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
 
@@ -48,8 +50,12 @@ decimal
     \G In ANS Forth u3 can only be a positive signed number.
     >r s>d >r abs -rot
     s>d r> xor r> swap >r >r dabs rot tuck um* 2swap um*
-    swap >r 0 d+ r> -rot r@ um/mod -rot r> um/mod nip swap
-    r> IF dnegate THEN ;
+    swap >r 0 d+ r> -rot r@ um/mod -rot r> um/mod
+    [ s" floored" environment? 0= throw ] [if]
+        -rot r> IF IF 1. d+ THEN dnegate ELSE drop THEN
+    [else]
+        nip swap r> IF dnegate THEN
+    [then] ;
 
 \ CASE OF ENDOF ENDCASE                                 17may93jaw
 
@@ -73,11 +79,6 @@ decimal
 
 \ C"                                                    17may93jaw
 
-: (c")     "lit ;
-
-: CLiteral
-    postpone (c") here over char+ allot  place align ; immediate restrict
-
 : C" ( compilation "ccc<quote>" -- ; 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
@@ -97,8 +98,8 @@ decimal
 
 \ CONVERT                                               17may93jaw
 
-: convert ( ud1 c-addr1 -- ud2 c-addr2 ) \ core-ext
-    \G OBSOLESCENT: superseded by @code{>number}.
+: convert ( ud1 c-addr1 -- ud2 c-addr2 ) \ core-ext-obsolescent
+    \G Obsolescent: superseded by @code{>number}.
     char+ true >number drop ;
 
 \ ERASE                                                 17may93jaw
@@ -123,7 +124,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
@@ -132,6 +133,7 @@ decimal
 
 \ SOURCE-ID SAVE-INPUT RESTORE-INPUT                    11jun93jaw
 
+[IFUNDEF] source-id
 : source-id ( -- 0 | -1 | fileid ) \ core-ext,file source-i-d
     \G Return 0 (the input source is the user input device), -1 (the
     \G input source is a string being processed by @code{evaluate}) or
@@ -181,16 +183,16 @@ decimal
     r> loadline !
     >in !
     false ;
-
+[THEN]
 \ This things we don't need, but for being complete... jaw
 
 \ EXPECT SPAN                                           17may93jaw
 
-variable span ( -- c-addr ) \ core-ext
+variable span ( -- c-addr ) \ core-ext-obsolescent
 \G @code{Variable} -- @i{c-addr} is the address of a cell that stores the
 \G length of the last string received by @code{expect}. OBSOLESCENT.
 
-: expect ( c-addr +n -- ) \ core-ext
+: expect ( c-addr +n -- ) \ core-ext-obsolescent
     \G Receive a string of at most @i{+n} characters, and store it
     \G in memory starting at @i{c-addr}. The string is
     \G displayed. Input terminates when the <return> key is pressed or
@@ -240,7 +242,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
@@ -267,6 +271,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