--- gforth/string.fs 2000/09/23 15:06:02 1.3 +++ gforth/string.fs 2010/12/31 14:37:13 1.11 @@ -1,12 +1,12 @@ \ dynamic string handling 10aug99py -\ Copyright (C) 2000 Free Software Foundation, Inc. +\ Copyright (C) 2000,2005,2007 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, @@ -15,16 +15,17 @@ \ 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 -\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +\ along with this program. If not, see http://www.gnu.org/licenses/. : delete ( buffer size count -- ) over min >r r@ - ( left over ) dup 0> IF 2dup swap dup r@ + -rot swap move THEN + r> bl fill ; +[IFUNDEF] insert : insert ( string length buffer size -- ) rot over min >r r@ - ( left over ) over dup r@ + rot move r> move ; +[THEN] : $padding ( n -- n' ) [ 6 cells ] Literal + [ -4 cells ] Literal and ; @@ -41,7 +42,8 @@ : $ins ( addr1 u addr2 off -- ) >r 2dup dup $@len rot + swap $!len $@ 1+ r> /string insert ; : $+! ( addr1 u addr2 -- ) dup $@len $ins ; -: $off ( addr -- ) dup @ free throw off ; +: $off ( addr -- ) dup @ dup IF free throw off ELSE 2drop THEN ; +: $init ( addr -- ) >r r@ off s" " r> $! ; \ dynamic string handling 12dec99py @@ -49,6 +51,6 @@ >r 2dup r> scan dup >r dup IF 1 /string THEN 2swap r> - 2swap ; -: $iter ( .. $addr char xt -- .. ) { char xt } - $@ BEGIN dup WHILE char $split >r >r xt execute r> r> - REPEAT 2drop ; +: $iter ( .. $addr char xt -- .. ) >r >r + $@ BEGIN dup WHILE r@ $split i' -rot >r >r execute r> r> + REPEAT 2drop rdrop rdrop ;