gforth: gforth/extend.fs

Diff for /gforth/extend.fs between version 1.59 and 1.69

-version 1.59, Thu Mar  8 13:55:49 2007 UTC
+version 1.69, Fri Aug 12 16:53:19 2011 UTC
  Line 1
  Line 1
  Line 1
  \ EXTEND.FS    CORE-EXT Word not fully tested!         12may93jaw
- \ Copyright (C) 1995,1998,2000,2003,2005 Free Software Foundation, Inc.
+ \ Copyright (C) 1995,1998,2000,2003,2005,2007,2009,2010 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,
  Line 15
  Line 15
  Line 15
  \ 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
+ \ along with this program. If not, see http://www.gnu.org/licenses/.
- \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
  \ May be cross-compiled
- Line 51
+ Line 50
  Line 51
  Line 50
      >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
-     [ s" floored" environment? 0= throw ] [if]
+     [ 1 -3 mod 0< ] [if]
          -rot r> IF IF 1. d+ THEN dnegate ELSE drop THEN
      [else]
          nip swap r> IF dnegate THEN
- Line 61
+ Line 60
  Line 61
  Line 60
  \ just as described in dpANS5
-CONSTANT case ( compilation  -- case-sys ; run-time  -- ) \ core-ext
+ [ifundef] cs-drop
-     immediate
+ : CS-DROP ( dest -- ) \ gforth
+     dest? 2drop ;
+ [then]
+ : case ( compilation  -- case-sys ; run-time  -- ) \ core-ext
+     postpone begin 0 ; immediate
+ : ?of ( compilation  -- of-sys ; run-time  f -- ) \ gforth
+     >r POSTPONE if r> ; immediate
  : of ( compilation  -- of-sys ; run-time x1 x2 -- |x1 ) \ core-ext
      \ !! the implementation does not match the stack effect
-+ >r
+     postpone over postpone = postpone ?of postpone drop ; immediate
-     postpone over postpone = postpone if postpone drop
-     r> ; immediate
  : endof ( compilation case-sys1 of-sys -- case-sys2 ; run-time  -- ) \ core-ext end-of
-     >r postpone else r> ; immediate
+     >r postpone else 1 cs-roll r> 1+ ; immediate
+ : contof ( compilation case-sys1 of-sys -- case-sys2 ; run-time  -- )
+     \ like @code{endof}, but loops back to the @code{case}
+     >r 1 cs-pick postpone again postpone then r> ; immediate
+ : n-thens ( orig1 ... origu u -- )
+?do postpone then loop ;
  : endcase ( compilation case-sys -- ; run-time x -- ) \ core-ext end-case
-     postpone drop
+     >r cs-drop postpone drop r> n-thens ; immediate
-?do postpone then loop ; immediate
+ : nextcase ( compilation case-sys -- ; run-time x -- ) \ gforth-undocumented
+     \ like ENDCASE, but start again from the beginning if this is
+     \ reached by fallthrough
+     >r postpone drop postpone again r> n-thens ; immediate
  \ C"                                                    17may93jaw
- Line 98
+ Line 115
  Line 98
  Line 115
  \ CONVERT                                               17may93jaw
- : convert ( ud1 c-addr1 -- ud2 c-addr2 ) \ core-ext
+ : convert ( ud1 c-addr1 -- ud2 c-addr2 ) \ core-ext-obsolescent
-     \G OBSOLESCENT: superseded by @code{>number}.
+     \G Obsolescent: superseded by @code{>number}.
      char+ true >number drop ;
  \ ERASE                                                 17may93jaw
- Line 188
+ Line 205
  Line 188
  Line 205
  \ 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
- Line 200
+ Line 217
  Line 200
  Line 217
      \G editing capabilites are available. The length of the string is
      \G stored in @code{span}; it does not include the <return>
      \G character. OBSOLESCENT: superceeded by @code{accept}.
+     everyline
 rot over
      BEGIN ( maxlen span c-addr pos1 )
-         key decode ( maxlen span c-addr pos2 flag )
+         xkey decode ( maxlen span c-addr pos2 flag )
          >r 2over = r> or
      UNTIL
 pick swap /string type
- Line 214
+ Line 232
  Line 214
  Line 232
  \ defined afterwards) when executing the mark.
  : included-files-mark ( -- u )
-     included-files 2@ nip
+     included-files @ ;
-     blk @ 0=
-     if \ not input from blocks
-         source-id 1 -1 within
-         if \ input from file
-- \ do not include the last file (hopefully this is the
-                \ currently included file)
-         then
-     then ;
  \ hmm, most of the saving appears to be pretty unnecessary: we could
  \ derive the wordlists and the words that have to be kept from the
- Line 248
+ Line 258
  Line 248
  Line 258
  : marker! ( mark -- )
      \ reset included files count; resize will happen on next add-included-file
-     included-files 2@ drop over @ included-files 2! cell+
+     included-files @ over @ min included-files ! cell+
      \ rest of marker!
      dup @ swap cell+ ( here rest-of-marker )
      dup @ voclink ! cell+

-Generate output suitable for use with a patch program
+Legend:



Removed from v.1.59
 


changed lines


 
Added in v.1.69
 Legend:



Removed from v.1.59
 


changed lines


 
Added in v.1.69
-Removed from v.1.59
+Added in v.1.69

CVS Admin

gforth: gforth/extend.fs

Diff for /gforth/extend.fs between version 1.59 and 1.69

ViewCVS and CVS Help