--- gforth/extend.fs 2002/12/04 10:42:58 1.47 +++ gforth/extend.fs 2007/03/08 13:55:49 1.59 @@ -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 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 @@ -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 @@ -118,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 @@ -236,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 @@ -263,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